config

Personal configuration.
git clone git://code.dwrz.net/config
Log | Files | Refs

commit 926284e6eb52313a319160436ca2c7b1954808ef
parent 3e6e1af9baf3342ab5fe82ae5d1111235778cf3f
Author: dwrz <dwrz@dwrz.net>
Date:   Thu, 27 Jun 2024 13:06:26 +0000

Update Emacs pkgs

Diffstat:
Memacs/elpa/archives/gnu/archive-contents | 12++++++------
Memacs/elpa/archives/gnu/archive-contents.signed | 4++--
Memacs/elpa/archives/melpa/archive-contents | 158++++++++++++++++++++++++++++++++++++++++++-------------------------------------
Memacs/elpa/archives/nongnu/archive-contents | 25++++++++++++++++++-------
Memacs/elpa/archives/nongnu/archive-contents.signed | 4++--
Demacs/elpa/doom-modeline-20240605.628/doom-modeline-core.elc | 0
Demacs/elpa/doom-modeline-20240605.628/doom-modeline-env.elc | 0
Demacs/elpa/doom-modeline-20240605.628/doom-modeline-pkg.el | 17-----------------
Demacs/elpa/doom-modeline-20240605.628/doom-modeline-segments.el | 3243-------------------------------------------------------------------------------
Demacs/elpa/doom-modeline-20240605.628/doom-modeline-segments.elc | 0
Demacs/elpa/doom-modeline-20240605.628/doom-modeline.elc | 0
Remacs/elpa/doom-modeline-20240605.628/doom-modeline-autoloads.el -> emacs/elpa/doom-modeline-20240625.230/doom-modeline-autoloads.el | 0
Remacs/elpa/doom-modeline-20240605.628/doom-modeline-core.el -> emacs/elpa/doom-modeline-20240625.230/doom-modeline-core.el | 0
Aemacs/elpa/doom-modeline-20240625.230/doom-modeline-core.elc | 0
Remacs/elpa/doom-modeline-20240605.628/doom-modeline-env.el -> emacs/elpa/doom-modeline-20240625.230/doom-modeline-env.el | 0
Aemacs/elpa/doom-modeline-20240625.230/doom-modeline-env.elc | 0
Aemacs/elpa/doom-modeline-20240625.230/doom-modeline-pkg.el | 17+++++++++++++++++
Aemacs/elpa/doom-modeline-20240625.230/doom-modeline-segments.el | 3247+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aemacs/elpa/doom-modeline-20240625.230/doom-modeline-segments.elc | 0
Remacs/elpa/doom-modeline-20240605.628/doom-modeline.el -> emacs/elpa/doom-modeline-20240625.230/doom-modeline.el | 0
Aemacs/elpa/doom-modeline-20240625.230/doom-modeline.elc | 0
Demacs/elpa/git-commit-20240618.1142/git-commit-pkg.el | 18------------------
Demacs/elpa/git-commit-20240618.1142/git-commit.el | 1312-------------------------------------------------------------------------------
Demacs/elpa/git-commit-20240618.1142/git-commit.elc | 0
Remacs/elpa/git-commit-20240618.1142/git-commit-autoloads.el -> emacs/elpa/git-commit-20240623.1335/git-commit-autoloads.el | 0
Aemacs/elpa/git-commit-20240623.1335/git-commit-pkg.el | 18++++++++++++++++++
Aemacs/elpa/git-commit-20240623.1335/git-commit.el | 1311+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aemacs/elpa/git-commit-20240623.1335/git-commit.elc | 0
Demacs/elpa/ledger-mode-20240527.2134/ledger-check.elc | 0
Demacs/elpa/ledger-mode-20240527.2134/ledger-commodities.elc | 0
Demacs/elpa/ledger-mode-20240527.2134/ledger-complete.elc | 0
Demacs/elpa/ledger-mode-20240527.2134/ledger-context.elc | 0
Demacs/elpa/ledger-mode-20240527.2134/ledger-exec.elc | 0
Demacs/elpa/ledger-mode-20240527.2134/ledger-flymake.elc | 0
Demacs/elpa/ledger-mode-20240527.2134/ledger-fontify.elc | 0
Demacs/elpa/ledger-mode-20240527.2134/ledger-fonts.elc | 0
Demacs/elpa/ledger-mode-20240527.2134/ledger-init.elc | 0
Demacs/elpa/ledger-mode-20240527.2134/ledger-mode-pkg.el | 6------
Demacs/elpa/ledger-mode-20240527.2134/ledger-mode.el | 374-------------------------------------------------------------------------------
Demacs/elpa/ledger-mode-20240527.2134/ledger-mode.elc | 0
Demacs/elpa/ledger-mode-20240527.2134/ledger-navigate.elc | 0
Demacs/elpa/ledger-mode-20240527.2134/ledger-occur.elc | 0
Demacs/elpa/ledger-mode-20240527.2134/ledger-post.elc | 0
Demacs/elpa/ledger-mode-20240527.2134/ledger-reconcile.elc | 0
Demacs/elpa/ledger-mode-20240527.2134/ledger-regex.elc | 0
Demacs/elpa/ledger-mode-20240527.2134/ledger-report.elc | 0
Demacs/elpa/ledger-mode-20240527.2134/ledger-schedule.elc | 0
Demacs/elpa/ledger-mode-20240527.2134/ledger-sort.elc | 0
Demacs/elpa/ledger-mode-20240527.2134/ledger-state.elc | 0
Demacs/elpa/ledger-mode-20240527.2134/ledger-test.elc | 0
Demacs/elpa/ledger-mode-20240527.2134/ledger-texi.elc | 0
Demacs/elpa/ledger-mode-20240527.2134/ledger-xact.elc | 0
Remacs/elpa/ledger-mode-20240527.2134/dir -> emacs/elpa/ledger-mode-20240622.2052/dir | 0
Remacs/elpa/ledger-mode-20240527.2134/ledger-check.el -> emacs/elpa/ledger-mode-20240622.2052/ledger-check.el | 0
Aemacs/elpa/ledger-mode-20240622.2052/ledger-check.elc | 0
Remacs/elpa/ledger-mode-20240527.2134/ledger-commodities.el -> emacs/elpa/ledger-mode-20240622.2052/ledger-commodities.el | 0
Aemacs/elpa/ledger-mode-20240622.2052/ledger-commodities.elc | 0
Remacs/elpa/ledger-mode-20240527.2134/ledger-complete.el -> emacs/elpa/ledger-mode-20240622.2052/ledger-complete.el | 0
Aemacs/elpa/ledger-mode-20240622.2052/ledger-complete.elc | 0
Remacs/elpa/ledger-mode-20240527.2134/ledger-context.el -> emacs/elpa/ledger-mode-20240622.2052/ledger-context.el | 0
Aemacs/elpa/ledger-mode-20240622.2052/ledger-context.elc | 0
Remacs/elpa/ledger-mode-20240527.2134/ledger-exec.el -> emacs/elpa/ledger-mode-20240622.2052/ledger-exec.el | 0
Aemacs/elpa/ledger-mode-20240622.2052/ledger-exec.elc | 0
Remacs/elpa/ledger-mode-20240527.2134/ledger-flymake.el -> emacs/elpa/ledger-mode-20240622.2052/ledger-flymake.el | 0
Aemacs/elpa/ledger-mode-20240622.2052/ledger-flymake.elc | 0
Remacs/elpa/ledger-mode-20240527.2134/ledger-fontify.el -> emacs/elpa/ledger-mode-20240622.2052/ledger-fontify.el | 0
Aemacs/elpa/ledger-mode-20240622.2052/ledger-fontify.elc | 0
Remacs/elpa/ledger-mode-20240527.2134/ledger-fonts.el -> emacs/elpa/ledger-mode-20240622.2052/ledger-fonts.el | 0
Aemacs/elpa/ledger-mode-20240622.2052/ledger-fonts.elc | 0
Remacs/elpa/ledger-mode-20240527.2134/ledger-init.el -> emacs/elpa/ledger-mode-20240622.2052/ledger-init.el | 0
Aemacs/elpa/ledger-mode-20240622.2052/ledger-init.elc | 0
Remacs/elpa/ledger-mode-20240527.2134/ledger-mode-autoloads.el -> emacs/elpa/ledger-mode-20240622.2052/ledger-mode-autoloads.el | 0
Aemacs/elpa/ledger-mode-20240622.2052/ledger-mode-pkg.el | 6++++++
Aemacs/elpa/ledger-mode-20240622.2052/ledger-mode.el | 465+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aemacs/elpa/ledger-mode-20240622.2052/ledger-mode.elc | 0
Remacs/elpa/ledger-mode-20240527.2134/ledger-mode.info -> emacs/elpa/ledger-mode-20240622.2052/ledger-mode.info | 0
Remacs/elpa/ledger-mode-20240527.2134/ledger-navigate.el -> emacs/elpa/ledger-mode-20240622.2052/ledger-navigate.el | 0
Aemacs/elpa/ledger-mode-20240622.2052/ledger-navigate.elc | 0
Remacs/elpa/ledger-mode-20240527.2134/ledger-occur.el -> emacs/elpa/ledger-mode-20240622.2052/ledger-occur.el | 0
Aemacs/elpa/ledger-mode-20240622.2052/ledger-occur.elc | 0
Remacs/elpa/ledger-mode-20240527.2134/ledger-post.el -> emacs/elpa/ledger-mode-20240622.2052/ledger-post.el | 0
Aemacs/elpa/ledger-mode-20240622.2052/ledger-post.elc | 0
Remacs/elpa/ledger-mode-20240527.2134/ledger-reconcile.el -> emacs/elpa/ledger-mode-20240622.2052/ledger-reconcile.el | 0
Aemacs/elpa/ledger-mode-20240622.2052/ledger-reconcile.elc | 0
Remacs/elpa/ledger-mode-20240527.2134/ledger-regex.el -> emacs/elpa/ledger-mode-20240622.2052/ledger-regex.el | 0
Aemacs/elpa/ledger-mode-20240622.2052/ledger-regex.elc | 0
Remacs/elpa/ledger-mode-20240527.2134/ledger-report.el -> emacs/elpa/ledger-mode-20240622.2052/ledger-report.el | 0
Aemacs/elpa/ledger-mode-20240622.2052/ledger-report.elc | 0
Remacs/elpa/ledger-mode-20240527.2134/ledger-schedule.el -> emacs/elpa/ledger-mode-20240622.2052/ledger-schedule.el | 0
Aemacs/elpa/ledger-mode-20240622.2052/ledger-schedule.elc | 0
Remacs/elpa/ledger-mode-20240527.2134/ledger-sort.el -> emacs/elpa/ledger-mode-20240622.2052/ledger-sort.el | 0
Aemacs/elpa/ledger-mode-20240622.2052/ledger-sort.elc | 0
Remacs/elpa/ledger-mode-20240527.2134/ledger-state.el -> emacs/elpa/ledger-mode-20240622.2052/ledger-state.el | 0
Aemacs/elpa/ledger-mode-20240622.2052/ledger-state.elc | 0
Remacs/elpa/ledger-mode-20240527.2134/ledger-test.el -> emacs/elpa/ledger-mode-20240622.2052/ledger-test.el | 0
Aemacs/elpa/ledger-mode-20240622.2052/ledger-test.elc | 0
Remacs/elpa/ledger-mode-20240527.2134/ledger-texi.el -> emacs/elpa/ledger-mode-20240622.2052/ledger-texi.el | 0
Aemacs/elpa/ledger-mode-20240622.2052/ledger-texi.elc | 0
Remacs/elpa/ledger-mode-20240527.2134/ledger-xact.el -> emacs/elpa/ledger-mode-20240622.2052/ledger-xact.el | 0
Aemacs/elpa/ledger-mode-20240622.2052/ledger-xact.elc | 0
Demacs/elpa/lsp-mode-20240619.951/lsp-cucumber.el | 68--------------------------------------------------------------------
Demacs/elpa/lsp-mode-20240619.951/lsp-cucumber.elc | 0
Demacs/elpa/lsp-mode-20240619.951/lsp-mode-autoloads.el | 979-------------------------------------------------------------------------------
Demacs/elpa/lsp-mode-20240619.951/lsp-mode-pkg.el | 21---------------------
Demacs/elpa/lsp-mode-20240619.951/lsp-mode.el | 9848-------------------------------------------------------------------------------
Demacs/elpa/lsp-mode-20240619.951/lsp-mode.elc | 0
Demacs/elpa/lsp-mode-20240619.951/lsp-terraform.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-actionscript.el -> emacs/elpa/lsp-mode-20240625.344/lsp-actionscript.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-actionscript.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-actionscript.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-ada.el -> emacs/elpa/lsp-mode-20240625.344/lsp-ada.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-ada.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-ada.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-angular.el -> emacs/elpa/lsp-mode-20240625.344/lsp-angular.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-angular.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-angular.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-ansible.el -> emacs/elpa/lsp-mode-20240625.344/lsp-ansible.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-ansible.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-ansible.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-asm.el -> emacs/elpa/lsp-mode-20240625.344/lsp-asm.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-asm.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-asm.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-astro.el -> emacs/elpa/lsp-mode-20240625.344/lsp-astro.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-astro.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-astro.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-autotools.el -> emacs/elpa/lsp-mode-20240625.344/lsp-autotools.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-autotools.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-autotools.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-awk.el -> emacs/elpa/lsp-mode-20240625.344/lsp-awk.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-awk.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-awk.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-bash.el -> emacs/elpa/lsp-mode-20240625.344/lsp-bash.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-bash.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-bash.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-beancount.el -> emacs/elpa/lsp-mode-20240625.344/lsp-beancount.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-beancount.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-beancount.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-bufls.el -> emacs/elpa/lsp-mode-20240625.344/lsp-bufls.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-bufls.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-bufls.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-camel.el -> emacs/elpa/lsp-mode-20240625.344/lsp-camel.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-camel.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-camel.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-clangd.el -> emacs/elpa/lsp-mode-20240625.344/lsp-clangd.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-clangd.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-clangd.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-clojure.el -> emacs/elpa/lsp-mode-20240625.344/lsp-clojure.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-clojure.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-clojure.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-cmake.el -> emacs/elpa/lsp-mode-20240625.344/lsp-cmake.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-cmake.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-cmake.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-cobol.el -> emacs/elpa/lsp-mode-20240625.344/lsp-cobol.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-cobol.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-cobol.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-completion.el -> emacs/elpa/lsp-mode-20240625.344/lsp-completion.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-completion.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-completion.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-credo.el -> emacs/elpa/lsp-mode-20240625.344/lsp-credo.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-credo.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-credo.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-crystal.el -> emacs/elpa/lsp-mode-20240625.344/lsp-crystal.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-crystal.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-crystal.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-csharp.el -> emacs/elpa/lsp-mode-20240625.344/lsp-csharp.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-csharp.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-csharp.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-css.el -> emacs/elpa/lsp-mode-20240625.344/lsp-css.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-css.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-css.elc | 0
Aemacs/elpa/lsp-mode-20240625.344/lsp-cucumber.el | 97+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aemacs/elpa/lsp-mode-20240625.344/lsp-cucumber.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-cypher.el -> emacs/elpa/lsp-mode-20240625.344/lsp-cypher.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-cypher.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-cypher.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-d.el -> emacs/elpa/lsp-mode-20240625.344/lsp-d.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-d.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-d.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-dhall.el -> emacs/elpa/lsp-mode-20240625.344/lsp-dhall.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-dhall.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-dhall.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-diagnostics.el -> emacs/elpa/lsp-mode-20240625.344/lsp-diagnostics.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-diagnostics.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-diagnostics.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-dired.el -> emacs/elpa/lsp-mode-20240625.344/lsp-dired.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-dired.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-dired.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-dockerfile.el -> emacs/elpa/lsp-mode-20240625.344/lsp-dockerfile.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-dockerfile.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-dockerfile.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-dot.el -> emacs/elpa/lsp-mode-20240625.344/lsp-dot.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-dot.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-dot.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-earthly.el -> emacs/elpa/lsp-mode-20240625.344/lsp-earthly.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-earthly.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-earthly.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-elixir.el -> emacs/elpa/lsp-mode-20240625.344/lsp-elixir.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-elixir.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-elixir.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-elm.el -> emacs/elpa/lsp-mode-20240625.344/lsp-elm.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-elm.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-elm.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-emmet.el -> emacs/elpa/lsp-mode-20240625.344/lsp-emmet.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-emmet.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-emmet.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-erlang.el -> emacs/elpa/lsp-mode-20240625.344/lsp-erlang.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-erlang.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-erlang.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-eslint.el -> emacs/elpa/lsp-mode-20240625.344/lsp-eslint.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-eslint.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-eslint.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-fortran.el -> emacs/elpa/lsp-mode-20240625.344/lsp-fortran.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-fortran.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-fortran.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-fsharp.el -> emacs/elpa/lsp-mode-20240625.344/lsp-fsharp.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-fsharp.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-fsharp.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-gdscript.el -> emacs/elpa/lsp-mode-20240625.344/lsp-gdscript.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-gdscript.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-gdscript.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-gleam.el -> emacs/elpa/lsp-mode-20240625.344/lsp-gleam.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-gleam.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-gleam.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-glsl.el -> emacs/elpa/lsp-mode-20240625.344/lsp-glsl.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-glsl.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-glsl.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-go.el -> emacs/elpa/lsp-mode-20240625.344/lsp-go.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-go.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-go.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-golangci-lint.el -> emacs/elpa/lsp-mode-20240625.344/lsp-golangci-lint.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-golangci-lint.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-golangci-lint.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-graphql.el -> emacs/elpa/lsp-mode-20240625.344/lsp-graphql.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-graphql.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-graphql.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-groovy.el -> emacs/elpa/lsp-mode-20240625.344/lsp-groovy.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-groovy.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-groovy.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-hack.el -> emacs/elpa/lsp-mode-20240625.344/lsp-hack.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-hack.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-hack.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-haxe.el -> emacs/elpa/lsp-mode-20240625.344/lsp-haxe.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-haxe.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-haxe.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-headerline.el -> emacs/elpa/lsp-mode-20240625.344/lsp-headerline.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-headerline.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-headerline.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-html.el -> emacs/elpa/lsp-mode-20240625.344/lsp-html.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-html.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-html.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-hy.el -> emacs/elpa/lsp-mode-20240625.344/lsp-hy.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-hy.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-hy.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-icons.el -> emacs/elpa/lsp-mode-20240625.344/lsp-icons.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-icons.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-icons.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-ido.el -> emacs/elpa/lsp-mode-20240625.344/lsp-ido.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-ido.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-ido.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-idris.el -> emacs/elpa/lsp-mode-20240625.344/lsp-idris.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-idris.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-idris.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-iedit.el -> emacs/elpa/lsp-mode-20240625.344/lsp-iedit.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-iedit.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-iedit.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-javascript.el -> emacs/elpa/lsp-mode-20240625.344/lsp-javascript.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-javascript.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-javascript.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-jq.el -> emacs/elpa/lsp-mode-20240625.344/lsp-jq.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-jq.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-jq.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-json.el -> emacs/elpa/lsp-mode-20240625.344/lsp-json.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-json.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-json.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-jsonnet.el -> emacs/elpa/lsp-mode-20240625.344/lsp-jsonnet.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-jsonnet.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-jsonnet.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-kotlin.el -> emacs/elpa/lsp-mode-20240625.344/lsp-kotlin.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-kotlin.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-kotlin.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-lens.el -> emacs/elpa/lsp-mode-20240625.344/lsp-lens.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-lens.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-lens.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-lisp.el -> emacs/elpa/lsp-mode-20240625.344/lsp-lisp.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-lisp.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-lisp.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-lua.el -> emacs/elpa/lsp-mode-20240625.344/lsp-lua.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-lua.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-lua.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-magik.el -> emacs/elpa/lsp-mode-20240625.344/lsp-magik.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-magik.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-magik.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-markdown.el -> emacs/elpa/lsp-mode-20240625.344/lsp-markdown.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-markdown.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-markdown.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-marksman.el -> emacs/elpa/lsp-mode-20240625.344/lsp-marksman.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-marksman.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-marksman.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-mdx.el -> emacs/elpa/lsp-mode-20240625.344/lsp-mdx.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-mdx.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-mdx.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-meson.el -> emacs/elpa/lsp-mode-20240625.344/lsp-meson.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-meson.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-meson.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-mint.el -> emacs/elpa/lsp-mode-20240625.344/lsp-mint.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-mint.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-mint.elc | 0
Aemacs/elpa/lsp-mode-20240625.344/lsp-mode-autoloads.el | 984+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aemacs/elpa/lsp-mode-20240625.344/lsp-mode-pkg.el | 21+++++++++++++++++++++
Aemacs/elpa/lsp-mode-20240625.344/lsp-mode.el | 9849++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aemacs/elpa/lsp-mode-20240625.344/lsp-mode.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-modeline.el -> emacs/elpa/lsp-mode-20240625.344/lsp-modeline.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-modeline.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-modeline.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-mojo.el -> emacs/elpa/lsp-mode-20240625.344/lsp-mojo.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-mojo.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-mojo.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-move.el -> emacs/elpa/lsp-mode-20240625.344/lsp-move.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-move.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-move.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-nginx.el -> emacs/elpa/lsp-mode-20240625.344/lsp-nginx.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-nginx.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-nginx.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-nim.el -> emacs/elpa/lsp-mode-20240625.344/lsp-nim.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-nim.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-nim.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-nix.el -> emacs/elpa/lsp-mode-20240625.344/lsp-nix.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-nix.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-nix.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-nushell.el -> emacs/elpa/lsp-mode-20240625.344/lsp-nushell.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-nushell.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-nushell.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-ocaml.el -> emacs/elpa/lsp-mode-20240625.344/lsp-ocaml.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-ocaml.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-ocaml.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-openscad.el -> emacs/elpa/lsp-mode-20240625.344/lsp-openscad.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-openscad.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-openscad.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-perl.el -> emacs/elpa/lsp-mode-20240625.344/lsp-perl.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-perl.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-perl.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-perlnavigator.el -> emacs/elpa/lsp-mode-20240625.344/lsp-perlnavigator.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-perlnavigator.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-perlnavigator.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-php.el -> emacs/elpa/lsp-mode-20240625.344/lsp-php.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-php.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-php.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-pls.el -> emacs/elpa/lsp-mode-20240625.344/lsp-pls.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-pls.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-pls.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-prolog.el -> emacs/elpa/lsp-mode-20240625.344/lsp-prolog.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-prolog.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-prolog.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-protocol.el -> emacs/elpa/lsp-mode-20240625.344/lsp-protocol.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-protocol.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-protocol.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-purescript.el -> emacs/elpa/lsp-mode-20240625.344/lsp-purescript.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-purescript.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-purescript.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-pwsh.el -> emacs/elpa/lsp-mode-20240625.344/lsp-pwsh.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-pwsh.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-pwsh.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-pyls.el -> emacs/elpa/lsp-mode-20240625.344/lsp-pyls.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-pyls.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-pyls.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-pylsp.el -> emacs/elpa/lsp-mode-20240625.344/lsp-pylsp.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-pylsp.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-pylsp.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-qml.el -> emacs/elpa/lsp-mode-20240625.344/lsp-qml.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-qml.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-qml.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-r.el -> emacs/elpa/lsp-mode-20240625.344/lsp-r.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-r.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-r.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-racket.el -> emacs/elpa/lsp-mode-20240625.344/lsp-racket.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-racket.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-racket.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-remark.el -> emacs/elpa/lsp-mode-20240625.344/lsp-remark.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-remark.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-remark.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-rf.el -> emacs/elpa/lsp-mode-20240625.344/lsp-rf.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-rf.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-rf.elc | 0
Aemacs/elpa/lsp-mode-20240625.344/lsp-roslyn.el | 361+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aemacs/elpa/lsp-mode-20240625.344/lsp-roslyn.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-rpm-spec.el -> emacs/elpa/lsp-mode-20240625.344/lsp-rpm-spec.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-rpm-spec.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-rpm-spec.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-rubocop.el -> emacs/elpa/lsp-mode-20240625.344/lsp-rubocop.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-rubocop.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-rubocop.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-ruby-lsp.el -> emacs/elpa/lsp-mode-20240625.344/lsp-ruby-lsp.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-ruby-lsp.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-ruby-lsp.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-ruby-syntax-tree.el -> emacs/elpa/lsp-mode-20240625.344/lsp-ruby-syntax-tree.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-ruby-syntax-tree.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-ruby-syntax-tree.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-ruff-lsp.el -> emacs/elpa/lsp-mode-20240625.344/lsp-ruff-lsp.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-ruff-lsp.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-ruff-lsp.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-rust.el -> emacs/elpa/lsp-mode-20240625.344/lsp-rust.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-rust.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-rust.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-semantic-tokens.el -> emacs/elpa/lsp-mode-20240625.344/lsp-semantic-tokens.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-semantic-tokens.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-semantic-tokens.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-semgrep.el -> emacs/elpa/lsp-mode-20240625.344/lsp-semgrep.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-semgrep.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-semgrep.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-sml.el -> emacs/elpa/lsp-mode-20240625.344/lsp-sml.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-sml.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-sml.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-solargraph.el -> emacs/elpa/lsp-mode-20240625.344/lsp-solargraph.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-solargraph.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-solargraph.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-solidity.el -> emacs/elpa/lsp-mode-20240625.344/lsp-solidity.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-solidity.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-solidity.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-sorbet.el -> emacs/elpa/lsp-mode-20240625.344/lsp-sorbet.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-sorbet.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-sorbet.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-sql.el -> emacs/elpa/lsp-mode-20240625.344/lsp-sql.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-sql.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-sql.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-sqls.el -> emacs/elpa/lsp-mode-20240625.344/lsp-sqls.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-sqls.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-sqls.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-steep.el -> emacs/elpa/lsp-mode-20240625.344/lsp-steep.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-steep.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-steep.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-svelte.el -> emacs/elpa/lsp-mode-20240625.344/lsp-svelte.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-svelte.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-svelte.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-terraform.el -> emacs/elpa/lsp-mode-20240625.344/lsp-terraform.el | 0
Aemacs/elpa/lsp-mode-20240625.344/lsp-terraform.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-tex.el -> emacs/elpa/lsp-mode-20240625.344/lsp-tex.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-tex.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-tex.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-tilt.el -> emacs/elpa/lsp-mode-20240625.344/lsp-tilt.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-tilt.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-tilt.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-toml.el -> emacs/elpa/lsp-mode-20240625.344/lsp-toml.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-toml.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-toml.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-trunk.el -> emacs/elpa/lsp-mode-20240625.344/lsp-trunk.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-trunk.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-trunk.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-ttcn3.el -> emacs/elpa/lsp-mode-20240625.344/lsp-ttcn3.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-ttcn3.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-ttcn3.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-typeprof.el -> emacs/elpa/lsp-mode-20240625.344/lsp-typeprof.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-typeprof.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-typeprof.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-v.el -> emacs/elpa/lsp-mode-20240625.344/lsp-v.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-v.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-v.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-vala.el -> emacs/elpa/lsp-mode-20240625.344/lsp-vala.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-vala.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-vala.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-verilog.el -> emacs/elpa/lsp-mode-20240625.344/lsp-verilog.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-verilog.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-verilog.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-vetur.el -> emacs/elpa/lsp-mode-20240625.344/lsp-vetur.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-vetur.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-vetur.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-vhdl.el -> emacs/elpa/lsp-mode-20240625.344/lsp-vhdl.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-vhdl.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-vhdl.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-vimscript.el -> emacs/elpa/lsp-mode-20240625.344/lsp-vimscript.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-vimscript.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-vimscript.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-volar.el -> emacs/elpa/lsp-mode-20240625.344/lsp-volar.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-volar.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-volar.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-wgsl.el -> emacs/elpa/lsp-mode-20240625.344/lsp-wgsl.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-wgsl.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-wgsl.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-xml.el -> emacs/elpa/lsp-mode-20240625.344/lsp-xml.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-xml.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-xml.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-yaml.el -> emacs/elpa/lsp-mode-20240625.344/lsp-yaml.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-yaml.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-yaml.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-yang.el -> emacs/elpa/lsp-mode-20240625.344/lsp-yang.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-yang.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-yang.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-zig.el -> emacs/elpa/lsp-mode-20240625.344/lsp-zig.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp-zig.elc -> emacs/elpa/lsp-mode-20240625.344/lsp-zig.elc | 0
Remacs/elpa/lsp-mode-20240619.951/lsp.el -> emacs/elpa/lsp-mode-20240625.344/lsp.el | 0
Remacs/elpa/lsp-mode-20240619.951/lsp.elc -> emacs/elpa/lsp-mode-20240625.344/lsp.elc | 0
Demacs/elpa/magit-20240622.1531/magit-apply.el | 856-------------------------------------------------------------------------------
Demacs/elpa/magit-20240622.1531/magit-apply.elc | 0
Demacs/elpa/magit-20240622.1531/magit-base.el | 1257-------------------------------------------------------------------------------
Demacs/elpa/magit-20240622.1531/magit-base.elc | 0
Demacs/elpa/magit-20240622.1531/magit-bisect.el | 322-------------------------------------------------------------------------------
Demacs/elpa/magit-20240622.1531/magit-bisect.elc | 0
Demacs/elpa/magit-20240622.1531/magit-bookmark.el | 154-------------------------------------------------------------------------------
Demacs/elpa/magit-20240622.1531/magit-bookmark.elc | 0
Demacs/elpa/magit-20240622.1531/magit-branch.el | 987-------------------------------------------------------------------------------
Demacs/elpa/magit-20240622.1531/magit-branch.elc | 0
Demacs/elpa/magit-20240622.1531/magit-clone.elc | 0
Demacs/elpa/magit-20240622.1531/magit-commit.elc | 0
Demacs/elpa/magit-20240622.1531/magit-core.el | 132-------------------------------------------------------------------------------
Demacs/elpa/magit-20240622.1531/magit-core.elc | 0
Demacs/elpa/magit-20240622.1531/magit-diff.el | 3564-------------------------------------------------------------------------------
Demacs/elpa/magit-20240622.1531/magit-diff.elc | 0
Demacs/elpa/magit-20240622.1531/magit-ediff.elc | 0
Demacs/elpa/magit-20240622.1531/magit-git.el | 2903-------------------------------------------------------------------------------
Demacs/elpa/magit-20240622.1531/magit-git.elc | 0
Demacs/elpa/magit-20240622.1531/magit-log.el | 2008-------------------------------------------------------------------------------
Demacs/elpa/magit-20240622.1531/magit-log.elc | 0
Demacs/elpa/magit-20240622.1531/magit-merge.el | 315-------------------------------------------------------------------------------
Demacs/elpa/magit-20240622.1531/magit-merge.elc | 0
Demacs/elpa/magit-20240622.1531/magit-mode.el | 1470-------------------------------------------------------------------------------
Demacs/elpa/magit-20240622.1531/magit-mode.elc | 0
Demacs/elpa/magit-20240622.1531/magit-patch.elc | 0
Demacs/elpa/magit-20240622.1531/magit-pkg.el | 20--------------------
Demacs/elpa/magit-20240622.1531/magit-process.el | 1291-------------------------------------------------------------------------------
Demacs/elpa/magit-20240622.1531/magit-process.elc | 0
Demacs/elpa/magit-20240622.1531/magit-reflog.el | 209-------------------------------------------------------------------------------
Demacs/elpa/magit-20240622.1531/magit-reflog.elc | 0
Demacs/elpa/magit-20240622.1531/magit-refs.el | 789-------------------------------------------------------------------------------
Demacs/elpa/magit-20240622.1531/magit-refs.elc | 0
Demacs/elpa/magit-20240622.1531/magit-remote.elc | 0
Demacs/elpa/magit-20240622.1531/magit-sequence.elc | 0
Demacs/elpa/magit-20240622.1531/magit-stash.el | 643-------------------------------------------------------------------------------
Demacs/elpa/magit-20240622.1531/magit-stash.elc | 0
Demacs/elpa/magit-20240622.1531/magit-status.el | 823-------------------------------------------------------------------------------
Demacs/elpa/magit-20240622.1531/magit-status.elc | 0
Demacs/elpa/magit-20240622.1531/magit-submodule.el | 720-------------------------------------------------------------------------------
Demacs/elpa/magit-20240622.1531/magit-submodule.elc | 0
Demacs/elpa/magit-20240622.1531/magit-worktree.el | 207-------------------------------------------------------------------------------
Demacs/elpa/magit-20240622.1531/magit-worktree.elc | 0
Remacs/elpa/magit-20240622.1531/AUTHORS.md -> emacs/elpa/magit-20240625.2109/AUTHORS.md | 0
Remacs/elpa/magit-20240622.1531/LICENSE -> emacs/elpa/magit-20240625.2109/LICENSE | 0
Remacs/elpa/magit-20240622.1531/dir -> emacs/elpa/magit-20240625.2109/dir | 0
Remacs/elpa/magit-20240622.1531/git-rebase.el -> emacs/elpa/magit-20240625.2109/git-rebase.el | 0
Remacs/elpa/magit-20240622.1531/git-rebase.elc -> emacs/elpa/magit-20240625.2109/git-rebase.elc | 0
Aemacs/elpa/magit-20240625.2109/magit-apply.el | 854+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aemacs/elpa/magit-20240625.2109/magit-apply.elc | 0
Remacs/elpa/magit-20240622.1531/magit-autoloads.el -> emacs/elpa/magit-20240625.2109/magit-autoloads.el | 0
Remacs/elpa/magit-20240622.1531/magit-autorevert.el -> emacs/elpa/magit-20240625.2109/magit-autorevert.el | 0
Remacs/elpa/magit-20240622.1531/magit-autorevert.elc -> emacs/elpa/magit-20240625.2109/magit-autorevert.elc | 0
Aemacs/elpa/magit-20240625.2109/magit-base.el | 1252+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aemacs/elpa/magit-20240625.2109/magit-base.elc | 0
Aemacs/elpa/magit-20240625.2109/magit-bisect.el | 322+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aemacs/elpa/magit-20240625.2109/magit-bisect.elc | 0
Remacs/elpa/magit-20240622.1531/magit-blame.el -> emacs/elpa/magit-20240625.2109/magit-blame.el | 0
Remacs/elpa/magit-20240622.1531/magit-blame.elc -> emacs/elpa/magit-20240625.2109/magit-blame.elc | 0
Aemacs/elpa/magit-20240625.2109/magit-bookmark.el | 154+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aemacs/elpa/magit-20240625.2109/magit-bookmark.elc | 0
Aemacs/elpa/magit-20240625.2109/magit-branch.el | 985+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aemacs/elpa/magit-20240625.2109/magit-branch.elc | 0
Remacs/elpa/magit-20240622.1531/magit-bundle.el -> emacs/elpa/magit-20240625.2109/magit-bundle.el | 0
Remacs/elpa/magit-20240622.1531/magit-bundle.elc -> emacs/elpa/magit-20240625.2109/magit-bundle.elc | 0
Remacs/elpa/magit-20240622.1531/magit-clone.el -> emacs/elpa/magit-20240625.2109/magit-clone.el | 0
Aemacs/elpa/magit-20240625.2109/magit-clone.elc | 0
Remacs/elpa/magit-20240622.1531/magit-commit.el -> emacs/elpa/magit-20240625.2109/magit-commit.el | 0
Aemacs/elpa/magit-20240625.2109/magit-commit.elc | 0
Aemacs/elpa/magit-20240625.2109/magit-core.el | 123+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aemacs/elpa/magit-20240625.2109/magit-core.elc | 0
Aemacs/elpa/magit-20240625.2109/magit-diff.el | 3567+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aemacs/elpa/magit-20240625.2109/magit-diff.elc | 0
Remacs/elpa/magit-20240622.1531/magit-ediff.el -> emacs/elpa/magit-20240625.2109/magit-ediff.el | 0
Aemacs/elpa/magit-20240625.2109/magit-ediff.elc | 0
Remacs/elpa/magit-20240622.1531/magit-extras.el -> emacs/elpa/magit-20240625.2109/magit-extras.el | 0
Remacs/elpa/magit-20240622.1531/magit-extras.elc -> emacs/elpa/magit-20240625.2109/magit-extras.elc | 0
Remacs/elpa/magit-20240622.1531/magit-fetch.el -> emacs/elpa/magit-20240625.2109/magit-fetch.el | 0
Remacs/elpa/magit-20240622.1531/magit-fetch.elc -> emacs/elpa/magit-20240625.2109/magit-fetch.elc | 0
Remacs/elpa/magit-20240622.1531/magit-files.el -> emacs/elpa/magit-20240625.2109/magit-files.el | 0
Remacs/elpa/magit-20240622.1531/magit-files.elc -> emacs/elpa/magit-20240625.2109/magit-files.elc | 0
Aemacs/elpa/magit-20240625.2109/magit-git.el | 2873+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aemacs/elpa/magit-20240625.2109/magit-git.elc | 0
Remacs/elpa/magit-20240622.1531/magit-gitignore.el -> emacs/elpa/magit-20240625.2109/magit-gitignore.el | 0
Remacs/elpa/magit-20240622.1531/magit-gitignore.elc -> emacs/elpa/magit-20240625.2109/magit-gitignore.elc | 0
Aemacs/elpa/magit-20240625.2109/magit-log.el | 2022+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aemacs/elpa/magit-20240625.2109/magit-log.elc | 0
Remacs/elpa/magit-20240622.1531/magit-margin.el -> emacs/elpa/magit-20240625.2109/magit-margin.el | 0
Remacs/elpa/magit-20240622.1531/magit-margin.elc -> emacs/elpa/magit-20240625.2109/magit-margin.elc | 0
Aemacs/elpa/magit-20240625.2109/magit-merge.el | 315+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aemacs/elpa/magit-20240625.2109/magit-merge.elc | 0
Aemacs/elpa/magit-20240625.2109/magit-mode.el | 1469+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aemacs/elpa/magit-20240625.2109/magit-mode.elc | 0
Remacs/elpa/magit-20240622.1531/magit-notes.el -> emacs/elpa/magit-20240625.2109/magit-notes.el | 0
Remacs/elpa/magit-20240622.1531/magit-notes.elc -> emacs/elpa/magit-20240625.2109/magit-notes.elc | 0
Remacs/elpa/magit-20240622.1531/magit-patch.el -> emacs/elpa/magit-20240625.2109/magit-patch.el | 0
Aemacs/elpa/magit-20240625.2109/magit-patch.elc | 0
Aemacs/elpa/magit-20240625.2109/magit-pkg.el | 20++++++++++++++++++++
Aemacs/elpa/magit-20240625.2109/magit-process.el | 1291+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aemacs/elpa/magit-20240625.2109/magit-process.elc | 0
Remacs/elpa/magit-20240622.1531/magit-pull.el -> emacs/elpa/magit-20240625.2109/magit-pull.el | 0
Remacs/elpa/magit-20240622.1531/magit-pull.elc -> emacs/elpa/magit-20240625.2109/magit-pull.elc | 0
Remacs/elpa/magit-20240622.1531/magit-push.el -> emacs/elpa/magit-20240625.2109/magit-push.el | 0
Remacs/elpa/magit-20240622.1531/magit-push.elc -> emacs/elpa/magit-20240625.2109/magit-push.elc | 0
Aemacs/elpa/magit-20240625.2109/magit-reflog.el | 207+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aemacs/elpa/magit-20240625.2109/magit-reflog.elc | 0
Aemacs/elpa/magit-20240625.2109/magit-refs.el | 789+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aemacs/elpa/magit-20240625.2109/magit-refs.elc | 0
Remacs/elpa/magit-20240622.1531/magit-remote.el -> emacs/elpa/magit-20240625.2109/magit-remote.el | 0
Aemacs/elpa/magit-20240625.2109/magit-remote.elc | 0
Remacs/elpa/magit-20240622.1531/magit-repos.el -> emacs/elpa/magit-20240625.2109/magit-repos.el | 0
Remacs/elpa/magit-20240622.1531/magit-repos.elc -> emacs/elpa/magit-20240625.2109/magit-repos.elc | 0
Remacs/elpa/magit-20240622.1531/magit-reset.el -> emacs/elpa/magit-20240625.2109/magit-reset.el | 0
Remacs/elpa/magit-20240622.1531/magit-reset.elc -> emacs/elpa/magit-20240625.2109/magit-reset.elc | 0
Remacs/elpa/magit-20240622.1531/magit-sequence.el -> emacs/elpa/magit-20240625.2109/magit-sequence.el | 0
Aemacs/elpa/magit-20240625.2109/magit-sequence.elc | 0
Remacs/elpa/magit-20240622.1531/magit-sparse-checkout.el -> emacs/elpa/magit-20240625.2109/magit-sparse-checkout.el | 0
Remacs/elpa/magit-20240622.1531/magit-sparse-checkout.elc -> emacs/elpa/magit-20240625.2109/magit-sparse-checkout.elc | 0
Aemacs/elpa/magit-20240625.2109/magit-stash.el | 644+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aemacs/elpa/magit-20240625.2109/magit-stash.elc | 0
Aemacs/elpa/magit-20240625.2109/magit-status.el | 789+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aemacs/elpa/magit-20240625.2109/magit-status.elc | 0
Aemacs/elpa/magit-20240625.2109/magit-submodule.el | 721+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aemacs/elpa/magit-20240625.2109/magit-submodule.elc | 0
Remacs/elpa/magit-20240622.1531/magit-subtree.el -> emacs/elpa/magit-20240625.2109/magit-subtree.el | 0
Remacs/elpa/magit-20240622.1531/magit-subtree.elc -> emacs/elpa/magit-20240625.2109/magit-subtree.elc | 0
Remacs/elpa/magit-20240622.1531/magit-tag.el -> emacs/elpa/magit-20240625.2109/magit-tag.el | 0
Remacs/elpa/magit-20240622.1531/magit-tag.elc -> emacs/elpa/magit-20240625.2109/magit-tag.elc | 0
Remacs/elpa/magit-20240622.1531/magit-transient.el -> emacs/elpa/magit-20240625.2109/magit-transient.el | 0
Remacs/elpa/magit-20240622.1531/magit-transient.elc -> emacs/elpa/magit-20240625.2109/magit-transient.elc | 0
Remacs/elpa/magit-20240622.1531/magit-wip.el -> emacs/elpa/magit-20240625.2109/magit-wip.el | 0
Remacs/elpa/magit-20240622.1531/magit-wip.elc -> emacs/elpa/magit-20240625.2109/magit-wip.elc | 0
Aemacs/elpa/magit-20240625.2109/magit-worktree.el | 207+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aemacs/elpa/magit-20240625.2109/magit-worktree.elc | 0
Remacs/elpa/magit-20240622.1531/magit.el -> emacs/elpa/magit-20240625.2109/magit.el | 0
Remacs/elpa/magit-20240622.1531/magit.elc -> emacs/elpa/magit-20240625.2109/magit.elc | 0
Remacs/elpa/magit-20240622.1531/magit.info -> emacs/elpa/magit-20240625.2109/magit.info | 0
Demacs/elpa/magit-section-20240621.2229/magit-section-pkg.el | 14--------------
Demacs/elpa/magit-section-20240621.2229/magit-section.el | 2473-------------------------------------------------------------------------------
Demacs/elpa/magit-section-20240621.2229/magit-section.elc | 0
Demacs/elpa/magit-section-20240621.2229/magit-section.info | 310-------------------------------------------------------------------------------
Remacs/elpa/magit-section-20240621.2229/dir -> emacs/elpa/magit-section-20240624.719/dir | 0
Remacs/elpa/magit-section-20240621.2229/magit-section-autoloads.el -> emacs/elpa/magit-section-20240624.719/magit-section-autoloads.el | 0
Aemacs/elpa/magit-section-20240624.719/magit-section-pkg.el | 14++++++++++++++
Aemacs/elpa/magit-section-20240624.719/magit-section.el | 2507+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aemacs/elpa/magit-section-20240624.719/magit-section.elc | 0
Aemacs/elpa/magit-section-20240624.719/magit-section.info | 317+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Demacs/elpa/markdown-mode-20240501.1057/markdown-mode-pkg.el | 14--------------
Demacs/elpa/markdown-mode-20240501.1057/markdown-mode.el | 10381-------------------------------------------------------------------------------
Demacs/elpa/markdown-mode-20240501.1057/markdown-mode.elc | 0
Remacs/elpa/markdown-mode-20240501.1057/markdown-mode-autoloads.el -> emacs/elpa/markdown-mode-20240626.826/markdown-mode-autoloads.el | 0
Aemacs/elpa/markdown-mode-20240626.826/markdown-mode-pkg.el | 14++++++++++++++
Aemacs/elpa/markdown-mode-20240626.826/markdown-mode.el | 10367+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aemacs/elpa/markdown-mode-20240626.826/markdown-mode.elc | 0
Demacs/elpa/transient-20240607.1832/transient-autoloads.el | 78------------------------------------------------------------------------------
Demacs/elpa/transient-20240607.1832/transient-pkg.el | 16----------------
Demacs/elpa/transient-20240607.1832/transient.el | 4508-------------------------------------------------------------------------------
Demacs/elpa/transient-20240607.1832/transient.elc | 0
Demacs/elpa/transient-20240607.1832/transient.info | 3273-------------------------------------------------------------------------------
Demacs/elpa/transient-20240622.1240/dir | 18------------------
Demacs/elpa/transient-20240622.1240/gpl.info | 721-------------------------------------------------------------------------------
Demacs/elpa/transient-20240622.1240/transient-pkg.el | 16----------------
Demacs/elpa/transient-20240622.1240/transient.el | 4568-------------------------------------------------------------------------------
Demacs/elpa/transient-20240622.1240/transient.elc | 0
Demacs/elpa/transient-20240622.1240/transient.info | 3273-------------------------------------------------------------------------------
Remacs/elpa/transient-20240607.1832/dir -> emacs/elpa/transient-20240626.947/dir | 0
Remacs/elpa/transient-20240607.1832/gpl.info -> emacs/elpa/transient-20240626.947/gpl.info | 0
Remacs/elpa/transient-20240622.1240/transient-autoloads.el -> emacs/elpa/transient-20240626.947/transient-autoloads.el | 0
Aemacs/elpa/transient-20240626.947/transient-pkg.el | 16++++++++++++++++
Aemacs/elpa/transient-20240626.947/transient.el | 4569+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aemacs/elpa/transient-20240626.947/transient.elc | 0
Aemacs/elpa/transient-20240626.947/transient.info | 3273+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Demacs/elpa/vertico-20240511.2047/vertico-buffer.el | 214-------------------------------------------------------------------------------
Demacs/elpa/vertico-20240511.2047/vertico-buffer.elc | 0
Demacs/elpa/vertico-20240511.2047/vertico-directory.elc | 0
Demacs/elpa/vertico-20240511.2047/vertico-flat.elc | 0
Demacs/elpa/vertico-20240511.2047/vertico-grid.elc | 0
Demacs/elpa/vertico-20240511.2047/vertico-indexed.elc | 0
Demacs/elpa/vertico-20240511.2047/vertico-mouse.elc | 0
Demacs/elpa/vertico-20240511.2047/vertico-multiform.elc | 0
Demacs/elpa/vertico-20240511.2047/vertico-pkg.el | 15---------------
Demacs/elpa/vertico-20240511.2047/vertico-quick.elc | 0
Demacs/elpa/vertico-20240511.2047/vertico-repeat.elc | 0
Demacs/elpa/vertico-20240511.2047/vertico-reverse.elc | 0
Demacs/elpa/vertico-20240511.2047/vertico-suspend.elc | 0
Demacs/elpa/vertico-20240511.2047/vertico-unobtrusive.elc | 0
Demacs/elpa/vertico-20240511.2047/vertico.elc | 0
Remacs/elpa/vertico-20240511.2047/vertico-autoloads.el -> emacs/elpa/vertico-20240625.506/vertico-autoloads.el | 0
Aemacs/elpa/vertico-20240625.506/vertico-buffer.el | 215+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aemacs/elpa/vertico-20240625.506/vertico-buffer.elc | 0
Remacs/elpa/vertico-20240511.2047/vertico-directory.el -> emacs/elpa/vertico-20240625.506/vertico-directory.el | 0
Aemacs/elpa/vertico-20240625.506/vertico-directory.elc | 0
Remacs/elpa/vertico-20240511.2047/vertico-flat.el -> emacs/elpa/vertico-20240625.506/vertico-flat.el | 0
Aemacs/elpa/vertico-20240625.506/vertico-flat.elc | 0
Remacs/elpa/vertico-20240511.2047/vertico-grid.el -> emacs/elpa/vertico-20240625.506/vertico-grid.el | 0
Aemacs/elpa/vertico-20240625.506/vertico-grid.elc | 0
Remacs/elpa/vertico-20240511.2047/vertico-indexed.el -> emacs/elpa/vertico-20240625.506/vertico-indexed.el | 0
Aemacs/elpa/vertico-20240625.506/vertico-indexed.elc | 0
Remacs/elpa/vertico-20240511.2047/vertico-mouse.el -> emacs/elpa/vertico-20240625.506/vertico-mouse.el | 0
Aemacs/elpa/vertico-20240625.506/vertico-mouse.elc | 0
Remacs/elpa/vertico-20240511.2047/vertico-multiform.el -> emacs/elpa/vertico-20240625.506/vertico-multiform.el | 0
Aemacs/elpa/vertico-20240625.506/vertico-multiform.elc | 0
Aemacs/elpa/vertico-20240625.506/vertico-pkg.el | 15+++++++++++++++
Remacs/elpa/vertico-20240511.2047/vertico-quick.el -> emacs/elpa/vertico-20240625.506/vertico-quick.el | 0
Aemacs/elpa/vertico-20240625.506/vertico-quick.elc | 0
Remacs/elpa/vertico-20240511.2047/vertico-repeat.el -> emacs/elpa/vertico-20240625.506/vertico-repeat.el | 0
Aemacs/elpa/vertico-20240625.506/vertico-repeat.elc | 0
Remacs/elpa/vertico-20240511.2047/vertico-reverse.el -> emacs/elpa/vertico-20240625.506/vertico-reverse.el | 0
Aemacs/elpa/vertico-20240625.506/vertico-reverse.elc | 0
Remacs/elpa/vertico-20240511.2047/vertico-suspend.el -> emacs/elpa/vertico-20240625.506/vertico-suspend.el | 0
Aemacs/elpa/vertico-20240625.506/vertico-suspend.elc | 0
Remacs/elpa/vertico-20240511.2047/vertico-unobtrusive.el -> emacs/elpa/vertico-20240625.506/vertico-unobtrusive.el | 0
Aemacs/elpa/vertico-20240625.506/vertico-unobtrusive.elc | 0
Remacs/elpa/vertico-20240511.2047/vertico.el -> emacs/elpa/vertico-20240625.506/vertico.el | 0
Aemacs/elpa/vertico-20240625.506/vertico.elc | 0
Demacs/elpa/with-editor-20240609.1518/with-editor-pkg.el | 15---------------
Demacs/elpa/with-editor-20240609.1518/with-editor.el | 980-------------------------------------------------------------------------------
Demacs/elpa/with-editor-20240609.1518/with-editor.elc | 0
Demacs/elpa/with-editor-20240609.1518/with-editor.info | 384-------------------------------------------------------------------------------
Demacs/elpa/with-editor-20240618.1840/dir | 18------------------
Demacs/elpa/with-editor-20240618.1840/with-editor-autoloads.el | 105-------------------------------------------------------------------------------
Demacs/elpa/with-editor-20240618.1840/with-editor-pkg.el | 15---------------
Demacs/elpa/with-editor-20240618.1840/with-editor.el | 980-------------------------------------------------------------------------------
Demacs/elpa/with-editor-20240618.1840/with-editor.elc | 0
Demacs/elpa/with-editor-20240618.1840/with-editor.info | 384-------------------------------------------------------------------------------
Remacs/elpa/with-editor-20240609.1518/dir -> emacs/elpa/with-editor-20240623.1757/dir | 0
Remacs/elpa/with-editor-20240609.1518/with-editor-autoloads.el -> emacs/elpa/with-editor-20240623.1757/with-editor-autoloads.el | 0
Aemacs/elpa/with-editor-20240623.1757/with-editor-pkg.el | 15+++++++++++++++
Aemacs/elpa/with-editor-20240623.1757/with-editor.el | 981+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
Aemacs/elpa/with-editor-20240623.1757/with-editor.elc | 0
Aemacs/elpa/with-editor-20240623.1757/with-editor.info | 384+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
598 files changed, 57780 insertions(+), 67419 deletions(-)

diff --git a/emacs/elpa/archives/gnu/archive-contents b/emacs/elpa/archives/gnu/archive-contents @@ -1143,7 +1143,7 @@ (:url . "https://elpa.gnu.org/packages/djvu.html") (:commit . "071c8ab168588897475899c46eaa16e70141db8c"))]) (do-at-point . - [(0 1 1) + [(0 1 2) ((emacs (26 1))) "Generic context-sensitive action dispatcher." tar @@ -1152,7 +1152,7 @@ (:maintainer "Philip Kaludercic" . "~pkal/public-inbox@lists.sr.ht") (:authors ("Philip Kaludercic" . "philipk@posteo.net")) - (:commit . "3244b2a765315ad640deab34b1b2f90ac2277df3"))]) + (:commit . "da0742df74cbb36347aefd5dcb17d674ee4846d3"))]) (doc-toc . [(1 2) ((emacs @@ -1356,7 +1356,7 @@ (:url . "https://elpa.gnu.org/packages/elisp-benchmarks.html") (:commit . "1a3d97954957a95a179806e0d49ca6d178b097af"))]) (ellama . - [(0 9 10) + [(0 9 11) ((emacs (28 1)) (llm @@ -1369,7 +1369,7 @@ (:maintainer "Sergey Kostyaev" . "sskostyaev@gmail.com") (:authors ("Sergey Kostyaev" . "sskostyaev@gmail.com")) - (:commit . "3d6192ea09cfbd2e3d3e13dcada5f543bd79b968"))]) + (:commit . "968b8631d102c7fd051dbe9eb077755964bb47a2"))]) (emacs-gc-stats . [(1 4 2) ((emacs @@ -4347,7 +4347,7 @@ (:url . "https://elpa.gnu.org/packages/transcribe.html") (:commit . "89832e4cdc1e6d8262a4a2c9d1ff70f398b8faf0"))]) (transient . - [(0 7 1) + [(0 7 2) ((emacs (26 1)) (compat @@ -4360,7 +4360,7 @@ (:maintainer "Jonas Bernoulli" . "emacs.transient@jonas.bernoulli.dev") (:authors ("Jonas Bernoulli" . "emacs.transient@jonas.bernoulli.dev")) - (:commit . "f78aebdd03292241b45023c4379bcad5c746fc4c"))]) + (:commit . "2d6fae0ca232c2423facbbbf8ece18c856e7d31d"))]) (transient-cycles . [(1 0) ((emacs diff --git a/emacs/elpa/archives/gnu/archive-contents.signed b/emacs/elpa/archives/gnu/archive-contents.signed @@ -1 +1 @@ -Good signature from 645357D2883A0966 GNU ELPA Signing Agent (2023) <elpasign@elpa.gnu.org> (trust undefined) created at 2024-06-22T21:10:02+0000 using EDDSA -\ No newline at end of file +Good signature from 645357D2883A0966 GNU ELPA Signing Agent (2023) <elpasign@elpa.gnu.org> (trust undefined) created at 2024-06-26T09:05:03+0000 using EDDSA +\ No newline at end of file diff --git a/emacs/elpa/archives/melpa/archive-contents b/emacs/elpa/archives/melpa/archive-contents @@ -81,7 +81,7 @@ (agenix . [(20240601 1304) ((emacs (27 1))) "Decrypt and encrypt agenix secrets" tar ((:commit . "b9c7ad33b534d80af207949cc06c0bcd1e60fd63") (:authors ("Tomasz Maciosowski" . "t4ccer@gmail.com")) (:maintainers ("Tomasz Maciosowski" . "t4ccer@gmail.com")) (:maintainer "Tomasz Maciosowski" . "t4ccer@gmail.com") (:url . "https://github.com/t4ccer/agenix.el"))]) (aggressive-fill-paragraph . [(20240213 2320) ((dash (2 10 0))) "A mode to automatically keep paragraphs filled" tar ((:commit . "60e4eb5c57d4408e811d12c6b6491b8c89dfa695") (:authors ("David Shepherd" . "davidshepherd7@gmail.com")) (:maintainers ("David Shepherd" . "davidshepherd7@gmail.com")) (:maintainer "David Shepherd" . "davidshepherd7@gmail.com") (:keywords "fill-paragraph" "automatic" "comments") (:url . "https://github.com/davidshepherd7/aggressive-fill-paragraph-mode"))]) (aggressive-indent . [(20230112 1300) ((emacs (24 3))) "Minor mode to aggressively keep your code always indented" tar ((:commit . "a437a45868f94b77362c6b913c5ee8e67b273c42") (:authors ("Artur Malabarba" . "emacs@endlessparentheses.com")) (:maintainers ("Artur Malabarba" . "emacs@endlessparentheses.com")) (:maintainer "Artur Malabarba" . "emacs@endlessparentheses.com") (:keywords "indent" "lisp" "maint" "tools") (:url . "https://github.com/Malabarba/aggressive-indent-mode"))]) - (agtags . [(20221026 904) ((emacs (25))) "A frontend to GNU Global" tar ((:commit . "e8e04ece2f32d65b084974597bfe8077da3ddba0") (:authors ("Vietor Liu" . "vietor.liu@gmail.com")) (:maintainers ("Vietor Liu" . "vietor.liu@gmail.com")) (:maintainer "Vietor Liu" . "vietor.liu@gmail.com") (:keywords "tools" "convenience") (:url . "https://github.com/vietor/agtags"))]) + (agtags . [(20240625 248) ((emacs (25))) "A frontend to GNU Global" tar ((:commit . "4561e19ff809c645629fd31ffa60d7313ac18014") (:authors ("Vietor Liu" . "vietor.liu@gmail.com")) (:maintainers ("Vietor Liu" . "vietor.liu@gmail.com")) (:maintainer "Vietor Liu" . "vietor.liu@gmail.com") (:keywords "tools" "convenience") (:url . "https://github.com/vietor/agtags"))]) (ah . [(20220730 1058) ((emacs (25 1))) "Additional hooks" tar ((:commit . "8e12223f0f423e7fa882cc049a25af6db755902d") (:authors ("Takaaki ISHIKAWA <takaxp at ieee dot org>")) (:maintainers ("Takaaki ISHIKAWA <takaxp at ieee dot org>")) (:maintainer "Takaaki ISHIKAWA <takaxp at ieee dot org>") (:keywords "convenience") (:url . "https://github.com/takaxp/ah"))]) (ahg . [(20230904 701) nil "Alberto's Emacs interface for Mercurial (Hg)" tar ((:commit . "6a8dd876d767b50431db2c695a8c21d5df9944e2") (:authors ("Alberto Griggio" . "agriggio@users.sourceforge.net")) (:maintainers ("Alberto Griggio" . "agriggio@users.sourceforge.net")) (:maintainer "Alberto Griggio" . "agriggio@users.sourceforge.net") (:url . "https://bitbucket.org/agriggio/ahg"))]) (ahk-mode . [(20200412 1832) ((emacs (24 3))) "Major mode for editing AHK (AutoHotkey and AutoHotkey_L)" tar ((:commit . "729007b5f22a49f5187ff47fca18c0d674e73047") (:authors ("Rich Alesi")) (:maintainers ("Rich Alesi")) (:maintainer "Rich Alesi") (:keywords "ahk" "autohotkey" "hotkey" "keyboard shortcut" "automation") (:url . "https://github.com/ralesi/ahk-mode"))]) @@ -101,7 +101,7 @@ (alert-toast . [(20220312 229) ((emacs (25 1)) (alert (1 2)) (f (0 20 0)) (s (1 12 0))) "Windows 10 toast notifications" tar ((:commit . "96c88c93c1084de681700f655223142ee0eb944a") (:authors ("Grzegorz Kowzan" . "grzegorz@kowzan.eu")) (:maintainers ("Grzegorz Kowzan" . "grzegorz@kowzan.eu")) (:maintainer "Grzegorz Kowzan" . "grzegorz@kowzan.eu") (:url . "https://github.com/gkowzan/alert-toast"))]) (align-cljlet . [(20160112 2101) ((clojure-mode (1 11 5))) "Space align various Clojure forms" tar ((:commit . "ebcf0a912e836579a3a9d386e22c1c4bef7fba17") (:url . "https://github.com/gstamp/align-cljlet"))]) (all-ext . [(20200315 1443) ((emacs (24 4)) (all (1 0))) "M-x all with helm-swoop/anything/multiple-cursors/line-number" tar ((:commit . "c865c62506af2c9edc7705a7c24dc8b70d5d4de2") (:authors ("rubikitch" . "rubikitch@ruby-lang.org")) (:maintainers ("rubikitch" . "rubikitch@ruby-lang.org")) (:maintainer "rubikitch" . "rubikitch@ruby-lang.org") (:keywords "matching" "all" "search" "replace" "anything" "helm" "helm-swoop" "occur") (:url . "https://github.com/rubikitch/all-ext"))]) - (all-the-icons . [(20240108 559) ((emacs (24 3))) "A library for inserting Developer icons" tar ((:commit . "ee414384938ccf2ce93c77d717b85dc5538a257d") (:authors ("Dominic Charlesworth" . "dgc336@gmail.com")) (:maintainers ("Dominic Charlesworth" . "dgc336@gmail.com")) (:maintainer "Dominic Charlesworth" . "dgc336@gmail.com") (:keywords "convenient" "lisp") (:url . "https://github.com/domtronn/all-the-icons.el"))]) + (all-the-icons . [(20240623 1800) ((emacs (24 3))) "A library for inserting Developer icons" tar ((:commit . "39ef44f810c34e8900978788467cc675870bcd19") (:authors ("Dominic Charlesworth" . "dgc336@gmail.com")) (:maintainers ("Dominic Charlesworth" . "dgc336@gmail.com")) (:maintainer "Dominic Charlesworth" . "dgc336@gmail.com") (:keywords "convenient" "lisp") (:url . "https://github.com/domtronn/all-the-icons.el"))]) (all-the-icons-completion . [(20240128 2048) ((emacs (26 1)) (all-the-icons (5 0))) "Add icons to completion candidates" tar ((:commit . "4c8bcad8033f5d0868ce82ea3807c6cd46c4a198") (:authors ("Itai Y. Efrat <https://github.com/iyefrat>")) (:maintainers ("Itai Y. Efrat" . "itai3397@gmail.com")) (:maintainer "Itai Y. Efrat" . "itai3397@gmail.com") (:keywords "convenient" "lisp") (:url . "https://github.com/iyefrat/all-the-icons-completion"))]) (all-the-icons-dired . [(20231207 1324) ((emacs (26 1)) (all-the-icons (2 2 0))) "Shows icons for each file in dired mode" tar ((:commit . "e157f0668f22ed586aebe0a2c0186ab07702986c") (:authors ("jtbm37")) (:maintainers ("Jimmy Yuen Ho Wong" . "wyuenho@gmail.com")) (:maintainer "Jimmy Yuen Ho Wong" . "wyuenho@gmail.com") (:keywords "files" "icons" "dired") (:url . "https://github.com/wyuenho/all-the-icons-dired"))]) (all-the-icons-gnus . [(20180511 654) ((emacs (24 4)) (dash (2 12 0)) (all-the-icons (3 1 0))) "Shows icons for in Gnus" tar ((:commit . "27f78996da0725943bcfb2d18038e6f7bddfa9c7") (:authors ("Nicolas Lamirault" . "nicolas.lamirault@gmail.com")) (:maintainers ("Nicolas Lamirault" . "nicolas.lamirault@gmail.com")) (:maintainer "Nicolas Lamirault" . "nicolas.lamirault@gmail.com") (:keywords "mail" "tools"))]) @@ -140,7 +140,7 @@ (annotation . [(20200914 644) nil "Functions for annotating text with faces and help bubbles" tar ((:commit . "aa5e3a127bf17a8c80d947f3c286758a36dadc36") (:url . "https://github.com/agda/agda"))]) (annoying-arrows-mode . [(20161024 646) ((cl-lib (0 5))) "Ring the bell if using arrows too much" tar ((:commit . "3c42e9807d7696da2da2a21b63beebf9cdb3f5dc") (:authors ("Magnar Sveen" . "magnars@gmail.com")) (:maintainers ("Magnar Sveen" . "magnars@gmail.com")) (:maintainer "Magnar Sveen" . "magnars@gmail.com"))]) (ansi . [(20230306 1823) ((emacs (24 1)) (cl-lib (0 6))) "Turn string into ansi strings" tar ((:commit . "c79806eacdf96e061abf5334f4c3364a995705d4") (:authors ("Johan Andersson" . "johan.rejeep@gmail.com")) (:maintainers ("Johan Andersson" . "johan.rejeep@gmail.com")) (:maintainer "Johan Andersson" . "johan.rejeep@gmail.com") (:keywords "terminals" "color" "ansi") (:url . "http://github.com/rejeep/ansi"))]) - (ansible . [(20240615 112) ((s (1 9 0)) (f (0 16 2))) "Ansible minor mode" tar ((:commit . "b4dca00f89334392d770a7a67fffc935ec7354aa") (:authors ("k1LoW (Kenichirou Oyama), <k1lowxb [at] gmail [dot] com> <k1low [at] 101000lab [dot] org>")) (:maintainers ("k1LoW (Kenichirou Oyama), <k1lowxb [at] gmail [dot] com> <k1low [at] 101000lab [dot] org>")) (:maintainer "k1LoW (Kenichirou Oyama), <k1lowxb [at] gmail [dot] com> <k1low [at] 101000lab [dot] org>") (:url . "https://github.com/k1LoW/emacs-ansible"))]) + (ansible . [(20240624 1452) ((s (1 9 0)) (f (0 16 2)) (emacs (25 1))) "Ansible minor mode" tar ((:commit . "eebb2fb49d3c0a0586d1e4ead9ba618c7d003cae") (:authors ("k1LoW (Kenichirou Oyama), <k1lowxb [at] gmail [dot] com>") ("<k1low [at] 101000lab [dot] org>")) (:maintainers ("k1LoW (Kenichirou Oyama), <k1lowxb [at] gmail [dot] com>")) (:maintainer "k1LoW (Kenichirou Oyama), <k1lowxb [at] gmail [dot] com>") (:url . "https://gitlab.com/emacs-ansible/emacs-ansible"))]) (ansible-doc . [(20160924 824) ((emacs (24 3))) "Ansible documentation Minor Mode" tar ((:commit . "bc8128a85a79b14f4a121105d87a5eddc33975ad") (:authors ("Sebastian Wiesner" . "swiesner@lunaryorn")) (:maintainers ("Sebastian Wiesner" . "swiesner@lunaryorn")) (:maintainer "Sebastian Wiesner" . "swiesner@lunaryorn") (:keywords "tools" "help") (:url . "https://github.com/lunaryorn/ansible-doc.el"))]) (ansible-vault . [(20211119 1459) ((emacs (24 3))) "Minor mode for editing ansible vault files" tar ((:commit . "9b3d82ee49d484a494f2d88927b37fcd6245d51e") (:maintainers ("Zachary Elliott" . "contact@zell.io")) (:maintainer "Zachary Elliott" . "contact@zell.io") (:keywords "ansible" "ansible-vault" "tools") (:url . "http://github.com/zellio/ansible-vault-mode"))]) (ansilove . [(20230210 1338) ((emacs (26 1))) "Display buffers as PNG images using ansilove" tar ((:commit . "abd64819dc67e1ababd38d39c7c7f6a2459987c0") (:authors ("Maciej Barć" . "xgqt@riseup.net")) (:maintainers ("Maciej Barć" . "xgqt@riseup.net")) (:maintainer "Maciej Barć" . "xgqt@riseup.net") (:keywords "multimedia") (:url . "https://gitlab.com/xgqt/emacs-ansilove/"))]) @@ -213,7 +213,7 @@ (auth-source-xoauth2 . [(20220804 2219) ((emacs (26 1))) "Integrate auth-source with XOAUTH2" tar ((:commit . "99a03f8ce835412943d311b2746e77fcf5a1b500") (:authors ("Cesar Crusius" . "ccrusius@google.com")) (:maintainers ("Cesar Crusius" . "ccrusius@google.com")) (:maintainer "Cesar Crusius" . "ccrusius@google.com") (:url . "https://github.com/ccrusius/auth-source-xoauth2"))]) (auto-async-byte-compile . [(20160916 454) nil "Automatically byte-compile when saved" tar ((:commit . "8681e74ddb8481789c5dbb3cafabb327db4c4484") (:authors ("rubikitch" . "rubikitch@ruby-lang.org")) (:maintainers ("rubikitch" . "rubikitch@ruby-lang.org")) (:maintainer "rubikitch" . "rubikitch@ruby-lang.org") (:keywords "lisp" "convenience") (:url . "http://www.emacswiki.org/cgi-bin/wiki/download/auto-async-byte-compile.el"))]) (auto-auto-indent . [(20131106 1903) ((es-lib (0 1)) (cl-lib (1 0))) "Indents code as you type" tar ((:commit . "0139378577f936d34b20276af6f022fb457af490") (:authors ("sabof")) (:maintainers ("sabof")) (:maintainer "sabof") (:url . "https://github.com/sabof/auto-auto-indent"))]) - (auto-compile . [(20240607 2343) ((emacs (26 1))) "Automatically compile Emacs Lisp libraries" tar ((:commit . "fc5b66cc6ee0f7dcf0b54ce576f46c0e2fa8c4e8") (:authors ("Jonas Bernoulli" . "emacs.auto-compile@jonas.bernoulli.dev")) (:maintainers ("Jonas Bernoulli" . "emacs.auto-compile@jonas.bernoulli.dev")) (:maintainer "Jonas Bernoulli" . "emacs.auto-compile@jonas.bernoulli.dev") (:keywords "compile" "convenience" "lisp") (:url . "https://github.com/emacscollective/auto-compile"))]) + (auto-compile . [(20240623 931) ((emacs (26 1))) "Automatically compile Emacs Lisp libraries" tar ((:commit . "a495b3b92a555953b58ec4b6a8ab8411c337ea3d") (:authors ("Jonas Bernoulli" . "emacs.auto-compile@jonas.bernoulli.dev")) (:maintainers ("Jonas Bernoulli" . "emacs.auto-compile@jonas.bernoulli.dev")) (:maintainer "Jonas Bernoulli" . "emacs.auto-compile@jonas.bernoulli.dev") (:keywords "compile" "convenience" "lisp") (:url . "https://github.com/emacscollective/auto-compile"))]) (auto-complete . [(20240320 1734) ((popup (0 5 0)) (cl-lib (0 5))) "Auto Completion for GNU Emacs" tar ((:commit . "0c2f5a7d28b70bfe30b87378d58d74798a62741d") (:authors ("Tomohiro Matsuyama" . "m2ym.pub@gmail.com")) (:maintainer "Jen-Chieh Shen" . "jcs090218@gmail.com") (:keywords "completion" "convenience") (:url . "https://github.com/auto-complete/auto-complete"))]) (auto-complete-auctex . [(20140223 1758) ((yasnippet (0 6 1)) (auto-complete (1 4))) "auto-completion for auctex" tar ((:commit . "855633f668bcc4b9408396742a7cb84e0c4a2f77") (:authors ("Christopher Monsanto" . "chris@monsan.to")) (:maintainers ("Christopher Monsanto" . "chris@monsan.to")) (:maintainer "Christopher Monsanto" . "chris@monsan.to"))]) (auto-complete-c-headers . [(20150912 323) ((auto-complete (1 4))) "An auto-complete source for C/C++ header files" tar ((:commit . "52fef720c6f274ad8de52bef39a343421006c511") (:authors ("Masafumi Oyamada" . "stillpedant@gmail.com")) (:maintainers ("Masafumi Oyamada" . "stillpedant@gmail.com")) (:maintainer "Masafumi Oyamada" . "stillpedant@gmail.com") (:keywords "c"))]) @@ -394,7 +394,7 @@ (bpe . [(20141228 2205) ((emacs (24 1))) "Blog from Org mode to Blogger" tar ((:commit . "7b5b25f83506e6c9f4075d3803fa32404943a189") (:authors ("Yuta Yamada <cokesboy\"at\"gmail.com>")) (:maintainers ("Yuta Yamada <cokesboy\"at\"gmail.com>")) (:maintainer "Yuta Yamada <cokesboy\"at\"gmail.com>") (:keywords "blogger" "blog") (:url . "https://github.com/yuutayamada/bpe"))]) (bpftrace-mode . [(20190608 2201) ((emacs (24 0))) "Major mode for editing bpftrace script files" tar ((:commit . "587b39ea7a1d786df5c04796d51bf2a5a4eda0d7") (:authors ("Jay Kamat" . "jaygkamat@gmail.com")) (:maintainers ("Jay Kamat" . "jaygkamat@gmail.com")) (:maintainer "Jay Kamat" . "jaygkamat@gmail.com") (:keywords "highlight" "c") (:url . "http://gitlab.com/jgkamat/bpftrace-mode"))]) (bpr . [(20180220 1844) ((emacs (24))) "Background Process Runner" tar ((:commit . "af84a83dea09d86e77d87ac30604f2c5b4bf4117") (:authors ("Ilya Babanov" . "ilya-babanov@ya.ru")) (:maintainers ("Ilya Babanov" . "ilya-babanov@ya.ru")) (:maintainer "Ilya Babanov" . "ilya-babanov@ya.ru") (:keywords "background" "async" "process" "management") (:url . "https://github.com/ilya-babanov/emacs-bpr"))]) - (bqn-mode . [(20231217 1203) ((emacs (26 1))) "Emacs mode for BQN" tar ((:commit . "23fd9db096ab3a5c5fbd034e721b8a7d27d1d6b7") (:authors ("Marshall Lochbaum" . "mwlochbaum@gmail.com")) (:maintainers ("Marshall Lochbaum" . "mwlochbaum@gmail.com")) (:maintainer "Marshall Lochbaum" . "mwlochbaum@gmail.com") (:url . "https://github.com/museoa/bqn-mode"))]) + (bqn-mode . [(20240623 126) ((emacs (26 1))) "Emacs mode for BQN" tar ((:commit . "b2a524b67d07483888fa17649a0618dfb6b22990") (:authors ("Marshall Lochbaum" . "mwlochbaum@gmail.com")) (:maintainers ("Marshall Lochbaum" . "mwlochbaum@gmail.com")) (:maintainer "Marshall Lochbaum" . "mwlochbaum@gmail.com") (:url . "https://github.com/museoa/bqn-mode"))]) (bracketed-paste . [(20160407 2348) ((emacs (24 3))) "bracketed paste mode support within emacs -nw" tar ((:commit . "843ce3bbb63d560face889e13a57a2f7543957d5") (:authors ("Takeshi Banse" . "takebi@laafc.net")) (:maintainers ("Takeshi Banse" . "takebi@laafc.net")) (:maintainer "Takeshi Banse" . "takebi@laafc.net") (:keywords "terminals"))]) (brainfuck-mode . [(20150113 842) ((langdoc (20130601 1450))) "Brainfuck mode for Emacs" tar ((:commit . "36e69552bb3b97a4f888d362c59845651bd0d492") (:authors ("Tomoya Tanjo" . "ttanjo@gmail.com")) (:maintainers ("Tomoya Tanjo" . "ttanjo@gmail.com")) (:maintainer "Tomoya Tanjo" . "ttanjo@gmail.com") (:keywords "brainfuck" "langdoc") (:url . "https://github.com/tom-tan/brainfuck-mode/"))]) (brazilian-holidays . [(20220828 2348) ((emacs (26))) "Brazilian holidays" tar ((:commit . "03206ea673df49c91a8f924db799620713d86240") (:authors ("Jaguaraquem A. Reinaldo" . "jaguar.adler@gmail.com")) (:maintainers ("Jaguaraquem A. Reinaldo" . "jaguar.adler@gmail.com")) (:maintainer "Jaguaraquem A. Reinaldo" . "jaguar.adler@gmail.com") (:keywords "calendar" "holidays" "brazilian") (:url . "https://github.com/jadler/brazilian-holidays"))]) @@ -494,6 +494,7 @@ (casual-info . [(20240620 1817) ((emacs (29 1)) (casual-lib (1 0 0))) "Transient UI for Info" tar ((:commit . "b20e4af7b5760b360089ea6125b8374cfada402e") (:authors ("Charles Choi" . "kickingvegas@gmail.com")) (:maintainers ("Charles Choi" . "kickingvegas@gmail.com")) (:maintainer "Charles Choi" . "kickingvegas@gmail.com") (:keywords "tools") (:url . "https://github.com/kickingvegas/casual-info"))]) (casual-isearch . [(20240620 1822) ((emacs (29 1)) (casual-lib (1 0 0))) "Transient UI for I-Search" tar ((:commit . "e3aed24fe945cb11d9adf4ded4da59ed9ea2e57d") (:authors ("Charles Choi" . "kickingvegas@gmail.com")) (:maintainers ("Charles Choi" . "kickingvegas@gmail.com")) (:maintainer "Charles Choi" . "kickingvegas@gmail.com") (:keywords "wp") (:url . "https://github.com/kickingvegas/casual-isearch"))]) (casual-lib . [(20240620 1804) ((emacs (29 1))) "Library routines for Casual porcelains" tar ((:commit . "688a32b28d3dbfd2333e7b5be645ef53844537ed") (:authors ("Charles Choi" . "kickingvegas@gmail.com")) (:maintainers ("Charles Choi" . "kickingvegas@gmail.com")) (:maintainer "Charles Choi" . "kickingvegas@gmail.com") (:keywords "tools") (:url . "https://github.com/kickingvegas/casual-lib"))]) + (casual-suite . [(20240620 1908) ((emacs (29 1)) (casual-calc (1 9 0)) (casual-isearch (1 7 0)) (casual-dired (1 4 0)) (casual-avy (1 2 0)) (casual-info (1 2 0))) "A suite of opinionated Transient UIs" tar ((:commit . "2ddc92b3ea479c7bd92666c0d694244cb31d7f26") (:authors ("Charles Choi" . "kickingvegas@gmail.com")) (:maintainers ("Charles Choi" . "kickingvegas@gmail.com")) (:maintainer "Charles Choi" . "kickingvegas@gmail.com") (:keywords "tools") (:url . "https://github.com/kickingvegas/casual-suite"))]) (catmacs . [(20170826 1157) ((emacs (24))) "Simple CAT interface for Yaesu Transceivers." tar ((:commit . "6ea9ee195661fe95355413856476c45dcc8e24e8") (:authors ("Frank Singleton" . "b17flyboy@gmail.com")) (:maintainers ("Frank Singleton" . "b17flyboy@gmail.com")) (:maintainer "Frank Singleton" . "b17flyboy@gmail.com") (:keywords "comm" "hardware") (:url . "https://bitbucket.org/pymaximus/catmacs"))]) (catppuccin-theme . [(20240607 1703) ((emacs (25 1))) "Catppuccin for Emacs - 🍄 Soothing pastel theme for Emacs" tar ((:commit . "2f15c7c7cca7834b072bb26421a2755a67786899") (:authors ("nyxkrage")) (:maintainers ("Carsten Kragelund" . "carsten@kragelund.me")) (:maintainer "Carsten Kragelund" . "carsten@kragelund.me") (:url . "https://github.com/catppuccin/emacs"))]) (cats . [(20230407 1316) ((emacs (26 1))) "Monads for Elisp" tar ((:commit . "7fc70db0eeb2c33ffba5c13c4cdc0f31c7b95537") (:authors ("Matúš Goljer" . "matus.goljer@gmail.com")) (:maintainers ("Matúš Goljer" . "matus.goljer@gmail.com")) (:maintainer "Matúš Goljer" . "matus.goljer@gmail.com") (:url . "https://github.com/Fuco1/emacs-cats"))]) @@ -509,7 +510,7 @@ (cedit . [(20200816 526) nil "paredit-like commands for c-like languages" tar ((:commit . "cb38316903e6cfa8b8c978defa7e1dafcd4e0c12") (:authors ("zk_phi")) (:maintainers ("zk_phi")) (:maintainer "zk_phi") (:url . "http://zk-phi.gitub.io/"))]) (celery . [(20170225 924) ((emacs (24)) (dash-functional (2 11 0)) (s (1 9 0)) (deferred (0 3 2))) "a minor mode to draw stats from celery and more?" tar ((:commit . "b3378dd81e5a717432123fb13d70201da5dc841a") (:authors ("ardumont" . "eniotna.t@gmail.com")) (:maintainers ("ardumont" . "eniotna.t@gmail.com")) (:maintainer "ardumont" . "eniotna.t@gmail.com") (:keywords "celery" "convenience") (:url . "https://github.com/ardumont/emacs-celery"))]) (celestial-mode-line . [(20230323 737) ((emacs (24))) "Show lunar phase and sunrise/-set time in modeline" tar ((:commit . "90056322d6664e2e2b593912e4d5e68f1468cafc") (:authors ("Peter" . "craven@gmx.net")) (:maintainers ("Peter" . "craven@gmx.net")) (:maintainer "Peter" . "craven@gmx.net") (:keywords "extensions") (:url . "https://github.com/ecraven/celestial-mode-line"))]) - (centaur-tabs . [(20240621 606) ((emacs (26 1)) (powerline (2 4)) (cl-lib (0 5))) "Aesthetic, modern looking customizable tabs plugin" tar ((:commit . "4a121a175e663295fcd295512642dae4d2ff9db3") (:authors ("Emmanuel Bustos" . "ema2159@gmail.com")) (:maintainers ("Jen-Chieh Shen" . "jcs090218@gmail.com")) (:maintainer "Jen-Chieh Shen" . "jcs090218@gmail.com") (:keywords "frames") (:url . "https://github.com/ema2159/centaur-tabs"))]) + (centaur-tabs . [(20240624 730) ((emacs (26 1)) (powerline (2 4)) (cl-lib (0 5))) "Aesthetic, modern looking customizable tabs plugin" tar ((:commit . "becd54b663b945b5f6bf0baab8fb81e42c833b07") (:authors ("Emmanuel Bustos" . "ema2159@gmail.com")) (:maintainers ("Jen-Chieh Shen" . "jcs090218@gmail.com")) (:maintainer "Jen-Chieh Shen" . "jcs090218@gmail.com") (:keywords "frames") (:url . "https://github.com/ema2159/centaur-tabs"))]) (centered-cursor-mode . [(20230914 1358) nil "cursor stays vertically centered" tar ((:commit . "67ef719e685407dbc455c7430765e4e685fd95a9") (:authors ("André Riemann" . "andre.riemann@web.de")) (:maintainers ("André Riemann" . "andre.riemann@web.de")) (:maintainer "André Riemann" . "andre.riemann@web.de") (:keywords "convenience") (:url . "https://github.com/andre-r/centered-cursor-mode.el"))]) (centered-window . [(20220125 804) ((emacs (24 4))) "Center the text when there's only one window" tar ((:commit . "80965f6c6afe8d918481433984b493de72af5399") (:authors ("Anler Hernández Peral" . "inbox+emacs@anler.me")) (:maintainers ("Anler Hernández Peral" . "inbox+emacs@anler.me")) (:maintainer "Anler Hernández Peral" . "inbox+emacs@anler.me") (:keywords "faces" "windows") (:url . "https://github.com/anler/centered-window-mode"))]) (centimacro . [(20201225 1132) nil "Assign multiple macros as global key bindings" tar ((:commit . "0149877584b333c4f1953f0767f0cae23881b0df") (:authors ("Oleh Krehel" . "ohwoeowho@gmail.com")) (:maintainers ("Oleh Krehel" . "ohwoeowho@gmail.com")) (:maintainer "Oleh Krehel" . "ohwoeowho@gmail.com") (:keywords "macros") (:url . "https://github.com/abo-abo/centimacro"))]) @@ -531,7 +532,7 @@ (chapel-mode . [(20210513 457) ((emacs (25 1)) (hydra (0 15 0))) "A major mode for the Chapel programming language" tar ((:commit . "39fd24bb7cf44808200354ac0496be4fc4fddd9a") (:keywords "chapel" "chpl" "programming" "languages") (:url . "https://github.com/damon-kwok/chapel-mode"))]) (char-menu . [(20210321 1657) ((emacs (24 3)) (avy-menu (0 1))) "Create your own menu for fast insertion of arbitrary symbols" tar ((:commit . "d77c4d64fc8acc386a0fb9727d346c838e75f011") (:authors ("Mark Karpov" . "markkarpov92@gmail.com")) (:maintainers ("Mark Karpov" . "markkarpov92@gmail.com")) (:maintainer "Mark Karpov" . "markkarpov92@gmail.com") (:keywords "convenience" "editing") (:url . "https://github.com/mrkkrp/char-menu"))]) (charmap . [(20200616 1418) nil "Unicode table for Emacs" tar ((:commit . "feac50b87d2a596c5e5b7b82b79ddd65b6dedd8c") (:authors ("Anan Mikami" . "lateau@gmail.com")) (:maintainers ("Anan Mikami" . "lateau@gmail.com")) (:maintainer "Anan Mikami" . "lateau@gmail.com") (:keywords "unicode" "character" "ucs") (:url . "https://github.com/lateau/charmap"))]) - (chatgpt-shell . [(20240617 1249) ((emacs (27 1)) (shell-maker (0 50 1))) "ChatGPT shell + buffer insert commands" tar ((:commit . "700cd237d78b640989606e698d88c63170f665d8") (:authors ("Alvaro Ramirez https://xenodium.com")) (:maintainers ("Alvaro Ramirez https://xenodium.com")) (:maintainer "Alvaro Ramirez https://xenodium.com") (:url . "https://github.com/xenodium/chatgpt-shell"))]) + (chatgpt-shell . [(20240626 1136) ((emacs (27 1)) (shell-maker (0 50 5))) "ChatGPT shell + buffer insert commands" tar ((:commit . "d7933c74561ba6c63bfede01c886e9521f6f8a01") (:authors ("Alvaro Ramirez https://xenodium.com")) (:maintainers ("Alvaro Ramirez https://xenodium.com")) (:maintainer "Alvaro Ramirez https://xenodium.com") (:url . "https://github.com/xenodium/chatgpt-shell"))]) (chatu . [(20240518 615) ((org (9 6 6)) (emacs (29 1)) (plantuml-mode (1 2 9))) "Convert and insert any images to org-mode or markdown buffer" tar ((:commit . "f813f0bc926346fbd8151d2ae7079119d4657abb") (:authors ("Kimi Ma" . "kimi.im@outlook.com")) (:maintainers ("Kimi Ma" . "kimi.im@outlook.com")) (:maintainer "Kimi Ma" . "kimi.im@outlook.com") (:keywords "multimedia" "convenience") (:url . "https://github.com/kimim/chatu"))]) (chatwork . [(20170511 442) nil "ChatWork client for Emacs" tar ((:commit . "fea231d479f06bf40dbfcf45de143eecc9ed744c") (:authors ("Masayuki Ataka" . "masayuki.ataka@gmail.com")) (:maintainers ("Masayuki Ataka" . "masayuki.ataka@gmail.com")) (:maintainer "Masayuki Ataka" . "masayuki.ataka@gmail.com") (:keywords "web") (:url . "https://github.com/ataka/chatwork"))]) (cheat-sh . [(20210607 1307) ((emacs (25 1))) "Interact with cheat.sh" tar ((:commit . "33bae22feae8d3375739c6bdef08d0dcdf47ee42") (:authors ("Dave Pearson" . "davep@davep.org")) (:maintainers ("Dave Pearson" . "davep@davep.org")) (:maintainer "Dave Pearson" . "davep@davep.org") (:keywords "docs" "help") (:url . "https://github.com/davep/cheat-sh.el"))]) @@ -623,7 +624,7 @@ (clojure-snippets . [(20220914 950) ((yasnippet (0 10 0))) "Yasnippets for clojure" tar ((:commit . "66d23f0ffedf2cc2be0387c3504b5f89d7300cfa") (:authors ("Max Penet" . "m@qbits.cc")) (:maintainer "Max Penet" . "m@qbits.cc") (:keywords "snippets"))]) (clojure-ts-mode . [(20240618 301) ((emacs (29 1))) "Major mode for Clojure code" tar ((:commit . "7b7a4705d1a952b4414672955e67fb9471213f2a") (:maintainers ("Danny Freeman" . "danny@dfreeman.email")) (:maintainer "Danny Freeman" . "danny@dfreeman.email") (:keywords "languages" "clojure" "clojurescript" "lisp") (:url . "http://github.com/clojure-emacs/clojure-ts-mode"))]) (clomacs . [(20220415 1035) ((emacs (24 3)) (cider (0 22 1)) (s (1 12 0)) (simple-httpd (1 4 6)) (dash (2 19 1))) "Simplifies Emacs Lisp interaction with Clojure." tar ((:commit . "9cd7c9fd86bc7bc627a31275d1ef131378b90a49") (:authors ("Kostafey" . "kostafey@gmail.com")) (:maintainers ("Kostafey" . "kostafey@gmail.com")) (:maintainer "Kostafey" . "kostafey@gmail.com") (:keywords "clojure" "interaction") (:url . "https://github.com/clojure-emacs/clomacs"))]) - (closql . [(20240601 1727) ((emacs (26 1)) (compat (29 1 4 5)) (emacsql (20240124))) "Store EIEIO objects using EmacSQL" tar ((:commit . "27b6d2be1a06cdcb5d5fbd77a702b9fbc5082c03") (:authors ("Jonas Bernoulli" . "emacs.closql@jonas.bernoulli.dev")) (:maintainers ("Jonas Bernoulli" . "emacs.closql@jonas.bernoulli.dev")) (:maintainer "Jonas Bernoulli" . "emacs.closql@jonas.bernoulli.dev") (:keywords "extensions") (:url . "https://github.com/emacscollective/closql"))]) + (closql . [(20240623 2020) ((emacs (26 1)) (compat (29 1 4 5)) (emacsql (20240124))) "Store EIEIO objects using EmacSQL" tar ((:commit . "ffbd489287c1fc46f208d2eb255eaec3f503d871") (:authors ("Jonas Bernoulli" . "emacs.closql@jonas.bernoulli.dev")) (:maintainers ("Jonas Bernoulli" . "emacs.closql@jonas.bernoulli.dev")) (:maintainer "Jonas Bernoulli" . "emacs.closql@jonas.bernoulli.dev") (:keywords "extensions") (:url . "https://github.com/emacscollective/closql"))]) (closure-lint-mode . [(20101118 2124) nil "minor mode for the Closure Linter" tar ((:commit . "bc3d2fd5c35580bf1b8af43b12484c95a343b4b5") (:authors ("Roman Scherer" . "roman@burningswell.com")) (:maintainers ("Roman Scherer" . "roman@burningswell.com")) (:maintainer "Roman Scherer" . "roman@burningswell.com") (:keywords "tools" "closure" "javascript" "lint" "flymake") (:url . "https://github.com/r0man/closure-lint-mode"))]) (cloud-theme . [(20220205 1336) ((emacs (24))) "A light colored theme" tar ((:commit . "16ef7fbf0a423b29e3c3a0a2d9525afaf265aaed") (:authors ("Valerii Lysenko" . "vallyscode@gmail.com")) (:maintainers ("Valerii Lysenko" . "vallyscode@gmail.com")) (:maintainer "Valerii Lysenko" . "vallyscode@gmail.com") (:keywords "color" "theme") (:url . "https://github.com/vallyscode/cloud-theme"))]) (cloud-to-butt-erc . [(20130627 2308) nil "Replace 'the cloud' with 'my butt'" tar ((:commit . "6710c03d1bc91736435cbfe845924940cae34e5c") (:authors ("David Leatherman" . "leathekd@gmail.com")) (:maintainers ("David Leatherman" . "leathekd@gmail.com")) (:maintainer "David Leatherman" . "leathekd@gmail.com") (:url . "http://www.github.com/leathekd/cloud-to-butt-erc"))]) @@ -631,7 +632,7 @@ (cm-mode . [(20240422 725) ((emacs (25 1)) (cl-lib (0 5))) "Minor mode for CriticMarkup" tar ((:commit . "a9381f57f3005a9b26f81085ecb2accf680c6f6b") (:authors ("Joost Kremers" . "joostkremers@fastmail.fm")) (:maintainers ("Joost Kremers" . "joostkremers@fastmail.fm")) (:maintainer "Joost Kremers" . "joostkremers@fastmail.fm") (:keywords "text" "markdown"))]) (cmake-font-lock . [(20230304 2223) ((cmake-mode (0 0))) "Advanced, type aware, highlight support for CMake" tar ((:commit . "a6038e916bcca807ae695f7d7e5c300c3f38f415") (:authors ("Anders Lindgren")) (:maintainers ("Anders Lindgren")) (:maintainer "Anders Lindgren") (:keywords "faces" "languages") (:url . "https://github.com/Lindydancer/cmake-font-lock"))]) (cmake-ide . [(20210610 1525) ((emacs (24 4)) (cl-lib (0 5)) (seq (1 11)) (levenshtein (0)) (s (1 11 0))) "Calls CMake to find out include paths and other compiler flags" tar ((:commit . "28dc4ab5bd01d99553901b4efeb7234280928b18") (:authors ("Atila Neves" . "atila.neves@gmail.com")) (:maintainers ("Atila Neves" . "atila.neves@gmail.com")) (:maintainer "Atila Neves" . "atila.neves@gmail.com") (:keywords "languages") (:url . "http://github.com/atilaneves/cmake-ide"))]) - (cmake-mode . [(20240412 1329) ((emacs (24 1))) "major-mode for editing CMake sources" tar ((:commit . "3bb04b05a527b2443298cb7bc9520f58e56c4e9e"))]) + (cmake-mode . [(20240624 1425) ((emacs (24 1))) "major-mode for editing CMake sources" tar ((:commit . "4b874546fc3711bb24fcdba5718e6c85a17c740a"))]) (cmake-project . [(20171121 1115) nil "Integrates CMake build process with Emacs" tar ((:commit . "d3f408f226eff3f77f7e00dd519f4efc78fd292d") (:authors ("Alexander Lamaison" . "alexander.lamaison@gmail")) (:maintainers ("Alexander Lamaison" . "alexander.lamaison@gmail")) (:maintainer "Alexander Lamaison" . "alexander.lamaison@gmail") (:keywords "c" "cmake" "languages" "tools") (:url . "http://github.com/alamaison/emacs-cmake-project"))]) (cmd-to-echo . [(20161203 2133) ((emacs (24 4)) (s (1 11 0)) (shell-split-string (20151224 208))) "Show the output of long-running commands in the echo area" tar ((:commit . "e0e874fc0e1ad6d291e39ed76023445297ad438a") (:authors ("Tijs Mallaerts" . "tijs.mallaerts@gmail.com")) (:maintainers ("Tijs Mallaerts" . "tijs.mallaerts@gmail.com")) (:maintainer "Tijs Mallaerts" . "tijs.mallaerts@gmail.com"))]) (cmm-mode . [(20150225 746) nil "Major mode for C-- source code" tar ((:commit . "c3ad514dff3eb30434f6b20d953276d4c00de1ee"))]) @@ -681,7 +682,7 @@ (commenter . [(20160219 1627) ((emacs (24 4)) (let-alist (1 0 4))) "multiline-comment support package" tar ((:commit . "6d1885419434ba779270c6fda0e30d390bb074bd") (:authors ("Yuta Yamada <cokesboy\"at\"gmail.com>")) (:maintainers ("Yuta Yamada <cokesboy\"at\"gmail.com>")) (:maintainer "Yuta Yamada <cokesboy\"at\"gmail.com>") (:keywords "comment") (:url . "https://github.com/yuutayamada/commenter"))]) (commify . [(20230616 1042) ((s (1 9 0))) "Toggle grouping commas in numbers" tar ((:commit . "35e2438eb7feeb28273c4920376fcf296cc83283") (:authors ("Daniel E. Doherty" . "ded-commify@ddoherty.net")) (:maintainers ("Daniel E. Doherty" . "ded-commify@ddoherty.net")) (:maintainer "Daniel E. Doherty" . "ded-commify@ddoherty.net") (:keywords "convenience" "editing" "numbers" "grouping" "commas") (:url . "https://github.com/ddoherty03/commify"))]) (common-lisp-snippets . [(20180226 1523) ((yasnippet (0 8 0))) "Yasnippets for Common Lisp" tar ((:commit . "1ddf808311ba4d9e8444a1cb50bd5ee75e4111f6") (:authors ("Mark Karpov" . "markkarpov92@gmail.com")) (:maintainers ("Mark Karpov" . "markkarpov92@gmail.com")) (:maintainer "Mark Karpov" . "markkarpov92@gmail.com") (:keywords "snippets") (:url . "https://github.com/mrkkrp/common-lisp-snippets"))]) - (company . [(20240612 2106) ((emacs (25 1))) "Modular text completion framework" tar ((:commit . "24c804393eaebe2e6919c1d9f7fbebfbc76d6eae") (:authors ("Nikolaj Schumacher")) (:maintainers ("Dmitry Gutov" . "dmitry@gutov.dev")) (:maintainer "Dmitry Gutov" . "dmitry@gutov.dev") (:keywords "abbrev" "convenience" "matching") (:url . "http://company-mode.github.io/"))]) + (company . [(20240625 0) ((emacs (25 1))) "Modular text completion framework" tar ((:commit . "8d2ca28a161f8b912889684412bb1d7fb07d035c") (:authors ("Nikolaj Schumacher")) (:maintainers ("Dmitry Gutov" . "dmitry@gutov.dev")) (:maintainer "Dmitry Gutov" . "dmitry@gutov.dev") (:keywords "abbrev" "convenience" "matching") (:url . "http://company-mode.github.io/"))]) (company-anaconda . [(20230821 2126) ((emacs (25 1)) (company (0 8 0)) (anaconda-mode (0 1 1)) (cl-lib (0 5 0)) (dash (2 6 0)) (s (1 9))) "Anaconda backend for company-mode" tar ((:commit . "14867265e474f7a919120bbac74870c3256cbacf") (:authors ("Artem Malyshev" . "proofit404@gmail.com")) (:maintainers ("Artem Malyshev" . "proofit404@gmail.com")) (:maintainer "Artem Malyshev" . "proofit404@gmail.com") (:keywords "convenience" "company" "anaconda") (:url . "https://github.com/proofit404/anaconda-mode"))]) (company-ansible . [(20240221 2255) ((emacs (24 4)) (company (0 8 12))) "A company back-end for ansible" tar ((:commit . "338922601cf9e8ada863fe6f2dd9d5145d9983b0") (:authors ("Krzysztof Magosa" . "krzysztof@magosa.pl")) (:maintainers ("Krzysztof Magosa" . "krzysztof@magosa.pl")) (:maintainer "Krzysztof Magosa" . "krzysztof@magosa.pl") (:keywords "ansible") (:url . "https://github.com/krzysztof-magosa/company-ansible"))]) (company-arduino . [(20160306 1739) ((emacs (24 1)) (company (0 8 0)) (irony (0 1 0)) (cl-lib (0 5)) (company-irony (0 1 0)) (company-c-headers (20140930)) (arduino-mode (1 0))) "company-mode for Arduino" tar ((:commit . "5958b917cc5cc729dc64d74d947da5ee91c48980") (:authors ("Yuta Yamada" . "sleepboy.zzz@gmail.com")) (:maintainers ("Yuta Yamada" . "sleepboy.zzz@gmail.com")) (:maintainer "Yuta Yamada" . "sleepboy.zzz@gmail.com") (:keywords "convenience" "development" "company") (:url . "https://github.com/yuutayamada/company-arduino"))]) @@ -787,7 +788,7 @@ (consult-hatena-bookmark . [(20221125 109) ((emacs (27 1)) (consult (0 9)) (async-await (1 1))) "Consult commands for the Hatena Bookmark" tar ((:commit . "b85484b11705ebd896878d3ac7fdb12bc8c9637a") (:authors ("Yukinori Kitadai")) (:maintainers ("Yukinori Kitadai")) (:maintainer "Yukinori Kitadai") (:url . "https://github.com/Nyoho/consult-hatena-bookmark"))]) (consult-ls-git . [(20240529 641) ((emacs (27 1)) (consult (0 16))) "Consult integration for git" tar ((:commit . "b1ca94f7c43cbd3811d09a0c9ab04f67f6318e95") (:authors ("Robin Joy")) (:maintainers ("Robin Joy")) (:maintainer "Robin Joy") (:keywords "convenience") (:url . "https://github.com/rcj/consult-ls-git"))]) (consult-lsp . [(20240507 2105) ((emacs (27 1)) (lsp-mode (5 0)) (consult (0 16)) (f (0 20 0))) "LSP-mode Consult integration" tar ((:commit . "68583913168bf66fd4d542b2517a2dcab19c447c") (:authors ("Gerry Agbobada")) (:maintainers ("Gerry Agbobada")) (:maintainer "Gerry Agbobada") (:keywords "tools" "completion" "lsp") (:url . "https://github.com/gagbo/consult-lsp"))]) - (consult-notes . [(20240516 1423) ((emacs (27 1)) (consult (0 17)) (s (1 12 0)) (dash (2 19))) "Manage notes with consult" tar ((:commit . "c97420c8e91aaae214be7de897eb7eb9b7843520") (:authors ("Colin McLear" . "mclear@fastmail.com")) (:maintainers ("Colin McLear")) (:maintainer "Colin McLear") (:keywords "convenience") (:url . "https://github.com/mclear-tools/consult-notes"))]) + (consult-notes . [(20240624 1219) ((emacs (27 1)) (consult (0 17)) (s (1 12 0)) (dash (2 19))) "Manage notes with consult" tar ((:commit . "9858bb13b54934ea0a95df45947ff40ffde4553b") (:authors ("Colin McLear" . "mclear@fastmail.com")) (:maintainers ("Colin McLear")) (:maintainer "Colin McLear") (:keywords "convenience") (:url . "https://github.com/mclear-tools/consult-notes"))]) (consult-notmuch . [(20240127 406) ((emacs (26 1)) (consult (0 9)) (notmuch (0 31))) "Notmuch search using consult" tar ((:commit . "d8022e2ddc67ed4e89cc6f5bbe664fdb04e1e815") (:authors ("Jose A Ortega Ruiz" . "jao@gnu.org")) (:maintainers ("Jose A Ortega Ruiz")) (:maintainer "Jose A Ortega Ruiz") (:keywords "mail") (:url . "https://codeberg.org/jao/consult-notmuch"))]) (consult-org-roam . [(20240217 1442) ((emacs (27 1)) (org-roam (2 2 0)) (consult (0 16))) "Consult integration for org-roam" tar ((:commit . "a6dec09dcd06a3014409044399c4f8860ca45ef1") (:authors ("jgru <https://github.com/jgru>")) (:maintainers ("jgru <https://github.com/jgru>")) (:maintainer "jgru <https://github.com/jgru>") (:url . "https://github.com/jgru/consult-org-roam"))]) (consult-project-extra . [(20231221 1857) ((emacs (27 1)) (consult (0 17)) (project (0 8 1))) "Consult integration for project.el" tar ((:commit . "982e8008d69ea6733a2a7548e245d645c0fefb3f") (:authors ("Enrique Kessler Martínez")) (:maintainers ("Enrique Kessler Martínez")) (:maintainer "Enrique Kessler Martínez") (:keywords "convenience" "project" "management") (:url . "https://github.com/Qkessler/consult-project-extra"))]) @@ -1131,7 +1132,7 @@ (dokuwiki-mode . [(20170223 1301) nil "Major mode for DokuWiki document" tar ((:commit . "e4e116f6fcc373e3f5937c1a7daa5c2c9c6d3fa1") (:authors ("Tsunenobu Kai" . "kai2nenobu@gmail.com")) (:maintainers ("Tsunenobu Kai" . "kai2nenobu@gmail.com")) (:maintainer "Tsunenobu Kai" . "kai2nenobu@gmail.com") (:keywords "hypermedia" "text" "dokuwiki") (:url . "https://github.com/kai2nenobu/emacs-dokuwiki-mode"))]) (dollaro . [(20151123 1302) ((s (1 6 0))) "simple text templates" tar ((:commit . "500127f0172ac7a1eec627e026b59136580a74ac") (:authors ("Alessandro Piras" . "laynor@gmail.com")) (:maintainers ("Alessandro Piras" . "laynor@gmail.com")) (:maintainer "Alessandro Piras" . "laynor@gmail.com") (:keywords "tools" "convenience"))]) (doom . [(20180301 2308) ((cl-lib (0 5))) "DOM implementation and manipulation library" tar ((:commit . "e59040aefc92dd9b3134eb623624307fb9e4327b") (:authors ("Alex Schroeder" . "alex@gnu.org") ("Henrik.Motakef" . "elisp@henrik-motakef.de") ("Katherine Whitlock" . "toroidal-code@gmail.com") ("Syohei YOSHIDA" . "syohex@gmail.com")) (:maintainers ("Alex Schroeder")) (:maintainer "Alex Schroeder") (:keywords "xml" "dom") (:url . "http://www.github.com/kensanata/doom.el/"))]) - (doom-modeline . [(20240605 628) ((emacs (25 1)) (compat (29 1 4 5)) (nerd-icons (0 1 0)) (shrink-path (0 3 1))) "A minimal and modern mode-line" tar ((:commit . "11ae6c193cd9cb8d7ff7996058e6df2c0d1e408b") (:authors ("Vincent Zhang" . "seagle0128@gmail.com")) (:maintainers ("Vincent Zhang" . "seagle0128@gmail.com")) (:maintainer "Vincent Zhang" . "seagle0128@gmail.com") (:keywords "faces" "mode-line") (:url . "https://github.com/seagle0128/doom-modeline"))]) + (doom-modeline . [(20240625 230) ((emacs (25 1)) (compat (29 1 4 5)) (nerd-icons (0 1 0)) (shrink-path (0 3 1))) "A minimal and modern mode-line" tar ((:commit . "1505c13564b83e44d3187611e326a48b742cad3a") (:authors ("Vincent Zhang" . "seagle0128@gmail.com")) (:maintainers ("Vincent Zhang" . "seagle0128@gmail.com")) (:maintainer "Vincent Zhang" . "seagle0128@gmail.com") (:keywords "faces" "mode-line") (:url . "https://github.com/seagle0128/doom-modeline"))]) (doom-modeline-now-playing . [(20240522 1704) ((emacs (24 4)) (doom-modeline (3 0 0)) (async (1 9 3))) "Segment for Doom Modeline to show playerctl information" tar ((:commit . "1532f324f98a234aa14e12ebdfd17cebba978d6a") (:authors ("Ellis Kenyő" . "me@elken.dev")) (:maintainers ("Ellis Kenyő" . "me@elken.dev")) (:maintainer "Ellis Kenyő" . "me@elken.dev") (:url . "https://github.com/elken/doom-modeline-now-playing"))]) (doom-themes . [(20240620 225) ((emacs (25 1)) (cl-lib (0 5))) "an opinionated pack of modern color-themes" tar ((:commit . "816fb54d60a7012b9b12cd995831d4226982b487") (:authors ("Henrik Lissner" . "contact@henrik.io")) (:maintainers ("Henrik Lissner" . "contact@henrik.io")) (:maintainer "Henrik Lissner" . "contact@henrik.io") (:keywords "themes" "faces") (:url . "https://github.com/doomemacs/themes"))]) (dot-env . [(20230820 2014) ((emacs (24 4)) (s (1 13 0))) "Dotenv functionality" tar ((:commit . "83ce690e8ef9175fc621c85d5fbef4f7ace7b7a8") (:authors ("Amo DelBello")) (:maintainers ("Amo DelBello")) (:maintainer "Amo DelBello") (:keywords "convenience" "dotenv" "environment" "configuration") (:url . "https://github.com/amodelbello/dot-env.el"))]) @@ -1156,16 +1157,17 @@ (dropbox . [(20220314 1638) ((request (0 3 0)) (json (1 2)) (oauth (1 0 3))) "Emacs backend for dropbox" tar ((:commit . "c048faad0be24e8fa31974f08b710a87cf5b668c") (:authors ("Pavel Panchekha" . "me@pavpanchekha.com")) (:maintainers ("Pavel Panchekha" . "me@pavpanchekha.com")) (:maintainer "Pavel Panchekha" . "me@pavpanchekha.com") (:keywords "dropbox"))]) (drupal-mode . [(20220125 1044) ((php-mode (1 5 0))) "Advanced minor mode for Drupal development" tar ((:commit . "17927723adc5921e8058f7c29e5e50e88b975639") (:authors ("Arne Jørgensen" . "arne@arnested.dk")) (:maintainers ("Arne Jørgensen" . "arne@arnested.dk")) (:maintainer "Arne Jørgensen" . "arne@arnested.dk") (:keywords "programming" "php" "drupal") (:url . "https://github.com/arnested/drupal-mode"))]) (drupal-spell . [(20130520 1655) nil "Aspell extra dictionary for Drupal" tar ((:commit . "a69f5e3b62c4c0da74ce26c1d00d5b8f7395e4ae") (:authors ("Arne Jørgensen" . "arne@arnested.dk")) (:maintainers ("Arne Jørgensen" . "arne@arnested.dk")) (:maintainer "Arne Jørgensen" . "arne@arnested.dk") (:keywords "wp") (:url . "https://github.com/arnested/drupal-spell"))]) + (dslide . [(20240626 125) ((emacs (29 2))) "Domain Specific sLIDEs. A presentation framework" tar ((:commit . "55803bc16a729a1a8ed1e785405feac3cb53878e") (:authors ("Positron" . "contact@positron.solutions")) (:maintainers ("Positron" . "contact@positron.solutions")) (:maintainer "Positron" . "contact@positron.solutions") (:keywords "convenience" "org-mode" "presentation" "narrowing") (:url . "https://github.com/positron-solutions/dslide"))]) (dsvn . [(20221102 1416) nil "Subversion interface" tar ((:commit . "36ecd5219584e46dcf6bd252e2ea1ec517d2fc05") (:authors ("David Kågedal" . "davidk@lysator.liu.se") (" Mattias Engdegård" . "mattiase@acm.org")) (:maintainers ("Mattias Engdegård" . "mattiase@acm.org")) (:maintainer "Mattias Engdegård" . "mattiase@acm.org") (:keywords "docs"))]) (dtb-mode . [(20210105 1132) ((emacs (25))) "Show device tree souce in dtbs" tar ((:commit . "d5bca7d1afaac5615c586b60c7314a1d0e2514dc") (:authors ("Schspa Shi" . "schspa@gmail.com")) (:maintainers ("Schspa Shi" . "schspa@gmail.com")) (:maintainer "Schspa Shi" . "schspa@gmail.com") (:keywords "dtb" "dts" "convenience") (:url . "https://github.com/schspa/dtb-mode"))]) (dtext-mode . [(20231120 1606) ((emacs (24 4))) "Major mode for Danbooru DText" tar ((:commit . "5c68d1c05c4606f68384569d9baaef4f6e72fc73") (:authors ("John Russell" . "johndevlopment7@gmail.com")) (:maintainers ("John Russell" . "johndevlopment7@gmail.com")) (:maintainer "John Russell" . "johndevlopment7@gmail.com") (:keywords "languages") (:url . "https://github.com/JohnDevlopment/dtext-mode.el"))]) (dtk . [(20240317 2328) ((emacs (24 4)) (cl-lib (0 6 1)) (dash (2 12 0)) (seq (1 9)) (s (1 9))) "access SWORD content via diatheke" tar ((:commit . "461f30f2e2038c3c469e710309046c0af4d6b41a") (:authors ("David Thompson")) (:maintainers ("David Thompson")) (:maintainer "David Thompson") (:keywords "hypermedia") (:url . "https://codeberg.org/thomp/dtk"))]) (dtrace-script-mode . [(20150214 623) nil "DTrace code editing commands for Emacs" tar ((:commit . "a92f76c65b9fb64d448e503b4ea7ff06085be8ee"))]) - (dtrt-indent . [(20240616 1053) nil "Adapt to foreign indentation offsets" tar ((:commit . "939c5e374ac0175bb7d561542e22e47a72d04aa8") (:authors ("Julian Scheid" . "julians37@googlemail.com")) (:maintainers ("Reuben Thomas" . "rrt@sc3d.org")) (:maintainer "Reuben Thomas" . "rrt@sc3d.org") (:keywords "convenience" "files" "languages" "c"))]) + (dtrt-indent . [(20240623 2118) nil "Adapt to foreign indentation offsets" tar ((:commit . "339755e4fb5245862737babf7f2c1e3bae1c129c") (:authors ("Julian Scheid" . "julians37@googlemail.com")) (:maintainers ("Reuben Thomas" . "rrt@sc3d.org")) (:maintainer "Reuben Thomas" . "rrt@sc3d.org") (:keywords "convenience" "files" "languages" "c"))]) (dts-mode . [(20211202 18) nil "Major mode for Devicetree source code" tar ((:commit . "32517e7eeeccc785b7c669fd5e93c5df45597ef1") (:authors ("Ben Gamari" . "ben@smart-cactus.org")) (:maintainers ("Ben Gamari" . "ben@smart-cactus.org")) (:maintainer "Ben Gamari" . "ben@smart-cactus.org") (:keywords "languages"))]) (ducpel . [(20140702 1154) ((cl-lib (0 5))) "Logic game with sokoban elements" tar ((:commit . "2f2ce2df269d99261c808a5c4ebc00d6d2cddabc") (:authors ("Alex Kost" . "alezost@gmail.com")) (:maintainers ("Alex Kost" . "alezost@gmail.com")) (:maintainer "Alex Kost" . "alezost@gmail.com") (:keywords "games") (:url . "https://github.com/alezost/ducpel"))]) (dumb-diff . [(20171211 2122) ((emacs (24 3))) "fast arbitrary diffs" tar ((:commit . "1a2331d283049b71a07c1b06b1e0627a950d55f4") (:authors ("jack angers")) (:maintainers ("jack angers")) (:maintainer "jack angers") (:keywords "programming" "diff"))]) - (dumb-jump . [(20240514 702) ((emacs (24 3)) (s (1 11 0)) (dash (2 9 0)) (popup (0 5 3))) "Jump to definition for 50+ languages without configuration" tar ((:commit . "3c2ab8dfff3a10d3c5f2efd69cfbc81fb5dbbd39") (:authors ("jack angers and contributors")) (:maintainers ("jack angers and contributors")) (:maintainer "jack angers and contributors") (:keywords "programming") (:url . "https://github.com/jacktasia/dumb-jump"))]) + (dumb-jump . [(20240625 224) ((emacs (24 3)) (s (1 11 0)) (dash (2 9 0)) (popup (0 5 3))) "Jump to definition for 50+ languages without configuration" tar ((:commit . "cd65a743370ac7b1a12e9ef0a7371b285a2597fb") (:authors ("jack angers and contributors")) (:maintainers ("jack angers and contributors")) (:maintainer "jack angers and contributors") (:keywords "programming") (:url . "https://github.com/jacktasia/dumb-jump"))]) (dummyparens . [(20141009 1024) nil "parenthesis auto-pairing and wrapping" tar ((:commit . "9798ef1d0eaa24e4fe66f8aa6022a8c62714cc89") (:authors ("Sergei Nosov <sergei.nosov [at] gmail.com>")) (:maintainers ("Sergei Nosov <sergei.nosov [at] gmail.com>")) (:maintainer "Sergei Nosov <sergei.nosov [at] gmail.com>") (:keywords "dummyparens" "auto-pair" "wrapping") (:url . "https://github.com/snosov1/dummyparens"))]) (dune . [(20240427 1346) nil "Integration with the dune build system" tar ((:commit . "5554158af27ead066fbb3c009e780c930958613c") (:url . "https://github.com/ocaml/dune"))]) (dune-format . [(20210505 108) ((reformatter (0 6)) (emacs (24 1))) "Reformat OCaml's dune files automatically" tar ((:commit . "eda7a16ae378e7c482c11228c43ef32b893a1520") (:authors ("Steve Purcell" . "steve@sanityinc.com")) (:maintainers ("Steve Purcell" . "steve@sanityinc.com")) (:maintainer "Steve Purcell" . "steve@sanityinc.com") (:keywords "languages") (:url . "https://github.com/purcell/emacs-dune-format"))]) @@ -1173,7 +1175,7 @@ (duplicate-thing . [(20181031 1500) nil "Duplicate current line & selection" tar ((:commit . "9d8fd05e3e5caa35d3f2a0c0032c92f0c0908e21") (:authors ("ongaeshi")) (:maintainers ("ongaeshi")) (:maintainer "ongaeshi") (:keywords "convenience" "command" "duplicate" "line" "selection") (:url . "https://github.com/ongaeshi/duplicate-thing"))]) (dut-mode . [(20170729 2111) ((emacs (24))) "Major mode for the Dut programming language" tar ((:commit . "9235c7acaa6690942e9de8b7acd1e4be0c859dc1") (:authors ("The dut-mode Authors")) (:maintainers ("The dut-mode Authors")) (:maintainer "The dut-mode Authors") (:keywords "languages" "gut") (:url . "https://github.com/dut-lang/dut-mode"))]) (dw . [(20210331 2311) ((emacs (25 1))) "Diceware passphrase generation commands" tar ((:commit . "61c5718ba64ace4c9e29de18aa2690ecc3f0f258") (:authors ("D. Williams" . "d.williams@posteo.net")) (:maintainers ("D. Williams" . "d.williams@posteo.net")) (:maintainer "D. Williams" . "d.williams@posteo.net") (:keywords "convenience" "games") (:url . "https://github.com/integral-dw/dw-passphrase-generator"))]) - (dwim-coder-mode . [(20230830 1215) ((emacs (29))) "DWIM keybindings for C, Python, Rust, and more" tar ((:commit . "94a752fca078144dd309343880abafbc4eacca5f") (:authors ("Mohammed Sadiq" . "sadiq@sadiqpk.org")) (:maintainers ("Mohammed Sadiq" . "sadiq@sadiqpk.org")) (:maintainer "Mohammed Sadiq" . "sadiq@sadiqpk.org") (:keywords "convenience" "hacks") (:url . "https://sadiqpk.org/projects/dwim-coder-mode.html"))]) + (dwim-coder-mode . [(20240623 1024) ((emacs (29))) "DWIM keybindings for C, Python, Rust, and more" tar ((:commit . "431b34922f1489dbc1ab89cc14e0d14372da725e") (:authors ("Mohammed Sadiq" . "sadiq@sadiqpk.org")) (:maintainers ("Mohammed Sadiq" . "sadiq@sadiqpk.org")) (:maintainer "Mohammed Sadiq" . "sadiq@sadiqpk.org") (:keywords "convenience" "hacks") (:url . "https://sadiqpk.org/projects/dwim-coder-mode.html"))]) (dwim-shell-command . [(20240526 2142) ((emacs (28 1))) "Shell commands with DWIM behaviour" tar ((:commit . "a1f34ba0f9ccb76673f6551f0c5e06a24ca9aa2a") (:authors ("Alvaro Ramirez")) (:maintainers ("Alvaro Ramirez")) (:maintainer "Alvaro Ramirez") (:url . "https://github.com/xenodium/dwim-shell-command"))]) (dyalog-mode . [(20230214 1027) ((cl-lib (0 2)) (emacs (24 3))) "Major mode for editing Dyalog APL source code" tar ((:commit . "13c0d391aa878a1609259a89fe3e6db8d21935e8") (:authors ("Joakim Hårsman" . "joakim.harsman@gmail.com")) (:maintainers ("Joakim Hårsman" . "joakim.harsman@gmail.com")) (:maintainer "Joakim Hårsman" . "joakim.harsman@gmail.com") (:keywords "languages") (:url . "https://github.com/harsman/dyalog-mode.git"))]) (dylan . [(20220115 1804) ((emacs (25 1))) "Dylan editing modes" tar ((:commit . "9d2891e3e06405b75072d296f385fa795aeb9835") (:url . "https://opendylan.org/"))]) @@ -1252,7 +1254,7 @@ (eglot-java . [(20240501 922) ((emacs (26 1)) (eglot (1 0)) (jsonrpc (1 0 0))) "Java extension for the eglot LSP client" tar ((:commit . "492282d653c91b07ec10b30eb8a05cbfdc4017c7") (:authors ("Yves Zoundi" . "yves_zoundi@hotmail.com")) (:maintainers ("Yves Zoundi" . "yves_zoundi@hotmail.com")) (:maintainer "Yves Zoundi" . "yves_zoundi@hotmail.com") (:keywords "convenience" "languages") (:url . "https://github.com/yveszoundi/eglot-java"))]) (eglot-jl . [(20240318 1159) ((emacs (25 1)) (eglot (1 4)) (project (0 8 1)) (cl-generic (1 0))) "Julia support for eglot" tar ((:commit . "1d9cab682380f37ca1e9e9933cda13164600706d") (:authors ("Adam Beckmeyer" . "adam_git@thebeckmeyers.xyz")) (:maintainers ("Adam Beckmeyer" . "adam_git@thebeckmeyers.xyz")) (:maintainer "Adam Beckmeyer" . "adam_git@thebeckmeyers.xyz") (:keywords "convenience" "languages") (:url . "https://github.com/non-Jedi/eglot-jl"))]) (eglot-luau . [(20240401 2209) ((emacs (29 1))) "Luau language server integration for eglot" tar ((:commit . "3926860036402cce4a55faec534b88c0bf6006fd") (:authors ("Kenneth Loeffler" . "kenloef@gmail.com")) (:maintainers ("Kenneth Loeffler" . "kenloef@gmail.com")) (:maintainer "Kenneth Loeffler" . "kenloef@gmail.com") (:keywords "roblox" "luau" "tools") (:url . "https://github.com/kennethloeffler/eglot-luau"))]) - (eglot-signature-eldoc-talkative . [(20240424 801) ((emacs (29 1)) (eglot (1 16)) (eldoc (1 14 0)) (jsonrpc (1 0 23))) "Make Eglot make ElDoc echo docs" tar ((:commit . "859aa6f2c0acf060a8e7549b79daf46c8d63ea8d") (:authors ("João Távora" . "joaotavora@gmail.com") ("Mekeor Melire" . "mekeor@posteo.de")) (:maintainers ("Mekeor Melire" . "mekeor@posteo.de")) (:maintainer "Mekeor Melire" . "mekeor@posteo.de") (:keywords "convenience" "documentation" "eglot" "eldoc" "languages" "lsp") (:url . "https://codeberg.org/mekeor/emacs-eglot-signature-eldoc-talkative"))]) + (eglot-signature-eldoc-talkative . [(20240626 815) ((emacs (29 1)) (eglot (1 16)) (eldoc (1 14 0)) (jsonrpc (1 0 23))) "Make Eglot make ElDoc echo docs" tar ((:commit . "34cc207265f26f13142f5c62276e0ba18e1d55e4") (:authors ("João Távora" . "joaotavora@gmail.com") ("Mekeor Melire" . "mekeor@posteo.de")) (:maintainers ("Mekeor Melire" . "mekeor@posteo.de")) (:maintainer "Mekeor Melire" . "mekeor@posteo.de") (:keywords "convenience" "documentation" "eglot" "eldoc" "languages" "lsp") (:url . "https://codeberg.org/mekeor/eglot-signature-eldoc-talkative"))]) (eglot-tempel . [(20230626 1004) ((eglot (1 9)) (tempel (0 5)) (emacs (24 4))) "Use eglot as inline template expander" tar ((:commit . "70fee6ac33df7a6c5cce967005766b6702a9e9a5") (:authors ("Jeff Walsh" . "fejfighter@gmail.com")) (:maintainers ("Jeff Walsh" . "fejfighter@gmail.com")) (:maintainer "Jeff Walsh" . "fejfighter@gmail.com") (:keywords "convenience" "languages" "tools") (:url . "https://github.com/fejfighter/eglot-tempel"))]) (ego . [(20200803 1101) ((emacs (24 5)) (ht (1 5)) (mustache (0 22)) (htmlize (1 47)) (org (8 0)) (dash (2 0 0))) "a static site generator based on org mode, forked from org-page." tar ((:commit . "211c4cb2af2582849d9df984fb2346deecaf79be") (:authors ("Feng Shu <tumashu AT 163.com>") ("Kelvin Hu <ini DOT kelvin AT gmail DOT com>") ("Kuangdash <kuangdash AT 163.com>")) (:maintainer "Feng Shu <tumashu AT 163.com>") (:keywords "org-mode" "convenience" "beautify") (:url . "https://github.com/emacs-china/EGO"))]) (eide . [(20240122 1953) ((emacs (26 1))) "IDE interface" tar ((:commit . "d497539f00c33e3bee85d0f4b8ca367672fa2219") (:authors ("Cédric Marie" . "cedric@hjuvi.fr.eu.org")) (:maintainer "Cédric Marie" . "cedric@hjuvi.fr.eu.org") (:url . "https://software.hjuvi.fr.eu.org/eide/"))]) @@ -1333,7 +1335,7 @@ (elixir-mode . [(20230626 1738) ((emacs (25))) "Major mode for editing Elixir files" tar ((:commit . "00d6580a040a750e019218f9392cf9a4c2dac23a") (:keywords "languages" "elixir") (:url . "https://github.com/elixir-editors/emacs-elixir"))]) (elixir-ts-mode . [(20240116 645) ((emacs (29 1)) (heex-ts-mode (1 3))) "Major mode for Elixir with tree-sitter support" tar ((:commit . "6db05baed9a34d01edf0bfdd804d951dedc6dccb") (:authors ("Wilhelm H Kirschbaum")) (:maintainers ("Wilhelm H Kirschbaum")) (:maintainer "Wilhelm H Kirschbaum") (:keywords "elixir" "languages" "tree-sitter") (:url . "https://github.com/wkirschbaum/elixir-ts-mode"))]) (elixir-yasnippets . [(20150417 1239) ((yasnippet (0 8 0))) "Yasnippets for Elixir" tar ((:commit . "980ca7626c14ef0573bec0035ec7942796062783") (:authors ("Yinghai Zhao" . "zyinghai@gmail.com")) (:maintainer "Yinghai Zhao" . "zyinghai@gmail.com") (:keywords "snippets"))]) - (ellama . [(20240609 1231) ((emacs (28 1)) (llm (0 6 0)) (spinner (1 7 4))) "Tool for interacting with LLMs" tar ((:commit . "3d6192ea09cfbd2e3d3e13dcada5f543bd79b968") (:authors ("Sergey Kostyaev" . "sskostyaev@gmail.com")) (:maintainers ("Sergey Kostyaev" . "sskostyaev@gmail.com")) (:maintainer "Sergey Kostyaev" . "sskostyaev@gmail.com") (:keywords "help" "local" "tools") (:url . "http://github.com/s-kostyaev/ellama"))]) + (ellama . [(20240626 632) ((emacs (28 1)) (llm (0 6 0)) (spinner (1 7 4))) "Tool for interacting with LLMs" tar ((:commit . "968b8631d102c7fd051dbe9eb077755964bb47a2") (:authors ("Sergey Kostyaev" . "sskostyaev@gmail.com")) (:maintainers ("Sergey Kostyaev" . "sskostyaev@gmail.com")) (:maintainer "Sergey Kostyaev" . "sskostyaev@gmail.com") (:keywords "help" "local" "tools") (:url . "http://github.com/s-kostyaev/ellama"))]) (ellocate . [(20200112 1931) ((emacs (25 1)) (s (1 12 0)) (f (0 20 0))) "The locate command reimplemented in Emacs Lisp" tar ((:commit . "81405082f68f0577c9f176d3d4f034a7142aba59") (:authors ("Sebastian Wålinder" . "s.walinder@gmail.com")) (:maintainers ("Sebastian Wålinder" . "s.walinder@gmail.com")) (:maintainer "Sebastian Wålinder" . "s.walinder@gmail.com") (:keywords "matching") (:url . "https://github.com/walseb/ellocate"))]) (elm-mode . [(20230315 1122) ((f (0 17)) (s (1 7 0)) (emacs (25 1)) (seq (2 23)) (reformatter (0 3))) "Major mode for Elm" tar ((:commit . "699841865e1bd5b7f2077baa7121510b6bcad3c7") (:authors ("Joseph Collard")) (:maintainers ("Joseph Collard")) (:maintainer "Joseph Collard") (:url . "https://github.com/jcollard/elm-mode"))]) (elm-test-runner . [(20230905 331) ((emacs (24 4))) "Enhanced support for running elm-test" tar ((:commit . "b664e50a4c849f5f2e2f434fc01718da10515612") (:authors ("Juan Edi")) (:maintainers ("Juan Edi")) (:maintainer "Juan Edi") (:url . "https://github.com/juanedi/elm-test-runner"))]) @@ -1365,15 +1367,15 @@ (elune-theme . [(20231009 1709) nil "Elune theme" tar ((:commit . "4d0217a7601e34fa84fc174ccf7945cd598d4135") (:authors ("Çağan Korkmaz" . "xcatalystt@gmail.com")) (:maintainers ("Çağan Korkmaz" . "xcatalystt@gmail.com")) (:maintainer "Çağan Korkmaz" . "xcatalystt@gmail.com") (:url . "https://github.com/xcatalyst/elune-theme"))]) (elvish-mode . [(20180809 1612) ((emacs (24 3))) "Defines a major mode for Elvish" tar ((:commit . "c3a7e31564256b9755b1ab9fb40d32ad78cd1ad2") (:authors ("Adam Schwalm" . "adamschwalm@gmail.com")) (:maintainers ("Adam Schwalm" . "adamschwalm@gmail.com")) (:maintainer "Adam Schwalm" . "adamschwalm@gmail.com") (:url . "https://github.com/ALSchwalm/elvish-mode"))]) (elwm . [(20150817 1007) ((dash (1 1 0))) "Minimalistic window manager for emacs" tar ((:commit . "c33b183f006ad476c3a44dab316f580f8b369930") (:authors ("Matus Goljer" . "matus.goljer@gmail.com")) (:maintainers ("Matus Goljer" . "matus.goljer@gmail.com")) (:maintainer "Matus Goljer" . "matus.goljer@gmail.com") (:keywords "docs") (:url . "https://github.com/Fuco1/elwm"))]) - (elx . [(20240618 1556) ((emacs (25 1)) (compat (29 1 4 5)) (llama (0 3 1))) "Extract information from Emacs Lisp libraries" tar ((:commit . "ff711c1bcd8b22459d58d263ef5eb18b4174710f") (:authors ("Jonas Bernoulli" . "emacs.elx@jonas.bernoulli.dev")) (:maintainers ("Jonas Bernoulli" . "emacs.elx@jonas.bernoulli.dev")) (:maintainer "Jonas Bernoulli" . "emacs.elx@jonas.bernoulli.dev") (:keywords "docs" "libraries" "packages") (:url . "https://github.com/emacscollective/elx"))]) + (elx . [(20240623 1338) ((emacs (25 1)) (compat (29 1 4 5)) (llama (0 3 1))) "Extract information from Emacs Lisp libraries" tar ((:commit . "b03b3db6bb6043c9e7f8478c421e1a2bc7a1fc06") (:authors ("Jonas Bernoulli" . "emacs.elx@jonas.bernoulli.dev")) (:maintainers ("Jonas Bernoulli" . "emacs.elx@jonas.bernoulli.dev")) (:maintainer "Jonas Bernoulli" . "emacs.elx@jonas.bernoulli.dev") (:keywords "docs" "libraries" "packages") (:url . "https://github.com/emacscollective/elx"))]) (emacs-everywhere . [(20240509 1715) ((emacs (26 3))) "System-wide popup windows for quick edits" tar ((:commit . "0b731ca6da351ba40953d090acf69e81757d437b") (:authors ("TEC <https://github.com/tecosaur>")) (:maintainers ("TEC" . "contact@tecosaur.net")) (:maintainer "TEC" . "contact@tecosaur.net") (:keywords "convenience" "frames") (:url . "https://github.com/tecosaur/emacs-everywhere"))]) (emacsc . [(20240104 634) nil "helper for emacsc(1)" tar ((:commit . "9bec453a4170dbcb409b884e3e8d30f388de7b8d") (:authors ("Akinori MUSHA" . "knu@iDaemons.org")) (:maintainers ("Akinori MUSHA" . "knu@iDaemons.org")) (:maintainer "Akinori MUSHA" . "knu@iDaemons.org") (:keywords "tools") (:url . "https://github.com/knu/emacsc"))]) (emacsist-view . [(20160426 1223) nil "Mode for viewing emacsist.com" tar ((:commit . "f67761259ed779a9bc95c9a4e0474522990c5c6b") (:authors ("DarkSun" . "lujun9972@gmail.com")) (:maintainers ("DarkSun" . "lujun9972@gmail.com")) (:maintainer "DarkSun" . "lujun9972@gmail.com") (:keywords "convenience" "usability") (:url . "https://github.com/lujun9972/emacsist-view"))]) - (emacsql . [(20240611 2032) ((emacs (25 1))) "High-level SQL database front-end" tar ((:commit . "601b3a5f6bdaf5b7c7c5889053b8191bcc89a8ff") (:authors ("Christopher Wellons" . "wellons@nullprogram.com")) (:maintainers ("Jonas Bernoulli" . "emacs.emacsql@jonas.bernoulli.dev")) (:maintainer "Jonas Bernoulli" . "emacs.emacsql@jonas.bernoulli.dev") (:url . "https://github.com/magit/emacsql"))]) + (emacsql . [(20240623 1340) ((emacs (25 1))) "High-level SQL database front-end" tar ((:commit . "efddd69c5e69214dbbe921fbf90f938501414894") (:authors ("Christopher Wellons" . "wellons@nullprogram.com")) (:maintainers ("Jonas Bernoulli" . "emacs.emacsql@jonas.bernoulli.dev")) (:maintainer "Jonas Bernoulli" . "emacs.emacsql@jonas.bernoulli.dev") (:url . "https://github.com/magit/emacsql"))]) (emacsql-mysql . [(20240415 1535) ((emacs (25 1)) (emacsql (20230220))) "EmacSQL back-end for MySQL" tar ((:commit . "5108c16c5e1d5bfdd41fcc0807241e28886ab763") (:authors ("Christopher Wellons" . "wellons@nullprogram.com")) (:maintainers ("Jonas Bernoulli" . "emacs.emacsql@jonas.bernoulli.dev")) (:maintainer "Jonas Bernoulli" . "emacs.emacsql@jonas.bernoulli.dev") (:url . "https://github.com/magit/emacsql"))]) (emacsql-pg . [(20240415 1535) ((emacs (25 1)) (emacsql (20230220)) (pg (0 16))) "EmacSQL back-end for PostgreSQL via pg" tar ((:commit . "5108c16c5e1d5bfdd41fcc0807241e28886ab763") (:authors ("Christopher Wellons" . "wellons@nullprogram.com")) (:maintainers ("Jonas Bernoulli" . "emacs.emacsql@jonas.bernoulli.dev")) (:maintainer "Jonas Bernoulli" . "emacs.emacsql@jonas.bernoulli.dev") (:url . "https://github.com/magit/emacsql"))]) (emacsql-psql . [(20240415 1535) ((emacs (25 1)) (emacsql (20230220))) "EmacSQL back-end for PostgreSQL via psql" tar ((:commit . "5108c16c5e1d5bfdd41fcc0807241e28886ab763") (:authors ("Christopher Wellons" . "wellons@nullprogram.com")) (:maintainers ("Jonas Bernoulli" . "emacs.emacsql@jonas.bernoulli.dev")) (:maintainer "Jonas Bernoulli" . "emacs.emacsql@jonas.bernoulli.dev") (:url . "https://github.com/magit/emacsql"))]) - (emacsql-sqlite . [(20240415 1535) ((emacs (25 1)) (emacsql (20230220))) "EmacSQL back-end for SQLite" tar ((:commit . "5108c16c5e1d5bfdd41fcc0807241e28886ab763") (:authors ("Christopher Wellons" . "wellons@nullprogram.com")) (:maintainers ("Jonas Bernoulli" . "emacs.emacsql@jonas.bernoulli.dev")) (:maintainer "Jonas Bernoulli" . "emacs.emacsql@jonas.bernoulli.dev") (:url . "https://github.com/magit/emacsql"))]) + (emacsql-sqlite . [(20240623 1340) ((emacs (25 1)) (emacsql (20230220))) "EmacSQL back-end for SQLite" tar ((:commit . "efddd69c5e69214dbbe921fbf90f938501414894") (:authors ("Christopher Wellons" . "wellons@nullprogram.com")) (:maintainers ("Jonas Bernoulli" . "emacs.emacsql@jonas.bernoulli.dev")) (:maintainer "Jonas Bernoulli" . "emacs.emacsql@jonas.bernoulli.dev") (:url . "https://github.com/magit/emacsql"))]) (emacsql-sqlite-builtin . [(20240415 1535) ((emacs (29)) (emacsql (20230220))) "EmacSQL back-end for SQLite using builtin support" tar ((:commit . "5108c16c5e1d5bfdd41fcc0807241e28886ab763") (:authors ("Jonas Bernoulli" . "emacs.emacsql@jonas.bernoulli.dev")) (:maintainers ("Jonas Bernoulli" . "emacs.emacsql@jonas.bernoulli.dev")) (:maintainer "Jonas Bernoulli" . "emacs.emacsql@jonas.bernoulli.dev") (:url . "https://github.com/magit/emacsql"))]) (emacsql-sqlite-module . [(20240415 1535) ((emacs (25)) (emacsql (20230220)) (sqlite3 (0 16))) "EmacSQL back-end for SQLite using a module" tar ((:commit . "5108c16c5e1d5bfdd41fcc0807241e28886ab763") (:authors ("Jonas Bernoulli" . "emacs.emacsql@jonas.bernoulli.dev")) (:maintainers ("Jonas Bernoulli" . "emacs.emacsql@jonas.bernoulli.dev")) (:maintainer "Jonas Bernoulli" . "emacs.emacsql@jonas.bernoulli.dev") (:url . "https://github.com/magit/emacsql"))]) (emacsshot . [(20191206 944) ((emacs (24 4))) "Snapshot a frame or window from within" tar ((:commit . "fe958b11056f3c671ebdd604d5aa574323284ca5") (:authors ("Marco Wahl" . "marcowahlsoft@gmail.com")) (:maintainers ("Marco Wahl")) (:maintainer "Marco Wahl") (:keywords "convenience") (:url . "https://gitlab.com/marcowahl/emacsshot"))]) @@ -1523,6 +1525,7 @@ (evalator . [(20160213 128) ((helm-core (1 9 1))) "Package for interactive transformation of data with helm" tar ((:commit . "f30da4da48c0b3f3cfa1fc1c7cfdb53ffe79df36") (:authors ("Sean Irby")) (:maintainers ("Sean Irby" . "sean.t.irby@gmail.com")) (:maintainer "Sean Irby" . "sean.t.irby@gmail.com") (:keywords "languages" "elisp" "helm") (:url . "http://www.github.com/seanirby/evalator"))]) (evalator-clojure . [(20160208 2148) ((cider (0 10 0)) (evalator (1 0 0))) "Clojure evaluation context for evalator via CIDER." tar ((:commit . "caa4e0a137bdfada86593128a654e16aa617ad50") (:authors ("Sean Irby")) (:maintainers ("Sean Irby" . "sean.t.irby@gmail.com")) (:maintainer "Sean Irby" . "sean.t.irby@gmail.com") (:keywords "languages" "clojure" "cider" "helm") (:url . "http://www.github.com/seanirby/evalator-clojure"))]) (eve-mode . [(20170822 2231) ((emacs (25)) (polymode (1 0)) (markdown-mode (2 0))) "Major mode for editing Eve documents." tar ((:commit . "a4661114d9c18725691b76321d72167ca5a9070a") (:authors ("Joshua Cole" . "joshuafcole@gmail.com")) (:maintainers ("Joshua Cole" . "joshuafcole@gmail.com")) (:maintainer "Joshua Cole" . "joshuafcole@gmail.com") (:keywords "languages" "wp" "tools") (:url . "https://github.com/witheve/emacs-eve-mode"))]) + (evenok . [(20240626 757) ((emacs (28 1))) "Themes with perceptively evenly distributed colors" tar ((:commit . "80ba81d380fe2cf953c27d228686851245d8e4b6") (:authors ("Mekeor Melire" . "mekeor@posteo.de")) (:maintainers ("Mekeor Melire" . "mekeor@posteo.de")) (:maintainer "Mekeor Melire" . "mekeor@posteo.de") (:keywords "faces" "theme") (:url . "https://codeberg.org/mekeor/evenok"))]) (everlasting-scratch . [(20240612 814) ((emacs (25 1))) "The *scratch* that lasts forever" tar ((:commit . "fa1b2af29e8bb463400bbea912ab4dfaa2b0c890") (:authors ("Huming Chen" . "chenhuming@gmail.com")) (:maintainers ("Huming Chen" . "chenhuming@gmail.com")) (:maintainer "Huming Chen" . "chenhuming@gmail.com") (:keywords "convenience" "tool") (:url . "https://github.com/beacoder/everlasting-scratch"))]) (evil . [(20240619 1337) ((emacs (24 1)) (goto-chg (1 6)) (cl-lib (0 5))) "Extensible vi layer" tar ((:commit . "0ad84c52169068021ec3372bf52503631f2261de") (:maintainer "Tom Dalziel" . "tom.dalziel@gmail.com") (:keywords "emulations") (:url . "https://github.com/emacs-evil/evil"))]) (evil-anzu . [(20220911 1939) ((evil (1 0 0)) (anzu (0 46))) "anzu for evil-mode" tar ((:commit . "d1e98ee6976437164627542909a25c6946497899") (:authors ("Syohei YOSHIDA" . "syohex@gmail.com") ("Fredrik Bergroth" . "fbergroth@gmail.com")) (:maintainers ("Syohei YOSHIDA" . "syohex@gmail.com")) (:maintainer "Syohei YOSHIDA" . "syohex@gmail.com") (:url . "https://github.com/syohex/emacs-evil-anzu"))]) @@ -1866,7 +1869,7 @@ (flymake-cursor . [(20220506 1458) ((flymake (0 3))) "Show flymake messages in the minibuffer after delay" tar ((:commit . "95806594cacddbbc0c3aa2351a6a7cf28e73a8bf") (:authors ("Unknown Original Author") ("Dino Chiesa" . "dpchiesa@hotmail.com") ("Sam Graham <libflymake-emacs BLAHBLAH illusori.co.uk>")) (:maintainers ("Sam Graham <libflymake-emacs BLAHBLAH illusori.co.uk>")) (:maintainer "Sam Graham <libflymake-emacs BLAHBLAH illusori.co.uk>") (:keywords "languages" "mode" "flymake") (:url . "https://github.com/flymake/emacs-flymake-cursor"))]) (flymake-diagnostic-at-point . [(20180815 1004) ((emacs (26 1)) (popup (0 5 3))) "Display flymake diagnostics at point" tar ((:commit . "379616b1c6f5ebeaf08fbe54ae765008a78b3be7") (:authors ("Ricardo Martins" . "ricardo@scarybox.net")) (:maintainers ("Ricardo Martins" . "ricardo@scarybox.net")) (:maintainer "Ricardo Martins" . "ricardo@scarybox.net") (:keywords "convenience" "languages" "tools") (:url . "https://github.com/meqif/flymake-diagnostic-at-point"))]) (flymake-eask . [(20240223 1022) ((emacs (26 1)) (flymake-easy (0 1))) "Eask support in Flymake" tar ((:commit . "0e83cec77aab54365ef8d604151888bb1f61049c") (:authors ("Shen, Jen-Chieh" . "jcs090218@gmail.com")) (:maintainers ("Shen, Jen-Chieh" . "jcs090218@gmail.com")) (:maintainer "Shen, Jen-Chieh" . "jcs090218@gmail.com") (:keywords "lisp" "eask") (:url . "https://github.com/flymake/flymake-eask"))]) - (flymake-easy . [(20141022 1828) nil "Helpers for easily building flymake checkers" tar ((:commit . "2a24f260cdc3b9c8f9263b653a475d90efa1d392") (:authors ("Steve Purcell" . "steve@sanityinc.com")) (:maintainers ("Steve Purcell" . "steve@sanityinc.com")) (:maintainer "Steve Purcell" . "steve@sanityinc.com") (:keywords "convenience" "internal") (:url . "https://github.com/purcell/flymake-easy"))]) + (flymake-easy . [(20240624 1702) nil "Helpers for easily building flymake checkers" tar ((:commit . "1986500f75ea06f006ab1734abcce441117d385d") (:authors ("Steve Purcell" . "steve@sanityinc.com")) (:maintainers ("Steve Purcell" . "steve@sanityinc.com")) (:maintainer "Steve Purcell" . "steve@sanityinc.com") (:keywords "convenience" "internal") (:url . "https://github.com/purcell/flymake-easy"))]) (flymake-eldev . [(20240419 2023) ((dash (2 17)) (emacs (28 1))) "Eldev support in Flymake" tar ((:commit . "d8f4d9da115002afd3785b777cd59a49d170e04a") (:authors ("Paul Pogonyshev" . "pogonyshev@gmail.com")) (:maintainers ("Paul Pogonyshev" . "pogonyshev@gmail.com")) (:maintainer "Paul Pogonyshev" . "pogonyshev@gmail.com") (:keywords "tools" "convenience") (:url . "https://github.com/emacs-eldev/flymake-eldev"))]) (flymake-elisp-config . [(20230711 1833) ((emacs (28 1))) "Setup load-path for flymake on Emacs Lisp mode" tar ((:commit . "3607b1ee738141f67ae803b4daadd4e2906ff324") (:authors ("ROCKTAKEY" . "rocktakey@gmail.com")) (:maintainers ("ROCKTAKEY" . "rocktakey@gmail.com")) (:maintainer "ROCKTAKEY" . "rocktakey@gmail.com") (:keywords "lisp") (:url . "https://github.com/ROCKTAKEY/flymake-elisp-config"))]) (flymake-elixir . [(20130810 1417) nil "A flymake handler for elixir-mode .ex files." tar ((:commit . "3810566cffe35d04cc3f01e27fe397d68d52f802") (:authors ("Sylvain Benner" . "syl20bnr@gmail.com")) (:maintainers ("Sylvain Benner" . "syl20bnr@gmail.com")) (:maintainer "Sylvain Benner" . "syl20bnr@gmail.com"))]) @@ -1949,7 +1952,7 @@ (foreign-regexp . [(20200325 50) nil "search and replace by foreign regexp." tar ((:commit . "e2dd47f2160cadc194eb156e7c76c3c869e6706e") (:authors ("K-talo Miyazaki <Keitaro dot Miyazaki at gmail dot com>")) (:maintainers ("K-talo Miyazaki <Keitaro dot Miyazaki at gmail dot com>")) (:maintainer "K-talo Miyazaki <Keitaro dot Miyazaki at gmail dot com>") (:keywords "convenience" "emulations" "matching" "tools" "unix" "wp"))]) (foreman-mode . [(20170725 1422) ((s (1 9 0)) (dash (2 10 0)) (dash-functional (1 2 0)) (f (0 17 2)) (emacs (24))) "View and manage Procfile-based applications" tar ((:commit . "22b3bb13134b617870ed1e888af739f4818be929") (:authors ("ZHOU Feng" . "zf.pascal@gmail.com")) (:maintainers ("ZHOU Feng" . "zf.pascal@gmail.com")) (:maintainer "ZHOU Feng" . "zf.pascal@gmail.com") (:keywords "foreman") (:url . "http://github.com/zweifisch/foreman-mode"))]) (forest-blue-theme . [(20160627 842) ((emacs (24))) "Emacs theme with a dark background." tar ((:commit . "58096ce1a25615d2bae806c3775bae3e2775019d") (:authors ("olkinn")) (:maintainers ("olkinn")) (:maintainer "olkinn"))]) - (forge . [(20240621 1920) ((emacs (26 3)) (compat (29 1 4 5)) (closql (20240405)) (dash (2 19 1)) (emacsql (20240124)) (ghub (20240507)) (let-alist (1 0 6)) (magit (20240428)) (markdown-mode (2 6)) (seq (2 24)) (transient (20240421)) (yaml (0 5 5))) "Access Git forges from Magit." tar ((:commit . "f8a7e8a678c2e379aff91596a05a49678a3ebd84") (:authors ("Jonas Bernoulli" . "emacs.forge@jonas.bernoulli.dev")) (:maintainer "Jonas Bernoulli" . "emacs.forge@jonas.bernoulli.dev") (:keywords "git" "tools" "vc") (:url . "https://github.com/magit/forge"))]) + (forge . [(20240623 1337) ((emacs (26 3)) (compat (29 1 4 5)) (closql (20240405)) (dash (2 19 1)) (emacsql (20240124)) (ghub (20240507)) (let-alist (1 0 6)) (magit (20240428)) (markdown-mode (2 6)) (seq (2 24)) (transient (20240421)) (yaml (0 5 5))) "Access Git forges from Magit." tar ((:commit . "1e144bdecd9bded03c69e760a6b1ff84e1e76256") (:authors ("Jonas Bernoulli" . "emacs.forge@jonas.bernoulli.dev")) (:maintainer "Jonas Bernoulli" . "emacs.forge@jonas.bernoulli.dev") (:keywords "git" "tools" "vc") (:url . "https://github.com/magit/forge"))]) (form-feed . [(20210508 1627) ((emacs (24 1))) "Display ^L glyphs as horizontal lines" tar ((:commit . "ac1f0ef30a11979f5dfe12d8c05a666739e486ff") (:authors ("Vasilij Schneidermann" . "mail@vasilij.de")) (:maintainers ("Vasilij Schneidermann" . "mail@vasilij.de")) (:maintainer "Vasilij Schneidermann" . "mail@vasilij.de") (:keywords "faces") (:url . "https://depp.brause.cc/form-feed"))]) (form-feed-st . [(20231002 2211) ((emacs (25 1))) "Display ^L glyphs as full-width horizontal lines" tar ((:commit . "f91c8daf35b7588e0aa24c8716c8cfd8ff0067c8") (:authors ("Leonardo Schripsema")) (:maintainers ("Leonardo Schripsema")) (:maintainer "Leonardo Schripsema") (:keywords "faces") (:url . "https://github.com/leodag/form-feed-st"))]) (format-all . [(20240511 1811) ((emacs (24 4)) (inheritenv (0 1)) (language-id (0 20))) "Auto-format C, C++, JS, Python, Ruby and 50 other languages" tar ((:commit . "c5ddfc5f3317eaa2a7541a818a0fce961e5e61dd") (:authors ("Lassi Kortela" . "lassi@lassi.io")) (:maintainers ("Lassi Kortela" . "lassi@lassi.io")) (:maintainer "Lassi Kortela" . "lassi@lassi.io") (:keywords "languages" "util") (:url . "https://github.com/lassik/emacs-format-all-the-code"))]) @@ -1958,7 +1961,7 @@ (forth-mode . [(20231206 1127) ((cl-lib (0 2))) "Programming language mode for Forth" tar ((:commit . "59c5ea89ca7593bd49cdde6caefa0893a8780105") (:authors ("Lars Brinkhoff" . "lars@nocrew.org")) (:maintainers ("Lars Brinkhoff" . "lars@nocrew.org")) (:maintainer "Lars Brinkhoff" . "lars@nocrew.org") (:keywords "languages" "forth") (:url . "http://github.com/larsbrinkhoff/forth-mode"))]) (fortpy . [(20150715 2032) ((epc (0 1 0)) (auto-complete (1 4)) (python-environment (0 0 2)) (pos-tip (0 4 5))) "a Fortran auto-completion for Emacs" tar ((:commit . "c614517e9396ef7a78be3b8786fbf303879cf43b") (:authors ("Conrad Rosenbrock <rosenbrockc at gmail.com>")) (:maintainers ("Conrad Rosenbrock <rosenbrockc at gmail.com>")) (:maintainer "Conrad Rosenbrock <rosenbrockc at gmail.com>"))]) (fortune-cookie . [(20181223 842) nil "Print a fortune in your scratch buffer." tar ((:commit . "6c1c08f5be83822c0b762872ab25e3dbee96f333") (:authors ("Andrew Schwartzmeyer" . "andrew@schwartzmeyer.com")) (:maintainers ("Andrew Schwartzmeyer" . "andrew@schwartzmeyer.com")) (:maintainer "Andrew Schwartzmeyer" . "andrew@schwartzmeyer.com") (:keywords "fortune" "cowsay" "scratch" "startup") (:url . "https://github.com/andschwa/fortune-cookie"))]) - (fountain-mode . [(20240608 1340) ((emacs (24 4)) (seq (2 20))) "Major mode for screenwriting in Fountain markup" tar ((:commit . "1160f9ab77fc0fb420c6923971213671c0efedbb") (:authors ("Paul W. Rankin" . "rnkn@rnkn.xyz")) (:maintainers ("Paul W. Rankin" . "rnkn@rnkn.xyz")) (:maintainer "Paul W. Rankin" . "rnkn@rnkn.xyz") (:keywords "wp" "text") (:url . "https://www.fountain-mode.org"))]) + (fountain-mode . [(20240624 601) ((emacs (24 4)) (seq (2 20))) "Major mode for screenwriting in Fountain markup" tar ((:commit . "0c0b7293d11f87073ca47409216a032d5fd8d529") (:authors ("Paul W. Rankin" . "rnkn@rnkn.xyz")) (:maintainers ("Paul W. Rankin" . "rnkn@rnkn.xyz")) (:maintainer "Paul W. Rankin" . "rnkn@rnkn.xyz") (:keywords "wp" "text") (:url . "https://www.fountain-mode.org"))]) (fpga . [(20240329 1759) ((emacs (29 1))) "FPGA & ASIC Utils" tar ((:commit . "34e521962ba3842321d456bd587aa93e4b627969") (:authors ("Gonzalo Larumbe" . "gonzalomlarumbe@gmail.com")) (:maintainers ("Gonzalo Larumbe" . "gonzalomlarumbe@gmail.com")) (:maintainer "Gonzalo Larumbe" . "gonzalomlarumbe@gmail.com") (:keywords "tools") (:url . "https://github.com/gmlarumbe/fpga"))]) (fraktur-mode . [(20160815 227) ((cl-lib (0 5))) "Easily insert Unicode mathematical Fraktur characters" tar ((:commit . "514baf5546aed12a0d9fa0fe66e87cdcc7843b08") (:authors ("Grant Rettke" . "gcr@wisdomandwonder.com")) (:maintainers (nil . "<gcr@wisdomandwonder.com>")) (:maintainer nil . "<gcr@wisdomandwonder.com>") (:keywords "unicode" "fraktur" "math" "mathematical") (:url . "https://github.com/grettke/fraktur-mode"))]) (frame-local . [(20180330 940) ((emacs (25 1))) "Variables local to a frame" tar ((:commit . "51c0889602626e2dcc6f1c1a812b058bc96df03c") (:authors ("Sebastien Chapuis" . "sebastien@chapu.is")) (:maintainers ("Sebastien Chapuis" . "sebastien@chapu.is")) (:maintainer "Sebastien Chapuis" . "sebastien@chapu.is") (:keywords "frames" "tools" "local" "lisp") (:url . "https://github.com/sebastiencs/frame-local"))]) @@ -1966,7 +1969,7 @@ (frame-purpose . [(20211011 1518) ((emacs (25 1)) (dash (2 18))) "Purpose-specific frames" tar ((:commit . "7d498147445cc0afb87b922a8225d2e163e5ed5a") (:authors ("Adam Porter" . "adam@alphapapa.net")) (:maintainers ("Adam Porter" . "adam@alphapapa.net")) (:maintainer "Adam Porter" . "adam@alphapapa.net") (:keywords "buffers" "convenience" "frames") (:url . "http://github.com/alphapapa/frame-purpose.el"))]) (frame-tag . [(20170111 6) ((cl-lib (0 5))) "Minor mode that assigns a unique number to each frame for easy switching" tar ((:commit . "73d6163568c7d32952175e663318b872f995a4e5") (:authors ("Wong Liang Zan" . "zan@liangzan.net")) (:maintainers ("Wong Liang Zan" . "zan@liangzan.net")) (:maintainer "Wong Liang Zan" . "zan@liangzan.net") (:keywords "frame" "movement") (:url . "http://github.com/liangzan/frame-tag.el"))]) (frames-only-mode . [(20240213 2142) ((emacs (26 3)) (dash (2 13 0)) (s (1 11 0))) "Use frames instead of Emacs windows" tar ((:commit . "53b17d712e363991f070d790493cd3cbf1d8a9be") (:authors ("David Shepherd" . "davidshepherd7@gmail.com")) (:maintainers ("David Shepherd" . "davidshepherd7@gmail.com")) (:maintainer "David Shepherd" . "davidshepherd7@gmail.com") (:keywords "frames" "windows") (:url . "https://github.com/davidshepherd7/frames-only-mode"))]) - (frameshot . [(20240618 1603) ((emacs (25 3)) (compat (29 1 4 5))) "Take screenshots of a frame" tar ((:commit . "009ee5f8d754b940c4f86f2276fce401845bb40a") (:authors ("Jonas Bernoulli" . "emacs.frameshot@jonas.bernoulli.dev")) (:maintainers ("Jonas Bernoulli" . "emacs.frameshot@jonas.bernoulli.dev")) (:maintainer "Jonas Bernoulli" . "emacs.frameshot@jonas.bernoulli.dev") (:keywords "multimedia") (:url . "https://github.com/tarsius/frameshot"))]) + (frameshot . [(20240623 1336) ((emacs (25 3)) (compat (29 1 4 5))) "Take screenshots of a frame" tar ((:commit . "ef2c25f4fc8c4a4a6ff4330c40ed67d263dc8234") (:authors ("Jonas Bernoulli" . "emacs.frameshot@jonas.bernoulli.dev")) (:maintainers ("Jonas Bernoulli" . "emacs.frameshot@jonas.bernoulli.dev")) (:maintainer "Jonas Bernoulli" . "emacs.frameshot@jonas.bernoulli.dev") (:keywords "multimedia") (:url . "https://github.com/tarsius/frameshot"))]) (framesize . [(20131017 2132) ((key-chord (0 5 20080915))) "change the size of frames in Emacs" tar ((:commit . "f2dbf5d2513b2bc45f2085370a55c1754b6025da") (:authors ("Nic Ferrier" . "nferrier@ferrier.me.uk")) (:maintainers ("Nic Ferrier" . "nferrier@ferrier.me.uk")) (:maintainer "Nic Ferrier" . "nferrier@ferrier.me.uk") (:keywords "frames") (:url . "http://github.com/nicferrier/emacs-framesize"))]) (frecency . [(20240111 628) ((emacs (25 1)) (a (0 1)) (dash (2 13 0))) "Library for sorting items by frequency and recency of access" tar ((:commit . "4293bf4c8d571b0914e16a5aa05a6d657fdff551") (:authors ("Adam Porter" . "adam@alphapapa.net")) (:maintainers ("Adam Porter" . "adam@alphapapa.net")) (:maintainer "Adam Porter" . "adam@alphapapa.net") (:keywords "extensions") (:url . "http://github.com/alphapapa/frecency.el"))]) (frecentf . [(20231125 201) ((emacs (26 1)) (frecency (0 1 -1)) (persist (0 4)) (async (1 9 4))) "Pervasive recentf using frecency" tar ((:commit . "ef788b2af412311fbc6f52d639810746e5c0fa93") (:authors ("Felipe Lema" . "felipel@mortemale.org")) (:maintainers ("Felipe Lema" . "felipel@mortemale.org")) (:maintainer "Felipe Lema" . "felipel@mortemale.org") (:keywords "files" "maint") (:url . "https://launchpad.net/frecentf.el"))]) @@ -2010,6 +2013,7 @@ (gather . [(20141230 1338) nil "Gather string in buffer." tar ((:commit . "8909c886d72a682710bb79ccfcfe4df54a399b7e") (:authors ("Masahiro Hayashi" . "mhayashi1120@gmail.com")) (:maintainers ("Masahiro Hayashi" . "mhayashi1120@gmail.com")) (:maintainer "Masahiro Hayashi" . "mhayashi1120@gmail.com") (:keywords "matching" "convenience" "tools") (:url . "https://github.com/mhayashi1120/Emacs-gather/raw/master/gather.el"))]) (gcmh . [(20201116 2251) ((emacs (24))) "the Garbage Collector Magic Hack" tar ((:commit . "0089f9c3a6d4e9a310d0791cf6fa8f35642ecfd9") (:authors ("Andrea Corallo" . "akrl@sdf.org")) (:maintainers (nil . "akrl@sdf.org")) (:maintainer nil . "akrl@sdf.org") (:keywords "internal") (:url . "https://gitlab.com/koral/gcmh"))]) (gcode-mode . [(20230823 2141) ((emacs (24 4))) "Simple G-Code major mode" tar ((:commit . "4b54553a698d81e52dde14037df94774c7f30b95") (:authors ("Yuri D'Elia" . "wavexx@thregr.org")) (:maintainers ("Yuri D'Elia" . "wavexx@thregr.org")) (:maintainer "Yuri D'Elia" . "wavexx@thregr.org") (:keywords "gcode" "languages" "highlight" "syntax") (:url . "https://gitlab.com/wavexx/gcode-mode.el"))]) + (gdb-x . [(20240617 1857) ((emacs (29 1))) "Improve GDB-MI user interface" tar ((:commit . "367dbb31e1591ffb3f4b7630f2c8ddcc0692e133") (:authors ("Sergio Pastor Pérez" . "sergio.pastorperez@outlook.es")) (:maintainers ("Sergio Pastor Pérez" . "sergio.pastorperez@outlook.es")) (:maintainer "Sergio Pastor Pérez" . "sergio.pastorperez@outlook.es") (:keywords "extensions") (:url . "https://codeberg.org/shepherd/gdb-x"))]) (gdscript-mode . [(20240509 1523) ((emacs (26 3))) "Major mode for Godot's GDScript language" tar ((:commit . "32086df83335ce0e5120b21b80cf7996edb2232e") (:authors ("Nathan Lovato <nathan@gdquest.com>, Fabián E. Gallina" . "fgallina@gnu.org")) (:maintainers (nil . "nathan@gdquest.com")) (:maintainer nil . "nathan@gdquest.com") (:keywords "languages") (:url . "https://github.com/godotengine/emacs-gdscript-mode/"))]) (geben . [(20220827 105) ((emacs (24 3)) (cl-lib (0 5))) "DBGp protocol frontend, a script debugger" tar ((:commit . "8df1ed2c8ff13b0ca4ef241c95c46f60a5a4fe3c") (:authors ("Matthew Carter" . "m@ahungry.com")) (:maintainers ("Matthew Carter" . "m@ahungry.com")) (:maintainer "Matthew Carter" . "m@ahungry.com") (:keywords "c" "comm" "tools") (:url . "https://github.com/ahungry/geben"))]) (geben-helm-projectile . [(20170524 334) ((emacs (24)) (geben (0 26)) (helm-projectile (0 13 0))) "Integrate helm-projectile with geben" tar ((:commit . "31ce0faca5dcc71924884f03fd5a7a25d00ccd9b") (:authors ("Matthew Carter" . "m@ahungry.com")) (:maintainers ("Matthew Carter" . "m@ahungry.com")) (:maintainer "Matthew Carter" . "m@ahungry.com") (:keywords "ahungry" "emacs" "geben" "helm" "projectile" "debug") (:url . "https://github.com/ahungry/geben-helm-projectile"))]) @@ -2064,7 +2068,7 @@ (git-blamed . [(20161028 1926) nil "Minor mode for incremental blame for Git" tar ((:commit . "cef196abf398e2dd11f775d1e6cd8690567408aa") (:keywords "git" "version control" "release management"))]) (git-cliff . [(20240517 1042) ((emacs (29 1)) (transient (0 6 0)) (dash (2 19 1))) "Generate and update changelog using git-cliff" tar ((:commit . "90db86c1a600fc319e7c8172839bfe18c3e4221b") (:authors ("liuyinz" . "liuyinz95@gmail.com")) (:maintainers ("liuyinz" . "liuyinz95@gmail.com")) (:maintainer "liuyinz" . "liuyinz95@gmail.com") (:keywords "tools") (:url . "https://github.com/liuyinz/git-cliff.el"))]) (git-command . [(20191028 333) ((term-run (0 1 4)) (with-editor (2 3 1))) "A Git Command-Line interface" tar ((:commit . "a773d40da39dfb1c6ecf2b0758aa370ddea8f06d") (:authors ("10sr <8slashes+el [at] gmail [dot] com>")) (:maintainers ("10sr <8slashes+el [at] gmail [dot] com>")) (:maintainer "10sr <8slashes+el [at] gmail [dot] com>") (:keywords "utility" "git") (:url . "https://github.com/10sr/git-command-el"))]) - (git-commit . [(20240618 1142) ((emacs (26 1)) (compat (29 1 4 5)) (transient (20240421)) (with-editor (20240415))) "Edit Git commit messages." tar ((:commit . "13850341e375bd12e1d1541daab07b111034ff4c") (:authors ("Jonas Bernoulli" . "emacs.magit@jonas.bernoulli.dev") ("Sebastian Wiesner" . "lunaryorn@gmail.com") ("Florian Ragwitz" . "rafl@debian.org") ("Marius Vollmer" . "marius.vollmer@gmail.com")) (:maintainer "Jonas Bernoulli" . "emacs.magit@jonas.bernoulli.dev") (:keywords "git" "tools" "vc") (:url . "https://github.com/magit/magit"))]) + (git-commit . [(20240623 1335) ((emacs (26 1)) (compat (29 1 4 5)) (transient (20240421)) (with-editor (20240415))) "Edit Git commit messages." tar ((:commit . "196abe727054a440bf6262c5c254ad4565cbaa66") (:authors ("Jonas Bernoulli" . "emacs.magit@jonas.bernoulli.dev") ("Sebastian Wiesner" . "lunaryorn@gmail.com") ("Florian Ragwitz" . "rafl@debian.org") ("Marius Vollmer" . "marius.vollmer@gmail.com")) (:maintainer "Jonas Bernoulli" . "emacs.magit@jonas.bernoulli.dev") (:keywords "git" "tools" "vc") (:url . "https://github.com/magit/magit"))]) (git-commit-insert-issue . [(20230512 1416) ((emacs (25)) (projectile (0)) (s (0)) (ghub (0)) (bitbucket (0))) "Get issues list when typing \"Fixes #\"" tar ((:commit . "df7ce0549d1db7bab27d401a351ea0d187c4a673") (:authors ("Vindarel")) (:maintainers ("Vindarel")) (:maintainer "Vindarel") (:keywords "tools" "vc" "github" "gitlab" "bitbucket" "commit" "issues") (:url . "https://gitlab.com/emacs-stuff/git-commit-insert-issue/"))]) (git-commit-ts-mode . [(20240527 708) ((emacs (29 1))) "Tree-sitter support for Git commit messages" tar ((:commit . "04219fdac2a5c1816cd08141513770adc0c2a48b") (:authors ("Daniil Shvalov" . "daniil.shvalov@gmail.com")) (:maintainers ("Daniil Shvalov" . "daniil.shvalov@gmail.com")) (:maintainer "Daniil Shvalov" . "daniil.shvalov@gmail.com") (:keywords "tree-sitter" "git" "faces") (:url . "https://github.com/danilshvalov/git-commit-ts-mode"))]) (git-dwim . [(20170126 1214) nil "Context-aware git commands such as branch handling" tar ((:commit . "485c732130686c2f28a026e385366006435394b9") (:authors ("rubikitch" . "rubikitch@ruby-lang.org")) (:maintainers ("rubikitch" . "rubikitch@ruby-lang.org")) (:maintainer "rubikitch" . "rubikitch@ruby-lang.org") (:keywords "git" "tools" "convenience") (:url . "http://www.emacswiki.org/cgi-bin/wiki/download/git-dwim.el"))]) @@ -2201,7 +2205,7 @@ (gpt . [(20231112 2012) ((emacs (24 4))) "Run instruction-following language models" tar ((:commit . "c1091d25db420320de4b121baba99d7ac2e23932") (:authors ("Andreas Stuhlmueller" . "andreas@ought.org")) (:maintainers ("Andreas Stuhlmueller" . "andreas@ought.org")) (:maintainer "Andreas Stuhlmueller" . "andreas@ought.org") (:keywords "gpt3" "language" "copilot" "convenience" "tools") (:url . "https://github.com/stuhlmueller/gpt.el"))]) (gpt-commit . [(20230716 331) ((emacs (27 1)) (magit (2 90)) (request (0 3 2))) "Commit messages with GPT in Emacs" tar ((:commit . "8a8883be2051eed499c5bc3035a75ff56d64d5ff") (:authors ("Youngwook Kim" . "youngwook.kim@gmail.com")) (:maintainers ("Youngwook Kim" . "youngwook.kim@gmail.com")) (:maintainer "Youngwook Kim" . "youngwook.kim@gmail.com") (:url . "https://github.com/ywkim/gpt-commit"))]) (gptai . [(20230530 1853) ((emacs (24 1))) "Integrate with the OpenAI API" tar ((:commit . "e7b8b91b425986868e8bc0edcac384ba47d4d4b7") (:authors ("Anton Hibl" . "antonhibl11@gmail.com")) (:maintainers ("Anton Hibl" . "antonhibl11@gmail.com")) (:maintainer "Anton Hibl" . "antonhibl11@gmail.com") (:keywords "comm" "convenience") (:url . "https://github.com/antonhibl/gptai"))]) - (gptel . [(20240620 2132) ((emacs (27 1)) (transient (0 4 0)) (compat (29 1 4 1))) "Interact with ChatGPT or other LLMs" tar ((:commit . "44780a408a3cf73a03f1ece3a6b570c160914834") (:authors ("Karthik Chikmagalur" . "karthik.chikmagalur@gmail.com")) (:maintainers ("Karthik Chikmagalur" . "karthik.chikmagalur@gmail.com")) (:maintainer "Karthik Chikmagalur" . "karthik.chikmagalur@gmail.com") (:keywords "convenience") (:url . "https://github.com/karthink/gptel"))]) + (gptel . [(20240626 340) ((emacs (27 1)) (transient (0 4 0)) (compat (29 1 4 1))) "Interact with ChatGPT or other LLMs" tar ((:commit . "95a5716aa250d6321b17691abb035aa8acefbfbb") (:authors ("Karthik Chikmagalur" . "karthik.chikmagalur@gmail.com")) (:maintainers ("Karthik Chikmagalur" . "karthik.chikmagalur@gmail.com")) (:maintainer "Karthik Chikmagalur" . "karthik.chikmagalur@gmail.com") (:keywords "convenience") (:url . "https://github.com/karthink/gptel"))]) (gpx . [(20240609 2200) ((emacs (27 1))) "Major mode for GPX files" tar ((:commit . "88aa5fed1b0987d90f442eb002ab0f2e4731e223") (:authors ("Michał Krzywkowski" . "k.michal@zoho.com")) (:maintainers ("Michał Krzywkowski" . "k.michal@zoho.com")) (:maintainer "Michał Krzywkowski" . "k.michal@zoho.com") (:keywords "data" "tools") (:url . "https://github.com/mkcms/gpx-mode"))]) (grab-mac-link . [(20210511 1303) ((emacs (24))) "Grab link from Mac Apps and insert it into Emacs" tar ((:commit . "5fdb03bf57bc4a530374b896e0f8b5139dc794e3") (:authors ("Xu Chunyang")) (:maintainers ("Xu Chunyang")) (:maintainer "Xu Chunyang") (:keywords "mac" "hyperlink") (:url . "https://github.com/xuchunyang/grab-mac-link.el"))]) (grab-x-link . [(20191113 848) ((emacs (24)) (cl-lib (0 5))) "Grab links from X11 apps and insert into Emacs" tar ((:commit . "d898db46e4864118359fdedfe915e180de3fe290") (:authors ("Xu Chunyang" . "mail@xuchunyang.me")) (:maintainers ("Xu Chunyang" . "mail@xuchunyang.me")) (:maintainer "Xu Chunyang" . "mail@xuchunyang.me") (:keywords "hyperlink") (:url . "https://github.com/xuchunyang/grab-x-link"))]) @@ -2295,7 +2299,7 @@ (headlong . [(20150417 1526) nil "reckless completion" tar ((:commit . "f6830f87f236eee88263cb6976125f72422abe72") (:authors ("Oleh Krehel" . "ohwoeowho@gmail.com")) (:maintainers ("Oleh Krehel" . "ohwoeowho@gmail.com")) (:maintainer "Oleh Krehel" . "ohwoeowho@gmail.com") (:keywords "completion") (:url . "https://github.com/abo-abo/headlong"))]) (heaven-and-hell . [(20190713 1830) ((emacs (24 4))) "easy toggle light/dark themes" tar ((:commit . "e1febfd60d060c110a1e43c5f093cd8537251308") (:authors ("Valentin Ignatev" . "valentignatev@gmail.com")) (:maintainers ("Valentin Ignatev" . "valentignatev@gmail.com")) (:maintainer "Valentin Ignatev" . "valentignatev@gmail.com") (:keywords "faces") (:url . "https://github.com/valignatev/heaven-and-hell"))]) (heex-ts-mode . [(20240113 1104) ((emacs (29 1))) "Major mode for Heex with tree-sitter support" tar ((:commit . "90142df2929956536dc1eaae3bb5ca04dc4232ab") (:authors ("Wilhelm H Kirschbaum")) (:maintainers ("Wilhelm H Kirschbaum")) (:maintainer "Wilhelm H Kirschbaum") (:keywords "heex" "languages" "tree-sitter") (:url . "https://github.com/wkirschbaum/elixir-ts-mode"))]) - (helm . [(20240618 613) ((helm-core (3 9 9)) (wfnames (1 2))) "Helm is an Emacs incremental and narrowing framework" tar ((:commit . "00faa55a8fddb7649a969120eb38a23c1bc8f739") (:authors ("Thierry Volpiatto" . "thievol@posteo.net")) (:maintainers ("Thierry Volpiatto" . "thievol@posteo.net")) (:maintainer "Thierry Volpiatto" . "thievol@posteo.net") (:url . "https://emacs-helm.github.io/helm/"))]) + (helm . [(20240626 917) ((helm-core (3 9 9)) (wfnames (1 2))) "Helm is an Emacs incremental and narrowing framework" tar ((:commit . "5dd15389a3c472c7b5ef93af4ad177c28b442ab0") (:authors ("Thierry Volpiatto" . "thievol@posteo.net")) (:maintainers ("Thierry Volpiatto" . "thievol@posteo.net")) (:maintainer "Thierry Volpiatto" . "thievol@posteo.net") (:url . "https://emacs-helm.github.io/helm/"))]) (helm-R . [(20120820 14) ((helm (20120517)) (ess (20120509))) "helm-sources and some utilities for GNU R." tar ((:commit . "b0eb9d5f6a483a9dbe6eb6cf1f2024d4f5938bc2") (:authors ("myuhe <yuhei.maeda_at_gmail.com>")) (:maintainers ("myuhe")) (:maintainer "myuhe") (:keywords "convenience") (:url . "https://github.com/myuhe/helm-R.el"))]) (helm-ack . [(20141030 1226) ((helm (1 0)) (cl-lib (0 5))) "Ack command with helm interface" tar ((:commit . "5982f3cb6ec9f460ebbe06ec0ce7b3590bca3118") (:authors ("Syohei YOSHIDA" . "syohex@gmail.com")) (:maintainers ("Syohei YOSHIDA" . "syohex@gmail.com")) (:maintainer "Syohei YOSHIDA" . "syohex@gmail.com") (:url . "https://github.com/syohex/emacs-helm-ack"))]) (helm-ad . [(20151209 1015) ((dash (2 8 0)) (helm (1 6 2))) "helm source for Active Directory" tar ((:commit . "8ac044705d8620ee354a9cfa8cc1b865e83c0d55") (:authors ("Takahiro Noda" . "takahiro.noda+github@gmail.com")) (:maintainers ("Takahiro Noda" . "takahiro.noda+github@gmail.com")) (:maintainer "Takahiro Noda" . "takahiro.noda+github@gmail.com") (:keywords "comm"))]) @@ -2329,7 +2333,7 @@ (helm-comint . [(20231102 2029) ((emacs (25 1)) (helm (3 9 4))) "Comint prompt navigation for helm" tar ((:commit . "9215b2aa8f42f62cbda66a1503832abb7f491549") (:authors ("Pierre Neidhardt" . "mail@ambrevar.xyz")) (:maintainers ("Benedict Wang" . "foss@bhw.name")) (:maintainer "Benedict Wang" . "foss@bhw.name") (:keywords "processes" "matching") (:url . "https://github.com/benedicthw/helm-comint.git"))]) (helm-commandlinefu . [(20150611 545) ((emacs (24 1)) (helm (1 7 0)) (json (1 3)) (let-alist (1 0 3))) "Search and browse commandlinefu.com from helm" tar ((:commit . "9ee7e018c5db23ae9c8d1c8fa969876f15b7280d") (:authors ("Chunyang Xu" . "xuchunyang56@gmail.com")) (:maintainers ("Chunyang Xu" . "xuchunyang56@gmail.com")) (:maintainer "Chunyang Xu" . "xuchunyang56@gmail.com") (:keywords "commandlinefu.com") (:url . "https://github.com/xuchunyang/helm-commandlinefu"))]) (helm-company . [(20231113 701) ((helm (1 5 9)) (company (0 10 0))) "Helm interface for company-mode" tar ((:commit . "4622b82353220ee6cc33468f710fa5b6b253b7f1") (:authors ("Yasuyuki Oka" . "yasuyk@gmail.com")) (:maintainers ("Daniel Ralston" . "Sodel-the-Vociferous@users.noreply.github.com")) (:maintainer "Daniel Ralston" . "Sodel-the-Vociferous@users.noreply.github.com") (:url . "https://github.com/Sodel-the-Vociferous/helm-company"))]) - (helm-core . [(20240621 737) ((emacs (25 1)) (async (1 9 8))) "Development files for Helm" tar ((:commit . "0ee130fbbfb314966b43f52f0105cd952f64a92c") (:authors ("Thierry Volpiatto" . "thievol@posteo.net")) (:maintainers ("Thierry Volpiatto" . "thievol@posteo.net")) (:maintainer "Thierry Volpiatto" . "thievol@posteo.net") (:url . "https://emacs-helm.github.io/helm/"))]) + (helm-core . [(20240625 349) ((emacs (25 1)) (async (1 9 8))) "Development files for Helm" tar ((:commit . "06048326c6840ac31aeb3815b5b80163d43b7d3a") (:authors ("Thierry Volpiatto" . "thievol@posteo.net")) (:maintainers ("Thierry Volpiatto" . "thievol@posteo.net")) (:maintainer "Thierry Volpiatto" . "thievol@posteo.net") (:url . "https://emacs-helm.github.io/helm/"))]) (helm-cscope . [(20190615 41) ((xcscope (1 0)) (helm (1 6 7)) (cl-lib (0 5)) (emacs (24 1))) "Helm interface for xcscope.el." tar ((:commit . "af1d9e7f4460a88d7400b5a74d5da68084089ac1") (:authors ("alpha22jp" . "alpha22jp@gmail.com")) (:maintainers ("alpha22jp" . "alpha22jp@gmail.com")) (:maintainer "alpha22jp" . "alpha22jp@gmail.com") (:keywords "cscope" "helm") (:url . "https://github.com/alpha22jp/helm-cscope.el"))]) (helm-css-scss . [(20230522 1113) ((emacs (24 3)) (helm (1 0))) "CSS/SCSS/LESS Selectors with helm interface" tar ((:commit . "2169d83d8fdc661241df208cb3235112735d936e") (:authors ("Shingo Fukuyama - http://fukuyama.co")) (:maintainers ("Shingo Fukuyama - http://fukuyama.co")) (:maintainer "Shingo Fukuyama - http://fukuyama.co") (:keywords "convenience" "scss" "css" "less" "selector" "helm") (:url . "https://github.com/ShingoFukuyama/helm-css-scss"))]) (helm-ctest . [(20220721 400) ((s (1 9 0)) (dash (2 11 0)) (helm-core (3 6 0))) "Run ctest from within emacs" tar ((:commit . "48edc9fa862219da34feb423c06c33d8f6d43722") (:authors ("Dan LaManna" . "me@danlamanna.com")) (:maintainers ("Dan LaManna" . "me@danlamanna.com")) (:maintainer "Dan LaManna" . "me@danlamanna.com") (:keywords "helm" "ctest"))]) @@ -2534,7 +2538,7 @@ (hl-indent-scope . [(20240422 204) ((emacs (29 1))) "Highlight indentation by scope" tar ((:commit . "b7816f73c1000975835ac28f54f8ecfc6648c0dc") (:authors ("Campbell Barton" . "ideasman42@gmail.com")) (:maintainers ("Campbell Barton" . "ideasman42@gmail.com")) (:maintainer "Campbell Barton" . "ideasman42@gmail.com") (:url . "https://codeberg.org/ideasman42/emacs-hl-indent-scope"))]) (hl-prog-extra . [(20240422 211) ((emacs (26 2))) "Customizable highlighting for source-code" tar ((:commit . "f32c04519f544634bd8dedf55d8bc458d9f64766") (:authors ("Campbell Barton" . "ideasman42@gmail.com")) (:maintainers ("Campbell Barton" . "ideasman42@gmail.com")) (:maintainer "Campbell Barton" . "ideasman42@gmail.com") (:keywords "convenience") (:url . "https://codeberg.org/ideasman42/emacs-hl-prog-extra"))]) (hl-sentence . [(20171018 1519) nil "highlight a sentence based on customizable face" tar ((:commit . "86ae38d3103bd20da5485cbdd59dfbd396c45ee4") (:authors ("Donald Ephraim Curtis" . "dcurtis@milkbox.net")) (:maintainers ("Donald Ephraim Curtis" . "dcurtis@milkbox.net")) (:maintainer "Donald Ephraim Curtis" . "dcurtis@milkbox.net") (:keywords "highlighting") (:url . "http://github.com/milkypostman/hl-sentence"))]) - (hl-todo . [(20240618 1724) ((emacs (25 1)) (compat (29 1 4 5))) "Highlight TODO and similar keywords" tar ((:commit . "dd46d426c0501b5e8ed976a834d3e54ae85731f7") (:authors ("Jonas Bernoulli" . "emacs.hl-todo@jonas.bernoulli.dev")) (:maintainers ("Jonas Bernoulli" . "emacs.hl-todo@jonas.bernoulli.dev")) (:maintainer "Jonas Bernoulli" . "emacs.hl-todo@jonas.bernoulli.dev") (:keywords "convenience") (:url . "https://github.com/tarsius/hl-todo"))]) + (hl-todo . [(20240625 1705) ((emacs (26 1)) (compat (29 1 4 5))) "Highlight TODO and similar keywords" tar ((:commit . "3a595b7eb9970105be6ce091ac187bbcdb0ad5e8") (:authors ("Jonas Bernoulli" . "emacs.hl-todo@jonas.bernoulli.dev")) (:maintainers ("Jonas Bernoulli" . "emacs.hl-todo@jonas.bernoulli.dev")) (:maintainer "Jonas Bernoulli" . "emacs.hl-todo@jonas.bernoulli.dev") (:keywords "convenience") (:url . "https://github.com/tarsius/hl-todo"))]) (hledger-mode . [(20240415 1812) ((emacs (24 4)) (popup (0 5 3)) (async (1 9)) (htmlize (1 47))) "A mode for writing journal entries for hledger." tar ((:commit . "5492509a23047f0a1f05a112b47fa34eba7c5e1d") (:authors ("Narendra Joshi" . "narendraj9@gmail.com")) (:maintainers ("Narendra Joshi" . "narendraj9@gmail.com")) (:maintainer "Narendra Joshi" . "narendraj9@gmail.com") (:keywords "data") (:url . "https://github.com/narendraj9/hledger-mode.git"))]) (hlint-refactor . [(20190115 900) nil "Apply HLint suggestions" tar ((:commit . "c4307f86aad6d02e32e9b30cb6edc115584c791c") (:keywords "haskell" "refactor") (:url . "https://github.com/mpickering/hlint-refactor-mode"))]) (hlinum . [(20180422 412) ((cl-lib (0 2))) "Extension for linum.el to highlight current line number" tar ((:commit . "f17360fe93de6df99a05b4b64b0a1ca4ee45abb6") (:authors ("Tomoya Tanjo" . "ttanjo@gmail.com")) (:maintainers ("Tomoya Tanjo" . "ttanjo@gmail.com")) (:maintainer "Tomoya Tanjo" . "ttanjo@gmail.com") (:keywords "convenience" "extensions") (:url . "https://github.com/tom-tan/hlinum-mode/"))]) @@ -2580,7 +2584,7 @@ (hydandata-light-theme . [(20190809 1925) nil "A light color theme that is easy on your eyes" tar ((:commit . "812ffa4bee3163098ef66ee4506feed45018be4e") (:authors ("David Chkhikvadze" . "david@chkhd.net")) (:maintainers ("David Chkhikvadze" . "david@chkhd.net")) (:maintainer "David Chkhikvadze" . "david@chkhd.net") (:keywords "color-theme" "theme") (:url . "https://github.com/chkhd/hydandata-light-theme"))]) (hyde . [(20160508 308) nil "Major mode to help create and manage Jekyll blogs" tar ((:commit . "a8cd6ed00ecd8d7de0ded2f4867015b412b15b76"))]) (hydra . [(20220910 1206) ((cl-lib (0 5)) (lv (0))) "Make bindings that stick around." tar ((:commit . "317e1de33086637579a7aeb60f77ed0405bf359b") (:authors ("Oleh Krehel" . "ohwoeowho@gmail.com")) (:maintainers ("Oleh Krehel" . "ohwoeowho@gmail.com")) (:maintainer "Oleh Krehel" . "ohwoeowho@gmail.com") (:keywords "bindings") (:url . "https://github.com/abo-abo/hydra"))]) - (hyperbole . [(20240622 601) ((emacs (27 1))) "GNU Hyperbole: The Everyday Hypertextual Information Manager" tar ((:commit . "2d95b9ab3b247526c12d037cb7c4bb0650b26b0e") (:authors ("Robert Weiner" . "rsw@gnu.org")) (:maintainers ("Mats Lidell" . "matsl@gnu.org")) (:maintainer "Mats Lidell" . "matsl@gnu.org") (:keywords "comm" "convenience" "files" "frames" "hypermedia" "languages" "mail" "matching" "mouse" "multimedia" "outlines" "tools" "wp") (:url . "http://www.gnu.org/software/hyperbole"))]) + (hyperbole . [(20240623 425) ((emacs (27 1))) "GNU Hyperbole: The Everyday Hypertextual Information Manager" tar ((:commit . "d4aaee59fe422dfd87dbcf1a6cd608edad30e5e1") (:authors ("Robert Weiner" . "rsw@gnu.org")) (:maintainers ("Mats Lidell" . "matsl@gnu.org")) (:maintainer "Mats Lidell" . "matsl@gnu.org") (:keywords "comm" "convenience" "files" "frames" "hypermedia" "languages" "mail" "matching" "mouse" "multimedia" "outlines" "tools" "wp") (:url . "http://www.gnu.org/software/hyperbole"))]) (hyperdrive . [(20240619 2131) ((emacs (28 1)) (map (3 0)) (compat (29 1 4 4)) (org (9 7 3)) (plz (0 9 0)) (persist (0 6 1)) (taxy-magit-section (0 13)) (transient (0 6 0))) "P2P filesystem" tar ((:commit . "79541d4aab9f165c861ea32f3f2890be0d7cb31f") (:authors ("Joseph Turner" . "joseph@ushin.org")) (:maintainers ("Joseph Turner" . "~ushin/ushin@lists.sr.ht")) (:maintainer "Joseph Turner" . "~ushin/ushin@lists.sr.ht") (:url . "https://git.sr.ht/~ushin/hyperdrive.el"))]) (hyperkitty . [(20220226 1951) ((request (0 3 2)) (emacs (25 1))) "Emacs interface for Hyperkitty archives" tar ((:commit . "2c1d22ff017d096c359aa151e6a29f7214a58118") (:authors ("Abhilash Raj" . "maxking@asynchronous.in")) (:maintainers ("Abhilash Raj" . "maxking@asynchronous.in")) (:maintainer "Abhilash Raj" . "maxking@asynchronous.in") (:keywords "mail" "hyperkitty" "mailman") (:url . "https://github.com/maxking/hyperkitty.el"))]) (hyperlist-mode . [(20230119 28) ((emacs (24))) "A major-mode for viewing Hyperlists" tar ((:commit . "480dbf33ca72e7b5fade952aaf0d5a5eb43acb1d") (:authors ("Wojciech Siewierski")) (:maintainers ("Wojciech Siewierski")) (:maintainer "Wojciech Siewierski") (:keywords "outlines") (:url . "https://github.com/vifon/hyperlist-mode"))]) @@ -2714,6 +2718,7 @@ (io-mode . [(20161004 756) nil "Major mode to edit Io language files in Emacs" tar ((:commit . "fd65ae769093defcf554d6d637eba6e6dfc29f56") (:authors ("Sergei Lebedev" . "superbobry@gmail.com")) (:maintainers ("Sergei Lebedev" . "superbobry@gmail.com")) (:maintainer "Sergei Lebedev" . "superbobry@gmail.com") (:keywords "languages" "io") (:url . "https://github.com/superbobry/io-mode"))]) (io-mode-inf . [(20140128 1934) nil "Interaction with an Io interpreter." tar ((:commit . "6dd2bac3fd87484bb7d97e135b06c29d70b444b6") (:keywords "io" "languages") (:url . "https://github.com/slackorama/io-emacs"))]) (iodine-theme . [(20151031 1639) ((emacs (24))) "A light emacs color theme" tar ((:commit . "02fb780e1d8d8a6b9c709bfac399abe1665c6999") (:authors ("Srđan Panić" . "srdja.panic@gmail.com")) (:maintainers ("Srđan Panić" . "srdja.panic@gmail.com")) (:maintainer "Srđan Panić" . "srdja.panic@gmail.com") (:keywords "themes") (:url . "https://github.com/srdja/iodine-theme"))]) + (iosevka-theme . [(20240621 2151) ((emacs (28 1))) "Theme using various stylistic sets of Iosevka font" tar ((:commit . "1f17b9cdb48021a0ac1369d9622742e0f5442c9d") (:authors ("Mekeor Melire" . "mekeor@posteo.de")) (:maintainers ("Mekeor Melire" . "mekeor@posteo.de")) (:maintainer "Mekeor Melire" . "mekeor@posteo.de") (:keywords "faces" "theme") (:url . "https://codeberg.org/mekeor/iosevka-theme"))]) (iota . [(20230918 1028) nil "Replace marker with increasing integers" tar ((:commit . "c065c087567f074bff639eb12fa53018654b8ce2") (:authors ("Thomas Voss" . "mail@thomasvoss.com")) (:maintainers ("Thomas Voss" . "mail@thomasvoss.com")) (:maintainer "Thomas Voss" . "mail@thomasvoss.com") (:keywords "abbrev" "data" "wp") (:url . "https://git.sr.ht/~mango/iota.el"))]) (ipcalc . [(20210903 958) ((cl-lib (0 5))) "IP subnet calculator" tar ((:commit . "05fcb5bb8db3ba0c1f9e5f1bfcf0c183828a2426") (:authors ("\"Aleksandar Simic\"" . "asimic@gmail.com")) (:maintainers ("\"Aleksandar Simic\"" . "asimic@gmail.com")) (:maintainer "\"Aleksandar Simic\"" . "asimic@gmail.com") (:keywords "networking" "tools") (:url . "http://github.com/dotemacs/ipcalc.el"))]) (ipe . [(20240428 852) ((emacs (24 4))) "Insert, Update and Delete PAIRs using overlays" tar ((:commit . "98a7dd345c20db85a5477272148d6fb7801ac651") (:authors ("Brian Kavanagh" . "brians.emacs@gmail.com")) (:maintainers ("Brian Kavanagh" . "brians.emacs@gmail.com")) (:maintainer "Brian Kavanagh" . "brians.emacs@gmail.com") (:keywords "convenience" "tools") (:url . "https://github.com/BriansEmacs/insert-pair-edit.el"))]) @@ -2778,7 +2783,7 @@ (ivy-youtube . [(20230503 1509) ((request (0 2 0)) (ivy (0 8 0)) (cl-lib (0 5))) "Query YouTube and play videos in your browser" tar ((:commit . "e7a7cc860e967500857e5fd85d8e397c6d752ee1") (:authors ("Brunno dos Santos")) (:maintainers ("Brunno dos Santos")) (:maintainer "Brunno dos Santos") (:keywords "youtube" "multimedia" "mpv" "vlc") (:url . "https://github.com/squiter/ivy-youtube"))]) (ix . [(20131027 1657) ((grapnel (0 5 3))) "Emacs client for http://ix.io pastebin" tar ((:commit . "498dac674f4f1910d39087b1457c5da5465a0614") (:authors ("Abhishek L" . "abhishekl.2006@gmail.com")) (:maintainers ("Abhishek L" . "abhishekl.2006@gmail.com")) (:maintainer "Abhishek L" . "abhishekl.2006@gmail.com") (:url . "http://www.github.com/theanalyst/ix.el"))]) (j-mode . [(20240611 2211) nil "Major mode for editing J programs" tar ((:commit . "3f852d1476be5625fea51dcaaad66dd57593101a") (:keywords "j" "langauges") (:url . "http://github.com/zellio/j-mode"))]) - (jabber . [(20240525 206) ((emacs (27 1)) (fsm (0 2)) (srv (0 2))) "A Jabber client for Emacs." tar ((:commit . "306e96589263c266b9d3738b33cf55be1a91240a") (:authors ("Magnus Henoch" . "mange@freemail.hu")) (:maintainer "wgreenhouse" . "wgreenhouse@tilde.club") (:keywords "comm") (:url . "https://codeberg.org/emacs-jabber/emacs-jabber"))]) + (jabber . [(20240624 528) ((emacs (27 1)) (fsm (0 2)) (srv (0 2))) "A Jabber client for Emacs." tar ((:commit . "e766d84b81d5df6abc30fcbbb94f7c8640ea54e2") (:authors ("Magnus Henoch" . "mange@freemail.hu")) (:maintainer "wgreenhouse" . "wgreenhouse@tilde.club") (:keywords "comm") (:url . "https://codeberg.org/emacs-jabber/emacs-jabber"))]) (jack . [(20221122 632) ((emacs (28 1))) "HTML generator library" tar ((:commit . "3b4ea97fcc107d0ffd201ea695129af52f390113") (:authors ("Tony Aldon" . "tony.aldon.adm@gmail.com")) (:maintainers ("Tony Aldon" . "tony.aldon.adm@gmail.com")) (:maintainer "Tony Aldon" . "tony.aldon.adm@gmail.com") (:keywords "lisp" "html") (:url . "https://github.com/tonyaldon/jack"))]) (jack-connect . [(20220201 1417) nil "Manage jack connections within Emacs" tar ((:commit . "1acaebfe8f37f0194e95c3e812c9515a6f688eee") (:authors ("Stefano Barbi" . "stefanobarbi@gmail.com")) (:maintainers ("Stefano Barbi" . "stefanobarbi@gmail.com")) (:maintainer "Stefano Barbi" . "stefanobarbi@gmail.com"))]) (jack-ts-mode . [(20231110 1615) ((emacs (29 1))) "Major mode for jack buffers using tree-sitter" tar ((:commit . "f57f211d96608a90142619a925caeb8808e7c632") (:authors ("Noah Peart" . "noah.v.peart@gmail.com")) (:maintainers ("Noah Peart" . "noah.v.peart@gmail.com")) (:maintainer "Noah Peart" . "noah.v.peart@gmail.com") (:keywords "tree-sitter" "languages" "jack" "nand2tetris") (:url . "https://github.com/nverno/jack-ts-mode"))]) @@ -2894,7 +2899,7 @@ (kana . [(20210531 1427) ((emacs (24 4)) (dash (2 17 0))) "Learn Japanese hiragana and katakana" tar ((:commit . "d3d550aad67ef8625b3860598bf3622f5b2a7d32") (:authors ("Damon Chan" . "elecming@gmail.com")) (:maintainers ("Damon Chan" . "elecming@gmail.com")) (:maintainer "Damon Chan" . "elecming@gmail.com") (:keywords "tools") (:url . "https://github.com/chenyanming/kana"))]) (kanban . [(20230210 1505) nil "Parse org-todo headlines to use org-tables as Kanban tables" tar ((:commit . "d70fa7acab2bfcbb7d3da43c1343073f7eff4998") (:authors ("Arne Babenhauserheide" . "arne_bab@web.de")) (:maintainers ("Arne Babenhauserheide" . "arne_bab@web.de")) (:maintainer "Arne Babenhauserheide" . "arne_bab@web.de") (:keywords "outlines" "convenience"))]) (kanji-mode . [(20230928 1113) nil "View stroke order for kanji characters at cursor" tar ((:commit . "731b3a5447bcb899ba1d86b645a344e0915d04f3") (:authors ("Wojciech Gac" . "wojciech.s.gac@gmail.com")) (:maintainers ("Wojciech Gac" . "wojciech.s.gac@gmail.com")) (:maintainer "Wojciech Gac" . "wojciech.s.gac@gmail.com") (:url . "http://github.com/wsgac/kanji-mode "))]) - (kaocha-runner . [(20240523 619) ((emacs (26)) (s (1 4 0)) (cider (0 21 0)) (parseedn (0 1 0))) "A package for running Kaocha tests via CIDER." tar ((:commit . "e5071ce09ec2d8c700bac91c902318035c5489bf") (:authors ("Magnar Sveen" . "magnars@gmail.com")) (:maintainers ("Magnar Sveen" . "magnars@gmail.com")) (:maintainer "Magnar Sveen" . "magnars@gmail.com") (:url . "https://github.com/magnars/kaocha-runner.el"))]) + (kaocha-runner . [(20240625 1010) ((emacs (26)) (s (1 4 0)) (cider (0 21 0)) (parseedn (0 1 0))) "A package for running Kaocha tests via CIDER." tar ((:commit . "98f45ee396802c2225595c9151d4a941f9dcaa9d") (:authors ("Magnar Sveen" . "magnars@gmail.com")) (:maintainers ("Magnar Sveen" . "magnars@gmail.com")) (:maintainer "Magnar Sveen" . "magnars@gmail.com") (:url . "https://github.com/magnars/kaocha-runner.el"))]) (kaolin-themes . [(20240507 1430) ((emacs (25 1)) (autothemer (0 2 2)) (cl-lib (0 6))) "A set of eye pleasing themes" tar ((:commit . "ba7a003d7aa5d4681a8464f4dec6ab4e9fb271d2") (:authors ("Ogden Webb" . "ogdenwebb@gmail.com")) (:maintainers ("Ogden Webb" . "ogdenwebb@gmail.com")) (:maintainer "Ogden Webb" . "ogdenwebb@gmail.com") (:keywords "dark" "light" "teal" "blue" "violet" "purple" "brown" "theme" "faces") (:url . "https://github.com/ogdenwebb/emacs-kaolin-themes"))]) (kaomoji . [(20220721 441) ((emacs (24 3)) (helm-core (3 6 0))) "Input kaomoji superb easily" tar ((:commit . "fba0018a13eba70c2bffc6153dcfee99937fa3d6") (:authors ("Ono Hiroko" . "azazabc123@gmail.com")) (:maintainers ("Ono Hiroko" . "azazabc123@gmail.com")) (:maintainer "Ono Hiroko" . "azazabc123@gmail.com") (:keywords "tools" "fun") (:url . "https://github.com/kuanyui/kaomoji.el"))]) (kapacitor . [(20190414 1908) ((emacs (25 1)) (magit (2 13 0)) (magit-popup (2 12 4))) "Main file for kapacitor-mode" tar ((:commit . "e3300d8b4017a2f66b0d929cb85bcc7ee2612072") (:authors ("Manoj Kumar Manikchand" . "manojm.321@gmail.com")) (:maintainers ("Manoj Kumar Manikchand" . "manojm.321@gmail.com")) (:maintainer "Manoj Kumar Manikchand" . "manojm.321@gmail.com") (:keywords "kapacitor" "emacs" "magit" "tools") (:url . "http://github.com/Manoj321/kapacitor-el"))]) @@ -2929,7 +2934,7 @@ (kfg . [(20140909 538) ((f (0 17 1))) "an emacs configuration system" tar ((:commit . "ffc35b77f227d4c64a1271ec30d31333ffeb0013") (:authors ("Austin Bingham" . "austin.bingham@gmail.com")) (:maintainers ("Austin Bingham" . "austin.bingham@gmail.com")) (:maintainer "Austin Bingham" . "austin.bingham@gmail.com") (:url . "https://github.com/abingham/kfg"))]) (khalel . [(20240527 527) ((emacs (27 1))) "Import, edit and create calendar events through khal" tar ((:commit . "14ef50352394cd1d62b80bc17ab14f4f801f47cd") (:authors ("Hanno Perrey <http://gitlab.com/hperrey>")) (:maintainers ("Hanno Perrey" . "hanno@hoowl.se")) (:maintainer "Hanno Perrey" . "hanno@hoowl.se") (:keywords "event" "calendar" "ics" "khal") (:url . "https://gitlab.com/hperrey/khalel"))]) (khardel . [(20231126 1502) ((emacs (27 1)) (yaml-mode (0 0 13))) "Integrate with khard" tar ((:commit . "205e374b36252183a146a7a8f857bcf95a77edc3") (:authors ("Damien Cassou" . "damien@cassou.me")) (:maintainers ("Damien Cassou" . "damien@cassou.me")) (:maintainer "Damien Cassou" . "damien@cassou.me") (:url . "https://github.com/DamienCassou/khardel"))]) - (khoj . [(20240618 1143) ((emacs (27 1)) (transient (0 3 0)) (dash (2 19 1))) "AI copilot for your Second Brain" tar ((:commit . "677d49d438ef07f92c68c53e4cd2a71a6dc3fe6c") (:authors ("Debanjum Singh Solanky" . "debanjum@khoj.dev") ("Saba Imran" . "saba@khoj.dev")) (:maintainers ("Debanjum Singh Solanky" . "debanjum@khoj.dev")) (:maintainer "Debanjum Singh Solanky" . "debanjum@khoj.dev") (:keywords "search" "chat" "org-mode" "outlines" "markdown" "pdf" "image") (:url . "https://github.com/khoj-ai/khoj/tree/master/src/interface/emacs"))]) + (khoj . [(20240626 508) ((emacs (27 1)) (transient (0 3 0)) (dash (2 19 1))) "AI copilot for your Second Brain" tar ((:commit . "4f89319b40cd05adeb6ff15a19b583eedfdd0520") (:authors ("Debanjum Singh Solanky" . "debanjum@khoj.dev") ("Saba Imran" . "saba@khoj.dev")) (:maintainers ("Debanjum Singh Solanky" . "debanjum@khoj.dev")) (:maintainer "Debanjum Singh Solanky" . "debanjum@khoj.dev") (:keywords "search" "chat" "org-mode" "outlines" "markdown" "pdf" "image") (:url . "https://github.com/khoj-ai/khoj/tree/master/src/interface/emacs"))]) (kibit-helper . [(20150508 1533) ((s (0 8)) (emacs (24))) "Conveniently use the Kibit Leiningen plugin from Emacs" tar ((:commit . "ec5f154db3bb0c838e86f527353f08644cede926") (:authors ("Jonas Enlund") ("James Elliott" . "james@brunchboy.com")) (:maintainers ("Jonas Enlund")) (:maintainer "Jonas Enlund") (:keywords "languages" "clojure" "kibit") (:url . "http://www.github.com/brunchboy/kibit-helper"))]) (kill-file-path . [(20230306 1041) ((emacs (26))) "Copy file name into kill ring" tar ((:commit . "5dcbce69cbae17665216a32dd20f27de54c62972") (:authors ("Adam Chyła" . "adam@chyla.org")) (:maintainers ("Adam Chyła" . "adam@chyla.org")) (:maintainer "Adam Chyła" . "adam@chyla.org") (:keywords "files") (:url . "https://github.com/chyla/kill-file-path/kill-file-path.el"))]) (kill-or-bury-alive . [(20230606 1503) ((emacs (24 4))) "Precise control over buffer killing" tar ((:commit . "16c393db6ad0c7e184af0a24d26b637e23543b1f") (:authors ("Mark Karpov" . "markkarpov92@gmail.com")) (:maintainers ("Mark Karpov" . "markkarpov92@gmail.com")) (:maintainer "Mark Karpov" . "markkarpov92@gmail.com") (:keywords "convenience") (:url . "https://github.com/mrkkrp/kill-or-bury-alive"))]) @@ -3018,7 +3023,7 @@ (leanote . [(20161223 139) ((emacs (24 4)) (cl-lib (0 5)) (request (0 2)) (let-alist (1 0 3)) (pcache (0 4 0)) (s (1 10 0)) (async (1 9))) "A minor mode writing markdown leanote" tar ((:commit . "d499e7b59bb1f1a2fabc0e4c26fb101ed62ebc7b") (:authors ("Aborn Jiang" . "aborn.jiang@gmail.com")) (:maintainers ("Aborn Jiang" . "aborn.jiang@gmail.com")) (:maintainer "Aborn Jiang" . "aborn.jiang@gmail.com") (:keywords "leanote" "note" "markdown") (:url . "https://github.com/aborn/leanote-emacs"))]) (learn-ocaml . [(20211003 1412) ((emacs (25 1))) "Emacs frontend for learn-ocaml" tar ((:commit . "abdc263537a6a534152a4eaaa17b2c3e4e10418b") (:url . "https://github.com/pfitaxel/learn-ocaml.el"))]) (ledger-import . [(20230904 1837) ((emacs (25 1))) "Fetch OFX files from bank and push them to Ledger" tar ((:commit . "e47e8508794462986b982d6ce3d05bcd17c19242") (:authors ("Damien Cassou" . "damien@cassou.me")) (:maintainers ("Damien Cassou" . "damien@cassou.me")) (:maintainer "Damien Cassou" . "damien@cassou.me") (:url . "https://gitlab.petton.fr/mpdel/libmpdel"))]) - (ledger-mode . [(20240527 2134) ((emacs (25 1))) "Helper code for use with the \"ledger\" command-line tool" tar ((:commit . "57de7d817296607a9a4721470f64e05c964744da"))]) + (ledger-mode . [(20240622 2052) ((emacs (25 1))) "Helper code for use with the \"ledger\" command-line tool" tar ((:commit . "b0e65f74a5a0db98fd1aea2bd87fcf9e489cdacb"))]) (leerzeichen . [(20220626 835) nil "Minor mode to display whitespace characters." tar ((:commit . "9d4126d5f6563569080845a69b0867119a9fd6ea") (:authors ("Felix Geller" . "fgeller@gmail.com")) (:maintainers ("Felix Geller" . "fgeller@gmail.com")) (:maintainer "Felix Geller" . "fgeller@gmail.com") (:keywords "whitespace" "characters") (:url . "http://github.com/fgeller/leerzeichen.el"))]) (leetcode . [(20230524 1851) ((emacs (26 1)) (dash (2 16 0)) (graphql (0 1 1)) (spinner (1 7 3)) (aio (1 0)) (log4e (0 3 3))) "An leetcode client" tar ((:commit . "e5701191a98d043acdc7112f28d67e3d5c848228") (:authors ("Wang Kai" . "kaiwkx@gmail.com")) (:maintainers ("Wang Kai" . "kaiwkx@gmail.com")) (:maintainer "Wang Kai" . "kaiwkx@gmail.com") (:keywords "extensions" "tools") (:url . "https://github.com/kaiwk/leetcode.el"))]) (legalese . [(20200119 2248) nil "Add legalese to your program files" tar ((:commit . "e465471d2d5a62d35073d93e0f8d40387a82e302") (:authors ("Jorgen Schaefer" . "forcer@forcix.cx")) (:maintainers ("Jorgen Schaefer" . "forcer@forcix.cx")) (:maintainer "Jorgen Schaefer" . "forcer@forcix.cx") (:keywords "convenience") (:url . "https://github.com/jorgenschaefer/legalese"))]) @@ -3058,7 +3063,7 @@ (linguistic . [(20181129 2116) nil "A package for basic linguistic analysis." tar ((:commit . "23e47e98cdb09ee61883669b6d8a11bf6449862c") (:authors ("Andrew Favia <drewlinguistics01 at gmail dot com>")) (:maintainers ("Andrew Favia <drewlinguistics01 at gmail dot com>")) (:maintainer "Andrew Favia <drewlinguistics01 at gmail dot com>") (:keywords "linguistics" "text analysis" "matching") (:url . "https://github.com/andcarnivorous/linguistic"))]) (lingva . [(20240607 1120) ((emacs (25 1))) "Access Google Translate without tracking via lingva.ml" tar ((:commit . "c4cd68fb3ab1ebf419be0ec92b77d9feac921a87") (:authors ("marty hiatt <martianhiatus [a t] riseup [d o t] net>")) (:maintainers ("marty hiatt <martianhiatus [a t] riseup [d o t] net>")) (:maintainer "marty hiatt <martianhiatus [a t] riseup [d o t] net>") (:keywords "convenience" "translation" "wp" "text") (:url . "https://codeberg.org/martianh/lingva.el"))]) (link . [(20191111 446) nil "Hypertext links in text buffers" tar ((:commit . "c9cad101100975e88873636bfd426b7a19304ebd") (:authors ("Torsten Hilbrich" . "torsten.hilbrich@gmx.net")) (:maintainers ("Torsten Hilbrich" . "torsten.hilbrich@gmx.net")) (:maintainer "Torsten Hilbrich" . "torsten.hilbrich@gmx.net") (:keywords "interface" "hypermedia"))]) - (link-hint . [(20240409 1250) ((avy (0 4 0)) (emacs (24 4))) "Use avy to open, copy, etc. visible links" tar ((:commit . "9ead085e9e6798ec4ea4791d9906d6655ea2b402") (:authors ("Fox Kiester" . "noct@posteo.net")) (:maintainers ("Fox Kiester" . "noct@posteo.net")) (:maintainer "Fox Kiester" . "noct@posteo.net") (:keywords "convenience" "url" "avy" "link" "links" "hyperlink") (:url . "https://github.com/noctuid/link-hint.el"))]) + (link-hint . [(20240626 1159) ((avy (0 4 0)) (emacs (24 4))) "Use avy to open, copy, etc. visible links" tar ((:commit . "391930f2010014b9b5bc16bb431db01dd21ca7bd") (:authors ("Fox Kiester" . "noct@posteo.net")) (:maintainers ("Fox Kiester" . "noct@posteo.net")) (:maintainer "Fox Kiester" . "noct@posteo.net") (:keywords "convenience" "url" "avy" "link" "links" "hyperlink") (:url . "https://github.com/noctuid/link-hint.el"))]) (linkode . [(20240604 53) nil "Generate a linkode snippet with region/buffer content" tar ((:commit . "5152aa3ba7a4360133efd5892f0891837af30440") (:authors ("Erick Navarro" . "erick@navarro.io")) (:maintainers ("Erick Navarro" . "erick@navarro.io")) (:maintainer "Erick Navarro" . "erick@navarro.io") (:url . "https://github.com/erickgnavar/linkode.el"))]) (linphone . [(20130524 1109) nil "Emacs interface to Linphone" tar ((:commit . "99af3db941b7f4e5272bb48bff96c1ce4ceac302") (:authors ("Yoni Rabkin" . "yonirabkin@member.fsf.org")) (:maintainers ("Yoni Rabkin" . "yonirabkin@member.fsf.org")) (:maintainer "Yoni Rabkin" . "yonirabkin@member.fsf.org") (:keywords "comm") (:url . "https://github.com/zabbal/emacs-linphone"))]) (linum-off . [(20160217 2137) nil "Provides an interface for turning line-numbering off" tar ((:commit . "3e37baaad27d27e405f8dfe01d4ab9cd5b591353") (:authors ("Matthew L. Fidler, Florian Adamsky (see wiki)")) (:maintainers ("Matthew L. Fidler")) (:maintainer "Matthew L. Fidler") (:keywords "line" "numbering") (:url . "http://www.emacswiki.org/emacs/auto-indent-mode.el "))]) @@ -3107,7 +3112,7 @@ (loc-changes . [(20230214 1036) nil "keep track of positions even after buffer changes" tar ((:commit . "622371e432f50626aaac82f8ee2841f71685b0fb") (:authors ("Rocky Bernstein" . "rocky@gnu.org")) (:maintainers ("Rocky Bernstein" . "rocky@gnu.org")) (:maintainer "Rocky Bernstein" . "rocky@gnu.org") (:url . "https://github.com/rocky/emacs-loc-changes"))]) (loccur . [(20240610 1830) ((emacs (25 1))) "Perform an occur-like folding in current buffer" tar ((:commit . "f47c53a24a9d262898517c71284337821dad7ea9") (:authors ("Alexey Veretennikov" . "alexey.veretennikov@gmail.com")) (:maintainers ("Alexey Veretennikov" . "alexey.veretennikov@gmail.com")) (:maintainer "Alexey Veretennikov" . "alexey.veretennikov@gmail.com") (:keywords "matching") (:url . "https://codeberg.org/fourier/loccur"))]) (lockfile-mode . [(20170625 507) nil "Major mode for .lock files" tar ((:commit . "496b6035716df0582f879f9488f296947cabead2") (:authors ("Preetpal S. Sohal")) (:maintainers ("Preetpal S. Sohal")) (:maintainer "Preetpal S. Sohal") (:url . "https://github.com/preetpalS/emacs-lockfile-mode"))]) - (loco . [(20240619 17) ((emacs (29 1))) "A library and minor mode for entering key sequences" tar ((:commit . "38f0bb01422fe75757ab089be31c086b70e6d1f2") (:authors ("Chris McLaren" . "csmclaren@me.com")) (:maintainers ("Chris McLaren" . "csmclaren@me.com")) (:maintainer "Chris McLaren" . "csmclaren@me.com") (:keywords "abbrev" "convenience") (:url . "https://github.com/csmclaren/loco"))]) + (loco . [(20240626 1356) ((emacs (29 1))) "A library and minor mode for entering key sequences" tar ((:commit . "bcedf0d9d94b70e9fe67849ac788d1ea2bcd9648") (:authors ("Chris McLaren" . "csmclaren@me.com")) (:maintainers ("Chris McLaren" . "csmclaren@me.com")) (:maintainer "Chris McLaren" . "csmclaren@me.com") (:keywords "abbrev" "convenience") (:url . "https://github.com/csmclaren/loco"))]) (lodgeit . [(20190802 1308) nil "Paste to a lodgeit powered pastebin" tar ((:commit . "442637194d48a7105b7747b8d98772f5899f9e21") (:authors ("Eric Larson" . "eric@ionrock.org")) (:maintainers ("Eric Larson" . "eric@ionrock.org")) (:maintainer "Eric Larson" . "eric@ionrock.org") (:keywords "pastebin" "lodgeit") (:url . "https://github.com/ionrock/lodgeit-el"))]) (log4e . [(20240123 1313) nil "provide logging framework for elisp" tar ((:commit . "6d71462df9bf595d3861bfb328377346aceed422") (:authors ("Hiroaki Otsu" . "ootsuhiroaki@gmail.com")) (:maintainers ("Hiroaki Otsu" . "ootsuhiroaki@gmail.com")) (:maintainer "Hiroaki Otsu" . "ootsuhiroaki@gmail.com") (:keywords "log") (:url . "https://github.com/aki2o/log4e"))]) (log4j-mode . [(20230826 1331) ((emacs (25 1))) "Major mode for viewing log files" tar ((:commit . "45d5e3ee918f502a160c3a131ce75fd3c38e5c6e") (:authors ("Johan Dykstrom")) (:maintainers ("Johan Dykstrom")) (:maintainer "Johan Dykstrom") (:keywords "tools") (:url . "https://github.com/dykstrom/log4j-mode"))]) @@ -3145,7 +3150,7 @@ (lsp-latex . [(20240324 1218) ((emacs (27 1)) (lsp-mode (6 0)) (consult (0 35))) "LSP-mode client for LaTeX, on texlab" tar ((:commit . "30e5ee2a387bee7b320564d402b3e587cdae536c") (:authors ("ROCKTAKEY" . "rocktakey@gmail.com")) (:maintainers ("ROCKTAKEY" . "rocktakey@gmail.com")) (:maintainer "ROCKTAKEY" . "rocktakey@gmail.com") (:keywords "languages" "tex") (:url . "https://github.com/ROCKTAKEY/lsp-latex"))]) (lsp-ltex . [(20240425 2049) ((emacs (27 1)) (lsp-mode (6 1))) "LSP Clients for LTEX" tar ((:commit . "c473ed37aa0f2769bb0b4c344cc28f95975dbc17") (:authors ("Shen, Jen-Chieh" . "jcs090218@gmail.com")) (:maintainers ("Shen, Jen-Chieh" . "jcs090218@gmail.com")) (:maintainer "Shen, Jen-Chieh" . "jcs090218@gmail.com") (:keywords "convenience" "lsp" "languagetool" "checker") (:url . "https://github.com/emacs-languagetool/lsp-ltex"))]) (lsp-metals . [(20240508 627) ((emacs (27 1)) (scala-mode (0 23)) (lsp-mode (7 0)) (lsp-treemacs (0 2)) (dap-mode (0 3)) (dash (2 18 0)) (f (0 20 0)) (ht (2 0)) (treemacs (3 1)) (posframe (1 4 1))) "Scala Client settings" tar ((:commit . "fa4072cbe7a7061cdb218b9a3619979f7facba0e") (:authors ("Ross A. Baker" . "ross@rossabaker.com") ("Evgeny Kurnevsky" . "kurnevsky@gmail.com")) (:maintainers ("Ross A. Baker" . "ross@rossabaker.com")) (:maintainer "Ross A. Baker" . "ross@rossabaker.com") (:keywords "languages" "extensions") (:url . "https://github.com/emacs-lsp/lsp-metals"))]) - (lsp-mode . [(20240619 951) ((emacs (27 1)) (dash (2 18 0)) (f (0 20 0)) (ht (2 3)) (spinner (1 7 3)) (markdown-mode (2 3)) (lv (0)) (eldoc (1 11))) "LSP mode" tar ((:commit . "cec9e56390e90d7ced3b18a922ab954e782b8628") (:authors ("Vibhav Pant, Fangrui Song, Ivan Yonchovski")) (:maintainers ("Vibhav Pant, Fangrui Song, Ivan Yonchovski")) (:maintainer "Vibhav Pant, Fangrui Song, Ivan Yonchovski") (:keywords "languages") (:url . "https://github.com/emacs-lsp/lsp-mode"))]) + (lsp-mode . [(20240625 344) ((emacs (27 1)) (dash (2 18 0)) (f (0 20 0)) (ht (2 3)) (spinner (1 7 3)) (markdown-mode (2 3)) (lv (0)) (eldoc (1 11))) "LSP mode" tar ((:commit . "7b1b0c32cc755198cb09f6c3aef069ecfec2e428") (:authors ("Vibhav Pant, Fangrui Song, Ivan Yonchovski")) (:maintainers ("Vibhav Pant, Fangrui Song, Ivan Yonchovski")) (:maintainer "Vibhav Pant, Fangrui Song, Ivan Yonchovski") (:keywords "languages") (:url . "https://github.com/emacs-lsp/lsp-mode"))]) (lsp-mssql . [(20230510 1124) ((emacs (25 1)) (lsp-mode (6 2)) (dash (2 14 1)) (f (0 20 0)) (ht (2 0)) (lsp-treemacs (0 1))) "MSSQL LSP bindings" tar ((:commit . "a0dba8f86a2ace7e800a9dc8f814767625a509af") (:authors ("Ivan Yonchovski" . "yyoncho@gmail.com")) (:maintainers ("Ivan Yonchovski" . "yyoncho@gmail.com")) (:maintainer "Ivan Yonchovski" . "yyoncho@gmail.com") (:keywords "data" "languages") (:url . "https://github.com/emacs-lsp/lsp-mssql"))]) (lsp-origami . [(20230815 704) ((emacs (27 1)) (origami (1 0)) (lsp-mode (6 1))) "origami.el support for lsp-mode" tar ((:commit . "86aa06517910141c3d5054eea5f7723461fce6a6") (:authors ("Vibhav Pant")) (:maintainers ("Vibhav Pant")) (:maintainer "Vibhav Pant") (:keywords "languages" "lsp-mode") (:url . "https://github.com/emacs-lsp/lsp-origami"))]) (lsp-p4 . [(20190127 1049) ((lsp-mode (3 0))) "P4 support for lsp-mode" tar ((:commit . "084e33a5782f9153502d9b03e63d9cbbe81cdaeb") (:authors ("Dmitri Makarov")) (:maintainers ("Dmitri Makarov")) (:maintainer "Dmitri Makarov") (:keywords "lsp" "p4") (:url . "https://github.com/dmakarov/p4ls"))]) @@ -3185,7 +3190,7 @@ (magic-filetype . [(20240130 1805) ((emacs (24 3)) (s (1 9 0))) "Enhance filetype major mode" tar ((:commit . "3979ddbd8066d7390e31bde2b35f997c5f5f4516") (:authors ("USAMI Kenta" . "tadsan@zonu.me")) (:maintainers ("USAMI Kenta" . "tadsan@zonu.me")) (:maintainer "USAMI Kenta" . "tadsan@zonu.me") (:keywords "emulations" "vim" "ft" "file" "magic-mode") (:url . "https://github.com/emacs-php/magic-filetype.el"))]) (magic-latex-buffer . [(20210306 422) ((cl-lib (0 5)) (emacs (25 1))) "Magically enhance LaTeX-mode font-locking for semi-WYSIWYG editing" tar ((:commit . "903ec91872760e47c0e5715795f8465173615098") (:authors ("zk_phi")) (:maintainers ("zk_phi")) (:maintainer "zk_phi") (:url . "http://zk-phi.github.io/"))]) (magik-mode . [(20240521 1419) ((emacs (24 4)) (compat (28 1))) "Emacs major mode for Smallworld Magik files" tar ((:commit . "51ec2d21e4d68fc549d2022f86a882e090541ec3") (:keywords "languages") (:url . "https://github.com/roadrunner1776/magik"))]) - (magit . [(20240622 1531) ((emacs (26 1)) (compat (29 1 4 5)) (dash (20240405)) (git-commit (20240429)) (magit-section (20240429)) (seq (2 24)) (transient (20240421)) (with-editor (20240415))) "A Git porcelain inside Emacs." tar ((:commit . "71630e4db1ff69a8e2c13f112c21b26d8bddf1e6") (:authors ("Marius Vollmer" . "marius.vollmer@gmail.com") ("Jonas Bernoulli" . "emacs.magit@jonas.bernoulli.dev")) (:maintainer "Jonas Bernoulli" . "emacs.magit@jonas.bernoulli.dev") (:keywords "git" "tools" "vc") (:url . "https://github.com/magit/magit"))]) + (magit . [(20240625 2109) ((emacs (26 1)) (compat (29 1 4 5)) (dash (20240405)) (git-commit (20240429)) (magit-section (20240429)) (seq (2 24)) (transient (20240421)) (with-editor (20240415))) "A Git porcelain inside Emacs." tar ((:commit . "703dfe58120cc5bdf1a1a454362b174a164d3613") (:authors ("Marius Vollmer" . "marius.vollmer@gmail.com") ("Jonas Bernoulli" . "emacs.magit@jonas.bernoulli.dev")) (:maintainer "Jonas Bernoulli" . "emacs.magit@jonas.bernoulli.dev") (:keywords "git" "tools" "vc") (:url . "https://github.com/magit/magit"))]) (magit-annex . [(20231210 2140) ((cl-lib (0 3)) (magit (3 0 0))) "Control git-annex from Magit" tar ((:commit . "056f0d4462cdccbd7bb7589994da7fef9de766da") (:authors ("Kyle Meyer" . "kyle@kyleam.com") ("Rémi Vanicat" . "vanicat@debian.org")) (:maintainers ("Kyle Meyer" . "kyle@kyleam.com")) (:maintainer "Kyle Meyer" . "kyle@kyleam.com") (:keywords "vc" "tools") (:url . "https://github.com/magit/magit-annex"))]) (magit-commit-mark . [(20240421 931) ((emacs (29 1)) (magit (3 3 0))) "Support marking commits as read" tar ((:commit . "d09d0df6f8a697446e9fac77428b32997b94c59e") (:authors ("Campbell Barton" . "ideasman42@gmail.com")) (:maintainers ("Campbell Barton" . "ideasman42@gmail.com")) (:maintainer "Campbell Barton" . "ideasman42@gmail.com") (:url . "https://codeberg.org/ideasman42/emacs-magit-commit-mark"))]) (magit-delta . [(20220125 50) ((emacs (25 1)) (magit (20200426)) (xterm-color (2 0))) "Use Delta when displaying diffs in Magit" tar ((:commit . "5fc7dbddcfacfe46d3fd876172ad02a9ab6ac616") (:authors ("Dan Davison" . "dandavison7@gmail.com")) (:maintainers ("Dan Davison" . "dandavison7@gmail.com")) (:maintainer "Dan Davison" . "dandavison7@gmail.com") (:url . "https://github.com/dandavison/magit-delta"))]) @@ -3196,7 +3201,8 @@ (magit-gerrit . [(20240514 1139) ((emacs (25 1)) (magit (2 90 1)) (transient (0 3 0))) "Magit plugin for Gerrit Code Review" tar ((:commit . "46fe81c76fd2d3e5e97207cd1d951f22ecb16573") (:authors ("Brian Fransioli" . "assem@terranpro.org")) (:maintainers ("Brian Fransioli" . "assem@terranpro.org")) (:maintainer "Brian Fransioli" . "assem@terranpro.org") (:url . "https://github.com/emacsorphanage/magit-gerrit"))]) (magit-gh-pulls . [(20191230 1944) ((emacs (24 4)) (gh (0 9 1)) (magit (2 12 0)) (pcache (0 2 3)) (s (1 6 1))) "GitHub pull requests extension for Magit" tar ((:commit . "57f3a5158bbc7bfd169ee136fde351cce999e0ca") (:authors ("Yann Hodique" . "yann.hodique@gmail.com")) (:maintainers ("Yann Hodique" . "yann.hodique@gmail.com")) (:maintainer "Yann Hodique" . "yann.hodique@gmail.com") (:keywords "git" "tools") (:url . "https://github.com/sigma/magit-gh-pulls"))]) (magit-gitflow . [(20170929 824) ((magit (2 1 0)) (magit-popup (2 2 0))) "gitflow extension for magit" tar ((:commit . "cc41b561ec6eea947fe9a176349fb4f771ed865b") (:authors ("Jan Tatarik" . "Jan.Tatarik@gmail.com")) (:maintainers ("Jan Tatarik" . "Jan.Tatarik@gmail.com")) (:maintainer "Jan Tatarik" . "Jan.Tatarik@gmail.com") (:keywords "vc" "tools") (:url . "https://github.com/jtatarik/magit-gitflow"))]) - (magit-gptcommit . [(20240406 807) ((emacs (29 1)) (dash (2 13 0)) (magit (2 90 1)) (gptel (0 6 0))) "Git commit with help of gpt" tar ((:commit . "3584b1036574c704e5bae04274b8849590a097b0") (:authors ("Tiou Lims" . "dourokinga@gmail.com")) (:maintainers ("Tiou Lims" . "dourokinga@gmail.com")) (:maintainer "Tiou Lims" . "dourokinga@gmail.com") (:url . "https://github.com/douo/magit-gptcommit"))]) + (magit-gitlab . [(20240621 908) ((emacs (26 1)) (magit (3 3 0)) (ghub (3 6 0)) (transient (0 6 0))) "Magit plugin for manipulating GitLab merge requests" tar ((:commit . "bce71a0ec40d08d70ae06f9e20775bfb8a80779a") (:authors ("Arvid Jakobsson" . "arvid.jakobsson@gmail.com")) (:maintainers ("Arvid Jakobsson" . "arvid.jakobsson@gmail.com")) (:maintainer "Arvid Jakobsson" . "arvid.jakobsson@gmail.com") (:url . "https://gitlab.com/arvidnl/magit-gitlab"))]) + (magit-gptcommit . [(20240625 356) ((emacs (29 1)) (dash (2 13 0)) (magit (2 90 1)) (llm (0 16 1))) "Git commit with help of gpt" tar ((:commit . "91b23fde4a880566a4e493240865e3582cad7306") (:authors ("Tiou Lims" . "dourokinga@gmail.com")) (:maintainers ("Tiou Lims" . "dourokinga@gmail.com")) (:maintainer "Tiou Lims" . "dourokinga@gmail.com") (:url . "https://github.com/douo/magit-gptcommit"))]) (magit-imerge . [(20230522 1054) ((emacs (25 1)) (magit (3 0 0))) "Magit extension for git-imerge" tar ((:commit . "b7cfe49a197c2cf5948109921e053711b156389d") (:authors ("Kyle Meyer" . "kyle@kyleam.com")) (:maintainers ("Kyle Meyer" . "kyle@kyleam.com")) (:maintainer "Kyle Meyer" . "kyle@kyleam.com") (:keywords "vc" "tools") (:url . "https://github.com/magit/magit-imerge"))]) (magit-lfs . [(20221031 1447) ((emacs (24 4)) (magit (2 10 3)) (dash (2 13 0))) "Magit plugin for Git LFS" tar ((:commit . "cd9f46e1840270be27e2c2d9dcf036ff0781f66d") (:authors ("Junyoung/Clare Jang" . "jjc9310@gmail.com")) (:maintainers ("Junyoung/Clare Jang" . "jjc9310@gmail.com")) (:maintainer "Junyoung/Clare Jang" . "jjc9310@gmail.com") (:keywords "magit" "git" "lfs" "tools" "vc") (:url . "https://github.com/ailrun/magit-lfs"))]) (magit-org-todos . [(20180709 1950) ((magit (2 0 0)) (emacs (24))) "Add local todo items to the magit status buffer" tar ((:commit . "9ffa3efb098434d837cab4bacd1601fdfc6fe999") (:authors ("Daniel Ma")) (:maintainers ("Daniel Ma")) (:maintainer "Daniel Ma") (:keywords "org-mode" "magit" "tools") (:url . "http://github.com/danielma/magit-org-todos"))]) @@ -3205,7 +3211,7 @@ (magit-popup . [(20200719 1015) ((emacs (24 4)) (dash (2 13 0))) "Define prefix-infix-suffix command combos" tar ((:commit . "d8585fa39f88956963d877b921322530257ba9f5") (:authors ("Jonas Bernoulli" . "jonas@bernoul.li")) (:maintainers ("Jonas Bernoulli" . "jonas@bernoul.li")) (:maintainer "Jonas Bernoulli" . "jonas@bernoul.li") (:keywords "bindings") (:url . "https://github.com/magit/magit-popup"))]) (magit-rbr . [(20181009 2016) ((magit (2 13 0)) (emacs (24 3))) "Support for git rbr in Magit" tar ((:commit . "029203b3e48537205052a058e964f058cd802c3c") (:authors ("Anatoly Fayngelerin" . "fanatoly+magitrbr@gmail.com")) (:maintainers ("Anatoly Fayngelerin" . "fanatoly+magitrbr@gmail.com")) (:maintainer "Anatoly Fayngelerin" . "fanatoly+magitrbr@gmail.com") (:keywords "git" "magit" "rbr" "tools") (:url . "https://github.com/fanatoly/magit-rbr"))]) (magit-reviewboard . [(20200727 1748) ((emacs (25 2)) (magit (2 13 0)) (s (1 12 0)) (request (0 3 0))) "Show open Reviewboard reviews in Magit" tar ((:commit . "aceedff88921f1dfef8a6b2fb18fe316fb7223a8") (:authors ("Jules Tamagnan" . "jtamagnan@gmail.com")) (:maintainers ("Jules Tamagnan" . "jtamagnan@gmail.com")) (:maintainer "Jules Tamagnan" . "jtamagnan@gmail.com") (:keywords "magit" "vc") (:url . "http://github.com/jtamagnan/magit-reviewboard"))]) - (magit-section . [(20240621 2229) ((emacs (26 1)) (compat (29 1 4 5)) (dash (20240405))) "Sections for read-only buffers." tar ((:commit . "ea0f07e54967197ac0b072a69ba314314a4080c1") (:authors ("Jonas Bernoulli" . "emacs.magit@jonas.bernoulli.dev")) (:maintainer "Jonas Bernoulli" . "emacs.magit@jonas.bernoulli.dev") (:keywords "tools") (:url . "https://github.com/magit/magit"))]) + (magit-section . [(20240624 719) ((emacs (26 1)) (compat (29 1 4 5)) (dash (20240405))) "Sections for read-only buffers." tar ((:commit . "0178d59d714f7968b8c5821fea95e68d27dde974") (:authors ("Jonas Bernoulli" . "emacs.magit@jonas.bernoulli.dev")) (:maintainer "Jonas Bernoulli" . "emacs.magit@jonas.bernoulli.dev") (:keywords "tools") (:url . "https://github.com/magit/magit"))]) (magit-stats . [(20230223 1819) ((emacs (25 1))) "Generates GIT Repo Statistics Report" tar ((:commit . "41b18e5fc664dba93981a7931f476632c5b54a7d") (:authors ("Rahul M. Juliato")) (:maintainers ("Rahul M. Juliato")) (:maintainer "Rahul M. Juliato") (:keywords "vc" "convenience") (:url . "https://github.com/LionyxML/magit-stats"))]) (magit-stgit . [(20231226 1514) ((emacs (24 4)) (magit (2 12 0)) (magit-popup (2 12 0))) "StGit extension for Magit" tar ((:commit . "59d1eb355caf4adbbdf1e351f5861de61b0b5efa") (:authors ("Lluís Vilanova" . "vilanova@ac.upc.edu")) (:maintainers ("Peter Grayson" . "pete@jpgrayson.net")) (:maintainer "Peter Grayson" . "pete@jpgrayson.net") (:keywords "git" "tools" "vc") (:url . "https://github.com/stacked-git/magit-stgit"))]) (magit-svn . [(20220314 1451) ((emacs (25 1)) (magit (2 90 1)) (transient (0 3 2))) "Git-Svn extension for Magit" tar ((:commit . "b8277081db90977247ae3900ea6afeb0ca644d36") (:authors ("Phil Jackson" . "phil@shellarchive.co.uk")) (:maintainers ("Phil Jackson" . "phil@shellarchive.co.uk")) (:maintainer "Phil Jackson" . "phil@shellarchive.co.uk") (:keywords "vc" "tools"))]) @@ -3244,7 +3250,7 @@ (mark-tools . [(20130614 1025) nil "Some simple tools to access the mark-ring in Emacs" tar ((:commit . "a11b61effa90bd0abc876d12573674d36fc17f0c") (:authors ("Alex Bennée" . "alex@bennee.com")) (:maintainers ("Alex Bennée" . "alex@bennee.com")) (:maintainer "Alex Bennée" . "alex@bennee.com") (:url . "https://github.com/stsquad/emacs-mark-tools"))]) (mark-yank . [(20231105 2027) ((emacs (24 4))) "Set region to the last yank" tar ((:commit . "7207aabe9edd0872ec6d506a58b942b43926c122") (:authors ("Michael Kleehammer" . "michael@kleehammer.com")) (:maintainers ("Michael Kleehammer" . "michael@kleehammer.com")) (:maintainer "Michael Kleehammer" . "michael@kleehammer.com") (:url . "https://github.com/mkleehammer/mark-yank"))]) (markdown-changelog . [(20230805 1720) ((emacs (26)) (dash (2 13 0))) "Maintain changelog entries" tar ((:commit . "403d2cd1cff932ae135692d57062824892e01d13") (:authors ("Paul Landes")) (:maintainers ("Paul Landes")) (:maintainer "Paul Landes") (:keywords "markdown" "changelog" "files") (:url . "https://github.com/plandes/markdown-changelog"))]) - (markdown-mode . [(20240501 1057) ((emacs (27 1))) "Major mode for Markdown-formatted text" tar ((:commit . "0cdebc833ed9b98baf9f260ed12b1e36b0ca0e89") (:authors ("Jason R. Blevins" . "jblevins@xbeta.org")) (:maintainers ("Jason R. Blevins" . "jblevins@xbeta.org")) (:maintainer "Jason R. Blevins" . "jblevins@xbeta.org") (:keywords "markdown" "github flavored markdown" "itex") (:url . "https://jblevins.org/projects/markdown-mode/"))]) + (markdown-mode . [(20240626 826) ((emacs (27 1))) "Major mode for Markdown-formatted text" tar ((:commit . "8aab017f4790f7a1e0d8403239cce989c88412f6") (:authors ("Jason R. Blevins" . "jblevins@xbeta.org")) (:maintainers ("Jason R. Blevins" . "jblevins@xbeta.org")) (:maintainer "Jason R. Blevins" . "jblevins@xbeta.org") (:keywords "markdown" "github flavored markdown" "itex") (:url . "https://jblevins.org/projects/markdown-mode/"))]) (markdown-preview-eww . [(20160111 1502) ((emacs (24 4))) "Realtime preview by eww" tar ((:commit . "5853f836425c877c8a956501f0adda137ef1d3b7") (:authors ("niku" . "niku@niku.name")) (:maintainers ("niku" . "niku@niku.name")) (:maintainer "niku" . "niku@niku.name") (:url . "https://github.com/niku/markdown-preview-eww"))]) (markdown-preview-mode . [(20230707 803) ((emacs (24 4)) (websocket (1 6)) (markdown-mode (2 0)) (cl-lib (0 5)) (web-server (0 1 1))) "markdown realtime preview minor mode." tar ((:commit . "68242b3907dc065aa35412bfd928b43d8052d321") (:authors ("Igor Shymko" . "igor.shimko@gmail.com")) (:maintainers ("Igor Shymko" . "igor.shimko@gmail.com")) (:maintainer "Igor Shymko" . "igor.shimko@gmail.com") (:keywords "markdown" "gfm" "convenience") (:url . "https://github.com/ancane/markdown-preview-mode"))]) (markdown-soma . [(20240215 228) ((emacs (25)) (s (1 11 0)) (dash (2 19 1)) (f (0 20 0))) "Live preview for Markdown" tar ((:commit . "ba30e609108d32fe6e1998490548b4631e3e48c3") (:authors ("Jason Milkins" . "jasonm23@gmail.com")) (:maintainers ("Jason Milkins" . "jasonm23@gmail.com")) (:maintainer "Jason Milkins" . "jasonm23@gmail.com") (:keywords "wp" "docs" "text" "markdown") (:url . "https://github.com/jasonm23/markdown-soma"))]) @@ -3259,7 +3265,7 @@ (marshal . [(20201223 1853) ((emacs (25 1)) (ht (2 0))) "eieio extension for automatic (un)marshalling" tar ((:commit . "490496d974d03906f784707ecc2e0ac36ed84b96") (:authors ("Yann Hodique" . "yann.hodique@gmail.com")) (:maintainers ("Yann Hodique" . "yann.hodique@gmail.com")) (:maintainer "Yann Hodique" . "yann.hodique@gmail.com") (:keywords "extensions") (:url . "https://github.com/sigma/marshal.el"))]) (maruo-macro-mode . [(20160616 1349) ((emacs (24 3))) "Major mode for editing Hidemaru/Maruo macro script" tar ((:commit . "8fc9a38ad051eafa8eb94038711acc52c5d1d8d5") (:authors ("USAMI Kenta" . "tadsan@zonu.me")) (:maintainers ("USAMI Kenta" . "tadsan@zonu.me")) (:maintainer "USAMI Kenta" . "tadsan@zonu.me") (:keywords "programming" "editor" "macro"))]) (masm-mode . [(20200308 1450) ((emacs (25 1))) "MASM x86 and x64 assembly major mode" tar ((:commit . "ab63524d195332ec9f703783704231606e69c292") (:authors ("YiGeeker" . "zyfchinese@yeah.net")) (:maintainers ("YiGeeker" . "zyfchinese@yeah.net")) (:maintainer "YiGeeker" . "zyfchinese@yeah.net") (:keywords "languages") (:url . "https://github.com/YiGeeker/masm-mode"))]) - (mastodon . [(20240531 1213) ((emacs (27 1)) (request (0 3 0)) (persist (0 4))) "Client for fediverse services using the Mastodon API" tar ((:commit . "b7a6145b89d4b07e0932d4c9e7dad20d031c9bd7") (:authors ("Johnson Denen" . "johnson.denen@gmail.com") ("Marty Hiatt" . "martianhiatus@riseup.net")) (:maintainers ("Marty Hiatt" . "martianhiatus@riseup.net")) (:maintainer "Marty Hiatt" . "martianhiatus@riseup.net") (:url . "https://codeberg.org/martianh/mastodon.el"))]) + (mastodon . [(20240624 1315) ((emacs (27 1)) (request (0 3 0)) (persist (0 4))) "Client for fediverse services using the Mastodon API" tar ((:commit . "c14891151345abc20efb5669bbe209604c57450e") (:authors ("Johnson Denen" . "johnson.denen@gmail.com") ("Marty Hiatt" . "martianhiatus@riseup.net")) (:maintainers ("Marty Hiatt" . "martianhiatus@riseup.net")) (:maintainer "Marty Hiatt" . "martianhiatus@riseup.net") (:url . "https://codeberg.org/martianh/mastodon.el"))]) (material-theme . [(20210904 1226) ((emacs (24 1))) "A Theme based on the colors of the Google Material Design" tar ((:commit . "6823009bc92f82aa3a90e27e1009f7da8e87b648") (:authors ("Christoph Paulik" . "cpaulik@gmail.com")) (:maintainers ("Christoph Paulik" . "cpaulik@gmail.com")) (:maintainer "Christoph Paulik" . "cpaulik@gmail.com") (:keywords "themes") (:url . "http://github.com/cpaulik/emacs-material-theme"))]) (math-preview . [(20240519 740) ((emacs (26 1)) (json (1 4)) (dash (2 18 0)) (s (1 12 0))) "Preview TeX math equations inline" tar ((:commit . "7c12235c7f8bb1af0e712a8bfa77f1f2635d964a") (:authors ("Matsievskiy S.V.")) (:maintainers ("Matsievskiy S.V.")) (:maintainer "Matsievskiy S.V.") (:keywords "convenience") (:url . "https://gitlab.com/matsievskiysv/math-preview"))]) (math-symbol-lists . [(20220828 2047) nil "Lists of Unicode math symbols and latex commands" tar ((:commit . "ac3eb053d3b576fcdd192b0ac6ad5090ea3a7079") (:authors ("Vitalie Spinu" . "spinuvit@gmail.com")) (:maintainers ("Vitalie Spinu" . "spinuvit@gmail.com")) (:maintainer "Vitalie Spinu" . "spinuvit@gmail.com") (:keywords "unicode" "symbols" "mathematics") (:url . "https://github.com/vspinu/math-symbol-lists"))]) @@ -3292,6 +3298,7 @@ (memolist . [(20150804 1721) ((markdown-mode (22 0)) (ag (0 45))) "memolist.el is Emacs port of memolist.vim." tar ((:commit . "60c296e202a71e9dcf1c3936d47b5c4b95c5839f") (:authors ("mikanfactory <k952i4j14x17_at_gmail.com>")) (:maintainers ("mikanfactory")) (:maintainer "mikanfactory") (:keywords "markdown" "memo") (:url . "http://github.com/mikanfactory/emacs-memolist"))]) (mentor . [(20230103 1146) ((emacs (25 1)) (xml-rpc (1 6 15)) (seq (1 11)) (async (1 9 3)) (url-scgi (0 8))) "Frontend for the rTorrent bittorrent client" tar ((:commit . "f51dd4f3f87c54b7cc92189924b9d873a53f5a75") (:authors ("Stefan Kangas" . "stefankangas@gmail.com")) (:maintainers ("Stefan Kangas" . "stefankangas@gmail.com")) (:maintainer "Stefan Kangas" . "stefankangas@gmail.com") (:keywords "comm" "processes" "bittorrent") (:url . "https://github.com/skangas/mentor"))]) (meow . [(20240613 2044) ((emacs (27 1))) "Yet Another modal editing" tar ((:commit . "bc05b048d3582425717d114b837b8fe78d47a753") (:authors ("Shi Tianshu")) (:maintainers ("Shi Tianshu")) (:maintainer "Shi Tianshu") (:keywords "convenience" "modal-editing") (:url . "https://www.github.com/DogLooksGood/meow"))]) + (meow-tree-sitter . [(20240618 1545) ((emacs (29 1)) (meow (1 2 0))) "Tree-sitter powered motions for Meow" tar ((:commit . "a69947f11264a887d00954254492eb8d2784aad8") (:authors ("Ad" . "me@skissue.xyz")) (:maintainers ("Ad" . "me@skissue.xyz")) (:maintainer "Ad" . "me@skissue.xyz") (:keywords "convenience" "files" "languages" "tools") (:url . "https://github.com/skissue/meow-tree-sitter"))]) (merlin . [(20240604 1521) ((emacs (25 1))) "Mode for Merlin, an assistant for OCaml" tar ((:commit . "bd900fd6cda97cfd10f2bf520848d0a8b0fe35b7") (:authors ("Frédéric Bour <frederic.bour(_)lakaban.net>")) (:maintainers ("Frédéric Bour <frederic.bour(_)lakaban.net>")) (:maintainer "Frédéric Bour <frederic.bour(_)lakaban.net>") (:keywords "ocaml" "languages") (:url . "https://github.com/ocaml/merlin"))]) (merlin-ac . [(20221123 1408) ((emacs (25 1)) (merlin (3)) (auto-complete (1 5))) "Merlin and auto-complete integration" tar ((:commit . "8bcab034a680f57ddf58092fda6288dc4caddd2a") (:authors ("Simon Castellan <simon.castellan(_)iuwt.fr>") ("Frédéric Bour <frederic.bour(_)lakaban.net>") ("Thomas Refis <thomas.refis(_)gmail.com>")) (:maintainers ("Simon Castellan <simon.castellan(_)iuwt.fr>")) (:maintainer "Simon Castellan <simon.castellan(_)iuwt.fr>") (:keywords "ocaml" "languages") (:url . "http://github.com/ocaml/merlin"))]) (merlin-company . [(20221123 1408) ((emacs (25 1)) (merlin (3)) (company (0 9))) "Merlin and company mode integration" tar ((:commit . "8bcab034a680f57ddf58092fda6288dc4caddd2a") (:authors ("Simon Castellan <simon.castellan(_)iuwt.fr>") ("Frédéric Bour <frederic.bour(_)lakaban.net>") ("Thomas Refis <thomas.refis(_)gmail.com>")) (:maintainers ("Simon Castellan <simon.castellan(_)iuwt.fr>")) (:maintainer "Simon Castellan <simon.castellan(_)iuwt.fr>") (:keywords "ocaml" "languages") (:url . "http://github.com/ocaml/merlin"))]) @@ -3376,7 +3383,7 @@ (modern-sh . [(20211101 1001) ((emacs (25 1)) (hydra (0 15 0)) (eval-in-repl (0 9 7))) "Minor mode for editing shell script" tar ((:commit . "8ebebe77304aa8170f7af809e7564c79d3bd45da") (:keywords "languages" "programming") (:url . "https://github.com/damon-kwok/modern-sh"))]) (modtime-skip-mode . [(20140128 2201) nil "Minor mode for disabling modtime and supersession checks on files." tar ((:commit . "c0e49523aa26b2263a8693691ac775988015f592") (:authors ("Jordon Biondo" . "biondoj@mail.gvsu.edu")) (:maintainers ("Jordon Biondo" . "biondoj@mail.gvsu.edu")) (:maintainer "Jordon Biondo" . "biondoj@mail.gvsu.edu") (:url . "http://www.github.com/jordonbiondo/modtime-skip-mode"))]) (modular-config . [(20210726 1614) ((emacs (25 1))) "Organize your config into small and loadable modules" tar ((:commit . "043907d96efff70dfaea1e721de90bd35970e8bd") (:authors ("Sidharth Arya" . "sidhartharya10@gmail.com")) (:maintainers ("Sidharth Arya" . "sidhartharya10@gmail.com")) (:maintainer "Sidharth Arya" . "sidhartharya10@gmail.com") (:keywords "startup" "lisp" "tools") (:url . "https://github.com/SidharthArya/modular-config.el"))]) - (modus-themes . [(20240622 1837) ((emacs (27 1))) "Elegant, highly legible and customizable themes" tar ((:commit . "4c7358011182d7201c015367821109384dbb73d6") (:authors ("Protesilaos Stavrou" . "info@protesilaos.com")) (:maintainers ("Protesilaos Stavrou" . "info@protesilaos.com")) (:maintainer "Protesilaos Stavrou" . "info@protesilaos.com") (:keywords "faces" "theme" "accessibility") (:url . "https://github.com/protesilaos/modus-themes"))]) + (modus-themes . [(20240625 437) ((emacs (27 1))) "Elegant, highly legible and customizable themes" tar ((:commit . "c4ebbfd21015cf63cf0c4e46beeb232588b8b5ac") (:authors ("Protesilaos Stavrou" . "info@protesilaos.com")) (:maintainers ("Protesilaos Stavrou" . "info@protesilaos.com")) (:maintainer "Protesilaos Stavrou" . "info@protesilaos.com") (:keywords "faces" "theme" "accessibility") (:url . "https://github.com/protesilaos/modus-themes"))]) (moe-theme . [(20240430 1601) nil "A colorful eye-candy theme. Moe, moe, kyun!" tar ((:commit . "6df0d99a1a2006b218282f15d84609b88478ca7a") (:authors ("kuanyui" . "azazabc123@gmail.com")) (:maintainers ("kuanyui" . "azazabc123@gmail.com")) (:maintainer "kuanyui" . "azazabc123@gmail.com") (:keywords "themes") (:url . "https://github.com/kuanyui/moe-theme.el"))]) (molar-mass . [(20220922 1752) ((emacs (24 3))) "Calculates molar mass of a molecule" tar ((:commit . "c3b686c4b621b45fa4b17857b4934eb4487d74f5") (:authors ("Sergi Ruiz Trepat")) (:maintainers ("Sergi Ruiz Trepat")) (:maintainer "Sergi Ruiz Trepat") (:keywords "convenience" "chemistry") (:url . "https://github.com/sergiruiztrepat/molar-mass.el"))]) (molecule . [(20180527 743) ((emacs (25 1))) "Simple wrapper for molecule" tar ((:commit . "2ef72b81d9aa24ea782b71a061a3abdad6cae162") (:authors (": drymer <drymer [ AT ] autistici.org>")) (:maintainers (": drymer <drymer [ AT ] autistici.org>")) (:maintainer ": drymer <drymer [ AT ] autistici.org>") (:keywords ":" "languages" "terminals") (:url . "https://git.daemons.it/drymer/molecule.el"))]) @@ -3559,7 +3566,7 @@ (nntwitter . [(20230705 1110) ((emacs (25 1)) (dash (20190401)) (anaphora (20180618)) (request (20190819))) "Gnus Backend For Twitter" tar ((:commit . "e27acca9beeb6645dd13545d42f6d4d97d59d82c") (:keywords "news") (:url . "https://github.com/dickmao/nntwitter"))]) (no-clown-fiesta-theme . [(20231214 2115) ((emacs (26 1)) (autothemer (0 2))) "Not-so-colorful-theme" tar ((:commit . "0cd04a72aa5dcf61e82e2a613670334816326b02") (:authors ("ranmaru22")) (:maintainers ("ranmaru22")) (:maintainer "ranmaru22") (:url . "https://github.com/ranmaru22/no-clown-fiesta-theme.el"))]) (no-emoji . [(20180515 1837) ((emacs (24))) "Show :emoji-name: instead of emoji characters" tar ((:commit . "ebceeab50dbfe4d60235180a57633745dbc18c77") (:authors ("Peter" . "craven@gmx.net")) (:maintainers ("Peter" . "craven@gmx.net")) (:maintainer "Peter" . "craven@gmx.net") (:keywords "extensions") (:url . "https://github.com/ecraven/no-emoji"))]) - (no-littering . [(20240618 1829) ((emacs (25 1)) (compat (29 1 4 5))) "Help keeping ~/.config/emacs clean" tar ((:commit . "9078334e44393696c78c6acb4484480fd4cf4b5d") (:authors ("Jonas Bernoulli" . "emacs.no-littering@jonas.bernoulli.dev")) (:maintainers ("Jonas Bernoulli" . "emacs.no-littering@jonas.bernoulli.dev")) (:maintainer "Jonas Bernoulli" . "emacs.no-littering@jonas.bernoulli.dev") (:keywords "convenience") (:url . "https://github.com/emacscollective/no-littering"))]) + (no-littering . [(20240624 1447) ((emacs (25 1)) (compat (29 1 4 5))) "Help keeping ~/.config/emacs clean" tar ((:commit . "f45335ede7c1246f922816610139face112e236b") (:authors ("Jonas Bernoulli" . "emacs.no-littering@jonas.bernoulli.dev")) (:maintainers ("Jonas Bernoulli" . "emacs.no-littering@jonas.bernoulli.dev")) (:maintainer "Jonas Bernoulli" . "emacs.no-littering@jonas.bernoulli.dev") (:keywords "convenience") (:url . "https://github.com/emacscollective/no-littering"))]) (no-spam . [(20190724 1854) ((emacs (25 1))) "Add repeat delays to commands" tar ((:commit . "860860e4a0d59bd15c8e092dc42f5f7f769a428e") (:authors ("Daniel Phan" . "daniel.phan36@gmail.com")) (:maintainers ("Daniel Phan" . "daniel.phan36@gmail.com")) (:maintainer "Daniel Phan" . "daniel.phan36@gmail.com") (:keywords "keyboard" "tools") (:url . "https://github.com/mamapanda/no-spam"))]) (noaa . [(20240317 2321) ((emacs (27 1)) (kv (0 0 19)) (request (0 2 0)) (s (1 12 0))) "Get NOAA weather data" tar ((:commit . "7d68b5a580c64123f3bbd75f795a891dfdeb1746") (:authors ("David Thompson")) (:maintainers ("David Thompson")) (:maintainer "David Thompson") (:keywords "calendar") (:url . "https://codeberg.org/thomp/noaa"))]) (noccur . [(20191015 719) nil "Run multi-occur on project/dired files" tar ((:commit . "fa91647a305e89561d3dbe53da002fff49abe0bb") (:authors ("Nicolas Petton" . "petton.nicolas@gmail.com")) (:maintainers ("Nicolas Petton" . "petton.nicolas@gmail.com")) (:maintainer "Nicolas Petton" . "petton.nicolas@gmail.com") (:keywords "convenience"))]) @@ -3580,7 +3587,7 @@ (norns . [(20230820 2157) ((emacs (27 1)) (dash (2 17 0)) (s (1 12 0)) (f (0 20 0)) (request (0 3 2)) (websocket (1 13)) (lua-mode (20221218 605))) "Interactive development environment for monome norns" tar ((:commit . "7e8b73b621db7494a22914b16c614ef80521f7f7") (:keywords "processes" "terminals") (:url . "https://github.com/p3r7/norns.el"))]) (northcode-theme . [(20180423 1649) ((emacs (24))) "A dark theme focused on blue and orange colors." tar ((:commit . "4d3750461ba25ec45321318b5f1af4e8fdf16147") (:authors ("Andreas Larsen" . "andreas@northcode.no")) (:maintainers ("Andreas Larsen" . "andreas@northcode.no")) (:maintainer "Andreas Larsen" . "andreas@northcode.no") (:url . "https://github.com/Northcode/northcode-theme.el"))]) (nothing-theme . [(20200504 402) ((emacs (24 1))) "Monochrome theme" tar ((:commit . "17fc9ecc94af0c919a24c4fe92bb48890bb4c3b0") (:authors ("Jared Gorski," . "jaredgorski6@gmail.com")) (:maintainers ("Jared Gorski," . "jaredgorski6@gmail.com")) (:maintainer "Jared Gorski," . "jaredgorski6@gmail.com") (:url . "https://github.com/jaredgorski/nothing.el"))]) - (notink-theme . [(20240605 2018) ((emacs (26 1))) "A custom theme inspired by e-ink displays" tar ((:commit . "b87954598ca78c4adabe17b7f23723657c3460e8") (:authors ("MetroWind" . "chris.corsair@gmail.com")) (:maintainers ("MetroWind" . "chris.corsair@gmail.com")) (:maintainer "MetroWind" . "chris.corsair@gmail.com") (:keywords "faces") (:url . "https://github.com/MetroWind/notink-theme"))]) + (notink-theme . [(20240625 326) ((emacs (26 1))) "A custom theme inspired by e-ink displays" tar ((:commit . "d1e84622a491bb570d6a450706833fafaad74f39") (:authors ("MetroWind" . "chris.corsair@gmail.com")) (:maintainers ("MetroWind" . "chris.corsair@gmail.com")) (:maintainer "MetroWind" . "chris.corsair@gmail.com") (:keywords "faces") (:url . "https://github.com/MetroWind/notink-theme"))]) (notmuch . [(20240619 1038) nil "run notmuch within emacs" tar ((:commit . "b526c5ef0e1ae78380e68e5a24170542b884cbe3") (:url . "https://notmuchmail.org"))]) (notmuch-addr . [(20240618 1830) ((emacs (27 1)) (compat (29 1 4 5)) (notmuch (0 38))) "An alternative to notmuch-address.el" tar ((:commit . "fee2fbe426edad380104f8ef13e4e36f974c11d4") (:authors ("Jonas Bernoulli" . "emacs.notmuch-addr@jonas.bernoulli.dev")) (:maintainers ("Jonas Bernoulli" . "emacs.notmuch-addr@jonas.bernoulli.dev")) (:maintainer "Jonas Bernoulli" . "emacs.notmuch-addr@jonas.bernoulli.dev") (:keywords "mail") (:url . "https://git.sr.ht/~tarsius/notmuch-addr"))]) (notmuch-bookmarks . [(20230727 1504) ((seq (2 20)) (emacs (26 1)) (notmuch (0 29 3))) "Add bookmark handling for notmuch buffers" tar ((:commit . "7c053fd2d278dc3a9f07f86975867bfbb4e7448d") (:authors ("Jörg Volbers" . "joerg@joergvolbers.de")) (:maintainers ("Jörg Volbers" . "joerg@joergvolbers.de")) (:maintainer "Jörg Volbers" . "joerg@joergvolbers.de") (:keywords "mail") (:url . "https://github.com/publicimageltd/notmuch-bookmarks"))]) @@ -3848,7 +3855,7 @@ (org-mind-map . [(20180826 2340) ((emacs (24)) (dash (1 8 0)) (org (8 2 10))) "Creates a directed graph from org-mode files" tar ((:commit . "41df4b2e30455494f1848b4e06cc9208aa9e902b") (:authors ("Ted Wiles" . "theodore.wiles@gmail.com")) (:maintainers ("Ted Wiles" . "theodore.wiles@gmail.com")) (:maintainer "Ted Wiles" . "theodore.wiles@gmail.com") (:keywords "orgmode" "extensions" "graphviz" "dot") (:url . "https://github.com/theodorewiles/org-mind-map"))]) (org-ml . [(20230410 30) ((emacs (27 1)) (org (9 3)) (dash (2 17)) (s (1 12))) "Functional Org Mode API" tar ((:commit . "f57336a9126a168ad32ccce017c072474555395a") (:authors ("Nathan Dwarshuis" . "ndwar@yavin4.ch")) (:maintainers ("Nathan Dwarshuis" . "ndwar@yavin4.ch")) (:maintainer "Nathan Dwarshuis" . "ndwar@yavin4.ch") (:keywords "org-mode" "outlines") (:url . "https://github.com/ndwarshuis/org-ml"))]) (org-mobile-sync . [(20180606 524) ((emacs (24 3 50)) (org (8 0))) "automatically sync org-mobile on changes" tar ((:commit . "06764b943a528827df1e2acc6bc7806cc2c1351f") (:authors ("steckerhalter")) (:maintainers ("steckerhalter")) (:maintainer "steckerhalter") (:keywords "org-mode" "org" "mobile" "sync" "todo") (:url . "https://framagit.org/steckerhalter/org-mobile-sync"))]) - (org-modern . [(20240602 926) ((emacs (27 1)) (compat (29 1 4 4))) "Modern looks for Org" tar ((:commit . "0b7af08548e586c0d3b0ca4a683253da407220d1") (:authors ("Daniel Mendler" . "mail@daniel-mendler.de")) (:maintainers ("Daniel Mendler" . "mail@daniel-mendler.de")) (:maintainer "Daniel Mendler" . "mail@daniel-mendler.de") (:keywords "outlines" "hypermedia" "text") (:url . "https://github.com/minad/org-modern"))]) + (org-modern . [(20240625 452) ((emacs (27 1)) (compat (29 1 4 4))) "Modern looks for Org" tar ((:commit . "c3c97156ecb45cd666bb0bb9d8e7d08e923cb65e") (:authors ("Daniel Mendler" . "mail@daniel-mendler.de")) (:maintainers ("Daniel Mendler" . "mail@daniel-mendler.de")) (:maintainer "Daniel Mendler" . "mail@daniel-mendler.de") (:keywords "outlines" "hypermedia" "text") (:url . "https://github.com/minad/org-modern"))]) (org-movies . [(20210920 101) ((emacs (26 1)) (org (9 0)) (request (0 3 0))) "Manage watchlist with Org mode" tar ((:commit . "e96fecaffa2924de64a507aa31d2934e667ee1ea") (:authors ("Anh T Nguyen")) (:maintainers ("Anh T Nguyen")) (:maintainer "Anh T Nguyen") (:keywords "hypermedia" "outlines" "org") (:url . "https://github.com/teeann/org-movies"))]) (org-mpv-notes . [(20231210 628) ((emacs (28 1))) "Take notes in org mode while watching videos in mpv" tar ((:commit . "01d6d52a1f964e7bb61f0f65ac4fb2ccfa986f34") (:authors ("Bibek Panthi" . "bpanthi977@gmail.com")) (:maintainers ("Bibek Panthi" . "bpanthi977@gmail.com")) (:maintainer "Bibek Panthi" . "bpanthi977@gmail.com") (:url . "https://github.com/bpanthi977/org-mpv-notes"))]) (org-mru-clock . [(20240522 826) ((emacs (26 1))) "Clock in/out of tasks with completion and persistent history" tar ((:commit . "198beb2089ea5e457dd13e8ac64d775eeff8fd89") (:authors ("Kevin Brubeck Unhammer" . "unhammer@fsfe.org")) (:maintainers ("Kevin Brubeck Unhammer" . "unhammer@fsfe.org")) (:maintainer "Kevin Brubeck Unhammer" . "unhammer@fsfe.org") (:keywords "convenience" "calendar") (:url . "https://github.com/unhammer/org-mru-clock"))]) @@ -3910,7 +3917,7 @@ (org-shoplist . [(20240605 2257) ((emacs (25))) "Eat the world" tar ((:commit . "6c2daa0b663d01a498dca2f2f4f4b645be1c365a") (:authors ("lordnik22")) (:maintainers ("lordnik22")) (:maintainer "lordnik22") (:keywords "extensions" "matching") (:url . "https://github.com/lordnik22"))]) (org-side-tree . [(20240601 1001) ((emacs (28 1))) "Navigate Org outlines in side window tree" tar ((:commit . "e8da5217ce23440a62f4a46ef60e2082b6284b28") (:authors ("Grant Rosson <https://github.com/localauthor>")) (:maintainers ("Grant Rosson <https://github.com/localauthor>")) (:maintainer "Grant Rosson <https://github.com/localauthor>") (:url . "https://github.com/localauthor/org-side-tree"))]) (org-sidebar . [(20240102 9) ((emacs (26 1)) (compat (29 1)) (s (1 10 0)) (dash (2 18)) (org (9 6)) (org-ql (0 2)) (org-super-agenda (1 0))) "Helpful sidebar for Org buffers" tar ((:commit . "1e06d1b4ab5f0d09301712cdecb757c9437a7179") (:authors ("Adam Porter" . "adam@alphapapa.net")) (:maintainers ("Adam Porter" . "adam@alphapapa.net")) (:maintainer "Adam Porter" . "adam@alphapapa.net") (:keywords "hypermedia" "outlines" "org" "agenda") (:url . "https://github.com/alphapapa/org-sidebar"))]) - (org-sliced-images . [(20240620 1821) ((emacs (29 1)) (org (9 6 15))) "Sliced inline images in org-mode" tar ((:commit . "2f29ef1008c881e847b816fed2b4c2dca96aa39c") (:authors ("Jacob Fong" . "jacobcfong@gmail.com")) (:maintainers ("Jacob Fong" . "jacobcfong@gmail.com")) (:maintainer "Jacob Fong" . "jacobcfong@gmail.com") (:url . "https://github.com/jcfk/org-sliced-images"))]) + (org-sliced-images . [(20240624 428) ((emacs (29 1)) (org (9 6 15))) "Sliced inline images in org-mode" tar ((:commit . "b98b88a55eff07e998e7789e0bf7307dd71db050") (:authors ("Jacob Fong" . "jacobcfong@gmail.com")) (:maintainers ("Jacob Fong" . "jacobcfong@gmail.com")) (:maintainer "Jacob Fong" . "jacobcfong@gmail.com") (:url . "https://github.com/jcfk/org-sliced-images"))]) (org-snooze . [(20181229 1424) ((emacs (24 4))) "Snooze your code, doc and feed" tar ((:commit . "8799adc14a20f3489063d279ff69312de3180bf9") (:authors ("Bill Xue")) (:maintainers ("Bill Xue")) (:maintainer "Bill Xue") (:keywords "extensions") (:url . "https://github.com/xueeinstein/org-snooze.el"))]) (org-special-block-extras . [(20230721 43) ((s (1 13 1)) (dash (2 18 1)) (emacs (27 1)) (org (9 1)) (lf (1 0)) (dad-joke (1 4)) (seq (2 0)) (lolcat (0))) "30 new custom blocks & 34 link types for Org-mode" tar ((:commit . "d7bdf9fcfe28f96f9470719f3985a6e413592de8") (:authors ("Musa Al-hassy" . "alhassy@gmail.com")) (:maintainers ("Musa Al-hassy" . "alhassy@gmail.com")) (:maintainer "Musa Al-hassy" . "alhassy@gmail.com") (:keywords "org" "blocks" "colors" "convenience") (:url . "https://alhassy.github.io/org-special-block-extras"))]) (org-sql . [(20220621 2252) ((emacs (27 1)) (s (1 12)) (f (0 20 0)) (dash (2 17)) (org-ml (5 6 1))) "Org-Mode SQL converter" tar ((:commit . "43376abf46b897a9a862cfcc1c087f4b8688634c") (:authors ("Nathan Dwarshuis" . "natedwarshuis@gmail.com")) (:maintainers ("Nathan Dwarshuis" . "natedwarshuis@gmail.com")) (:maintainer "Nathan Dwarshuis" . "natedwarshuis@gmail.com") (:keywords "org-mode" "data") (:url . "https://github.com/ndwarshuis/org-sql"))]) @@ -3935,6 +3942,7 @@ (org-timeline . [(20211110 1952) ((dash (2 13 0)) (emacs (24 3))) "Add graphical view of agenda to agenda buffer." tar ((:commit . "2b300abc8adc9955418fa2334f55e0610bff79f5") (:authors ("Matúš Goljer" . "matus.goljer@gmail.com")) (:maintainers ("Matúš Goljer" . "matus.goljer@gmail.com")) (:maintainer "Matúš Goljer" . "matus.goljer@gmail.com") (:keywords "calendar") (:url . "https://github.com/Fuco1/org-timeline/"))]) (org-toodledo . [(20150301 1113) ((request-deferred (0 2 0)) (emacs (24)) (cl-lib (0 5))) "Toodledo integration for Emacs Org mode" tar ((:commit . "01b53b637f304b89cd3bf2d29009b5ed6ad9466d") (:authors ("Christopher J. White" . "emacs@grierwhite.com")) (:maintainers ("Christopher J. White" . "emacs@grierwhite.com")) (:maintainer "Christopher J. White" . "emacs@grierwhite.com") (:keywords "outlines" "data"))]) (org-tracktable . [(20161118 1329) ((emacs (24)) (cl-lib (0 5))) "Track your writing progress in an org-table" tar ((:commit . "8e0e60a582a034bd66d5efb72d513140b7d4d90a") (:authors ("tty-tourist" . "andreasrasholm@protonmail.com")) (:maintainers ("tty-tourist" . "andreasrasholm@protonmail.com")) (:maintainer "tty-tourist" . "andreasrasholm@protonmail.com") (:keywords "org" "writing") (:url . "https://github.com/tty-tourist/org-tracktable"))]) + (org-transclusion-http . [(20240619 2130) ((emacs (28 1)) (org-transclusion (1 4 0)) (plz (0 7 2))) "Transclude over HTTP" tar ((:commit . "65caad0d9b19bf19c815bd7c033ffb907c3ebb12") (:authors ("Joseph Turner <first name at ushin.org>")) (:maintainers ("Joseph Turner" . "~ushin/ushin@lists.sr.ht")) (:maintainer "Joseph Turner" . "~ushin/ushin@lists.sr.ht") (:url . "https://git.sr.ht/~ushin/org-transclusion-http"))]) (org-transform-tree-table . [(20200413 1959) ((dash (2 10 0)) (s (1 3 0))) "Transform org-mode tree with properties to a table, and the other way around" tar ((:commit . "d84e7fb87bf2d5fc2be252500de0cddf20facf4f") (:authors (nil . "Johan Lindstrom <buzzwordninja not_this_bit@googlemail.com>")) (:maintainers (nil . "Johan Lindstrom <buzzwordninja not_this_bit@googlemail.com>")) (:maintainer nil . "Johan Lindstrom <buzzwordninja not_this_bit@googlemail.com>") (:keywords "org-mode" "table" "org-table" "tree" "csv" "convert") (:url . "https://github.com/jplindstrom/emacs-org-transform-tree-table"))]) (org-tree-slide . [(20230826 1234) ((emacs (25 2))) "A presentation tool for org-mode" tar ((:commit . "941e7e6cb8a5a0b193345263ed912cceecae1887") (:authors ("Takaaki ISHIKAWA <takaxp at ieee dot org>")) (:maintainers ("Takaaki ISHIKAWA <takaxp at ieee dot org>")) (:maintainer "Takaaki ISHIKAWA <takaxp at ieee dot org>") (:keywords "convenience" "org-mode" "presentation" "narrowing") (:url . "https://github.com/takaxp/org-tree-slide"))]) (org-tree-slide-pauses . [(20201215 146) ((emacs (24 5)) (org-tree-slide (2 8 4))) "Bring the pause command from Beamer to org-tree-slide" tar ((:commit . "f02af7102e9ecef7c3dac0d376d85bbb8c4de4cc") (:authors ("cnngimenez")) (:maintainers ("cnngimenez")) (:maintainer "cnngimenez") (:keywords "convenience" "org-mode" "presentation") (:url . "https://github.com/cnngimenez/org-tree-slide-pauses"))]) @@ -4028,7 +4036,7 @@ (ox-json . [(20240106 2116) ((emacs (26 1)) (org (9)) (s (1 12))) "JSON export backend for Org mode" tar ((:commit . "57a43e3b3e400d219b80008c51373796b844c6b8") (:authors ("Jared Lumpe" . "jared@jaredlumpe.com")) (:maintainers ("Jared Lumpe" . "jared@jaredlumpe.com")) (:maintainer "Jared Lumpe" . "jared@jaredlumpe.com") (:keywords "outlines") (:url . "https://github.com/jlumpe/ox-json"))]) (ox-latex-subfigure . [(20200326 919) ((emacs (24 4)) (org (9 0))) "Subfigure for latex export" tar ((:commit . "be0a0dde62fde8cdf8d72b6968344906aa8c6f54") (:authors ("Quang Linh LE" . "linktohack@gmail.com")) (:maintainers ("Quang Linh LE" . "linktohack@gmail.com")) (:maintainer "Quang Linh LE" . "linktohack@gmail.com") (:keywords "convenience" "ox" "latex" "subfigure" "org" "org-mode") (:url . "http://github.com/linktohack/ox-latex-subfigure"))]) (ox-leanpub . [(20230415 2139) ((org (9 1)) (ox-gfm (1 0)) (emacs (26 1)) (s (1 12 0))) "Export Org documents to Leanpub book format" tar ((:commit . "e8cd440632fd46812d7311360f565828a12380b7") (:authors ("Diego Zamboni" . "diego@zzamboni.org")) (:maintainers ("Diego Zamboni" . "diego@zzamboni.org")) (:maintainer "Diego Zamboni" . "diego@zzamboni.org") (:keywords "files" "org" "leanpub") (:url . "https://gitlab.com/zzamboni/ox-leanpub"))]) - (ox-linuxmag-fr . [(20240326 722) ((emacs (28 1))) "Org-mode exporter for the French GNU/Linux Magazine" tar ((:commit . "893a401db7d3b93e977b3c2608169dbb6e3fbdce") (:url . "https://github.com/DamienCassou/ox-linuxmag-fr"))]) + (ox-linuxmag-fr . [(20240624 1829) ((emacs (28 1))) "Org-mode exporter for the French GNU/Linux Magazine" tar ((:commit . "3319c309f6fb0b0771363bec80557bc387243a82") (:url . "https://github.com/DamienCassou/ox-linuxmag-fr"))]) (ox-mdx-deck . [(20181115 1847) ((emacs (24)) (ox-hugo (0 7))) "org-mode to mdx-deck exporter" tar ((:commit . "f3dbc35870b69a5d8971b1647da8c5468f520c5d") (:authors ("Joshua Wolfe")) (:maintainers ("Joshua Wolfe")) (:maintainer "Joshua Wolfe") (:keywords "lisp" "org" "ox" "mdx" "deck") (:url . "https://github.com/WolfeCub/ox-mdx-deck/"))]) (ox-mediawiki . [(20230425 115) ((cl-lib (0 5)) (s (1 9 0))) "Mediawiki Back-End for Org Export Engine" tar ((:commit . "fa4954c12ab339ac8adf2830141390e71ee13067") (:authors ("Tom Alexander" . "tomalexander@paphus.com")) (:maintainers ("Tom Alexander" . "tomalexander@paphus.com")) (:maintainer "Tom Alexander" . "tomalexander@paphus.com") (:keywords "org" "wp" "mediawiki") (:url . "https://github.com/tomalexander/orgmode-mediawiki"))]) (ox-minutes . [(20180202 1734) ((emacs (24 4))) "Plain text backend for Org for Meeting Minutes" tar ((:commit . "27c29f3fdb9181322ae56f8bace8d95e621230e5") (:authors ("Kaushal Modi" . "kaushal.modi@gmail.com")) (:maintainers ("Kaushal Modi" . "kaushal.modi@gmail.com")) (:maintainer "Kaushal Modi" . "kaushal.modi@gmail.com") (:keywords "org" "exporter" "notes") (:url . "https://github.com/kaushalmodi/ox-minutes"))]) @@ -4061,7 +4069,7 @@ (pacfiles-mode . [(20230503 1523) ((emacs (26 1))) "The pacnew and pacsave merging tool" tar ((:commit . "a613d1d88dba4cb293ecaf42a9aeff7d8a3ce8aa") (:authors ("Carlos G. Cordero <http://github/UndeadKernel>")) (:maintainers ("Carlos G. Cordero" . "pacfiles@binarycharly.com")) (:maintainer "Carlos G. Cordero" . "pacfiles@binarycharly.com") (:keywords "files" "pacman" "arch" "pacnew" "pacsave" "update" "linux") (:url . "https://github.com/UndeadKernel/pacfiles-mode"))]) (pack . [(20191017 456) ((emacs (24)) (cl-lib (0 5))) "Pack and unpack archive files" tar ((:commit . "85cd856fdc00a2365e88b50373b99f1b3d2227be") (:authors ("10sr" . "8.slashes@gmail.com")) (:maintainers ("10sr" . "8.slashes@gmail.com")) (:maintainer "10sr" . "8.slashes@gmail.com") (:keywords "files" "dired") (:url . "https://github.com/10sr/pack-el"))]) (package+ . [(20230805 2115) ((emacs (24 3))) "Extensions for the package library." tar ((:commit . "57a53a1da75d76a9dcd17008d1c1d77475b9671a") (:authors ("Ryan Davis" . "ryand-ruby@zenspider.com")) (:maintainers ("Ryan Davis" . "ryand-ruby@zenspider.com")) (:maintainer "Ryan Davis" . "ryand-ruby@zenspider.com") (:keywords "extensions" "tools") (:url . "https://github.com/zenspider/package"))]) - (package-build . [(20240415 1547) ((emacs (26 1)) (compat (27 1))) "Tools for assembling a package archive" tar ((:commit . "d9ce37b82529827ce720ad3ccf4af887d19fcfb0") (:authors ("Donald Ephraim Curtis" . "dcurtis@milkbox.net") ("Steve Purcell" . "steve@sanityinc.com") ("Jonas Bernoulli" . "emacs.package-build@jonas.bernoulli.dev") ("Phil Hagelberg" . "technomancy@gmail.com")) (:maintainers ("Donald Ephraim Curtis" . "dcurtis@milkbox.net")) (:maintainer "Donald Ephraim Curtis" . "dcurtis@milkbox.net") (:keywords "maint" "tools") (:url . "https://github.com/melpa/package-build"))]) + (package-build . [(20240623 1343) ((emacs (26 1)) (compat (27 1))) "Tools for assembling a package archive" tar ((:commit . "9411f5d16e30ed3886b567e2bef32662ee08f0cf") (:authors ("Donald Ephraim Curtis" . "dcurtis@milkbox.net") ("Steve Purcell" . "steve@sanityinc.com") ("Jonas Bernoulli" . "emacs.package-build@jonas.bernoulli.dev") ("Phil Hagelberg" . "technomancy@gmail.com")) (:maintainers ("Donald Ephraim Curtis" . "dcurtis@milkbox.net")) (:maintainer "Donald Ephraim Curtis" . "dcurtis@milkbox.net") (:keywords "maint" "tools") (:url . "https://github.com/melpa/package-build"))]) (package-filter . [(20161122 719) nil "package archive whitelist and blacklist" tar ((:commit . "c8e2531227c02c4c5e9d593f2cdb6a4ab4a6849b") (:authors ("Donald Ephraim Curtis" . "dcurtis@milkbox.net")) (:maintainers ("Donald Ephraim Curtis" . "dcurtis@milkbox.net")) (:maintainer "Donald Ephraim Curtis" . "dcurtis@milkbox.net") (:url . "https://github.com/milkypostman/package-filter"))]) (package-lint . [(20240507 1722) ((emacs (24 4)) (let-alist (1 0 6))) "A linting library for elisp package authors" tar ((:commit . "cb8b0ddaa14cafe9e4ab9a81b2ad47319fd54f27") (:authors ("Steve Purcell" . "steve@sanityinc.com") ("Fanael Linithien" . "fanael4@gmail.com")) (:maintainers ("Steve Purcell" . "steve@sanityinc.com")) (:maintainer "Steve Purcell" . "steve@sanityinc.com") (:keywords "lisp") (:url . "https://github.com/purcell/package-lint"))]) (package-lint-flymake . [(20240330 1458) ((emacs (26 1)) (package-lint (0 5))) "A package-lint Flymake backend" tar ((:commit . "17e4ab20dd3e36fa540007b4f4047170c23bdb10") (:url . "https://github.com/purcell/package-lint"))]) @@ -4092,7 +4100,7 @@ (paren-completer . [(20160501 1052) ((emacs (24 3))) "Automatically, language agnostically, fill in delimiters." tar ((:commit . "74183a8e13fa1266271bdcbcb4bfb29a4f915f0a") (:authors ("Matthew Bregg")) (:maintainers ("Matthew Bregg")) (:maintainer "Matthew Bregg") (:keywords "convenience") (:url . "https://github.com/MatthewBregg/paren-completer"))]) (paren-face . [(20240618 1837) ((emacs (25 1)) (compat (29 1 4 5))) "A face for parentheses in lisp modes" tar ((:commit . "b6b60ad39391cde91e36c127714f7658eb4151ff") (:authors ("Jonas Bernoulli" . "emacs.paren-face@jonas.bernoulli.dev")) (:maintainers ("Jonas Bernoulli" . "emacs.paren-face@jonas.bernoulli.dev")) (:maintainer "Jonas Bernoulli" . "emacs.paren-face@jonas.bernoulli.dev") (:keywords "faces" "lisp") (:url . "https://github.com/tarsius/paren-face"))]) (parent-mode . [(20240210 1906) nil "get major mode's parent modes" tar ((:commit . "9fe5363b2a190619641c79b3a40d874d8c8f9f40") (:authors ("Fanael Linithien" . "fanael4@gmail.com")) (:maintainers ("Fanael Linithien" . "fanael4@gmail.com")) (:maintainer "Fanael Linithien" . "fanael4@gmail.com") (:url . "https://github.com/Fanael/parent-mode"))]) - (parinfer-rust-mode . [(20240610 1814) ((emacs (26 1)) (track-changes (1 1))) "An interface for the parinfer-rust library" tar ((:commit . "a96c768e9dc4427c9ea18812a2f09e209a5e1a5e") (:authors ("Justin Barclay" . "justinbarclay@gmail.com")) (:maintainers ("Justin Barclay" . "justinbarclay@gmail.com")) (:maintainer "Justin Barclay" . "justinbarclay@gmail.com") (:keywords "lisp" "tools") (:url . "https://github.com/justinbarclay/parinfer-rust-mode"))]) + (parinfer-rust-mode . [(20240625 740) ((emacs (26 1)) (track-changes (1 1))) "An interface for the parinfer-rust library" tar ((:commit . "7f7fa030e3ca51eb0a060df2694cbab2eb3b27b7") (:authors ("Justin Barclay" . "justinbarclay@gmail.com")) (:maintainers ("Justin Barclay" . "justinbarclay@gmail.com")) (:maintainer "Justin Barclay" . "justinbarclay@gmail.com") (:keywords "lisp" "tools") (:url . "https://github.com/justinbarclay/parinfer-rust-mode"))]) (parrot . [(20220101 518) ((emacs (24 1))) "Party Parrot rotates gracefully in mode-line." tar ((:commit . "1d381f24d74242018e306d1a0c891bed9a465ac3") (:authors ("Daniel Ting" . "deep.paren.12@gmail.com")) (:maintainers ("Daniel Ting" . "deep.paren.12@gmail.com")) (:maintainer "Daniel Ting" . "deep.paren.12@gmail.com") (:keywords "party" "parrot" "rotate" "sirocco" "kakapo" "games") (:url . "https://github.com/dp12/parrot.git"))]) (parse-csv . [(20160512 1723) nil "Parse strings with CSV fields into s-expressions" tar ((:commit . "96bef1ffbc89ea12d13311c9fa239c5c3e864890") (:authors ("Edward Marco Baringer (Common Lisp)") ("Matt Curtis" . "matt.r.curtis@gmail.com")) (:maintainers ("Matt Curtis" . "matt.r.curtis@gmail.com")) (:maintainer "Matt Curtis" . "matt.r.curtis@gmail.com") (:keywords "csv") (:url . "https://github.com/mrc/el-csv"))]) (parse-it . [(20240101 946) ((emacs (25 1)) (s (1 12 0))) "Basic Parser in Emacs Lisp" tar ((:commit . "cdc4386ef8e94ccdeff3700021d4a944034ae559") (:authors ("Shen, Jen-Chieh" . "jcs090218@gmail.com")) (:maintainers ("Shen, Jen-Chieh" . "jcs090218@gmail.com")) (:maintainer "Shen, Jen-Chieh" . "jcs090218@gmail.com") (:keywords "convenience" "parse" "parser" "lex" "lexer" "ast") (:url . "https://github.com/jcs-elpa/parse-it"))]) @@ -4160,9 +4168,9 @@ (perspective-project-bridge . [(20231024 1737) ((emacs (27 1)) (perspective (2 18))) "Integration of perspective.el + project.el" tar ((:commit . "7b65b08a0151b8279fc3ae75f0016cb8d5eadb53") (:authors ("Arunkumar Vaidyanathan" . "arunkumarmv1997@gmail.com")) (:maintainers ("Arunkumar Vaidyanathan" . "arunkumarmv1997@gmail.com")) (:maintainer "Arunkumar Vaidyanathan" . "arunkumarmv1997@gmail.com") (:keywords "perspective" "project" "convenience" "frames") (:url . "https://github.com/arunkmv/perspective-project-bridge"))]) (perspeen . [(20171203 1021) ((emacs (25 0)) (powerline (2 4))) "An package for multi-workspace" tar ((:commit . "edb70c530bda50ff3d1756e32a703d5fef5e5480") (:authors ("Peng Li" . "seudut@gmail.com")) (:maintainers ("Peng Li" . "seudut@gmail.com")) (:maintainer "Peng Li" . "seudut@gmail.com") (:keywords "lisp") (:url . "https://github.com/seudut/perspeen"))]) (pest-mode . [(20221231 15) ((emacs (26 3))) "Major mode for editing Pest files" tar ((:commit . "8023a92ce59c34dcd1587cbd85ed144f206ddb89") (:authors ("ksqsf" . "i@ksqsf.moe")) (:maintainers ("ksqsf" . "i@ksqsf.moe")) (:maintainer "ksqsf" . "i@ksqsf.moe") (:keywords "languages") (:url . "https://github.com/ksqsf/pest-mode"))]) - (pet . [(20240608 2012) ((emacs (26 1)) (f (0 6 0)) (map (3 3 1)) (seq (2 24))) "Executable and virtualenv tracker for python-mode" tar ((:commit . "c23dea50711bb906bc0d972e3a49af008310e3a2") (:authors ("Jimmy Yuen Ho Wong" . "wyuenho@gmail.com")) (:maintainers ("Jimmy Yuen Ho Wong" . "wyuenho@gmail.com")) (:maintainer "Jimmy Yuen Ho Wong" . "wyuenho@gmail.com") (:keywords "tools") (:url . "https://github.com/wyuenho/emacs-pet/"))]) + (pet . [(20240624 1753) ((emacs (26 1)) (f (0 6 0)) (map (3 3 1)) (seq (2 24))) "Executable and virtualenv tracker for python-mode" tar ((:commit . "cc086d91a9e6ab0158335d37a774356414746e17") (:authors ("Jimmy Yuen Ho Wong" . "wyuenho@gmail.com")) (:maintainers ("Jimmy Yuen Ho Wong" . "wyuenho@gmail.com")) (:maintainer "Jimmy Yuen Ho Wong" . "wyuenho@gmail.com") (:keywords "tools") (:url . "https://github.com/wyuenho/emacs-pet/"))]) (pfuture . [(20220913 1401) ((emacs (25 2))) "a simple wrapper around asynchronous processes" tar ((:commit . "19b53aebbc0f2da31de6326c495038901bffb73c") (:authors ("Alexander Miller" . "alexanderm@web.de")) (:maintainers ("Alexander Miller" . "alexanderm@web.de")) (:maintainer "Alexander Miller" . "alexanderm@web.de") (:url . "https://github.com/Alexander-Miller/pfuture"))]) - (pg . [(20240618 1347) ((emacs (28 1)) (peg (1 0))) "Emacs Lisp socket-level interface to the PostgreSQL RDBMS" tar ((:commit . "82c3e96813b0cefcb49f061e3c573384d3f88a46") (:authors ("Eric Marsden" . "eric.marsden@risk-engineering.org")) (:maintainers ("Eric Marsden" . "eric.marsden@risk-engineering.org")) (:maintainer "Eric Marsden" . "eric.marsden@risk-engineering.org") (:keywords "data" "comm" "database" "postgresql") (:url . "https://github.com/emarsden/pg-el"))]) + (pg . [(20240626 1428) ((emacs (28 1)) (peg (1 0))) "Emacs Lisp socket-level interface to the PostgreSQL RDBMS" tar ((:commit . "d5e0ebf603227147f19fded517b0de5e8660ebf9") (:authors ("Eric Marsden" . "eric.marsden@risk-engineering.org")) (:maintainers ("Eric Marsden" . "eric.marsden@risk-engineering.org")) (:maintainer "Eric Marsden" . "eric.marsden@risk-engineering.org") (:keywords "data" "comm" "database" "postgresql") (:url . "https://github.com/emarsden/pg-el"))]) (pgdevenv . [(20150105 2236) nil "Manage your PostgreSQL development envs" tar ((:commit . "7f1d5bc734750aca98cf67a9491cdbd5615fd132") (:authors ("Dimitri Fontaine" . "dim@tapoueh.org")) (:maintainers ("Dimitri Fontaine" . "dim@tapoueh.org")) (:maintainer "Dimitri Fontaine" . "dim@tapoueh.org") (:keywords "emacs" "postgresql" "development" "environment" "shell" "debug" "gdb"))]) (ph . [(20161029 1522) ((emacs (24 3))) "A global minor mode for managing multiple projects." tar ((:commit . "a66e38637d1898b2ec31ee611033ac3f295fd97f") (:authors ("Alexander Gromnitsky" . "alexander.gromnitsky@gmail.com")) (:maintainer "Alexander Gromnitsky" . "alexander.gromnitsky@gmail.com"))]) (phabricator . [(20160510 1425) ((emacs (24 4)) (dash (1 0)) (projectile (0 13 0)) (s (1 10 0)) (f (0 17 2))) "Phabricator/Arcanist helpers for Emacs." tar ((:commit . "d09d6f059aea92d3b11c68664a5e80c901182ab8") (:authors ("Andrew Tulloch")) (:maintainers ("Andrew Tulloch")) (:maintainer "Andrew Tulloch") (:keywords "phabricator" "arcanist" "diffusion") (:url . "https://github.com/ajtulloch/phabricator.el"))]) @@ -4252,7 +4260,7 @@ (poke-line . [(20201023 247) ((emacs (24 3))) "Minor mode to show position in a buffer using a Pokemon" tar ((:commit . "8d484dbaa1215d902fbd1e3c9163b39a43ec532a") (:authors ("Ryan Miller" . "ryan@devopsmachine.com")) (:maintainers ("Ryan Miller" . "ryan@devopsmachine.com")) (:maintainer "Ryan Miller" . "ryan@devopsmachine.com") (:keywords "pokemon" "fun" "mode-line" "mouse") (:url . "https://github.com/RyanMillerC/poke-line/"))]) (pollen-mode . [(20220904 447) ((emacs (24 3)) (cl-lib (0 5))) "major mode for editing pollen files" tar ((:commit . "19174fab69ce4d2ae903ef2c3da44054e8b84268") (:authors ("Junsong Li <ljs.darkfish AT GMAIL>")) (:maintainers ("Junsong Li")) (:maintainer "Junsong Li") (:keywords "languages" "pollen" "pollenpub") (:url . "https://github.com/lijunsong/pollen-mode"))]) (poly-R . [(20230416 1454) ((emacs (25)) (polymode (0 2 2)) (poly-markdown (0 2 2)) (poly-noweb (0 2 2))) "Various polymodes for R language" tar ((:commit . "8024e852cfca642dea2045a41b2033baa2f1f9a5") (:authors ("Vitalie Spinu")) (:maintainers ("Vitalie Spinu")) (:maintainer "Vitalie Spinu") (:keywords "languages" "multi-modes") (:url . "https://github.com/polymode/poly-R"))]) - (poly-ansible . [(20240520 1500) ((ansible (0 2)) (ansible-doc (0 4)) (emacs (24 1)) (jinja2-mode (0 2)) (polymode (0 2)) (yaml-mode (0 0 13))) "Polymode for Ansible: Jinja2 in YAML" tar ((:commit . "187ad18b7c03eb2b286b4d49eb36572bb7847d57") (:authors ("Peter Oliver" . "poly-ansible@mavit.org.uk")) (:maintainers ("Peter Oliver" . "poly-ansible@mavit.org.uk")) (:maintainer "Peter Oliver" . "poly-ansible@mavit.org.uk") (:keywords "languages") (:url . "https://gitlab.com/mavit/poly-ansible/"))]) + (poly-ansible . [(20240626 1320) ((ansible (0 4 1)) (ansible-doc (0 4)) (emacs (24 1)) (jinja2-mode (0 2)) (polymode (0 2)) (yaml-mode (0 0 13))) "Polymode for Ansible: Jinja2 in YAML" tar ((:commit . "24a17c6b965a085c737bee857eff919dfd0f961d") (:authors ("Peter Oliver" . "poly-ansible@mavit.org.uk")) (:maintainers ("Peter Oliver" . "poly-ansible@mavit.org.uk")) (:maintainer "Peter Oliver" . "poly-ansible@mavit.org.uk") (:keywords "languages") (:url . "https://gitlab.com/mavit/poly-ansible/"))]) (poly-erb . [(20200316 1314) ((emacs (25)) (polymode (0 2 2))) "Polymode for erb" tar ((:commit . "56c744b8d87d8cbe0aba2696d4e8525afc4aa0e8") (:authors ("Siavash Sajjadi and Vitalie Spinu")) (:maintainers ("Vitalie Spinu")) (:maintainer "Vitalie Spinu") (:keywords "emacs") (:url . "https://github.com/polymode/poly-erb"))]) (poly-markdown . [(20230202 1210) ((emacs (25)) (polymode (0 2 2)) (markdown-mode (2 3))) "Polymode for markdown-mode" tar ((:commit . "98695eb7ca4ca11dcec71a1cab64903bbf79b4d3") (:authors ("Vitalie Spinu")) (:maintainers ("Vitalie Spinu")) (:maintainer "Vitalie Spinu") (:keywords "emacs") (:url . "https://github.com/polymode/poly-markdown"))]) (poly-noweb . [(20200316 1315) ((emacs (25)) (polymode (0 2 2))) "Polymode for noweb" tar ((:commit . "3b0cd36ca9a707e8a09337a3468fa85d81fc461c") (:authors ("Vitalie Spinu")) (:maintainers ("Vitalie Spinu")) (:maintainer "Vitalie Spinu") (:keywords "languages" "multi-modes") (:url . "https://github.com/polymode/poly-noweb"))]) @@ -4387,7 +4395,7 @@ (puni . [(20231231 1415) ((emacs (26 1))) "Parentheses Universalistic" tar ((:commit . "72e091ef30e0c9299dbcd0bc4669ab9bb8fb6e47") (:authors ("Hao Wang" . "amaikinono@gmail.com")) (:maintainers ("Hao Wang" . "amaikinono@gmail.com")) (:maintainer "Hao Wang" . "amaikinono@gmail.com") (:keywords "convenience" "lisp" "tools") (:url . "https://github.com/AmaiKinono/puni"))]) (punpun-themes . [(20221121 1018) ((emacs (24 1))) "A set of bleak themes" tar ((:commit . "6a7e04de1ad9f7ba9074b7206bffc9241c33349c") (:authors ("Vasilij Schneidermann" . "mail@vasilij.de")) (:maintainer "Vasilij Schneidermann" . "mail@vasilij.de") (:url . "https://depp.brause.cc/punpun-themes"))]) (puppet-mode . [(20210305 645) ((emacs (24 1)) (pkg-info (0 4))) "Major mode for Puppet manifests" tar ((:commit . "ab25cf379236f4e1bd4bc9c1d77a93c95800e9bf") (:authors ("Vox Pupuli" . "voxpupuli@groups.io") ("Bozhidar Batsov" . "bozhidar@batsov.com") ("Sebastian Wiesner" . "swiesner@lunaryorn.com") ("Russ Allbery" . "rra@stanford.edu")) (:maintainers ("Vox Pupuli" . "voxpupuli@groups.io")) (:maintainer "Vox Pupuli" . "voxpupuli@groups.io") (:keywords "languages") (:url . "https://github.com/voxpupuli/puppet-mode"))]) - (puppet-ts-mode . [(20240618 1532) ((emacs (29 1))) "Major mode for Puppet using Tree-sitter" tar ((:commit . "978e11b7e41ed7de3647bdf95045063d56f45aa2") (:authors ("Stefan Möding" . "stm@kill-9.net")) (:maintainers ("Stefan Möding" . "stm@kill-9.net")) (:maintainer "Stefan Möding" . "stm@kill-9.net") (:keywords "languages") (:url . "https://github.com/smoeding/puppet-ts-mode"))]) + (puppet-ts-mode . [(20240626 646) ((emacs (29 1))) "Major mode for Puppet using Tree-sitter" tar ((:commit . "9622188612f3be347bd92f5a195999b36f95f988") (:authors ("Stefan Möding" . "stm@kill-9.net")) (:maintainers ("Stefan Möding" . "stm@kill-9.net")) (:maintainer "Stefan Möding" . "stm@kill-9.net") (:keywords "languages") (:url . "https://github.com/smoeding/puppet-ts-mode"))]) (purescript-mode . [(20230309 1301) ((emacs (25 1))) "A PureScript editing mode" tar ((:commit . "eacc61aaafe6055b5f278c9843558f220f18b153") (:authors ("1992 Simon Marlow") ("1997-1998 Graeme E Moss" . "gem@cs.york.ac.uk") ("Tommy Thorn" . "thorn@irisa.fr") ("2001-2002 Reuben Thomas (>=v1.4)") ("2003 Dave Love" . "fx@gnu.org") ("2014 Tim Dysinger" . "tim@dysinger.net")) (:maintainer "1992 Simon Marlow") (:keywords "faces" "files" "purescript") (:url . "https://github.com/purescript-emacs/purescript-mode"))]) (purp-theme . [(20210912 1940) nil "A dark color theme with few colors" tar ((:commit . "8d3510e1ed995b8323cd5205626ddde6386a76ca") (:authors ("Vincent Foley" . "vfoley@gmail.com")) (:maintainers ("Vincent Foley" . "vfoley@gmail.com")) (:maintainer "Vincent Foley" . "vfoley@gmail.com") (:keywords "faces") (:url . "https://github.com/gnuvince/purp"))]) (purple-haze-theme . [(20141015 229) ((emacs (24 0))) "an overtly purple color theme for Emacs24." tar ((:commit . "3e245cbef7cd09e6b3ee124963e372a04e9a6485") (:authors ("Jason Milkins" . "jasonm23@gmail.com")) (:maintainers ("Jason Milkins" . "jasonm23@gmail.com")) (:maintainer "Jason Milkins" . "jasonm23@gmail.com") (:url . "https://github.com/jasonm23/emacs-purple-haze-theme"))]) @@ -4465,7 +4473,7 @@ (qwen-chat-shell . [(20240612 343) ((emacs (27 1)) (shell-maker (0 50 1))) "Qwen-chat shell + buffer insert commands" tar ((:commit . "2d6562c8a75aebf7a59e554011571ba5883cf4fd") (:authors ("Pavinberg" . "pavin0702@gmail.com")) (:maintainers ("Pavinberg" . "pavin0702@gmail.com")) (:maintainer "Pavinberg" . "pavin0702@gmail.com") (:url . "https://github.com/Pavinberg/qwen-chat-shell"))]) (r-autoyas . [(20140101 1510) ((ess (0)) (yasnippet (0 8 0))) "Provides automatically created yasnippets for R function argument lists." tar ((:commit . "d321a7da0ef2e94668d53e0807277da7b70ea678") (:authors ("Sven Hartenstein & Matthew Fidler")) (:maintainers ("Matthew Fidler")) (:maintainer "Matthew Fidler") (:keywords "r" "yasnippet") (:url . "https://github.com/mlf176f2/r-autoyas.el"))]) (racer . [(20210307 243) ((emacs (25 1)) (rust-mode (0 2 0)) (dash (2 13 0)) (s (1 10 0)) (f (0 18 2)) (pos-tip (0 4 6))) "code completion, goto-definition and docs browsing for Rust via racer" tar ((:commit . "1e63e98626737ea9b662d4a9b1ffd6842b1c648c") (:authors ("Phil Dawes")) (:maintainers ("Phil Dawes")) (:maintainer "Phil Dawes") (:keywords "abbrev" "convenience" "matching" "rust" "tools") (:url . "https://github.com/racer-rust/emacs-racer"))]) - (racket-mode . [(20240620 1750) ((emacs (25 1))) "Racket editing, REPL, and more" tar ((:commit . "47cb399324f1ecd76cbc7c4af159e223c331c6e1") (:authors ("Greg Hendershott" . "racket-mode-author@greghendershott.com")) (:maintainers ("Greg Hendershott")) (:maintainer "Greg Hendershott") (:url . "https://www.racket-mode.com/"))]) + (racket-mode . [(20240621 1647) ((emacs (25 1))) "Racket editing, REPL, and more" tar ((:commit . "40ecb87f409a9ef9a4e58c1e51243cce948ab3d7") (:authors ("Greg Hendershott" . "racket-mode-author@greghendershott.com")) (:maintainers ("Greg Hendershott")) (:maintainer "Greg Hendershott") (:url . "https://www.racket-mode.com/"))]) (rails-i18n . [(20220126 1643) ((emacs (27 2)) (yaml (0 1 0)) (dash (2 19 1))) "Seach and insert i18n on ruby code" tar ((:commit . "8e87e4e48e31902b8259ded28a208c2e7efea6e9") (:authors ("Otávio Schwanck dos Santos" . "otavioschwanck@gmail.com")) (:maintainers ("Otávio Schwanck dos Santos" . "otavioschwanck@gmail.com")) (:maintainer "Otávio Schwanck dos Santos" . "otavioschwanck@gmail.com") (:keywords "tools" "languages") (:url . "https://github.com/otavioschwanck/rails-i18n.el"))]) (rails-log-mode . [(20140408 425) nil "Major mode for viewing Rails log files" tar ((:commit . "ff440003ad7d47cb0ac3300f2a632f4cfd36a446") (:authors ("Anantha kumaran" . "ananthakumaran@gmail.com")) (:maintainers ("Anantha kumaran" . "ananthakumaran@gmail.com")) (:maintainer "Anantha kumaran" . "ananthakumaran@gmail.com") (:keywords "rails" "log"))]) (rails-routes . [(20220126 1631) ((emacs (27 2)) (inflections (1 1))) "Search for and insert rails routes" tar ((:commit . "eab995a9297ca5bd9bd4f4c2737f2fecfc36def0") (:authors ("Otávio Schwanck" . "otavioschwanck@gmail.com")) (:maintainers ("Otávio Schwanck" . "otavioschwanck@gmail.com")) (:maintainer "Otávio Schwanck" . "otavioschwanck@gmail.com") (:keywords "tools" "languages") (:url . "https://github.com/otavioschwanck/rails-routes"))]) @@ -4543,7 +4551,7 @@ (regex-tool . [(20170104 1918) nil "A regular expression evaluation tool for programmers" tar ((:commit . "0b4a0111143c88ef94bec56624cb2e00c1a054e6") (:authors ("John Wiegley" . "johnw@newartisans.com")) (:maintainers ("John Wiegley" . "johnw@newartisans.com")) (:maintainer "John Wiegley" . "johnw@newartisans.com") (:keywords "regex" "languages" "programming" "development") (:url . "http://www.newartisans.com/"))]) (region-bindings-mode . [(20140407 2214) nil "Enable custom bindings when mark is active." tar ((:commit . "3fa5dbdbd7c000bebff6d9d14a4be326ec24b6fc") (:authors ("Fabián E. Gallina" . "fabian@anue.biz")) (:maintainers ("Fabián E. Gallina" . "fabian@anue.biz")) (:maintainer "Fabián E. Gallina" . "fabian@anue.biz") (:keywords "convenience") (:url . "https://github.com/fgallina/region-bindings-mode"))]) (region-convert . [(20210519 1655) ((emacs (24 3))) "Convert string in region by Lisp function" tar ((:commit . "cb3ab0417d7b74e5edd34bf23a70737fc7bf1d3a") (:authors ("USAMI Kenta" . "tadsan@zonu.me")) (:maintainers ("USAMI Kenta" . "tadsan@zonu.me")) (:maintainer "USAMI Kenta" . "tadsan@zonu.me") (:keywords "region" "convenience") (:url . "https://github.com/zonuexe/right-click-context"))]) - (region-occurrences-highlighter . [(20240417 2146) ((emacs (24))) "Mark occurrences of current region (selection)" tar ((:commit . "a1ade7985656faf00f8a6afda885e8bdf959d133") (:authors ("Álvaro González Sotillo" . "alvarogonzalezsotillo@gmail.com")) (:maintainers ("Shen, Jen-Chieh" . "jcs090218@gmail.com")) (:maintainer "Shen, Jen-Chieh" . "jcs090218@gmail.com") (:keywords "convenience") (:url . "https://github.com/alvarogonzalezsotillo/region-occurrences-highlighter"))]) + (region-occurrences-highlighter . [(20240626 1101) ((emacs (26 1))) "Mark occurrences of current region (selection)" tar ((:commit . "55f9d100ef67f174c55209f8d4cef1962a9adfc2") (:authors ("Álvaro González Sotillo" . "alvarogonzalezsotillo@gmail.com")) (:maintainers ("Shen, Jen-Chieh" . "jcs090218@gmail.com")) (:maintainer "Shen, Jen-Chieh" . "jcs090218@gmail.com") (:keywords "convenience") (:url . "https://github.com/alvarogonzalezsotillo/region-occurrences-highlighter"))]) (region-state . [(20181205 1746) nil "Show the number of chars/lines or rows/columns in the region" tar ((:commit . "f9e3926036a7c261b20bad9bf46f68ead8c15024") (:authors ("Chunyang Xu" . "mail@xuchunyang.me")) (:maintainers ("Chunyang Xu" . "mail@xuchunyang.me")) (:maintainer "Chunyang Xu" . "mail@xuchunyang.me") (:keywords "convenience") (:url . "https://github.com/xuchunyang/region-state.el"))]) (register-channel . [(20210120 1618) nil "Jump around fast using registers" tar ((:commit . "ed7f563e92170b758dc878fcb5df88d46d5d44cc") (:authors ("Yang Zhao" . "YangZhao11@users.noreply.github.com")) (:maintainers ("Yang Zhao" . "YangZhao11@users.noreply.github.com")) (:maintainer "Yang Zhao" . "YangZhao11@users.noreply.github.com") (:keywords "convenience"))]) (register-quicknav . [(20200524 2006) ((emacs (25 3))) "Quickly jump to next/previous register" tar ((:commit . "c15ea92b0946c28b3f14986d42b15b0b534aa6a2") (:authors ("tastytea" . "tastytea@tastytea.de")) (:maintainers ("tastytea" . "tastytea@tastytea.de")) (:maintainer "tastytea" . "tastytea@tastytea.de") (:keywords "convenience") (:url . "https://schlomp.space/tastytea/register-quicknav"))]) @@ -4658,7 +4666,7 @@ (rust-auto-use . [(20200608 1359) nil "Utility to automatically insert Rust use statements" tar ((:commit . "d5205f7b9b9eae0f7d0893f87d3391464719f9c0") (:authors ("Rotem Yaari" . "rotemy@MBP.local")) (:maintainers ("Rotem Yaari" . "rotemy@MBP.local")) (:maintainer "Rotem Yaari" . "rotemy@MBP.local") (:keywords "languages"))]) (rust-mode . [(20240520 749) ((emacs (25 1))) "A major-mode for editing Rust source code" tar ((:commit . "d00d83d3a207a5b7c2994392b2781f627e3159ce") (:authors ("Mozilla" . "rust-mode@noreply.github.com")) (:maintainers ("Mozilla" . "rust-mode@noreply.github.com")) (:maintainer "Mozilla" . "rust-mode@noreply.github.com") (:keywords "languages") (:url . "https://github.com/rust-lang/rust-mode"))]) (rust-playground . [(20200116 1043) ((emacs (24 3))) "Local Rust playground for short code snippets." tar ((:commit . "5a117781dcb66065bea7830dd73618008fc34949") (:authors ("Alexander I.Grafov" . "grafov@gmail.com")) (:maintainers ("Alexander I.Grafov" . "grafov@gmail.com")) (:maintainer "Alexander I.Grafov" . "grafov@gmail.com") (:keywords "tools" "rust") (:url . "https://github.com/grafov/rust-playground"))]) - (rustic . [(20230130 912) ((emacs (26 1)) (rust-mode (1 0 3)) (dash (2 13 0)) (f (0 18 2)) (let-alist (1 0 4)) (markdown-mode (2 3)) (project (0 3 0)) (s (1 10 0)) (seq (2 3)) (spinner (1 7 3)) (xterm-color (1 6))) "Rust development environment" tar ((:commit . "a5fc66c8167a827a57c4426e4b8dbe717b3be43c") (:authors ("Mozilla")) (:maintainers ("Mozilla")) (:maintainer "Mozilla") (:keywords "languages"))]) + (rustic . [(20240626 1215) ((emacs (26 1)) (rust-mode (1 0 3)) (dash (2 13 0)) (f (0 18 2)) (let-alist (1 0 4)) (markdown-mode (2 3)) (project (0 3 0)) (s (1 10 0)) (spinner (1 7 3)) (xterm-color (1 6)) (flycheck (34 0))) "Rust development environment" tar ((:commit . "4d9fae5c526a6d699f6513e9729e186406d8e3d9") (:authors ("Mozilla")) (:maintainers ("Mozilla")) (:maintainer "Mozilla") (:keywords "languages"))]) (rutils . [(20220619 1421) ((emacs (26 1)) (ess (18 10 1)) (transient (0 3 0))) "R utilities with transient" tar ((:commit . "dd500ab8062ce40cb339ec8620bdfc63fdd28364") (:authors ("Shuguang Sun" . "shuguang79@qq.com")) (:maintainers ("Shuguang Sun" . "shuguang79@qq.com")) (:maintainer "Shuguang Sun" . "shuguang79@qq.com") (:keywords "convenience") (:url . "https://github.com/ShuguangSun/rutils.el"))]) (rvm . [(20220910 1558) nil "Emacs integration for rvm" tar ((:commit . "e1e83b5466c132c066142ac63729ba833c530c83") (:authors ("Yves Senn" . "yves.senn@gmx.ch")) (:maintainers ("Yves Senn" . "yves.senn@gmx.ch")) (:maintainer "Yves Senn" . "yves.senn@gmx.ch") (:keywords "ruby" "rvm") (:url . "http://www.emacswiki.org/emacs/RvmEl"))]) (ryo-modal . [(20221221 1355) ((emacs (25 1))) "Roll your own modal mode" tar ((:commit . "b9e6a0f33b9e2aeb6088accd23ed312083d8f707") (:authors ("Erik Sjöstrand" . "sjostrand.erik@gmail.com")) (:maintainers ("Erik Sjöstrand" . "sjostrand.erik@gmail.com")) (:maintainer "Erik Sjöstrand" . "sjostrand.erik@gmail.com") (:keywords "convenience" "modal" "keys") (:url . "http://github.com/Kungsgeten/ryo-modal"))]) @@ -4688,7 +4696,7 @@ (scad-preview . [(20211212 1128) ((scad-mode (91 0)) (emacs (24 4))) "Preview SCAD models in real-time within Emacs" tar ((:commit . "c5449b26c63f3e0a695905a7e4e84f8d844f761b") (:authors ("zk_phi")) (:maintainers ("zk_phi")) (:maintainer "zk_phi") (:url . "https://zk-phi.github.io/"))]) (scala-mode . [(20240113 1743) nil "Major mode for editing Scala" tar ((:commit . "4c6d636b86e3bb1d95de819dc48dda92abdfbcf4") (:keywords "languages") (:url . "https://github.com/hvesalai/emacs-scala-mode"))]) (scala-repl . [(20240427 1456) ((emacs (29 1))) "Scala REPL Mode" tar ((:commit . "679bdf663e0b32a5a285d6f98daa2e3d5de60289") (:authors ("Daian YUE" . "sheepduke@gmail.com")) (:maintainers ("Daian YUE" . "sheepduke@gmail.com")) (:maintainer "Daian YUE" . "sheepduke@gmail.com") (:keywords "languages" "tools") (:url . "https://github.com/sheepduke/scala-repl.el"))]) - (scala-ts-mode . [(20240420 1150) ((emacs (29 1))) "Scala Tree-Sitter Mode" tar ((:commit . "d9424fa74acf930664c43d4c9f9625d8bfdd4d21") (:authors ("Karan Ahlawat" . "ahlawatkaran12@gmail.com")) (:maintainers ("Karan Ahlawat" . "ahlawatkaran12@gmail.com")) (:maintainer "Karan Ahlawat" . "ahlawatkaran12@gmail.com") (:keywords "scala" "languages" "tree-sitter") (:url . "https://github.com/KaranAhlawat/scala-ts-mode"))]) + (scala-ts-mode . [(20240623 905) ((emacs (29 1))) "Scala Tree-Sitter Mode" tar ((:commit . "8147803401ada30d0e817c01df73293e0a967c99") (:authors ("Karan Ahlawat" . "ahlawatkaran12@gmail.com")) (:maintainers ("Karan Ahlawat" . "ahlawatkaran12@gmail.com")) (:maintainer "Karan Ahlawat" . "ahlawatkaran12@gmail.com") (:keywords "scala" "languages" "tree-sitter") (:url . "https://github.com/KaranAhlawat/scala-ts-mode"))]) (scf-mode . [(20151122 248) nil "shorten file-names in compilation type buffers" tar ((:commit . "dbfcdcd89034f208d65e181af58e0d73ad09f8b2") (:authors ("Le Wang")) (:maintainers ("Le Wang")) (:maintainer "Le Wang") (:keywords "compilation") (:url . "https://github.com/lewang/scf-mode"))]) (scheme-complete . [(20201112 442) nil "Smart auto completion for Scheme in Emacs" tar ((:commit . "b9a1448c4696f117d9ea4e59b6162dc31112e71a") (:authors ("Alex Shinn")) (:maintainers ("Alex Shinn")) (:maintainer "Alex Shinn"))]) (scholar-import . [(20230412 1413) ((emacs (26 1)) (org (9 0)) (request (0 3 0)) (s (1 10 0)) (parsebib (4 2))) "Import Bibtex & PDF from Google Scholar" tar ((:commit . "2456367578caa7fd768e30238ce080687faa0a25") (:authors ("Anh T Nguyen <https://github.com/teeann>")) (:maintainers ("Anh T Nguyen <https://github.com/teeann>")) (:maintainer "Anh T Nguyen <https://github.com/teeann>") (:url . "https://github.com/teeann/scholar-import"))]) @@ -4772,7 +4780,7 @@ (shell-current-directory . [(20140101 2354) nil "create new shell based on buffer directory" tar ((:commit . "bf843771bf9a4aa05e054ade799eb8862f3be89a") (:authors ("Daniel Polani")) (:maintainers ("Daniel Polani")) (:maintainer "Daniel Polani") (:keywords "shell" "comint"))]) (shell-here . [(20220102 1703) nil "Open a shell relative to the working directory" tar ((:commit . "eeb437ff26d62a5009046b1b3b4503b768e3131a") (:authors ("Ian Eure" . "ian.eure@gmail.com")) (:maintainers ("Ian Eure" . "ian.eure@gmail.com")) (:maintainer "Ian Eure" . "ian.eure@gmail.com") (:keywords "unix" "tools" "processes"))]) (shell-history . [(20100505 839) nil "integration with shell history" tar ((:commit . "ee371a81f2d2bf5a308344078329ca1e9b5ed38c") (:authors ("rubikitch" . "rubikitch@ruby-lang.org")) (:maintainers ("rubikitch" . "rubikitch@ruby-lang.org")) (:maintainer "rubikitch" . "rubikitch@ruby-lang.org") (:keywords "processes" "convenience") (:url . "http://www.emacswiki.org/cgi-bin/wiki/download/shell-history.el"))]) - (shell-maker . [(20240619 1033) ((emacs (27 1))) "Interaction mode for making comint shells" tar ((:commit . "bb06e4a902ebc6bc0412c33cada88536ebb53c1f") (:authors ("Alvaro Ramirez https://xenodium.com")) (:maintainers ("Alvaro Ramirez https://xenodium.com")) (:maintainer "Alvaro Ramirez https://xenodium.com") (:url . "https://github.com/xenodium/chatgpt-shell"))]) + (shell-maker . [(20240623 1713) ((emacs (27 1))) "Interaction mode for making comint shells" tar ((:commit . "f3307e7ffac399e36cb70d7663181dd53caf712a") (:authors ("Alvaro Ramirez https://xenodium.com")) (:maintainers ("Alvaro Ramirez https://xenodium.com")) (:maintainer "Alvaro Ramirez https://xenodium.com") (:url . "https://github.com/xenodium/chatgpt-shell"))]) (shell-pop . [(20231228 612) ((emacs (24 1)) (cl-lib (0 5))) "helps you to use shell easily on Emacs. Only one key action to work." tar ((:commit . "ff3dc705ee1c7bc566b35c17e4635c57061fe3ae") (:authors ("Kazuo YAGI" . "kazuo.yagi@gmail.com")) (:maintainers ("Kazuo YAGI" . "kazuo.yagi@gmail.com")) (:maintainer "Kazuo YAGI" . "kazuo.yagi@gmail.com") (:keywords "shell" "terminal" "tools") (:url . "http://github.com/kyagi/shell-pop-el"))]) (shell-split-string . [(20151224 1008) nil "Split strings using shell-like syntax" tar ((:commit . "19f6f999c33cc66a4c91bacdcc3697c25d97bf5a") (:authors ("10sr <8.slashes+el [at] gmail [dot] com>")) (:maintainers ("10sr <8.slashes+el [at] gmail [dot] com>")) (:maintainer "10sr <8.slashes+el [at] gmail [dot] com>") (:keywords "utility" "library" "shell" "string") (:url . "https://github.com/10sr/shell-split-string-el"))]) (shell-switcher . [(20210509 1045) ((emacs (24))) "Provide fast switching between shell buffers." tar ((:commit . "ed74b20fa12935be0068765f5bc8de97b92a8020") (:authors ("Damien Cassou" . "damien.cassou@gmail.com")) (:maintainer "Damien Cassou" . "damien.cassou@gmail.com") (:keywords "emacs" "package" "elisp" "shell" "eshell" "term" "switcher") (:url . "https://github.com/DamienCassou/shell-switcher"))]) @@ -4806,7 +4814,7 @@ (side-hustle . [(20240325 205) ((emacs (24 4)) (seq (2 20))) "Hustle through Imenu in a side window" tar ((:commit . "903380cf9e08d98689c2c116965f8e47d002fad6") (:authors ("Paul W. Rankin" . "hello@paulwrankin.com")) (:maintainers ("Paul W. Rankin" . "hello@paulwrankin.com")) (:maintainer "Paul W. Rankin" . "hello@paulwrankin.com") (:keywords "convenience") (:url . "https://github.com/rnkn/side-hustle"))]) (side-notes . [(20230814 302) ((emacs (24 4))) "Easy access to a directory notes file" tar ((:commit . "fbe409066df83a7e64a6a9ddf6d99ce7177fcdbb") (:authors ("Paul W. Rankin" . "hello@paulwrankin.com")) (:maintainers ("Paul W. Rankin" . "hello@paulwrankin.com")) (:maintainer "Paul W. Rankin" . "hello@paulwrankin.com") (:keywords "convenience") (:url . "https://github.com/rnkn/side-notes"))]) (sidecar-locals . [(20240421 655) ((emacs (27 1))) "A flexible alternative to built-in dir-locals" tar ((:commit . "3daf8c07fac7c4ada7a02a1edad2f64894463614") (:authors ("Campbell Barton" . "ideasman42@gmail.com")) (:maintainers ("Campbell Barton" . "ideasman42@gmail.com")) (:maintainer "Campbell Barton" . "ideasman42@gmail.com") (:keywords "convenience") (:url . "https://codeberg.org/ideasman42/emacs-sidecar-locals"))]) - (sideline . [(20240617 214) ((emacs (27 1)) (ht (2 4))) "Show information on the side" tar ((:commit . "b9db025858fdf25ecf11b7b93a7f4043c699c7e6") (:authors ("Shen, Jen-Chieh" . "jcs090218@gmail.com")) (:maintainers ("Shen, Jen-Chieh" . "jcs090218@gmail.com")) (:maintainer "Shen, Jen-Chieh" . "jcs090218@gmail.com") (:keywords "convenience") (:url . "https://github.com/emacs-sideline/sideline"))]) + (sideline . [(20240626 1102) ((emacs (27 1)) (ht (2 4))) "Show information on the side" tar ((:commit . "eb84fa5e34e94fdfbc157aef7682bb2f01b0b2da") (:authors ("Shen, Jen-Chieh" . "jcs090218@gmail.com")) (:maintainers ("Shen, Jen-Chieh" . "jcs090218@gmail.com")) (:maintainer "Shen, Jen-Chieh" . "jcs090218@gmail.com") (:keywords "convenience") (:url . "https://github.com/emacs-sideline/sideline"))]) (sideline-blame . [(20240101 918) ((emacs (27 1)) (sideline (0 1 0)) (vc-msg (1 1 1))) "Show blame messages with sideline" tar ((:commit . "b597c047d2a8ef7dd155e85e43fd65530ecf0a61") (:authors ("Shen, Jen-Chieh" . "jcs090218@gmail.com")) (:maintainers ("Shen, Jen-Chieh" . "jcs090218@gmail.com")) (:maintainer "Shen, Jen-Chieh" . "jcs090218@gmail.com") (:keywords "convenience" "blame") (:url . "https://github.com/emacs-sideline/sideline-blame"))]) (sideline-flycheck . [(20240530 2209) ((emacs (27 1)) (sideline (0 1 1)) (flycheck (0 14)) (ht (2 4))) "Show flycheck errors with sideline" tar ((:commit . "11f34abcd34b55c021453e332e58282654b35a7c") (:authors ("Shen, Jen-Chieh" . "jcs090218@gmail.com")) (:maintainers ("Shen, Jen-Chieh" . "jcs090218@gmail.com")) (:maintainer "Shen, Jen-Chieh" . "jcs090218@gmail.com") (:keywords "convenience" "flycheck") (:url . "https://github.com/emacs-sideline/sideline-flycheck"))]) (sideline-flymake . [(20240509 742) ((emacs (27 1)) (sideline (0 1 0))) "Show flymake errors with sideline" tar ((:commit . "06e84875022a5645ece8f4c2c8b56aa5f003c65d") (:authors ("Shen, Jen-Chieh" . "jcs090218@gmail.com")) (:maintainers ("Shen, Jen-Chieh" . "jcs090218@gmail.com")) (:maintainer "Shen, Jen-Chieh" . "jcs090218@gmail.com") (:keywords "convenience" "flymake") (:url . "https://github.com/emacs-sideline/sideline-flymake"))]) @@ -4953,7 +4961,7 @@ (spacegray-theme . [(20150719 1931) ((emacs (24 1))) "A Hyperminimal UI Theme" tar ((:commit . "7f70ee36297e5ccf9bc90b1f81472024f5a7a749") (:authors ("Bruce Williams" . "brwcodes@gmail.com")) (:maintainers ("Bruce Williams" . "brwcodes@gmail.com")) (:maintainer "Bruce Williams" . "brwcodes@gmail.com") (:keywords "themes") (:url . "http://github.com/bruce/emacs-spacegray-theme"))]) (spaceline . [(20230922 1127) ((emacs (24 4)) (cl-lib (0 5)) (powerline (2 3)) (dash (2 11 0)) (s (1 10 0))) "Modeline configuration library for powerline" tar ((:commit . "086420d16e526c79b67fc1edec4c2ae1e699f372") (:authors ("Eivind Fonn" . "evfonn@gmail.com")) (:maintainers ("Eivind Fonn" . "evfonn@gmail.com")) (:maintainer "Eivind Fonn" . "evfonn@gmail.com") (:keywords "mode-line" "powerline" "spacemacs") (:url . "https://github.com/TheBB/spaceline"))]) (spaceline-all-the-icons . [(20190325 1602) ((emacs (24 4)) (all-the-icons (2 6 0)) (spaceline (2 0 0)) (memoize (1 0 1))) "A Spaceline theme using All The Icons" tar ((:commit . "5afd48c10f1bd42d9b9648c5e64596b72f3e9042") (:authors ("Dominic Charlesworth" . "dgc336@gmail.com")) (:maintainers ("Dominic Charlesworth" . "dgc336@gmail.com")) (:maintainer "Dominic Charlesworth" . "dgc336@gmail.com") (:keywords "convenience" "lisp" "tools") (:url . "https://github.com/domtronn/spaceline-all-the-icons.el"))]) - (spacemacs-theme . [(20230530 1751) nil "Color theme with a dark and light versions" tar ((:commit . "319ad1cd6aa05dcb43e4edca50eca339892e0865") (:authors ("Nasser Alshammari")) (:maintainer "Nasser Alshammari") (:keywords "color" "theme") (:url . "https://github.com/nashamri/spacemacs-theme"))]) + (spacemacs-theme . [(20240623 2202) nil "Color theme with a dark and light versions" tar ((:commit . "7b06ef8fb26825e0035c70c81ac130b930d81bbc") (:authors ("Nasser Alshammari")) (:maintainer "Nasser Alshammari") (:keywords "color" "theme") (:url . "https://github.com/nashamri/spacemacs-theme"))]) (spaces . [(20170809 2208) nil "Create and switch between named window configurations." tar ((:commit . "6bdb51e9a346907d60a9625f6180bddd06be6674") (:authors ("Steven Thomas")) (:maintainers ("Steven Thomas")) (:maintainer "Steven Thomas") (:keywords "frames" "convenience") (:url . "https://github.com/chumpage/chumpy-windows"))]) (spanish-holidays . [(20240302 1542) nil "Spain holidays for calendar" tar ((:commit . "81ef3733da0ab807570c7fad1bab613bf7f30acb") (:authors ("Carlos Pajuelo" . "carlospajuelo_@hotmail.com")) (:maintainers ("Carlos Pajuelo" . "carlospajuelo_@hotmail.com")) (:maintainer "Carlos Pajuelo" . "carlospajuelo_@hotmail.com") (:keywords "calendar") (:url . "https://gitlab.com/gnuhack/spanish-holidays"))]) (spark . [(20230406 2307) ((emacs (24 3))) "sparkline generation" tar ((:commit . "0e58e5122cbb46fb6d850e3b72487431a3696861") (:authors ("Alvin Francis Dumalus")) (:maintainers ("Alvin Francis Dumalus")) (:maintainer "Alvin Francis Dumalus") (:keywords "lisp" "data") (:url . "https://github.com/alvinfrancis/spark"))]) @@ -5064,7 +5072,7 @@ (sv-kalender-namnsdagar . [(20240620 1416) ((emacs (24 3))) "Swedish name day calendar" tar ((:commit . "743aa9eec1364fa4194e11f7f10c29688cdd636b") (:authors ("Mats Lidell" . "mats.lidell@lidells.se")) (:maintainers ("Mats Lidell" . "mats.lidell@lidells.se")) (:maintainer "Mats Lidell" . "mats.lidell@lidells.se") (:keywords "calendar" "swedish" "localization") (:url . "https://github.com/matsl/sv-kalender-namnsdagar"))]) (svelte-mode . [(20211016 652) ((emacs (26 1))) "Emacs major mode for Svelte" tar ((:commit . "6a1d4274af7f4c0f271f77bd96678c3dd1fa68e1") (:authors ("Leaf" . "leafvocation@gmail.com")) (:maintainers ("Leaf" . "leafvocation@gmail.com")) (:maintainer "Leaf" . "leafvocation@gmail.com") (:keywords "wp" "languages") (:url . "https://github.com/leafOfTree/svelte-mode"))]) (svg-mode-line-themes . [(20150425 2006) ((xmlgen (0 4))) "SVG-based themes for mode-line" tar ((:commit . "80a0e01839cafbd66899202e7764c33231974259") (:authors ("sabof")) (:maintainers ("sabof")) (:maintainer "sabof") (:url . "https://github.com/sabof/svg-mode-line-themes"))]) - (svg-tag-mode . [(20240429 1052) ((emacs (27 1)) (svg-lib (0 2))) "Replace keywords with SVG tags" tar ((:commit . "a152bc90a7c9dc17112893a19ddf91078b909057") (:authors ("Nicolas P. Rougier" . "Nicolas.Rougier@inria.fr")) (:maintainers ("Nicolas P. Rougier" . "Nicolas.Rougier@inria.fr")) (:maintainer "Nicolas P. Rougier" . "Nicolas.Rougier@inria.fr") (:keywords "convenience") (:url . "https://github.com/rougier/svg-tag-mode"))]) + (svg-tag-mode . [(20240624 857) ((emacs (27 1)) (svg-lib (0 2))) "Replace keywords with SVG tags" tar ((:commit . "ece58da9362d34be48ac658107bd9b99ac250162") (:authors ("Nicolas P. Rougier" . "Nicolas.Rougier@inria.fr")) (:maintainers ("Nicolas P. Rougier" . "Nicolas.Rougier@inria.fr")) (:maintainer "Nicolas P. Rougier" . "Nicolas.Rougier@inria.fr") (:keywords "convenience") (:url . "https://github.com/rougier/svg-tag-mode"))]) (svgo . [(20220525 2059) ((emacs (26 2))) "SVG optimization with SVGO" tar ((:commit . "9b01cc9eb1fdf2731cd2b931a7dfe1f601b70786") (:authors ("Mathis Hofer" . "mathis@fsfe.org")) (:maintainers ("Mathis Hofer" . "mathis@fsfe.org")) (:maintainer "Mathis Hofer" . "mathis@fsfe.org") (:keywords "tools") (:url . "https://github.com/hupf/svgo.el/"))]) (svnwrapper . [(20180414 1843) ((e2ansi (0 1 1))) "Highlighting and paging for shell command `svn'" tar ((:commit . "de5069f5784e5d9e87a0af0159ba5f28a3716583") (:authors ("Anders Lindgren")) (:maintainers ("Anders Lindgren")) (:maintainer "Anders Lindgren") (:keywords "faces") (:url . "https://github.com/Lindydancer/svnwrapper"))]) (swagg . [(20240326 737) ((emacs (27 1)) (compat (29 1 4 0)) (request (0 3 3)) (dash (2 19 1)) (yaml (0 5 1)) (s (1 13 1))) "Swagger UI" tar ((:commit . "27d5e7d06c2296cd356ac4a5b97ec84f2dabbb53") (:authors ("Isa Mert Gurbuz" . "isamertgurbuz@gmail.com")) (:maintainers ("Isa Mert Gurbuz" . "isamertgurbuz@gmail.com")) (:maintainer "Isa Mert Gurbuz" . "isamertgurbuz@gmail.com") (:keywords "tools" "convenience") (:url . "https://github.com/isamert/swagg.el"))]) @@ -5204,7 +5212,7 @@ (third-time . [(20240207 1621) ((emacs (27 1))) "Third Time: A Better Way to Work" tar ((:commit . "093b74be860fac389fb173caef5fabf61e417eef") (:authors ("Samuel W. Flint" . "swflint@flintfam.org")) (:maintainers ("Samuel W. Flint" . "swflint@flintfam.org")) (:maintainer "Samuel W. Flint" . "swflint@flintfam.org") (:url . "https://git.sr.ht/~swflint/third-time"))]) (thread-dump . [(20170816 1850) nil "Java thread dump viewer" tar ((:commit . "204c9600242756d4b514bb5ff6293e052bf4b49d") (:authors ("Dmitry Neverov")) (:maintainers ("Dmitry Neverov")) (:maintainer "Dmitry Neverov") (:url . "http://github.com/nd/thread-dump.el"))]) (threes . [(20160820 1242) ((emacs (24)) (seq (1 11))) "A clone of Threes (a tiny puzzle game)" tar ((:commit . "6981acb30b856c77cba6aba63fefbf102cbdfbb2") (:authors ("Chunyang Xu" . "xuchunyang.me@gmail.com")) (:maintainers ("Chunyang Xu" . "xuchunyang.me@gmail.com")) (:maintainer "Chunyang Xu" . "xuchunyang.me@gmail.com") (:keywords "games") (:url . "https://github.com/xuchunyang/threes.el"))]) - (thrift . [(20240617 1257) ((emacs (24))) "major mode for fbthrift and Apache Thrift files" tar ((:commit . "d510221bfd3893c291edf893c6754db8a160babe") (:keywords "languages"))]) + (thrift . [(20240623 1632) ((emacs (24))) "major mode for fbthrift and Apache Thrift files" tar ((:commit . "2b9d5776e7ec1e9f7be45adba31378db8f3b244e") (:keywords "languages"))]) (thumb-through . [(20120119 534) nil "Plain text reader of HTML documents" tar ((:commit . "08d8fb720f93c6172653e035191a8fa9c3305e63") (:keywords "html"))]) (tickscript-mode . [(20171219 203) ((emacs (24 1))) "A major mode for Tickscript files" tar ((:commit . "f0579f38ff14954df5002ce30ae6d4a2c978d461") (:authors ("Marc Sherry" . "msherry@gmail.com")) (:maintainers ("Marc Sherry" . "msherry@gmail.com")) (:maintainer "Marc Sherry" . "msherry@gmail.com") (:keywords "languages") (:url . "https://github.com/msherry/tickscript-mode"))]) (tidal . [(20240407 1952) ((haskell-mode (16)) (emacs (25 1))) "Interact with TidalCycles for live coding patterns" tar ((:commit . "88f09edf6bef2228d5f530dea872b08a9d803066") (:authors (nil . "alex@slab.org")) (:maintainers (nil . "alex@slab.org")) (:maintainer nil . "alex@slab.org") (:keywords "tools") (:url . "https://github.com/tidalcycles/Tidal"))]) @@ -5216,6 +5224,7 @@ (time-ext . [(20170126 1215) nil "more function for time/date" tar ((:commit . "d128becf660fe3f30178eb1b05cd266741f4784a") (:authors ("rubikitch" . "rubikitch@ruby-lang.org")) (:maintainers ("rubikitch" . "rubikitch@ruby-lang.org")) (:maintainer "rubikitch" . "rubikitch@ruby-lang.org") (:keywords "lisp") (:url . "http://www.emacswiki.org/cgi-bin/wiki/download/time-ext.el"))]) (time-uuid-mode . [(20240112 1005) ((emacs (24 3))) "Minor mode for previewing time uuids as an overlay" tar ((:commit . "e30f50229c617bdd31a1edcd849cba1f3423fea1") (:authors ("Robert Plant" . "rob@robertplant.io")) (:maintainers ("Robert Plant" . "rob@robertplant.io")) (:maintainer "Robert Plant" . "rob@robertplant.io") (:keywords "extensions" "convenience" "data" "tools") (:url . "https://github.com/RobertPlant/time-uuid-mode"))]) (timecop . [(20240105 2100) ((emacs (26 3)) (datetime-format (0 0 1))) "Freeze Time for testing" tar ((:commit . "090bfff5c28fa0a6cb629512003c49b3f43ed72d") (:authors ("USAMI Kenta" . "tadsan@zonu.me")) (:maintainers ("USAMI Kenta" . "tadsan@zonu.me")) (:maintainer "USAMI Kenta" . "tadsan@zonu.me") (:keywords "lisp" "datetime" "testing") (:url . "https://github.com/emacs-php/emacs-datetime"))]) + (timeout . [(20240623 2023) ((emacs (24 4))) "Throttle or debounce elisp functions" tar ((:commit . "d59ca149307182b20e9843db0dd1738e01504cf1") (:authors ("Karthik Chikmagalur" . "karthikchikmagalur@gmail.com")) (:maintainers ("Karthik Chikmagalur" . "karthikchikmagalur@gmail.com")) (:maintainer "Karthik Chikmagalur" . "karthikchikmagalur@gmail.com") (:keywords "convenience" "extensions") (:url . "https://github.com/karthink/timeout"))]) (timer-revert . [(20150122 2032) nil "minor mode to revert buffer for a given time interval." tar ((:commit . "615c91dec8b440d2b9b7c725dd733d7432564e45") (:authors ("Yagnesh Raghava Yakkala. http://yagnesh.org")) (:maintainer nil . "hi@yagnesh.org") (:keywords "timer" "revert" "auto-revert.") (:url . "http://github.com/yyr/timer-revert"))]) (timesheet . [(20221004 1702) ((s (1)) (org (9))) "Timesheet management add-on for org-mode" tar ((:commit . "511751b239c84d7619ec1c61d7f108b732b64442") (:authors ("Tom Marble")) (:maintainers ("Tom Marble")) (:maintainer "Tom Marble") (:keywords "org" "timesheet") (:url . "https://github.com/tmarble/timesheet.el"))]) (timonier . [(20170411 800) ((emacs (24 4)) (s (1 11 0)) (f (0 19 0)) (dash (2 12 0)) (pkg-info (0 5 0)) (hydra (0 13 6)) (request (0 2 0)) (all-the-icons (2 0 0))) "Manage Kubernetes Applications" tar ((:commit . "3460a878269424c8d19b7d5d8e04749d0a8bf203") (:authors ("Nicolas Lamirault" . "nicolas.lamirault@gmail.com")) (:maintainers ("Nicolas Lamirault" . "nicolas.lamirault@gmail.com")) (:maintainer "Nicolas Lamirault" . "nicolas.lamirault@gmail.com") (:keywords "kubernetes" "docker") (:url . "https://github.com/nlamirault/timonier"))]) @@ -5239,7 +5248,7 @@ (tmux-pane . [(20240106 131) ((names (0 5)) (emacs (24)) (s (0))) "Provide integration between emacs window and tmux pane" tar ((:commit . "0ab0d40b497e984a589189358e04e322b8165985") (:keywords "convenience" "terminals" "tmux" "window" "pane" "navigation" "integration") (:url . "https://github.com/laishulu/emacs-tmux-pane"))]) (toc-mode . [(20220926 530) ((emacs (26 1))) "Manage outlines/table of contents of pdf and djvu documents" tar ((:commit . "448a0ac00c110802f3124bbf9c5a72bdfc3c3c28") (:authors ("Daniel Laurens Nicolai" . "dalanicolai@gmail.com")) (:maintainers ("Daniel Laurens Nicolai" . "dalanicolai@gmail.com")) (:maintainer "Daniel Laurens Nicolai" . "dalanicolai@gmail.com") (:keywords "tools" "outlines" "convenience") (:url . "https://github.com/dalanicolai/toc-mode"))]) (toc-org . [(20220110 1452) nil "add table of contents to org-mode files (formerly, org-toc)" tar ((:commit . "bf2e4b358efbd860ecafe6e74776de0885d9d100") (:authors ("Sergei Nosov <sergei.nosov [at] gmail.com>")) (:maintainers ("Sergei Nosov <sergei.nosov [at] gmail.com>")) (:maintainer "Sergei Nosov <sergei.nosov [at] gmail.com>") (:keywords "org-mode" "org-toc" "toc-org" "org" "toc" "table" "of" "contents") (:url . "https://github.com/snosov1/toc-org"))]) - (todoist . [(20240113 1729) ((dash (2 15 0)) (transient (0 1 0)) (org (8 3 5)) (emacs (25 3))) "Extension for interacting and managing todoist tasks" tar ((:commit . "e756a345d213d93fbb965d1314c4dec62566c653") (:authors ("Adrien Brochard")) (:maintainers ("Adrien Brochard")) (:maintainer "Adrien Brochard") (:keywords "todoist" "task" "todo" "comm") (:url . "https://github.com/abrochard/emacs-todoist"))]) + (todoist . [(20240624 1512) ((dash (2 15 0)) (transient (0 1 0)) (org (8 3 5)) (emacs (25 3))) "Extension for interacting and managing todoist tasks" tar ((:commit . "205c730a4615dec20ea71ccd0a09479a420cb974") (:authors ("Adrien Brochard")) (:maintainers ("Adrien Brochard")) (:maintainer "Adrien Brochard") (:keywords "todoist" "task" "todo" "comm") (:url . "https://github.com/abrochard/emacs-todoist"))]) (todotxt . [(20220204 1903) nil "A major mode for editing todo.txt files" tar ((:commit . "ddb25fb931b4bbc1af14c4c712d412af454794c4") (:authors ("Rick Dillon" . "rpdillon@killring.org")) (:maintainers ("Rick Dillon" . "rpdillon@killring.org")) (:maintainer "Rick Dillon" . "rpdillon@killring.org") (:keywords "todo.txt" "todotxt" "todotxt.el") (:url . "https://github.com/rpdillon/todotxt.el"))]) (todotxt-mode . [(20200228 952) nil "Major mode for editing todo.txt files" tar ((:commit . "8b616ce1cf3e18a60757450a0acf22996abb9b79") (:authors ("Adolfo Villafiorita" . "adolfo.villafiorita@me.com")) (:maintainers ("Adolfo Villafiorita" . "adolfo.villafiorita@me.com")) (:maintainer "Adolfo Villafiorita" . "adolfo.villafiorita@me.com") (:keywords "wp" "files"))]) (togetherly . [(20170426 616) ((cl-lib (0 3))) "allow multiple clients to edit a single buffer online" tar ((:commit . "65072b1d5e04c7098c318ebf1af279f596039ef9") (:authors ("zk_phi")) (:maintainers ("zk_phi")) (:maintainer "zk_phi") (:url . "http://hins11.yu-yake.com/"))]) @@ -5253,6 +5262,7 @@ (toml . [(20230411 1449) nil "TOML (Tom's Obvious, Minimal Language) parser" tar ((:commit . "ee4a12bfc8c890c5e8b4bfa35837ce672a882967") (:authors ("Wataru MIYAGUNI" . "gonngo@gmail.com")) (:maintainers ("Wataru MIYAGUNI" . "gonngo@gmail.com")) (:maintainer "Wataru MIYAGUNI" . "gonngo@gmail.com") (:keywords "toml" "parser") (:url . "https://github.com/gongo/emacs-toml"))]) (toml-mode . [(20161107 1800) ((emacs (24)) (cl-lib (0 5))) "Major mode for editing TOML files" tar ((:commit . "f6c61817b00f9c4a3cab1bae9c309e0fc45cdd06") (:authors ("Felix Chern" . "idryman@gmail.com")) (:maintainers ("Felix Chern" . "idryman@gmail.com")) (:maintainer "Felix Chern" . "idryman@gmail.com") (:keywords "data" "toml") (:url . "https://github.com/dryman/toml-mode.el"))]) (tommyh-theme . [(20131004 2330) nil "A bright, bold-colored theme for emacs" tar ((:commit . "46d1c69ee0a1ca7c67b569b891a2f28fed89e7d5") (:authors ("William Glass" . "william.glass@gmail.com")) (:maintainers ("William Glass" . "william.glass@gmail.com")) (:maintainer "William Glass" . "william.glass@gmail.com"))]) + (tomorrow-night-deepblue-theme . [(20240619 110) ((emacs (26 1))) "The Tomorrow Night Deepblue color theme" tar ((:commit . "679bb04452419faef3497f004b32fae739dde77b") (:authors ("James Cherti")) (:maintainers ("James Cherti")) (:maintainer "James Cherti") (:keywords "faces" "themes") (:url . "https://github.com/jamescherti/tomorrow-night-deepblue-theme.el"))]) (tongbu . [(20200414 507) ((emacs (25 1)) (web-server (0 1 2))) "A web server to share text or files between two devices" tar ((:commit . "6f6e5c5446f0c5735357ab520b249ab97295653e") (:authors ("Xu Chunyang")) (:maintainers ("Xu Chunyang")) (:maintainer "Xu Chunyang") (:keywords "tools") (:url . "https://github.com/xuchunyang/tongbu.el"))]) (topspace . [(20220824 134) ((emacs (25 1))) "Recenter line 1 with scrollable upper margin/padding" tar ((:commit . "33c2a6f0a11d1d88cdb2065c5a897e33507f4c86") (:authors ("Trevor Edwin Pogue" . "trevor.pogue@gmail.com")) (:maintainers ("Trevor Edwin Pogue" . "trevor.pogue@gmail.com")) (:maintainer "Trevor Edwin Pogue" . "trevor.pogue@gmail.com") (:keywords "convenience" "scrolling" "center" "cursor" "margin" "padding") (:url . "https://github.com/trevorpogue/topspace"))]) (topsy . [(20231214 843) ((emacs (26 3)) (compat (29 1))) "Simple sticky header" tar ((:commit . "8b6c6d5026ac72b4c3704ed7bb8fafe1ea343699") (:authors ("Adam Porter" . "adam@alphapapa.net")) (:maintainers ("Adam Porter" . "adam@alphapapa.net")) (:maintainer "Adam Porter" . "adam@alphapapa.net") (:keywords "convenience") (:url . "https://github.com/alphapapa/topsy.el"))]) @@ -5274,7 +5284,7 @@ (tramp-term . [(20220725 1441) nil "Automatic setup of directory tracking in ssh sessions" tar ((:commit . "ed75189122737d301f716a30a8013205aa3736f1") (:authors ("Randy Morris" . "randy.morris@archlinux.us")) (:maintainers ("Randy Morris" . "randy.morris@archlinux.us")) (:maintainer "Randy Morris" . "randy.morris@archlinux.us") (:keywords "comm" "terminals") (:url . "https://github.com/randymorris/tramp-term.el"))]) (transducers . [(20240308 843) ((emacs (28 1))) "Ergonomic, efficient data processing" tar ((:commit . "2d452e4cdc3b5cfa29ee3d7a645ff53d4e993384") (:authors ("Colin Woodbury" . "colin@fosskers.ca")) (:maintainers ("Colin Woodbury" . "colin@fosskers.ca")) (:maintainer "Colin Woodbury" . "colin@fosskers.ca") (:keywords "lisp") (:url . "https://git.sr.ht/~fosskers/transducers.el"))]) (transfer-sh . [(20200601 1708) ((emacs (24 3)) (async (1 0))) "Simple interface for sending buffer contents to transfer.sh" tar ((:commit . "0621a66d00ec91a209a542c10b158095088bd44d") (:keywords "comm" "convenience" "files") (:url . "https://gitlab.com/tuedachu/transfer-sh.el"))]) - (transient . [(20240622 1240) ((emacs (26 1)) (compat (29 1 4 5)) (seq (2 24))) "Transient commands" tar ((:commit . "06a87bd0f39dced6fc892fe7f710f008a1dde308") (:authors ("Jonas Bernoulli" . "emacs.transient@jonas.bernoulli.dev")) (:maintainers ("Jonas Bernoulli" . "emacs.transient@jonas.bernoulli.dev")) (:maintainer "Jonas Bernoulli" . "emacs.transient@jonas.bernoulli.dev") (:keywords "extensions") (:url . "https://github.com/magit/transient"))]) + (transient . [(20240626 947) ((emacs (26 1)) (compat (29 1 4 5)) (seq (2 24))) "Transient commands" tar ((:commit . "0e0ece32362bb5eed430328583018a35f44d3c7d") (:authors ("Jonas Bernoulli" . "emacs.transient@jonas.bernoulli.dev")) (:maintainers ("Jonas Bernoulli" . "emacs.transient@jonas.bernoulli.dev")) (:maintainer "Jonas Bernoulli" . "emacs.transient@jonas.bernoulli.dev") (:keywords "extensions") (:url . "https://github.com/magit/transient"))]) (transient-dwim . [(20221225 1630) ((emacs (26 1)) (transient (0 1))) "Useful preset transient commands" tar ((:commit . "cb5e0d35729fc6448553b7a17fc5c843f00e8c1d") (:authors ("Naoya Yamashita" . "conao3@gmail.com")) (:maintainers ("Naoya Yamashita" . "conao3@gmail.com")) (:maintainer "Naoya Yamashita" . "conao3@gmail.com") (:keywords "tools") (:url . "https://github.com/conao3/transient-dwim.el"))]) (transient-extras . [(20230721 839) ((emacs (28 1))) "Extra features for transient" tar ((:commit . "ca0d5c597382615f0ee8300ff8718f54f8214359") (:authors ("Al Haji-Ali <abdo.haji.ali@gmail.com>, Samuel W. Flint" . "swflint@flintfam.org")) (:maintainers ("Al Haji-Ali <abdo.haji.ali@gmail.com>, Samuel W. Flint" . "swflint@flintfam.org")) (:maintainer "Al Haji-Ali <abdo.haji.ali@gmail.com>, Samuel W. Flint" . "swflint@flintfam.org") (:keywords "convenience") (:url . "https://github.com/haji-ali/transient-extras.git"))]) (transient-extras-a2ps . [(20230303 1511) ((emacs (28 1)) (transient-extras (1 0 0))) "A transient interface to a2ps" tar ((:commit . "e91a1cddb1f0cb8b99d2bd30db64d467e5fa7ea8") (:authors ("Samuel W. Flint" . "swflint@flintfam.org")) (:maintainers ("Samuel W. Flint" . "swflint@flintfam.org")) (:maintainer "Samuel W. Flint" . "swflint@flintfam.org") (:keywords "convenience") (:url . "https://git.sr.ht/~swflint/transient-extras-a2ps"))]) @@ -5294,7 +5304,7 @@ (tree-sitter-ess-r . [(20221012 855) ((emacs (26 1)) (ess (18 10 1)) (tree-sitter (0 12 1)) (tree-sitter-langs (0 12 0))) "R with tree-sitter" tar ((:commit . "9669c00f3d3463e6769725af74c392891e269eed") (:authors ("Shuguang Sun" . "shuguang79@qq.com")) (:maintainers ("Shuguang Sun" . "shuguang79@qq.com")) (:maintainer "Shuguang Sun" . "shuguang79@qq.com") (:keywords "tools") (:url . "https://github.com/ShuguangSun/tree-sitter-ess-r"))]) (tree-sitter-indent . [(20220411 1439) ((emacs (26 1)) (tree-sitter (0 12 1)) (seq (2 20))) "Provide indentation with a Tree-sitter backend" tar ((:commit . "4ef246db3e4ff99f672fe5e4b416c890f885c09e") (:authors ("Felipe Lema" . "felipelema@mortemale.org")) (:maintainers ("Felipe Lema" . "felipelema@mortemale.org")) (:maintainer "Felipe Lema" . "felipelema@mortemale.org") (:keywords "convenience" "internal") (:url . "https://codeberg.org/FelipeLema/tree-sitter-indent.el"))]) (tree-sitter-ispell . [(20240610 2252) ((emacs (26 1)) (tree-sitter (0 15 0))) "Run ispell on tree-sitter text nodes" tar ((:commit . "a06eff00affff85992d2a8ad0019034747ffeb70") (:authors ("Erick Navarro" . "erick@navarro.io")) (:maintainers ("Erick Navarro" . "erick@navarro.io")) (:maintainer "Erick Navarro" . "erick@navarro.io") (:url . "https://github.com/erickgnavar/tree-sitter-ispell.el"))]) - (tree-sitter-langs . [(20240616 832) ((emacs (25 1)) (tree-sitter (0 15 0))) "Grammar bundle for tree-sitter" tar ((:commit . "a06804e13fc1d24d0099b44ce23d6ac5e6bac5b8") (:authors ("Tuấn-Anh Nguyễn" . "ubolonton@gmail.com")) (:maintainers ("Tuấn-Anh Nguyễn" . "ubolonton@gmail.com")) (:maintainer "Tuấn-Anh Nguyễn" . "ubolonton@gmail.com") (:keywords "languages" "tools" "parsers" "tree-sitter") (:url . "https://github.com/emacs-tree-sitter/tree-sitter-langs"))]) + (tree-sitter-langs . [(20240623 2252) ((emacs (25 1)) (tree-sitter (0 15 0))) "Grammar bundle for tree-sitter" tar ((:commit . "b597549d1e3e1fa69e942c4117b63a2089f625c6") (:authors ("Tuấn-Anh Nguyễn" . "ubolonton@gmail.com")) (:maintainers ("Tuấn-Anh Nguyễn" . "ubolonton@gmail.com")) (:maintainer "Tuấn-Anh Nguyễn" . "ubolonton@gmail.com") (:keywords "languages" "tools" "parsers" "tree-sitter") (:url . "https://github.com/emacs-tree-sitter/tree-sitter-langs"))]) (treebundel . [(20240531 2321) ((emacs (27 1)) (compat (29 1 4 2))) "Bundle related git-worktrees together" tar ((:commit . "b0a5d1bf924d8cadde5bae50b8d9ac131279b828") (:authors ("Ben Whitley")) (:maintainers ("Ben Whitley")) (:maintainer "Ben Whitley") (:keywords "convenience" "vc") (:url . "https://github.com/purplg/treebundel"))]) (treefactor . [(20200516 1631) ((emacs (26 1)) (dash (2 16 0)) (f (0 20 0)) (org (9 2 6)) (avy (0 5 0))) "Restructure your messy Org documents" tar ((:commit . "75357757022a4399ab772ff0d92065bd114dabe9") (:authors ("Leo Littlebook" . "Leo.Littlebook@gmail.com")) (:maintainers ("Leo Littlebook" . "Leo.Littlebook@gmail.com")) (:maintainer "Leo Littlebook" . "Leo.Littlebook@gmail.com") (:keywords "outlines" "files" "convenience") (:url . "https://github.com/cyberthal/treefactor"))]) (treemacs . [(20240613 2014) ((emacs (26 1)) (cl-lib (0 5)) (dash (2 11 0)) (s (1 12 0)) (ace-window (0 9 0)) (pfuture (1 7)) (hydra (0 13 2)) (ht (2 2)) (cfrs (1 3 2))) "A tree style file explorer package" tar ((:commit . "54ef590b7621032a76f8f3e307032fc13c802371") (:authors ("Alexander Miller" . "alexanderm@web.de")) (:maintainers ("Alexander Miller" . "alexanderm@web.de")) (:maintainer "Alexander Miller" . "alexanderm@web.de") (:url . "https://github.com/Alexander-Miller/treemacs"))]) @@ -5312,6 +5322,7 @@ (treesit-ispell . [(20240611 117) ((emacs (29 1))) "Run ispell on tree-sitter text nodes" tar ((:commit . "56740dccd5a72277fa05f19491e032e0c4701ad2") (:authors ("Erick Navarro" . "erick@navarro.io")) (:maintainers ("Erick Navarro" . "erick@navarro.io")) (:maintainer "Erick Navarro" . "erick@navarro.io") (:url . "https://github.com/erickgnavar/treesit-ispell.el"))]) (treeview . [(20230728 2343) ((emacs (24 4))) "A generic tree navigation library" tar ((:commit . "c6888e5f3aa0d72a7b4db625fcc2a847fd3bb1ce") (:authors ("Tilman Rassy" . "tilman.rassy@googlemail.com")) (:maintainers ("Tilman Rassy" . "tilman.rassy@googlemail.com")) (:maintainer "Tilman Rassy" . "tilman.rassy@googlemail.com") (:keywords "lisp" "tools" "internal" "convenience") (:url . "https://github.com/tilmanrassy/emacs-treeview"))]) (trident-mode . [(20190410 2036) ((emacs (24)) (slime (20130526)) (skewer-mode (1 5 0)) (dash (1 0 3))) "Live Parenscript interaction" tar ((:commit . "109a1bc10bd0c4b47679a6ca5c4cd27c7c8d4ccb") (:authors ("John Mastro" . "john.b.mastro@gmail.com")) (:maintainers ("John Mastro" . "john.b.mastro@gmail.com")) (:maintainer "John Mastro" . "john.b.mastro@gmail.com") (:keywords "languages" "lisp" "processes" "tools") (:url . "https://github.com/johnmastro/trident-mode.el"))]) + (trimspace-mode . [(20240607 2100) ((emacs (24 3))) "A minor mode to trim trailing whitespace and newlines" tar ((:commit . "a1134bcf6aaf4e10736502a487ba1cd2e9e5d45f") (:authors ("Björn Lindström" . "bkhl@elektrubadur.se")) (:maintainers ("Björn Lindström" . "bkhl@elektrubadur.se")) (:maintainer "Björn Lindström" . "bkhl@elektrubadur.se") (:keywords "files" "convenience") (:url . "https://git.sr.ht/~bkhl/trimspace-mode"))]) (trinary . [(20230301 2044) ((emacs (24))) "Trinary logic" tar ((:commit . "d4869d260f22d13a9a71327a6d40edc6980d022e") (:authors ("Matúš Goljer" . "matus.goljer@gmail.com")) (:maintainers ("Matúš Goljer" . "matus.goljer@gmail.com")) (:maintainer "Matúš Goljer" . "matus.goljer@gmail.com") (:keywords "languages") (:url . "https://github.com/emacs-elsa/trinary-logic"))]) (tron-legacy-theme . [(20230506 1037) nil "An original retro-futuristic theme inspired by Tron: Legacy" tar ((:commit . "44996469041a9b7f54c2a42ad2a3c16ac9579d77") (:authors ("Ian Y.E. Pan")) (:maintainers ("Ian Y.E. Pan")) (:maintainer "Ian Y.E. Pan") (:url . "https://github.com/ianpan870102/tron-legacy-emacs-theme"))]) (trr . [(20191019 1403) nil "a type-writing training program on GNU Emacs." tar ((:commit . "f841173e11213ac6916b2d3394b28fb202543871") (:authors ("YAMAMOTO Hirotaka" . "ymmt@is.s.u-tokyo.ac.jp") ("KATO Kenji" . "kato@suri.co.jp") (" *Original Author") ("INAMURA You" . "inamura@icot.or.jp") (" *Original Author")) (:maintainers ("YAMAMOTO Hirotaka" . "ymmt@is.s.u-tokyo.ac.jp")) (:maintainer "YAMAMOTO Hirotaka" . "ymmt@is.s.u-tokyo.ac.jp") (:keywords "games" "faces"))]) @@ -5393,6 +5404,7 @@ (unkillable-scratch . [(20221015 1323) ((emacs (24))) "Disallow the \\*scratch\\* buffer from being killed" tar ((:commit . "6c752e4cd4762bb4bcde2b0b96f2e83740efd104") (:authors ("Eric Crosson" . "eric.s.crosson@utexas.com")) (:maintainers ("Eric Crosson" . "eric.s.crosson@utexas.com")) (:maintainer "Eric Crosson" . "eric.s.crosson@utexas.com") (:keywords "convenience") (:url . "https://github.com/EricCrosson/unkillable-scratch"))]) (unmodified-buffer . [(20220129 2022) ((emacs (24 1))) "Auto revert modified buffer state" tar ((:commit . "9095a3f870aa570804a11d75aba0952294199715") (:authors ("Arthur Colombini Gusmao")) (:maintainers ("Arthur Colombini Gusmao")) (:maintainer "Arthur Colombini Gusmao") (:url . "https://github.com/arthurcgusmao/unmodified-buffer"))]) (unobtrusive-magit-theme . [(20200411 1349) ((emacs (24 1))) "An unobtrusive Magit theme" tar ((:commit . "aede357009655d19d4468320b2b61b0f26a47593") (:authors ("Thomas A. Brown" . "tabsoftwareconsulting@gmail.com")) (:maintainers ("Thomas A. Brown" . "tabsoftwareconsulting@gmail.com")) (:maintainer "Thomas A. Brown" . "tabsoftwareconsulting@gmail.com") (:keywords "faces" "vc" "magit") (:url . "https://github.com/tee3/unobtrusive-magit-theme"))]) + (unspecified-theme . [(20240620 2310) ((emacs (25)) (most-faces (0 0 3))) "Theme that unspecifies all attributes of all faces" tar ((:commit . "822f461bb04b4f8751bc2431140197a077d6c4a6") (:authors ("Mekeor Melire" . "mekeor@posteo.de")) (:maintainers ("Mekeor Melire" . "mekeor@posteo.de")) (:maintainer "Mekeor Melire" . "mekeor@posteo.de") (:keywords "faces" "theme") (:url . "https://codeberg.org/mekeor/unspecified-theme"))]) (untappd . [(20240316 1755) ((emacs (26 1)) (request (0 3 2)) (emojify (1 2 1))) "Display your latest Untappd feed" tar ((:commit . "0b46faab755c8f6c4b70a45c24af1673465d9958") (:authors ("Matthieu Petiteau" . "matt@smallwat3r.com")) (:maintainers ("Matthieu Petiteau" . "matt@smallwat3r.com")) (:maintainer "Matthieu Petiteau" . "matt@smallwat3r.com") (:url . "https://github.com/smallwat3r/untappd.el"))]) (untitled-new-buffer . [(20161212 1508) ((emacs (24 4)) (magic-filetype (0 2 0))) "Open untitled new buffer like other text editors." tar ((:commit . "e359ae63bc6310e315b7c25157858f9b9796ed3d") (:authors ("USAMI Kenta" . "tadsan@zonu.me")) (:maintainers ("USAMI Kenta" . "tadsan@zonu.me")) (:maintainer "USAMI Kenta" . "tadsan@zonu.me") (:keywords "files" "convenience") (:url . "https://github.com/zonuexe/untitled-new-buffer.el"))]) (upbo . [(20180422 822) ((dash (2 12 0)) (emacs (24 4))) "Karma Test Runner Integration" tar ((:commit . "63514c484e70cd6eeae828f7e58216e1a3429184") (:authors ("Sungho Kim(shiren)")) (:maintainers ("Sungho Kim(shiren)")) (:maintainer "Sungho Kim(shiren)") (:keywords "javascript" "js" "test" "karma") (:url . "http://github.com/shiren"))]) @@ -5446,7 +5458,7 @@ (vector-utils . [(20140508 2041) nil "Vector-manipulation utility functions" tar ((:commit . "5f9ced3960a318d611c3d20ffdc9ca74054fa8b7") (:authors ("Roland Walker" . "walker@pobox.com")) (:maintainers ("Roland Walker" . "walker@pobox.com")) (:maintainer "Roland Walker" . "walker@pobox.com") (:keywords "extensions") (:url . "http://github.com/rolandwalker/vector-utils"))]) (vega-view . [(20210401 1115) ((emacs (25)) (cider (0 24 0)) (parseedn (0 1))) "Vega visualization viewer" tar ((:commit . "3793025a523a86acc6255b4183b12ebfc95e1116") (:authors ("Jack Rusher" . "jack@appliedscience.studio")) (:maintainers ("Jack Rusher" . "jack@appliedscience.studio")) (:maintainer "Jack Rusher" . "jack@appliedscience.studio") (:keywords "multimedia") (:url . "https://www.github.com/applied-science/emacs-vega-view"))]) (vegetative-theme . [(20220822 353) ((autothemer (0 2)) (emacs (24))) "A Theme based on green CRT terminals" tar ((:commit . "db60ce0fe327ae7e4371545179ed94483b1132a8") (:url . "http://github.com/emacsfodder/emacs-theme-vegetative"))]) - (verb . [(20240609 1723) ((emacs (26 3))) "Organize and send HTTP requests" tar ((:commit . "5caa09dd24a3aeefe53ced5250a2ae4e638e576b") (:authors ("Federico Tedin" . "federicotedin@gmail.com")) (:maintainers ("Federico Tedin" . "federicotedin@gmail.com")) (:maintainer "Federico Tedin" . "federicotedin@gmail.com") (:keywords "tools") (:url . "https://github.com/federicotdn/verb"))]) + (verb . [(20240625 2335) ((emacs (26 3))) "Organize and send HTTP requests" tar ((:commit . "559b92c368552923b20ba220fac4a99032486bb1") (:authors ("Federico Tedin" . "federicotedin@gmail.com")) (:maintainers ("Federico Tedin" . "federicotedin@gmail.com")) (:maintainer "Federico Tedin" . "federicotedin@gmail.com") (:keywords "tools") (:url . "https://github.com/federicotdn/verb"))]) (veri-kompass . [(20200213 934) ((emacs (25)) (cl-lib (0 5)) (org (8 2 0))) "verilog codebase navigation facility" tar ((:commit . "271903cdf92db05898ee7cffb65641f30fa08280") (:maintainers (nil . "andrea_corallo@yahoo.it")) (:maintainer nil . "andrea_corallo@yahoo.it") (:keywords "languages" "extensions" "verilog" "hardware" "rtl") (:url . "https://gitlab.com/koral/veri-kompass"))]) (verify-url . [(20160426 1228) ((cl-lib (0 5))) "find out invalid urls in the buffer or region" tar ((:commit . "d6f3623cda8cd526a2d198619b137059cb1ba1ab") (:authors ("DarkSun" . "lujun9972@gmail.com")) (:maintainers ("DarkSun" . "lujun9972@gmail.com")) (:maintainer "DarkSun" . "lujun9972@gmail.com") (:keywords "convenience" "usability" "url") (:url . "https://github.com/lujun9972/verify-url"))]) (verilog-ext . [(20240407 1352) ((emacs (29 1)) (verilog-mode (2024 3 1 121933719)) (verilog-ts-mode (0 1 3)) (lsp-mode (8 0 0)) (ag (0 48)) (ripgrep (0 4 0)) (hydra (0 15 0)) (apheleia (3 1)) (yasnippet (0 14 0)) (flycheck (32)) (outshine (3 0 1)) (async (1 9 7))) "SystemVerilog Extensions" tar ((:commit . "1454457a85c9fb10145f45f80e1d3baa065017e5") (:authors ("Gonzalo Larumbe" . "gonzalomlarumbe@gmail.com")) (:maintainers ("Gonzalo Larumbe" . "gonzalomlarumbe@gmail.com")) (:maintainer "Gonzalo Larumbe" . "gonzalomlarumbe@gmail.com") (:keywords "verilog" "ide" "tools") (:url . "https://github.com/gmlarumbe/verilog-ext"))]) @@ -5455,7 +5467,7 @@ (versuri . [(20211104 1301) ((emacs (26 1)) (dash (2 16 0)) (request (0 3 0)) (anaphora (1 0 4)) (esxml (0 1 0)) (s (1 12 0)) (esqlite (0 3 1))) "The lyrics package" tar ((:commit . "c8ea562304194f3379ed8f9c6a785ce8ee72898e") (:authors ("Mihai Olteanu" . "mihai_olteanu@fastmail.fm")) (:maintainers ("Mihai Olteanu" . "mihai_olteanu@fastmail.fm")) (:maintainer "Mihai Olteanu" . "mihai_olteanu@fastmail.fm") (:keywords "multimedia") (:url . "https://github.com/mihaiolteanu/versuri/"))]) (vertica . [(20131217 1511) ((sql (3 0))) "Vertica SQL mode extension" tar ((:commit . "3c9647b425c5c13c30bf0cba483646af18196588") (:authors ("Roman Scherer" . "roman@burningswell.com")) (:maintainers ("Roman Scherer" . "roman@burningswell.com")) (:maintainer "Roman Scherer" . "roman@burningswell.com") (:keywords "sql" "vertica"))]) (vertica-snippets . [(20240527 1136) ((yasnippet (0 6 1))) "Yasnippets for Vertica" tar ((:commit . "d764a25bfba01b542d6bc24a5cd3f07d394c1657") (:authors ("Andreas Gerler" . "baron@bundesbrandschatzamt.de")) (:maintainers ("Andreas Gerler" . "baron@bundesbrandschatzamt.de")) (:maintainer "Andreas Gerler" . "baron@bundesbrandschatzamt.de") (:keywords "convenience" "snippets") (:url . "https://github.com/baron42bba/vertica-snippets"))]) - (vertico . [(20240511 2047) ((emacs (27 1)) (compat (29 1 4 4))) "VERTical Interactive COmpletion" tar ((:commit . "ba650a7ab90d66686ba787937ac9e71f749c598e") (:authors ("Daniel Mendler" . "mail@daniel-mendler.de")) (:maintainers ("Daniel Mendler" . "mail@daniel-mendler.de")) (:maintainer "Daniel Mendler" . "mail@daniel-mendler.de") (:keywords "convenience" "files" "matching" "completion") (:url . "https://github.com/minad/vertico"))]) + (vertico . [(20240625 506) ((emacs (27 1)) (compat (29 1 4 4))) "VERTical Interactive COmpletion" tar ((:commit . "0d2cde6c964833fe1f715921d9b174aee9b40b24") (:authors ("Daniel Mendler" . "mail@daniel-mendler.de")) (:maintainers ("Daniel Mendler" . "mail@daniel-mendler.de")) (:maintainer "Daniel Mendler" . "mail@daniel-mendler.de") (:keywords "convenience" "files" "matching" "completion") (:url . "https://github.com/minad/vertico"))]) (vertico-prescient . [(20240505 2249) ((emacs (27 1)) (prescient (6 1 0)) (vertico (0 28)) (compat (29 1))) "prescient.el + Vertico" tar ((:commit . "0765418e4362099db8788fcb745ce9b7602aa001") (:authors ("Radian LLC" . "contact+prescient@radian.codes")) (:maintainers ("Radian LLC" . "contact+prescient@radian.codes")) (:maintainer "Radian LLC" . "contact+prescient@radian.codes") (:keywords "extensions") (:url . "https://github.com/radian-software/prescient.el"))]) (vertigo . [(20211224 1256) ((dash (2 11 0))) "Jump across lines using the home row." tar ((:commit . "280b30518529242ee36cd436bd2349c34c35abb0") (:authors ("Fox Kiester" . "noct@posteo.net")) (:maintainers ("Fox Kiester" . "noct@posteo.net")) (:maintainer "Fox Kiester" . "noct@posteo.net") (:keywords "vim" "vertigo") (:url . "https://github.com/noctuid/vertigo.el"))]) (vhdl-capf . [(20160221 1734) nil "Completion at point function (capf) for vhdl-mode." tar ((:commit . "290abe217050f33532bc9ccb04f894123402f414") (:authors ("sh-ow" . "sh-ow@users.noreply.github.com")) (:maintainers ("sh-ow" . "sh-ow@users.noreply.github.com")) (:maintainer "sh-ow" . "sh-ow@users.noreply.github.com") (:keywords "convenience" "usability" "vhdl" "completion") (:url . "https://github.com/sh-ow/vhdl-capf"))]) @@ -5467,7 +5479,7 @@ (viking-mode . [(20160705 2027) nil "kill first, ask later" tar ((:commit . "c76aa265d13ad91d6890d242e142d05e31f0340b") (:authors ("T.v.Dein" . "tlinden@cpan.org")) (:maintainers ("T.v.Dein" . "tlinden@cpan.org")) (:maintainer "T.v.Dein" . "tlinden@cpan.org") (:keywords "kill" "delete") (:url . "https://github.com/tlinden/viking-mode"))]) (vim-empty-lines-mode . [(20150111 426) ((emacs (23))) "Vim-like empty line indicator at end of files." tar ((:commit . "442a29b0ba1635a3b352c9dd1faf9ce99656d048") (:authors ("Jonne Mickelin" . "jonne@ljhms.com")) (:maintainers ("Jonne Mickelin" . "jonne@ljhms.com")) (:maintainer "Jonne Mickelin" . "jonne@ljhms.com") (:keywords "emulations") (:url . "https://github.com/jmickelin/vim-empty-lines-mode"))]) (vim-region . [(20140329 1624) ((expand-region (20140127))) "Select region as vim" tar ((:commit . "7c4a99ce3678fee40c83ab88e8ad075d2a935fdf") (:authors ("ongaeshi" . "ongaeshi0621@gmail.com")) (:maintainers ("ongaeshi" . "ongaeshi0621@gmail.com")) (:maintainer "ongaeshi" . "ongaeshi0621@gmail.com") (:url . "https://github.com/ongaeshi/emacs-vim-region"))]) - (vim-tab-bar . [(20240620 309) ((emacs (28 1))) "Vim-like tab bar" tar ((:commit . "2ed991ac0511057abebaf6aaae78867b1674fed5") (:authors ("James Cherti")) (:maintainers ("James Cherti")) (:maintainer "James Cherti") (:keywords "frames") (:url . "https://github.com/jamescherti/vim-tab-bar.el"))]) + (vim-tab-bar . [(20240623 209) ((emacs (28 1))) "Vim-like tab bar" tar ((:commit . "78aaf7e0a08821ed621d8861dca7228c7d8b12e0") (:authors ("James Cherti")) (:maintainers ("James Cherti")) (:maintainer "James Cherti") (:keywords "frames") (:url . "https://github.com/jamescherti/vim-tab-bar.el"))]) (vimgolf . [(20200205 1420) nil "VimGolf interface for the One True Editor" tar ((:commit . "f565447ed294898588a19438d56c116555d8c628") (:authors ("Tim Visher" . "tim.visher@gmail.com")) (:maintainers ("Tim Visher" . "tim.visher@gmail.com")) (:maintainer "Tim Visher" . "tim.visher@gmail.com") (:keywords "games" "vimgolf" "vim") (:url . "https://github.com/timvisher/vimgolf.el"))]) (vimish-fold . [(20201205 1156) ((emacs (24 4)) (cl-lib (0 5)) (f (0 18 0))) "Fold text like in Vim" tar ((:commit . "a6501cbfe3db791f9ca17fd986c7202a87f3adb8") (:authors ("Mark Karpov" . "markkarpov92@gmail.com")) (:maintainers ("Mark Karpov" . "markkarpov92@gmail.com")) (:maintainer "Mark Karpov" . "markkarpov92@gmail.com") (:keywords "convenience") (:url . "https://github.com/mrkkrp/vimish-fold"))]) (vimrc-mode . [(20181116 1919) nil "Major mode for vimrc files" tar ((:commit . "13bc150a870d5d4a95f1111e4740e2b22813c30e") (:keywords "languages" "vim") (:url . "https://github.com/mcandre/vimrc-mode"))]) @@ -5499,7 +5511,7 @@ (vue-html-mode . [(20180428 2035) nil "Major mode for editing Vue.js templates" tar ((:commit . "361a9fa117f044c3072dc5a7344ff7be31725849") (:authors ("Adam Niederer" . "adam.niederer@gmail.com")) (:maintainers ("Adam Niederer" . "adam.niederer@gmail.com")) (:maintainer "Adam Niederer" . "adam.niederer@gmail.com") (:keywords "languages" "vue" "template") (:url . "http://github.com/AdamNiederer/vue-html-mode"))]) (vue-mode . [(20240101 333) ((mmm-mode (0 5 5)) (vue-html-mode (0 2)) (ssass-mode (0 2)) (edit-indirect (0 1 4))) "Major mode for vue component based on mmm-mode" tar ((:commit . "3a8056bc6ea6458265efb91067c7467860d2c118") (:authors ("codefalling" . "code.falling@gmail.com")) (:maintainers ("codefalling" . "code.falling@gmail.com")) (:maintainer "codefalling" . "code.falling@gmail.com") (:keywords "languages") (:url . "https://github.com/AdamNiederer/vue-mode"))]) (vuiet . [(20231231 1051) ((emacs (26 1)) (lastfm (1 1)) (versuri (1 0)) (s (1 12 0)) (bind-key (2 4)) (mpv (0 1 0)) (ivy (0 14 2))) "The music player and explorer for Emacs" tar ((:commit . "25d79860b165f04d7d39395138ed4f23e982132f") (:authors ("Mihai Olteanu" . "mihai_olteanu@fastmail.fm")) (:maintainers ("Mihai Olteanu" . "mihai_olteanu@fastmail.fm")) (:maintainer "Mihai Olteanu" . "mihai_olteanu@fastmail.fm") (:keywords "multimedia") (:url . "https://github.com/mihaiolteanu/vuiet"))]) - (vulpea . [(20240622 1018) ((emacs (27 2)) (org (9 4 4)) (org-roam (2 0 0)) (s (1 12)) (dash (2 19))) "A collection of org-roam note-taking functions" tar ((:commit . "2cd14af26e4ffafd069b2ed867c07102ad89bdd3") (:authors ("Boris Buliga" . "boris@d12frosted.io")) (:maintainers ("Boris Buliga" . "boris@d12frosted.io")) (:maintainer "Boris Buliga" . "boris@d12frosted.io") (:url . "https://github.com/d12frosted/vulpea"))]) + (vulpea . [(20240625 1858) ((emacs (27 2)) (org (9 4 4)) (org-roam (2 0 0)) (s (1 12)) (dash (2 19))) "A collection of org-roam note-taking functions" tar ((:commit . "8f1d683c496eefe271e0991d6614f608956a3d8d") (:authors ("Boris Buliga" . "boris@d12frosted.io")) (:maintainers ("Boris Buliga" . "boris@d12frosted.io")) (:maintainer "Boris Buliga" . "boris@d12frosted.io") (:url . "https://github.com/d12frosted/vulpea"))]) (vunit-mode . [(20230913 1754) ((hydra (0 14 0)) (emacs (24 3))) "VUnit Runner Interface" tar ((:commit . "a2126892f17a48c857682b6455f963a3fb7e07f0") (:authors ("Lukas Lichtl" . "support@embed-me.com")) (:maintainers ("Lukas Lichtl" . "support@embed-me.com")) (:maintainer "Lukas Lichtl" . "support@embed-me.com") (:keywords "vunit" "python" "tools") (:url . "https://github.com/embed-me"))]) (vyper-mode . [(20180707 1935) ((emacs (24 3))) "Major mode for the Vyper programming language" tar ((:commit . "323dfddfc38f0b11697e9ebaf04d1b53297e54e5") (:authors ("Alex Stokes" . "r.alex.stokes@gmail.com")) (:maintainers ("Alex Stokes" . "r.alex.stokes@gmail.com")) (:maintainer "Alex Stokes" . "r.alex.stokes@gmail.com") (:keywords "languages") (:url . "https://github.com/ralexstokes/vyper-mode"))]) (w32-browser . [(20170101 1954) nil "Run Windows application associated with a file." tar ((:commit . "e5c60eafd8f8d3546a0fa295ad5af2414d36b4e6") (:authors ("Emacs Wiki, Drew Adams")) (:maintainers (nil . "Drew Adams (concat \"drew.adams\" \"@\" \"oracle\" \".com\")")) (:maintainer nil . "Drew Adams (concat \"drew.adams\" \"@\" \"oracle\" \".com\")") (:keywords "mouse" "dired" "w32" "explorer") (:url . "http://www.emacswiki.org/w32-browser.el"))]) @@ -5508,7 +5520,7 @@ (wacspace . [(20180311 2350) ((dash (1 2 0)) (cl-lib (0 2))) "The WACky WorkSPACE manager for emACS" tar ((:commit . "54d19aab6fd2bc5945b7ffc58104e695064927e2") (:authors ("Emanuel Evans" . "emanuel.evans@gmail.com")) (:maintainer "Emanuel Evans" . "emanuel.evans@gmail.com") (:keywords "workspace") (:url . "http://github.com/shosti/wacspace.el"))]) (waf-mode . [(20170403 1940) nil "Waf integration for Emacs" tar ((:commit . "91c761336aa137b85b88b53b3f0cc60786d70800") (:authors ("Denys Valchuk" . "dvalchuk@gmail.com")) (:maintainers ("Denys Valchuk" . "dvalchuk@gmail.com")) (:maintainer "Denys Valchuk" . "dvalchuk@gmail.com") (:url . "https://bitbucket.org/dvalchuk/waf-mode"))]) (waher-theme . [(20141115 1230) ((emacs (24 1))) "Emacs 24 theme based on waher for st2 by dduckster" tar ((:commit . "60d31519fcfd8e797723d47961b255ae2f2e2c0a") (:authors ("Jasonm23" . "jasonm23@gmail.com")) (:maintainers ("Jasonm23" . "jasonm23@gmail.com")) (:maintainer "Jasonm23" . "jasonm23@gmail.com") (:url . "https://github.com/jasonm23/emacs-waher-theme"))]) - (wakatime-mode . [(20240203 1221) nil "Automatic time tracking extension for WakaTime" tar ((:commit . "25fb775178d16decb818b75f32fd23301c0f5da0") (:authors ("Gabor Torok" . "gabor@20y.hu")) (:maintainers ("Alan Hamlett" . "alan@wakatime.com")) (:maintainer "Alan Hamlett" . "alan@wakatime.com") (:keywords "calendar" "comm"))]) + (wakatime-mode . [(20240623 653) nil "Automatic time tracking extension for WakaTime" tar ((:commit . "1c5b2254dd72f2ff504d6a6189a8c10be03a98d1") (:authors ("Gabor Torok" . "gabor@20y.hu")) (:maintainers ("Alan Hamlett" . "alan@wakatime.com")) (:maintainer "Alan Hamlett" . "alan@wakatime.com") (:keywords "calendar" "comm"))]) (wakib-keys . [(20220211 1304) ((emacs (24 4))) "Minor Mode for Modern Keybindings" tar ((:commit . "ed86134f91c532a38d2739dd15ea6cec879cbd8a") (:authors ("Abdulla Bubshait")) (:maintainers ("Abdulla Bubshait")) (:maintainer "Abdulla Bubshait") (:keywords "convenience" "keybindings" "keys") (:url . "https://github.com/darkstego/wakib-keys/"))]) (wal-mode . [(20220409 1214) ((emacs (25 1))) "A major mode for the WAL programming language" tar ((:commit . "16733847f04af1929e590ff3e41f554baa3ba640") (:authors ("Lucas Klemmer" . "lucas.klemmer@jku.at")) (:maintainers ("Lucas Klemmer" . "lucas.klemmer@jku.at")) (:maintainer "Lucas Klemmer" . "lucas.klemmer@jku.at") (:keywords "languages") (:url . "https://github.com/LucasKl/wal-major-mode"))]) (walkclj . [(20220719 1610) ((emacs (25)) (parseclj (0 1 0)) (treepy (0 1 0)) (a (1 0 0))) "Manipulate Clojure parse trees" tar ((:commit . "875ee7a350f5141f425c4b5350a630e1ee1795e8") (:authors ("Arne Brasseur")) (:maintainers ("Arne Brasseur")) (:maintainer "Arne Brasseur") (:keywords "languages") (:url . "https://github.com/plexus/walkclj"))]) @@ -5597,7 +5609,7 @@ (winum . [(20190911 1607) ((cl-lib (0 5)) (dash (2 13 0))) "Navigate windows and frames using numbers." tar ((:commit . "098249c65042ee0308b8236d1ee838c8da8fdf25") (:authors ("Thomas de Beauchêne" . "thomas.de.beauchene@gmail.com")) (:maintainers ("Thomas de Beauchêne" . "thomas.de.beauchene@gmail.com")) (:maintainer "Thomas de Beauchêne" . "thomas.de.beauchene@gmail.com") (:keywords "convenience" "frames" "windows" "multi-screen") (:url . "http://github.com/deb0ch/winum.el"))]) (wisp-mode . [(20220529 1522) ((emacs (24 4))) "Tools for wisp: the Whitespace-to-Lisp preprocessor" tar ((:commit . "1a01003d400db8a42838cabcb26c06d627246a17") (:authors ("Arne Babenhauserheide" . "arne_bab@web.de")) (:maintainers ("Arne Babenhauserheide" . "arne_bab@web.de")) (:maintainer "Arne Babenhauserheide" . "arne_bab@web.de") (:keywords "languages" "lisp" "scheme") (:url . "http://www.draketo.de/english/wisp"))]) (wispjs-mode . [(20170720 1919) ((clojure-mode (0))) "Major mode for Wisp code." tar ((:commit . "60f9f5fd9d1556e2d008939f67eb1b1d0f325fa8") (:authors ("Kris Jenkins" . "krisajenkins@gmail.com")) (:maintainers ("Kris Jenkins" . "krisajenkins@gmail.com")) (:maintainer "Kris Jenkins" . "krisajenkins@gmail.com") (:url . "https://github.com/krisajenkins/wispjs-mode"))]) - (with-editor . [(20240618 1840) ((emacs (25 1)) (compat (29 1 4 5))) "Use the Emacsclient as $EDITOR" tar ((:commit . "0eff758e59b0efeab0a4f40b19c51e5712c19d4e") (:authors ("Jonas Bernoulli" . "emacs.with-editor@jonas.bernoulli.dev")) (:maintainers ("Jonas Bernoulli" . "emacs.with-editor@jonas.bernoulli.dev")) (:maintainer "Jonas Bernoulli" . "emacs.with-editor@jonas.bernoulli.dev") (:keywords "processes" "terminals") (:url . "https://github.com/magit/with-editor"))]) + (with-editor . [(20240623 1757) ((emacs (25 1)) (compat (29 1 4 5))) "Use the Emacsclient as $EDITOR" tar ((:commit . "322ee26d3a7d3d67840293041837b7e70cffa8d1") (:authors ("Jonas Bernoulli" . "emacs.with-editor@jonas.bernoulli.dev")) (:maintainers ("Jonas Bernoulli" . "emacs.with-editor@jonas.bernoulli.dev")) (:maintainer "Jonas Bernoulli" . "emacs.with-editor@jonas.bernoulli.dev") (:keywords "processes" "terminals") (:url . "https://github.com/magit/with-editor"))]) (with-emacs . [(20220814 444) ((emacs (24 4))) "Evaluate Emacs Lisp expressions in a separate Emacs process" tar ((:commit . "fb9ef454a4bb2d6de3415807b4858a20a9cc0dad") (:authors ("Gong Qijian" . "gongqijian@gmail.com")) (:maintainers ("Gong Qijian" . "gongqijian@gmail.com")) (:maintainer "Gong Qijian" . "gongqijian@gmail.com") (:keywords "tools") (:url . "https://github.com/twlz0ne/with-emacs.el"))]) (with-namespace . [(20130407 1822) ((dash (1 1 0)) (loop (1 1))) "interoperable elisp namespaces" tar ((:commit . "36828a40428c8e53c117f2df830b2f7a59ddd306") (:authors ("Wilfred Hughes" . "me@wilfred.me.uk")) (:maintainers ("Wilfred Hughes" . "me@wilfred.me.uk")) (:maintainer "Wilfred Hughes" . "me@wilfred.me.uk") (:keywords "namespaces"))]) (with-proxy . [(20200510 414) ((emacs (24 4))) "Evaluate expressions with proxy" tar ((:commit . "93b1ed2f3060f305009fa71f4fb5bb10173a10e3") (:authors ("Gong Qijian" . "gongqijian@gmail.com")) (:maintainers ("Gong Qijian" . "gongqijian@gmail.com")) (:maintainer "Gong Qijian" . "gongqijian@gmail.com") (:keywords "comm") (:url . "https://github.com/twlz0ne/with-proxy.el"))]) @@ -5676,7 +5688,7 @@ (yaml . [(20231211 1501) ((emacs (25 1))) "YAML parser for Elisp" tar ((:commit . "70c4fcead97e9bd6594e418c922ae769818f4245") (:authors ("Zachary Romero" . "zkry@posteo.org")) (:maintainers ("Zachary Romero" . "zkry@posteo.org")) (:maintainer "Zachary Romero" . "zkry@posteo.org") (:keywords "tools") (:url . "https://github.com/zkry/yaml.el"))]) (yaml-imenu . [(20220406 1703) ((emacs (24 4)) (yaml-mode (0))) "Enhancement of the imenu support in yaml-mode." tar ((:commit . "c1fbba8b03a7bef4fc2b87404914fa9c6eb67b55") (:authors ("Akinori MUSHA" . "knu@iDaemons.org")) (:maintainers ("Akinori MUSHA" . "knu@iDaemons.org")) (:maintainer "Akinori MUSHA" . "knu@iDaemons.org") (:keywords "outlining" "convenience" "imenu") (:url . "https://github.com/knu/yaml-imenu.el"))]) (yaml-mode . [(20240317 1602) ((emacs (24 1))) "Major mode for editing YAML files" tar ((:commit . "7b5ce294fb15c2c8926fa476d7218aa415550a2a") (:authors ("Yoshiki Kurihara" . "clouder@gmail.com") ("Marshall T. Vandegrift" . "llasram@gmail.com")) (:maintainers ("Vasilij Schneidermann" . "mail@vasilij.de")) (:maintainer "Vasilij Schneidermann" . "mail@vasilij.de") (:keywords "data" "yaml") (:url . "https://github.com/yoshiki/yaml-mode"))]) - (yaml-pro . [(20240611 1706) ((emacs (26 1)) (yaml (0 5 1))) "Parser-aided YAML editing features" tar ((:commit . "d8a02469ec617a1276e41f98008b049e8a02ca0b") (:authors ("Zachary Romero")) (:maintainers ("Zachary Romero")) (:maintainer "Zachary Romero") (:keywords "tools") (:url . "https://github.com/zkry/yaml-pro"))]) + (yaml-pro . [(20240623 1904) ((emacs (26 1)) (yaml (0 5 1))) "Parser-aided YAML editing features" tar ((:commit . "5f06949e92dc19dcc48dc31662b2aa958fe33726") (:authors ("Zachary Romero")) (:maintainers ("Zachary Romero")) (:maintainer "Zachary Romero") (:keywords "tools") (:url . "https://github.com/zkry/yaml-pro"))]) (yaml-tomato . [(20151123 753) ((s (1 9))) "copy or show the yaml path currently under cursor." tar ((:commit . "1272c502fac6ce6b0f8b7f8a9beb353f0b35e13c") (:authors ("qrczeno")) (:maintainers ("qrczeno")) (:maintainer "qrczeno") (:keywords "yaml"))]) (yang-mode . [(20190507 724) nil "major mode for editing YANG files" tar ((:commit . "4b4ab4d4a79d37d6c31c6ea7cccbc425e0b1eded") (:authors ("Martin Bjorklund" . "mbj4668@gmail.com")) (:maintainers ("Martin Bjorklund" . "mbj4668@gmail.com")) (:maintainer "Martin Bjorklund" . "mbj4668@gmail.com"))]) (yankpad . [(20220201 2104) ((emacs (25 1))) "Paste snippets from an org-mode file" tar ((:commit . "927e6d26956ac7219b8a69d641acf486854fba16") (:authors ("Erik Sjöstrand")) (:maintainers ("Erik Sjöstrand")) (:maintainer "Erik Sjöstrand") (:keywords "abbrev" "convenience") (:url . "http://github.com/Kungsgeten/yankpad"))]) diff --git a/emacs/elpa/archives/nongnu/archive-contents b/emacs/elpa/archives/nongnu/archive-contents @@ -135,6 +135,14 @@ (:authors ("Stephane Zermatten" . "szermatt@gmx.net")) (:commit . "a021468eec8ff8cacb74a9ea595d3587186e29ea"))]) + (beancount . + [(0 9) + nil "A major mode to edit Beancount input files." tar + ((:maintainer "Martin Blais" . "blais@furius.ca") + (:authors + ("Martin Blais" . "blais@furius.ca")) + (:url . "https://elpa.nongnu.org/nongnu/beancount.html") + (:commit . "71c16222461d947b82e45e4b986d01880b492bbb"))]) (better-jumper . [(1 0 1) ((emacs @@ -1091,7 +1099,7 @@ ("David Andersson" . "l.david.anderssonsverige.nu")) (:commit . "278cd3e6d5107693aa2bb33189ca503f22f227d0"))]) (gptel . - [(0 8 6) + [(0 9 0) ((emacs (27 1)) (transient @@ -1101,7 +1109,10 @@ "Interact with ChatGPT or other LLMs" tar ((:url . "https://github.com/karthink/gptel") (:keywords "convenience") - (:commit . "cdb07d0d2bb6a4fe6d6a620aa4eec98f70fe6f78"))]) + (:maintainer "Karthik Chikmagalur" . "karthik.chikmagalur@gmail.com") + (:authors + ("Karthik Chikmagalur" . "karthik.chikmagalur@gmail.com")) + (:commit . "4c0583b2bd6557a09d66dfec84bab776242d0848"))]) (graphql-mode . [(1 0 0) ((emacs @@ -1480,7 +1491,7 @@ ("Jason R. Blevins" . "jblevins@xbeta.org")) (:commit . "193b61605f44c85d261b8bd82e0a213fd8f1ff32"))]) (mastodon . - [(1 0 23) + [(1 0 24) ((emacs (27 1)) (request @@ -1493,7 +1504,7 @@ (:authors ("Johnson Denen" . "johnson.denen@gmail.com") ("Marty Hiatt" . "martianhiatus@riseup.net")) - (:commit . "ac5684acaa2c0910350a5a79977b28dea8ddf8d7"))]) + (:commit . "d1baf1eed450b5dc5ddb8555d29eec3bb969a4fb"))]) (material-theme . [(2015) ((emacs @@ -1941,7 +1952,7 @@ ("David Christiansen" . "david@davidchristiansen.dk")) (:commit . "1edda80e2e32b72e77f4f16ae5b83c312c68ee95"))]) (racket-mode . - [(1 0 20240620 135010) + [(1 0 20240621 124732) ((emacs (25 1))) "Racket editing, REPL, and more" tar @@ -2472,7 +2483,7 @@ ("Akib Azmain Turja" . "akib@disroot.org")) (:commit . "5203d9379afaf6703746823a580c804e1dd98e08"))]) (with-editor . - [(3 3 3) + [(3 3 4) ((emacs (25 1)) (compat @@ -2483,7 +2494,7 @@ (:maintainer "Jonas Bernoulli" . "emacs.with-editor@jonas.bernoulli.dev") (:authors ("Jonas Bernoulli" . "emacs.with-editor@jonas.bernoulli.dev")) - (:commit . "0eff758e59b0efeab0a4f40b19c51e5712c19d4e"))]) + (:commit . "322ee26d3a7d3d67840293041837b7e70cffa8d1"))]) (with-simulated-input . [(3 0) ((emacs diff --git a/emacs/elpa/archives/nongnu/archive-contents.signed b/emacs/elpa/archives/nongnu/archive-contents.signed @@ -1 +1 @@ -Good signature from 645357D2883A0966 GNU ELPA Signing Agent (2023) <elpasign@elpa.gnu.org> (trust undefined) created at 2024-06-22T21:10:04+0000 using EDDSA -\ No newline at end of file +Good signature from 645357D2883A0966 GNU ELPA Signing Agent (2023) <elpasign@elpa.gnu.org> (trust undefined) created at 2024-06-26T09:10:04+0000 using EDDSA +\ No newline at end of file diff --git a/emacs/elpa/doom-modeline-20240605.628/doom-modeline-core.elc b/emacs/elpa/doom-modeline-20240605.628/doom-modeline-core.elc Binary files differ. diff --git a/emacs/elpa/doom-modeline-20240605.628/doom-modeline-env.elc b/emacs/elpa/doom-modeline-20240605.628/doom-modeline-env.elc Binary files differ. diff --git a/emacs/elpa/doom-modeline-20240605.628/doom-modeline-pkg.el b/emacs/elpa/doom-modeline-20240605.628/doom-modeline-pkg.el @@ -1,17 +0,0 @@ -(define-package "doom-modeline" "20240605.628" "A minimal and modern mode-line" - '((emacs "25.1") - (compat "29.1.4.5") - (nerd-icons "0.1.0") - (shrink-path "0.3.1")) - :commit "11ae6c193cd9cb8d7ff7996058e6df2c0d1e408b" :authors - '(("Vincent Zhang" . "seagle0128@gmail.com")) - :maintainers - '(("Vincent Zhang" . "seagle0128@gmail.com")) - :maintainer - '("Vincent Zhang" . "seagle0128@gmail.com") - :keywords - '("faces" "mode-line") - :url "https://github.com/seagle0128/doom-modeline") -;; Local Variables: -;; no-byte-compile: t -;; End: diff --git a/emacs/elpa/doom-modeline-20240605.628/doom-modeline-segments.el b/emacs/elpa/doom-modeline-20240605.628/doom-modeline-segments.el @@ -1,3243 +0,0 @@ -;;; doom-modeline-segments.el --- The segments for doom-modeline -*- lexical-binding: t; -*- - -;; Copyright (C) 2018-2024 Vincent Zhang - -;; This file is not part of GNU Emacs. - -;; -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <https://www.gnu.org/licenses/>. -;; - -;;; Commentary: -;; -;; The segments for doom-modeline. -;; Use `doom-modeline-def-segment' to create a new segment. -;; - -;;; Code: - -(require 'doom-modeline-core) -(require 'doom-modeline-env) -(eval-when-compile - (require 'cl-lib) - (require 'seq) - (require 'subr-x)) - - -;; -;; Externals -;; - -(defvar Info-current-file) -(defvar Info-current-node) -(defvar Info-mode-line-node-keymap) -(defvar anzu--cached-count) -(defvar anzu--current-position) -(defvar anzu--overflow-p) -(defvar anzu--state) -(defvar anzu--total-matched) -(defvar anzu-cons-mode-line-p) -(defvar aw-keys) -(defvar battery-echo-area-format) -(defvar battery-load-critical) -(defvar battery-mode-line-format) -(defvar battery-mode-line-limit) -(defvar battery-status-function) -(defvar boon-command-state) -(defvar boon-insert-state) -(defvar boon-off-state) -(defvar boon-special-state) -(defvar display-time-string) -(defvar edebug-execution-mode) -(defvar eglot--managed-mode) -(defvar erc-modified-channels-alist) -(defvar evil-ex-active-highlights-alist) -(defvar evil-ex-argument) -(defvar evil-ex-range) -(defvar evil-mc-frozen) -(defvar evil-state) -(defvar evil-visual-beginning) -(defvar evil-visual-end) -(defvar evil-visual-selection) -(defvar flycheck--automatically-enabled-checkers) -(defvar flycheck-current-errors) -(defvar flycheck-mode-menu-map) -(defvar flymake--mode-line-format) -(defvar flymake--state) -(defvar flymake-menu) -(defvar gnus-newsrc-alist) -(defvar gnus-newsrc-hashtb) -(defvar grip--process) -(defvar helm--mode-line-display-prefarg) -(defvar iedit-occurrences-overlays) -(defvar kele-menu-map) -(defvar meow--indicator) -(defvar minions-mode-line-lighter) -(defvar minions-mode-line-minor-modes-map) -(defvar mlscroll-minimum-current-width) -(defvar mlscroll-right-align) -(defvar mu4e--modeline-item) -(defvar mu4e-alert-mode-line) -(defvar mu4e-alert-modeline-formatter) -(defvar mu4e-modeline-mode) -(defvar nyan-minimum-window-width) -(defvar objed--obj-state) -(defvar objed--object) -(defvar objed-modeline-setup-func) -(defvar persp-nil-name) -(defvar phi-replace--mode-line-format) -(defvar phi-search--overlays) -(defvar phi-search--selection) -(defvar phi-search-mode-line-format) -(defvar poke-line-minimum-window-width) -(defvar rcirc-activity) -(defvar sml-modeline-len) -(defvar symbol-overlay-keywords-alist) -(defvar symbol-overlay-temp-symbol) -(defvar text-scale-mode-amount) -(defvar tracking-buffers) -(defvar winum-auto-setup-mode-line) -(defvar xah-fly-insert-state-p) - -(declare-function anzu--reset-status "ext:anzu") -(declare-function anzu--where-is-here "ext:anzu") -(declare-function async-inject-variables "ext:async") -(declare-function async-start "ext:async") -(declare-function avy-traverse "ext:avy") -(declare-function avy-tree "ext:avy") -(declare-function aw-update "ext:ace-window") -(declare-function aw-window-list "ext:ace-window") -(declare-function battery-format "battery") -(declare-function battery-update "battery") -(declare-function boon-modeline-string "ext:boon") -(declare-function boon-state-string "ext:boon") -(declare-function cider--connection-info "ext:cider") -(declare-function cider-connected-p "ext:cider") -(declare-function cider-current-repl "ext:cider") -(declare-function cider-jack-in "ext:cider") -(declare-function cider-quit "ext:cider") -(declare-function citre-mode "ext:citre-basic-tools") -(declare-function compilation-goto-in-progress-buffer "compile") -(declare-function dap--cur-session "ext:dap-mode") -(declare-function dap--debug-session-name "ext:dap-mode") -(declare-function dap--debug-session-state "ext:dap-mode") -(declare-function dap--session-running "ext:dap-mode") -(declare-function dap-debug-recent "ext:dap-mode") -(declare-function dap-disconnect "ext:dap-mode") -(declare-function dap-hydra "ext:dap-hydra") -(declare-function edebug-help "edebug") -(declare-function edebug-next-mode "edebug") -(declare-function edebug-stop "edebug") -(declare-function eglot "ext:eglot") -(declare-function eglot--major-modes "ext:eglot" t t) -(declare-function eglot--project-nickname "ext:eglot" t t) -(declare-function eglot-clear-status "ext:eglot") -(declare-function eglot-current-server "ext:eglot") -(declare-function eglot-events-buffer "ext:eglot") -(declare-function eglot-forget-pending-continuations "ext:eglot") -(declare-function eglot-managed-p "ext:glot") -(declare-function eglot-reconnect "ext:eglot") -(declare-function eglot-shutdown "ext:eglot") -(declare-function eglot-stderr-buffer "ext:eglot") -(declare-function erc-switch-to-buffer "erc") -(declare-function erc-track-switch-buffer "erc-track") -(declare-function evil-delimited-arguments "ext:evil-common") -(declare-function evil-emacs-state-p "ext:evil-states" t t) -(declare-function evil-force-normal-state "ext:evil-commands" t t) -(declare-function evil-insert-state-p "ext:evil-states" t t) -(declare-function evil-motion-state-p "ext:evil-states" t t) -(declare-function evil-normal-state-p "ext:evil-states" t t) -(declare-function evil-operator-state-p "ext:evil-states" t t) -(declare-function evil-replace-state-p "ext:evil-states" t t) -(declare-function evil-state-property "ext:evil-common") -(declare-function evil-visual-state-p "ext:evil-states" t t) -(declare-function eyebrowse--get "ext:eyebrowse") -(declare-function face-remap-remove-relative "face-remap") -(declare-function fancy-narrow-active-p "ext:fancy-narrow") -(declare-function flycheck-buffer "ext:flycheck") -(declare-function flycheck-count-errors "ext:flycheck") -(declare-function flycheck-error-level-compilation-level "ext:flycheck") -(declare-function flycheck-list-errors "ext:flycheck") -(declare-function flycheck-next-error "ext:flycheck") -(declare-function flycheck-previous-error "ext:flycheck") -(declare-function flymake--diag-type "ext:flymake" t t) -(declare-function flymake--handle-report "ext:flymake") -(declare-function flymake--lookup-type-property "ext:flymake") -(declare-function flymake--state-diags "ext:flymake" t t) -(declare-function flymake-disabled-backends "ext:flymake") -(declare-function flymake-goto-next-error "ext:flymake") -(declare-function flymake-goto-prev-error "ext:flymake") -(declare-function flymake-reporting-backends "ext:flymake") -(declare-function flymake-running-backends "ext:flymake") -(declare-function flymake-show-buffer-diagnostics "ext:flymake") -(declare-function flymake-show-buffer-diagnostics "ext:flymake") -(declare-function flymake-start "ext:flymake") -(declare-function follow-all-followers "follow") -(declare-function gnus-demon-add-handler "gnus-demon") -(declare-function grip--preview-url "ext:grip-mode") -(declare-function grip-browse-preview "ext:grip-mode") -(declare-function grip-restart-preview "ext:grip-mode") -(declare-function grip-stop-preview "ext:grip-mode") -(declare-function helm-candidate-number-at-point "ext:helm-core") -(declare-function helm-get-candidate-number "ext:helm-core") -(declare-function iedit-find-current-occurrence-overlay "ext:iedit-lib") -(declare-function iedit-prev-occurrence "ext:iedit-lib") -(declare-function image-get-display-property "image-mode") -(declare-function jsonrpc--request-continuations "ext:jsonrpc" t t) -(declare-function jsonrpc-last-error "ext:jsonrpc" t t) -(declare-function kele-current-context-name "ext:kele") -(declare-function kele-current-namespace "ext:kele") -(declare-function lsp--workspace-print "ext:lsp-mode") -(declare-function lsp-describe-session "ext:lsp-mode") -(declare-function lsp-workspace-folders-open "ext:lsp-mode") -(declare-function lsp-workspace-restart "ext:lsp-mode") -(declare-function lsp-workspace-shutdown "ext:lsp-mode") -(declare-function lsp-workspaces "ext:lsp-mode") -(declare-function lv-message "ext:lv") -(declare-function mc/num-cursors "ext:multiple-cursors-core") -(declare-function meow--current-state "ext:meow") -(declare-function meow-beacon-mode-p "ext:meow") -(declare-function meow-insert-mode-p "ext:meow") -(declare-function meow-keypad-mode-p "ext:meow") -(declare-function meow-motion-mode-p "ext:meow") -(declare-function meow-normal-mode-p "ext:meow") -(declare-function minions--prominent-modes "ext:minions") -(declare-function mlscroll-mode-line "ext:mlscroll") -(declare-function mu4e--modeline-string "ext:mu4e-modeline") -(declare-function mu4e-alert-default-mode-line-formatter "ext:mu4e-alert") -(declare-function mu4e-alert-enable-mode-line-display "ext:mu4e-alert") -(declare-function nyan-create "ext:nyan-mode") -(declare-function org-edit-src-save "ext:org-src") -(declare-function parrot-create "ext:parrot") -(declare-function pdf-cache-number-of-pages "ext:pdf-cache" t t) -(declare-function persp-add-buffer "ext:persp-mode") -(declare-function persp-contain-buffer-p "ext:persp-mode") -(declare-function persp-switch "ext:persp-mode") -(declare-function phi-search--initialize "ext:phi-search") -(declare-function poke-line-create "ext:poke-line") -(declare-function popup-create "ext:popup") -(declare-function popup-delete "ext:popup") -(declare-function rcirc-next-active-buffer "rcirc") -(declare-function rcirc-short-buffer-name "rcirc") -(declare-function rcirc-switch-to-server-buffer "rcirc") -(declare-function rcirc-window-configuration-change "rcirc") -(declare-function rime--should-enable-p "ext:rime") -(declare-function rime--should-inline-ascii-p "ext:rime") -(declare-function sml-modeline-create "ext:sml-modeline") -(declare-function svg-circle "svg") -(declare-function svg-create "svg") -(declare-function svg-image "svg") -(declare-function svg-line "svg") -(declare-function symbol-overlay-assoc "ext:symbol-overlay") -(declare-function symbol-overlay-get-list "ext:symbol-overlay") -(declare-function symbol-overlay-get-symbol "ext:symbol-overlay") -(declare-function symbol-overlay-rename "ext:symbol-overlay") -(declare-function tab-bar--current-tab "tab-bar") -(declare-function tab-bar--current-tab-index "tab-bar") -(declare-function tracking-next-buffer "ext:tracking") -(declare-function tracking-previous-buffer "ext:tracking") -(declare-function tracking-shorten "ext:tracking") -(declare-function undo-tree-redo-1 "ext:undo-tree") -(declare-function undo-tree-undo-1 "ext:undo-tree") -(declare-function warning-numeric-level "warnings") -(declare-function window-numbering-clear-mode-line "ext:window-numbering") -(declare-function window-numbering-get-number-string "ext:window-numbering") -(declare-function window-numbering-install-mode-line "ext:window-numbering") -(declare-function winum--clear-mode-line "ext:winum") -(declare-function winum--install-mode-line "ext:winum") -(declare-function winum-get-number-string "ext:winum") - - - -;; -;; Buffer information -;; - -(defvar-local doom-modeline--buffer-file-icon nil) -(defun doom-modeline-update-buffer-file-icon (&rest _) - "Update file icon in mode-line." - (setq doom-modeline--buffer-file-icon - (when (and doom-modeline-major-mode-icon - (doom-modeline-icon-displayable-p)) - (let ((icon (doom-modeline-icon-for-buffer))) - (propertize (if (or (null icon) (symbolp icon)) - (doom-modeline-icon 'faicon "nf-fa-file_o" nil nil - :face 'nerd-icons-dsilver) - (doom-modeline-propertize-icon icon)) - 'help-echo (format "Major-mode: %s" (format-mode-line mode-name))))))) -(add-hook 'find-file-hook #'doom-modeline-update-buffer-file-icon) -(add-hook 'after-change-major-mode-hook #'doom-modeline-update-buffer-file-icon) -(add-hook 'clone-indirect-buffer-hook #'doom-modeline-update-buffer-file-icon) - -(doom-modeline-add-variable-watcher - 'doom-modeline-icon - (lambda (_sym val op _where) - (when (eq op 'set) - (setq doom-modeline-icon val) - (dolist (buf (buffer-list)) - (with-current-buffer buf - (doom-modeline-update-buffer-file-icon)))))) - -(defun doom-modeline-buffer-file-state-icon (icon unicode text face) - "Displays an ICON of buffer state with FACE. -UNICODE and TEXT are the alternatives if it is not applicable. -Uses `nerd-icons-mdicon' to fetch the icon." - (doom-modeline-icon 'mdicon icon unicode text :face face)) - -(defvar-local doom-modeline--buffer-file-state-icon nil) -(defun doom-modeline-update-buffer-file-state-icon (&rest _) - "Update the buffer or file state in mode-line." - (setq doom-modeline--buffer-file-state-icon - (when doom-modeline-buffer-state-icon - (ignore-errors - (concat - (cond (buffer-read-only - (doom-modeline-buffer-file-state-icon - "nf-md-lock" "🔒" "%1*" - 'doom-modeline-warning)) - ((and buffer-file-name (buffer-modified-p) - doom-modeline-buffer-modification-icon) - (doom-modeline-buffer-file-state-icon - "nf-md-content_save_edit" "💾" "%1*" - 'doom-modeline-warning)) - ((and buffer-file-name - ;; Avoid freezing while connection is lost - (not (file-remote-p buffer-file-name)) - (not (file-exists-p buffer-file-name))) - (doom-modeline-buffer-file-state-icon - "nf-md-cancel" "🚫" "!" - 'doom-modeline-urgent)) - (t "")) - (when (or (buffer-narrowed-p) - (and (bound-and-true-p fancy-narrow-mode) - (fancy-narrow-active-p)) - (bound-and-true-p dired-narrow-mode)) - (doom-modeline-buffer-file-state-icon - "nf-md-unfold_less_horizontal" "↕" "><" - 'doom-modeline-warning))))))) - -(defvar-local doom-modeline--buffer-file-name nil) -(defun doom-modeline-update-buffer-file-name (&rest _) - "Update buffer file name in mode-line." - (setq doom-modeline--buffer-file-name - (ignore-errors - (save-match-data - (if buffer-file-name - (doom-modeline-buffer-file-name) - (propertize "%b" - 'face 'doom-modeline-buffer-file - 'mouse-face 'doom-modeline-highlight - 'help-echo "Buffer name -mouse-1: Previous buffer\nmouse-3: Next buffer" - 'local-map mode-line-buffer-identification-keymap)))))) -(add-hook 'find-file-hook #'doom-modeline-update-buffer-file-name) -(add-hook 'after-save-hook #'doom-modeline-update-buffer-file-name) -(add-hook 'clone-indirect-buffer-hook #'doom-modeline-update-buffer-file-name) -(add-hook 'evil-insert-state-exit-hook #'doom-modeline-update-buffer-file-name) -(add-hook 'Info-selection-hook #'doom-modeline-update-buffer-file-name) -(advice-add #'rename-buffer :after #'doom-modeline-update-buffer-file-name) -(advice-add #'set-visited-file-name :after #'doom-modeline-update-buffer-file-name) -(advice-add #'pop-to-buffer :after #'doom-modeline-update-buffer-file-name) -(advice-add #'popup-create :after #'doom-modeline-update-buffer-file-name) -(advice-add #'popup-delete :after #'doom-modeline-update-buffer-file-name) -;; (advice-add #'primitive-undo :after #'doom-modeline-update-buffer-file-name) -;; (advice-add #'set-buffer-modified-p :after #'doom-modeline-update-buffer-file-name) - -(with-no-warnings - (if (boundp 'after-focus-change-function) - (progn - (advice-add #'handle-switch-frame :after #'doom-modeline-update-buffer-file-name) - (add-function :after after-focus-change-function #'doom-modeline-update-buffer-file-name)) - (progn - (add-hook 'focus-in-hook #'doom-modeline-update-buffer-file-name) - (add-hook 'focus-out-hook #'doom-modeline-update-buffer-file-name)))) - -(doom-modeline-add-variable-watcher - 'doom-modeline-buffer-file-name-style - (lambda (_sym val op _where) - (when (eq op 'set) - (setq doom-modeline-buffer-file-name-style val) - (dolist (buf (buffer-list)) - (with-current-buffer buf - (when buffer-file-name - (doom-modeline-update-buffer-file-name))))))) - -(defsubst doom-modeline--buffer-mode-icon () - "The icon of the current major mode." - (when (and doom-modeline-icon doom-modeline-major-mode-icon) - (when-let ((icon (or doom-modeline--buffer-file-icon - (doom-modeline-update-buffer-file-icon)))) - (unless (string-empty-p icon) - (concat - (if doom-modeline-major-mode-color-icon - (doom-modeline-display-icon icon) - (doom-modeline-propertize-icon - icon - (doom-modeline-face))) - (doom-modeline-vspc)))))) - -(defsubst doom-modeline--buffer-state-icon () - "The icon of the current buffer state." - (when doom-modeline-buffer-state-icon - (when-let ((icon (doom-modeline-update-buffer-file-state-icon))) - (unless (string-empty-p icon) - (concat - (doom-modeline-display-icon icon) - (doom-modeline-vspc)))))) - -(defsubst doom-modeline--buffer-simple-name () - "The buffer simple name." - (propertize "%b" - 'face (doom-modeline-face - (if (and doom-modeline-highlight-modified-buffer-name - (buffer-modified-p)) - 'doom-modeline-buffer-modified - 'doom-modeline-buffer-file)) - 'mouse-face 'doom-modeline-highlight - 'help-echo "Buffer name -mouse-1: Previous buffer\nmouse-3: Next buffer" - 'local-map mode-line-buffer-identification-keymap)) - -(defsubst doom-modeline--buffer-name () - "The current buffer name." - (when doom-modeline-buffer-name - (if (and (not (eq doom-modeline-buffer-file-name-style 'file-name)) - doom-modeline--limited-width-p) - ;; Only display the buffer name if the window is small, and doesn't - ;; need to respect file-name style. - (doom-modeline--buffer-simple-name) - (when-let ((name (or doom-modeline--buffer-file-name - (doom-modeline-update-buffer-file-name)))) - ;; Check if the buffer is modified - (if (and doom-modeline-highlight-modified-buffer-name - (buffer-modified-p)) - (propertize name 'face (doom-modeline-face 'doom-modeline-buffer-modified)) - (doom-modeline-display-text name)))))) - -(doom-modeline-def-segment buffer-info - "Combined information about the current buffer. - -Including the current working directory, the file name, and its state (modified, -read-only or non-existent)." - (concat - (doom-modeline-spc) - (doom-modeline--buffer-mode-icon) - (doom-modeline--buffer-state-icon) - (doom-modeline--buffer-name))) - -(doom-modeline-def-segment buffer-info-simple - "Display only the current buffer's name, but with fontification." - (concat - (doom-modeline-spc) - (doom-modeline--buffer-mode-icon) - (doom-modeline--buffer-state-icon) - (doom-modeline--buffer-simple-name))) - -(doom-modeline-def-segment calc - "Display calculator icons and info." - (concat - (doom-modeline-spc) - (when-let ((icon (doom-modeline-icon 'faicon "nf-fa-calculator" "🖩" ""))) - (concat - (doom-modeline-display-icon icon) - (doom-modeline-vspc))) - (doom-modeline--buffer-simple-name))) - -(doom-modeline-def-segment buffer-default-directory - "Displays `default-directory' with the icon and state. - -This is for special buffers like the scratch buffer where knowing the current -project directory is important." - (let ((face (doom-modeline-face - (if (and buffer-file-name (buffer-modified-p)) - 'doom-modeline-buffer-modified - 'doom-modeline-buffer-path)))) - (concat - (doom-modeline-spc) - (and doom-modeline-major-mode-icon - (concat - (doom-modeline-icon - 'octicon "nf-oct-file_directory_fill" "🖿" "" :face face) - (doom-modeline-vspc))) - (doom-modeline--buffer-state-icon) - (propertize (abbreviate-file-name default-directory) 'face face)))) - -(doom-modeline-def-segment buffer-default-directory-simple - "Displays `default-directory'. - -This is for special buffers like the scratch buffer where knowing the current -project directory is important." - (let ((face (doom-modeline-face 'doom-modeline-buffer-path))) - (concat - (doom-modeline-spc) - (and doom-modeline-major-mode-icon - (concat - (doom-modeline-icon - 'octicon "nf-oct-file_directory_fill" "🖿" "" :face face) - (doom-modeline-vspc))) - (propertize (abbreviate-file-name default-directory) 'face face)))) - - -;; -;; Encoding -;; - -(doom-modeline-def-segment buffer-encoding - "Displays the eol and the encoding style of the buffer." - (when doom-modeline-buffer-encoding - (let ((sep (doom-modeline-spc)) - (face (doom-modeline-face)) - (mouse-face 'doom-modeline-highlight)) - (concat - sep - - ;; eol type - (let ((eol (coding-system-eol-type buffer-file-coding-system))) - (when (or (eq doom-modeline-buffer-encoding t) - (and (eq doom-modeline-buffer-encoding 'nondefault) - (not (equal eol doom-modeline-default-eol-type)))) - (propertize - (pcase eol - (0 "LF ") - (1 "CRLF ") - (2 "CR ") - (_ "")) - 'face face - 'mouse-face mouse-face - 'help-echo (format "End-of-line style: %s\nmouse-1: Cycle" - (pcase eol - (0 "Unix-style LF") - (1 "DOS-style CRLF") - (2 "Mac-style CR") - (_ "Undecided"))) - 'local-map (let ((map (make-sparse-keymap))) - (define-key map [mode-line mouse-1] 'mode-line-change-eol) - map)))) - - ;; coding system - (let* ((sys (coding-system-plist buffer-file-coding-system)) - (cat (plist-get sys :category)) - (sym (if (memq cat - '(coding-category-undecided coding-category-utf-8)) - 'utf-8 - (plist-get sys :name)))) - (when (or (eq doom-modeline-buffer-encoding t) - (and (eq doom-modeline-buffer-encoding 'nondefault) - (not (eq cat 'coding-category-undecided)) - (not (eq sym doom-modeline-default-coding-system)))) - (propertize - (upcase (symbol-name sym)) - 'face face - 'mouse-face mouse-face - 'help-echo 'mode-line-mule-info-help-echo - 'local-map mode-line-coding-system-map))) - - sep)))) - - -;; -;; Indentation -;; - -(doom-modeline-def-segment indent-info - "Displays the indentation information." - (when doom-modeline-indent-info - (let ((do-propertize - (lambda (mode size) - (propertize - (format " %s %d " mode size) - 'face (doom-modeline-face))))) - (if indent-tabs-mode - (funcall do-propertize "TAB" tab-width) - (let ((lookup-var - (seq-find (lambda (var) - (and var (boundp var) (symbol-value var))) - (cdr (assoc major-mode doom-modeline-indent-alist)) nil))) - (funcall do-propertize "SPC" - (if lookup-var - (symbol-value lookup-var) - tab-width))))))) - -;; -;; Remote host -;; - -(doom-modeline-def-segment remote-host - "Hostname for remote buffers." - (when default-directory - (when-let ((host (file-remote-p default-directory 'host))) - (propertize - (concat "@" host) - 'face (doom-modeline-face 'doom-modeline-host))))) - - -;; -;; Major mode -;; - -(doom-modeline-def-segment major-mode - "The major mode, including environment and text-scale info." - (let ((sep (doom-modeline-spc)) - (face (doom-modeline-face 'doom-modeline-buffer-major-mode))) - (concat - sep - (propertize (concat - (format-mode-line - (or (and (boundp 'delighted-modes) - (cadr (assq major-mode delighted-modes))) - mode-name)) - (when (and doom-modeline-env-version doom-modeline-env--version) - (format " %s" doom-modeline-env--version))) - 'help-echo "Major mode\n\ -mouse-1: Display major mode menu\n\ -mouse-2: Show help for major mode\n\ -mouse-3: Toggle minor modes" - 'face face - 'mouse-face 'doom-modeline-highlight - 'local-map mode-line-major-mode-keymap) - (and (boundp 'text-scale-mode-amount) - (/= text-scale-mode-amount 0) - (propertize - (format - (if (> text-scale-mode-amount 0) " (%+d)" " (%-d)") - text-scale-mode-amount) - 'face face)) - sep))) - - -;; -;; Process -;; - -(doom-modeline-def-segment process - "The process info." - (doom-modeline-display-text - (format-mode-line mode-line-process))) - - -;; -;; Minor modes -;; - -(doom-modeline-def-segment minor-modes - (when doom-modeline-minor-modes - (let ((sep (doom-modeline-spc)) - (face (doom-modeline-face 'doom-modeline-buffer-minor-mode)) - (mouse-face 'doom-modeline-highlight) - (help-echo "Minor mode - mouse-1: Display minor mode menu - mouse-2: Show help for minor mode - mouse-3: Toggle minor modes")) - (if (bound-and-true-p minions-mode) - `((:propertize ("" ,(minions--prominent-modes)) - face ,face - mouse-face ,mouse-face - help-echo ,help-echo - local-map ,mode-line-minor-mode-keymap) - ,sep - (:propertize ("" ,(doom-modeline-icon 'octicon "nf-oct-gear" "⚙" - minions-mode-line-lighter - :face face)) - mouse-face ,mouse-face - help-echo "Minions -mouse-1: Display minor modes menu" - local-map ,minions-mode-line-minor-modes-map) - ,sep) - `((:propertize ("" minor-mode-alist) - face ,face - mouse-face ,mouse-face - help-echo ,help-echo - local-map ,mode-line-minor-mode-keymap) - ,sep))))) - - -;; -;; VCS -;; - -(defun doom-modeline-vcs-icon (icon &optional unicode text face) - "Displays the vcs ICON with FACE and VOFFSET. - -UNICODE and TEXT are fallbacks. -Uses `nerd-icons-octicon' to fetch the icon." - (doom-modeline-icon 'devicon (and doom-modeline-vcs-icon icon) - unicode text :face face)) - -(defvar-local doom-modeline--vcs nil) -(defun doom-modeline-update-vcs (&rest _) - "Update vcs state in mode-line." - (setq doom-modeline--vcs - (when (and vc-mode buffer-file-name) - (let* ((backend (vc-backend buffer-file-name)) - (state (vc-state buffer-file-name backend)) - (icon (cond ((memq state '(edited added)) - (doom-modeline-vcs-icon "nf-dev-git_compare" "🔃" "*" 'doom-modeline-info)) - ((eq state 'needs-merge) - (doom-modeline-vcs-icon "nf-dev-git_merge" "🔀" "?" 'doom-modeline-info)) - ((eq state 'needs-update) - (doom-modeline-vcs-icon "nf-dev-git_pull_request" "⬇" "!" 'doom-modeline-warning)) - ((memq state '(removed conflict unregistered)) - (doom-modeline-icon 'octicon "nf-oct-alert" "⚠" "!" :face 'doom-modeline-urgent)) - (t (doom-modeline-vcs-icon "nf-dev-git_branch" "" "@" 'doom-modeline-info)))) - (str (if vc-display-status - (substring vc-mode (+ (if (eq backend 'Hg) 2 3) 2)) - "")) - (face (cond ((eq state 'needs-update) - '(doom-modeline-warning bold)) - ((memq state '(removed conflict unregistered)) - '(doom-modeline-urgent bold)) - (t '(doom-modeline-info bold)))) - (text (propertize (if (length> str doom-modeline-vcs-max-length) - (concat - (substring str 0 (- doom-modeline-vcs-max-length 3)) - doom-modeline-ellipsis) - str) - 'face face))) - `((icon . ,icon) (text . ,text)))))) -(add-hook 'find-file-hook #'doom-modeline-update-vcs) -(add-hook 'after-save-hook #'doom-modeline-update-vcs) -(advice-add #'vc-refresh-state :after #'doom-modeline-update-vcs) - -(doom-modeline-add-variable-watcher - 'doom-modeline-icon - (lambda (_sym val op _where) - (when (eq op 'set) - (setq doom-modeline-icon val) - (dolist (buf (buffer-list)) - (with-current-buffer buf - (doom-modeline-update-vcs)))))) - -(doom-modeline-add-variable-watcher - 'doom-modeline-unicode-fallback - (lambda (_sym val op _where) - (when (eq op 'set) - (setq doom-modeline-unicode-fallback val) - (dolist (buf (buffer-list)) - (with-current-buffer buf - (doom-modeline-update-vcs)))))) - -(doom-modeline-add-variable-watcher - 'doom-modeline-vcs-icon - (lambda (_sym val op _where) - (when (eq op 'set) - (setq doom-modeline-vcs-icon val) - (dolist (buf (buffer-list)) - (with-current-buffer buf - (doom-modeline-update-vcs)))))) - -(doom-modeline-def-segment vcs - "Displays the current branch, colored based on its state." - (when doom-modeline--vcs - (let-alist doom-modeline--vcs - (let ((sep (doom-modeline-spc)) - (vsep (doom-modeline-vspc))) - (concat sep - (propertize (concat - (doom-modeline-display-icon .icon) - vsep - (doom-modeline-display-text .text)) - 'help-echo (get-text-property 1 'help-echo vc-mode) - 'mouse-face 'doom-modeline-highlight - 'local-map (get-text-property 1 'local-map vc-mode)) - sep))))) - - -;; -;; Check -;; - -(defun doom-modeline-check-icon (icon unicode text face) - "Displays the check ICON with FACE. - -UNICODE and TEXT are fallbacks. -Uses `nerd-icons-mdicon' to fetch the icon." - (doom-modeline-icon 'mdicon (and doom-modeline-check-icon icon) - unicode text :face face)) - -(defun doom-modeline-check-text (text &optional face) - "Displays the check TEXT with FACE." - (propertize text 'face (or face 'mode-line))) - -;; Flycheck - -(defun doom-modeline--flycheck-count-errors () - "Count the number of ERRORS, grouped by level. - -Return an alist, where each ITEM is a cons cell whose `car' is an -error level, and whose `cdr' is the number of errors of that -level." - (let ((info 0) (warning 0) (error 0)) - (mapc - (lambda (item) - (let ((count (cdr item))) - (pcase (flycheck-error-level-compilation-level (car item)) - (0 (cl-incf info count)) - (1 (cl-incf warning count)) - (2 (cl-incf error count))))) - (flycheck-count-errors flycheck-current-errors)) - `((info . ,info) (warning . ,warning) (error . ,error)))) - -(defvar-local doom-modeline--flycheck nil) -(defun doom-modeline-update-flycheck (&optional status) - "Update flycheck via STATUS." - (setq doom-modeline--flycheck - (let-alist (doom-modeline--flycheck-count-errors) - (let* ((vsep (doom-modeline-vspc)) - (seg (if doom-modeline-check-simple-format - (let ((count (+ .error .warning .info))) - (pcase status - ('finished (if (> count 0) - (let ((face (if (> .error 0) 'doom-modeline-urgent 'doom-modeline-warning))) - (concat - (doom-modeline-check-icon "nf-md-alert_circle_outline" "⚠" "!" face) - vsep - (doom-modeline-check-text (number-to-string count) face))) - (doom-modeline-check-icon "nf-md-check_circle_outline" "✔" "" 'doom-modeline-info))) - ('running (concat - (doom-modeline-check-icon "nf-md-timer_sand" "⏳" "*" 'doom-modeline-debug) - (when (> count 0) - (concat - vsep - (doom-modeline-check-text (number-to-string count) 'doom-modeline-debug))))) - ('no-checker (doom-modeline-check-icon "nf-md-alert_box_outline" "⚠" "-" 'doom-modeline-debug)) - ('errored (doom-modeline-check-icon "nf-md-alert_box_outline" "⚠" "!" 'doom-modeline-urgent)) - ('interrupted (doom-modeline-check-icon "nf-md-pause_circle_outline" "⦷" "." 'doom-modeline-debug)) - ('suspicious (doom-modeline-check-icon "nf-md-file_question_outline" "❓" "?" 'doom-modeline-debug)) - (_ ""))) - (concat (doom-modeline-check-icon "nf-md-close_circle_outline" "⮾" "!" 'doom-modeline-urgent) - vsep - (doom-modeline-check-text (number-to-string .error) 'doom-modeline-urgent) - vsep - (doom-modeline-check-icon "nf-md-alert_outline" "⚠" "!" 'doom-modeline-warning) - vsep - (doom-modeline-check-text (number-to-string .warning) 'doom-modeline-warning) - vsep - (doom-modeline-check-icon "nf-md-information_outline" "🛈" "!" 'doom-modeline-info) - vsep - (doom-modeline-check-text (number-to-string .info) 'doom-modeline-info))))) - (propertize seg - 'help-echo (concat "Flycheck\n" - (pcase status - ('finished (format "error: %d, warning: %d, info: %d" .error .warning .info)) - ('running "Checking...") - ('no-checker "No Checker") - ('errored "Error") - ('interrupted "Interrupted") - ('suspicious "Suspicious")) - "\nmouse-1: Display minor mode menu\nmouse-2: Show help for minor mode") - 'mouse-face 'doom-modeline-highlight - 'local-map (let ((map (make-sparse-keymap))) - (define-key map [mode-line down-mouse-1] - flycheck-mode-menu-map) - (define-key map [mode-line mouse-2] - (lambda () - (interactive) - (describe-function 'flycheck-mode))) - map)))))) -(add-hook 'flycheck-status-changed-functions #'doom-modeline-update-flycheck) -(add-hook 'flycheck-mode-hook #'doom-modeline-update-flycheck) - -(doom-modeline-add-variable-watcher - 'doom-modeline-icon - (lambda (_sym val op _where) - (when (eq op 'set) - (setq doom-modeline-icon val) - (dolist (buf (buffer-list)) - (with-current-buffer buf - (when (bound-and-true-p flycheck-mode) - (doom-modeline-update-flycheck))))))) - -(doom-modeline-add-variable-watcher - 'doom-modeline-check-icon - (lambda (_sym val op _where) - (when (eq op 'set) - (setq doom-modeline-check-icon val) - (dolist (buf (buffer-list)) - (with-current-buffer buf - (when (bound-and-true-p flycheck-mode) - (doom-modeline-update-flycheck))))))) - -(doom-modeline-add-variable-watcher - 'doom-modeline-unicode-fallback - (lambda (_sym val op _where) - (when (eq op 'set) - (setq doom-modeline-unicode-fallback val) - (dolist (buf (buffer-list)) - (with-current-buffer buf - (when (bound-and-true-p flycheck-mode) - (doom-modeline-update-flycheck))))))) - -(doom-modeline-add-variable-watcher - 'doom-modeline-check-simple-format - (lambda (_sym val op _where) - (when (eq op 'set) - (setq doom-modeline-check-simple-format val) - (dolist (buf (buffer-list)) - (with-current-buffer buf - (when (bound-and-true-p flycheck-mode) - (doom-modeline-update-flycheck))))))) - -;; Flymake - -;; Compatibility -;; @see https://github.com/emacs-mirror/emacs/commit/6e100869012da9244679696634cab6b9cac96303. -(with-eval-after-load 'flymake - (unless (boundp 'flymake--state) - (defvaralias 'flymake--state 'flymake--backend-state)) - (unless (fboundp 'flymake--state-diags) - (defalias 'flymake--state-diags 'flymake--backend-state-diags))) - -(defun doom-modeline--flymake-count-errors () - "Count the number of ERRORS, grouped by level." - (let ((warning-level (warning-numeric-level :warning)) - (note-level (warning-numeric-level :debug)) - (note 0) (warning 0) (error 0)) - (maphash (lambda (_b state) - (cl-loop - with diags = (flymake--state-diags state) - for diag in diags do - (let ((severity (flymake--lookup-type-property (flymake--diag-type diag) 'severity - (warning-numeric-level :error)))) - (cond ((> severity warning-level) (cl-incf error)) - ((> severity note-level) (cl-incf warning)) - (t (cl-incf note)))))) - flymake--state) - `((note . ,note) (warning . ,warning) (error . ,error)))) - -(defvar-local doom-modeline--flymake nil) -(defun doom-modeline-update-flymake (&rest _) - "Update flymake." - (setq doom-modeline--flymake - (let* ((known (hash-table-keys flymake--state)) - (running (flymake-running-backends)) - (disabled (flymake-disabled-backends)) - (reported (flymake-reporting-backends)) - (all-disabled (and disabled (null running))) - (some-waiting (cl-set-difference running reported))) - (let-alist (doom-modeline--flymake-count-errors) - (let* ((vsep (doom-modeline-vspc)) - (seg (if doom-modeline-check-simple-format - (let ((count (+ .error .warning .note))) - (cond - (some-waiting (concat - (doom-modeline-check-icon "nf-md-timer_sand" "⏳" "*" 'doom-modeline-debug) - (when (> count 0) - (concat - vsep - (doom-modeline-check-text (number-to-string count) 'doom-modeline-debug))))) - ((null known) (doom-modeline-check-icon "nf-md-alert_box_outline" "⚠" "!" 'doom-modeline-urgent)) - (all-disabled (doom-modeline-check-icon "nf-md-alert_box_outline" "⚠" "!" 'doom-modeline-warning)) - (t (if (> count 0) - (let ((face (if (> .error 0) 'doom-modeline-urgent 'doom-modeline-warning))) - (concat - (doom-modeline-check-icon "nf-md-alert_circle_outline" "⚠" "!" face) - vsep - (doom-modeline-check-text (number-to-string count) face))) - (doom-modeline-check-icon "nf-md-check_circle_outline" "✔" "" 'doom-modeline-info))))) - (concat (doom-modeline-check-icon "nf-md-close_circle_outline" "⮾" "!" 'doom-modeline-urgent) - vsep - (doom-modeline-check-text (number-to-string .error) 'doom-modeline-urgent) - vsep - (doom-modeline-check-icon "nf-md-alert_outline" "⚠" "!" 'doom-modeline-warning) - vsep - (doom-modeline-check-text (number-to-string .warning) 'doom-modeline-warning) - vsep - (doom-modeline-check-icon "nf-md-information_outline" "🛈" "!" 'doom-modeline-info) - vsep - (doom-modeline-check-text (number-to-string .note) 'doom-modeline-info))))) - (propertize - seg - 'help-echo (concat "Flymake\n" - (cond - (some-waiting "Checking...") - ((null known) "No Checker") - (all-disabled "All Checkers Disabled") - (t (format "%d/%d backends running\nerror: %d, warning: %d, note: %d" - (length running) (length known) .error .warning .note))) - "\nmouse-1: Display minor mode menu\nmouse-2: Show help for minor mode") - 'mouse-face 'doom-modeline-highlight - 'local-map (let ((map (make-sparse-keymap))) - (define-key map [mode-line down-mouse-1] - flymake-menu) - (define-key map [mode-line mouse-2] - (lambda () - (interactive) - (describe-function 'flymake-mode))) - map))))))) -(advice-add #'flymake--handle-report :after #'doom-modeline-update-flymake) - -(doom-modeline-add-variable-watcher - 'doom-modeline-icon - (lambda (_sym val op _where) - (when (eq op 'set) - (setq doom-modeline-icon val) - (dolist (buf (buffer-list)) - (with-current-buffer buf - (when (bound-and-true-p flymake-mode) - (doom-modeline-update-flymake))))))) - -(doom-modeline-add-variable-watcher - 'doom-modeline-check-icon - (lambda (_sym val op _where) - (when (eq op 'set) - (setq doom-modeline-check-icon val) - (dolist (buf (buffer-list)) - (with-current-buffer buf - (when (bound-and-true-p flymake-mode) - (doom-modeline-update-flymake))))))) - -(doom-modeline-add-variable-watcher - 'doom-modeline-unicode-fallback - (lambda (_sym val op _where) - (when (eq op 'set) - (setq doom-modeline-unicode-fallback val) - (dolist (buf (buffer-list)) - (with-current-buffer buf - (when (bound-and-true-p flymake-mode) - (doom-modeline-update-flymake))))))) - -(doom-modeline-add-variable-watcher - 'doom-modeline-check-simple-format - (lambda (_sym val op _where) - (when (eq op 'set) - (setq doom-modeline-check-simple-format val) - (dolist (buf (buffer-list)) - (with-current-buffer buf - (when (bound-and-true-p flymake-mode) - (doom-modeline-update-flymake))))))) - -(doom-modeline-def-segment check - "Displays color-coded error status in the current buffer with pretty icons." - (when-let ((sep (doom-modeline-spc)) - (vsep (doom-modeline-vspc)) - (seg (cond - ((and (bound-and-true-p flymake-mode) - (bound-and-true-p flymake--state)) ; only support 26+ - doom-modeline--flymake) - ((and (bound-and-true-p flycheck-mode) - (bound-and-true-p flycheck--automatically-enabled-checkers)) - doom-modeline--flycheck)))) - (concat - sep - (let ((str)) - (dolist (s (split-string seg " ")) - (setq str - (concat str - (if (string-match-p "^[0-9]+$" s) - (concat vsep - (doom-modeline-display-text s) - vsep) - (doom-modeline-display-icon s))))) - (propertize str - 'help-echo (get-text-property 1 'help-echo seg) - 'mouse-face 'doom-modeline-highlight - 'local-map (get-text-property 1 'local-map seg))) - sep))) - - -;; -;; Word Count -;; - -(doom-modeline-def-segment word-count - "The buffer word count. -Displayed when in a major mode in `doom-modeline-continuous-word-count-modes'. -Respects `doom-modeline-enable-word-count'." - (when (and doom-modeline-enable-word-count - (member major-mode doom-modeline-continuous-word-count-modes)) - (propertize (format " %dW" (count-words (point-min) (point-max))) - 'face (doom-modeline-face)))) - - -;; -;; Selection -;; - -(defsubst doom-modeline-column (pos) - "Get the column of the position `POS'." - (save-excursion (goto-char pos) - (current-column))) - -(doom-modeline-def-segment selection-info - "Information about the current selection. - -Such as how many characters and lines are selected, or the NxM dimensions of a -block selection." - (when (and (or mark-active (and (bound-and-true-p evil-local-mode) - (eq evil-state 'visual))) - (doom-modeline--active)) - (cl-destructuring-bind (beg . end) - (if (and (bound-and-true-p evil-local-mode) (eq evil-state 'visual)) - (cons evil-visual-beginning evil-visual-end) - (cons (region-beginning) (region-end))) - (propertize - (let ((lines (count-lines beg (min end (point-max))))) - (concat - " " - (cond ((or (bound-and-true-p rectangle-mark-mode) - (and (bound-and-true-p evil-visual-selection) - (eq 'block evil-visual-selection))) - (let ((cols (abs (- (doom-modeline-column end) - (doom-modeline-column beg))))) - (format "%dx%dB" lines cols))) - ((and (bound-and-true-p evil-visual-selection) - (eq evil-visual-selection 'line)) - (format "%dL" lines)) - ((> lines 1) - (format "%dC %dL" (- end beg) lines)) - (t - (format "%dC" (- end beg)))) - (when doom-modeline-enable-word-count - (format " %dW" (count-words beg end))) - " ")) - 'face 'doom-modeline-emphasis)))) - - -;; -;; Matches (macro, anzu, evil-substitute, iedit, symbol-overlay and multi-cursors) -;; - -(defsubst doom-modeline--macro-recording () - "Display current Emacs or evil macro being recorded." - (when (and (doom-modeline--active) - (or defining-kbd-macro executing-kbd-macro)) - (let ((sep (propertize " " 'face 'doom-modeline-panel)) - (vsep (propertize " " 'face - '(:inherit (doom-modeline-panel variable-pitch)))) - (macro-name (if (bound-and-true-p evil-this-macro) - (format " @%s " - (char-to-string evil-this-macro)) - "Macro"))) - (concat - sep - (if doom-modeline-always-show-macro-register - (propertize macro-name 'face 'doom-modeline-panel) - (concat - (doom-modeline-icon 'mdicon "nf-md-record" "●" - macro-name - :face '(:inherit (doom-modeline-urgent doom-modeline-panel)) - :v-adjust 0.15) - vsep - (doom-modeline-icon 'mdicon "nf-md-menu_right" "▶" ">" - :face 'doom-modeline-panel - :v-adjust 0.15))) - sep)))) - -;; `anzu' and `evil-anzu' expose current/total state that can be displayed in the -;; mode-line. -(defun doom-modeline-fix-anzu-count (positions here) - "Calulate anzu count via POSITIONS and HERE." - (cl-loop for (start . end) in positions - collect t into before - when (and (>= here start) (<= here end)) - return (length before) - finally return 0)) - -(advice-add #'anzu--where-is-here :override #'doom-modeline-fix-anzu-count) - -(setq anzu-cons-mode-line-p nil) ; manage modeline segment ourselves -;; Ensure anzu state is cleared when searches & iedit are done -(with-eval-after-load 'anzu - (add-hook 'isearch-mode-end-hook #'anzu--reset-status t) - (add-hook 'iedit-mode-end-hook #'anzu--reset-status) - (advice-add #'evil-force-normal-state :after #'anzu--reset-status) - ;; Fix matches segment mirroring across all buffers - (mapc #'make-variable-buffer-local - '(anzu--total-matched - anzu--current-position anzu--state anzu--cached-count - anzu--cached-positions anzu--last-command - anzu--last-isearch-string anzu--overflow-p))) - -(defsubst doom-modeline--anzu () - "Show the match index and total number thereof. -Requires `anzu', also `evil-anzu' if using `evil-mode' for compatibility with -`evil-search'." - (when (and (bound-and-true-p anzu--state) - (not (bound-and-true-p iedit-mode))) - (propertize - (let ((here anzu--current-position) - (total anzu--total-matched)) - (cond ((eq anzu--state 'replace-query) - (format " %d replace " anzu--cached-count)) - ((eq anzu--state 'replace) - (format " %d/%d " here total)) - (anzu--overflow-p - (format " %s+ " total)) - (t - (format " %s/%d " here total)))) - 'face (doom-modeline-face 'doom-modeline-panel)))) - -(defsubst doom-modeline--evil-substitute () - "Show number of matches for `evil-ex' in real time. -The number of matches contains substitutions and highlightings." - (when (and (bound-and-true-p evil-local-mode) - (or (assq 'evil-ex-substitute evil-ex-active-highlights-alist) - (assq 'evil-ex-global-match evil-ex-active-highlights-alist) - (assq 'evil-ex-buffer-match evil-ex-active-highlights-alist))) - (propertize - (let ((range (if evil-ex-range - (cons (car evil-ex-range) (cadr evil-ex-range)) - (cons (line-beginning-position) (line-end-position)))) - (pattern (car-safe (evil-delimited-arguments evil-ex-argument 2)))) - (if pattern - (format " %s matches " (how-many pattern (car range) (cdr range))) - " - ")) - 'face (doom-modeline-face 'doom-modeline-panel)))) - -(defun doom-modeline-themes--overlay-sort (a b) - "Sort overlay A and B." - (< (overlay-start a) (overlay-start b))) - -(defsubst doom-modeline--iedit () - "Show the number of iedit regions matches + what match you're on." - (when (and (bound-and-true-p iedit-mode) - (bound-and-true-p iedit-occurrences-overlays)) - (propertize - (let ((this-oc (or (let ((inhibit-message t)) - (iedit-find-current-occurrence-overlay)) - (save-excursion (iedit-prev-occurrence) - (iedit-find-current-occurrence-overlay)))) - (length (length iedit-occurrences-overlays))) - (format " %s/%d " - (if this-oc - (- length - (length (memq this-oc (sort (append iedit-occurrences-overlays nil) - #'doom-modeline-themes--overlay-sort))) - -1) - "-") - length)) - 'face (doom-modeline-face 'doom-modeline-panel)))) - -(defsubst doom-modeline--symbol-overlay () - "Show the number of matches for symbol overlay." - (when (and (doom-modeline--active) - (bound-and-true-p symbol-overlay-keywords-alist) - (not (bound-and-true-p symbol-overlay-temp-symbol)) - (not (bound-and-true-p iedit-mode))) - (let* ((keyword (symbol-overlay-assoc (symbol-overlay-get-symbol t))) - (symbol (car keyword)) - (before (symbol-overlay-get-list -1 symbol)) - (after (symbol-overlay-get-list 1 symbol)) - (count (length before))) - (if (symbol-overlay-assoc symbol) - (propertize - (format (concat " %d/%d " (and (cadr keyword) "in scope ")) - (+ count 1) - (+ count (length after))) - 'face (doom-modeline-face 'doom-modeline-panel)))))) - -(defsubst doom-modeline--multiple-cursors () - "Show the number of multiple cursors." - (cl-destructuring-bind (count . face) - (cond ((bound-and-true-p multiple-cursors-mode) - (cons (mc/num-cursors) - (doom-modeline-face 'doom-modeline-panel))) - ((bound-and-true-p evil-mc-cursor-list) - (cons (length evil-mc-cursor-list) - (doom-modeline-face (if evil-mc-frozen - 'doom-modeline-bar - 'doom-modeline-panel)))) - ((cons nil nil))) - (when count - (concat (propertize " " 'face face) - (if (doom-modeline-icon-displayable-p) - (doom-modeline-icon 'faicon "nf-fa-i_cursor" "" "" :face face) - (propertize "I" - 'face `(:inherit ,face :height 1.4 :weight normal) - 'display '(raise -0.1))) - (propertize " " - 'face `(:inherit (variable-pitch ,face))) - (propertize (format "%d " count) - 'face face))))) - -(defsubst doom-modeline--phi-search () - "Show the number of matches for `phi-search' and `phi-replace'." - (when (and (doom-modeline--active) - (bound-and-true-p phi-search--overlays)) - (let ((total (length phi-search--overlays)) - (selection phi-search--selection)) - (when selection - (propertize - (format " %d/%d " (1+ selection) total) - 'face (doom-modeline-face 'doom-modeline-panel)))))) - -(defun doom-modeline--override-phi-search (orig-fun &rest args) - "Override the mode-line of `phi-search' and `phi-replace'. -Apply ORIG-FUN with ARGS." - (if (bound-and-true-p doom-modeline-mode) - (apply orig-fun mode-line-format (cdr args)) - (apply orig-fun args))) -(advice-add #'phi-search--initialize :around #'doom-modeline--override-phi-search) - -(defsubst doom-modeline--buffer-size () - "Show buffer size." - (when size-indication-mode - (let ((sep (doom-modeline-spc))) - (concat sep - (propertize "%I" - 'face (doom-modeline-face) - 'help-echo "Buffer size -mouse-1: Display Line and Column Mode Menu" - 'mouse-face 'doom-modeline-highlight - 'local-map mode-line-column-line-number-mode-map) - sep)))) - -(doom-modeline-def-segment matches - "Displays matches. - -Including: -1. the currently recording macro, 2. A current/total for the -current search term (with `anzu'), 3. The number of substitutions being -conducted with `evil-ex-substitute', and/or 4. The number of active `iedit' -regions, 5. The current/total for the highlight term (with `symbol-overlay'), -6. The number of active `multiple-cursors'." - (let ((meta (concat (doom-modeline--macro-recording) - (doom-modeline--anzu) - (doom-modeline--phi-search) - (doom-modeline--evil-substitute) - (doom-modeline--iedit) - (doom-modeline--symbol-overlay) - (doom-modeline--multiple-cursors)))) - (or (and (not (string-empty-p meta)) meta) - (doom-modeline--buffer-size)))) - -(doom-modeline-def-segment buffer-size - "Display buffer size." - (doom-modeline--buffer-size)) - -;; -;; Media -;; - -(doom-modeline-def-segment media-info - "Metadata regarding the current file, such as dimensions for images." - ;; TODO: Include other information - (cond ((eq major-mode 'image-mode) - (cl-destructuring-bind (width . height) - (when (fboundp 'image-size) - (image-size (image-get-display-property) :pixels)) - (format " %dx%d " width height))))) - - -;; -;; Bars -;; - -(defvar doom-modeline--bar-active nil) -(defvar doom-modeline--bar-inactive nil) - -(defsubst doom-modeline--bar () - "The default bar regulates the height of the mode-line in GUI." - (unless (and doom-modeline--bar-active doom-modeline--bar-inactive) - (let ((width doom-modeline-bar-width) - (height (max doom-modeline-height (doom-modeline--font-height)))) - (setq doom-modeline--bar-active - (doom-modeline--create-bar-image 'doom-modeline-bar width height) - doom-modeline--bar-inactive - (doom-modeline--create-bar-image - 'doom-modeline-bar-inactive width height)))) - (if (doom-modeline--active) - doom-modeline--bar-active - doom-modeline--bar-inactive)) - -(defun doom-modeline-refresh-bars () - "Refresh mode-line bars on next redraw." - (setq doom-modeline--bar-active nil - doom-modeline--bar-inactive nil)) - -(cl-defstruct doom-modeline--hud-cache active inactive top-margin bottom-margin) - -(defsubst doom-modeline--hud () - "Powerline's hud segment reimplemented in the style of Doom's bar segment." - (let* ((ws (window-start)) - (we (window-end)) - (bs (buffer-size)) - (height (max doom-modeline-height (doom-modeline--font-height))) - (top-margin (if (zerop bs) - 0 - (/ (* height (1- ws)) bs))) - (bottom-margin (if (zerop bs) - 0 - (max 0 (/ (* height (- bs we 1)) bs)))) - (cache (or (window-parameter nil 'doom-modeline--hud-cache) - (set-window-parameter - nil - 'doom-modeline--hud-cache - (make-doom-modeline--hud-cache))))) - (unless (and (doom-modeline--hud-cache-active cache) - (doom-modeline--hud-cache-inactive cache) - (= top-margin (doom-modeline--hud-cache-top-margin cache)) - (= bottom-margin - (doom-modeline--hud-cache-bottom-margin cache))) - (setf (doom-modeline--hud-cache-active cache) - (doom-modeline--create-hud-image - 'doom-modeline-bar 'default doom-modeline-bar-width - height top-margin bottom-margin) - (doom-modeline--hud-cache-inactive cache) - (doom-modeline--create-hud-image - 'doom-modeline-bar-inactive 'default doom-modeline-bar-width - height top-margin bottom-margin) - (doom-modeline--hud-cache-top-margin cache) top-margin - (doom-modeline--hud-cache-bottom-margin cache) bottom-margin)) - (if (doom-modeline--active) - (doom-modeline--hud-cache-active cache) - (doom-modeline--hud-cache-inactive cache)))) - -(defun doom-modeline-invalidate-huds () - "Invalidate all cached hud images." - (dolist (frame (frame-list)) - (dolist (window (window-list frame)) - (set-window-parameter window 'doom-modeline--hud-cache nil)))) - -(doom-modeline-add-variable-watcher - 'doom-modeline-height - (lambda (_sym val op _where) - (when (and (eq op 'set) (integerp val)) - (doom-modeline-refresh-bars) - (doom-modeline-invalidate-huds)))) - -(doom-modeline-add-variable-watcher - 'doom-modeline-bar-width - (lambda (_sym val op _where) - (when (and (eq op 'set) (integerp val)) - (doom-modeline-refresh-bars) - (doom-modeline-invalidate-huds)))) - -(doom-modeline-add-variable-watcher - 'doom-modeline-icon - (lambda (_sym _val op _where) - (when (eq op 'set) - (doom-modeline-refresh-bars) - (doom-modeline-invalidate-huds)))) - -(doom-modeline-add-variable-watcher - 'doom-modeline-unicode-fallback - (lambda (_sym _val op _where) - (when (eq op 'set) - (doom-modeline-refresh-bars) - (doom-modeline-invalidate-huds)))) - -(add-hook 'window-configuration-change-hook #'doom-modeline-refresh-bars) -(add-hook 'window-configuration-change-hook #'doom-modeline-invalidate-huds) - -(doom-modeline-def-segment bar - "The bar regulates the height of the `doom-modeline' in GUI." - (when (display-graphic-p) - (concat - (if doom-modeline-hud - (doom-modeline--hud) - (doom-modeline--bar)) - (doom-modeline-spc)))) - -(doom-modeline-def-segment hud - "Powerline's hud segment reimplemented in the style of bar segment." - (when (display-graphic-p) - (concat - (doom-modeline--hud) - (doom-modeline-spc)))) - - -;; -;; Window number -;; - -;; HACK: `ace-window-display-mode' should respect the ignore buffers. -(defun doom-modeline-aw-update () - "Update ace-window-path window parameter for all windows. -Ensure all windows are labeled so the user can select a specific -one. The ignored buffers are excluded unless `aw-ignore-on' is nil." - (let ((ignore-window-parameters t)) - (avy-traverse - (avy-tree (aw-window-list) aw-keys) - (lambda (path leaf) - (set-window-parameter - leaf 'ace-window-path - (propertize - (apply #'string (reverse path)) - 'face 'aw-mode-line-face)))))) -(advice-add #'aw-update :override #'doom-modeline-aw-update) - -;; Remove original window number of `ace-window-display-mode'. -(add-hook 'ace-window-display-mode-hook - (lambda () - (setq-default mode-line-format - (assq-delete-all 'ace-window-display-mode - (default-value 'mode-line-format))))) - -(advice-add #'window-numbering-install-mode-line :override #'ignore) -(advice-add #'window-numbering-clear-mode-line :override #'ignore) -(advice-add #'winum--install-mode-line :override #'ignore) -(advice-add #'winum--clear-mode-line :override #'ignore) - -(doom-modeline-def-segment window-number - "The current window number." - (let ((num (cond - ((bound-and-true-p ace-window-display-mode) - (aw-update) - (window-parameter (selected-window) 'ace-window-path)) - ((bound-and-true-p winum-mode) - (setq winum-auto-setup-mode-line nil) - (winum-get-number-string)) - ((bound-and-true-p window-numbering-mode) - (window-numbering-get-number-string)) - (t "")))) - (when (and (length> num 0) - (length> (cl-mapcan - (lambda (frame) - ;; Exclude minibuffer, tooltip and child frames - (unless (or (and (fboundp 'frame-parent) (frame-parent frame)) - (string= (frame-parameter frame 'name) - (alist-get 'name (bound-and-true-p tooltip-frame-parameters)))) - (window-list frame 'never))) - (visible-frame-list)) - 1)) - (propertize (format " %s " num) - 'face (doom-modeline-face 'doom-modeline-buffer-major-mode))))) - - -;; -;; Workspace -;; - -(doom-modeline-def-segment workspace-name - "The current workspace name or number. -Requires `eyebrowse-mode' to be enabled or `tab-bar-mode' tabs to be created." - (when doom-modeline-workspace-name - (when-let - ((name (cond - ((and (bound-and-true-p eyebrowse-mode) - (length> (eyebrowse--get 'window-configs) 1)) - (setq mode-line-misc-info - (assq-delete-all 'eyebrowse-mode mode-line-misc-info)) - (when-let* - ((num (eyebrowse--get 'current-slot)) - (tag (nth 2 (assoc num (eyebrowse--get 'window-configs))))) - (if (length> tag 0) tag (int-to-string num)))) - ((and (fboundp 'tab-bar-mode) - (length> (frame-parameter nil 'tabs) 1)) - (let* ((current-tab (tab-bar--current-tab)) - (tab-index (tab-bar--current-tab-index)) - (explicit-name (alist-get 'explicit-name current-tab)) - (tab-name (alist-get 'name current-tab))) - (if explicit-name tab-name (+ 1 tab-index))))))) - (propertize (format " %s " name) - 'face (doom-modeline-face 'doom-modeline-buffer-major-mode))))) - - -;; -;; Perspective -;; - -(defvar-local doom-modeline--persp-name nil) -(defun doom-modeline-update-persp-name (&rest _) - "Update perspective name in mode-line." - (setq doom-modeline--persp-name - ;; Support `persp-mode', while not support `perspective' - (when (and doom-modeline-persp-name - (bound-and-true-p persp-mode) - (fboundp 'safe-persp-name) - (fboundp 'get-current-persp)) - (let* ((persp (get-current-persp)) - (name (safe-persp-name persp)) - (face (if (and persp - (not (persp-contain-buffer-p (current-buffer) persp))) - 'doom-modeline-persp-buffer-not-in-persp - 'doom-modeline-persp-name)) - (icon (doom-modeline-icon 'octicon "nf-oct-repo" "🖿" "#" - :face `(:inherit ,face :slant normal)))) - (when (or doom-modeline-display-default-persp-name - (not (string-equal persp-nil-name name))) - (concat " " - (propertize (concat (and doom-modeline-persp-icon - (concat icon - (propertize - " " - 'display '((space :relative-width 0.5))))) - (propertize name 'face face)) - 'help-echo "mouse-1: Switch perspective -mouse-2: Show help for minor mode" - 'mouse-face 'doom-modeline-highlight - 'local-map (let ((map (make-sparse-keymap))) - (define-key map [mode-line mouse-1] - #'persp-switch) - (define-key map [mode-line mouse-2] - (lambda () - (interactive) - (describe-function 'persp-mode))) - map)) - " ")))))) - -(add-hook 'buffer-list-update-hook #'doom-modeline-update-persp-name) -(add-hook 'find-file-hook #'doom-modeline-update-persp-name) -(add-hook 'persp-activated-functions #'doom-modeline-update-persp-name) -(add-hook 'persp-renamed-functions #'doom-modeline-update-persp-name) -(advice-add #'lv-message :after #'doom-modeline-update-persp-name) - -(doom-modeline-def-segment persp-name - "The current perspective name." - (when (doom-modeline--segment-visible 'persp-name) - doom-modeline--persp-name)) - - -;; -;; Misc info -;; - -(doom-modeline-def-segment misc-info - "Mode line construct for miscellaneous information. -By default, this shows the information specified by `global-mode-string'." - (when (and (doom-modeline--segment-visible 'misc-info) - (or doom-modeline-display-misc-in-all-mode-lines - (doom-modeline--active))) - (doom-modeline-display-text - (format-mode-line mode-line-misc-info)))) - - -;; -;; Position -;; - -(doom-modeline-def-segment buffer-position - "The buffer position information." - (let ((visible (doom-modeline--segment-visible 'buffer-position)) - (sep (doom-modeline-spc)) - (wsep (doom-modeline-wspc)) - (face (doom-modeline-face)) - (help-echo "Buffer percentage\n\ -mouse-1: Display Line and Column Mode Menu") - (mouse-face 'doom-modeline-highlight) - (local-map mode-line-column-line-number-mode-map)) - `(,wsep - - ;; Line and column - (:propertize - ((line-number-mode - (column-number-mode - (doom-modeline-column-zero-based - doom-modeline-position-column-line-format - ,(string-replace - "%c" "%C" (car doom-modeline-position-column-line-format))) - doom-modeline-position-line-format) - (column-number-mode - (doom-modeline-column-zero-based - doom-modeline-position-column-format - ,(string-replace - "%c" "%C" (car doom-modeline-position-column-format))))) - (doom-modeline-total-line-number - ,(format "/%d" (line-number-at-pos (point-max))))) - face ,face - help-echo ,help-echo - mouse-face ,mouse-face - local-map ,local-map) - - ((or line-number-mode column-number-mode) - ,sep) - - ;; Position - (,visible - ,(cond - ((and (bound-and-true-p nyan-mode) - (>= (window-width) nyan-minimum-window-width)) - (concat sep (nyan-create) sep)) - ((and (bound-and-true-p poke-line-mode) - (>= (window-width) poke-line-minimum-window-width)) - (concat sep (poke-line-create) sep)) - ((and (bound-and-true-p mlscroll-mode) - (>= (window-width) mlscroll-minimum-current-width)) - (concat - sep - (let ((mlscroll-right-align nil)) - (format-mode-line (mlscroll-mode-line))) - sep)) - ((and (bound-and-true-p sml-modeline-mode) - (>= (window-width) sml-modeline-len)) - (concat sep (sml-modeline-create) sep)) - (t ""))) - - ;; Percent position - (doom-modeline-percent-position - ((:propertize ("" doom-modeline-percent-position) - face ,face - help-echo ,help-echo - mouse-face ,mouse-face - local-map ,local-map) - ,sep))))) - -;; -;; Party parrot -;; -(doom-modeline-def-segment parrot - "The party parrot animated icon. Requires `parrot-mode' to be enabled." - (when (and (doom-modeline--segment-visible 'parrot) - (bound-and-true-p parrot-mode)) - (concat (doom-modeline-wspc) - (parrot-create) - (doom-modeline-spc)))) - -;; -;; Modals (evil, overwrite, god, ryo and xah-fly-keys, etc.) -;; - -(defun doom-modeline--modal-icon (text face help-echo &optional icon unicode) - "Display the model icon with FACE and HELP-ECHO. -TEXT is alternative if icon is not available." - (propertize (doom-modeline-icon - 'mdicon - (and doom-modeline-modal-icon - (or (and doom-modeline-modal-modern-icon icon) - "nf-md-record")) - (or (and doom-modeline-modal-modern-icon unicode) "●") - text - :face (doom-modeline-face face)) - 'help-echo help-echo)) - -(defsubst doom-modeline--evil () - "The current evil state. Requires `evil-mode' to be enabled." - (when (bound-and-true-p evil-local-mode) - (doom-modeline--modal-icon - (let ((tag (evil-state-property evil-state :tag t))) - (if (stringp tag) tag (funcall tag))) - (cond - ((evil-normal-state-p) 'doom-modeline-evil-normal-state) - ((evil-emacs-state-p) 'doom-modeline-evil-emacs-state) - ((evil-insert-state-p) 'doom-modeline-evil-insert-state) - ((evil-motion-state-p) 'doom-modeline-evil-motion-state) - ((evil-visual-state-p) 'doom-modeline-evil-visual-state) - ((evil-operator-state-p) 'doom-modeline-evil-operator-state) - ((evil-replace-state-p) 'doom-modeline-evil-replace-state) - (t 'doom-modeline-evil-normal-state)) - (evil-state-property evil-state :name t) - (cond - ((evil-normal-state-p) "nf-md-alpha_n_circle") - ((evil-emacs-state-p) "nf-md-alpha_e_circle") - ((evil-insert-state-p) "nf-md-alpha_i_circle") - ((evil-motion-state-p) "nf-md-alpha_m_circle") - ((evil-visual-state-p) "nf-md-alpha_v_circle") - ((evil-operator-state-p) "nf-md-alpha_o_circle") - ((evil-replace-state-p) "nf-md-alpha_r_circle") - (t "nf-md-alpha_n_circle")) - (cond - ((evil-normal-state-p) "🅝") - ((evil-emacs-state-p) "🅔") - ((evil-insert-state-p) "🅘") - ((evil-motion-state-p) "🅜") - ((evil-visual-state-p) "🅥") - ((evil-operator-state-p) "🅞") - ((evil-replace-state-p) "🅡") - (t "🅝"))))) - -(defsubst doom-modeline--overwrite () - "The current overwrite state which is enabled by command `overwrite-mode'." - (when (and (bound-and-true-p overwrite-mode) - (not (bound-and-true-p evil-local-mode))) - (doom-modeline--modal-icon - "<W>" 'doom-modeline-overwrite "Overwrite mode" - "nf-md-marker" "🅦"))) - -(defsubst doom-modeline--god () - "The current god state which is enabled by the command `god-mode'." - (when (bound-and-true-p god-local-mode) - (doom-modeline--modal-icon - "<G>" 'doom-modeline-god "God mode" - "nf-md-account_circle" "🅖"))) - -(defsubst doom-modeline--ryo () - "The current ryo-modal state which is enabled by the command `ryo-modal-mode'." - (when (bound-and-true-p ryo-modal-mode) - (doom-modeline--modal-icon - "<R>" 'doom-modeline-ryo "Ryo modal" - "nf-md-star_circle" "✪"))) - -(defsubst doom-modeline--xah-fly-keys () - "The current `xah-fly-keys' state." - (when (bound-and-true-p xah-fly-keys) - (if xah-fly-insert-state-p - (doom-modeline--modal-icon - "<I>" 'doom-modeline-fly-insert-state "Xah-fly insert mode" - "nf-md-airplane_edit" "🛧") - (doom-modeline--modal-icon - "<C>" 'doom-modeline-fly-normal-state "Xah-fly command mode" - "nf-md-airplane_cog" "🛧")))) - -(defsubst doom-modeline--boon () - "The current Boon state. Requires `boon-mode' to be enabled." - (when (bound-and-true-p boon-local-mode) - (doom-modeline--modal-icon - (boon-state-string) - (cond - (boon-command-state 'doom-modeline-boon-command-state) - (boon-insert-state 'doom-modeline-boon-insert-state) - (boon-special-state 'doom-modeline-boon-special-state) - (boon-off-state 'doom-modeline-boon-off-state) - (t 'doom-modeline-boon-off-state)) - (boon-modeline-string) - "nf-md-coffee" "🍵"))) - -(defsubst doom-modeline--meow () - "The current Meow state. Requires `meow-mode' to be enabled." - (when (bound-and-true-p meow-mode) - (doom-modeline--modal-icon - (symbol-name (meow--current-state)) - (cond - ((meow-normal-mode-p) 'doom-modeline-evil-normal-state) - ((meow-insert-mode-p) 'doom-modeline-evil-insert-state) - ((meow-beacon-mode-p) 'doom-modeline-evil-visual-state) - ((meow-motion-mode-p) 'doom-modeline-evil-motion-state) - ((meow-keypad-mode-p) 'doom-modeline-evil-operator-state) - (t 'doom-modeline-evil-normal-state)) - (symbol-name (meow--current-state)) - (cond - ((meow-normal-mode-p) "nf-md-alpha_n_circle") - ((meow-insert-mode-p) "nf-md-alpha_i_circle") - ((meow-beacon-mode-p) "nf-md-alpha_b_circle") - ((meow-motion-mode-p) "nf-md-alpha_m_circle") - ((meow-keypad-mode-p) "nf-md-alpha_k_circle") - (t "nf-md-alpha_n_circle")) - (cond - ((meow-normal-mode-p) "🅝") - ((meow-insert-mode-p) "🅘") - ((meow-beacon-mode-p) "🅑") - ((meow-motion-mode-p) "🅜") - ((meow-keypad-mode-p) "🅚") - (t "🅝"))))) - -(doom-modeline-def-segment modals - "Displays modal editing states. - -Including `evil', `overwrite', `god', `ryo' and `xha-fly-kyes', etc." - (when doom-modeline-modal - (let* ((evil (doom-modeline--evil)) - (ow (doom-modeline--overwrite)) - (god (doom-modeline--god)) - (ryo (doom-modeline--ryo)) - (xf (doom-modeline--xah-fly-keys)) - (boon (doom-modeline--boon)) - (vsep (doom-modeline-vspc)) - (meow (doom-modeline--meow)) - (sep (and (or evil ow god ryo xf boon) (doom-modeline-spc)))) - (concat sep - (and evil (concat evil (and (or ow god ryo xf boon meow) vsep))) - (and ow (concat ow (and (or god ryo xf boon meow) vsep))) - (and god (concat god (and (or ryo xf boon meow) vsep))) - (and ryo (concat ryo (and (or xf boon meow) vsep))) - (and xf (concat xf (and (or boon meow) vsep))) - (and boon (concat boon (and meow vsep))) - meow - sep)))) - -;; -;; Objed state -;; - -(defvar doom-modeline--objed-active nil) - -(defun doom-modeline-update-objed (_ &optional reset) - "Update `objed' status, inactive when RESET is true." - (setq doom-modeline--objed-active (not reset))) - -(setq objed-modeline-setup-func #'doom-modeline-update-objed) - -(doom-modeline-def-segment objed-state () - "The current objed state." - (when (and doom-modeline--objed-active - (doom-modeline--active)) - (propertize (format " %s(%s) " - (symbol-name objed--object) - (char-to-string (aref (symbol-name objed--obj-state) 0))) - 'face 'doom-modeline-evil-emacs-state - 'help-echo (format "Objed object: %s (%s)" - (symbol-name objed--object) - (symbol-name objed--obj-state))))) - - -;; -;; Input method -;; - -(doom-modeline-def-segment input-method - "The current input method." - (when-let ((im (cond - (current-input-method - current-input-method-title) - ((and (bound-and-true-p evil-local-mode) - (bound-and-true-p evil-input-method)) - (nth 3 (assoc default-input-method input-method-alist))) - (t nil))) - (sep (doom-modeline-spc))) - (concat - sep - (propertize im - 'face (doom-modeline-face - (if (and (bound-and-true-p rime-mode) - (equal current-input-method "rime")) - (if (and (rime--should-enable-p) - (not (rime--should-inline-ascii-p))) - 'doom-modeline-input-method - 'doom-modeline-input-method-alt) - 'doom-modeline-input-method)) - 'help-echo (concat - "Current input method: " - current-input-method - "\n\ -mouse-2: Disable input method\n\ -mouse-3: Describe current input method") - 'mouse-face 'doom-modeline-highlight - 'local-map mode-line-input-method-map) - sep))) - - -;; -;; Info -;; - -(doom-modeline-def-segment info-nodes - "The topic and nodes in the Info buffer." - (concat - " (" - ;; topic - (propertize (if (stringp Info-current-file) - (replace-regexp-in-string - "%" "%%" - (file-name-sans-extension - (file-name-nondirectory Info-current-file))) - (format "*%S*" Info-current-file)) - 'face (doom-modeline-face 'doom-modeline-info)) - ") " - ;; node - (when Info-current-node - (propertize (replace-regexp-in-string - "%" "%%" Info-current-node) - 'face (doom-modeline-face 'doom-modeline-buffer-path) - 'help-echo - "mouse-1: scroll forward, mouse-3: scroll back" - 'mouse-face 'doom-modeline-highlight - 'local-map Info-mode-line-node-keymap)))) - - -;; -;; REPL -;; - -(defun doom-modeline-repl-icon (text face) - "Display REPL icon (or TEXT in terminal) with FACE." - (doom-modeline-icon 'faicon "nf-fa-terminal" "$" text :face face)) - -(defvar doom-modeline--cider nil) - -(defun doom-modeline-update-cider () - "Update cider repl state." - (setq doom-modeline--cider - (let* ((connected (cider-connected-p)) - (face (if connected 'doom-modeline-repl-success 'doom-modeline-repl-warning)) - (repl-buffer (cider-current-repl nil nil)) - (cider-info (when repl-buffer - (cider--connection-info repl-buffer t))) - (icon (doom-modeline-repl-icon "REPL" face))) - (propertize icon - 'help-echo - (if connected - (format "CIDER Connected %s\nmouse-2: CIDER quit" cider-info) - "CIDER Disconnected\nmouse-1: CIDER jack-in") - 'mouse-face 'doom-modeline-highlight - 'local-map (let ((map (make-sparse-keymap))) - (if connected - (define-key map [mode-line mouse-2] - #'cider-quit) - (define-key map [mode-line mouse-1] - #'cider-jack-in)) - map))))) - -(add-hook 'cider-connected-hook #'doom-modeline-update-cider) -(add-hook 'cider-disconnected-hook #'doom-modeline-update-cider) -(add-hook 'cider-mode-hook #'doom-modeline-update-cider) - -(doom-modeline-def-segment repl - "The REPL state." - (when doom-modeline-repl - (when-let ((icon (when (bound-and-true-p cider-mode) - doom-modeline--cider)) - (sep (doom-modeline-spc))) - (concat - sep - (doom-modeline-display-icon icon) - sep)))) - - -;; -;; LSP -;; - -(defun doom-modeline-lsp-icon (text face) - "Display LSP icon (or TEXT in terminal) with FACE." - (if doom-modeline-lsp-icon - (doom-modeline-icon 'octicon "nf-oct-rocket" "🚀" text :face face) - (propertize text 'face face))) - -(defvar-local doom-modeline--lsp nil) -(defun doom-modeline-update-lsp (&rest _) - "Update `lsp-mode' state." - (setq doom-modeline--lsp - (let* ((workspaces (lsp-workspaces)) - (face (if workspaces 'doom-modeline-lsp-success 'doom-modeline-lsp-warning)) - (icon (doom-modeline-lsp-icon "LSP" face))) - (propertize icon - 'help-echo - (if workspaces - (concat "LSP Connected " - (string-join - (mapcar (lambda (w) - (format "[%s]\n" (lsp--workspace-print w))) - workspaces)) - "C-mouse-1: Switch to another workspace folder -mouse-1: Describe current session -mouse-2: Quit server -mouse-3: Reconnect to server") - "LSP Disconnected -mouse-1: Reload to start server") - 'mouse-face 'doom-modeline-highlight - 'local-map (let ((map (make-sparse-keymap))) - (if workspaces - (progn - (define-key map [mode-line C-mouse-1] - #'lsp-workspace-folders-open) - (define-key map [mode-line mouse-1] - #'lsp-describe-session) - (define-key map [mode-line mouse-2] - #'lsp-workspace-shutdown) - (define-key map [mode-line mouse-3] - #'lsp-workspace-restart)) - (progn - (define-key map [mode-line mouse-1] - (lambda () - (interactive) - (ignore-errors (revert-buffer t t)))))) - map))))) -(add-hook 'lsp-before-initialize-hook #'doom-modeline-update-lsp) -(add-hook 'lsp-after-initialize-hook #'doom-modeline-update-lsp) -(add-hook 'lsp-after-uninitialized-functions #'doom-modeline-update-lsp) -(add-hook 'lsp-before-open-hook #'doom-modeline-update-lsp) -(add-hook 'lsp-after-open-hook #'doom-modeline-update-lsp) - -(defun doom-modeline--eglot-pending-count (server) - "Get count of pending eglot requests to SERVER." - (if (fboundp 'jsonrpc-continuation-count) - (jsonrpc-continuation-count server) - (hash-table-count (jsonrpc--request-continuations server)))) - -(defvar-local doom-modeline--eglot nil) -(defun doom-modeline-update-eglot () - "Update `eglot' state." - (setq doom-modeline--eglot - (pcase-let* ((server (and (eglot-managed-p) (eglot-current-server))) - (nick (and server (eglot--project-nickname server))) - (pending (and server (doom-modeline--eglot-pending-count server))) - (last-error (and server (jsonrpc-last-error server))) - (face (cond (last-error 'doom-modeline-lsp-error) - ((and pending (cl-plusp pending)) 'doom-modeline-lsp-warning) - (nick 'doom-modeline-lsp-success) - (t 'doom-modeline-lsp-warning))) - (icon (doom-modeline-lsp-icon "EGLOT" face))) - (propertize icon - 'help-echo (cond - (last-error - (format "EGLOT\nAn error occured: %s -mouse-3: Clear this status" (plist-get last-error :message))) - ((and pending (cl-plusp pending)) - (format "EGLOT\n%d outstanding requests" pending)) - (nick (format "EGLOT Connected (%s/%s) -C-mouse-1: Go to server errors -mouse-1: Go to server events -mouse-2: Quit server -mouse-3: Reconnect to server" nick (eglot--major-modes server))) - (t "EGLOT Disconnected -mouse-1: Start server")) - 'mouse-face 'doom-modeline-highlight - 'local-map (let ((map (make-sparse-keymap))) - (cond (last-error - (define-key map [mode-line mouse-3] - #'eglot-clear-status)) - ((and pending (cl-plusp pending)) - (define-key map [mode-line mouse-3] - #'eglot-forget-pending-continuations)) - (nick - (define-key map [mode-line C-mouse-1] - #'eglot-stderr-buffer) - (define-key map [mode-line mouse-1] - #'eglot-events-buffer) - (define-key map [mode-line mouse-2] - #'eglot-shutdown) - (define-key map [mode-line mouse-3] - #'eglot-reconnect)) - (t (define-key map [mode-line mouse-1] - #'eglot))) - map))))) -(add-hook 'eglot-managed-mode-hook #'doom-modeline-update-eglot) - -(defvar-local doom-modeline--tags nil) -(defun doom-modeline-update-tags () - "Update tags state." - (setq doom-modeline--tags - (propertize - (doom-modeline-lsp-icon "TAGS" 'doom-modeline-lsp-success) - 'help-echo "TAGS: Citre mode -mouse-1: Toggle citre mode" - 'mouse-face 'doom-modeline-highlight - 'local-map (make-mode-line-mouse-map 'mouse-1 #'citre-mode)))) -(add-hook 'citre-mode-hook #'doom-modeline-update-tags) - -(defun doom-modeline-update-lsp-icon () - "Update lsp icon." - (cond ((bound-and-true-p lsp-mode) - (doom-modeline-update-lsp)) - ((bound-and-true-p eglot--managed-mode) - (doom-modeline-update-eglot)) - ((bound-and-true-p citre-mode) - (doom-modeline-update-tags)))) - -(doom-modeline-add-variable-watcher - 'doom-modeline-lsp-icon - (lambda (_sym val op _where) - (when (eq op 'set) - (setq doom-modeline-lsp-icon val) - (dolist (buf (buffer-list)) - (with-current-buffer buf - (doom-modeline-update-lsp-icon)))))) - -(doom-modeline-add-variable-watcher - 'doom-modeline-icon - (lambda (_sym val op _where) - (when (eq op 'set) - (setq doom-modeline-icon val) - (dolist (buf (buffer-list)) - (with-current-buffer buf - (doom-modeline-update-lsp-icon)))))) - -(doom-modeline-add-variable-watcher - 'doom-modeline-unicode-fallback - (lambda (_sym val op _where) - (when (eq op 'set) - (setq doom-modeline-unicode-fallback val) - (dolist (buf (buffer-list)) - (with-current-buffer buf - (doom-modeline-update-lsp-icon)))))) - -(doom-modeline-def-segment lsp - "The LSP server state." - (when doom-modeline-lsp - (when-let ((icon (cond ((bound-and-true-p lsp-mode) - doom-modeline--lsp) - ((bound-and-true-p eglot--managed-mode) - doom-modeline--eglot) - ((bound-and-true-p citre-mode) - doom-modeline--tags))) - (sep (doom-modeline-spc))) - (concat - sep - (doom-modeline-display-icon icon) - sep)))) - -(defun doom-modeline-override-eglot () - "Override `eglot' mode-line." - (if (and doom-modeline-lsp - (bound-and-true-p doom-modeline-mode)) - (setq mode-line-misc-info - (delq (assq 'eglot--managed-mode mode-line-misc-info) mode-line-misc-info)) - (add-to-list 'mode-line-misc-info - `(eglot--managed-mode (" [" eglot--mode-line-format "] "))))) -(add-hook 'eglot-managed-mode-hook #'doom-modeline-override-eglot) -(add-hook 'doom-modeline-mode-hook #'doom-modeline-override-eglot) - -(doom-modeline-add-variable-watcher - 'doom-modeline-battery - (lambda (_sym val op _where) - (when (eq op 'set) - (setq doom-modeline-lsp val) - (doom-modeline-override-eglot)))) - - -;; -;; GitHub -;; - -(defvar doom-modeline--github-notification-number 0) -(defvar doom-modeline-before-github-fetch-notification-hook nil - "Hooks before fetching GitHub notifications. -Example: - (add-hook \\='doom-modeline-before-github-fetch-notification-hook - #\\='auth-source-pass-enable)") - -(defvar doom-modeline-after-github-fetch-notification-hook nil - "Hooks after fetching GitHub notifications.") - -(defun doom-modeline--github-fetch-notifications () - "Fetch GitHub notifications." - (when (and doom-modeline-github - (require 'async nil t)) - (async-start - `(lambda () - ,(async-inject-variables - "\\`\\(load-path\\|auth-sources\\|doom-modeline-before-github-fetch-notification-hook\\)\\'") - (run-hooks 'doom-modeline-before-github-fetch-notification-hook) - (when (require 'ghub nil t) - (with-timeout (10) - (ignore-errors - (when-let* ((username (ghub--username ghub-default-host)) - (token (or (ghub--token ghub-default-host username 'forge t) - (ghub--token ghub-default-host username 'ghub t)))) - (ghub-get "/notifications" - '((notifications . t)) - :host ghub-default-host - :username username - :auth token - :unpaginate t - :noerror t)))))) - (lambda (result) - (message "") ; suppress message - (setq doom-modeline--github-notification-number (length result)) - (run-hooks 'doom-modeline-after-github-fetch-notification-hook))))) - -(defvar doom-modeline--github-timer nil) -(defun doom-modeline-github-timer () - "Start/Stop the timer for GitHub fetching." - (if (timerp doom-modeline--github-timer) - (cancel-timer doom-modeline--github-timer)) - (setq doom-modeline--github-timer - (and doom-modeline-github - (run-with-idle-timer 30 - doom-modeline-github-interval - #'doom-modeline--github-fetch-notifications)))) - -(doom-modeline-add-variable-watcher - 'doom-modeline-github - (lambda (_sym val op _where) - (when (eq op 'set) - (setq doom-modeline-github val) - (doom-modeline-github-timer)))) - -(doom-modeline-github-timer) - -(doom-modeline-def-segment github - "The GitHub notifications." - (when (and doom-modeline-github - (doom-modeline--segment-visible 'github) - (numberp doom-modeline--github-notification-number)) - (let ((sep (doom-modeline-spc))) - (concat - sep - (propertize - (concat - (doom-modeline-icon 'octicon "nf-oct-mark_github" "🔔" "&" - :face 'doom-modeline-notification) - (and (> doom-modeline--github-notification-number 0) (doom-modeline-vspc)) - (propertize - (cond - ((<= doom-modeline--github-notification-number 0) "") - ((> doom-modeline--github-notification-number 99) "99+") - (t (number-to-string doom-modeline--github-notification-number))) - 'face '(:inherit - (doom-modeline-unread-number doom-modeline-notification)))) - 'help-echo "Github Notifications -mouse-1: Show notifications -mouse-3: Fetch notifications" - 'mouse-face 'doom-modeline-highlight - 'local-map (let ((map (make-sparse-keymap))) - (define-key map [mode-line mouse-1] - (lambda () - "Open GitHub notifications page." - (interactive) - (run-with-idle-timer 300 nil #'doom-modeline--github-fetch-notifications) - (browse-url "https://github.com/notifications"))) - (define-key map [mode-line mouse-3] - (lambda () - "Fetching GitHub notifications." - (interactive) - (message "Fetching GitHub notifications...") - (doom-modeline--github-fetch-notifications))) - map)) - sep)))) - - -;; -;; Debug states -;; - -;; Highlight the doom-modeline while debugging. -(defvar-local doom-modeline--debug-cookie nil) -(defun doom-modeline--debug-visual (&rest _) - "Update the face of mode-line for debugging." - (mapc (lambda (buffer) - (with-current-buffer buffer - (setq doom-modeline--debug-cookie - (face-remap-add-relative 'doom-modeline 'doom-modeline-debug-visual)) - (force-mode-line-update))) - (buffer-list))) - -(defun doom-modeline--normal-visual (&rest _) - "Restore the face of mode-line." - (mapc (lambda (buffer) - (with-current-buffer buffer - (when doom-modeline--debug-cookie - (face-remap-remove-relative doom-modeline--debug-cookie) - (force-mode-line-update)))) - (buffer-list))) - -(add-hook 'dap-session-created-hook #'doom-modeline--debug-visual) -(add-hook 'dap-terminated-hook #'doom-modeline--normal-visual) - -(defun doom-modeline-debug-icon (face) - "Display debug icon with FACE and ARGS." - (doom-modeline-icon 'codicon "nf-cod-debug" "🐛" "!" :face face)) - -(defun doom-modeline--debug-dap () - "The current `dap-mode' state." - (when (and (bound-and-true-p dap-mode) - (bound-and-true-p lsp-mode)) - (when-let ((session (dap--cur-session))) - (when (dap--session-running session) - (propertize (doom-modeline-debug-icon 'doom-modeline-info) - 'help-echo (format "DAP (%s - %s) -mouse-1: Display debug hydra -mouse-2: Display recent configurations -mouse-3: Disconnect session" - (dap--debug-session-name session) - (dap--debug-session-state session)) - 'mouse-face 'doom-modeline-highlight - 'local-map (let ((map (make-sparse-keymap))) - (define-key map [mode-line mouse-1] - #'dap-hydra) - (define-key map [mode-line mouse-2] - #'dap-debug-recent) - (define-key map [mode-line mouse-3] - #'dap-disconnect) - map)))))) - -(defvar-local doom-modeline--debug-dap nil) -(defun doom-modeline-update-debug-dap (&rest _) - "Update dap debug state." - (setq doom-modeline--debug-dap (doom-modeline--debug-dap))) - -(add-hook 'dap-session-created-hook #'doom-modeline-update-debug-dap) -(add-hook 'dap-session-changed-hook #'doom-modeline-update-debug-dap) -(add-hook 'dap-terminated-hook #'doom-modeline-update-debug-dap) - -(defsubst doom-modeline--debug-edebug () - "The current `edebug' state." - (when (bound-and-true-p edebug-mode) - (propertize (doom-modeline-debug-icon 'doom-modeline-info) - 'help-echo (format "EDebug (%s) -mouse-1: Show help -mouse-2: Next -mouse-3: Stop debugging" - edebug-execution-mode) - 'mouse-face 'doom-modeline-highlight - 'local-map (let ((map (make-sparse-keymap))) - (define-key map [mode-line mouse-1] - #'edebug-help) - (define-key map [mode-line mouse-2] - #'edebug-next-mode) - (define-key map [mode-line mouse-3] - #'edebug-stop) - map)))) - -(defsubst doom-modeline--debug-on-error () - "The current `debug-on-error' state." - (when debug-on-error - (propertize (doom-modeline-debug-icon 'doom-modeline-urgent) - 'help-echo "Debug on Error -mouse-1: Toggle Debug on Error" - 'mouse-face 'doom-modeline-highlight - 'local-map (make-mode-line-mouse-map 'mouse-1 #'toggle-debug-on-error)))) - -(defsubst doom-modeline--debug-on-quit () - "The current `debug-on-quit' state." - (when debug-on-quit - (propertize (doom-modeline-debug-icon 'doom-modeline-warning) - 'help-echo "Debug on Quit -mouse-1: Toggle Debug on Quit" - 'mouse-face 'doom-modeline-highlight - 'local-map (make-mode-line-mouse-map 'mouse-1 #'toggle-debug-on-quit)))) - -(doom-modeline-def-segment debug - "The current debug state." - (when (doom-modeline--segment-visible 'debug) - (let* ((dap doom-modeline--debug-dap) - (edebug (doom-modeline--debug-edebug)) - (on-error (doom-modeline--debug-on-error)) - (on-quit (doom-modeline--debug-on-quit)) - (vsep (doom-modeline-vspc)) - (sep (and (or dap edebug on-error on-quit) (doom-modeline-spc)))) - (concat sep - (and dap (concat dap (and (or edebug on-error on-quit) vsep))) - (and edebug (concat edebug (and (or on-error on-quit) vsep))) - (and on-error (concat on-error (and on-quit vsep))) - on-quit - sep)))) - - -;; -;; PDF pages -;; - -(defvar-local doom-modeline--pdf-pages nil) -(defun doom-modeline-update-pdf-pages () - "Update PDF pages." - (setq doom-modeline--pdf-pages - (format " P%d/%d " - (or (eval `(pdf-view-current-page)) 0) - (pdf-cache-number-of-pages)))) -(add-hook 'pdf-view-change-page-hook #'doom-modeline-update-pdf-pages) - -(doom-modeline-def-segment pdf-pages - "Display PDF pages." - doom-modeline--pdf-pages) - - -;; -;; `mu4e' notifications -;; - -(doom-modeline-def-segment mu4e - "Show notifications of any unread emails in `mu4e'." - (when (and doom-modeline-mu4e - (doom-modeline--segment-visible 'mu4e)) - (let ((sep (doom-modeline-spc)) - (vsep (doom-modeline-vspc)) - (icon (doom-modeline-icon 'mdicon "nf-md-email" "📧" "#" - :face 'doom-modeline-notification))) - (cond ((and (bound-and-true-p mu4e-alert-mode-line) - (numberp mu4e-alert-mode-line) - ;; don't display if the unread mails count is zero - (> mu4e-alert-mode-line 0)) - (concat - sep - (propertize - (concat - icon - vsep - (propertize - (if (> mu4e-alert-mode-line doom-modeline-number-limit) - (format "%d+" doom-modeline-number-limit) - (number-to-string mu4e-alert-mode-line)) - 'face '(:inherit - (doom-modeline-unread-number doom-modeline-notification)))) - 'mouse-face 'doom-modeline-highlight - 'keymap '(mode-line keymap - (mouse-1 . mu4e-alert-view-unread-mails) - (mouse-2 . mu4e-alert-view-unread-mails) - (mouse-3 . mu4e-alert-view-unread-mails)) - 'help-echo (concat (if (= mu4e-alert-mode-line 1) - "You have an unread email" - (format "You have %s unread emails" mu4e-alert-mode-line)) - "\nClick here to view " - (if (= mu4e-alert-mode-line 1) "it" "them"))) - sep)) - ((bound-and-true-p mu4e-modeline-mode) - (concat sep icon vsep - (propertize (mu4e--modeline-string) - 'face 'doom-modeline-notification) - sep)))))) - -(defun doom-modeline-override-mu4e-alert (&rest _) - "Delete `mu4e-alert-mode-line' from global modeline string." - (when (and (featurep 'mu4e-alert) - (bound-and-true-p mu4e-alert-mode-line)) - (if (and doom-modeline-mu4e - (bound-and-true-p doom-modeline-mode)) - ;; Delete original modeline - (progn - (setq global-mode-string - (delete '(:eval mu4e-alert-mode-line) global-mode-string)) - (setq mu4e-alert-modeline-formatter #'identity)) - ;; Recover default settings - (setq mu4e-alert-modeline-formatter #'mu4e-alert-default-mode-line-formatter)))) -(advice-add #'mu4e-alert-enable-mode-line-display - :after #'doom-modeline-override-mu4e-alert) -(add-hook 'doom-modeline-mode-hook #'doom-modeline-override-mu4e-alert) - -(defun doom-modeline-override-mu4e-modeline (&rest _) - "Delete `mu4e-alert-mode-line' from global modeline string." - (when (bound-and-true-p mu4e-modeline-mode) - (if (and doom-modeline-mu4e - (bound-and-true-p doom-modeline-mode)) - ;; Delete original modeline - (setq global-mode-string - (delete mu4e--modeline-item global-mode-string)) - ;; Recover default settings - (add-to-list 'global-mode-string mu4e--modeline-item)))) -(add-hook 'mu4e-modeline-mode-hook #'doom-modeline-override-mu4e-modeline) -(add-hook 'doom-modeline-mode-hook #'doom-modeline-override-mu4e-modeline) - -(doom-modeline-add-variable-watcher - 'doom-modeline-mu4e - (lambda (_sym val op _where) - (when (eq op 'set) - (setq doom-modeline-mu4e val) - (doom-modeline-override-mu4e-alert) - (doom-modeline-override-mu4e-modeline)))) - - -;; -;; `gnus' notifications -;; - -(defvar doom-modeline--gnus-unread-mail 0) -(defvar doom-modeline--gnus-started nil - "Used to determine if gnus has started.") -(defun doom-modeline-update-gnus-status (&rest _) - "Get the total number of unread news of gnus group." - (setq doom-modeline--gnus-unread-mail - (when (and doom-modeline-gnus - doom-modeline--gnus-started) - (let ((total-unread-news-number 0)) - (mapc (lambda (g) - (let* ((group (car g)) - (unread (eval `(gnus-group-unread ,group)))) - (when (and (not (seq-contains-p doom-modeline-gnus-excluded-groups group)) - (numberp unread) - (> unread 0)) - (setq total-unread-news-number (+ total-unread-news-number unread))))) - gnus-newsrc-alist) - total-unread-news-number)))) - -;; Update the modeline after changes have been made -(add-hook 'gnus-group-update-hook #'doom-modeline-update-gnus-status) -(add-hook 'gnus-summary-update-hook #'doom-modeline-update-gnus-status) -(add-hook 'gnus-group-update-group-hook #'doom-modeline-update-gnus-status) -(add-hook 'gnus-after-getting-new-news-hook #'doom-modeline-update-gnus-status) - -;; Only start to listen to gnus when gnus is actually running -(defun doom-modeline-start-gnus-listener () - "Start GNUS listener." - (when (and doom-modeline-gnus - (not doom-modeline--gnus-started)) - (setq doom-modeline--gnus-started t) - ;; Scan gnus in the background if the timer is higher than 0 - (doom-modeline-update-gnus-status) - (if (> doom-modeline-gnus-timer 0) - (gnus-demon-add-handler 'gnus-demon-scan-news doom-modeline-gnus-timer doom-modeline-gnus-idle)))) -(add-hook 'gnus-started-hook #'doom-modeline-start-gnus-listener) - -;; Stop the listener if gnus isn't running -(defun doom-modeline-stop-gnus-listener () - "Stop GNUS listener." - (setq doom-modeline--gnus-started nil)) -(add-hook 'gnus-exit-gnus-hook #'doom-modeline-stop-gnus-listener) - -(doom-modeline-def-segment gnus - "Show notifications of any unread emails in `gnus'." - (when (and (doom-modeline--segment-visible 'gnus) - doom-modeline-gnus - doom-modeline--gnus-started - ;; Don't display if the unread mails count is zero - (numberp doom-modeline--gnus-unread-mail) - (> doom-modeline--gnus-unread-mail 0)) - (let ((sep (doom-modeline-spc)) - (vsep (doom-modeline-vspc))) - (concat - sep - (propertize - (concat - (doom-modeline-icon 'mdicon "nf-md-email" "📧" "#" - :face 'doom-modeline-notification) - vsep - (propertize - (if (> doom-modeline--gnus-unread-mail doom-modeline-number-limit) - (format "%d+" doom-modeline-number-limit) - (number-to-string doom-modeline--gnus-unread-mail)) - 'face '(:inherit - (doom-modeline-unread-number doom-modeline-notification)))) - 'mouse-face 'doom-modeline-highlight - 'help-echo (if (= doom-modeline--gnus-unread-mail 1) - "You have an unread email" - (format "You have %s unread emails" doom-modeline--gnus-unread-mail))) - sep)))) - - -;; -;; IRC notifications -;; - -(defun doom-modeline--shorten-irc (name) - "Wrapper for `tracking-shorten' and `erc-track-shorten-function' with NAME. - -One key difference is that when `tracking-shorten' and -`erc-track-shorten-function' returns nil we will instead return the original -value of name. This is necessary in cases where the user has stylized the name -to be an icon and we don't want to remove that so we just return the original." - (or (and (boundp 'tracking-shorten) - (car (tracking-shorten (list name)))) - (and (boundp 'erc-track-shorten-function) - (functionp erc-track-shorten-function) - (car (funcall erc-track-shorten-function (list name)))) - (and (boundp 'rcirc-short-buffer-name) - (rcirc-short-buffer-name name)) - name)) - -(defun doom-modeline--tracking-buffers (buffers) - "Logic to convert some irc BUFFERS to their font-awesome icon." - (mapconcat - (lambda (b) - (propertize - (doom-modeline--shorten-irc (funcall doom-modeline-irc-stylize b)) - 'face '(:inherit (doom-modeline-unread-number doom-modeline-notification)) - 'help-echo (format "IRC Notification: %s\nmouse-1: Switch to buffer" b) - 'mouse-face 'doom-modeline-highlight - 'local-map (make-mode-line-mouse-map - 'mouse-1 - (lambda () - (interactive) - (when (buffer-live-p (get-buffer b)) - (switch-to-buffer b)))))) - buffers - (doom-modeline-vspc))) - -(defun doom-modeline--circe-p () - "Check if `circe' is in use." - (boundp 'tracking-mode-line-buffers)) - -(defun doom-modeline--erc-p () - "Check if `erc' is in use." - (boundp 'erc-modified-channels-alist)) - -(defun doom-modeline--rcirc-p () - "Check if `rcirc' is in use." - (bound-and-true-p rcirc-track-minor-mode)) - -(defun doom-modeline--get-buffers () - "Gets the buffers that have activity." - (cond - ((doom-modeline--circe-p) - tracking-buffers) - ((doom-modeline--erc-p) - (mapcar (lambda (l) - (buffer-name (car l))) - erc-modified-channels-alist)) - ((doom-modeline--rcirc-p) - (mapcar (lambda (b) - (buffer-name b)) - rcirc-activity)))) - -;; Create a modeline segment that contains all the irc tracked buffers -(doom-modeline-def-segment irc-buffers - "The list of shortened, unread irc buffers." - (when (and doom-modeline-irc - (doom-modeline--segment-visible 'irc-buffers)) - (let* ((buffers (doom-modeline--get-buffers)) - (number (length buffers)) - (sep (doom-modeline-spc))) - (when (> number 0) - (concat - sep - (doom-modeline--tracking-buffers buffers) - sep))))) - -(doom-modeline-def-segment irc - "A notification icon for any unread irc buffer." - (when (and doom-modeline-irc - (doom-modeline--segment-visible 'irc)) - (let* ((buffers (doom-modeline--get-buffers)) - (number (length buffers)) - (sep (doom-modeline-spc)) - (vsep (doom-modeline-vspc))) - (when (> number 0) - (concat - sep - - (propertize (concat - (doom-modeline-icon 'mdicon "nf-md-message_processing" "🗊" "#" - :face 'doom-modeline-notification) - vsep - ;; Display the number of unread buffers - (propertize (number-to-string number) - 'face '(:inherit - (doom-modeline-unread-number - doom-modeline-notification)))) - 'help-echo (format "IRC Notifications: %s\n%s" - (mapconcat - (lambda (b) (funcall doom-modeline-irc-stylize b)) - buffers - ", ") - (cond - ((doom-modeline--circe-p) - "mouse-1: Switch to previous unread buffer -mouse-3: Switch to next unread buffer") - ((doom-modeline--erc-p) - "mouse-1: Switch to buffer -mouse-3: Switch to next unread buffer") - ((doom-modeline--rcirc-p) - "mouse-1: Switch to server buffer -mouse-3: Switch to next unread buffer"))) - 'mouse-face 'doom-modeline-highlight - 'local-map (let ((map (make-sparse-keymap))) - (cond - ((doom-modeline--circe-p) - (define-key map [mode-line mouse-1] - #'tracking-previous-buffer) - (define-key map [mode-line mouse-3] - #'tracking-next-buffer)) - ((doom-modeline--erc-p) - (define-key map [mode-line mouse-1] - #'erc-switch-to-buffer) - (define-key map [mode-line mouse-3] - #'erc-track-switch-buffer)) - ((doom-modeline--rcirc-p) - (define-key map [mode-line mouse-1] - #'rcirc-switch-to-server-buffer) - (define-key map [mode-line mouse-3] - #'rcirc-next-active-buffer))) - map)) - - ;; Display the unread irc buffers as well - (when doom-modeline-irc-buffers - (concat sep (doom-modeline--tracking-buffers buffers))) - - sep))))) - -(defun doom-modeline-override-rcirc () - "Override default `rcirc' mode-line." - (if (and doom-modeline-irc - (bound-and-true-p doom-modeline-mode)) - (setq global-mode-string - (delq 'rcirc-activity-string global-mode-string)) - (when (and rcirc-track-minor-mode - (not (memq 'rcirc-activity-string global-mode-string))) - (setq global-mode-string - (append global-mode-string '(rcirc-activity-string)))))) -(add-hook 'rcirc-track-minor-mode-hook #'doom-modeline-override-rcirc) -(add-hook 'doom-modeline-mode-hook #'doom-modeline-override-rcirc) - -(doom-modeline-add-variable-watcher - 'doom-modeline-irc - (lambda (_sym val op _where) - (when (eq op 'set) - (setq doom-modeline-irc val) - (doom-modeline-override-rcirc)))) - - -;; -;; Battery status -;; - -(defun doom-modeline-battery-icon (icon unicode text face) - "Displays the battery ICON with FACE. - -UNICODE and TEXT are fallbacks. -Uses `nerd-icons-mdicon' to fetch the icon." - (doom-modeline-icon 'mdicon icon unicode text :face face)) - -(defvar doom-modeline--battery-status nil) -(defun doom-modeline-update-battery-status () - "Update battery status." - (setq doom-modeline--battery-status - (when (and doom-modeline-battery - (bound-and-true-p display-battery-mode)) - (let* ((data (and battery-status-function - (functionp battery-status-function) - (funcall battery-status-function))) - (status (cdr (assoc ?L data))) - (charging? (or (string-equal "AC" status) - (string-equal "on-line" status))) - (percentage (car (read-from-string (or (cdr (assq ?p data)) "ERR")))) - (valid-percentage? (and (numberp percentage) - (>= percentage 0) - (<= percentage battery-mode-line-limit))) - (face (if valid-percentage? - (cond (charging? 'doom-modeline-battery-charging) - ((< percentage battery-load-critical) 'doom-modeline-battery-critical) - ((< percentage 25) 'doom-modeline-battery-warning) - ((< percentage 95) 'doom-modeline-battery-normal) - (t 'doom-modeline-battery-full)) - 'doom-modeline-battery-error)) - (icon (if valid-percentage? - (cond - ((>= percentage 100) - (doom-modeline-battery-icon (if charging? - "nf-md-battery_charging_100" - "nf-md-battery") - "🔋" "-" face)) - ((>= percentage 90) - (doom-modeline-battery-icon (if charging? - "nf-md-battery_charging_90" - "nf-md-battery_90") - "🔋" "-" face)) - ((>= percentage 80) - (doom-modeline-battery-icon (if charging? - "nf-md-battery_charging_80" - "nf-md-battery_80") - "🔋" "-" face)) - ((>= percentage 70) - (doom-modeline-battery-icon (if charging? - "nf-md-battery_charging_70" - "nf-md-battery_70") - "🔋" "-" face)) - ((>= percentage 60) - (doom-modeline-battery-icon (if charging? - "nf-md-battery_charging_60" - "nf-md-battery_60") - "🔋" "-" face)) - ((>= percentage 50) - (doom-modeline-battery-icon (if charging? - "nf-md-battery_charging_50" - "nf-md-battery_50") - "🔋" "-" face)) - ((>= percentage 40) - (doom-modeline-battery-icon (if charging? - "nf-md-battery_charging_40" - "nf-md-battery_40") - "🔋" "-" face)) - ((>= percentage 30) - (doom-modeline-battery-icon (if charging? - "nf-md-battery_charging_30" - "nf-md-battery_30") - "🔋" "-" face)) - ((>= percentage 20) - (doom-modeline-battery-icon (if charging? - "nf-md-battery_charging_20" - "nf-md-battery_20") - "🔋" "-" face)) - ((>= percentage 10) - (doom-modeline-battery-icon (if charging? - "nf-md-battery_charging_10" - "nf-md-battery_10") - "🪫" "-" face)) - (t (doom-modeline-battery-icon (if charging? - "nf-md-battery_charging_outline" - "nf-md-battery_outline") - "🪫" "!" face))) - (doom-modeline-battery-icon "nf-md-battery_alert" "⚠" "N/A" face))) - (text (if valid-percentage? (format "%d%s" percentage "%%") "")) - (help-echo (if (and battery-echo-area-format data valid-percentage?) - (battery-format battery-echo-area-format data) - "Battery status not available"))) - (cons (propertize icon 'help-echo help-echo) - (propertize text 'face face 'help-echo help-echo)))))) - -(doom-modeline-add-variable-watcher - 'doom-modeline-icon - (lambda (_sym val op _where) - (when (eq op 'set) - (setq doom-modeline-icon val) - (doom-modeline-update-battery-status)))) - -(doom-modeline-add-variable-watcher - 'doom-modeline-unicode-fallback - (lambda (_sym val op _where) - (when (eq op 'set) - (setq doom-modeline-unicode-fallback val) - (doom-modeline-update-battery-status)))) - -(doom-modeline-def-segment battery - "Display battery status." - (when (and doom-modeline-battery - (bound-and-true-p display-battery-mode) - (doom-modeline--segment-visible 'battery)) - (let ((sep (doom-modeline-spc)) - (vsep (doom-modeline-vspc))) - (concat sep - (car doom-modeline--battery-status) - vsep - (cdr doom-modeline--battery-status) - sep)))) - -(defun doom-modeline-override-battery () - "Override default battery mode-line." - (if (and doom-modeline-battery - (bound-and-true-p doom-modeline-mode)) - (progn - (advice-add #'battery-update :override #'doom-modeline-update-battery-status) - (setq global-mode-string - (delq 'battery-mode-line-string global-mode-string)) - (and (bound-and-true-p display-battery-mode) (battery-update))) - (progn - (advice-remove #'battery-update #'doom-modeline-update-battery-status) - (when (and display-battery-mode battery-status-function battery-mode-line-format - (not (memq 'battery-mode-line-string global-mode-string))) - (setq global-mode-string - (append global-mode-string '(battery-mode-line-string))))))) -(add-hook 'display-battery-mode-hook #'doom-modeline-override-battery) -(add-hook 'doom-modeline-mode-hook #'doom-modeline-override-battery) - -(doom-modeline-add-variable-watcher - 'doom-modeline-battery - (lambda (_sym val op _where) - (when (eq op 'set) - (setq doom-modeline-battery val) - (doom-modeline-override-battery)))) - - -;; -;; Package information -;; - -(doom-modeline-def-segment package - "Show package information via `paradox'." - (concat - (doom-modeline-display-text - (format-mode-line 'mode-line-front-space)) - - (when (and doom-modeline-icon doom-modeline-major-mode-icon) - (concat - (doom-modeline-spc) - (doom-modeline-icon 'faicon "nf-fa-archive" nil nil - :face (doom-modeline-face - (if doom-modeline-major-mode-color-icon - 'nerd-icons-silver - 'mode-line))))) - (doom-modeline-display-text - (format-mode-line 'mode-line-buffer-identification)))) - - -;; -;; Helm -;; - -(defvar doom-modeline--helm-buffer-ids - '(("*helm*" . "HELM") - ("*helm M-x*" . "HELM M-x") - ("*swiper*" . "SWIPER") - ("*Projectile Perspectives*" . "HELM Projectile Perspectives") - ("*Projectile Layouts*" . "HELM Projectile Layouts") - ("*helm-ag*" . (lambda () - (format "HELM Ag: Using %s" - (car (split-string helm-ag-base-command)))))) - "Alist of custom helm buffer names to use. -The cdr can also be a function that returns a name to use.") - -(doom-modeline-def-segment helm-buffer-id - "Helm session identifier." - (when (bound-and-true-p helm-alive-p) - (let ((sep (doom-modeline-spc))) - (concat - sep - (when doom-modeline-icon - (concat - (doom-modeline-icon 'sucicon "nf-custom-emacs" nil nil - :face (doom-modeline-face - (and doom-modeline-major-mode-color-icon - 'nerd-icons-blue))) - sep)) - (propertize - (let ((custom (cdr (assoc (buffer-name) doom-modeline--helm-buffer-ids))) - (case-fold-search t) - (name (replace-regexp-in-string "-" " " (buffer-name)))) - (cond ((stringp custom) custom) - ((functionp custom) (funcall custom)) - (t - (string-match "\\*helm:? \\(mode \\)?\\([^\\*]+\\)\\*" name) - (concat "HELM " (capitalize (match-string 2 name)))))) - 'face (doom-modeline-face 'doom-modeline-buffer-file)) - sep)))) - -(doom-modeline-def-segment helm-number - "Number of helm candidates." - (when (bound-and-true-p helm-alive-p) - (concat - (propertize (format " %d/%d" - (helm-candidate-number-at-point) - (helm-get-candidate-number t)) - 'face (doom-modeline-face 'doom-modeline-buffer-path)) - (propertize (format " (%d total) " (helm-get-candidate-number)) - 'face (doom-modeline-face 'doom-modeline-info))))) - -(doom-modeline-def-segment helm-help - "Helm keybindings help." - (when (bound-and-true-p helm-alive-p) - (mapcar - (lambda (s) - (if (string-prefix-p "\\<" s) - (propertize (substitute-command-keys s) - 'face (doom-modeline-face - 'doom-modeline-buffer-file)) - s)) - '("\\<helm-map>\\[helm-help]" "(help) " - "\\<helm-map>\\[helm-select-action]" "(actions) " - "\\<helm-map>\\[helm-maybe-exit-minibuffer]/F1/F2..." "(action) ")))) - -(doom-modeline-def-segment helm-prefix-argument - "Helm prefix argument." - (when (and (bound-and-true-p helm-alive-p) - helm--mode-line-display-prefarg) - (let ((arg (prefix-numeric-value (or prefix-arg current-prefix-arg)))) - (unless (= arg 1) - (propertize (format "C-u %s" arg) - 'face (doom-modeline-face 'doom-modeline-info)))))) - -(defvar doom-modeline--helm-current-source nil - "The currently active helm source.") -(doom-modeline-def-segment helm-follow - "Helm follow indicator." - (and (bound-and-true-p helm-alive-p) - doom-modeline--helm-current-source - (eq 1 (cdr (assq 'follow doom-modeline--helm-current-source))) - "HF")) - -;; -;; Git timemachine -;; - -(doom-modeline-def-segment git-timemachine - (concat - (doom-modeline-spc) - (doom-modeline--buffer-mode-icon) - (doom-modeline--buffer-state-icon) - (propertize - "*%b*" - 'face (doom-modeline-face 'doom-modeline-buffer-timemachine)))) - -;; -;; Markdown/Org preview -;; - -(doom-modeline-def-segment grip - (when (bound-and-true-p grip-mode) - (let ((sep (doom-modeline-spc))) - (concat - sep - (let ((face (doom-modeline-face - (if grip--process - (pcase (process-status grip--process) - ('run 'doom-modeline-info) - ('exit 'doom-modeline-warning) - (_ 'doom-modeline-urgent)) - 'doom-modeline-urgent)))) - (propertize - (doom-modeline-icon 'codicon "nf-cod-open_preview" "🗐" "@" :face face) - 'help-echo (format "Preview on %s -mouse-1: Preview in browser -mouse-2: Stop preview -mouse-3: Restart preview" - (grip--preview-url)) - 'mouse-face 'doom-modeline-highlight - 'local-map (let ((map (make-sparse-keymap))) - (define-key map [mode-line mouse-1] - #'grip-browse-preview) - (define-key map [mode-line mouse-2] - #'grip-stop-preview) - (define-key map [mode-line mouse-3] - #'grip-restart-preview) - map))) - sep)))) - -;; -;; Follow mode -;; - -(doom-modeline-def-segment follow - (when (bound-and-true-p follow-mode) - (let* ((windows (follow-all-followers)) - (nwindows (length windows)) - (nfollowing (- (length (memq (selected-window) windows)) 1))) - (concat - (doom-modeline-spc) - (propertize (format "Follow %d/%d" (- nwindows nfollowing) nwindows) - 'face 'doom-modeline-buffer-minor-mode))))) - -;; -;; Display time -;; - -(defconst doom-modeline--clock-hour-hand-ratio 0.45 - "Length of the hour hand as a proportion of the radius.") - -(defconst doom-modeline--clock-minute-hand-ratio 0.7 - "Length of the minute hand as a proportion of the radius.") - -(defun doom-modeline--create-clock-svg (hour minute radius color) - "Construct an SVG clock showing the time HOUR:MINUTE. -The clock will be of the specified RADIUS and COLOR." - (let ((thickness-factor (image-compute-scaling-factor 'auto)) - (hour-x (* radius (sin (* (- 6 hour (/ minute 60.0)) (/ float-pi 6))) - doom-modeline--clock-hour-hand-ratio)) - (hour-y (* radius (cos (* (- 6 hour (/ minute 60.0)) (/ float-pi 6))) - doom-modeline--clock-hour-hand-ratio)) - (minute-x (* radius (sin (* (- 30 minute) (/ float-pi 30))) - doom-modeline--clock-minute-hand-ratio)) - (minute-y (* radius (cos (* (- 30 minute) (/ float-pi 30))) - doom-modeline--clock-minute-hand-ratio)) - (svg (svg-create (* 2 radius) (* 2 radius) :stroke color))) - (svg-circle svg radius radius (- radius thickness-factor) - :fill "none" :stroke-width (* 2 thickness-factor)) - (svg-circle svg radius radius thickness-factor - :fill color :stroke "none") - (svg-line svg radius radius (+ radius hour-x) (+ radius hour-y) - :stroke-width (* 2 thickness-factor)) - (svg-line svg radius radius (+ radius minute-x) (+ radius minute-y) - :stroke-width (* 1.5 thickness-factor)) - svg)) - -(defvar doom-modeline--clock-cache nil - "The last result of `doom-modeline--generate-clock'.") - -(defun doom-modeline--generate-clock () - "Return a string containing the current time as an analogue clock svg. -When the svg library is not available, return nil." - (cdr - (or (and (equal (truncate (float-time) - (* doom-modeline-time-clock-minute-resolution 60)) - (car doom-modeline--clock-cache)) - doom-modeline--clock-cache) - (and (require 'svg nil t) - (setq doom-modeline--clock-cache - (cons (truncate (float-time) - (* doom-modeline-time-clock-minute-resolution 60)) - (propertize - " " - 'display - (svg-image - (doom-modeline--create-clock-svg - (string-to-number (format-time-string "%-I")) ; hour - (* (truncate (string-to-number (format-time-string "%-M")) - doom-modeline-time-clock-minute-resolution) - doom-modeline-time-clock-minute-resolution) ; minute - (if (integerp doom-modeline-time-clock-size) ; radius - doom-modeline-time-clock-size - (* doom-modeline-height 0.5 doom-modeline-time-clock-size)) - "currentColor") - :scale 1 :ascent 'center) - 'face 'doom-modeline-time - 'help-echo (lambda (_window _object _pos) - (format-time-string "%c"))))))))) - -(defun doom-modeline-time-icon () - "Displays the time icon." - (or (and doom-modeline-time-live-icon - doom-modeline-time-analogue-clock - (display-graphic-p) - (doom-modeline--generate-clock)) - (doom-modeline-icon - 'mdicon - (if doom-modeline-time-live-icon - (pcase (% (caddr (decode-time)) 12) - (0 "nf-md-clock_time_twelve_outline") - (1 "nf-md-clock_time_one_outline") - (2 "nf-md-clock_time_two_outline") - (3 "nf-md-clock_time_three_outline") - (4 "nf-md-clock_time_four_outline") - (5 "nf-md-clock_time_five_outline") - (6 "nf-md-clock_time_six_outline") - (7 "nf-md-clock_time_seven_outline") - (8 "nf-md-clock_time_eight_outline") - (9 "nf-md-clock_time_nine_outline") - (10 "nf-md-clock_time_ten_outline") - (11 "nf-md-clock_time_eleven_outline")) - "nf-md-clock_outline") - "⏰" - "" - :face '(:inherit doom-modeline-time :weight normal)))) - -(doom-modeline-def-segment time - (when (and doom-modeline-time - (bound-and-true-p display-time-mode) - (doom-modeline--segment-visible 'time)) - (concat - (doom-modeline-spc) - (when doom-modeline-time-icon - (concat - (doom-modeline-time-icon) - (and (or doom-modeline-icon doom-modeline-unicode-fallback) - (doom-modeline-vspc)))) - (propertize display-time-string - 'face (doom-modeline-face 'doom-modeline-time))))) - -(defun doom-modeline-override-time () - "Override default `display-time' mode-line." - (or global-mode-string (setq global-mode-string '(""))) - (if (and doom-modeline-time - (bound-and-true-p doom-modeline-mode)) - (setq global-mode-string (delq 'display-time-string global-mode-string)) - (setq global-mode-string (append global-mode-string '(display-time-string))))) -(add-hook 'display-time-mode-hook #'doom-modeline-override-time) -(add-hook 'doom-modeline-mode-hook #'doom-modeline-override-time) - -(doom-modeline-add-variable-watcher - 'doom-modeline-time - (lambda (_sym val op _where) - (when (eq op 'set) - (setq doom-modeline-time val) - (doom-modeline-override-time)))) - -;; -;; Compilation -;; - -(doom-modeline-def-segment compilation - (and (bound-and-true-p compilation-in-progress) - (propertize "[Compiling] " - 'face (doom-modeline-face 'doom-modeline-compilation) - 'help-echo "Compiling; mouse-2: Goto Buffer" - 'mouse-face 'doom-modeline-highlight - 'local-map - (make-mode-line-mouse-map - 'mouse-2 - #'compilation-goto-in-progress-buffer)))) - -;; -;; Eldoc -;; - -(doom-modeline-def-segment eldoc - (and (bound-and-true-p eldoc-mode) - '(eldoc-mode-line-string - (" " eldoc-mode-line-string " ")))) - -(defun doom-modeline-eldoc-minibuffer-message (format-string &rest args) - "Display message specified by FORMAT-STRING and ARGS on the mode-line as needed. -This function displays the message produced by formatting ARGS -with FORMAT-STRING on the mode line when the current buffer is a minibuffer. -Otherwise, it displays the message like `message' would." - (if (minibufferp) - (progn - (add-hook 'minibuffer-exit-hook - (lambda () (setq eldoc-mode-line-string nil - ;; https://debbugs.gnu.org/16920 - eldoc-last-message nil)) - nil t) - (with-current-buffer - (window-buffer - (or (window-in-direction 'above (minibuffer-window)) - (minibuffer-selected-window) - (get-largest-window))) - (setq eldoc-mode-line-string - (when (stringp format-string) - (apply #'format-message format-string args))) - (force-mode-line-update))) - (apply #'message format-string args))) - -;; -;; Kubernetes -;; - -(doom-modeline-def-segment k8s - (when (and (bound-and-true-p kele-mode) (doom-modeline--segment-visible 'k8s)) - (let* ((ctx (kele-current-context-name :wait nil)) - (ns (kele-current-namespace :wait nil)) - (icon (doom-modeline-icon 'mdicon "nf-md-kubernetes" "K8s:" "K8s:")) - (sep (doom-modeline-spc)) - (help-msg (let ((msgs (list (format "Current context: %s" ctx)))) - (when ns - (setq msgs (append msgs (list (format "Current namespace: %s" ns))))) - (string-join msgs "\n")))) - (propertize (concat - icon sep ctx - (when (and doom-modeline-k8s-show-namespace ns) (format "(%s)" ns)) - sep) - 'local-map (let ((map (make-sparse-keymap))) - (define-key map [mode-line down-mouse-1] kele-menu-map) - map) - 'mouse-face 'doom-modeline-highlight - 'help-echo help-msg)))) - -(provide 'doom-modeline-segments) - -;;; doom-modeline-segments.el ends here diff --git a/emacs/elpa/doom-modeline-20240605.628/doom-modeline-segments.elc b/emacs/elpa/doom-modeline-20240605.628/doom-modeline-segments.elc Binary files differ. diff --git a/emacs/elpa/doom-modeline-20240605.628/doom-modeline.elc b/emacs/elpa/doom-modeline-20240605.628/doom-modeline.elc Binary files differ. diff --git a/emacs/elpa/doom-modeline-20240605.628/doom-modeline-autoloads.el b/emacs/elpa/doom-modeline-20240625.230/doom-modeline-autoloads.el diff --git a/emacs/elpa/doom-modeline-20240605.628/doom-modeline-core.el b/emacs/elpa/doom-modeline-20240625.230/doom-modeline-core.el diff --git a/emacs/elpa/doom-modeline-20240625.230/doom-modeline-core.elc b/emacs/elpa/doom-modeline-20240625.230/doom-modeline-core.elc Binary files differ. diff --git a/emacs/elpa/doom-modeline-20240605.628/doom-modeline-env.el b/emacs/elpa/doom-modeline-20240625.230/doom-modeline-env.el diff --git a/emacs/elpa/doom-modeline-20240625.230/doom-modeline-env.elc b/emacs/elpa/doom-modeline-20240625.230/doom-modeline-env.elc Binary files differ. diff --git a/emacs/elpa/doom-modeline-20240625.230/doom-modeline-pkg.el b/emacs/elpa/doom-modeline-20240625.230/doom-modeline-pkg.el @@ -0,0 +1,17 @@ +(define-package "doom-modeline" "20240625.230" "A minimal and modern mode-line" + '((emacs "25.1") + (compat "29.1.4.5") + (nerd-icons "0.1.0") + (shrink-path "0.3.1")) + :commit "1505c13564b83e44d3187611e326a48b742cad3a" :authors + '(("Vincent Zhang" . "seagle0128@gmail.com")) + :maintainers + '(("Vincent Zhang" . "seagle0128@gmail.com")) + :maintainer + '("Vincent Zhang" . "seagle0128@gmail.com") + :keywords + '("faces" "mode-line") + :url "https://github.com/seagle0128/doom-modeline") +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/emacs/elpa/doom-modeline-20240625.230/doom-modeline-segments.el b/emacs/elpa/doom-modeline-20240625.230/doom-modeline-segments.el @@ -0,0 +1,3247 @@ +;;; doom-modeline-segments.el --- The segments for doom-modeline -*- lexical-binding: t; -*- + +;; Copyright (C) 2018-2024 Vincent Zhang + +;; This file is not part of GNU Emacs. + +;; +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. +;; +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <https://www.gnu.org/licenses/>. +;; + +;;; Commentary: +;; +;; The segments for doom-modeline. +;; Use `doom-modeline-def-segment' to create a new segment. +;; + +;;; Code: + +(require 'doom-modeline-core) +(require 'doom-modeline-env) +(eval-when-compile + (require 'cl-lib) + (require 'seq) + (require 'subr-x)) + + +;; +;; Externals +;; + +(defvar Info-current-file) +(defvar Info-current-node) +(defvar Info-mode-line-node-keymap) +(defvar anzu--cached-count) +(defvar anzu--current-position) +(defvar anzu--overflow-p) +(defvar anzu--state) +(defvar anzu--total-matched) +(defvar anzu-cons-mode-line-p) +(defvar aw-keys) +(defvar battery-echo-area-format) +(defvar battery-load-critical) +(defvar battery-mode-line-format) +(defvar battery-mode-line-limit) +(defvar battery-status-function) +(defvar boon-command-state) +(defvar boon-insert-state) +(defvar boon-off-state) +(defvar boon-special-state) +(defvar display-time-string) +(defvar edebug-execution-mode) +(defvar eglot--managed-mode) +(defvar erc-modified-channels-alist) +(defvar evil-ex-active-highlights-alist) +(defvar evil-ex-argument) +(defvar evil-ex-range) +(defvar evil-mc-frozen) +(defvar evil-state) +(defvar evil-visual-beginning) +(defvar evil-visual-end) +(defvar evil-visual-selection) +(defvar flycheck--automatically-enabled-checkers) +(defvar flycheck-current-errors) +(defvar flycheck-mode-menu-map) +(defvar flymake--mode-line-format) +(defvar flymake--state) +(defvar flymake-menu) +(defvar gnus-newsrc-alist) +(defvar gnus-newsrc-hashtb) +(defvar grip--process) +(defvar helm--mode-line-display-prefarg) +(defvar iedit-occurrences-overlays) +(defvar kele-menu-map) +(defvar meow--indicator) +(defvar minions-mode-line-lighter) +(defvar minions-mode-line-minor-modes-map) +(defvar mlscroll-minimum-current-width) +(defvar mlscroll-right-align) +(defvar mu4e--modeline-item) +(defvar mu4e-alert-mode-line) +(defvar mu4e-alert-modeline-formatter) +(defvar mu4e-modeline-mode) +(defvar nyan-minimum-window-width) +(defvar objed--obj-state) +(defvar objed--object) +(defvar objed-modeline-setup-func) +(defvar persp-nil-name) +(defvar phi-replace--mode-line-format) +(defvar phi-search--overlays) +(defvar phi-search--selection) +(defvar phi-search-mode-line-format) +(defvar poke-line-minimum-window-width) +(defvar rcirc-activity) +(defvar sml-modeline-len) +(defvar symbol-overlay-keywords-alist) +(defvar symbol-overlay-temp-symbol) +(defvar text-scale-mode-amount) +(defvar tracking-buffers) +(defvar winum-auto-setup-mode-line) +(defvar xah-fly-insert-state-p) + +(declare-function anzu--reset-status "ext:anzu") +(declare-function anzu--where-is-here "ext:anzu") +(declare-function async-inject-variables "ext:async") +(declare-function async-start "ext:async") +(declare-function avy-traverse "ext:avy") +(declare-function avy-tree "ext:avy") +(declare-function aw-update "ext:ace-window") +(declare-function aw-window-list "ext:ace-window") +(declare-function battery-format "battery") +(declare-function battery-update "battery") +(declare-function boon-modeline-string "ext:boon") +(declare-function boon-state-string "ext:boon") +(declare-function cider--connection-info "ext:cider") +(declare-function cider-connected-p "ext:cider") +(declare-function cider-current-repl "ext:cider") +(declare-function cider-jack-in "ext:cider") +(declare-function cider-quit "ext:cider") +(declare-function citre-mode "ext:citre-basic-tools") +(declare-function compilation-goto-in-progress-buffer "compile") +(declare-function dap--cur-session "ext:dap-mode") +(declare-function dap--debug-session-name "ext:dap-mode") +(declare-function dap--debug-session-state "ext:dap-mode") +(declare-function dap--session-running "ext:dap-mode") +(declare-function dap-debug-recent "ext:dap-mode") +(declare-function dap-disconnect "ext:dap-mode") +(declare-function dap-hydra "ext:dap-hydra") +(declare-function edebug-help "edebug") +(declare-function edebug-next-mode "edebug") +(declare-function edebug-stop "edebug") +(declare-function eglot "ext:eglot") +(declare-function eglot--major-modes "ext:eglot" t t) +(declare-function eglot--project-nickname "ext:eglot" t t) +(declare-function eglot-clear-status "ext:eglot") +(declare-function eglot-current-server "ext:eglot") +(declare-function eglot-events-buffer "ext:eglot") +(declare-function eglot-forget-pending-continuations "ext:eglot") +(declare-function eglot-managed-p "ext:glot") +(declare-function eglot-reconnect "ext:eglot") +(declare-function eglot-shutdown "ext:eglot") +(declare-function eglot-stderr-buffer "ext:eglot") +(declare-function erc-switch-to-buffer "erc") +(declare-function erc-track-switch-buffer "erc-track") +(declare-function evil-delimited-arguments "ext:evil-common") +(declare-function evil-emacs-state-p "ext:evil-states" t t) +(declare-function evil-force-normal-state "ext:evil-commands" t t) +(declare-function evil-insert-state-p "ext:evil-states" t t) +(declare-function evil-motion-state-p "ext:evil-states" t t) +(declare-function evil-normal-state-p "ext:evil-states" t t) +(declare-function evil-operator-state-p "ext:evil-states" t t) +(declare-function evil-replace-state-p "ext:evil-states" t t) +(declare-function evil-state-property "ext:evil-common") +(declare-function evil-visual-state-p "ext:evil-states" t t) +(declare-function eyebrowse--get "ext:eyebrowse") +(declare-function face-remap-remove-relative "face-remap") +(declare-function fancy-narrow-active-p "ext:fancy-narrow") +(declare-function flycheck-buffer "ext:flycheck") +(declare-function flycheck-count-errors "ext:flycheck") +(declare-function flycheck-error-level-compilation-level "ext:flycheck") +(declare-function flycheck-list-errors "ext:flycheck") +(declare-function flycheck-next-error "ext:flycheck") +(declare-function flycheck-previous-error "ext:flycheck") +(declare-function flymake--diag-type "ext:flymake" t t) +(declare-function flymake--handle-report "ext:flymake") +(declare-function flymake--lookup-type-property "ext:flymake") +(declare-function flymake--state-diags "ext:flymake" t t) +(declare-function flymake-disabled-backends "ext:flymake") +(declare-function flymake-goto-next-error "ext:flymake") +(declare-function flymake-goto-prev-error "ext:flymake") +(declare-function flymake-reporting-backends "ext:flymake") +(declare-function flymake-running-backends "ext:flymake") +(declare-function flymake-show-buffer-diagnostics "ext:flymake") +(declare-function flymake-show-buffer-diagnostics "ext:flymake") +(declare-function flymake-start "ext:flymake") +(declare-function follow-all-followers "follow") +(declare-function gnus-demon-add-handler "gnus-demon") +(declare-function grip--preview-url "ext:grip-mode") +(declare-function grip-browse-preview "ext:grip-mode") +(declare-function grip-restart-preview "ext:grip-mode") +(declare-function grip-stop-preview "ext:grip-mode") +(declare-function helm-candidate-number-at-point "ext:helm-core") +(declare-function helm-get-candidate-number "ext:helm-core") +(declare-function iedit-find-current-occurrence-overlay "ext:iedit-lib") +(declare-function iedit-prev-occurrence "ext:iedit-lib") +(declare-function image-get-display-property "image-mode") +(declare-function jsonrpc--request-continuations "ext:jsonrpc" t t) +(declare-function jsonrpc-last-error "ext:jsonrpc" t t) +(declare-function kele-current-context-name "ext:kele") +(declare-function kele-current-namespace "ext:kele") +(declare-function lsp--workspace-print "ext:lsp-mode") +(declare-function lsp-describe-session "ext:lsp-mode") +(declare-function lsp-workspace-folders-open "ext:lsp-mode") +(declare-function lsp-workspace-restart "ext:lsp-mode") +(declare-function lsp-workspace-shutdown "ext:lsp-mode") +(declare-function lsp-workspaces "ext:lsp-mode") +(declare-function lv-message "ext:lv") +(declare-function mc/num-cursors "ext:multiple-cursors-core") +(declare-function meow--current-state "ext:meow") +(declare-function meow-beacon-mode-p "ext:meow") +(declare-function meow-insert-mode-p "ext:meow") +(declare-function meow-keypad-mode-p "ext:meow") +(declare-function meow-motion-mode-p "ext:meow") +(declare-function meow-normal-mode-p "ext:meow") +(declare-function minions--prominent-modes "ext:minions") +(declare-function mlscroll-mode-line "ext:mlscroll") +(declare-function mu4e--modeline-string "ext:mu4e-modeline") +(declare-function mu4e-alert-default-mode-line-formatter "ext:mu4e-alert") +(declare-function mu4e-alert-enable-mode-line-display "ext:mu4e-alert") +(declare-function nyan-create "ext:nyan-mode") +(declare-function org-edit-src-save "ext:org-src") +(declare-function parrot-create "ext:parrot") +(declare-function pdf-cache-number-of-pages "ext:pdf-cache" t t) +(declare-function persp-add-buffer "ext:persp-mode") +(declare-function persp-contain-buffer-p "ext:persp-mode") +(declare-function persp-switch "ext:persp-mode") +(declare-function phi-search--initialize "ext:phi-search") +(declare-function poke-line-create "ext:poke-line") +(declare-function popup-create "ext:popup") +(declare-function popup-delete "ext:popup") +(declare-function rcirc-next-active-buffer "rcirc") +(declare-function rcirc-short-buffer-name "rcirc") +(declare-function rcirc-switch-to-server-buffer "rcirc") +(declare-function rcirc-window-configuration-change "rcirc") +(declare-function rime--should-enable-p "ext:rime") +(declare-function rime--should-inline-ascii-p "ext:rime") +(declare-function sml-modeline-create "ext:sml-modeline") +(declare-function svg-circle "svg") +(declare-function svg-create "svg") +(declare-function svg-image "svg") +(declare-function svg-line "svg") +(declare-function symbol-overlay-assoc "ext:symbol-overlay") +(declare-function symbol-overlay-get-list "ext:symbol-overlay") +(declare-function symbol-overlay-get-symbol "ext:symbol-overlay") +(declare-function symbol-overlay-rename "ext:symbol-overlay") +(declare-function tab-bar--current-tab "tab-bar") +(declare-function tab-bar--current-tab-index "tab-bar") +(declare-function tracking-next-buffer "ext:tracking") +(declare-function tracking-previous-buffer "ext:tracking") +(declare-function tracking-shorten "ext:tracking") +(declare-function undo-tree-redo-1 "ext:undo-tree") +(declare-function undo-tree-undo-1 "ext:undo-tree") +(declare-function warning-numeric-level "warnings") +(declare-function window-numbering-clear-mode-line "ext:window-numbering") +(declare-function window-numbering-get-number-string "ext:window-numbering") +(declare-function window-numbering-install-mode-line "ext:window-numbering") +(declare-function winum--clear-mode-line "ext:winum") +(declare-function winum--install-mode-line "ext:winum") +(declare-function winum-get-number-string "ext:winum") + + + +;; +;; Buffer information +;; + +(defvar-local doom-modeline--buffer-file-icon nil) +(defun doom-modeline-update-buffer-file-icon (&rest _) + "Update file icon in mode-line." + (setq doom-modeline--buffer-file-icon + (when (and doom-modeline-major-mode-icon + (doom-modeline-icon-displayable-p)) + (let ((icon (doom-modeline-icon-for-buffer))) + (propertize (if (or (null icon) (symbolp icon)) + (doom-modeline-icon 'faicon "nf-fa-file_o" nil nil + :face 'nerd-icons-dsilver) + (doom-modeline-propertize-icon icon)) + 'help-echo (format "Major-mode: %s" (format-mode-line mode-name))))))) +(add-hook 'find-file-hook #'doom-modeline-update-buffer-file-icon) +(add-hook 'after-change-major-mode-hook #'doom-modeline-update-buffer-file-icon) +(add-hook 'clone-indirect-buffer-hook #'doom-modeline-update-buffer-file-icon) + +(doom-modeline-add-variable-watcher + 'doom-modeline-icon + (lambda (_sym val op _where) + (when (eq op 'set) + (setq doom-modeline-icon val) + (dolist (buf (buffer-list)) + (with-current-buffer buf + (doom-modeline-update-buffer-file-icon)))))) + +(defun doom-modeline-buffer-file-state-icon (icon unicode text face) + "Displays an ICON of buffer state with FACE. +UNICODE and TEXT are the alternatives if it is not applicable. +Uses `nerd-icons-mdicon' to fetch the icon." + (doom-modeline-icon 'mdicon icon unicode text :face face)) + +(defvar-local doom-modeline--buffer-file-state-icon nil) +(defun doom-modeline-update-buffer-file-state-icon (&rest _) + "Update the buffer or file state in mode-line." + (setq doom-modeline--buffer-file-state-icon + (when doom-modeline-buffer-state-icon + (ignore-errors + (concat + (cond (buffer-read-only + (doom-modeline-buffer-file-state-icon + "nf-md-lock" "🔒" "%1*" + 'doom-modeline-warning)) + ((and buffer-file-name (buffer-modified-p) + doom-modeline-buffer-modification-icon) + (doom-modeline-buffer-file-state-icon + "nf-md-content_save_edit" "💾" "%1*" + 'doom-modeline-warning)) + ((and buffer-file-name + ;; Avoid freezing while connection is lost + (not (file-remote-p buffer-file-name)) + (not (file-exists-p buffer-file-name))) + (doom-modeline-buffer-file-state-icon + "nf-md-cancel" "🚫" "!" + 'doom-modeline-urgent)) + (t "")) + (when (or (buffer-narrowed-p) + (and (bound-and-true-p fancy-narrow-mode) + (fancy-narrow-active-p)) + (bound-and-true-p dired-narrow-mode)) + (doom-modeline-buffer-file-state-icon + "nf-md-unfold_less_horizontal" "↕" "><" + 'doom-modeline-warning))))))) + +(defvar-local doom-modeline--buffer-file-name nil) +(defun doom-modeline-update-buffer-file-name (&rest _) + "Update buffer file name in mode-line." + (setq doom-modeline--buffer-file-name + (ignore-errors + (save-match-data + (if buffer-file-name + (doom-modeline-buffer-file-name) + (propertize "%b" + 'face 'doom-modeline-buffer-file + 'mouse-face 'doom-modeline-highlight + 'help-echo "Buffer name +mouse-1: Previous buffer\nmouse-3: Next buffer" + 'local-map mode-line-buffer-identification-keymap)))))) +(add-hook 'find-file-hook #'doom-modeline-update-buffer-file-name) +(add-hook 'after-save-hook #'doom-modeline-update-buffer-file-name) +(add-hook 'clone-indirect-buffer-hook #'doom-modeline-update-buffer-file-name) +(add-hook 'evil-insert-state-exit-hook #'doom-modeline-update-buffer-file-name) +(add-hook 'Info-selection-hook #'doom-modeline-update-buffer-file-name) +(advice-add #'rename-buffer :after #'doom-modeline-update-buffer-file-name) +(advice-add #'set-visited-file-name :after #'doom-modeline-update-buffer-file-name) +(advice-add #'pop-to-buffer :after #'doom-modeline-update-buffer-file-name) +(advice-add #'popup-create :after #'doom-modeline-update-buffer-file-name) +(advice-add #'popup-delete :after #'doom-modeline-update-buffer-file-name) +;; (advice-add #'primitive-undo :after #'doom-modeline-update-buffer-file-name) +;; (advice-add #'set-buffer-modified-p :after #'doom-modeline-update-buffer-file-name) + +(with-no-warnings + (if (boundp 'after-focus-change-function) + (progn + (advice-add #'handle-switch-frame :after #'doom-modeline-update-buffer-file-name) + (add-function :after after-focus-change-function #'doom-modeline-update-buffer-file-name)) + (progn + (add-hook 'focus-in-hook #'doom-modeline-update-buffer-file-name) + (add-hook 'focus-out-hook #'doom-modeline-update-buffer-file-name)))) + +(doom-modeline-add-variable-watcher + 'doom-modeline-buffer-file-name-style + (lambda (_sym val op _where) + (when (eq op 'set) + (setq doom-modeline-buffer-file-name-style val) + (dolist (buf (buffer-list)) + (with-current-buffer buf + (when buffer-file-name + (doom-modeline-update-buffer-file-name))))))) + +(defsubst doom-modeline--buffer-mode-icon () + "The icon of the current major mode." + (when (and doom-modeline-icon doom-modeline-major-mode-icon) + (when-let ((icon (or doom-modeline--buffer-file-icon + (doom-modeline-update-buffer-file-icon)))) + (unless (string-empty-p icon) + (concat + (if doom-modeline-major-mode-color-icon + (doom-modeline-display-icon icon) + (doom-modeline-propertize-icon + icon + (doom-modeline-face))) + (doom-modeline-vspc)))))) + +(defsubst doom-modeline--buffer-state-icon () + "The icon of the current buffer state." + (when doom-modeline-buffer-state-icon + (when-let ((icon (doom-modeline-update-buffer-file-state-icon))) + (unless (string-empty-p icon) + (concat + (doom-modeline-display-icon icon) + (doom-modeline-vspc)))))) + +(defsubst doom-modeline--buffer-simple-name () + "The buffer simple name." + (propertize "%b" + 'face (doom-modeline-face + (if (and doom-modeline-highlight-modified-buffer-name + (buffer-modified-p)) + 'doom-modeline-buffer-modified + 'doom-modeline-buffer-file)) + 'mouse-face 'doom-modeline-highlight + 'help-echo "Buffer name +mouse-1: Previous buffer\nmouse-3: Next buffer" + 'local-map mode-line-buffer-identification-keymap)) + +(defsubst doom-modeline--buffer-name () + "The current buffer name." + (when doom-modeline-buffer-name + (if (and (not (eq doom-modeline-buffer-file-name-style 'file-name)) + doom-modeline--limited-width-p) + ;; Only display the buffer name if the window is small, and doesn't + ;; need to respect file-name style. + (doom-modeline--buffer-simple-name) + (when-let ((name (or doom-modeline--buffer-file-name + (doom-modeline-update-buffer-file-name)))) + ;; Check if the buffer is modified + (if (and doom-modeline-highlight-modified-buffer-name + (buffer-modified-p)) + (propertize name 'face (doom-modeline-face 'doom-modeline-buffer-modified)) + (doom-modeline-display-text name)))))) + +(doom-modeline-def-segment buffer-info + "Combined information about the current buffer. + +Including the current working directory, the file name, and its state (modified, +read-only or non-existent)." + (concat + (doom-modeline-spc) + (doom-modeline--buffer-mode-icon) + (doom-modeline--buffer-state-icon) + (doom-modeline--buffer-name))) + +(doom-modeline-def-segment buffer-info-simple + "Display only the current buffer's name, but with fontification." + (concat + (doom-modeline-spc) + (doom-modeline--buffer-mode-icon) + (doom-modeline--buffer-state-icon) + (doom-modeline--buffer-simple-name))) + +(doom-modeline-def-segment calc + "Display calculator icons and info." + (concat + (doom-modeline-spc) + (when-let ((icon (doom-modeline-icon 'faicon "nf-fa-calculator" "🖩" ""))) + (concat + (doom-modeline-display-icon icon) + (doom-modeline-vspc))) + (doom-modeline--buffer-simple-name))) + +(doom-modeline-def-segment buffer-default-directory + "Displays `default-directory' with the icon and state. + +This is for special buffers like the scratch buffer where knowing the current +project directory is important." + (let ((face (doom-modeline-face + (if (and buffer-file-name (buffer-modified-p)) + 'doom-modeline-buffer-modified + 'doom-modeline-buffer-path)))) + (concat + (doom-modeline-spc) + (and doom-modeline-major-mode-icon + (concat + (doom-modeline-icon + 'octicon "nf-oct-file_directory_fill" "🖿" "" :face face) + (doom-modeline-vspc))) + (doom-modeline--buffer-state-icon) + (propertize (abbreviate-file-name default-directory) 'face face)))) + +(doom-modeline-def-segment buffer-default-directory-simple + "Displays `default-directory'. + +This is for special buffers like the scratch buffer where knowing the current +project directory is important." + (let ((face (doom-modeline-face 'doom-modeline-buffer-path))) + (concat + (doom-modeline-spc) + (and doom-modeline-major-mode-icon + (concat + (doom-modeline-icon + 'octicon "nf-oct-file_directory_fill" "🖿" "" :face face) + (doom-modeline-vspc))) + (propertize (abbreviate-file-name default-directory) 'face face)))) + + +;; +;; Encoding +;; + +(doom-modeline-def-segment buffer-encoding + "Displays the eol and the encoding style of the buffer." + (when doom-modeline-buffer-encoding + (let ((sep (doom-modeline-spc)) + (face (doom-modeline-face)) + (mouse-face 'doom-modeline-highlight)) + (concat + sep + + ;; eol type + (let ((eol (coding-system-eol-type buffer-file-coding-system))) + (when (or (eq doom-modeline-buffer-encoding t) + (and (eq doom-modeline-buffer-encoding 'nondefault) + (not (equal eol doom-modeline-default-eol-type)))) + (propertize + (pcase eol + (0 "LF ") + (1 "CRLF ") + (2 "CR ") + (_ "")) + 'face face + 'mouse-face mouse-face + 'help-echo (format "End-of-line style: %s\nmouse-1: Cycle" + (pcase eol + (0 "Unix-style LF") + (1 "DOS-style CRLF") + (2 "Mac-style CR") + (_ "Undecided"))) + 'local-map (let ((map (make-sparse-keymap))) + (define-key map [mode-line mouse-1] 'mode-line-change-eol) + map)))) + + ;; coding system + (let* ((sys (coding-system-plist buffer-file-coding-system)) + (cat (plist-get sys :category)) + (sym (if (memq cat + '(coding-category-undecided coding-category-utf-8)) + 'utf-8 + (plist-get sys :name)))) + (when (or (eq doom-modeline-buffer-encoding t) + (and (eq doom-modeline-buffer-encoding 'nondefault) + (not (eq cat 'coding-category-undecided)) + (not (eq sym doom-modeline-default-coding-system)))) + (propertize + (upcase (symbol-name sym)) + 'face face + 'mouse-face mouse-face + 'help-echo 'mode-line-mule-info-help-echo + 'local-map mode-line-coding-system-map))) + + sep)))) + + +;; +;; Indentation +;; + +(doom-modeline-def-segment indent-info + "Displays the indentation information." + (when doom-modeline-indent-info + (let ((do-propertize + (lambda (mode size) + (propertize + (format " %s %d " mode size) + 'face (doom-modeline-face))))) + (if indent-tabs-mode + (funcall do-propertize "TAB" tab-width) + (let ((lookup-var + (seq-find (lambda (var) + (and var (boundp var) (symbol-value var))) + (cdr (assoc major-mode doom-modeline-indent-alist)) nil))) + (funcall do-propertize "SPC" + (if lookup-var + (symbol-value lookup-var) + tab-width))))))) + +;; +;; Remote host +;; + +(doom-modeline-def-segment remote-host + "Hostname for remote buffers." + (when default-directory + (when-let ((host (file-remote-p default-directory 'host))) + (propertize + (concat "@" host) + 'face (doom-modeline-face 'doom-modeline-host))))) + + +;; +;; Major mode +;; + +(doom-modeline-def-segment major-mode + "The major mode, including environment and text-scale info." + (let ((sep (doom-modeline-spc)) + (face (doom-modeline-face 'doom-modeline-buffer-major-mode))) + (concat + sep + (propertize (concat + (format-mode-line + (or (and (boundp 'delighted-modes) + (cadr (assq major-mode delighted-modes))) + mode-name)) + (when (and doom-modeline-env-version doom-modeline-env--version) + (format " %s" doom-modeline-env--version))) + 'help-echo "Major mode\n\ +mouse-1: Display major mode menu\n\ +mouse-2: Show help for major mode\n\ +mouse-3: Toggle minor modes" + 'face face + 'mouse-face 'doom-modeline-highlight + 'local-map mode-line-major-mode-keymap) + (and (boundp 'text-scale-mode-amount) + (/= text-scale-mode-amount 0) + (propertize + (format + (if (> text-scale-mode-amount 0) " (%+d)" " (%-d)") + text-scale-mode-amount) + 'face face)) + sep))) + + +;; +;; Process +;; + +(doom-modeline-def-segment process + "The process info." + (doom-modeline-display-text + (format-mode-line mode-line-process))) + + +;; +;; Minor modes +;; + +(doom-modeline-def-segment minor-modes + (when doom-modeline-minor-modes + (let ((sep (doom-modeline-spc)) + (face (doom-modeline-face 'doom-modeline-buffer-minor-mode)) + (mouse-face 'doom-modeline-highlight) + (help-echo "Minor mode + mouse-1: Display minor mode menu + mouse-2: Show help for minor mode + mouse-3: Toggle minor modes")) + (if (bound-and-true-p minions-mode) + `((:propertize ("" ,(minions--prominent-modes)) + face ,face + mouse-face ,mouse-face + help-echo ,help-echo + local-map ,mode-line-minor-mode-keymap) + ,sep + (:propertize ("" ,(doom-modeline-icon 'octicon "nf-oct-gear" "⚙" + minions-mode-line-lighter + :face face)) + mouse-face ,mouse-face + help-echo "Minions +mouse-1: Display minor modes menu" + local-map ,minions-mode-line-minor-modes-map) + ,sep) + `((:propertize ("" minor-mode-alist) + face ,face + mouse-face ,mouse-face + help-echo ,help-echo + local-map ,mode-line-minor-mode-keymap) + ,sep))))) + + +;; +;; VCS +;; + +(defun doom-modeline-vcs-icon (icon &optional unicode text face) + "Displays the vcs ICON with FACE and VOFFSET. + +UNICODE and TEXT are fallbacks. +Uses `nerd-icons-octicon' to fetch the icon." + (doom-modeline-icon 'devicon (and doom-modeline-vcs-icon icon) + unicode text :face face)) + +(defvar-local doom-modeline--vcs nil) +(defun doom-modeline-update-vcs (&rest _) + "Update vcs state in mode-line." + (setq doom-modeline--vcs + (when (and vc-mode buffer-file-name) + (let* ((backend (vc-backend buffer-file-name)) + (state (vc-state buffer-file-name backend)) + (icon (cond ((memq state '(edited added)) + (doom-modeline-vcs-icon "nf-dev-git_compare" "🔃" "*" 'doom-modeline-info)) + ((eq state 'needs-merge) + (doom-modeline-vcs-icon "nf-dev-git_merge" "🔀" "?" 'doom-modeline-info)) + ((eq state 'needs-update) + (doom-modeline-vcs-icon "nf-dev-git_pull_request" "⬇" "!" 'doom-modeline-warning)) + ((memq state '(removed conflict unregistered)) + (doom-modeline-icon 'octicon "nf-oct-alert" "⚠" "!" :face 'doom-modeline-urgent)) + (t (doom-modeline-vcs-icon "nf-dev-git_branch" "" "@" 'doom-modeline-info)))) + (str (if vc-display-status + (substring vc-mode (+ (if (eq backend 'Hg) 2 3) 2)) + "")) + (face (cond ((eq state 'needs-update) + '(doom-modeline-warning bold)) + ((memq state '(removed conflict unregistered)) + '(doom-modeline-urgent bold)) + (t '(doom-modeline-info bold)))) + (text (propertize (if (length> str doom-modeline-vcs-max-length) + (concat + (substring str 0 (- doom-modeline-vcs-max-length 3)) + doom-modeline-ellipsis) + str) + 'face face))) + `((icon . ,icon) (text . ,text)))))) +(add-hook 'find-file-hook #'doom-modeline-update-vcs) +(add-hook 'after-save-hook #'doom-modeline-update-vcs) +(advice-add #'vc-refresh-state :after #'doom-modeline-update-vcs) + +(doom-modeline-add-variable-watcher + 'doom-modeline-icon + (lambda (_sym val op _where) + (when (eq op 'set) + (setq doom-modeline-icon val) + (dolist (buf (buffer-list)) + (with-current-buffer buf + (doom-modeline-update-vcs)))))) + +(doom-modeline-add-variable-watcher + 'doom-modeline-unicode-fallback + (lambda (_sym val op _where) + (when (eq op 'set) + (setq doom-modeline-unicode-fallback val) + (dolist (buf (buffer-list)) + (with-current-buffer buf + (doom-modeline-update-vcs)))))) + +(doom-modeline-add-variable-watcher + 'doom-modeline-vcs-icon + (lambda (_sym val op _where) + (when (eq op 'set) + (setq doom-modeline-vcs-icon val) + (dolist (buf (buffer-list)) + (with-current-buffer buf + (doom-modeline-update-vcs)))))) + +(doom-modeline-def-segment vcs + "Displays the current branch, colored based on its state." + (when doom-modeline--vcs + (let-alist doom-modeline--vcs + (let ((sep (doom-modeline-spc)) + (vsep (doom-modeline-vspc))) + (concat sep + (propertize (concat + (doom-modeline-display-icon .icon) + vsep + (doom-modeline-display-text .text)) + 'help-echo (get-text-property 1 'help-echo vc-mode) + 'mouse-face 'doom-modeline-highlight + 'local-map (get-text-property 1 'local-map vc-mode)) + sep))))) + + +;; +;; Check +;; + +(defun doom-modeline-check-icon (icon unicode text face) + "Displays the check ICON with FACE. + +UNICODE and TEXT are fallbacks. +Uses `nerd-icons-mdicon' to fetch the icon." + (doom-modeline-icon 'mdicon (and doom-modeline-check-icon icon) + unicode text :face face)) + +(defun doom-modeline-check-text (text &optional face) + "Displays the check TEXT with FACE." + (propertize text 'face (or face 'mode-line))) + +;; Flycheck + +(defun doom-modeline--flycheck-count-errors () + "Count the number of ERRORS, grouped by level. + +Return an alist, where each ITEM is a cons cell whose `car' is an +error level, and whose `cdr' is the number of errors of that +level." + (let ((info 0) (warning 0) (error 0)) + (mapc + (lambda (item) + (let ((count (cdr item))) + (pcase (flycheck-error-level-compilation-level (car item)) + (0 (cl-incf info count)) + (1 (cl-incf warning count)) + (2 (cl-incf error count))))) + (flycheck-count-errors flycheck-current-errors)) + `((info . ,info) (warning . ,warning) (error . ,error)))) + +(defvar-local doom-modeline--flycheck nil) +(defun doom-modeline-update-flycheck (&optional status) + "Update flycheck via STATUS." + (setq doom-modeline--flycheck + (let-alist (doom-modeline--flycheck-count-errors) + (let* ((vsep (doom-modeline-vspc)) + (seg (if doom-modeline-check-simple-format + (let ((count (+ .error .warning .info))) + (pcase status + ('finished (if (> count 0) + (let ((face (if (> .error 0) 'doom-modeline-urgent 'doom-modeline-warning))) + (concat + (doom-modeline-check-icon "nf-md-alert_circle_outline" "⚠" "!" face) + vsep + (doom-modeline-check-text (number-to-string count) face))) + (doom-modeline-check-icon "nf-md-check_circle_outline" "✔" "*" 'doom-modeline-info))) + ('running (concat + (doom-modeline-check-icon "nf-md-timer_sand" "⏳" "*" 'doom-modeline-debug) + (when (> count 0) + (concat + vsep + (doom-modeline-check-text (number-to-string count) 'doom-modeline-debug))))) + ('no-checker (doom-modeline-check-icon "nf-md-alert_box_outline" "⚠" "-" 'doom-modeline-debug)) + ('errored (doom-modeline-check-icon "nf-md-alert_box_outline" "⚠" "!" 'doom-modeline-urgent)) + ('interrupted (doom-modeline-check-icon "nf-md-pause_circle_outline" "⦷" "." 'doom-modeline-debug)) + ('suspicious (doom-modeline-check-icon "nf-md-file_question_outline" "❓" "?" 'doom-modeline-debug)) + (_ ""))) + (concat (doom-modeline-check-icon "nf-md-close_circle_outline" "⮾" "!" 'doom-modeline-urgent) + vsep + (doom-modeline-check-text (number-to-string .error) 'doom-modeline-urgent) + vsep + (doom-modeline-check-icon "nf-md-alert_outline" "⚠" "!" 'doom-modeline-warning) + vsep + (doom-modeline-check-text (number-to-string .warning) 'doom-modeline-warning) + vsep + (doom-modeline-check-icon "nf-md-information_outline" "🛈" "!" 'doom-modeline-info) + vsep + (doom-modeline-check-text (number-to-string .info) 'doom-modeline-info))))) + (propertize seg + 'help-echo (concat "Flycheck\n" + (pcase status + ('finished (format "error: %d, warning: %d, info: %d" .error .warning .info)) + ('running "Checking...") + ('no-checker "No Checker") + ('errored "Error") + ('interrupted "Interrupted") + ('suspicious "Suspicious")) + "\nmouse-1: Display minor mode menu\nmouse-2: Show help for minor mode") + 'mouse-face 'doom-modeline-highlight + 'local-map (let ((map (make-sparse-keymap))) + (define-key map [mode-line down-mouse-1] + flycheck-mode-menu-map) + (define-key map [mode-line mouse-2] + (lambda () + (interactive) + (describe-function 'flycheck-mode))) + map)))))) +(add-hook 'flycheck-status-changed-functions #'doom-modeline-update-flycheck) +(add-hook 'flycheck-mode-hook #'doom-modeline-update-flycheck) + +(doom-modeline-add-variable-watcher + 'doom-modeline-icon + (lambda (_sym val op _where) + (when (eq op 'set) + (setq doom-modeline-icon val) + (dolist (buf (buffer-list)) + (with-current-buffer buf + (when (bound-and-true-p flycheck-mode) + (doom-modeline-update-flycheck))))))) + +(doom-modeline-add-variable-watcher + 'doom-modeline-check-icon + (lambda (_sym val op _where) + (when (eq op 'set) + (setq doom-modeline-check-icon val) + (dolist (buf (buffer-list)) + (with-current-buffer buf + (when (bound-and-true-p flycheck-mode) + (doom-modeline-update-flycheck))))))) + +(doom-modeline-add-variable-watcher + 'doom-modeline-unicode-fallback + (lambda (_sym val op _where) + (when (eq op 'set) + (setq doom-modeline-unicode-fallback val) + (dolist (buf (buffer-list)) + (with-current-buffer buf + (when (bound-and-true-p flycheck-mode) + (doom-modeline-update-flycheck))))))) + +(doom-modeline-add-variable-watcher + 'doom-modeline-check-simple-format + (lambda (_sym val op _where) + (when (eq op 'set) + (setq doom-modeline-check-simple-format val) + (dolist (buf (buffer-list)) + (with-current-buffer buf + (when (bound-and-true-p flycheck-mode) + (doom-modeline-update-flycheck))))))) + +;; Flymake + +;; Compatibility +;; @see https://github.com/emacs-mirror/emacs/commit/6e100869012da9244679696634cab6b9cac96303. +(with-eval-after-load 'flymake + (unless (boundp 'flymake--state) + (defvaralias 'flymake--state 'flymake--backend-state)) + (unless (fboundp 'flymake--state-diags) + (defalias 'flymake--state-diags 'flymake--backend-state-diags))) + +(defun doom-modeline--flymake-count-errors () + "Count the number of ERRORS, grouped by level." + (let ((warning-level (warning-numeric-level :warning)) + (note-level (warning-numeric-level :debug)) + (note 0) (warning 0) (error 0)) + (maphash (lambda (_b state) + (cl-loop + with diags = (flymake--state-diags state) + for diag in diags do + (let ((severity (flymake--lookup-type-property (flymake--diag-type diag) 'severity + (warning-numeric-level :error)))) + (cond ((> severity warning-level) (cl-incf error)) + ((> severity note-level) (cl-incf warning)) + (t (cl-incf note)))))) + flymake--state) + `((note . ,note) (warning . ,warning) (error . ,error)))) + +(defvar-local doom-modeline--flymake nil) +(defun doom-modeline-update-flymake (&rest _) + "Update flymake." + (setq doom-modeline--flymake + (let* ((known (hash-table-keys flymake--state)) + (running (flymake-running-backends)) + (disabled (flymake-disabled-backends)) + (reported (flymake-reporting-backends)) + (all-disabled (and disabled (null running))) + (some-waiting (cl-set-difference running reported))) + (let-alist (doom-modeline--flymake-count-errors) + (let* ((vsep (doom-modeline-vspc)) + (seg (if doom-modeline-check-simple-format + (let ((count (+ .error .warning .note))) + (cond + (some-waiting (concat + (doom-modeline-check-icon "nf-md-timer_sand" "⏳" "*" 'doom-modeline-debug) + (when (> count 0) + (concat + vsep + (doom-modeline-check-text (number-to-string count) 'doom-modeline-debug))))) + ((null known) (doom-modeline-check-icon "nf-md-alert_box_outline" "⚠" "!" 'doom-modeline-urgent)) + (all-disabled (doom-modeline-check-icon "nf-md-alert_box_outline" "⚠" "!" 'doom-modeline-warning)) + (t (if (> count 0) + (let ((face (cond ((> .error 0) 'doom-modeline-urgent) + ((> .warning 0) 'doom-modeline-warning) + (t 'doom-modeline-info)))) + (concat + (doom-modeline-check-icon "nf-md-alert_circle_outline" "⚠" "!" face) + vsep + (doom-modeline-check-text (number-to-string count) face))) + (doom-modeline-check-icon "nf-md-check_circle_outline" "✔" "*" 'doom-modeline-info))))) + (concat + (doom-modeline-check-icon "nf-md-close_circle_outline" "⮾" "!" 'doom-modeline-urgent) + vsep + (doom-modeline-check-text (number-to-string .error) 'doom-modeline-urgent) + vsep + (doom-modeline-check-icon "nf-md-alert_outline" "⚠" "!" 'doom-modeline-warning) + vsep + (doom-modeline-check-text (number-to-string .warning) 'doom-modeline-warning) + vsep + (doom-modeline-check-icon "nf-md-information_outline" "🛈" "!" 'doom-modeline-info) + vsep + (doom-modeline-check-text (number-to-string .note) 'doom-modeline-info))))) + (propertize + seg + 'help-echo (concat + "Flymake\n" + (cond (some-waiting "Checking...") + ((null known) "No Checker") + (all-disabled "All Checkers Disabled") + (t (format "%d/%d backends running\nerror: %d, warning: %d, note: %d" + (length running) (length known) .error .warning .note))) + "\nmouse-1: Display minor mode menu\nmouse-2: Show help for minor mode") + 'mouse-face 'doom-modeline-highlight + 'local-map (let ((map (make-sparse-keymap))) + (define-key map [mode-line down-mouse-1] + flymake-menu) + (define-key map [mode-line mouse-2] + (lambda () + (interactive) + (describe-function 'flymake-mode))) + map))))))) +(advice-add #'flymake--handle-report :after #'doom-modeline-update-flymake) + +(doom-modeline-add-variable-watcher + 'doom-modeline-icon + (lambda (_sym val op _where) + (when (eq op 'set) + (setq doom-modeline-icon val) + (dolist (buf (buffer-list)) + (with-current-buffer buf + (when (bound-and-true-p flymake-mode) + (doom-modeline-update-flymake))))))) + +(doom-modeline-add-variable-watcher + 'doom-modeline-check-icon + (lambda (_sym val op _where) + (when (eq op 'set) + (setq doom-modeline-check-icon val) + (dolist (buf (buffer-list)) + (with-current-buffer buf + (when (bound-and-true-p flymake-mode) + (doom-modeline-update-flymake))))))) + +(doom-modeline-add-variable-watcher + 'doom-modeline-unicode-fallback + (lambda (_sym val op _where) + (when (eq op 'set) + (setq doom-modeline-unicode-fallback val) + (dolist (buf (buffer-list)) + (with-current-buffer buf + (when (bound-and-true-p flymake-mode) + (doom-modeline-update-flymake))))))) + +(doom-modeline-add-variable-watcher + 'doom-modeline-check-simple-format + (lambda (_sym val op _where) + (when (eq op 'set) + (setq doom-modeline-check-simple-format val) + (dolist (buf (buffer-list)) + (with-current-buffer buf + (when (bound-and-true-p flymake-mode) + (doom-modeline-update-flymake))))))) + +(doom-modeline-def-segment check + "Displays color-coded error status in the current buffer with pretty icons." + (when-let ((sep (doom-modeline-spc)) + (vsep (doom-modeline-vspc)) + (seg (cond + ((and (bound-and-true-p flymake-mode) + (bound-and-true-p flymake--state)) ; only support 26+ + doom-modeline--flymake) + ((and (bound-and-true-p flycheck-mode) + (bound-and-true-p flycheck--automatically-enabled-checkers)) + doom-modeline--flycheck)))) + (concat + sep + (let ((str)) + (dolist (s (split-string seg " ")) + (setq str + (concat str + (if (string-match-p "^[0-9]+$" s) + (concat vsep + (doom-modeline-display-text s) + vsep) + (doom-modeline-display-icon s))))) + (propertize str + 'help-echo (get-text-property 0 'help-echo seg) + 'mouse-face 'doom-modeline-highlight + 'local-map (get-text-property 0 'local-map seg))) + sep))) + + +;; +;; Word Count +;; + +(doom-modeline-def-segment word-count + "The buffer word count. +Displayed when in a major mode in `doom-modeline-continuous-word-count-modes'. +Respects `doom-modeline-enable-word-count'." + (when (and doom-modeline-enable-word-count + (member major-mode doom-modeline-continuous-word-count-modes)) + (propertize (format " %dW" (count-words (point-min) (point-max))) + 'face (doom-modeline-face)))) + + +;; +;; Selection +;; + +(defsubst doom-modeline-column (pos) + "Get the column of the position `POS'." + (save-excursion (goto-char pos) + (current-column))) + +(doom-modeline-def-segment selection-info + "Information about the current selection. + +Such as how many characters and lines are selected, or the NxM dimensions of a +block selection." + (when (and (or mark-active (and (bound-and-true-p evil-local-mode) + (eq evil-state 'visual))) + (doom-modeline--active)) + (cl-destructuring-bind (beg . end) + (if (and (bound-and-true-p evil-local-mode) (eq evil-state 'visual)) + (cons evil-visual-beginning evil-visual-end) + (cons (region-beginning) (region-end))) + (propertize + (let ((lines (count-lines beg (min end (point-max))))) + (concat + " " + (cond ((or (bound-and-true-p rectangle-mark-mode) + (and (bound-and-true-p evil-visual-selection) + (eq 'block evil-visual-selection))) + (let ((cols (abs (- (doom-modeline-column end) + (doom-modeline-column beg))))) + (format "%dx%dB" lines cols))) + ((and (bound-and-true-p evil-visual-selection) + (eq evil-visual-selection 'line)) + (format "%dL" lines)) + ((> lines 1) + (format "%dC %dL" (- end beg) lines)) + (t + (format "%dC" (- end beg)))) + (when doom-modeline-enable-word-count + (format " %dW" (count-words beg end))) + " ")) + 'face 'doom-modeline-emphasis)))) + + +;; +;; Matches (macro, anzu, evil-substitute, iedit, symbol-overlay and multi-cursors) +;; + +(defsubst doom-modeline--macro-recording () + "Display current Emacs or evil macro being recorded." + (when (and (doom-modeline--active) + (or defining-kbd-macro executing-kbd-macro)) + (let ((sep (propertize " " 'face 'doom-modeline-panel)) + (vsep (propertize " " 'face + '(:inherit (doom-modeline-panel variable-pitch)))) + (macro-name (if (bound-and-true-p evil-this-macro) + (format " @%s " + (char-to-string evil-this-macro)) + "Macro"))) + (concat + sep + (if doom-modeline-always-show-macro-register + (propertize macro-name 'face 'doom-modeline-panel) + (concat + (doom-modeline-icon 'mdicon "nf-md-record" "●" + macro-name + :face '(:inherit (doom-modeline-urgent doom-modeline-panel)) + :v-adjust 0.15) + vsep + (doom-modeline-icon 'mdicon "nf-md-menu_right" "▶" ">" + :face 'doom-modeline-panel + :v-adjust 0.15))) + sep)))) + +;; `anzu' and `evil-anzu' expose current/total state that can be displayed in the +;; mode-line. +(defun doom-modeline-fix-anzu-count (positions here) + "Calulate anzu count via POSITIONS and HERE." + (cl-loop with i = 0 + for (start . end) in positions + do (cl-incf i) + when (and (>= here start) (<= here end)) + return i + finally return 0)) + +(advice-add #'anzu--where-is-here :override #'doom-modeline-fix-anzu-count) + +(setq anzu-cons-mode-line-p nil) ; manage modeline segment ourselves +;; Ensure anzu state is cleared when searches & iedit are done +(with-eval-after-load 'anzu + (add-hook 'isearch-mode-end-hook #'anzu--reset-status t) + (add-hook 'iedit-mode-end-hook #'anzu--reset-status) + (advice-add #'evil-force-normal-state :after #'anzu--reset-status) + ;; Fix matches segment mirroring across all buffers + (mapc #'make-variable-buffer-local + '(anzu--total-matched + anzu--current-position anzu--state anzu--cached-count + anzu--cached-positions anzu--last-command + anzu--last-isearch-string anzu--overflow-p))) + +(defsubst doom-modeline--anzu () + "Show the match index and total number thereof. +Requires `anzu', also `evil-anzu' if using `evil-mode' for compatibility with +`evil-search'." + (when (and (bound-and-true-p anzu--state) + (not (bound-and-true-p iedit-mode))) + (propertize + (let ((here anzu--current-position) + (total anzu--total-matched)) + (cond ((eq anzu--state 'replace-query) + (format " %d replace " anzu--cached-count)) + ((eq anzu--state 'replace) + (format " %d/%d " here total)) + (anzu--overflow-p + (format " %s+ " total)) + (t + (format " %s/%d " here total)))) + 'face (doom-modeline-face 'doom-modeline-panel)))) + +(defsubst doom-modeline--evil-substitute () + "Show number of matches for `evil-ex' in real time. +The number of matches contains substitutions and highlightings." + (when (and (bound-and-true-p evil-local-mode) + (or (assq 'evil-ex-substitute evil-ex-active-highlights-alist) + (assq 'evil-ex-global-match evil-ex-active-highlights-alist) + (assq 'evil-ex-buffer-match evil-ex-active-highlights-alist))) + (propertize + (let ((range (if evil-ex-range + (cons (car evil-ex-range) (cadr evil-ex-range)) + (cons (line-beginning-position) (line-end-position)))) + (pattern (car-safe (evil-delimited-arguments evil-ex-argument 2)))) + (if pattern + (format " %s matches " (how-many pattern (car range) (cdr range))) + " - ")) + 'face (doom-modeline-face 'doom-modeline-panel)))) + +(defun doom-modeline-themes--overlay-sort (a b) + "Sort overlay A and B." + (< (overlay-start a) (overlay-start b))) + +(defsubst doom-modeline--iedit () + "Show the number of iedit regions matches + what match you're on." + (when (and (bound-and-true-p iedit-mode) + (bound-and-true-p iedit-occurrences-overlays)) + (propertize + (let ((this-oc (or (let ((inhibit-message t)) + (iedit-find-current-occurrence-overlay)) + (save-excursion (iedit-prev-occurrence) + (iedit-find-current-occurrence-overlay)))) + (length (length iedit-occurrences-overlays))) + (format " %s/%d " + (if this-oc + (- length + (length (memq this-oc (sort (append iedit-occurrences-overlays nil) + #'doom-modeline-themes--overlay-sort))) + -1) + "-") + length)) + 'face (doom-modeline-face 'doom-modeline-panel)))) + +(defsubst doom-modeline--symbol-overlay () + "Show the number of matches for symbol overlay." + (when (and (doom-modeline--active) + (bound-and-true-p symbol-overlay-keywords-alist) + (not (bound-and-true-p symbol-overlay-temp-symbol)) + (not (bound-and-true-p iedit-mode))) + (let* ((keyword (symbol-overlay-assoc (symbol-overlay-get-symbol t))) + (symbol (car keyword)) + (before (symbol-overlay-get-list -1 symbol)) + (after (symbol-overlay-get-list 1 symbol)) + (count (length before))) + (if (symbol-overlay-assoc symbol) + (propertize + (format (concat " %d/%d " (and (cadr keyword) "in scope ")) + (+ count 1) + (+ count (length after))) + 'face (doom-modeline-face 'doom-modeline-panel)))))) + +(defsubst doom-modeline--multiple-cursors () + "Show the number of multiple cursors." + (cl-destructuring-bind (count . face) + (cond ((bound-and-true-p multiple-cursors-mode) + (cons (mc/num-cursors) + (doom-modeline-face 'doom-modeline-panel))) + ((bound-and-true-p evil-mc-cursor-list) + (cons (length evil-mc-cursor-list) + (doom-modeline-face (if evil-mc-frozen + 'doom-modeline-bar + 'doom-modeline-panel)))) + ((cons nil nil))) + (when count + (concat (propertize " " 'face face) + (if (doom-modeline-icon-displayable-p) + (doom-modeline-icon 'faicon "nf-fa-i_cursor" "" "" :face face) + (propertize "I" + 'face `(:inherit ,face :height 1.4 :weight normal) + 'display '(raise -0.1))) + (propertize " " + 'face `(:inherit (variable-pitch ,face))) + (propertize (format "%d " count) + 'face face))))) + +(defsubst doom-modeline--phi-search () + "Show the number of matches for `phi-search' and `phi-replace'." + (when (and (doom-modeline--active) + (bound-and-true-p phi-search--overlays)) + (let ((total (length phi-search--overlays)) + (selection phi-search--selection)) + (when selection + (propertize + (format " %d/%d " (1+ selection) total) + 'face (doom-modeline-face 'doom-modeline-panel)))))) + +(defun doom-modeline--override-phi-search (orig-fun &rest args) + "Override the mode-line of `phi-search' and `phi-replace'. +Apply ORIG-FUN with ARGS." + (if (bound-and-true-p doom-modeline-mode) + (apply orig-fun mode-line-format (cdr args)) + (apply orig-fun args))) +(advice-add #'phi-search--initialize :around #'doom-modeline--override-phi-search) + +(defsubst doom-modeline--buffer-size () + "Show buffer size." + (when size-indication-mode + (let ((sep (doom-modeline-spc))) + (concat sep + (propertize "%I" + 'face (doom-modeline-face) + 'help-echo "Buffer size +mouse-1: Display Line and Column Mode Menu" + 'mouse-face 'doom-modeline-highlight + 'local-map mode-line-column-line-number-mode-map) + sep)))) + +(doom-modeline-def-segment matches + "Displays matches. + +Including: +1. the currently recording macro, 2. A current/total for the +current search term (with `anzu'), 3. The number of substitutions being +conducted with `evil-ex-substitute', and/or 4. The number of active `iedit' +regions, 5. The current/total for the highlight term (with `symbol-overlay'), +6. The number of active `multiple-cursors'." + (let ((meta (concat (doom-modeline--macro-recording) + (doom-modeline--anzu) + (doom-modeline--phi-search) + (doom-modeline--evil-substitute) + (doom-modeline--iedit) + (doom-modeline--symbol-overlay) + (doom-modeline--multiple-cursors)))) + (or (and (not (string-empty-p meta)) meta) + (doom-modeline--buffer-size)))) + +(doom-modeline-def-segment buffer-size + "Display buffer size." + (doom-modeline--buffer-size)) + +;; +;; Media +;; + +(doom-modeline-def-segment media-info + "Metadata regarding the current file, such as dimensions for images." + ;; TODO: Include other information + (cond ((eq major-mode 'image-mode) + (cl-destructuring-bind (width . height) + (when (fboundp 'image-size) + (image-size (image-get-display-property) :pixels)) + (format " %dx%d " width height))))) + + +;; +;; Bars +;; + +(defvar doom-modeline--bar-active nil) +(defvar doom-modeline--bar-inactive nil) + +(defsubst doom-modeline--bar () + "The default bar regulates the height of the mode-line in GUI." + (unless (and doom-modeline--bar-active doom-modeline--bar-inactive) + (let ((width doom-modeline-bar-width) + (height (max doom-modeline-height (doom-modeline--font-height)))) + (setq doom-modeline--bar-active + (doom-modeline--create-bar-image 'doom-modeline-bar width height) + doom-modeline--bar-inactive + (doom-modeline--create-bar-image + 'doom-modeline-bar-inactive width height)))) + (if (doom-modeline--active) + doom-modeline--bar-active + doom-modeline--bar-inactive)) + +(defun doom-modeline-refresh-bars () + "Refresh mode-line bars on next redraw." + (setq doom-modeline--bar-active nil + doom-modeline--bar-inactive nil)) + +(cl-defstruct doom-modeline--hud-cache active inactive top-margin bottom-margin) + +(defsubst doom-modeline--hud () + "Powerline's hud segment reimplemented in the style of Doom's bar segment." + (let* ((ws (window-start)) + (we (window-end)) + (bs (buffer-size)) + (height (max doom-modeline-height (doom-modeline--font-height))) + (top-margin (if (zerop bs) + 0 + (/ (* height (1- ws)) bs))) + (bottom-margin (if (zerop bs) + 0 + (max 0 (/ (* height (- bs we 1)) bs)))) + (cache (or (window-parameter nil 'doom-modeline--hud-cache) + (set-window-parameter + nil + 'doom-modeline--hud-cache + (make-doom-modeline--hud-cache))))) + (unless (and (doom-modeline--hud-cache-active cache) + (doom-modeline--hud-cache-inactive cache) + (= top-margin (doom-modeline--hud-cache-top-margin cache)) + (= bottom-margin + (doom-modeline--hud-cache-bottom-margin cache))) + (setf (doom-modeline--hud-cache-active cache) + (doom-modeline--create-hud-image + 'doom-modeline-bar 'default doom-modeline-bar-width + height top-margin bottom-margin) + (doom-modeline--hud-cache-inactive cache) + (doom-modeline--create-hud-image + 'doom-modeline-bar-inactive 'default doom-modeline-bar-width + height top-margin bottom-margin) + (doom-modeline--hud-cache-top-margin cache) top-margin + (doom-modeline--hud-cache-bottom-margin cache) bottom-margin)) + (if (doom-modeline--active) + (doom-modeline--hud-cache-active cache) + (doom-modeline--hud-cache-inactive cache)))) + +(defun doom-modeline-invalidate-huds () + "Invalidate all cached hud images." + (dolist (frame (frame-list)) + (dolist (window (window-list frame)) + (set-window-parameter window 'doom-modeline--hud-cache nil)))) + +(doom-modeline-add-variable-watcher + 'doom-modeline-height + (lambda (_sym val op _where) + (when (and (eq op 'set) (integerp val)) + (doom-modeline-refresh-bars) + (doom-modeline-invalidate-huds)))) + +(doom-modeline-add-variable-watcher + 'doom-modeline-bar-width + (lambda (_sym val op _where) + (when (and (eq op 'set) (integerp val)) + (doom-modeline-refresh-bars) + (doom-modeline-invalidate-huds)))) + +(doom-modeline-add-variable-watcher + 'doom-modeline-icon + (lambda (_sym _val op _where) + (when (eq op 'set) + (doom-modeline-refresh-bars) + (doom-modeline-invalidate-huds)))) + +(doom-modeline-add-variable-watcher + 'doom-modeline-unicode-fallback + (lambda (_sym _val op _where) + (when (eq op 'set) + (doom-modeline-refresh-bars) + (doom-modeline-invalidate-huds)))) + +(add-hook 'window-configuration-change-hook #'doom-modeline-refresh-bars) +(add-hook 'window-configuration-change-hook #'doom-modeline-invalidate-huds) + +(doom-modeline-def-segment bar + "The bar regulates the height of the `doom-modeline' in GUI." + (when (display-graphic-p) + (concat + (if doom-modeline-hud + (doom-modeline--hud) + (doom-modeline--bar)) + (doom-modeline-spc)))) + +(doom-modeline-def-segment hud + "Powerline's hud segment reimplemented in the style of bar segment." + (when (display-graphic-p) + (concat + (doom-modeline--hud) + (doom-modeline-spc)))) + + +;; +;; Window number +;; + +;; HACK: `ace-window-display-mode' should respect the ignore buffers. +(defun doom-modeline-aw-update () + "Update ace-window-path window parameter for all windows. +Ensure all windows are labeled so the user can select a specific +one. The ignored buffers are excluded unless `aw-ignore-on' is nil." + (let ((ignore-window-parameters t)) + (avy-traverse + (avy-tree (aw-window-list) aw-keys) + (lambda (path leaf) + (set-window-parameter + leaf 'ace-window-path + (propertize + (apply #'string (reverse path)) + 'face 'aw-mode-line-face)))))) +(advice-add #'aw-update :override #'doom-modeline-aw-update) + +;; Remove original window number of `ace-window-display-mode'. +(add-hook 'ace-window-display-mode-hook + (lambda () + (setq-default mode-line-format + (assq-delete-all 'ace-window-display-mode + (default-value 'mode-line-format))))) + +(advice-add #'window-numbering-install-mode-line :override #'ignore) +(advice-add #'window-numbering-clear-mode-line :override #'ignore) +(advice-add #'winum--install-mode-line :override #'ignore) +(advice-add #'winum--clear-mode-line :override #'ignore) + +(doom-modeline-def-segment window-number + "The current window number." + (let ((num (cond + ((bound-and-true-p ace-window-display-mode) + (aw-update) + (window-parameter (selected-window) 'ace-window-path)) + ((bound-and-true-p winum-mode) + (setq winum-auto-setup-mode-line nil) + (winum-get-number-string)) + ((bound-and-true-p window-numbering-mode) + (window-numbering-get-number-string)) + (t "")))) + (when (and (length> num 0) + (length> (cl-mapcan + (lambda (frame) + ;; Exclude minibuffer, tooltip and child frames + (unless (or (and (fboundp 'frame-parent) (frame-parent frame)) + (string= (frame-parameter frame 'name) + (alist-get 'name (bound-and-true-p tooltip-frame-parameters)))) + (window-list frame 'never))) + (visible-frame-list)) + 1)) + (propertize (format " %s " num) + 'face (doom-modeline-face 'doom-modeline-buffer-major-mode))))) + + +;; +;; Workspace +;; + +(doom-modeline-def-segment workspace-name + "The current workspace name or number. +Requires `eyebrowse-mode' to be enabled or `tab-bar-mode' tabs to be created." + (when doom-modeline-workspace-name + (when-let + ((name (cond + ((and (bound-and-true-p eyebrowse-mode) + (length> (eyebrowse--get 'window-configs) 1)) + (setq mode-line-misc-info + (assq-delete-all 'eyebrowse-mode mode-line-misc-info)) + (when-let* + ((num (eyebrowse--get 'current-slot)) + (tag (nth 2 (assoc num (eyebrowse--get 'window-configs))))) + (if (length> tag 0) tag (int-to-string num)))) + ((and (fboundp 'tab-bar-mode) + (length> (frame-parameter nil 'tabs) 1)) + (let* ((current-tab (tab-bar--current-tab)) + (tab-index (tab-bar--current-tab-index)) + (explicit-name (alist-get 'explicit-name current-tab)) + (tab-name (alist-get 'name current-tab))) + (if explicit-name tab-name (+ 1 tab-index))))))) + (propertize (format " %s " name) + 'face (doom-modeline-face 'doom-modeline-buffer-major-mode))))) + + +;; +;; Perspective +;; + +(defvar-local doom-modeline--persp-name nil) +(defun doom-modeline-update-persp-name (&rest _) + "Update perspective name in mode-line." + (setq doom-modeline--persp-name + ;; Support `persp-mode', while not support `perspective' + (when (and doom-modeline-persp-name + (bound-and-true-p persp-mode) + (fboundp 'safe-persp-name) + (fboundp 'get-current-persp)) + (let* ((persp (get-current-persp)) + (name (safe-persp-name persp)) + (face (if (and persp + (not (persp-contain-buffer-p (current-buffer) persp))) + 'doom-modeline-persp-buffer-not-in-persp + 'doom-modeline-persp-name)) + (icon (doom-modeline-icon 'octicon "nf-oct-repo" "🖿" "#" + :face `(:inherit ,face :slant normal)))) + (when (or doom-modeline-display-default-persp-name + (not (string-equal persp-nil-name name))) + (concat " " + (propertize (concat (and doom-modeline-persp-icon + (concat icon + (propertize + " " + 'display '((space :relative-width 0.5))))) + (propertize name 'face face)) + 'help-echo "mouse-1: Switch perspective +mouse-2: Show help for minor mode" + 'mouse-face 'doom-modeline-highlight + 'local-map (let ((map (make-sparse-keymap))) + (define-key map [mode-line mouse-1] + #'persp-switch) + (define-key map [mode-line mouse-2] + (lambda () + (interactive) + (describe-function 'persp-mode))) + map)) + " ")))))) + +(add-hook 'buffer-list-update-hook #'doom-modeline-update-persp-name) +(add-hook 'find-file-hook #'doom-modeline-update-persp-name) +(add-hook 'persp-activated-functions #'doom-modeline-update-persp-name) +(add-hook 'persp-renamed-functions #'doom-modeline-update-persp-name) +(advice-add #'lv-message :after #'doom-modeline-update-persp-name) + +(doom-modeline-def-segment persp-name + "The current perspective name." + (when (doom-modeline--segment-visible 'persp-name) + doom-modeline--persp-name)) + + +;; +;; Misc info +;; + +(doom-modeline-def-segment misc-info + "Mode line construct for miscellaneous information. +By default, this shows the information specified by `global-mode-string'." + (when (and (doom-modeline--segment-visible 'misc-info) + (or doom-modeline-display-misc-in-all-mode-lines + (doom-modeline--active))) + (doom-modeline-display-text + (format-mode-line mode-line-misc-info)))) + + +;; +;; Position +;; + +(doom-modeline-def-segment buffer-position + "The buffer position information." + (let ((visible (doom-modeline--segment-visible 'buffer-position)) + (sep (doom-modeline-spc)) + (wsep (doom-modeline-wspc)) + (face (doom-modeline-face)) + (help-echo "Buffer percentage\n\ +mouse-1: Display Line and Column Mode Menu") + (mouse-face 'doom-modeline-highlight) + (local-map mode-line-column-line-number-mode-map)) + `(,wsep + + ;; Line and column + (:propertize + ((line-number-mode + (column-number-mode + (doom-modeline-column-zero-based + doom-modeline-position-column-line-format + ,(string-replace + "%c" "%C" (car doom-modeline-position-column-line-format))) + doom-modeline-position-line-format) + (column-number-mode + (doom-modeline-column-zero-based + doom-modeline-position-column-format + ,(string-replace + "%c" "%C" (car doom-modeline-position-column-format))))) + (doom-modeline-total-line-number + ,(format "/%d" (line-number-at-pos (point-max))))) + face ,face + help-echo ,help-echo + mouse-face ,mouse-face + local-map ,local-map) + + ((or line-number-mode column-number-mode) + ,sep) + + ;; Position + (,visible + ,(cond + ((and (bound-and-true-p nyan-mode) + (>= (window-width) nyan-minimum-window-width)) + (concat sep (nyan-create) sep)) + ((and (bound-and-true-p poke-line-mode) + (>= (window-width) poke-line-minimum-window-width)) + (concat sep (poke-line-create) sep)) + ((and (bound-and-true-p mlscroll-mode) + (>= (window-width) mlscroll-minimum-current-width)) + (concat + sep + (let ((mlscroll-right-align nil)) + (format-mode-line (mlscroll-mode-line))) + sep)) + ((and (bound-and-true-p sml-modeline-mode) + (>= (window-width) sml-modeline-len)) + (concat sep (sml-modeline-create) sep)) + (t ""))) + + ;; Percent position + (doom-modeline-percent-position + ((:propertize ("" doom-modeline-percent-position) + face ,face + help-echo ,help-echo + mouse-face ,mouse-face + local-map ,local-map) + ,sep))))) + +;; +;; Party parrot +;; +(doom-modeline-def-segment parrot + "The party parrot animated icon. Requires `parrot-mode' to be enabled." + (when (and (doom-modeline--segment-visible 'parrot) + (bound-and-true-p parrot-mode)) + (concat (doom-modeline-wspc) + (parrot-create) + (doom-modeline-spc)))) + +;; +;; Modals (evil, overwrite, god, ryo and xah-fly-keys, etc.) +;; + +(defun doom-modeline--modal-icon (text face help-echo &optional icon unicode) + "Display the model icon with FACE and HELP-ECHO. +TEXT is alternative if icon is not available." + (propertize (doom-modeline-icon + 'mdicon + (and doom-modeline-modal-icon + (or (and doom-modeline-modal-modern-icon icon) + "nf-md-record")) + (or (and doom-modeline-modal-modern-icon unicode) "●") + text + :face (doom-modeline-face face)) + 'help-echo help-echo)) + +(defsubst doom-modeline--evil () + "The current evil state. Requires `evil-mode' to be enabled." + (when (bound-and-true-p evil-local-mode) + (doom-modeline--modal-icon + (let ((tag (evil-state-property evil-state :tag t))) + (if (stringp tag) tag (funcall tag))) + (cond + ((evil-normal-state-p) 'doom-modeline-evil-normal-state) + ((evil-emacs-state-p) 'doom-modeline-evil-emacs-state) + ((evil-insert-state-p) 'doom-modeline-evil-insert-state) + ((evil-motion-state-p) 'doom-modeline-evil-motion-state) + ((evil-visual-state-p) 'doom-modeline-evil-visual-state) + ((evil-operator-state-p) 'doom-modeline-evil-operator-state) + ((evil-replace-state-p) 'doom-modeline-evil-replace-state) + (t 'doom-modeline-evil-normal-state)) + (evil-state-property evil-state :name t) + (cond + ((evil-normal-state-p) "nf-md-alpha_n_circle") + ((evil-emacs-state-p) "nf-md-alpha_e_circle") + ((evil-insert-state-p) "nf-md-alpha_i_circle") + ((evil-motion-state-p) "nf-md-alpha_m_circle") + ((evil-visual-state-p) "nf-md-alpha_v_circle") + ((evil-operator-state-p) "nf-md-alpha_o_circle") + ((evil-replace-state-p) "nf-md-alpha_r_circle") + (t "nf-md-alpha_n_circle")) + (cond + ((evil-normal-state-p) "🅝") + ((evil-emacs-state-p) "🅔") + ((evil-insert-state-p) "🅘") + ((evil-motion-state-p) "🅜") + ((evil-visual-state-p) "🅥") + ((evil-operator-state-p) "🅞") + ((evil-replace-state-p) "🅡") + (t "🅝"))))) + +(defsubst doom-modeline--overwrite () + "The current overwrite state which is enabled by command `overwrite-mode'." + (when (and (bound-and-true-p overwrite-mode) + (not (bound-and-true-p evil-local-mode))) + (doom-modeline--modal-icon + "<W>" 'doom-modeline-overwrite "Overwrite mode" + "nf-md-marker" "🅦"))) + +(defsubst doom-modeline--god () + "The current god state which is enabled by the command `god-mode'." + (when (bound-and-true-p god-local-mode) + (doom-modeline--modal-icon + "<G>" 'doom-modeline-god "God mode" + "nf-md-account_circle" "🅖"))) + +(defsubst doom-modeline--ryo () + "The current ryo-modal state which is enabled by the command `ryo-modal-mode'." + (when (bound-and-true-p ryo-modal-mode) + (doom-modeline--modal-icon + "<R>" 'doom-modeline-ryo "Ryo modal" + "nf-md-star_circle" "✪"))) + +(defsubst doom-modeline--xah-fly-keys () + "The current `xah-fly-keys' state." + (when (bound-and-true-p xah-fly-keys) + (if xah-fly-insert-state-p + (doom-modeline--modal-icon + "<I>" 'doom-modeline-fly-insert-state "Xah-fly insert mode" + "nf-md-airplane_edit" "🛧") + (doom-modeline--modal-icon + "<C>" 'doom-modeline-fly-normal-state "Xah-fly command mode" + "nf-md-airplane_cog" "🛧")))) + +(defsubst doom-modeline--boon () + "The current Boon state. Requires `boon-mode' to be enabled." + (when (bound-and-true-p boon-local-mode) + (doom-modeline--modal-icon + (boon-state-string) + (cond + (boon-command-state 'doom-modeline-boon-command-state) + (boon-insert-state 'doom-modeline-boon-insert-state) + (boon-special-state 'doom-modeline-boon-special-state) + (boon-off-state 'doom-modeline-boon-off-state) + (t 'doom-modeline-boon-off-state)) + (boon-modeline-string) + "nf-md-coffee" "🍵"))) + +(defsubst doom-modeline--meow () + "The current Meow state. Requires `meow-mode' to be enabled." + (when (bound-and-true-p meow-mode) + (doom-modeline--modal-icon + (symbol-name (meow--current-state)) + (cond + ((meow-normal-mode-p) 'doom-modeline-evil-normal-state) + ((meow-insert-mode-p) 'doom-modeline-evil-insert-state) + ((meow-beacon-mode-p) 'doom-modeline-evil-visual-state) + ((meow-motion-mode-p) 'doom-modeline-evil-motion-state) + ((meow-keypad-mode-p) 'doom-modeline-evil-operator-state) + (t 'doom-modeline-evil-normal-state)) + (symbol-name (meow--current-state)) + (cond + ((meow-normal-mode-p) "nf-md-alpha_n_circle") + ((meow-insert-mode-p) "nf-md-alpha_i_circle") + ((meow-beacon-mode-p) "nf-md-alpha_b_circle") + ((meow-motion-mode-p) "nf-md-alpha_m_circle") + ((meow-keypad-mode-p) "nf-md-alpha_k_circle") + (t "nf-md-alpha_n_circle")) + (cond + ((meow-normal-mode-p) "🅝") + ((meow-insert-mode-p) "🅘") + ((meow-beacon-mode-p) "🅑") + ((meow-motion-mode-p) "🅜") + ((meow-keypad-mode-p) "🅚") + (t "🅝"))))) + +(doom-modeline-def-segment modals + "Displays modal editing states. + +Including `evil', `overwrite', `god', `ryo' and `xha-fly-kyes', etc." + (when doom-modeline-modal + (let* ((evil (doom-modeline--evil)) + (ow (doom-modeline--overwrite)) + (god (doom-modeline--god)) + (ryo (doom-modeline--ryo)) + (xf (doom-modeline--xah-fly-keys)) + (boon (doom-modeline--boon)) + (vsep (doom-modeline-vspc)) + (meow (doom-modeline--meow)) + (sep (and (or evil ow god ryo xf boon) (doom-modeline-spc)))) + (concat sep + (and evil (concat evil (and (or ow god ryo xf boon meow) vsep))) + (and ow (concat ow (and (or god ryo xf boon meow) vsep))) + (and god (concat god (and (or ryo xf boon meow) vsep))) + (and ryo (concat ryo (and (or xf boon meow) vsep))) + (and xf (concat xf (and (or boon meow) vsep))) + (and boon (concat boon (and meow vsep))) + meow + sep)))) + +;; +;; Objed state +;; + +(defvar doom-modeline--objed-active nil) + +(defun doom-modeline-update-objed (_ &optional reset) + "Update `objed' status, inactive when RESET is true." + (setq doom-modeline--objed-active (not reset))) + +(setq objed-modeline-setup-func #'doom-modeline-update-objed) + +(doom-modeline-def-segment objed-state () + "The current objed state." + (when (and doom-modeline--objed-active + (doom-modeline--active)) + (propertize (format " %s(%s) " + (symbol-name objed--object) + (char-to-string (aref (symbol-name objed--obj-state) 0))) + 'face 'doom-modeline-evil-emacs-state + 'help-echo (format "Objed object: %s (%s)" + (symbol-name objed--object) + (symbol-name objed--obj-state))))) + + +;; +;; Input method +;; + +(doom-modeline-def-segment input-method + "The current input method." + (when-let ((im (cond + (current-input-method + current-input-method-title) + ((and (bound-and-true-p evil-local-mode) + (bound-and-true-p evil-input-method)) + (nth 3 (assoc default-input-method input-method-alist))) + (t nil))) + (sep (doom-modeline-spc))) + (concat + sep + (propertize im + 'face (doom-modeline-face + (if (and (bound-and-true-p rime-mode) + (equal current-input-method "rime")) + (if (and (rime--should-enable-p) + (not (rime--should-inline-ascii-p))) + 'doom-modeline-input-method + 'doom-modeline-input-method-alt) + 'doom-modeline-input-method)) + 'help-echo (concat + "Current input method: " + current-input-method + "\n\ +mouse-2: Disable input method\n\ +mouse-3: Describe current input method") + 'mouse-face 'doom-modeline-highlight + 'local-map mode-line-input-method-map) + sep))) + + +;; +;; Info +;; + +(doom-modeline-def-segment info-nodes + "The topic and nodes in the Info buffer." + (concat + " (" + ;; topic + (propertize (if (stringp Info-current-file) + (replace-regexp-in-string + "%" "%%" + (file-name-sans-extension + (file-name-nondirectory Info-current-file))) + (format "*%S*" Info-current-file)) + 'face (doom-modeline-face 'doom-modeline-info)) + ") " + ;; node + (when Info-current-node + (propertize (replace-regexp-in-string + "%" "%%" Info-current-node) + 'face (doom-modeline-face 'doom-modeline-buffer-path) + 'help-echo + "mouse-1: scroll forward, mouse-3: scroll back" + 'mouse-face 'doom-modeline-highlight + 'local-map Info-mode-line-node-keymap)))) + + +;; +;; REPL +;; + +(defun doom-modeline-repl-icon (text face) + "Display REPL icon (or TEXT in terminal) with FACE." + (doom-modeline-icon 'faicon "nf-fa-terminal" "$" text :face face)) + +(defvar doom-modeline--cider nil) + +(defun doom-modeline-update-cider () + "Update cider repl state." + (setq doom-modeline--cider + (let* ((connected (cider-connected-p)) + (face (if connected 'doom-modeline-repl-success 'doom-modeline-repl-warning)) + (repl-buffer (cider-current-repl nil nil)) + (cider-info (when repl-buffer + (cider--connection-info repl-buffer t))) + (icon (doom-modeline-repl-icon "REPL" face))) + (propertize icon + 'help-echo + (if connected + (format "CIDER Connected %s\nmouse-2: CIDER quit" cider-info) + "CIDER Disconnected\nmouse-1: CIDER jack-in") + 'mouse-face 'doom-modeline-highlight + 'local-map (let ((map (make-sparse-keymap))) + (if connected + (define-key map [mode-line mouse-2] + #'cider-quit) + (define-key map [mode-line mouse-1] + #'cider-jack-in)) + map))))) + +(add-hook 'cider-connected-hook #'doom-modeline-update-cider) +(add-hook 'cider-disconnected-hook #'doom-modeline-update-cider) +(add-hook 'cider-mode-hook #'doom-modeline-update-cider) + +(doom-modeline-def-segment repl + "The REPL state." + (when doom-modeline-repl + (when-let ((icon (when (bound-and-true-p cider-mode) + doom-modeline--cider)) + (sep (doom-modeline-spc))) + (concat + sep + (doom-modeline-display-icon icon) + sep)))) + + +;; +;; LSP +;; + +(defun doom-modeline-lsp-icon (text face) + "Display LSP icon (or TEXT in terminal) with FACE." + (if doom-modeline-lsp-icon + (doom-modeline-icon 'octicon "nf-oct-rocket" "🚀" text :face face) + (propertize text 'face face))) + +(defvar-local doom-modeline--lsp nil) +(defun doom-modeline-update-lsp (&rest _) + "Update `lsp-mode' state." + (setq doom-modeline--lsp + (let* ((workspaces (lsp-workspaces)) + (face (if workspaces 'doom-modeline-lsp-success 'doom-modeline-lsp-warning)) + (icon (doom-modeline-lsp-icon "LSP" face))) + (propertize icon + 'help-echo + (if workspaces + (concat "LSP Connected " + (string-join + (mapcar (lambda (w) + (format "[%s]\n" (lsp--workspace-print w))) + workspaces)) + "C-mouse-1: Switch to another workspace folder +mouse-1: Describe current session +mouse-2: Quit server +mouse-3: Reconnect to server") + "LSP Disconnected +mouse-1: Reload to start server") + 'mouse-face 'doom-modeline-highlight + 'local-map (let ((map (make-sparse-keymap))) + (if workspaces + (progn + (define-key map [mode-line C-mouse-1] + #'lsp-workspace-folders-open) + (define-key map [mode-line mouse-1] + #'lsp-describe-session) + (define-key map [mode-line mouse-2] + #'lsp-workspace-shutdown) + (define-key map [mode-line mouse-3] + #'lsp-workspace-restart)) + (progn + (define-key map [mode-line mouse-1] + (lambda () + (interactive) + (ignore-errors (revert-buffer t t)))))) + map))))) +(add-hook 'lsp-before-initialize-hook #'doom-modeline-update-lsp) +(add-hook 'lsp-after-initialize-hook #'doom-modeline-update-lsp) +(add-hook 'lsp-after-uninitialized-functions #'doom-modeline-update-lsp) +(add-hook 'lsp-before-open-hook #'doom-modeline-update-lsp) +(add-hook 'lsp-after-open-hook #'doom-modeline-update-lsp) + +(defun doom-modeline--eglot-pending-count (server) + "Get count of pending eglot requests to SERVER." + (if (fboundp 'jsonrpc-continuation-count) + (jsonrpc-continuation-count server) + (hash-table-count (jsonrpc--request-continuations server)))) + +(defvar-local doom-modeline--eglot nil) +(defun doom-modeline-update-eglot () + "Update `eglot' state." + (setq doom-modeline--eglot + (pcase-let* ((server (and (eglot-managed-p) (eglot-current-server))) + (nick (and server (eglot--project-nickname server))) + (pending (and server (doom-modeline--eglot-pending-count server))) + (last-error (and server (jsonrpc-last-error server))) + (face (cond (last-error 'doom-modeline-lsp-error) + ((and pending (cl-plusp pending)) 'doom-modeline-lsp-warning) + (nick 'doom-modeline-lsp-success) + (t 'doom-modeline-lsp-warning))) + (icon (doom-modeline-lsp-icon "EGLOT" face))) + (propertize icon + 'help-echo (cond + (last-error + (format "EGLOT\nAn error occured: %s +mouse-3: Clear this status" (plist-get last-error :message))) + ((and pending (cl-plusp pending)) + (format "EGLOT\n%d outstanding requests" pending)) + (nick (format "EGLOT Connected (%s/%s) +C-mouse-1: Go to server errors +mouse-1: Go to server events +mouse-2: Quit server +mouse-3: Reconnect to server" nick (eglot--major-modes server))) + (t "EGLOT Disconnected +mouse-1: Start server")) + 'mouse-face 'doom-modeline-highlight + 'local-map (let ((map (make-sparse-keymap))) + (cond (last-error + (define-key map [mode-line mouse-3] + #'eglot-clear-status)) + ((and pending (cl-plusp pending)) + (define-key map [mode-line mouse-3] + #'eglot-forget-pending-continuations)) + (nick + (define-key map [mode-line C-mouse-1] + #'eglot-stderr-buffer) + (define-key map [mode-line mouse-1] + #'eglot-events-buffer) + (define-key map [mode-line mouse-2] + #'eglot-shutdown) + (define-key map [mode-line mouse-3] + #'eglot-reconnect)) + (t (define-key map [mode-line mouse-1] + #'eglot))) + map))))) +(add-hook 'eglot-managed-mode-hook #'doom-modeline-update-eglot) + +(defvar-local doom-modeline--tags nil) +(defun doom-modeline-update-tags () + "Update tags state." + (setq doom-modeline--tags + (propertize + (doom-modeline-lsp-icon "TAGS" 'doom-modeline-lsp-success) + 'help-echo "TAGS: Citre mode +mouse-1: Toggle citre mode" + 'mouse-face 'doom-modeline-highlight + 'local-map (make-mode-line-mouse-map 'mouse-1 #'citre-mode)))) +(add-hook 'citre-mode-hook #'doom-modeline-update-tags) + +(defun doom-modeline-update-lsp-icon () + "Update lsp icon." + (cond ((bound-and-true-p lsp-mode) + (doom-modeline-update-lsp)) + ((bound-and-true-p eglot--managed-mode) + (doom-modeline-update-eglot)) + ((bound-and-true-p citre-mode) + (doom-modeline-update-tags)))) + +(doom-modeline-add-variable-watcher + 'doom-modeline-lsp-icon + (lambda (_sym val op _where) + (when (eq op 'set) + (setq doom-modeline-lsp-icon val) + (dolist (buf (buffer-list)) + (with-current-buffer buf + (doom-modeline-update-lsp-icon)))))) + +(doom-modeline-add-variable-watcher + 'doom-modeline-icon + (lambda (_sym val op _where) + (when (eq op 'set) + (setq doom-modeline-icon val) + (dolist (buf (buffer-list)) + (with-current-buffer buf + (doom-modeline-update-lsp-icon)))))) + +(doom-modeline-add-variable-watcher + 'doom-modeline-unicode-fallback + (lambda (_sym val op _where) + (when (eq op 'set) + (setq doom-modeline-unicode-fallback val) + (dolist (buf (buffer-list)) + (with-current-buffer buf + (doom-modeline-update-lsp-icon)))))) + +(doom-modeline-def-segment lsp + "The LSP server state." + (when doom-modeline-lsp + (when-let ((icon (cond ((bound-and-true-p lsp-mode) + doom-modeline--lsp) + ((bound-and-true-p eglot--managed-mode) + doom-modeline--eglot) + ((bound-and-true-p citre-mode) + doom-modeline--tags))) + (sep (doom-modeline-spc))) + (concat + sep + (doom-modeline-display-icon icon) + sep)))) + +(defun doom-modeline-override-eglot () + "Override `eglot' mode-line." + (if (and doom-modeline-lsp + (bound-and-true-p doom-modeline-mode)) + (setq mode-line-misc-info + (delq (assq 'eglot--managed-mode mode-line-misc-info) mode-line-misc-info)) + (add-to-list 'mode-line-misc-info + `(eglot--managed-mode (" [" eglot--mode-line-format "] "))))) +(add-hook 'eglot-managed-mode-hook #'doom-modeline-override-eglot) +(add-hook 'doom-modeline-mode-hook #'doom-modeline-override-eglot) + +(doom-modeline-add-variable-watcher + 'doom-modeline-battery + (lambda (_sym val op _where) + (when (eq op 'set) + (setq doom-modeline-lsp val) + (doom-modeline-override-eglot)))) + + +;; +;; GitHub +;; + +(defvar doom-modeline--github-notification-number 0) +(defvar doom-modeline-before-github-fetch-notification-hook nil + "Hooks before fetching GitHub notifications. +Example: + (add-hook \\='doom-modeline-before-github-fetch-notification-hook + #\\='auth-source-pass-enable)") + +(defvar doom-modeline-after-github-fetch-notification-hook nil + "Hooks after fetching GitHub notifications.") + +(defun doom-modeline--github-fetch-notifications () + "Fetch GitHub notifications." + (when (and doom-modeline-github + (require 'async nil t)) + (async-start + `(lambda () + ,(async-inject-variables + "\\`\\(load-path\\|auth-sources\\|doom-modeline-before-github-fetch-notification-hook\\)\\'") + (run-hooks 'doom-modeline-before-github-fetch-notification-hook) + (when (require 'ghub nil t) + (with-timeout (10) + (ignore-errors + (when-let* ((username (ghub--username ghub-default-host)) + (token (or (ghub--token ghub-default-host username 'forge t) + (ghub--token ghub-default-host username 'ghub t)))) + (ghub-get "/notifications" + '((notifications . t)) + :host ghub-default-host + :username username + :auth token + :unpaginate t + :noerror t)))))) + (lambda (result) + (message "") ; suppress message + (setq doom-modeline--github-notification-number (length result)) + (run-hooks 'doom-modeline-after-github-fetch-notification-hook))))) + +(defvar doom-modeline--github-timer nil) +(defun doom-modeline-github-timer () + "Start/Stop the timer for GitHub fetching." + (if (timerp doom-modeline--github-timer) + (cancel-timer doom-modeline--github-timer)) + (setq doom-modeline--github-timer + (and doom-modeline-github + (run-with-idle-timer 30 + doom-modeline-github-interval + #'doom-modeline--github-fetch-notifications)))) + +(doom-modeline-add-variable-watcher + 'doom-modeline-github + (lambda (_sym val op _where) + (when (eq op 'set) + (setq doom-modeline-github val) + (doom-modeline-github-timer)))) + +(doom-modeline-github-timer) + +(doom-modeline-def-segment github + "The GitHub notifications." + (when (and doom-modeline-github + (doom-modeline--segment-visible 'github) + (numberp doom-modeline--github-notification-number)) + (let ((sep (doom-modeline-spc))) + (concat + sep + (propertize + (concat + (doom-modeline-icon 'octicon "nf-oct-mark_github" "🔔" "&" + :face 'doom-modeline-notification) + (and (> doom-modeline--github-notification-number 0) (doom-modeline-vspc)) + (propertize + (cond + ((<= doom-modeline--github-notification-number 0) "") + ((> doom-modeline--github-notification-number 99) "99+") + (t (number-to-string doom-modeline--github-notification-number))) + 'face '(:inherit + (doom-modeline-unread-number doom-modeline-notification)))) + 'help-echo "Github Notifications +mouse-1: Show notifications +mouse-3: Fetch notifications" + 'mouse-face 'doom-modeline-highlight + 'local-map (let ((map (make-sparse-keymap))) + (define-key map [mode-line mouse-1] + (lambda () + "Open GitHub notifications page." + (interactive) + (run-with-idle-timer 300 nil #'doom-modeline--github-fetch-notifications) + (browse-url "https://github.com/notifications"))) + (define-key map [mode-line mouse-3] + (lambda () + "Fetching GitHub notifications." + (interactive) + (message "Fetching GitHub notifications...") + (doom-modeline--github-fetch-notifications))) + map)) + sep)))) + + +;; +;; Debug states +;; + +;; Highlight the doom-modeline while debugging. +(defvar-local doom-modeline--debug-cookie nil) +(defun doom-modeline--debug-visual (&rest _) + "Update the face of mode-line for debugging." + (mapc (lambda (buffer) + (with-current-buffer buffer + (setq doom-modeline--debug-cookie + (face-remap-add-relative 'doom-modeline 'doom-modeline-debug-visual)) + (force-mode-line-update))) + (buffer-list))) + +(defun doom-modeline--normal-visual (&rest _) + "Restore the face of mode-line." + (mapc (lambda (buffer) + (with-current-buffer buffer + (when doom-modeline--debug-cookie + (face-remap-remove-relative doom-modeline--debug-cookie) + (force-mode-line-update)))) + (buffer-list))) + +(add-hook 'dap-session-created-hook #'doom-modeline--debug-visual) +(add-hook 'dap-terminated-hook #'doom-modeline--normal-visual) + +(defun doom-modeline-debug-icon (face) + "Display debug icon with FACE and ARGS." + (doom-modeline-icon 'codicon "nf-cod-debug" "🐛" "!" :face face)) + +(defun doom-modeline--debug-dap () + "The current `dap-mode' state." + (when (and (bound-and-true-p dap-mode) + (bound-and-true-p lsp-mode)) + (when-let ((session (dap--cur-session))) + (when (dap--session-running session) + (propertize (doom-modeline-debug-icon 'doom-modeline-info) + 'help-echo (format "DAP (%s - %s) +mouse-1: Display debug hydra +mouse-2: Display recent configurations +mouse-3: Disconnect session" + (dap--debug-session-name session) + (dap--debug-session-state session)) + 'mouse-face 'doom-modeline-highlight + 'local-map (let ((map (make-sparse-keymap))) + (define-key map [mode-line mouse-1] + #'dap-hydra) + (define-key map [mode-line mouse-2] + #'dap-debug-recent) + (define-key map [mode-line mouse-3] + #'dap-disconnect) + map)))))) + +(defvar-local doom-modeline--debug-dap nil) +(defun doom-modeline-update-debug-dap (&rest _) + "Update dap debug state." + (setq doom-modeline--debug-dap (doom-modeline--debug-dap))) + +(add-hook 'dap-session-created-hook #'doom-modeline-update-debug-dap) +(add-hook 'dap-session-changed-hook #'doom-modeline-update-debug-dap) +(add-hook 'dap-terminated-hook #'doom-modeline-update-debug-dap) + +(defsubst doom-modeline--debug-edebug () + "The current `edebug' state." + (when (bound-and-true-p edebug-mode) + (propertize (doom-modeline-debug-icon 'doom-modeline-info) + 'help-echo (format "EDebug (%s) +mouse-1: Show help +mouse-2: Next +mouse-3: Stop debugging" + edebug-execution-mode) + 'mouse-face 'doom-modeline-highlight + 'local-map (let ((map (make-sparse-keymap))) + (define-key map [mode-line mouse-1] + #'edebug-help) + (define-key map [mode-line mouse-2] + #'edebug-next-mode) + (define-key map [mode-line mouse-3] + #'edebug-stop) + map)))) + +(defsubst doom-modeline--debug-on-error () + "The current `debug-on-error' state." + (when debug-on-error + (propertize (doom-modeline-debug-icon 'doom-modeline-urgent) + 'help-echo "Debug on Error +mouse-1: Toggle Debug on Error" + 'mouse-face 'doom-modeline-highlight + 'local-map (make-mode-line-mouse-map 'mouse-1 #'toggle-debug-on-error)))) + +(defsubst doom-modeline--debug-on-quit () + "The current `debug-on-quit' state." + (when debug-on-quit + (propertize (doom-modeline-debug-icon 'doom-modeline-warning) + 'help-echo "Debug on Quit +mouse-1: Toggle Debug on Quit" + 'mouse-face 'doom-modeline-highlight + 'local-map (make-mode-line-mouse-map 'mouse-1 #'toggle-debug-on-quit)))) + +(doom-modeline-def-segment debug + "The current debug state." + (when (doom-modeline--segment-visible 'debug) + (let* ((dap doom-modeline--debug-dap) + (edebug (doom-modeline--debug-edebug)) + (on-error (doom-modeline--debug-on-error)) + (on-quit (doom-modeline--debug-on-quit)) + (vsep (doom-modeline-vspc)) + (sep (and (or dap edebug on-error on-quit) (doom-modeline-spc)))) + (concat sep + (and dap (concat dap (and (or edebug on-error on-quit) vsep))) + (and edebug (concat edebug (and (or on-error on-quit) vsep))) + (and on-error (concat on-error (and on-quit vsep))) + on-quit + sep)))) + + +;; +;; PDF pages +;; + +(defvar-local doom-modeline--pdf-pages nil) +(defun doom-modeline-update-pdf-pages () + "Update PDF pages." + (setq doom-modeline--pdf-pages + (format " P%d/%d " + (or (eval `(pdf-view-current-page)) 0) + (pdf-cache-number-of-pages)))) +(add-hook 'pdf-view-change-page-hook #'doom-modeline-update-pdf-pages) + +(doom-modeline-def-segment pdf-pages + "Display PDF pages." + doom-modeline--pdf-pages) + + +;; +;; `mu4e' notifications +;; + +(doom-modeline-def-segment mu4e + "Show notifications of any unread emails in `mu4e'." + (when (and doom-modeline-mu4e + (doom-modeline--segment-visible 'mu4e)) + (let ((sep (doom-modeline-spc)) + (vsep (doom-modeline-vspc)) + (icon (doom-modeline-icon 'mdicon "nf-md-email" "📧" "#" + :face 'doom-modeline-notification))) + (cond ((and (bound-and-true-p mu4e-alert-mode-line) + (numberp mu4e-alert-mode-line) + ;; don't display if the unread mails count is zero + (> mu4e-alert-mode-line 0)) + (concat + sep + (propertize + (concat + icon + vsep + (propertize + (if (> mu4e-alert-mode-line doom-modeline-number-limit) + (format "%d+" doom-modeline-number-limit) + (number-to-string mu4e-alert-mode-line)) + 'face '(:inherit + (doom-modeline-unread-number doom-modeline-notification)))) + 'mouse-face 'doom-modeline-highlight + 'keymap '(mode-line keymap + (mouse-1 . mu4e-alert-view-unread-mails) + (mouse-2 . mu4e-alert-view-unread-mails) + (mouse-3 . mu4e-alert-view-unread-mails)) + 'help-echo (concat (if (= mu4e-alert-mode-line 1) + "You have an unread email" + (format "You have %s unread emails" mu4e-alert-mode-line)) + "\nClick here to view " + (if (= mu4e-alert-mode-line 1) "it" "them"))) + sep)) + ((bound-and-true-p mu4e-modeline-mode) + (concat sep icon vsep + (propertize (mu4e--modeline-string) + 'face 'doom-modeline-notification) + sep)))))) + +(defun doom-modeline-override-mu4e-alert (&rest _) + "Delete `mu4e-alert-mode-line' from global modeline string." + (when (and (featurep 'mu4e-alert) + (bound-and-true-p mu4e-alert-mode-line)) + (if (and doom-modeline-mu4e + (bound-and-true-p doom-modeline-mode)) + ;; Delete original modeline + (progn + (setq global-mode-string + (delete '(:eval mu4e-alert-mode-line) global-mode-string)) + (setq mu4e-alert-modeline-formatter #'identity)) + ;; Recover default settings + (setq mu4e-alert-modeline-formatter #'mu4e-alert-default-mode-line-formatter)))) +(advice-add #'mu4e-alert-enable-mode-line-display + :after #'doom-modeline-override-mu4e-alert) +(add-hook 'doom-modeline-mode-hook #'doom-modeline-override-mu4e-alert) + +(defun doom-modeline-override-mu4e-modeline (&rest _) + "Delete `mu4e-alert-mode-line' from global modeline string." + (when (bound-and-true-p mu4e-modeline-mode) + (if (and doom-modeline-mu4e + (bound-and-true-p doom-modeline-mode)) + ;; Delete original modeline + (setq global-mode-string + (delete mu4e--modeline-item global-mode-string)) + ;; Recover default settings + (add-to-list 'global-mode-string mu4e--modeline-item)))) +(add-hook 'mu4e-modeline-mode-hook #'doom-modeline-override-mu4e-modeline) +(add-hook 'doom-modeline-mode-hook #'doom-modeline-override-mu4e-modeline) + +(doom-modeline-add-variable-watcher + 'doom-modeline-mu4e + (lambda (_sym val op _where) + (when (eq op 'set) + (setq doom-modeline-mu4e val) + (doom-modeline-override-mu4e-alert) + (doom-modeline-override-mu4e-modeline)))) + + +;; +;; `gnus' notifications +;; + +(defvar doom-modeline--gnus-unread-mail 0) +(defvar doom-modeline--gnus-started nil + "Used to determine if gnus has started.") +(defun doom-modeline-update-gnus-status (&rest _) + "Get the total number of unread news of gnus group." + (setq doom-modeline--gnus-unread-mail + (when (and doom-modeline-gnus + doom-modeline--gnus-started) + (let ((total-unread-news-number 0)) + (mapc (lambda (g) + (let* ((group (car g)) + (unread (eval `(gnus-group-unread ,group)))) + (when (and (not (seq-contains-p doom-modeline-gnus-excluded-groups group)) + (numberp unread) + (> unread 0)) + (setq total-unread-news-number (+ total-unread-news-number unread))))) + gnus-newsrc-alist) + total-unread-news-number)))) + +;; Update the modeline after changes have been made +(add-hook 'gnus-group-update-hook #'doom-modeline-update-gnus-status) +(add-hook 'gnus-summary-update-hook #'doom-modeline-update-gnus-status) +(add-hook 'gnus-group-update-group-hook #'doom-modeline-update-gnus-status) +(add-hook 'gnus-after-getting-new-news-hook #'doom-modeline-update-gnus-status) + +;; Only start to listen to gnus when gnus is actually running +(defun doom-modeline-start-gnus-listener () + "Start GNUS listener." + (when (and doom-modeline-gnus + (not doom-modeline--gnus-started)) + (setq doom-modeline--gnus-started t) + ;; Scan gnus in the background if the timer is higher than 0 + (doom-modeline-update-gnus-status) + (if (> doom-modeline-gnus-timer 0) + (gnus-demon-add-handler 'gnus-demon-scan-news doom-modeline-gnus-timer doom-modeline-gnus-idle)))) +(add-hook 'gnus-started-hook #'doom-modeline-start-gnus-listener) + +;; Stop the listener if gnus isn't running +(defun doom-modeline-stop-gnus-listener () + "Stop GNUS listener." + (setq doom-modeline--gnus-started nil)) +(add-hook 'gnus-exit-gnus-hook #'doom-modeline-stop-gnus-listener) + +(doom-modeline-def-segment gnus + "Show notifications of any unread emails in `gnus'." + (when (and (doom-modeline--segment-visible 'gnus) + doom-modeline-gnus + doom-modeline--gnus-started + ;; Don't display if the unread mails count is zero + (numberp doom-modeline--gnus-unread-mail) + (> doom-modeline--gnus-unread-mail 0)) + (let ((sep (doom-modeline-spc)) + (vsep (doom-modeline-vspc))) + (concat + sep + (propertize + (concat + (doom-modeline-icon 'mdicon "nf-md-email" "📧" "#" + :face 'doom-modeline-notification) + vsep + (propertize + (if (> doom-modeline--gnus-unread-mail doom-modeline-number-limit) + (format "%d+" doom-modeline-number-limit) + (number-to-string doom-modeline--gnus-unread-mail)) + 'face '(:inherit + (doom-modeline-unread-number doom-modeline-notification)))) + 'mouse-face 'doom-modeline-highlight + 'help-echo (if (= doom-modeline--gnus-unread-mail 1) + "You have an unread email" + (format "You have %s unread emails" doom-modeline--gnus-unread-mail))) + sep)))) + + +;; +;; IRC notifications +;; + +(defun doom-modeline--shorten-irc (name) + "Wrapper for `tracking-shorten' and `erc-track-shorten-function' with NAME. + +One key difference is that when `tracking-shorten' and +`erc-track-shorten-function' returns nil we will instead return the original +value of name. This is necessary in cases where the user has stylized the name +to be an icon and we don't want to remove that so we just return the original." + (or (and (boundp 'tracking-shorten) + (car (tracking-shorten (list name)))) + (and (boundp 'erc-track-shorten-function) + (functionp erc-track-shorten-function) + (car (funcall erc-track-shorten-function (list name)))) + (and (boundp 'rcirc-short-buffer-name) + (rcirc-short-buffer-name name)) + name)) + +(defun doom-modeline--tracking-buffers (buffers) + "Logic to convert some irc BUFFERS to their font-awesome icon." + (mapconcat + (lambda (b) + (propertize + (doom-modeline--shorten-irc (funcall doom-modeline-irc-stylize b)) + 'face '(:inherit (doom-modeline-unread-number doom-modeline-notification)) + 'help-echo (format "IRC Notification: %s\nmouse-1: Switch to buffer" b) + 'mouse-face 'doom-modeline-highlight + 'local-map (make-mode-line-mouse-map + 'mouse-1 + (lambda () + (interactive) + (when (buffer-live-p (get-buffer b)) + (switch-to-buffer b)))))) + buffers + (doom-modeline-vspc))) + +(defun doom-modeline--circe-p () + "Check if `circe' is in use." + (boundp 'tracking-mode-line-buffers)) + +(defun doom-modeline--erc-p () + "Check if `erc' is in use." + (boundp 'erc-modified-channels-alist)) + +(defun doom-modeline--rcirc-p () + "Check if `rcirc' is in use." + (bound-and-true-p rcirc-track-minor-mode)) + +(defun doom-modeline--get-buffers () + "Gets the buffers that have activity." + (cond + ((doom-modeline--circe-p) + tracking-buffers) + ((doom-modeline--erc-p) + (mapcar (lambda (l) + (buffer-name (car l))) + erc-modified-channels-alist)) + ((doom-modeline--rcirc-p) + (mapcar (lambda (b) + (buffer-name b)) + rcirc-activity)))) + +;; Create a modeline segment that contains all the irc tracked buffers +(doom-modeline-def-segment irc-buffers + "The list of shortened, unread irc buffers." + (when (and doom-modeline-irc + (doom-modeline--segment-visible 'irc-buffers)) + (let* ((buffers (doom-modeline--get-buffers)) + (number (length buffers)) + (sep (doom-modeline-spc))) + (when (> number 0) + (concat + sep + (doom-modeline--tracking-buffers buffers) + sep))))) + +(doom-modeline-def-segment irc + "A notification icon for any unread irc buffer." + (when (and doom-modeline-irc + (doom-modeline--segment-visible 'irc)) + (let* ((buffers (doom-modeline--get-buffers)) + (number (length buffers)) + (sep (doom-modeline-spc)) + (vsep (doom-modeline-vspc))) + (when (> number 0) + (concat + sep + + (propertize (concat + (doom-modeline-icon 'mdicon "nf-md-message_processing" "🗊" "#" + :face 'doom-modeline-notification) + vsep + ;; Display the number of unread buffers + (propertize (number-to-string number) + 'face '(:inherit + (doom-modeline-unread-number + doom-modeline-notification)))) + 'help-echo (format "IRC Notifications: %s\n%s" + (mapconcat + (lambda (b) (funcall doom-modeline-irc-stylize b)) + buffers + ", ") + (cond + ((doom-modeline--circe-p) + "mouse-1: Switch to previous unread buffer +mouse-3: Switch to next unread buffer") + ((doom-modeline--erc-p) + "mouse-1: Switch to buffer +mouse-3: Switch to next unread buffer") + ((doom-modeline--rcirc-p) + "mouse-1: Switch to server buffer +mouse-3: Switch to next unread buffer"))) + 'mouse-face 'doom-modeline-highlight + 'local-map (let ((map (make-sparse-keymap))) + (cond + ((doom-modeline--circe-p) + (define-key map [mode-line mouse-1] + #'tracking-previous-buffer) + (define-key map [mode-line mouse-3] + #'tracking-next-buffer)) + ((doom-modeline--erc-p) + (define-key map [mode-line mouse-1] + #'erc-switch-to-buffer) + (define-key map [mode-line mouse-3] + #'erc-track-switch-buffer)) + ((doom-modeline--rcirc-p) + (define-key map [mode-line mouse-1] + #'rcirc-switch-to-server-buffer) + (define-key map [mode-line mouse-3] + #'rcirc-next-active-buffer))) + map)) + + ;; Display the unread irc buffers as well + (when doom-modeline-irc-buffers + (concat sep (doom-modeline--tracking-buffers buffers))) + + sep))))) + +(defun doom-modeline-override-rcirc () + "Override default `rcirc' mode-line." + (if (and doom-modeline-irc + (bound-and-true-p doom-modeline-mode)) + (setq global-mode-string + (delq 'rcirc-activity-string global-mode-string)) + (when (and rcirc-track-minor-mode + (not (memq 'rcirc-activity-string global-mode-string))) + (setq global-mode-string + (append global-mode-string '(rcirc-activity-string)))))) +(add-hook 'rcirc-track-minor-mode-hook #'doom-modeline-override-rcirc) +(add-hook 'doom-modeline-mode-hook #'doom-modeline-override-rcirc) + +(doom-modeline-add-variable-watcher + 'doom-modeline-irc + (lambda (_sym val op _where) + (when (eq op 'set) + (setq doom-modeline-irc val) + (doom-modeline-override-rcirc)))) + + +;; +;; Battery status +;; + +(defun doom-modeline-battery-icon (icon unicode text face) + "Displays the battery ICON with FACE. + +UNICODE and TEXT are fallbacks. +Uses `nerd-icons-mdicon' to fetch the icon." + (doom-modeline-icon 'mdicon icon unicode text :face face)) + +(defvar doom-modeline--battery-status nil) +(defun doom-modeline-update-battery-status () + "Update battery status." + (setq doom-modeline--battery-status + (when (and doom-modeline-battery + (bound-and-true-p display-battery-mode)) + (let* ((data (and battery-status-function + (functionp battery-status-function) + (funcall battery-status-function))) + (status (cdr (assoc ?L data))) + (charging? (or (string-equal "AC" status) + (string-equal "on-line" status))) + (percentage (car (read-from-string (or (cdr (assq ?p data)) "ERR")))) + (valid-percentage? (and (numberp percentage) + (>= percentage 0) + (<= percentage battery-mode-line-limit))) + (face (if valid-percentage? + (cond (charging? 'doom-modeline-battery-charging) + ((< percentage battery-load-critical) 'doom-modeline-battery-critical) + ((< percentage 25) 'doom-modeline-battery-warning) + ((< percentage 95) 'doom-modeline-battery-normal) + (t 'doom-modeline-battery-full)) + 'doom-modeline-battery-error)) + (icon (if valid-percentage? + (cond + ((>= percentage 100) + (doom-modeline-battery-icon (if charging? + "nf-md-battery_charging_100" + "nf-md-battery") + "🔋" "-" face)) + ((>= percentage 90) + (doom-modeline-battery-icon (if charging? + "nf-md-battery_charging_90" + "nf-md-battery_90") + "🔋" "-" face)) + ((>= percentage 80) + (doom-modeline-battery-icon (if charging? + "nf-md-battery_charging_80" + "nf-md-battery_80") + "🔋" "-" face)) + ((>= percentage 70) + (doom-modeline-battery-icon (if charging? + "nf-md-battery_charging_70" + "nf-md-battery_70") + "🔋" "-" face)) + ((>= percentage 60) + (doom-modeline-battery-icon (if charging? + "nf-md-battery_charging_60" + "nf-md-battery_60") + "🔋" "-" face)) + ((>= percentage 50) + (doom-modeline-battery-icon (if charging? + "nf-md-battery_charging_50" + "nf-md-battery_50") + "🔋" "-" face)) + ((>= percentage 40) + (doom-modeline-battery-icon (if charging? + "nf-md-battery_charging_40" + "nf-md-battery_40") + "🔋" "-" face)) + ((>= percentage 30) + (doom-modeline-battery-icon (if charging? + "nf-md-battery_charging_30" + "nf-md-battery_30") + "🔋" "-" face)) + ((>= percentage 20) + (doom-modeline-battery-icon (if charging? + "nf-md-battery_charging_20" + "nf-md-battery_20") + "🔋" "-" face)) + ((>= percentage 10) + (doom-modeline-battery-icon (if charging? + "nf-md-battery_charging_10" + "nf-md-battery_10") + "🪫" "-" face)) + (t (doom-modeline-battery-icon (if charging? + "nf-md-battery_charging_outline" + "nf-md-battery_outline") + "🪫" "!" face))) + (doom-modeline-battery-icon "nf-md-battery_alert" "⚠" "N/A" face))) + (text (if valid-percentage? (format "%d%s" percentage "%%") "")) + (help-echo (if (and battery-echo-area-format data valid-percentage?) + (battery-format battery-echo-area-format data) + "Battery status not available"))) + (cons (propertize icon 'help-echo help-echo) + (propertize text 'face face 'help-echo help-echo)))))) + +(doom-modeline-add-variable-watcher + 'doom-modeline-icon + (lambda (_sym val op _where) + (when (eq op 'set) + (setq doom-modeline-icon val) + (doom-modeline-update-battery-status)))) + +(doom-modeline-add-variable-watcher + 'doom-modeline-unicode-fallback + (lambda (_sym val op _where) + (when (eq op 'set) + (setq doom-modeline-unicode-fallback val) + (doom-modeline-update-battery-status)))) + +(doom-modeline-def-segment battery + "Display battery status." + (when (and doom-modeline-battery + (bound-and-true-p display-battery-mode) + (doom-modeline--segment-visible 'battery)) + (let ((sep (doom-modeline-spc)) + (vsep (doom-modeline-vspc))) + (concat sep + (car doom-modeline--battery-status) + vsep + (cdr doom-modeline--battery-status) + sep)))) + +(defun doom-modeline-override-battery () + "Override default battery mode-line." + (if (and doom-modeline-battery + (bound-and-true-p doom-modeline-mode)) + (progn + (advice-add #'battery-update :override #'doom-modeline-update-battery-status) + (setq global-mode-string + (delq 'battery-mode-line-string global-mode-string)) + (and (bound-and-true-p display-battery-mode) (battery-update))) + (progn + (advice-remove #'battery-update #'doom-modeline-update-battery-status) + (when (and display-battery-mode battery-status-function battery-mode-line-format + (not (memq 'battery-mode-line-string global-mode-string))) + (setq global-mode-string + (append global-mode-string '(battery-mode-line-string))))))) +(add-hook 'display-battery-mode-hook #'doom-modeline-override-battery) +(add-hook 'doom-modeline-mode-hook #'doom-modeline-override-battery) + +(doom-modeline-add-variable-watcher + 'doom-modeline-battery + (lambda (_sym val op _where) + (when (eq op 'set) + (setq doom-modeline-battery val) + (doom-modeline-override-battery)))) + + +;; +;; Package information +;; + +(doom-modeline-def-segment package + "Show package information via `paradox'." + (concat + (doom-modeline-display-text + (format-mode-line 'mode-line-front-space)) + + (when (and doom-modeline-icon doom-modeline-major-mode-icon) + (concat + (doom-modeline-spc) + (doom-modeline-icon 'faicon "nf-fa-archive" nil nil + :face (doom-modeline-face + (if doom-modeline-major-mode-color-icon + 'nerd-icons-silver + 'mode-line))))) + (doom-modeline-display-text + (format-mode-line 'mode-line-buffer-identification)))) + + +;; +;; Helm +;; + +(defvar doom-modeline--helm-buffer-ids + '(("*helm*" . "HELM") + ("*helm M-x*" . "HELM M-x") + ("*swiper*" . "SWIPER") + ("*Projectile Perspectives*" . "HELM Projectile Perspectives") + ("*Projectile Layouts*" . "HELM Projectile Layouts") + ("*helm-ag*" . (lambda () + (format "HELM Ag: Using %s" + (car (split-string helm-ag-base-command)))))) + "Alist of custom helm buffer names to use. +The cdr can also be a function that returns a name to use.") + +(doom-modeline-def-segment helm-buffer-id + "Helm session identifier." + (when (bound-and-true-p helm-alive-p) + (let ((sep (doom-modeline-spc))) + (concat + sep + (when doom-modeline-icon + (concat + (doom-modeline-icon 'sucicon "nf-custom-emacs" nil nil + :face (doom-modeline-face + (and doom-modeline-major-mode-color-icon + 'nerd-icons-blue))) + sep)) + (propertize + (let ((custom (cdr (assoc (buffer-name) doom-modeline--helm-buffer-ids))) + (case-fold-search t) + (name (replace-regexp-in-string "-" " " (buffer-name)))) + (cond ((stringp custom) custom) + ((functionp custom) (funcall custom)) + (t + (string-match "\\*helm:? \\(mode \\)?\\([^\\*]+\\)\\*" name) + (concat "HELM " (capitalize (match-string 2 name)))))) + 'face (doom-modeline-face 'doom-modeline-buffer-file)) + sep)))) + +(doom-modeline-def-segment helm-number + "Number of helm candidates." + (when (bound-and-true-p helm-alive-p) + (concat + (propertize (format " %d/%d" + (helm-candidate-number-at-point) + (helm-get-candidate-number t)) + 'face (doom-modeline-face 'doom-modeline-buffer-path)) + (propertize (format " (%d total) " (helm-get-candidate-number)) + 'face (doom-modeline-face 'doom-modeline-info))))) + +(doom-modeline-def-segment helm-help + "Helm keybindings help." + (when (bound-and-true-p helm-alive-p) + (mapcar + (lambda (s) + (if (string-prefix-p "\\<" s) + (propertize (substitute-command-keys s) + 'face (doom-modeline-face + 'doom-modeline-buffer-file)) + s)) + '("\\<helm-map>\\[helm-help]" "(help) " + "\\<helm-map>\\[helm-select-action]" "(actions) " + "\\<helm-map>\\[helm-maybe-exit-minibuffer]/F1/F2..." "(action) ")))) + +(doom-modeline-def-segment helm-prefix-argument + "Helm prefix argument." + (when (and (bound-and-true-p helm-alive-p) + helm--mode-line-display-prefarg) + (let ((arg (prefix-numeric-value (or prefix-arg current-prefix-arg)))) + (unless (= arg 1) + (propertize (format "C-u %s" arg) + 'face (doom-modeline-face 'doom-modeline-info)))))) + +(defvar doom-modeline--helm-current-source nil + "The currently active helm source.") +(doom-modeline-def-segment helm-follow + "Helm follow indicator." + (and (bound-and-true-p helm-alive-p) + doom-modeline--helm-current-source + (eq 1 (cdr (assq 'follow doom-modeline--helm-current-source))) + "HF")) + +;; +;; Git timemachine +;; + +(doom-modeline-def-segment git-timemachine + (concat + (doom-modeline-spc) + (doom-modeline--buffer-mode-icon) + (doom-modeline--buffer-state-icon) + (propertize + "*%b*" + 'face (doom-modeline-face 'doom-modeline-buffer-timemachine)))) + +;; +;; Markdown/Org preview +;; + +(doom-modeline-def-segment grip + (when (bound-and-true-p grip-mode) + (let ((sep (doom-modeline-spc))) + (concat + sep + (let ((face (doom-modeline-face + (if grip--process + (pcase (process-status grip--process) + ('run 'doom-modeline-info) + ('exit 'doom-modeline-warning) + (_ 'doom-modeline-urgent)) + 'doom-modeline-urgent)))) + (propertize + (doom-modeline-icon 'codicon "nf-cod-open_preview" "🗐" "@" :face face) + 'help-echo (format "Preview on %s +mouse-1: Preview in browser +mouse-2: Stop preview +mouse-3: Restart preview" + (grip--preview-url)) + 'mouse-face 'doom-modeline-highlight + 'local-map (let ((map (make-sparse-keymap))) + (define-key map [mode-line mouse-1] + #'grip-browse-preview) + (define-key map [mode-line mouse-2] + #'grip-stop-preview) + (define-key map [mode-line mouse-3] + #'grip-restart-preview) + map))) + sep)))) + +;; +;; Follow mode +;; + +(doom-modeline-def-segment follow + (when (bound-and-true-p follow-mode) + (let* ((windows (follow-all-followers)) + (nwindows (length windows)) + (nfollowing (- (length (memq (selected-window) windows)) 1))) + (concat + (doom-modeline-spc) + (propertize (format "Follow %d/%d" (- nwindows nfollowing) nwindows) + 'face 'doom-modeline-buffer-minor-mode))))) + +;; +;; Display time +;; + +(defconst doom-modeline--clock-hour-hand-ratio 0.45 + "Length of the hour hand as a proportion of the radius.") + +(defconst doom-modeline--clock-minute-hand-ratio 0.7 + "Length of the minute hand as a proportion of the radius.") + +(defun doom-modeline--create-clock-svg (hour minute radius color) + "Construct an SVG clock showing the time HOUR:MINUTE. +The clock will be of the specified RADIUS and COLOR." + (let ((thickness-factor (image-compute-scaling-factor 'auto)) + (hour-x (* radius (sin (* (- 6 hour (/ minute 60.0)) (/ float-pi 6))) + doom-modeline--clock-hour-hand-ratio)) + (hour-y (* radius (cos (* (- 6 hour (/ minute 60.0)) (/ float-pi 6))) + doom-modeline--clock-hour-hand-ratio)) + (minute-x (* radius (sin (* (- 30 minute) (/ float-pi 30))) + doom-modeline--clock-minute-hand-ratio)) + (minute-y (* radius (cos (* (- 30 minute) (/ float-pi 30))) + doom-modeline--clock-minute-hand-ratio)) + (svg (svg-create (* 2 radius) (* 2 radius) :stroke color))) + (svg-circle svg radius radius (- radius thickness-factor) + :fill "none" :stroke-width (* 2 thickness-factor)) + (svg-circle svg radius radius thickness-factor + :fill color :stroke "none") + (svg-line svg radius radius (+ radius hour-x) (+ radius hour-y) + :stroke-width (* 2 thickness-factor)) + (svg-line svg radius radius (+ radius minute-x) (+ radius minute-y) + :stroke-width (* 1.5 thickness-factor)) + svg)) + +(defvar doom-modeline--clock-cache nil + "The last result of `doom-modeline--generate-clock'.") + +(defun doom-modeline--generate-clock () + "Return a string containing the current time as an analogue clock svg. +When the svg library is not available, return nil." + (cdr + (or (and (equal (truncate (float-time) + (* doom-modeline-time-clock-minute-resolution 60)) + (car doom-modeline--clock-cache)) + doom-modeline--clock-cache) + (and (require 'svg nil t) + (setq doom-modeline--clock-cache + (cons (truncate (float-time) + (* doom-modeline-time-clock-minute-resolution 60)) + (propertize + " " + 'display + (svg-image + (doom-modeline--create-clock-svg + (string-to-number (format-time-string "%-I")) ; hour + (* (truncate (string-to-number (format-time-string "%-M")) + doom-modeline-time-clock-minute-resolution) + doom-modeline-time-clock-minute-resolution) ; minute + (if (integerp doom-modeline-time-clock-size) ; radius + doom-modeline-time-clock-size + (* doom-modeline-height 0.5 doom-modeline-time-clock-size)) + "currentColor") + :scale 1 :ascent 'center) + 'face 'doom-modeline-time + 'help-echo (lambda (_window _object _pos) + (format-time-string "%c"))))))))) + +(defun doom-modeline-time-icon () + "Displays the time icon." + (or (and doom-modeline-time-live-icon + doom-modeline-time-analogue-clock + (display-graphic-p) + (doom-modeline--generate-clock)) + (doom-modeline-icon + 'mdicon + (if doom-modeline-time-live-icon + (pcase (% (caddr (decode-time)) 12) + (0 "nf-md-clock_time_twelve_outline") + (1 "nf-md-clock_time_one_outline") + (2 "nf-md-clock_time_two_outline") + (3 "nf-md-clock_time_three_outline") + (4 "nf-md-clock_time_four_outline") + (5 "nf-md-clock_time_five_outline") + (6 "nf-md-clock_time_six_outline") + (7 "nf-md-clock_time_seven_outline") + (8 "nf-md-clock_time_eight_outline") + (9 "nf-md-clock_time_nine_outline") + (10 "nf-md-clock_time_ten_outline") + (11 "nf-md-clock_time_eleven_outline")) + "nf-md-clock_outline") + "⏰" + "" + :face '(:inherit doom-modeline-time :weight normal)))) + +(doom-modeline-def-segment time + (when (and doom-modeline-time + (bound-and-true-p display-time-mode) + (doom-modeline--segment-visible 'time)) + (concat + (doom-modeline-spc) + (when doom-modeline-time-icon + (concat + (doom-modeline-time-icon) + (and (or doom-modeline-icon doom-modeline-unicode-fallback) + (doom-modeline-vspc)))) + (propertize display-time-string + 'face (doom-modeline-face 'doom-modeline-time))))) + +(defun doom-modeline-override-time () + "Override default `display-time' mode-line." + (or global-mode-string (setq global-mode-string '(""))) + (if (and doom-modeline-time + (bound-and-true-p doom-modeline-mode)) + (setq global-mode-string (delq 'display-time-string global-mode-string)) + (setq global-mode-string (append global-mode-string '(display-time-string))))) +(add-hook 'display-time-mode-hook #'doom-modeline-override-time) +(add-hook 'doom-modeline-mode-hook #'doom-modeline-override-time) + +(doom-modeline-add-variable-watcher + 'doom-modeline-time + (lambda (_sym val op _where) + (when (eq op 'set) + (setq doom-modeline-time val) + (doom-modeline-override-time)))) + +;; +;; Compilation +;; + +(doom-modeline-def-segment compilation + (and (bound-and-true-p compilation-in-progress) + (propertize "[Compiling] " + 'face (doom-modeline-face 'doom-modeline-compilation) + 'help-echo "Compiling; mouse-2: Goto Buffer" + 'mouse-face 'doom-modeline-highlight + 'local-map + (make-mode-line-mouse-map + 'mouse-2 + #'compilation-goto-in-progress-buffer)))) + +;; +;; Eldoc +;; + +(doom-modeline-def-segment eldoc + (and (bound-and-true-p eldoc-mode) + '(eldoc-mode-line-string + (" " eldoc-mode-line-string " ")))) + +(defun doom-modeline-eldoc-minibuffer-message (format-string &rest args) + "Display message specified by FORMAT-STRING and ARGS on the mode-line as needed. +This function displays the message produced by formatting ARGS +with FORMAT-STRING on the mode line when the current buffer is a minibuffer. +Otherwise, it displays the message like `message' would." + (if (minibufferp) + (progn + (add-hook 'minibuffer-exit-hook + (lambda () (setq eldoc-mode-line-string nil + ;; https://debbugs.gnu.org/16920 + eldoc-last-message nil)) + nil t) + (with-current-buffer + (window-buffer + (or (window-in-direction 'above (minibuffer-window)) + (minibuffer-selected-window) + (get-largest-window))) + (setq eldoc-mode-line-string + (when (stringp format-string) + (apply #'format-message format-string args))) + (force-mode-line-update))) + (apply #'message format-string args))) + +;; +;; Kubernetes +;; + +(doom-modeline-def-segment k8s + (when (and (bound-and-true-p kele-mode) (doom-modeline--segment-visible 'k8s)) + (let* ((ctx (kele-current-context-name :wait nil)) + (ns (kele-current-namespace :wait nil)) + (icon (doom-modeline-icon 'mdicon "nf-md-kubernetes" "K8s:" "K8s:")) + (sep (doom-modeline-spc)) + (help-msg (let ((msgs (list (format "Current context: %s" ctx)))) + (when ns + (setq msgs (append msgs (list (format "Current namespace: %s" ns))))) + (string-join msgs "\n")))) + (propertize (concat + icon sep ctx + (when (and doom-modeline-k8s-show-namespace ns) (format "(%s)" ns)) + sep) + 'local-map (let ((map (make-sparse-keymap))) + (define-key map [mode-line down-mouse-1] kele-menu-map) + map) + 'mouse-face 'doom-modeline-highlight + 'help-echo help-msg)))) + +(provide 'doom-modeline-segments) + +;;; doom-modeline-segments.el ends here diff --git a/emacs/elpa/doom-modeline-20240625.230/doom-modeline-segments.elc b/emacs/elpa/doom-modeline-20240625.230/doom-modeline-segments.elc Binary files differ. diff --git a/emacs/elpa/doom-modeline-20240605.628/doom-modeline.el b/emacs/elpa/doom-modeline-20240625.230/doom-modeline.el diff --git a/emacs/elpa/doom-modeline-20240625.230/doom-modeline.elc b/emacs/elpa/doom-modeline-20240625.230/doom-modeline.elc Binary files differ. diff --git a/emacs/elpa/git-commit-20240618.1142/git-commit-pkg.el b/emacs/elpa/git-commit-20240618.1142/git-commit-pkg.el @@ -1,18 +0,0 @@ -(define-package "git-commit" "20240618.1142" "Edit Git commit messages." - '((emacs "26.1") - (compat "29.1.4.5") - (transient "20240421") - (with-editor "20240415")) - :commit "13850341e375bd12e1d1541daab07b111034ff4c" :authors - '(("Jonas Bernoulli" . "emacs.magit@jonas.bernoulli.dev") - ("Sebastian Wiesner" . "lunaryorn@gmail.com") - ("Florian Ragwitz" . "rafl@debian.org") - ("Marius Vollmer" . "marius.vollmer@gmail.com")) - :maintainer - '("Jonas Bernoulli" . "emacs.magit@jonas.bernoulli.dev") - :keywords - '("git" "tools" "vc") - :url "https://github.com/magit/magit") -;; Local Variables: -;; no-byte-compile: t -;; End: diff --git a/emacs/elpa/git-commit-20240618.1142/git-commit.el b/emacs/elpa/git-commit-20240618.1142/git-commit.el @@ -1,1312 +0,0 @@ -;;; git-commit.el --- Edit Git commit messages -*- lexical-binding:t; coding:utf-8 -*- - -;; Copyright (C) 2008-2024 The Magit Project Contributors - -;; Author: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> -;; Sebastian Wiesner <lunaryorn@gmail.com> -;; Florian Ragwitz <rafl@debian.org> -;; Marius Vollmer <marius.vollmer@gmail.com> -;; Maintainer: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> - -;; Homepage: https://github.com/magit/magit -;; Keywords: git tools vc - -;; Package-Version: 3.3.0.50-git -;; Package-Requires: ( -;; (emacs "26.1") -;; (compat "29.1.4.5") -;; (seq "2.24") -;; (transient "0.6.0") -;; (with-editor "3.3.2")) - -;; SPDX-License-Identifier: GPL-3.0-or-later - -;; 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. -;; -;; 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 Magit. If not, see <https://www.gnu.org/licenses/>. - -;; You should have received a copy of the AUTHORS.md file, which -;; lists all contributors. If not, see https://magit.vc/authors. - -;;; 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. - -;; Support for inserting Git trailers (as described in the manpage -;; git-interpret-trailers(1)) is available. -;; -;; C-c C-i Insert a trailer selected from a transient menu. - -;; 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: - -(require 'compat) -(require 'subr-x) - -(when (and (featurep 'seq) - (not (fboundp 'seq-keep))) - (unload-feature 'seq 'force)) -(require 'seq) - -(require 'log-edit) -(require 'ring) -(require 'server) -(require 'transient) -(require 'with-editor) - -;; For historic reasons Magit isn't a hard dependency. -(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) -(defvar recentf-exclude) - -(defvar git-commit-need-summary-line) - -(define-obsolete-variable-alias - 'git-commit-known-pseudo-headers - 'git-commit-trailers - "git-commit 4.0.0") - -;;; Options -;;;; Variables - -(defgroup git-commit nil - "Edit Git commit messages." - :prefix "git-commit-" - :link '(info-link "(magit)Editing Commit Messages") - :group 'tools) - -(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. - -Loading the library `git-commit' by default enables this mode, -but the library is not automatically loaded because doing that -would pull in many dependencies and increase startup time too -much. You can either rely on `magit' loading this library or -you can load it explicitly. Autoloading is not an alternative -because in this case autoloading would immediately trigger -full loading." - :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) - (remove-hook 'after-change-major-mode-hook - #'git-commit-setup-font-lock-in-buffer))) - (cond - (global-git-commit-mode - (add-hook 'find-file-hook #'git-commit-setup-check-buffer) - (add-hook 'after-change-major-mode-hook - #'git-commit-setup-font-lock-in-buffer)) - (t - (remove-hook 'find-file-hook #'git-commit-setup-check-buffer) - (remove-hook 'after-change-major-mode-hook - #'git-commit-setup-font-lock-in-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-item fundamental-mode) - (function-item git-commit-elisp-text-mode) - (function :tag "Another mode") - (const :tag "No major mode"))) -;;;###autoload(put 'git-commit-major-mode 'safe-local-variable -;;;###autoload (lambda (val) -;;;###autoload (memq val '(text-mode -;;;###autoload markdown-mode -;;;###autoload org-mode -;;;###autoload fundamental-mode -;;;###autoload git-commit-elisp-text-mode)))) - -(defvaralias 'git-commit-mode-hook 'git-commit-setup-hook - "This variable is an alias for `git-commit-setup-hook' (which see). -Also note that `git-commit-mode' (which see) is not a major-mode.") - -(defcustom git-commit-setup-hook - '(git-commit-ensure-comment-gap - git-commit-save-message - git-commit-setup-changelog-support - git-commit-turn-on-auto-fill - git-commit-propertize-diff - bug-reference-mode) - "Hook run at the end of `git-commit-setup'." - :group 'git-commit - :type 'hook - :get (and (featurep 'magit-base) #'magit-hook-custom-get) - :options '(git-commit-ensure-comment-gap - git-commit-save-message - git-commit-setup-changelog-support - magit-generate-changelog - git-commit-turn-on-auto-fill - git-commit-turn-on-orglink - git-commit-turn-on-flyspell - git-commit-propertize-diff - bug-reference-mode)) - -(defcustom git-commit-post-finish-hook nil - "Hook run after the user finished writing a commit message. - -\\<with-editor-mode-map>\ -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 -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-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) - "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-trailers - '("Acked-by" - "Modified-by" - "Reviewed-by" - "Signed-off-by" - "Tested-by" - "Cc" - "Reported-by" - "Suggested-by" - "Co-authored-by" - "Co-developed-by") - "A list of Git trailers to be highlighted. - -See also manpage git-interpret-trailer(1). This package does -not use that Git command, but the initial description still -serves as a good introduction." - :group 'git-commit - :safe (lambda (val) (and (listp val) (seq-every-p #'stringp val))) - :type '(repeat string)) - -(defcustom git-commit-use-local-message-ring nil - "Whether to use a local message ring instead of the global one. - -This can be set globally, in which case every repository gets its -own commit message ring, or locally for a single repository. If -Magit isn't available, then setting this to a non-nil value has -no effect." - :group 'git-commit - :safe 'booleanp - :type 'boolean) - -(defcustom git-commit-cd-to-toplevel nil - "Whether to set `default-directory' to the worktree in message buffer. - -Editing a commit message is done by visiting a file located in the git -directory, usually \"COMMIT_EDITMSG\". As is done when visiting any -file, the local value of `default-directory' is set to the directory -that contains the file. - -If this option is non-nil, then the local `default-directory' is changed -to the working tree from which the commit command was invoked. You may -wish to do that, to make it easier to open a file that is located in the -working tree, directly from the commit message buffer. - -If the git variable `safe.bareRepository' is set to \"explicit\", then -you have to enable this, to be able to commit at all. See issue #5100. - -This option only has an effect if the commit was initiated from Magit." - :group 'git-commit - :type 'boolean) - -;;;; 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) - -(defface git-commit-trailer-token - '((t :inherit font-lock-keyword-face)) - "Face used for Git trailer tokens in commit messages." - :group 'git-commit-faces) - -(defface git-commit-trailer-value - '((t :inherit font-lock-string-face)) - "Face used for Git trailer values 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) - -(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-trailer-token)) - "Face used for headings in commit message comments." - :group 'git-commit-faces) - -(defface git-commit-comment-file - '((t :inherit git-commit-trailer-value)) - "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-keymap git-commit-redundant-bindings - :doc "Bindings made redundant by `git-commit-insert-trailer'. -This keymap is used as the parent of `git-commit-mode-map', -to avoid upsetting muscle-memory. If you would rather avoid -the redundant bindings, then set this to nil, before loading -`git-commit'." - "C-c C-a" #'git-commit-ack - "C-c M-i" #'git-commit-suggested - "C-c C-m" #'git-commit-modified - "C-c C-o" #'git-commit-cc - "C-c C-p" #'git-commit-reported - "C-c C-r" #'git-commit-review - "C-c C-s" #'git-commit-signoff - "C-c C-t" #'git-commit-test) - -(defvar-keymap git-commit-mode-map - :doc "Keymap used by `git-commit-mode'." - :parent git-commit-redundant-bindings - "M-p" #'git-commit-prev-message - "M-n" #'git-commit-next-message - "C-c M-p" #'git-commit-search-message-backward - "C-c M-n" #'git-commit-search-message-forward - "C-c C-i" #'git-commit-insert-trailer - "C-c M-s" #'git-commit-save-message) - -;;; 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 t - :help "Insert an 'Acked-by' trailer"] - ["Modified-by" git-commit-modified t - :help "Insert a 'Modified-by' trailer"] - ["Reviewed-by" git-commit-review t - :help "Insert a 'Reviewed-by' trailer"] - ["Sign-Off" git-commit-signoff t - :help "Insert a 'Signed-off-by' trailer"] - ["Tested-by" git-commit-test t - :help "Insert a 'Tested-by' trailer"] - "-" - ["CC" git-commit-cc t - :help "Insert a 'Cc' trailer"] - ["Reported" git-commit-reported t - :help "Insert a 'Reported-by' trailer"] - ["Suggested" git-commit-suggested t - :help "Insert a 'Suggested-by' trailer"] - ["Co-authored-by" git-commit-co-authored t - :help "Insert a 'Co-authored-by' trailer"] - ["Co-developed-by" git-commit-co-developed t - :help "Insert a 'Co-developed-by' trailer"] - "-" - ["Save" git-commit-save-message t] - ["Cancel" with-editor-cancel t] - ["Commit" with-editor-finish t])) - -;;; Hooks - -(defconst git-commit-filename-regexp "/\\(\ -\\(\\(COMMIT\\|NOTES\\|PULLREQ\\|MERGEREQ\\|TAG\\)_EDIT\\|MERGE_\\|\\)MSG\ -\\|\\(BRANCH\\|EDIT\\)_DESCRIPTION\\)\\'") - -(with-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 () - (when (and buffer-file-name - (string-match-p git-commit-filename-regexp buffer-file-name)) - (git-commit-setup-font-lock))) - -(defun git-commit-setup-check-buffer () - (when (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 - ((file (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 file)) - (let ((inhibit-read-only t)) - (insert-file-contents file t) - t)))) - -(when (eq system-type 'windows-nt) - (add-hook 'find-file-not-found-functions #'git-commit-file-not-found)) - -(defconst git-commit-default-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") - -(defvar git-commit-usage-message git-commit-default-usage-message - "Message displayed when editing a commit message. -When this is nil, then `with-editor-usage-message' is displayed -instead. One of these messages has to be displayed; otherwise -the user gets to see the message displayed by `server-execute'. -That message is misleading and because we cannot prevent it from -being displayed, we have to immediately show another message to -prevent the user from seeing it.") - -(defvar git-commit-header-line-format nil - "If non-nil, header line format used by `git-commit-mode'. -Used as the local value of `header-line-format', in buffer using -`git-commit-mode'. If it is a string, then it is passed through -`substitute-command-keys' first. A useful setting may be: - (setq git-commit-header-line-format git-commit-default-usage-message) - (setq git-commit-usage-message nil) ; show a shorter message") - -(defun git-commit-setup () - (let ((gitdir default-directory) - (cd nil)) - (when (and (fboundp 'magit-toplevel) - (boundp 'magit--separated-gitdirs)) - ;; `magit-toplevel' is autoloaded and defined in magit-git.el. That - ;; library declares this function without loading magit-process.el, - ;; which defines it. - (require 'magit-process nil t) - (when git-commit-cd-to-toplevel - (setq cd (or (car (rassoc default-directory magit--separated-gitdirs)) - (magit-toplevel))))) - ;; 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 - (expand-file-name ".dir-locals.el" gitdir))) - ;; 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) - (or cd (magit-toplevel))) - gitdir))) - (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 cd - (setq default-directory cd))) - (when git-commit-major-mode - (let ((auto-mode-alist - ;; `set-auto-mode--apply-alist' removes the remote part from - ;; the file-name before looking it up in `auto-mode-alist'. - ;; For our temporary entry to be found, we have to modify the - ;; file-name the same way. - (list (cons (concat "\\`" - (regexp-quote - (or (file-remote-p buffer-file-name 'localname) - 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))) - ;; Below we instead explicitly show a message. - (setq with-editor-show-usage nil) - (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 (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 - 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) - (git-commit-setup-font-lock) - (git-commit-prepare-message-ring) - (when (boundp 'save-place) - (setq save-place nil)) - (let ((git-commit-mode-hook nil)) - (git-commit-mode 1)) - (with-demoted-errors "Error running git-commit-setup-hook: %S" - (run-hooks 'git-commit-setup-hook)) - (set-buffer-modified-p nil) - (when-let ((format git-commit-header-line-format)) - (setq header-line-format - (if (stringp format) (substitute-command-keys format) format))) - (when git-commit-usage-message - (setq with-editor-usage-message git-commit-usage-message)) - (with-editor-usage-message)) - -(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 - git-commit-post-finish-hook-timeout)))) - (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'. -Variable `git-commit-major-mode' controls which major-mode is -used." - :lighter "") - -(put 'git-commit-mode 'permanent-local t) - -(defun git-commit-ensure-comment-gap () - "Separate initial empty line from initial comment. -If the buffer begins with an empty line followed by a comment, insert -an additional newline in between, so that once the users start typing, -the input isn't tacked to the comment." - (save-excursion - (goto-char (point-min)) - (when (looking-at (format "\\`\n%s" comment-start)) - (open-line 1)))) - -(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. -Ensure auto filling happens everywhere, except in the summary line." - (turn-on-auto-fill) - (setq-local comment-auto-fill-only-comments nil) - (when git-commit-need-summary-line - (setq-local auto-fill-function #'git-commit-auto-fill-except-summary))) - -(defun git-commit-auto-fill-except-summary () - (unless (eq (line-beginning-position) 1) - (do-auto-fill))) - -(defun git-commit-turn-on-orglink () - "Turn on Orglink mode if it is available. -If `git-commit-major-mode' is `org-mode', then silently forgo -turning on `orglink-mode'." - (when (and (not (derived-mode-p 'org-mode)) - (boundp 'orglink-match-anywhere) - (fboundp 'orglink-mode)) - (setq-local orglink-match-anywhere t) - (orglink-mode 1))) - -(defun git-commit-turn-on-flyspell () - "Unconditionally turn on Flyspell mode. -Also check text that is already in the buffer, while avoiding to check -most text that Git will strip from the final message, such as the last -comment and anything below the cut line (\"--- >8 ---\")." - (require 'flyspell) - (turn-on-flyspell) - (setq flyspell-generic-check-word-predicate - #'git-commit-flyspell-verify) - (let ((end nil) - ;; The "cut line" is defined in "git/wt-status.c". It appears - ;; in the commit message when `commit.verbose' is set to true. - (cut-line-regex (format "^%s -\\{8,\\} >8 -\\{8,\\}$" comment-start)) - (comment-start-regex (format "^\\(%s\\|$\\)" comment-start))) - (save-excursion - (goto-char (or (re-search-forward cut-line-regex nil t) - (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-style-convention-checks' 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") - (let ((len (ring-length log-edit-comment-ring))) - (if (<= len 0) - (progn (message "Empty comment ring") (ding)) - ;; Unlike `log-edit-previous-comment' we save the current - ;; non-empty and newly written comment, because otherwise - ;; it would be irreversibly lost. - (when-let ((message (git-commit-buffer-message))) - (unless (ring-member log-edit-comment-ring message) - (ring-insert log-edit-comment-ring message) - (cl-incf arg) - (setq len (ring-length log-edit-comment-ring)))) - ;; Delete the message but not the instructions at the end. - (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))) - (delete-region (point-min) (point))) - (setq log-edit-comment-ring-index (log-edit-new-comment-index arg len)) - (message "Comment %d" (1+ log-edit-comment-ring-index)) - (insert (ring-ref log-edit-comment-ring log-edit-comment-ring-index))))) - -(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-search-message-backward (string) - "Search backward through message history for a match for STRING. -Save current message first." - (interactive - (list (read-string (format-prompt "Comment substring" - log-edit-last-comment-match) - nil nil log-edit-last-comment-match))) - (cl-letf (((symbol-function #'log-edit-previous-comment) - (symbol-function #'git-commit-prev-message))) - (log-edit-comment-search-backward string))) - -(defun git-commit-search-message-forward (string) - "Search forward through message history for a match for STRING. -Save current message first." - (interactive - (list (read-string (format-prompt "Comment substring" - log-edit-last-comment-match) - nil nil log-edit-last-comment-match))) - (cl-letf (((symbol-function #'log-edit-previous-comment) - (symbol-function #'git-commit-prev-message))) - (log-edit-comment-search-forward string))) - -(defun git-commit-save-message () - "Save current message to `log-edit-comment-ring'." - (interactive) - (if-let ((message (git-commit-buffer-message))) - (progn - (when-let ((index (ring-member log-edit-comment-ring message))) - (ring-remove log-edit-comment-ring index)) - (ring-insert log-edit-comment-ring message) - (when (and git-commit-use-local-message-ring - (fboundp 'magit-repository-local-set)) - (magit-repository-local-set 'log-edit-comment-ring - log-edit-comment-ring)) - (message "Message saved")) - (message "Only whitespace and/or comments; message not saved"))) - -(defun git-commit-prepare-message-ring () - (make-local-variable 'log-edit-comment-ring-index) - (when (and git-commit-use-local-message-ring - (fboundp 'magit-repository-local-get)) - (setq-local log-edit-comment-ring - (magit-repository-local-get - 'log-edit-comment-ring - (make-ring log-edit-maximum-comment-ring-size))))) - -(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 (line-beginning-position) (point-max))) - (goto-char (point-min)) - (flush-lines flush) - (goto-char (point-max)) - (unless (eq (char-before) ?\n) - (insert ?\n)) - (setq str (buffer-string))) - (and (not (string-match "\\`[ \t\n\r]*\\'" str)) - (progn - (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)))) - -;;; Utilities - -(defsubst git-commit-executable () - (if (fboundp 'magit-git-executable) - (magit-git-executable) - "git")) - -;;; Trailers - -(transient-define-prefix git-commit-insert-trailer () - "Insert a commit message trailer. - -See also manpage git-interpret-trailer(1). This command does -not use that Git command, but the initial description still -serves as a good introduction." - [[:description (lambda () - (cond (prefix-arg - "Insert ... by someone ") - ("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) - ("C-d" "Co-developed" git-commit-co-developed)]]) - -(defun git-commit-ack (name mail) - "Insert a trailer acknowledging that you have looked at the commit." - (interactive (git-commit-get-ident "Acked-by")) - (git-commit--insert-ident-trailer "Acked-by" name mail)) - -(defun git-commit-modified (name mail) - "Insert a trailer to signal that you have modified the commit." - (interactive (git-commit-get-ident "Modified-by")) - (git-commit--insert-ident-trailer "Modified-by" name mail)) - -(defun git-commit-review (name mail) - "Insert a trailer acknowledging that you have reviewed the commit. -With a prefix argument, prompt for another person who performed a -review." - (interactive (git-commit-get-ident "Reviewed-by")) - (git-commit--insert-ident-trailer "Reviewed-by" name mail)) - -(defun git-commit-signoff (name mail) - "Insert a trailer to sign off the commit. -With a prefix argument, prompt for another person who signed off." - (interactive (git-commit-get-ident "Signed-off-by")) - (git-commit--insert-ident-trailer "Signed-off-by" name mail)) - -(defun git-commit-test (name mail) - "Insert a trailer acknowledging that you have tested the commit. -With a prefix argument, prompt for another person who tested." - (interactive (git-commit-get-ident "Tested-by")) - (git-commit--insert-ident-trailer "Tested-by" name mail)) - -(defun git-commit-cc (name mail) - "Insert a trailer mentioning someone who might be interested." - (interactive (git-commit-read-ident "Cc")) - (git-commit--insert-ident-trailer "Cc" name mail)) - -(defun git-commit-reported (name mail) - "Insert a trailer mentioning the person who reported the issue." - (interactive (git-commit-read-ident "Reported-by")) - (git-commit--insert-ident-trailer "Reported-by" name mail)) - -(defun git-commit-suggested (name mail) - "Insert a trailer mentioning the person who suggested the change." - (interactive (git-commit-read-ident "Suggested-by")) - (git-commit--insert-ident-trailer "Suggested-by" name mail)) - -(defun git-commit-co-authored (name mail) - "Insert a trailer mentioning the person who co-authored the commit." - (interactive (git-commit-read-ident "Co-authored-by")) - (git-commit--insert-ident-trailer "Co-authored-by" name mail)) - -(defun git-commit-co-developed (name mail) - "Insert a trailer mentioning the person who co-developed the commit." - (interactive (git-commit-read-ident "Co-developed-by")) - (git-commit--insert-ident-trailer "Co-developed-by" name mail)) - -(defun git-commit-get-ident (&optional prompt) - "Return name and email of the user or read another name and email. -If PROMPT and `current-prefix-arg' are both non-nil, read name -and email using `git-commit-read-ident' (which see), otherwise -return name and email of the current user (you)." - (if (and prompt current-prefix-arg) - (git-commit-read-ident prompt) - (list (or (getenv "GIT_AUTHOR_NAME") - (getenv "GIT_COMMITTER_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") - (with-demoted-errors "Error running 'git config user.email': %S" - (car (process-lines - (git-commit-executable) "config" "user.email"))) - (read-string "Email: "))))) - -(defalias 'git-commit-self-ident #'git-commit-get-ident) - -(defvar git-commit-read-ident-history nil) - -(defun git-commit-read-ident (prompt) - "Read a name and email, prompting with PROMPT, and return them. -If Magit is available, read them using a single prompt, offering -past commit authors as completion candidates. The input must -have the form \"NAME <EMAIL>\"." - (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-ident-trailer (trailer name email) - (git-commit--insert-trailer trailer (format "%s <%s>" name email))) - -(defun git-commit--insert-trailer (trailer value) - (save-excursion - (let ((string (format "%s: %s" trailer value)) - (leading-comment-end nil)) - ;; Make sure we skip forward past any leading comments. - (goto-char (point-min)) - (while (looking-at comment-start) - (forward-line)) - (setq leading-comment-end (point)) - (goto-char (point-max)) - (cond - ;; Look backwards for existing trailers. - ((re-search-backward (git-commit--trailer-regexp) nil t) - (end-of-line) - (insert ?\n string) - (unless (= (char-after) ?\n) - (insert ?\n))) - ;; Or place the new trailer right before the first non-leading - ;; comments. - (t - (while (re-search-backward (concat "^" comment-start) - leading-comment-end t)) - (unless (looking-back "\n\n" nil) - (insert ?\n)) - (insert string ?\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--trailer-regexp () - (format - "^\\(?:\\(%s:\\)\\( .*\\)\\|\\([-a-zA-Z]+\\): \\([^<\n]+? <[^>\n]+>\\)\\)" - (regexp-opt git-commit-trailers))) - -(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:") - "Also fontified outside of comments in `git-commit-font-lock-keywords-2'.") - -(defconst git-commit-font-lock-keywords-1 - '(;; Trailers - (eval . `(,(git-commit--trailer-regexp) - (1 'git-commit-trailer-token) - (2 'git-commit-trailer-value) - (3 'git-commit-trailer-token) - (4 'git-commit-trailer-value))) - ;; 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))) - ;; "commit HASH" - (eval . '("^commit [[:alnum:]]+$" - (0 'git-commit-trailer-value))) - ;; `git-commit-comment-headings' (but not in commented lines) - (eval . `(,(format "\\(?:^%s[[:blank:]]+.+$\\)" - (regexp-opt git-commit-comment-headings)) - (0 'git-commit-trailer-value))))) - -(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-3 - "Font-Lock keywords for Git-Commit mode.") - -(defun git-commit-setup-font-lock () - (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 "") - (setq-local comment-end-skip "\n") - (setq-local comment-use-syntax nil) - (when (and (derived-mode-p 'markdown-mode) - (fboundp 'markdown-fill-paragraph)) - (setq-local fill-paragraph-function - (lambda (&optional justify) - (and (not (= (char-after (line-beginning-position)) - (aref comment-start 0))) - (markdown-fill-paragraph justify))))) - (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) - (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 ((pos (point-min))) - (while-let ((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)))) - -;;; _ - -(define-obsolete-function-alias - 'git-commit-insert-pseudo-header - 'git-commit-insert-trailer - "git-commit 4.0.0") -(define-obsolete-function-alias - 'git-commit-insert-header - 'git-commit--insert-ident-trailer - "git-commit 4.0.0") -(define-obsolete-face-alias - 'git-commit-pseudo-header - 'git-commit-trailer-value - "git-commit 4.0.0") -(define-obsolete-face-alias - 'git-commit-known-pseudo-header - 'git-commit-trailer-token - "git-commit 4.0.0") - -(provide 'git-commit) -;;; git-commit.el ends here diff --git a/emacs/elpa/git-commit-20240618.1142/git-commit.elc b/emacs/elpa/git-commit-20240618.1142/git-commit.elc Binary files differ. diff --git a/emacs/elpa/git-commit-20240618.1142/git-commit-autoloads.el b/emacs/elpa/git-commit-20240623.1335/git-commit-autoloads.el diff --git a/emacs/elpa/git-commit-20240623.1335/git-commit-pkg.el b/emacs/elpa/git-commit-20240623.1335/git-commit-pkg.el @@ -0,0 +1,18 @@ +(define-package "git-commit" "20240623.1335" "Edit Git commit messages." + '((emacs "26.1") + (compat "29.1.4.5") + (transient "20240421") + (with-editor "20240415")) + :commit "196abe727054a440bf6262c5c254ad4565cbaa66" :authors + '(("Jonas Bernoulli" . "emacs.magit@jonas.bernoulli.dev") + ("Sebastian Wiesner" . "lunaryorn@gmail.com") + ("Florian Ragwitz" . "rafl@debian.org") + ("Marius Vollmer" . "marius.vollmer@gmail.com")) + :maintainer + '("Jonas Bernoulli" . "emacs.magit@jonas.bernoulli.dev") + :keywords + '("git" "tools" "vc") + :url "https://github.com/magit/magit") +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/emacs/elpa/git-commit-20240623.1335/git-commit.el b/emacs/elpa/git-commit-20240623.1335/git-commit.el @@ -0,0 +1,1311 @@ +;;; git-commit.el --- Edit Git commit messages -*- lexical-binding:t; coding:utf-8 -*- + +;; Copyright (C) 2008-2024 The Magit Project Contributors + +;; Author: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> +;; Sebastian Wiesner <lunaryorn@gmail.com> +;; Florian Ragwitz <rafl@debian.org> +;; Marius Vollmer <marius.vollmer@gmail.com> +;; Maintainer: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> + +;; Homepage: https://github.com/magit/magit +;; Keywords: git tools vc + +;; Package-Version: 3.3.0.50-git +;; Package-Requires: ( +;; (emacs "26.1") +;; (compat "29.1.4.5") +;; (seq "2.24") +;; (transient "0.6.0") +;; (with-editor "3.3.2")) + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; 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. +;; +;; 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 Magit. If not, see <https://www.gnu.org/licenses/>. + +;; You should have received a copy of the AUTHORS.md file, which +;; lists all contributors. If not, see https://magit.vc/authors. + +;;; 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. + +;; Support for inserting Git trailers (as described in the manpage +;; git-interpret-trailers(1)) is available. +;; +;; C-c C-i Insert a trailer selected from a transient menu. + +;; 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: + +(require 'compat) +(require 'subr-x) + +(when (and (featurep 'seq) + (not (fboundp 'seq-keep))) + (unload-feature 'seq 'force)) +(require 'seq) + +(require 'log-edit) +(require 'ring) +(require 'server) +(require 'transient) +(require 'with-editor) + +;; For historic reasons Magit isn't a hard dependency. +(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) +(defvar recentf-exclude) + +(defvar git-commit-need-summary-line) + +(define-obsolete-variable-alias + 'git-commit-known-pseudo-headers + 'git-commit-trailers + "git-commit 4.0.0") + +;;; Options +;;;; Variables + +(defgroup git-commit nil + "Edit Git commit messages." + :prefix "git-commit-" + :link '(info-link "(magit)Editing Commit Messages") + :group 'tools) + +(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. + +Loading the library `git-commit' by default enables this mode, +but the library is not automatically loaded because doing that +would pull in many dependencies and increase startup time too +much. You can either rely on `magit' loading this library or +you can load it explicitly. Autoloading is not an alternative +because in this case autoloading would immediately trigger +full loading." + :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) + (remove-hook 'after-change-major-mode-hook + #'git-commit-setup-font-lock-in-buffer))) + (cond + (global-git-commit-mode + (add-hook 'find-file-hook #'git-commit-setup-check-buffer) + (add-hook 'after-change-major-mode-hook + #'git-commit-setup-font-lock-in-buffer)) + (t + (remove-hook 'find-file-hook #'git-commit-setup-check-buffer) + (remove-hook 'after-change-major-mode-hook + #'git-commit-setup-font-lock-in-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-item fundamental-mode) + (function-item git-commit-elisp-text-mode) + (function :tag "Another mode") + (const :tag "No major mode"))) +;;;###autoload(put 'git-commit-major-mode 'safe-local-variable +;;;###autoload (lambda (val) +;;;###autoload (memq val '(text-mode +;;;###autoload markdown-mode +;;;###autoload org-mode +;;;###autoload fundamental-mode +;;;###autoload git-commit-elisp-text-mode)))) + +(defvaralias 'git-commit-mode-hook 'git-commit-setup-hook + "This variable is an alias for `git-commit-setup-hook' (which see). +Also note that `git-commit-mode' (which see) is not a major-mode.") + +(defcustom git-commit-setup-hook + '(git-commit-ensure-comment-gap + git-commit-save-message + git-commit-setup-changelog-support + git-commit-turn-on-auto-fill + git-commit-propertize-diff + bug-reference-mode) + "Hook run at the end of `git-commit-setup'." + :group 'git-commit + :type 'hook + :get (and (featurep 'magit-base) #'magit-hook-custom-get) + :options '(git-commit-ensure-comment-gap + git-commit-save-message + git-commit-setup-changelog-support + magit-generate-changelog + git-commit-turn-on-auto-fill + git-commit-turn-on-orglink + git-commit-turn-on-flyspell + git-commit-propertize-diff + bug-reference-mode)) + +(defcustom git-commit-post-finish-hook nil + "Hook run after the user finished writing a commit message. + +\\<with-editor-mode-map>\ +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 +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-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) + "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-trailers + '("Acked-by" + "Modified-by" + "Reviewed-by" + "Signed-off-by" + "Tested-by" + "Cc" + "Reported-by" + "Suggested-by" + "Co-authored-by" + "Co-developed-by") + "A list of Git trailers to be highlighted. + +See also manpage git-interpret-trailer(1). This package does +not use that Git command, but the initial description still +serves as a good introduction." + :group 'git-commit + :safe (lambda (val) (and (listp val) (seq-every-p #'stringp val))) + :type '(repeat string)) + +(defcustom git-commit-use-local-message-ring nil + "Whether to use a local message ring instead of the global one. + +This can be set globally, in which case every repository gets its +own commit message ring, or locally for a single repository. If +Magit isn't available, then setting this to a non-nil value has +no effect." + :group 'git-commit + :safe 'booleanp + :type 'boolean) + +(defcustom git-commit-cd-to-toplevel nil + "Whether to set `default-directory' to the worktree in message buffer. + +Editing a commit message is done by visiting a file located in the git +directory, usually \"COMMIT_EDITMSG\". As is done when visiting any +file, the local value of `default-directory' is set to the directory +that contains the file. + +If this option is non-nil, then the local `default-directory' is changed +to the working tree from which the commit command was invoked. You may +wish to do that, to make it easier to open a file that is located in the +working tree, directly from the commit message buffer. + +If the git variable `safe.bareRepository' is set to \"explicit\", then +you have to enable this, to be able to commit at all. See issue #5100. + +This option only has an effect if the commit was initiated from Magit." + :group 'git-commit + :type 'boolean) + +;;;; 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) + +(defface git-commit-trailer-token + '((t :inherit font-lock-keyword-face)) + "Face used for Git trailer tokens in commit messages." + :group 'git-commit-faces) + +(defface git-commit-trailer-value + '((t :inherit font-lock-string-face)) + "Face used for Git trailer values 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) + +(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-trailer-token)) + "Face used for headings in commit message comments." + :group 'git-commit-faces) + +(defface git-commit-comment-file + '((t :inherit git-commit-trailer-value)) + "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-keymap git-commit-redundant-bindings + :doc "Bindings made redundant by `git-commit-insert-trailer'. +This keymap is used as the parent of `git-commit-mode-map', +to avoid upsetting muscle-memory. If you would rather avoid +the redundant bindings, then set this to nil, before loading +`git-commit'." + "C-c C-a" #'git-commit-ack + "C-c M-i" #'git-commit-suggested + "C-c C-m" #'git-commit-modified + "C-c C-o" #'git-commit-cc + "C-c C-p" #'git-commit-reported + "C-c C-r" #'git-commit-review + "C-c C-s" #'git-commit-signoff + "C-c C-t" #'git-commit-test) + +(defvar-keymap git-commit-mode-map + :doc "Keymap used by `git-commit-mode'." + :parent git-commit-redundant-bindings + "M-p" #'git-commit-prev-message + "M-n" #'git-commit-next-message + "C-c M-p" #'git-commit-search-message-backward + "C-c M-n" #'git-commit-search-message-forward + "C-c C-i" #'git-commit-insert-trailer + "C-c M-s" #'git-commit-save-message) + +;;; 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 t + :help "Insert an 'Acked-by' trailer"] + ["Modified-by" git-commit-modified t + :help "Insert a 'Modified-by' trailer"] + ["Reviewed-by" git-commit-review t + :help "Insert a 'Reviewed-by' trailer"] + ["Sign-Off" git-commit-signoff t + :help "Insert a 'Signed-off-by' trailer"] + ["Tested-by" git-commit-test t + :help "Insert a 'Tested-by' trailer"] + "-" + ["CC" git-commit-cc t + :help "Insert a 'Cc' trailer"] + ["Reported" git-commit-reported t + :help "Insert a 'Reported-by' trailer"] + ["Suggested" git-commit-suggested t + :help "Insert a 'Suggested-by' trailer"] + ["Co-authored-by" git-commit-co-authored t + :help "Insert a 'Co-authored-by' trailer"] + ["Co-developed-by" git-commit-co-developed t + :help "Insert a 'Co-developed-by' trailer"] + "-" + ["Save" git-commit-save-message t] + ["Cancel" with-editor-cancel t] + ["Commit" with-editor-finish t])) + +;;; Hooks + +(defconst git-commit-filename-regexp "/\\(\ +\\(\\(COMMIT\\|NOTES\\|PULLREQ\\|MERGEREQ\\|TAG\\)_EDIT\\|MERGE_\\|\\)MSG\ +\\|\\(BRANCH\\|EDIT\\)_DESCRIPTION\\)\\'") + +(with-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 () + (when (and buffer-file-name + (string-match-p git-commit-filename-regexp buffer-file-name)) + (git-commit-setup-font-lock))) + +(defun git-commit-setup-check-buffer () + (when (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 + ((file (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 file)) + (let ((inhibit-read-only t)) + (insert-file-contents file t) + t)))) + +(when (eq system-type 'windows-nt) + (add-hook 'find-file-not-found-functions #'git-commit-file-not-found)) + +(defconst git-commit-default-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") + +(defvar git-commit-usage-message git-commit-default-usage-message + "Message displayed when editing a commit message. +When this is nil, then `with-editor-usage-message' is displayed +instead. One of these messages has to be displayed; otherwise +the user gets to see the message displayed by `server-execute'. +That message is misleading and because we cannot prevent it from +being displayed, we have to immediately show another message to +prevent the user from seeing it.") + +(defvar git-commit-header-line-format nil + "If non-nil, header line format used by `git-commit-mode'. +Used as the local value of `header-line-format', in buffer using +`git-commit-mode'. If it is a string, then it is passed through +`substitute-command-keys' first. A useful setting may be: + (setq git-commit-header-line-format git-commit-default-usage-message) + (setq git-commit-usage-message nil) ; show a shorter message") + +(defun git-commit-setup () + (let ((gitdir default-directory) + (cd nil)) + (when (and (fboundp 'magit-toplevel) + (boundp 'magit--separated-gitdirs)) + ;; `magit-toplevel' is autoloaded and defined in magit-git.el. That + ;; library declares this function without loading magit-process.el, + ;; which defines it. + (require 'magit-process nil t) + (when git-commit-cd-to-toplevel + (setq cd (or (car (rassoc default-directory magit--separated-gitdirs)) + (magit-toplevel))))) + ;; 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 + (expand-file-name ".dir-locals.el" gitdir))) + ;; 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) + (or cd (magit-toplevel))) + gitdir))) + (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 cd + (setq default-directory cd))) + (when git-commit-major-mode + (let ((auto-mode-alist + ;; `set-auto-mode--apply-alist' removes the remote part from + ;; the file-name before looking it up in `auto-mode-alist'. + ;; For our temporary entry to be found, we have to modify the + ;; file-name the same way. + (list (cons (concat "\\`" + (regexp-quote + (or (file-remote-p buffer-file-name 'localname) + 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))) + ;; Below we instead explicitly show a message. + (setq with-editor-show-usage nil) + (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 (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 + 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) + (git-commit-setup-font-lock) + (git-commit-prepare-message-ring) + (when (boundp 'save-place) + (setq save-place nil)) + (let ((git-commit-mode-hook nil)) + (git-commit-mode 1)) + (with-demoted-errors "Error running git-commit-setup-hook: %S" + (run-hooks 'git-commit-setup-hook)) + (set-buffer-modified-p nil) + (when-let ((format git-commit-header-line-format)) + (setq header-line-format + (if (stringp format) (substitute-command-keys format) format))) + (when git-commit-usage-message + (setq with-editor-usage-message git-commit-usage-message)) + (with-editor-usage-message)) + +(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 + git-commit-post-finish-hook-timeout)))) + (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'. +Variable `git-commit-major-mode' controls which major-mode is +used." + :lighter "") + +(put 'git-commit-mode 'permanent-local t) + +(defun git-commit-ensure-comment-gap () + "Separate initial empty line from initial comment. +If the buffer begins with an empty line followed by a comment, insert +an additional newline in between, so that once the users start typing, +the input isn't tacked to the comment." + (save-excursion + (goto-char (point-min)) + (when (looking-at (format "\\`\n%s" comment-start)) + (open-line 1)))) + +(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. +Ensure auto filling happens everywhere, except in the summary line." + (turn-on-auto-fill) + (setq-local comment-auto-fill-only-comments nil) + (when git-commit-need-summary-line + (setq-local auto-fill-function #'git-commit-auto-fill-except-summary))) + +(defun git-commit-auto-fill-except-summary () + (unless (eq (line-beginning-position) 1) + (do-auto-fill))) + +(defun git-commit-turn-on-orglink () + "Turn on Orglink mode if it is available. +If `git-commit-major-mode' is `org-mode', then silently forgo +turning on `orglink-mode'." + (when (and (not (derived-mode-p 'org-mode)) + (boundp 'orglink-match-anywhere) + (fboundp 'orglink-mode)) + (setq-local orglink-match-anywhere t) + (orglink-mode 1))) + +(defun git-commit-turn-on-flyspell () + "Unconditionally turn on Flyspell mode. +Also check text that is already in the buffer, while avoiding to check +most text that Git will strip from the final message, such as the last +comment and anything below the cut line (\"--- >8 ---\")." + (require 'flyspell) + (turn-on-flyspell) + (setq flyspell-generic-check-word-predicate + #'git-commit-flyspell-verify) + (let ((end nil) + ;; The "cut line" is defined in "git/wt-status.c". It appears + ;; in the commit message when `commit.verbose' is set to true. + (cut-line-regex (format "^%s -\\{8,\\} >8 -\\{8,\\}$" comment-start)) + (comment-start-regex (format "^\\(%s\\|$\\)" comment-start))) + (save-excursion + (goto-char (or (re-search-forward cut-line-regex nil t) + (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-style-convention-checks' 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") + (let ((len (ring-length log-edit-comment-ring))) + (if (<= len 0) + (progn (message "Empty comment ring") (ding)) + ;; Unlike `log-edit-previous-comment' we save the current + ;; non-empty and newly written comment, because otherwise + ;; it would be irreversibly lost. + (when-let ((message (git-commit-buffer-message))) + (unless (ring-member log-edit-comment-ring message) + (ring-insert log-edit-comment-ring message) + (cl-incf arg) + (setq len (ring-length log-edit-comment-ring)))) + ;; Delete the message but not the instructions at the end. + (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))) + (delete-region (point-min) (point))) + (setq log-edit-comment-ring-index (log-edit-new-comment-index arg len)) + (message "Comment %d" (1+ log-edit-comment-ring-index)) + (insert (ring-ref log-edit-comment-ring log-edit-comment-ring-index))))) + +(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-search-message-backward (string) + "Search backward through message history for a match for STRING. +Save current message first." + (interactive + (list (read-string (format-prompt "Comment substring" + log-edit-last-comment-match) + nil nil log-edit-last-comment-match))) + (cl-letf (((symbol-function #'log-edit-previous-comment) + (symbol-function #'git-commit-prev-message))) + (log-edit-comment-search-backward string))) + +(defun git-commit-search-message-forward (string) + "Search forward through message history for a match for STRING. +Save current message first." + (interactive + (list (read-string (format-prompt "Comment substring" + log-edit-last-comment-match) + nil nil log-edit-last-comment-match))) + (cl-letf (((symbol-function #'log-edit-previous-comment) + (symbol-function #'git-commit-prev-message))) + (log-edit-comment-search-forward string))) + +(defun git-commit-save-message () + "Save current message to `log-edit-comment-ring'." + (interactive) + (if-let ((message (git-commit-buffer-message))) + (progn + (when-let ((index (ring-member log-edit-comment-ring message))) + (ring-remove log-edit-comment-ring index)) + (ring-insert log-edit-comment-ring message) + (when (and git-commit-use-local-message-ring + (fboundp 'magit-repository-local-set)) + (magit-repository-local-set 'log-edit-comment-ring + log-edit-comment-ring)) + (message "Message saved")) + (message "Only whitespace and/or comments; message not saved"))) + +(defun git-commit-prepare-message-ring () + (make-local-variable 'log-edit-comment-ring-index) + (when (and git-commit-use-local-message-ring + (fboundp 'magit-repository-local-get)) + (setq-local log-edit-comment-ring + (magit-repository-local-get + 'log-edit-comment-ring + (make-ring log-edit-maximum-comment-ring-size))))) + +(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 (line-beginning-position) (point-max))) + (goto-char (point-min)) + (flush-lines flush) + (goto-char (point-max)) + (unless (eq (char-before) ?\n) + (insert ?\n)) + (setq str (buffer-string))) + (and (not (string-match "\\`[ \t\n\r]*\\'" str)) + (progn + (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)))) + +;;; Utilities + +(defsubst git-commit-executable () + (if (fboundp 'magit-git-executable) + (magit-git-executable) + "git")) + +;;; Trailers + +(transient-define-prefix git-commit-insert-trailer () + "Insert a commit message trailer. + +See also manpage git-interpret-trailer(1). This command does +not use that Git command, but the initial description still +serves as a good introduction." + [[:description (lambda () + (cond (prefix-arg + "Insert ... by someone ") + ("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) + ("C-d" "Co-developed" git-commit-co-developed)]]) + +(defun git-commit-ack (name mail) + "Insert a trailer acknowledging that you have looked at the commit." + (interactive (git-commit-get-ident "Acked-by")) + (git-commit--insert-ident-trailer "Acked-by" name mail)) + +(defun git-commit-modified (name mail) + "Insert a trailer to signal that you have modified the commit." + (interactive (git-commit-get-ident "Modified-by")) + (git-commit--insert-ident-trailer "Modified-by" name mail)) + +(defun git-commit-review (name mail) + "Insert a trailer acknowledging that you have reviewed the commit. +With a prefix argument, prompt for another person who performed a +review." + (interactive (git-commit-get-ident "Reviewed-by")) + (git-commit--insert-ident-trailer "Reviewed-by" name mail)) + +(defun git-commit-signoff (name mail) + "Insert a trailer to sign off the commit. +With a prefix argument, prompt for another person who signed off." + (interactive (git-commit-get-ident "Signed-off-by")) + (git-commit--insert-ident-trailer "Signed-off-by" name mail)) + +(defun git-commit-test (name mail) + "Insert a trailer acknowledging that you have tested the commit. +With a prefix argument, prompt for another person who tested." + (interactive (git-commit-get-ident "Tested-by")) + (git-commit--insert-ident-trailer "Tested-by" name mail)) + +(defun git-commit-cc (name mail) + "Insert a trailer mentioning someone who might be interested." + (interactive (git-commit-read-ident "Cc")) + (git-commit--insert-ident-trailer "Cc" name mail)) + +(defun git-commit-reported (name mail) + "Insert a trailer mentioning the person who reported the issue." + (interactive (git-commit-read-ident "Reported-by")) + (git-commit--insert-ident-trailer "Reported-by" name mail)) + +(defun git-commit-suggested (name mail) + "Insert a trailer mentioning the person who suggested the change." + (interactive (git-commit-read-ident "Suggested-by")) + (git-commit--insert-ident-trailer "Suggested-by" name mail)) + +(defun git-commit-co-authored (name mail) + "Insert a trailer mentioning the person who co-authored the commit." + (interactive (git-commit-read-ident "Co-authored-by")) + (git-commit--insert-ident-trailer "Co-authored-by" name mail)) + +(defun git-commit-co-developed (name mail) + "Insert a trailer mentioning the person who co-developed the commit." + (interactive (git-commit-read-ident "Co-developed-by")) + (git-commit--insert-ident-trailer "Co-developed-by" name mail)) + +(defun git-commit-get-ident (&optional prompt) + "Return name and email of the user or read another name and email. +If PROMPT and `current-prefix-arg' are both non-nil, read name +and email using `git-commit-read-ident' (which see), otherwise +return name and email of the current user (you)." + (if (and prompt current-prefix-arg) + (git-commit-read-ident prompt) + (list (or (getenv "GIT_AUTHOR_NAME") + (getenv "GIT_COMMITTER_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") + (with-demoted-errors "Error running 'git config user.email': %S" + (car (process-lines + (git-commit-executable) "config" "user.email"))) + (read-string "Email: "))))) + +(defalias 'git-commit-self-ident #'git-commit-get-ident) + +(defvar git-commit-read-ident-history nil) + +(defun git-commit-read-ident (prompt) + "Read a name and email, prompting with PROMPT, and return them. +If Magit is available, read them using a single prompt, offering +past commit authors as completion candidates. The input must +have the form \"NAME <EMAIL>\"." + (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-ident-trailer (trailer name email) + (git-commit--insert-trailer trailer (format "%s <%s>" name email))) + +(defun git-commit--insert-trailer (trailer value) + (save-excursion + (let ((string (format "%s: %s" trailer value)) + (leading-comment-end nil)) + ;; Make sure we skip forward past any leading comments. + (goto-char (point-min)) + (while (looking-at comment-start) + (forward-line)) + (setq leading-comment-end (point)) + (goto-char (point-max)) + (cond + ;; Look backwards for existing trailers. + ((re-search-backward (git-commit--trailer-regexp) nil t) + (end-of-line) + (insert ?\n string) + (unless (= (char-after) ?\n) + (insert ?\n))) + ;; Or place the new trailer right before the first non-leading + ;; comments. + (t + (while (re-search-backward (concat "^" comment-start) + leading-comment-end t)) + (unless (looking-back "\n\n" nil) + (insert ?\n)) + (insert string ?\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--trailer-regexp () + (format + "^\\(?:\\(%s:\\)\\( .*\\)\\|\\([-a-zA-Z]+\\): \\([^<\n]+? <[^>\n]+>\\)\\)" + (regexp-opt git-commit-trailers))) + +(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:") + "Also fontified outside of comments in `git-commit-font-lock-keywords-2'.") + +(defconst git-commit-font-lock-keywords-1 + '(;; Trailers + (eval . `(,(git-commit--trailer-regexp) + (1 'git-commit-trailer-token) + (2 'git-commit-trailer-value) + (3 'git-commit-trailer-token) + (4 'git-commit-trailer-value))) + ;; 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))) + ;; "commit HASH" + (eval . '("^commit [[:alnum:]]+$" + (0 'git-commit-trailer-value))) + ;; `git-commit-comment-headings' (but not in commented lines) + (eval . `(,(format "\\(?:^%s[[:blank:]]+.+$\\)" + (regexp-opt git-commit-comment-headings)) + (0 'git-commit-trailer-value))))) + +(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-3 + "Font-Lock keywords for Git-Commit mode.") + +(defun git-commit-setup-font-lock () + (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 "") + (setq-local comment-end-skip "\n") + (setq-local comment-use-syntax nil) + (when (and (derived-mode-p 'markdown-mode) + (fboundp 'markdown-fill-paragraph)) + (setq-local fill-paragraph-function + (lambda (&optional justify) + (and (not (= (char-after (line-beginning-position)) + (aref comment-start 0))) + (markdown-fill-paragraph justify))))) + (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\\)\\|\\)\\([^']+\\)" + (string-join (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) + (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 ((pos (point-min))) + (while-let ((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)))) + +;;; _ + +(define-obsolete-function-alias + 'git-commit-insert-pseudo-header + 'git-commit-insert-trailer + "git-commit 4.0.0") +(define-obsolete-function-alias + 'git-commit-insert-header + 'git-commit--insert-ident-trailer + "git-commit 4.0.0") +(define-obsolete-face-alias + 'git-commit-pseudo-header + 'git-commit-trailer-value + "git-commit 4.0.0") +(define-obsolete-face-alias + 'git-commit-known-pseudo-header + 'git-commit-trailer-token + "git-commit 4.0.0") + +(provide 'git-commit) +;;; git-commit.el ends here diff --git a/emacs/elpa/git-commit-20240623.1335/git-commit.elc b/emacs/elpa/git-commit-20240623.1335/git-commit.elc Binary files differ. diff --git a/emacs/elpa/ledger-mode-20240527.2134/ledger-check.elc b/emacs/elpa/ledger-mode-20240527.2134/ledger-check.elc Binary files differ. diff --git a/emacs/elpa/ledger-mode-20240527.2134/ledger-commodities.elc b/emacs/elpa/ledger-mode-20240527.2134/ledger-commodities.elc Binary files differ. diff --git a/emacs/elpa/ledger-mode-20240527.2134/ledger-complete.elc b/emacs/elpa/ledger-mode-20240527.2134/ledger-complete.elc Binary files differ. diff --git a/emacs/elpa/ledger-mode-20240527.2134/ledger-context.elc b/emacs/elpa/ledger-mode-20240527.2134/ledger-context.elc Binary files differ. diff --git a/emacs/elpa/ledger-mode-20240527.2134/ledger-exec.elc b/emacs/elpa/ledger-mode-20240527.2134/ledger-exec.elc Binary files differ. diff --git a/emacs/elpa/ledger-mode-20240527.2134/ledger-flymake.elc b/emacs/elpa/ledger-mode-20240527.2134/ledger-flymake.elc Binary files differ. diff --git a/emacs/elpa/ledger-mode-20240527.2134/ledger-fontify.elc b/emacs/elpa/ledger-mode-20240527.2134/ledger-fontify.elc Binary files differ. diff --git a/emacs/elpa/ledger-mode-20240527.2134/ledger-fonts.elc b/emacs/elpa/ledger-mode-20240527.2134/ledger-fonts.elc Binary files differ. diff --git a/emacs/elpa/ledger-mode-20240527.2134/ledger-init.elc b/emacs/elpa/ledger-mode-20240527.2134/ledger-init.elc Binary files differ. diff --git a/emacs/elpa/ledger-mode-20240527.2134/ledger-mode-pkg.el b/emacs/elpa/ledger-mode-20240527.2134/ledger-mode-pkg.el @@ -1,6 +0,0 @@ -(define-package "ledger-mode" "20240527.2134" "Helper code for use with the \"ledger\" command-line tool" - '((emacs "25.1")) - :commit "57de7d817296607a9a4721470f64e05c964744da") -;; Local Variables: -;; no-byte-compile: t -;; End: diff --git a/emacs/elpa/ledger-mode-20240527.2134/ledger-mode.el b/emacs/elpa/ledger-mode-20240527.2134/ledger-mode.el @@ -1,374 +0,0 @@ -;;; ledger-mode.el --- Helper code for use with the "ledger" command-line tool -*- lexical-binding: t; -*- - -;; Copyright (C) 2003-2016 John Wiegley (johnw AT gnu DOT org) - -;; This file is not part of GNU Emacs. - -;; Package-Requires: ((emacs "25.1")) - -;; This is free software; you can redistribute it and/or modify it under -;; the terms of the GNU General Public License as published by the Free -;; Software Foundation; either version 2, or (at your option) any later -;; version. -;; -;; This is distributed in the hope that it will be useful, but WITHOUT -;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or -;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License -;; for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, -;; MA 02110-1301 USA. - -;;; Commentary: -;; This Emacs library provides a major mode for editing files in the format used -;; by the `ledger' command-line accounting system. - -;; It also provides automated support for some `ledger' workflows, such as -;; reconciling transactions, or running certain reports. - -;;; Code: - -(require 'ledger-regex) -(require 'org) -(require 'ledger-commodities) -(require 'ledger-complete) -(require 'ledger-context) -(require 'ledger-exec) -(require 'ledger-fonts) -(require 'ledger-fontify) -(require 'ledger-init) -(require 'ledger-navigate) -(require 'ledger-occur) -(require 'ledger-post) -(require 'ledger-reconcile) -(require 'ledger-report) -(require 'ledger-sort) -(require 'ledger-state) -(require 'ledger-test) -(require 'ledger-texi) -(require 'ledger-xact) -(require 'ledger-schedule) -(require 'ledger-check) - -(declare-function custom-group-members "cus-edit" (symbol groups-only)) - -;;; Code: - -(defgroup ledger nil - "Interface to the Ledger command-line accounting program." - :group 'data) - -(defconst ledger-version "3.0" - "The version of ledger.el currently loaded.") - -(defconst ledger-mode-version "4.0.0") - -(defun ledger-mode-dump-variable (var) - "Format VAR for dump to buffer." - (if var - (insert (format " %s: %S\n" (symbol-name var) (eval var))))) - -(defun ledger-mode-dump-group (group) - "Dump GROUP customizations to current buffer." - (require 'cus-edit) - (let ((members (custom-group-members group nil))) - (dolist (member members) - (cond ((eq (cadr member) 'custom-group) - (insert (format "Group %s:\n" (symbol-name (car member)))) - (ledger-mode-dump-group (car member))) - ((eq (cadr member) 'custom-variable) - (ledger-mode-dump-variable (car member))))))) - -(defun ledger-mode-dump-configuration () - "Dump all customizations." - (interactive) - (find-file "ledger-mode-dump") - (ledger-mode-dump-group 'ledger)) - -(defun ledger-read-account-with-prompt (prompt) - "Read an account from the minibuffer with PROMPT." - (let* ((context (ledger-context-at-point)) - (account (ledger-context-field-value context 'account))) - (ledger-completing-read-with-default prompt - (when account - (regexp-quote account)) - (ledger-accounts-list)))) - -(defun ledger-read-payee-with-prompt (prompt) - "Read a payee from the minibuffer with PROMPT." - (ledger-completing-read-with-default prompt - (when-let ((payee (ledger-xact-payee))) - (regexp-quote payee)) - (ledger-payees-list))) - -(defun ledger-read-date (prompt) - "Return user-supplied date after `PROMPT', defaults to today. -This uses `org-read-date', which see." - (ledger-format-date (let ((org-read-date-prefer-future nil)) - (org-read-date nil t nil prompt)))) - -(defun ledger-get-minibuffer-prompt (prompt default) - "Return a minibuffer prompt string composing PROMPT and DEFAULT." - (concat prompt - (if default - (concat " (" default "): ") - ": "))) - -(defun ledger-completing-read-with-default (prompt default collection) - "Return a user-supplied string after PROMPT. -Use the given DEFAULT, while providing completions from COLLECTION." - (completing-read (ledger-get-minibuffer-prompt prompt default) - collection nil nil nil 'ledger-minibuffer-history default)) - -(defun ledger-read-string-with-default (prompt default) - "Return user supplied string after PROMPT, or DEFAULT." - (read-string (ledger-get-minibuffer-prompt prompt default) - nil 'ledger-minibuffer-history default)) - -(defun ledger-display-balance-at-point (&optional arg) - "Display the cleared-or-pending balance. -And calculate the target-delta of the account being reconciled. - -With ARG (\\[universal-argument]) ask for the target commodity and convert -the balance into that." - (interactive "P") - (let* ((account (ledger-read-account-with-prompt "Account balance to show")) - (target-commodity (when arg (ledger-read-commodity-with-prompt "Target commodity: "))) - (buffer (find-file-noselect (ledger-master-file))) - (balance (with-temp-buffer - (apply 'ledger-exec-ledger buffer (current-buffer) "cleared" account - (when target-commodity (list "-X" target-commodity))) - (if (> (buffer-size) 0) - (buffer-substring-no-properties (point-min) (1- (point-max))) - (concat account " is empty."))))) - (when balance - (display-message-or-buffer balance)))) - -(defun ledger-display-ledger-stats () - "Display some summary statistics about the current ledger file." - (interactive) - (let* ((buffer (find-file-noselect (ledger-master-file))) - (balance (with-temp-buffer - (ledger-exec-ledger buffer (current-buffer) "stats") - (buffer-substring-no-properties (point-min) (1- (point-max)))))) - (when balance - (message balance)))) - -(defvar ledger-mode-abbrev-table) - -(defvar ledger-date-string-today (ledger-format-date)) - -(defun ledger-remove-effective-date () - "Remove the effective date from a transaction or posting." - (interactive) - (let ((context (car (ledger-context-at-point)))) - (save-excursion - (save-restriction - (narrow-to-region (line-beginning-position) (line-end-position)) - (beginning-of-line) - (cond ((eq 'xact context) - (re-search-forward ledger-iso-date-regexp) - (when (= (char-after) ?=) - (let ((eq-pos (point))) - (delete-region - eq-pos - (re-search-forward ledger-iso-date-regexp))))) - ((eq 'acct-transaction context) - ;; Match "; [=date]" & delete string - (when (re-search-forward - (concat ledger-comment-regex - "\\[=" ledger-iso-date-regexp "\\]") - nil 'noerr) - (replace-match "")))))))) - -(defun ledger-insert-effective-date (&optional date) - "Insert effective date `DATE' to the transaction or posting. - -If `DATE' is nil, prompt the user a date. - -Replace the current effective date if there's one in the same -line. - -With a prefix argument, remove the effective date." - (interactive) - (if (and (listp current-prefix-arg) - (= 4 (prefix-numeric-value current-prefix-arg))) - (ledger-remove-effective-date) - (let* ((context (car (ledger-context-at-point))) - (date-string (or date (ledger-read-date "Effective date: ")))) - (save-restriction - (narrow-to-region (line-beginning-position) (line-end-position)) - (cond - ((eq 'xact context) - (beginning-of-line) - (re-search-forward ledger-iso-date-regexp) - (when (= (char-after) ?=) - (ledger-remove-effective-date)) - (insert "=" date-string)) - ((eq 'acct-transaction context) - (end-of-line) - (ledger-remove-effective-date) - (insert " ; [=" date-string "]"))))))) - -(defun ledger-mode-remove-extra-lines () - "Get rid of multiple empty lines." - (goto-char (point-min)) - (while (re-search-forward "\n\n\\(\n\\)+" nil t) - (replace-match "\n\n"))) - -(defun ledger-mode-clean-buffer () - "Indent, remove multiple line feeds and sort the buffer." - (interactive) - (let ((start (point-min-marker)) - (end (point-max-marker)) - (distance-in-xact (- (point) (ledger-navigate-beginning-of-xact)))) - (let ((target (buffer-substring (line-beginning-position) (line-end-position)))) - (goto-char start) - (untabify start end) - (ledger-sort-buffer) - (ledger-post-align-postings start end) - (ledger-mode-remove-extra-lines) - (goto-char start) - (search-forward target) - (beginning-of-line) - (forward-char distance-in-xact)))) - -(defun ledger-rename-account (old new &optional toplevel-only) - "Rename account with name OLD to name NEW. - -Affects account names mentioned in postings as well as declared -with the \"account\" directive. - -By default, child accounts of OLD are also renamed to -corresponding child accounts of NEW. With \\[universal-argument] -prefix, child accounts are not renamed. When called from Lisp, -TOPLEVEL-ONLY has the same meaning." - (interactive "sOld name: \nsNew name: \nP") - (save-excursion - (goto-char (point-min)) - (while (re-search-forward ledger-account-name-or-directive-regex nil t) - (let ((account (match-string 1))) - (cond - ((string-equal account old) - (replace-match new 'fixedcase 'literal nil 1)) - ((and (not toplevel-only) - (string-prefix-p (concat old ":") account)) - (replace-match - (concat new (substring account (length old))) - 'fixedcase 'literal nil 1)))))) - (when ledger-post-auto-align - (ledger-post-align-postings (point-min) (point-max)))) - -(defvar ledger-mode-syntax-table - (let ((table (make-syntax-table text-mode-syntax-table))) - (modify-syntax-entry ?\; "<" table) - (modify-syntax-entry ?\n ">" table) - table) - "Syntax table in use in `ledger-mode' buffers.") - -(defvar ledger-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-c C-a") #'ledger-add-transaction) - (define-key map (kbd "C-c C-b") #'ledger-post-edit-amount) - (define-key map (kbd "C-c C-c") #'ledger-toggle-current) - (define-key map (kbd "C-c C-d") #'ledger-delete-current-transaction) - (define-key map (kbd "C-c C-e") #'ledger-toggle-current-transaction) - (define-key map (kbd "C-c C-f") #'ledger-occur) - (define-key map (kbd "C-c C-k") #'ledger-copy-transaction-at-point) - (define-key map (kbd "C-c C-r") #'ledger-reconcile) - (define-key map (kbd "C-c C-s") #'ledger-sort-region) - (define-key map (kbd "C-c C-t") #'ledger-insert-effective-date) - (define-key map (kbd "C-c C-u") #'ledger-schedule-upcoming) - (define-key map (kbd "C-c C-p") #'ledger-display-balance-at-point) - (define-key map (kbd "C-c C-l") #'ledger-display-ledger-stats) - (define-key map (kbd "C-c C-q") #'ledger-post-align-xact) - - (define-key map (kbd "C-TAB") #'ledger-post-align-xact) - (define-key map (kbd "C-c TAB") #'ledger-fully-complete-xact) - (define-key map (kbd "C-c C-i") #'ledger-fully-complete-xact) - - (define-key map (kbd "C-c C-o C-a") #'ledger-report-redo) - (define-key map (kbd "C-c C-o C-e") #'ledger-report-edit-report) - (define-key map (kbd "C-c C-o C-g") #'ledger-report-goto) - (define-key map (kbd "C-c C-o C-k") #'ledger-report-quit) - (define-key map (kbd "C-c C-o C-r") #'ledger-report) - (define-key map (kbd "C-c C-o C-s") #'ledger-report-save) - - (define-key map (kbd "M-p") #'ledger-navigate-prev-xact-or-directive) - (define-key map (kbd "M-n") #'ledger-navigate-next-xact-or-directive) - (define-key map (kbd "M-q") #'ledger-post-align-dwim) - - ;; Reset the `text-mode' override of this standard binding - (define-key map (kbd "C-M-i") 'completion-at-point) - map) - "Keymap for `ledger-mode'.") - -(easy-menu-define ledger-mode-menu ledger-mode-map - "Ledger menu" - '("Ledger" - ["Narrow to REGEX" ledger-occur] - ["Show all transactions" ledger-occur-mode ledger-occur-mode] - ["Ledger Statistics" ledger-display-ledger-stats ledger-works] - "---" - ["Show upcoming transactions" ledger-schedule-upcoming] - ["Add Transaction (ledger xact)" ledger-add-transaction ledger-works] - ["Complete Transaction" ledger-fully-complete-xact] - ["Delete Transaction" ledger-delete-current-transaction] - "---" - ["Calc on Amount" ledger-post-edit-amount] - "---" - ["Check Balance" ledger-display-balance-at-point ledger-works] - ["Reconcile Account" ledger-reconcile ledger-works] - "---" - ["Toggle Current Transaction" ledger-toggle-current-transaction] - ["Toggle Current Posting" ledger-toggle-current] - ["Copy Trans at Point" ledger-copy-transaction-at-point] - "---" - ["Clean-up Buffer" ledger-mode-clean-buffer] - ["Check Buffer" ledger-check-buffer ledger-works] - ["Align Region" ledger-post-align-postings mark-active] - ["Align Xact" ledger-post-align-xact] - ["Sort Region" ledger-sort-region mark-active] - ["Sort Buffer" ledger-sort-buffer] - ["Mark Sort Beginning" ledger-sort-insert-start-mark] - ["Mark Sort End" ledger-sort-insert-end-mark] - ["Set effective date" ledger-insert-effective-date] - "---" - ["Customize Ledger Mode" (lambda () (interactive) (customize-group 'ledger))] - "---" - ["Run Report" ledger-report ledger-works] - ["Goto Report" ledger-report-goto ledger-works] - ["Re-run Report" ledger-report-redo ledger-works] - ["Save Report" ledger-report-save ledger-works] - ["Edit Report" ledger-report-edit-report ledger-works] - ["Quit Report" ledger-report-quit ledger-works])) - -;;;###autoload -(define-derived-mode ledger-mode text-mode "Ledger" - "A mode for editing ledger data files." - (ledger-check-version) - (setq font-lock-defaults - '(ledger-font-lock-keywords t nil nil nil)) - (add-hook 'font-lock-extend-region-functions 'ledger-fontify-extend-region) - (add-hook 'completion-at-point-functions #'ledger-complete-at-point nil t) - (add-hook 'after-save-hook 'ledger-report-redo nil t) - - (add-hook 'post-command-hook 'ledger-highlight-xact-under-point nil t) - (add-hook 'before-revert-hook 'ledger-highlight--before-revert nil t) - (add-hook 'after-revert-hook 'ledger-highlight-xact-under-point nil t) - - (ledger-init-load-init-file) - (setq-local comment-start ";") - (setq-local indent-line-function #'ledger-indent-line) - (setq-local indent-region-function 'ledger-post-align-postings) - (setq-local beginning-of-defun-function #'ledger-navigate-beginning-of-xact) - (setq-local end-of-defun-function #'ledger-navigate-end-of-xact)) - -;;;###autoload -(add-to-list 'auto-mode-alist '("\\.ledger\\'" . ledger-mode)) - -(provide 'ledger-mode) - -;;; ledger-mode.el ends here diff --git a/emacs/elpa/ledger-mode-20240527.2134/ledger-mode.elc b/emacs/elpa/ledger-mode-20240527.2134/ledger-mode.elc Binary files differ. diff --git a/emacs/elpa/ledger-mode-20240527.2134/ledger-navigate.elc b/emacs/elpa/ledger-mode-20240527.2134/ledger-navigate.elc Binary files differ. diff --git a/emacs/elpa/ledger-mode-20240527.2134/ledger-occur.elc b/emacs/elpa/ledger-mode-20240527.2134/ledger-occur.elc Binary files differ. diff --git a/emacs/elpa/ledger-mode-20240527.2134/ledger-post.elc b/emacs/elpa/ledger-mode-20240527.2134/ledger-post.elc Binary files differ. diff --git a/emacs/elpa/ledger-mode-20240527.2134/ledger-reconcile.elc b/emacs/elpa/ledger-mode-20240527.2134/ledger-reconcile.elc Binary files differ. diff --git a/emacs/elpa/ledger-mode-20240527.2134/ledger-regex.elc b/emacs/elpa/ledger-mode-20240527.2134/ledger-regex.elc Binary files differ. diff --git a/emacs/elpa/ledger-mode-20240527.2134/ledger-report.elc b/emacs/elpa/ledger-mode-20240527.2134/ledger-report.elc Binary files differ. diff --git a/emacs/elpa/ledger-mode-20240527.2134/ledger-schedule.elc b/emacs/elpa/ledger-mode-20240527.2134/ledger-schedule.elc Binary files differ. diff --git a/emacs/elpa/ledger-mode-20240527.2134/ledger-sort.elc b/emacs/elpa/ledger-mode-20240527.2134/ledger-sort.elc Binary files differ. diff --git a/emacs/elpa/ledger-mode-20240527.2134/ledger-state.elc b/emacs/elpa/ledger-mode-20240527.2134/ledger-state.elc Binary files differ. diff --git a/emacs/elpa/ledger-mode-20240527.2134/ledger-test.elc b/emacs/elpa/ledger-mode-20240527.2134/ledger-test.elc Binary files differ. diff --git a/emacs/elpa/ledger-mode-20240527.2134/ledger-texi.elc b/emacs/elpa/ledger-mode-20240527.2134/ledger-texi.elc Binary files differ. diff --git a/emacs/elpa/ledger-mode-20240527.2134/ledger-xact.elc b/emacs/elpa/ledger-mode-20240527.2134/ledger-xact.elc Binary files differ. diff --git a/emacs/elpa/ledger-mode-20240527.2134/dir b/emacs/elpa/ledger-mode-20240622.2052/dir diff --git a/emacs/elpa/ledger-mode-20240527.2134/ledger-check.el b/emacs/elpa/ledger-mode-20240622.2052/ledger-check.el diff --git a/emacs/elpa/ledger-mode-20240622.2052/ledger-check.elc b/emacs/elpa/ledger-mode-20240622.2052/ledger-check.elc Binary files differ. diff --git a/emacs/elpa/ledger-mode-20240527.2134/ledger-commodities.el b/emacs/elpa/ledger-mode-20240622.2052/ledger-commodities.el diff --git a/emacs/elpa/ledger-mode-20240622.2052/ledger-commodities.elc b/emacs/elpa/ledger-mode-20240622.2052/ledger-commodities.elc Binary files differ. diff --git a/emacs/elpa/ledger-mode-20240527.2134/ledger-complete.el b/emacs/elpa/ledger-mode-20240622.2052/ledger-complete.el diff --git a/emacs/elpa/ledger-mode-20240622.2052/ledger-complete.elc b/emacs/elpa/ledger-mode-20240622.2052/ledger-complete.elc Binary files differ. diff --git a/emacs/elpa/ledger-mode-20240527.2134/ledger-context.el b/emacs/elpa/ledger-mode-20240622.2052/ledger-context.el diff --git a/emacs/elpa/ledger-mode-20240622.2052/ledger-context.elc b/emacs/elpa/ledger-mode-20240622.2052/ledger-context.elc Binary files differ. diff --git a/emacs/elpa/ledger-mode-20240527.2134/ledger-exec.el b/emacs/elpa/ledger-mode-20240622.2052/ledger-exec.el diff --git a/emacs/elpa/ledger-mode-20240622.2052/ledger-exec.elc b/emacs/elpa/ledger-mode-20240622.2052/ledger-exec.elc Binary files differ. diff --git a/emacs/elpa/ledger-mode-20240527.2134/ledger-flymake.el b/emacs/elpa/ledger-mode-20240622.2052/ledger-flymake.el diff --git a/emacs/elpa/ledger-mode-20240622.2052/ledger-flymake.elc b/emacs/elpa/ledger-mode-20240622.2052/ledger-flymake.elc Binary files differ. diff --git a/emacs/elpa/ledger-mode-20240527.2134/ledger-fontify.el b/emacs/elpa/ledger-mode-20240622.2052/ledger-fontify.el diff --git a/emacs/elpa/ledger-mode-20240622.2052/ledger-fontify.elc b/emacs/elpa/ledger-mode-20240622.2052/ledger-fontify.elc Binary files differ. diff --git a/emacs/elpa/ledger-mode-20240527.2134/ledger-fonts.el b/emacs/elpa/ledger-mode-20240622.2052/ledger-fonts.el diff --git a/emacs/elpa/ledger-mode-20240622.2052/ledger-fonts.elc b/emacs/elpa/ledger-mode-20240622.2052/ledger-fonts.elc Binary files differ. diff --git a/emacs/elpa/ledger-mode-20240527.2134/ledger-init.el b/emacs/elpa/ledger-mode-20240622.2052/ledger-init.el diff --git a/emacs/elpa/ledger-mode-20240622.2052/ledger-init.elc b/emacs/elpa/ledger-mode-20240622.2052/ledger-init.elc Binary files differ. diff --git a/emacs/elpa/ledger-mode-20240527.2134/ledger-mode-autoloads.el b/emacs/elpa/ledger-mode-20240622.2052/ledger-mode-autoloads.el diff --git a/emacs/elpa/ledger-mode-20240622.2052/ledger-mode-pkg.el b/emacs/elpa/ledger-mode-20240622.2052/ledger-mode-pkg.el @@ -0,0 +1,6 @@ +(define-package "ledger-mode" "20240622.2052" "Helper code for use with the \"ledger\" command-line tool" + '((emacs "25.1")) + :commit "b0e65f74a5a0db98fd1aea2bd87fcf9e489cdacb") +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/emacs/elpa/ledger-mode-20240622.2052/ledger-mode.el b/emacs/elpa/ledger-mode-20240622.2052/ledger-mode.el @@ -0,0 +1,465 @@ +;;; ledger-mode.el --- Helper code for use with the "ledger" command-line tool -*- lexical-binding: t; -*- + +;; Copyright (C) 2003-2016 John Wiegley (johnw AT gnu DOT org) + +;; This file is not part of GNU Emacs. + +;; Package-Requires: ((emacs "25.1")) + +;; This is free software; you can redistribute it and/or modify it under +;; the terms of the GNU General Public License as published by the Free +;; Software Foundation; either version 2, or (at your option) any later +;; version. +;; +;; This is distributed in the hope that it will be useful, but WITHOUT +;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or +;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License +;; for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with GNU Emacs; see the file COPYING. If not, write to the +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, +;; MA 02110-1301 USA. + +;;; Commentary: +;; This Emacs library provides a major mode for editing files in the format used +;; by the `ledger' command-line accounting system. + +;; It also provides automated support for some `ledger' workflows, such as +;; reconciling transactions, or running certain reports. + +;;; Code: + +(require 'ledger-regex) +(require 'org) +(require 'ledger-commodities) +(require 'ledger-complete) +(require 'ledger-context) +(require 'ledger-exec) +(require 'ledger-fonts) +(require 'ledger-fontify) +(require 'ledger-init) +(require 'ledger-navigate) +(require 'ledger-occur) +(require 'ledger-post) +(require 'ledger-reconcile) +(require 'ledger-report) +(require 'ledger-sort) +(require 'ledger-state) +(require 'ledger-test) +(require 'ledger-texi) +(require 'ledger-xact) +(require 'ledger-schedule) +(require 'ledger-check) + +(declare-function custom-group-members "cus-edit" (symbol groups-only)) + +;;; Code: + +(defgroup ledger nil + "Interface to the Ledger command-line accounting program." + :group 'data) + +(defconst ledger-version "3.0" + "The version of ledger.el currently loaded.") + +(defconst ledger-mode-version "4.0.0") + +(defun ledger-mode-dump-variable (var) + "Format VAR for dump to buffer." + (if var + (insert (format " %s: %S\n" (symbol-name var) (eval var))))) + +(defun ledger-mode-dump-group (group) + "Dump GROUP customizations to current buffer." + (require 'cus-edit) + (let ((members (custom-group-members group nil))) + (dolist (member members) + (cond ((eq (cadr member) 'custom-group) + (insert (format "Group %s:\n" (symbol-name (car member)))) + (ledger-mode-dump-group (car member))) + ((eq (cadr member) 'custom-variable) + (ledger-mode-dump-variable (car member))))))) + +(defun ledger-mode-dump-configuration () + "Dump all customizations." + (interactive) + (find-file "ledger-mode-dump") + (ledger-mode-dump-group 'ledger)) + +(defun ledger-read-account-with-prompt (prompt) + "Read an account from the minibuffer with PROMPT." + (let* ((context (ledger-context-at-point)) + (account (ledger-context-field-value context 'account))) + (ledger-completing-read-with-default prompt + (when account + (regexp-quote account)) + (ledger-accounts-list)))) + +(defun ledger-read-payee-with-prompt (prompt) + "Read a payee from the minibuffer with PROMPT." + (ledger-completing-read-with-default prompt + (when-let ((payee (ledger-xact-payee))) + (regexp-quote payee)) + (ledger-payees-list))) + +(defun ledger-read-date (prompt) + "Return user-supplied date after `PROMPT', defaults to today. +This uses `org-read-date', which see." + (ledger-format-date (let ((org-read-date-prefer-future nil)) + (org-read-date nil t nil prompt)))) + +(defun ledger-get-minibuffer-prompt (prompt default) + "Return a minibuffer prompt string composing PROMPT and DEFAULT." + (concat prompt + (if default + (concat " (" default "): ") + ": "))) + +(defun ledger-completing-read-with-default (prompt default collection) + "Return a user-supplied string after PROMPT. +Use the given DEFAULT, while providing completions from COLLECTION." + (completing-read (ledger-get-minibuffer-prompt prompt default) + collection nil nil nil 'ledger-minibuffer-history default)) + +(defun ledger-read-string-with-default (prompt default) + "Return user supplied string after PROMPT, or DEFAULT." + (read-string (ledger-get-minibuffer-prompt prompt default) + nil 'ledger-minibuffer-history default)) + +(defun ledger-display-balance-at-point (&optional arg) + "Display the cleared-or-pending balance. +And calculate the target-delta of the account being reconciled. + +With ARG (\\[universal-argument]) ask for the target commodity and convert +the balance into that." + (interactive "P") + (let* ((account (ledger-read-account-with-prompt "Account balance to show")) + (target-commodity (when arg (ledger-read-commodity-with-prompt "Target commodity: "))) + (buffer (find-file-noselect (ledger-master-file))) + (balance (with-temp-buffer + (apply 'ledger-exec-ledger buffer (current-buffer) "cleared" account + (when target-commodity (list "-X" target-commodity))) + (if (> (buffer-size) 0) + (buffer-substring-no-properties (point-min) (1- (point-max))) + (concat account " is empty."))))) + (when balance + (display-message-or-buffer balance)))) + +(defun ledger-display-ledger-stats () + "Display some summary statistics about the current ledger file." + (interactive) + (let* ((buffer (find-file-noselect (ledger-master-file))) + (balance (with-temp-buffer + (ledger-exec-ledger buffer (current-buffer) "stats") + (buffer-substring-no-properties (point-min) (1- (point-max)))))) + (when balance + (message balance)))) + +(defvar ledger-mode-abbrev-table) + +(defvar ledger-date-string-today (ledger-format-date)) + + + +;;; Editing commands + +(defun ledger-remove-effective-date () + "Remove the effective date from a transaction or posting." + (interactive) + (let ((context (car (ledger-context-at-point)))) + (save-excursion + (save-restriction + (narrow-to-region (line-beginning-position) (line-end-position)) + (beginning-of-line) + (cond ((eq 'xact context) + (re-search-forward ledger-iso-date-regexp) + (when (= (char-after) ?=) + (let ((eq-pos (point))) + (delete-region + eq-pos + (re-search-forward ledger-iso-date-regexp))))) + ((eq 'acct-transaction context) + ;; Match "; [=date]" & delete string + (when (re-search-forward + (concat ledger-comment-regex + "\\[=" ledger-iso-date-regexp "\\]") + nil 'noerr) + (replace-match "")))))))) + +(defun ledger-insert-effective-date (&optional date) + "Insert effective date `DATE' to the transaction or posting. + +If `DATE' is nil, prompt the user a date. + +Replace the current effective date if there's one in the same +line. + +With a prefix argument, remove the effective date." + (interactive) + (if (and (listp current-prefix-arg) + (= 4 (prefix-numeric-value current-prefix-arg))) + (ledger-remove-effective-date) + (let* ((context (car (ledger-context-at-point))) + (date-string (or date (ledger-read-date "Effective date: ")))) + (save-restriction + (narrow-to-region (line-beginning-position) (line-end-position)) + (cond + ((eq 'xact context) + (beginning-of-line) + (re-search-forward ledger-iso-date-regexp) + (when (= (char-after) ?=) + (ledger-remove-effective-date)) + (insert "=" date-string)) + ((eq 'acct-transaction context) + (end-of-line) + (ledger-remove-effective-date) + (insert " ; [=" date-string "]"))))))) + +(defun ledger-mode-remove-extra-lines () + "Get rid of multiple empty lines." + (goto-char (point-min)) + (while (re-search-forward "\n\n\\(\n\\)+" nil t) + (replace-match "\n\n"))) + +(defun ledger-mode-clean-buffer () + "Indent, remove multiple line feeds and sort the buffer." + (interactive) + (let ((start (point-min-marker)) + (end (point-max-marker)) + (distance-in-xact (- (point) (ledger-navigate-beginning-of-xact)))) + (let ((target (buffer-substring (line-beginning-position) (line-end-position)))) + (goto-char start) + (untabify start end) + (ledger-sort-buffer) + (ledger-post-align-postings start end) + (ledger-mode-remove-extra-lines) + (goto-char start) + (search-forward target) + (beginning-of-line) + (forward-char distance-in-xact)))) + +(defun ledger-rename-account (old new &optional toplevel-only) + "Rename account with name OLD to name NEW. + +Affects account names mentioned in postings as well as declared +with the \"account\" directive. + +By default, child accounts of OLD are also renamed to +corresponding child accounts of NEW. With \\[universal-argument] +prefix, child accounts are not renamed. When called from Lisp, +TOPLEVEL-ONLY has the same meaning." + (interactive "sOld name: \nsNew name: \nP") + (save-excursion + (goto-char (point-min)) + (while (re-search-forward ledger-account-name-or-directive-regex nil t) + (let ((account (match-string 1))) + (cond + ((string-equal account old) + (replace-match new 'fixedcase 'literal nil 1)) + ((and (not toplevel-only) + (string-prefix-p (concat old ":") account)) + (replace-match + (concat new (substring account (length old))) + 'fixedcase 'literal nil 1)))))) + (when ledger-post-auto-align + (ledger-post-align-postings (point-min) (point-max)))) + + + +;;; Commands for changing dates + +;; These functions are adapted from the implementation of `org-timestamp-change'. + +(defun ledger--in-regexp (regexp) + "Return (BEG . END) if point is inside a match of REGEXP, or nil. + +Only check the current line for occurrences of REGEXP." + (catch :exit + (let ((pos (point)) + (eol (line-end-position))) + (save-excursion + (beginning-of-line) + (while (and (re-search-forward regexp eol t) + (<= (match-beginning 0) pos)) + (let ((end (match-end 0))) + (when (>= end pos) + (throw :exit (cons (match-beginning 0) (match-end 0)))))))))) + +(defsubst ledger--pos-in-match-range (pos n) + "Return non-nil if POS is inside the range of group N in the match data." + (and (match-beginning n) + (<= (match-beginning n) pos) + (>= (match-end n) pos))) + +(defun ledger--at-date-p () + "Return non-nil if point is inside a date. + +Specifically, return `year', `month', or `day', depending on +which part of the date string point is in." + (let ((pos (point)) + (boundaries (ledger--in-regexp ledger-iso-date-regexp))) + (cond ((null boundaries) nil) + ((ledger--pos-in-match-range pos 2) 'year) + ((ledger--pos-in-match-range pos 3) 'month) + ((ledger--pos-in-match-range pos 4) 'day)))) + +(defun ledger--date-change (n) + "Change the date field at point by N (can be negative)." + (let ((date-cat (ledger--at-date-p)) + (origin-pos (point)) + date-separator + date-str time-old time-new) + (unless date-cat (user-error "Not at a date")) + (setq date-str (match-string 0)) + (setq date-separator + (string (aref date-str 4))) + (save-match-data + (setq time-old (decode-time (ledger-parse-iso-date date-str))) + (setq time-new + ;; Do not pass DST or ZONE arguments here; it should be + ;; automatically inferred from the other arguments, since the + ;; appropriate DST value may differ from `time-old'. + (encode-time + 0 ; second + 0 ; minute + 0 ; hour + (+ (if (eq date-cat 'day) n 0) (nth 3 time-old)) + (+ (if (eq date-cat 'month) n 0) (nth 4 time-old)) + (+ (if (eq date-cat 'year) n 0) (nth 5 time-old))))) + (replace-match (format-time-string (concat "%Y" date-separator "%m" date-separator "%d") + time-new) + 'fixedcase + 'literal) + (goto-char origin-pos))) + +(defun ledger-date-up (&optional arg) + "Increment the date field at point by 1. +With prefix ARG, increment by that many instead." + (interactive "p") + (ledger--date-change arg)) + +(defun ledger-date-down (&optional arg) + "Decrement the date field at point by 1. +With prefix ARG, decrement by that many instead." + (interactive "p") + (ledger--date-change (- arg))) + + + +;;; Major mode definition + +(defvar ledger-mode-syntax-table + (let ((table (make-syntax-table text-mode-syntax-table))) + (modify-syntax-entry ?\; "<" table) + (modify-syntax-entry ?\n ">" table) + table) + "Syntax table in use in `ledger-mode' buffers.") + +(defvar ledger-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-c C-a") #'ledger-add-transaction) + (define-key map (kbd "C-c C-b") #'ledger-post-edit-amount) + (define-key map (kbd "C-c C-c") #'ledger-toggle-current) + (define-key map (kbd "C-c C-d") #'ledger-delete-current-transaction) + (define-key map (kbd "C-c C-e") #'ledger-toggle-current-transaction) + (define-key map (kbd "C-c C-f") #'ledger-occur) + (define-key map (kbd "C-c C-k") #'ledger-copy-transaction-at-point) + (define-key map (kbd "C-c C-r") #'ledger-reconcile) + (define-key map (kbd "C-c C-s") #'ledger-sort-region) + (define-key map (kbd "C-c C-t") #'ledger-insert-effective-date) + (define-key map (kbd "C-c C-u") #'ledger-schedule-upcoming) + (define-key map (kbd "C-c C-p") #'ledger-display-balance-at-point) + (define-key map (kbd "C-c C-l") #'ledger-display-ledger-stats) + (define-key map (kbd "C-c C-q") #'ledger-post-align-xact) + + (define-key map (kbd "C-TAB") #'ledger-post-align-xact) + (define-key map (kbd "C-c TAB") #'ledger-fully-complete-xact) + (define-key map (kbd "C-c C-i") #'ledger-fully-complete-xact) + + (define-key map (kbd "C-c C-o C-a") #'ledger-report-redo) + (define-key map (kbd "C-c C-o C-e") #'ledger-report-edit-report) + (define-key map (kbd "C-c C-o C-g") #'ledger-report-goto) + (define-key map (kbd "C-c C-o C-k") #'ledger-report-quit) + (define-key map (kbd "C-c C-o C-r") #'ledger-report) + (define-key map (kbd "C-c C-o C-s") #'ledger-report-save) + + (define-key map (kbd "M-p") #'ledger-navigate-prev-xact-or-directive) + (define-key map (kbd "M-n") #'ledger-navigate-next-xact-or-directive) + (define-key map (kbd "M-q") #'ledger-post-align-dwim) + + (define-key map (kbd "S-<up>") #'ledger-date-up) + (define-key map (kbd "S-<down>") #'ledger-date-down) + + ;; Reset the `text-mode' override of this standard binding + (define-key map (kbd "C-M-i") 'completion-at-point) + map) + "Keymap for `ledger-mode'.") + +(easy-menu-define ledger-mode-menu ledger-mode-map + "Ledger menu" + '("Ledger" + ["Narrow to REGEX" ledger-occur] + ["Show all transactions" ledger-occur-mode ledger-occur-mode] + ["Ledger Statistics" ledger-display-ledger-stats ledger-works] + "---" + ["Show upcoming transactions" ledger-schedule-upcoming] + ["Add Transaction (ledger xact)" ledger-add-transaction ledger-works] + ["Complete Transaction" ledger-fully-complete-xact] + ["Delete Transaction" ledger-delete-current-transaction] + "---" + ["Calc on Amount" ledger-post-edit-amount] + "---" + ["Check Balance" ledger-display-balance-at-point ledger-works] + ["Reconcile Account" ledger-reconcile ledger-works] + "---" + ["Toggle Current Transaction" ledger-toggle-current-transaction] + ["Toggle Current Posting" ledger-toggle-current] + ["Copy Trans at Point" ledger-copy-transaction-at-point] + "---" + ["Clean-up Buffer" ledger-mode-clean-buffer] + ["Check Buffer" ledger-check-buffer ledger-works] + ["Align Region" ledger-post-align-postings mark-active] + ["Align Xact" ledger-post-align-xact] + ["Sort Region" ledger-sort-region mark-active] + ["Sort Buffer" ledger-sort-buffer] + ["Mark Sort Beginning" ledger-sort-insert-start-mark] + ["Mark Sort End" ledger-sort-insert-end-mark] + ["Set effective date" ledger-insert-effective-date] + "---" + ["Customize Ledger Mode" (lambda () (interactive) (customize-group 'ledger))] + "---" + ["Run Report" ledger-report ledger-works] + ["Goto Report" ledger-report-goto ledger-works] + ["Re-run Report" ledger-report-redo ledger-works] + ["Save Report" ledger-report-save ledger-works] + ["Edit Report" ledger-report-edit-report ledger-works] + ["Quit Report" ledger-report-quit ledger-works])) + +;;;###autoload +(define-derived-mode ledger-mode text-mode "Ledger" + "A mode for editing ledger data files." + (ledger-check-version) + (setq font-lock-defaults + '(ledger-font-lock-keywords t nil nil nil)) + (add-hook 'font-lock-extend-region-functions 'ledger-fontify-extend-region) + (add-hook 'completion-at-point-functions #'ledger-complete-at-point nil t) + (add-hook 'after-save-hook 'ledger-report-redo nil t) + + (add-hook 'post-command-hook 'ledger-highlight-xact-under-point nil t) + (add-hook 'before-revert-hook 'ledger-highlight--before-revert nil t) + (add-hook 'after-revert-hook 'ledger-highlight-xact-under-point nil t) + + (ledger-init-load-init-file) + (setq-local comment-start ";") + (setq-local indent-line-function #'ledger-indent-line) + (setq-local indent-region-function 'ledger-post-align-postings) + (setq-local beginning-of-defun-function #'ledger-navigate-beginning-of-xact) + (setq-local end-of-defun-function #'ledger-navigate-end-of-xact)) + +;;;###autoload +(add-to-list 'auto-mode-alist '("\\.ledger\\'" . ledger-mode)) + +(provide 'ledger-mode) + +;;; ledger-mode.el ends here diff --git a/emacs/elpa/ledger-mode-20240622.2052/ledger-mode.elc b/emacs/elpa/ledger-mode-20240622.2052/ledger-mode.elc Binary files differ. diff --git a/emacs/elpa/ledger-mode-20240527.2134/ledger-mode.info b/emacs/elpa/ledger-mode-20240622.2052/ledger-mode.info diff --git a/emacs/elpa/ledger-mode-20240527.2134/ledger-navigate.el b/emacs/elpa/ledger-mode-20240622.2052/ledger-navigate.el diff --git a/emacs/elpa/ledger-mode-20240622.2052/ledger-navigate.elc b/emacs/elpa/ledger-mode-20240622.2052/ledger-navigate.elc Binary files differ. diff --git a/emacs/elpa/ledger-mode-20240527.2134/ledger-occur.el b/emacs/elpa/ledger-mode-20240622.2052/ledger-occur.el diff --git a/emacs/elpa/ledger-mode-20240622.2052/ledger-occur.elc b/emacs/elpa/ledger-mode-20240622.2052/ledger-occur.elc Binary files differ. diff --git a/emacs/elpa/ledger-mode-20240527.2134/ledger-post.el b/emacs/elpa/ledger-mode-20240622.2052/ledger-post.el diff --git a/emacs/elpa/ledger-mode-20240622.2052/ledger-post.elc b/emacs/elpa/ledger-mode-20240622.2052/ledger-post.elc Binary files differ. diff --git a/emacs/elpa/ledger-mode-20240527.2134/ledger-reconcile.el b/emacs/elpa/ledger-mode-20240622.2052/ledger-reconcile.el diff --git a/emacs/elpa/ledger-mode-20240622.2052/ledger-reconcile.elc b/emacs/elpa/ledger-mode-20240622.2052/ledger-reconcile.elc Binary files differ. diff --git a/emacs/elpa/ledger-mode-20240527.2134/ledger-regex.el b/emacs/elpa/ledger-mode-20240622.2052/ledger-regex.el diff --git a/emacs/elpa/ledger-mode-20240622.2052/ledger-regex.elc b/emacs/elpa/ledger-mode-20240622.2052/ledger-regex.elc Binary files differ. diff --git a/emacs/elpa/ledger-mode-20240527.2134/ledger-report.el b/emacs/elpa/ledger-mode-20240622.2052/ledger-report.el diff --git a/emacs/elpa/ledger-mode-20240622.2052/ledger-report.elc b/emacs/elpa/ledger-mode-20240622.2052/ledger-report.elc Binary files differ. diff --git a/emacs/elpa/ledger-mode-20240527.2134/ledger-schedule.el b/emacs/elpa/ledger-mode-20240622.2052/ledger-schedule.el diff --git a/emacs/elpa/ledger-mode-20240622.2052/ledger-schedule.elc b/emacs/elpa/ledger-mode-20240622.2052/ledger-schedule.elc Binary files differ. diff --git a/emacs/elpa/ledger-mode-20240527.2134/ledger-sort.el b/emacs/elpa/ledger-mode-20240622.2052/ledger-sort.el diff --git a/emacs/elpa/ledger-mode-20240622.2052/ledger-sort.elc b/emacs/elpa/ledger-mode-20240622.2052/ledger-sort.elc Binary files differ. diff --git a/emacs/elpa/ledger-mode-20240527.2134/ledger-state.el b/emacs/elpa/ledger-mode-20240622.2052/ledger-state.el diff --git a/emacs/elpa/ledger-mode-20240622.2052/ledger-state.elc b/emacs/elpa/ledger-mode-20240622.2052/ledger-state.elc Binary files differ. diff --git a/emacs/elpa/ledger-mode-20240527.2134/ledger-test.el b/emacs/elpa/ledger-mode-20240622.2052/ledger-test.el diff --git a/emacs/elpa/ledger-mode-20240622.2052/ledger-test.elc b/emacs/elpa/ledger-mode-20240622.2052/ledger-test.elc Binary files differ. diff --git a/emacs/elpa/ledger-mode-20240527.2134/ledger-texi.el b/emacs/elpa/ledger-mode-20240622.2052/ledger-texi.el diff --git a/emacs/elpa/ledger-mode-20240622.2052/ledger-texi.elc b/emacs/elpa/ledger-mode-20240622.2052/ledger-texi.elc Binary files differ. diff --git a/emacs/elpa/ledger-mode-20240527.2134/ledger-xact.el b/emacs/elpa/ledger-mode-20240622.2052/ledger-xact.el diff --git a/emacs/elpa/ledger-mode-20240622.2052/ledger-xact.elc b/emacs/elpa/ledger-mode-20240622.2052/ledger-xact.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-cucumber.el b/emacs/elpa/lsp-mode-20240619.951/lsp-cucumber.el @@ -1,68 +0,0 @@ -;;; lsp-cucumber.el --- LSP Clients for Cucumber -*- lexical-binding: t; -*- - -;; Copyright (C) 2024 Shen, Jen-Chieh - -;; This file is not part of GNU Emacs. - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <https://www.gnu.org/licenses/>. - -;;; Commentary: -;; -;; LSP server implementation for Cucumber -;; - -;;; Code: - -(require 'lsp-mode) - -(defgroup lsp-cucumber nil - "LSP server implementation for Cucumber." - :group 'lsp-mode - :link '(url-link "https://github.com/cucumber/language-server")) - -(defcustom lsp-cucumber-server-path nil - "Path points for Cucumber language server. - -This is only for development use." - :type 'string - :group 'lsp-cucumber) - -(defcustom lsp-cucumber-active-modes - '( feature-mode) - "List of major mode that work with Cucumber language server." - :type 'list - :group 'lsp-cucumber) - -(defun lsp-cucumber--server-command () - "Generate startup command for Cucumber language server." - (or (and lsp-cucumber-server-path - (list lsp-cucumber-server-path "--stdio")) - (list (lsp-package-path 'cucumber-language-server) "--stdio"))) - -(lsp-dependency 'cucumber-language-server - '(:system "cucumber-language-server") - '(:npm :package "@cucumber/language-server" - :path "cucumber-language-server")) - -(lsp-register-client - (make-lsp-client - :new-connection (lsp-stdio-connection #'lsp-cucumber--server-command) - :major-modes lsp-cucumber-active-modes - :priority -1 - :server-id 'cucumber-language-server - :download-server-fn (lambda (_client callback error-callback _update?) - (lsp-package-ensure 'cucumber-language-server callback error-callback)))) - -(provide 'lsp-cucumber) -;;; lsp-cucumber.el ends here diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-cucumber.elc b/emacs/elpa/lsp-mode-20240619.951/lsp-cucumber.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-mode-autoloads.el b/emacs/elpa/lsp-mode-20240619.951/lsp-mode-autoloads.el @@ -1,979 +0,0 @@ -;;; lsp-mode-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*- -;; Generated by the `loaddefs-generate' function. - -;; This file is part of GNU Emacs. - -;;; Code: - -(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path))) - - - -;;; Generated autoloads from lsp-actionscript.el - -(register-definition-prefixes "lsp-actionscript" '("lsp-actionscript-")) - - -;;; Generated autoloads from lsp-ada.el - -(register-definition-prefixes "lsp-ada" '("lsp-ada-")) - - -;;; Generated autoloads from lsp-angular.el - -(register-definition-prefixes "lsp-angular" '("lsp-client")) - - -;;; Generated autoloads from lsp-ansible.el - -(register-definition-prefixes "lsp-ansible" '("lsp-ansible-")) - - -;;; Generated autoloads from lsp-asm.el - -(register-definition-prefixes "lsp-asm" '("lsp-asm-")) - - -;;; Generated autoloads from lsp-astro.el - -(register-definition-prefixes "lsp-astro" '("lsp-astro--get-initialization-options")) - - -;;; Generated autoloads from lsp-autotools.el - -(register-definition-prefixes "lsp-autotools" '("lsp-autotools-")) - - -;;; Generated autoloads from lsp-awk.el - -(register-definition-prefixes "lsp-awk" '("lsp-awk-executable")) - - -;;; Generated autoloads from lsp-bash.el - -(register-definition-prefixes "lsp-bash" '("lsp-bash-")) - - -;;; Generated autoloads from lsp-beancount.el - -(register-definition-prefixes "lsp-beancount" '("lsp-beancount-")) - - -;;; Generated autoloads from lsp-bufls.el - -(register-definition-prefixes "lsp-bufls" '("lsp-bufls-")) - - -;;; Generated autoloads from lsp-camel.el - -(register-definition-prefixes "lsp-camel" '("lsp-camel-")) - - -;;; 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)") -(register-definition-prefixes "lsp-clangd" '("lsp-c")) - - -;;; 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) -(autoload 'lsp-clojure-show-project-tree "lsp-clojure" "\ -Show a project tree with source-paths and dependencies. -Focus on it if IGNORE-FOCUS? is nil. - -(fn IGNORE-FOCUS?)" t) -(register-definition-prefixes "lsp-clojure" '("lsp-clojure-")) - - -;;; Generated autoloads from lsp-cmake.el - -(register-definition-prefixes "lsp-cmake" '("lsp-cmake-")) - - -;;; Generated autoloads from lsp-cobol.el - -(add-hook 'cobol-mode-hook #'lsp-cobol-start-ls) -(autoload 'lsp-cobol-start-ls "lsp-cobol" "\ -Start the COBOL language service." t) -(register-definition-prefixes "lsp-cobol" '("lsp-cobol-")) - - -;;; 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.") -(autoload 'lsp-completion--enable "lsp-completion" "\ -Enable LSP completion support.") -(autoload 'lsp-completion-mode "lsp-completion" "\ -Toggle LSP completion support. - -This is a minor mode. If called interactively, toggle the -`Lsp-Completion 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 `lsp-completion-mode'. - -The mode's hook is called both when the mode is enabled and when -it is disabled. - -(fn &optional ARG)" t) -(add-hook 'lsp-configure-hook (lambda nil (when (and lsp-auto-configure lsp-completion-enable) (lsp-completion--enable)))) -(register-definition-prefixes "lsp-completion" '("lsp-")) - - -;;; Generated autoloads from lsp-credo.el - -(register-definition-prefixes "lsp-credo" '("lsp-credo-")) - - -;;; Generated autoloads from lsp-crystal.el - -(register-definition-prefixes "lsp-crystal" '("lsp-clients-crystal-executable")) - - -;;; Generated autoloads from lsp-csharp.el - -(register-definition-prefixes "lsp-csharp" '("lsp-csharp-")) - - -;;; Generated autoloads from lsp-css.el - -(register-definition-prefixes "lsp-css" '("lsp-css-")) - - -;;; Generated autoloads from lsp-cucumber.el - -(register-definition-prefixes "lsp-cucumber" '("lsp-cucumber-")) - - -;;; Generated autoloads from lsp-cypher.el - -(register-definition-prefixes "lsp-cypher" '("lsp-client--cypher-ls-server-command")) - - -;;; 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") -(autoload 'lsp-diagnostics--enable "lsp-diagnostics" "\ -Enable LSP checker support.") -(autoload 'lsp-diagnostics-mode "lsp-diagnostics" "\ -Toggle LSP diagnostics integration. - -This is a minor mode. If called interactively, toggle the -`Lsp-Diagnostics 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 `lsp-diagnostics-mode'. - -The mode's hook is called both when the mode is enabled and when -it is disabled. - -(fn &optional ARG)" t) -(add-hook 'lsp-configure-hook (lambda nil (when lsp-auto-configure (lsp-diagnostics--enable)))) -(register-definition-prefixes "lsp-diagnostics" '("lsp-diagnostics-")) - - -;;; 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. - -This is a global minor mode. If called interactively, toggle the -`Lsp-Dired 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 `(default-value \\='lsp-dired-mode)'. - -The mode's hook is called both when the mode is enabled and when -it is disabled. - -(fn &optional ARG)" t) -(register-definition-prefixes "lsp-dired" '("lsp-dired-")) - - -;;; Generated autoloads from lsp-dockerfile.el - -(register-definition-prefixes "lsp-dockerfile" '("lsp-dockerfile-language-server-command")) - - -;;; Generated autoloads from lsp-dot.el - -(register-definition-prefixes "lsp-dot" '("lsp-dot--dot-ls-server-command")) - - -;;; Generated autoloads from lsp-earthly.el - -(register-definition-prefixes "lsp-earthly" '("lsp-earthly-")) - - -;;; Generated autoloads from lsp-elixir.el - -(register-definition-prefixes "lsp-elixir" '("lsp-elixir-")) - - -;;; Generated autoloads from lsp-elm.el - -(register-definition-prefixes "lsp-elm" '("lsp-")) - - -;;; Generated autoloads from lsp-emmet.el - -(register-definition-prefixes "lsp-emmet" '("lsp-emmet-ls-command")) - - -;;; Generated autoloads from lsp-erlang.el - -(register-definition-prefixes "lsp-erlang" '("lsp-erlang-")) - - -;;; Generated autoloads from lsp-eslint.el - -(register-definition-prefixes "lsp-eslint" '("lsp-")) - - -;;; Generated autoloads from lsp-fortran.el - -(register-definition-prefixes "lsp-fortran" '("lsp-clients-")) - - -;;; Generated autoloads from lsp-fsharp.el - -(autoload 'lsp-fsharp--workspace-load "lsp-fsharp" "\ -Load all of the provided PROJECTS. - -(fn PROJECTS)") -(register-definition-prefixes "lsp-fsharp" '("lsp-fsharp-")) - - -;;; Generated autoloads from lsp-gdscript.el - -(register-definition-prefixes "lsp-gdscript" '("lsp-gdscript-")) - - -;;; Generated autoloads from lsp-gleam.el - -(register-definition-prefixes "lsp-gleam" '("lsp-gleam-executable")) - - -;;; Generated autoloads from lsp-glsl.el - -(register-definition-prefixes "lsp-glsl" '("lsp-glsl-executable")) - - -;;; Generated autoloads from lsp-go.el - -(register-definition-prefixes "lsp-go" '("lsp-go-")) - - -;;; Generated autoloads from lsp-golangci-lint.el - -(register-definition-prefixes "lsp-golangci-lint" '("lsp-golangci-lint-")) - - -;;; Generated autoloads from lsp-graphql.el - -(register-definition-prefixes "lsp-graphql" '("lsp-")) - - -;;; Generated autoloads from lsp-groovy.el - -(register-definition-prefixes "lsp-groovy" '("lsp-groovy-")) - - -;;; Generated autoloads from lsp-hack.el - -(register-definition-prefixes "lsp-hack" '("lsp-clients-hack-command")) - - -;;; Generated autoloads from lsp-haxe.el - -(register-definition-prefixes "lsp-haxe" '("lsp-")) - - -;;; Generated autoloads from lsp-headerline.el - -(autoload 'lsp-headerline-breadcrumb-mode "lsp-headerline" "\ -Toggle breadcrumb on headerline. - -This is a minor mode. If called interactively, toggle the -`Lsp-Headerline-Breadcrumb 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 `lsp-headerline-breadcrumb-mode'. - -The mode's hook is called both when the mode is enabled and when -it is disabled. - -(fn &optional ARG)" t) -(autoload 'lsp-breadcrumb-go-to-symbol "lsp-headerline" "\ -Go to the symbol on breadcrumb at SYMBOL-POSITION. - -(fn SYMBOL-POSITION)" t) -(autoload 'lsp-breadcrumb-narrow-to-symbol "lsp-headerline" "\ -Narrow to the symbol range on breadcrumb at SYMBOL-POSITION. - -(fn SYMBOL-POSITION)" t) -(register-definition-prefixes "lsp-headerline" '("lsp-headerline-")) - - -;;; Generated autoloads from lsp-html.el - -(register-definition-prefixes "lsp-html" '("lsp-html-")) - - -;;; Generated autoloads from lsp-hy.el - -(register-definition-prefixes "lsp-hy" '("lsp-clients-hy-server-executable")) - - -;;; Generated autoloads from lsp-icons.el - -(register-definition-prefixes "lsp-icons" '("lsp-")) - - -;;; 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) -(register-definition-prefixes "lsp-ido" '("lsp-ido-")) - - -;;; Generated autoloads from lsp-idris.el - -(register-definition-prefixes "lsp-idris" '("lsp-idris2-lsp-")) - - -;;; 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) -(autoload 'lsp-iedit-linked-ranges "lsp-iedit" "\ -Start an `iedit' for `textDocument/linkedEditingRange'" t) -(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) -(autoload 'lsp-evil-multiedit-linked-ranges "lsp-iedit" "\ -Start an `evil-multiedit' for `textDocument/linkedEditingRange'" t) -(autoload 'lsp-evil-state-highlights "lsp-iedit" "\ -Start `iedit-mode'. for `textDocument/documentHighlight'" t) -(autoload 'lsp-evil-state-linked-ranges "lsp-iedit" "\ -Start `iedit-mode'. for `textDocument/linkedEditingRange'" t) -(register-definition-prefixes "lsp-iedit" '("lsp-iedit--on-ranges")) - - -;;; Generated autoloads from lsp-javascript.el - -(register-definition-prefixes "lsp-javascript" '("lsp-")) - - -;;; Generated autoloads from lsp-jq.el - -(register-definition-prefixes "lsp-jq" '("lsp-clients-jq-server-executable")) - - -;;; Generated autoloads from lsp-json.el - -(register-definition-prefixes "lsp-json" '("lsp-")) - - -;;; Generated autoloads from lsp-jsonnet.el - -(register-definition-prefixes "lsp-jsonnet" '("lsp-clients-jsonnet-server-executable")) - - -;;; Generated autoloads from lsp-kotlin.el - -(register-definition-prefixes "lsp-kotlin" '("lsp-")) - - -;;; Generated autoloads from lsp-lens.el - -(autoload 'lsp-lens--enable "lsp-lens" "\ -Enable lens mode.") -(autoload 'lsp-lens-show "lsp-lens" "\ -Display lenses in the buffer." t) -(autoload 'lsp-lens-hide "lsp-lens" "\ -Delete all lenses." t) -(autoload 'lsp-lens-mode "lsp-lens" "\ -Toggle code-lens overlays. - -This is a minor mode. If called interactively, toggle the -`Lsp-Lens 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 `lsp-lens-mode'. - -The mode's hook is called both when the mode is enabled and when -it is disabled. - -(fn &optional ARG)" t) -(autoload 'lsp-avy-lens "lsp-lens" "\ -Click lsp lens using `avy' package." t) -(register-definition-prefixes "lsp-lens" '("lsp-")) - - -;;; Generated autoloads from lsp-lisp.el - -(autoload 'lsp-lisp-alive-start-ls "lsp-lisp" "\ -Start the alive-lsp." t) -(register-definition-prefixes "lsp-lisp" '("lsp-lisp-a")) - - -;;; Generated autoloads from lsp-lua.el - -(register-definition-prefixes "lsp-lua" '("lsp-")) - - -;;; Generated autoloads from lsp-magik.el - -(register-definition-prefixes "lsp-magik" '("lsp-magik-")) - - -;;; Generated autoloads from lsp-markdown.el - -(register-definition-prefixes "lsp-markdown" '("lsp-markdown-")) - - -;;; Generated autoloads from lsp-marksman.el - -(register-definition-prefixes "lsp-marksman" '("lsp-marksman-")) - - -;;; Generated autoloads from lsp-mdx.el - -(register-definition-prefixes "lsp-mdx" '("lsp-mdx-server-command")) - - -;;; Generated autoloads from lsp-meson.el - -(register-definition-prefixes "lsp-meson" '("lsp-meson-")) - - -;;; Generated autoloads from lsp-mint.el - -(register-definition-prefixes "lsp-mint" '("lsp-clients-mint-executable")) - - -;;; 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)") -(autoload 'lsp-load-vscode-workspace "lsp-mode" "\ -Load vscode workspace from FILE - -(fn FILE)" t) -(autoload 'lsp-save-vscode-workspace "lsp-mode" "\ -Save vscode workspace to FILE - -(fn FILE)" t) -(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) -(autoload 'lsp-uninstall-server "lsp-mode" "\ -Delete a LSP server from `lsp-server-install-dir'. - -(fn DIR)" t) -(autoload 'lsp-uninstall-servers "lsp-mode" "\ -Uninstall all installed servers." t) -(autoload 'lsp-update-server "lsp-mode" "\ -Interactively update (reinstall) a server. - -(fn &optional SERVER-ID)" t) -(autoload 'lsp-update-servers "lsp-mode" "\ -Update (reinstall) all installed servers." t) -(autoload 'lsp-ensure-server "lsp-mode" "\ -Ensure server SERVER-ID - -(fn SERVER-ID)") -(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) -(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.") -(autoload 'lsp-start-plain "lsp-mode" "\ -Start `lsp-mode' using minimal configuration using the latest `melpa' version -of the packages. - -In case the major-mode that you are using for " t) -(register-definition-prefixes "lsp-mode" '("defcustom-lsp" "lsp-" "make-lsp-client" "when-lsp-workspace" "with-lsp-workspace")) - - -;;; 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. - -This is a minor mode. If called interactively, toggle the -`Lsp-Modeline-Code-Actions 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 `lsp-modeline-code-actions-mode'. - -The mode's hook is called both when the mode is enabled and when -it is disabled. - -(fn &optional ARG)" t) -(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. - -This is a minor mode. If called interactively, toggle the -`Lsp-Modeline-Diagnostics 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 `lsp-modeline-diagnostics-mode'. - -The mode's hook is called both when the mode is enabled and when -it is disabled. - -(fn &optional ARG)" t) -(autoload 'lsp-modeline-workspace-status-mode "lsp-modeline" "\ -Toggle workspace status on modeline. - -This is a minor mode. If called interactively, toggle the -`Lsp-Modeline-Workspace-Status 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 `lsp-modeline-workspace-status-mode'. - -The mode's hook is called both when the mode is enabled and when -it is disabled. - -(fn &optional ARG)" t) -(register-definition-prefixes "lsp-modeline" '("lsp-")) - - -;;; Generated autoloads from lsp-mojo.el - -(register-definition-prefixes "lsp-mojo" '("lsp-mojo-executable")) - - -;;; Generated autoloads from lsp-move.el - -(register-definition-prefixes "lsp-move" '("lsp-clients-")) - - -;;; Generated autoloads from lsp-nginx.el - -(register-definition-prefixes "lsp-nginx" '("lsp-nginx-")) - - -;;; Generated autoloads from lsp-nim.el - -(register-definition-prefixes "lsp-nim" '("lsp-nim-l")) - - -;;; Generated autoloads from lsp-nix.el - -(register-definition-prefixes "lsp-nix" '("lsp-nix-")) - - -;;; Generated autoloads from lsp-nushell.el - -(register-definition-prefixes "lsp-nushell" '("lsp-nushell-language-server-command")) - - -;;; Generated autoloads from lsp-ocaml.el - -(register-definition-prefixes "lsp-ocaml" '("lsp-")) - - -;;; Generated autoloads from lsp-openscad.el - -(register-definition-prefixes "lsp-openscad" '("lsp-openscad-")) - - -;;; Generated autoloads from lsp-perl.el - -(register-definition-prefixes "lsp-perl" '("lsp-perl-")) - - -;;; Generated autoloads from lsp-perlnavigator.el - -(register-definition-prefixes "lsp-perlnavigator" '("lsp-perlnavigator-")) - - -;;; Generated autoloads from lsp-php.el - -(register-definition-prefixes "lsp-php" '("lsp-")) - - -;;; Generated autoloads from lsp-pls.el - -(register-definition-prefixes "lsp-pls" '("lsp-pls-")) - - -;;; Generated autoloads from lsp-prolog.el - -(register-definition-prefixes "lsp-prolog" '("lsp-prolog-server-command")) - - -;;; Generated autoloads from lsp-protocol.el - -(register-definition-prefixes "lsp-protocol" '("dash-expand:&RangeToPoint" "lsp")) - - -;;; Generated autoloads from lsp-purescript.el - -(register-definition-prefixes "lsp-purescript" '("lsp-purescript-")) - - -;;; Generated autoloads from lsp-pwsh.el - -(register-definition-prefixes "lsp-pwsh" '("lsp-pwsh-")) - - -;;; Generated autoloads from lsp-pyls.el - -(register-definition-prefixes "lsp-pyls" '("lsp-")) - - -;;; Generated autoloads from lsp-pylsp.el - -(register-definition-prefixes "lsp-pylsp" '("lsp-")) - - -;;; Generated autoloads from lsp-qml.el - -(register-definition-prefixes "lsp-qml" '("lsp-qml-server-command")) - - -;;; Generated autoloads from lsp-r.el - -(register-definition-prefixes "lsp-r" '("lsp-clients-r-server-command")) - - -;;; Generated autoloads from lsp-racket.el - -(register-definition-prefixes "lsp-racket" '("lsp-racket-lang")) - - -;;; Generated autoloads from lsp-remark.el - -(register-definition-prefixes "lsp-remark" '("lsp-remark-server-command")) - - -;;; Generated autoloads from lsp-rf.el - -(register-definition-prefixes "lsp-rf" '("expand-start-command" "lsp-rf-language-server-" "parse-rf-language-server-")) - - -;;; Generated autoloads from lsp-rpm-spec.el - -(register-definition-prefixes "lsp-rpm-spec" '("lsp-rpm-spec-")) - - -;;; Generated autoloads from lsp-rubocop.el - -(register-definition-prefixes "lsp-rubocop" '("lsp-rubocop-")) - - -;;; Generated autoloads from lsp-ruby-lsp.el - -(register-definition-prefixes "lsp-ruby-lsp" '("lsp-ruby-lsp-")) - - -;;; Generated autoloads from lsp-ruby-syntax-tree.el - -(register-definition-prefixes "lsp-ruby-syntax-tree" '("lsp-ruby-syntax-tree-")) - - -;;; Generated autoloads from lsp-ruff-lsp.el - -(register-definition-prefixes "lsp-ruff-lsp" '("lsp-ruff-lsp-")) - - -;;; Generated autoloads from lsp-rust.el - -(register-definition-prefixes "lsp-rust" '("lsp-")) - - -;;; Generated autoloads from lsp-semantic-tokens.el - -(defvar-local semantic-token-modifier-cache (make-hash-table) "\ -A cache of modifier values to the selected fonts. -This allows whole-bitmap lookup instead of checking each bit. The -expectation is that usage of modifiers will tend to cluster, so -we will not have the full range of possible usages, hence a -tractable hash map. - -This is set as buffer-local. It should probably be shared in a -given workspace/language-server combination. - -This cache should be flushed every time any modifier -configuration changes.") -(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.") -(autoload 'lsp--semantic-tokens-initialize-workspace "lsp-semantic-tokens" "\ -Initialize semantic tokens for WORKSPACE. - -(fn WORKSPACE)") -(autoload 'lsp-semantic-tokens--warn-about-deprecated-setting "lsp-semantic-tokens" "\ -Warn about deprecated semantic highlighting variable.") -(autoload 'lsp-semantic-tokens--enable "lsp-semantic-tokens" "\ -Enable semantic tokens mode.") -(autoload 'lsp-semantic-tokens-mode "lsp-semantic-tokens" "\ -Toggle semantic-tokens support. - -This is a minor mode. If called interactively, toggle the -`Lsp-Semantic-Tokens 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 `lsp-semantic-tokens-mode'. - -The mode's hook is called both when the mode is enabled and when -it is disabled. - -(fn &optional ARG)" t) -(register-definition-prefixes "lsp-semantic-tokens" '("lsp-")) - - -;;; Generated autoloads from lsp-semgrep.el - -(register-definition-prefixes "lsp-semgrep" '("lsp-semgrep-" "semgrep-")) - - -;;; Generated autoloads from lsp-sml.el - -(register-definition-prefixes "lsp-sml" '("lsp-sml-millet-")) - - -;;; Generated autoloads from lsp-solargraph.el - -(register-definition-prefixes "lsp-solargraph" '("lsp-solargraph-")) - - -;;; Generated autoloads from lsp-solidity.el - -(register-definition-prefixes "lsp-solidity" '("lsp-client--solidity-")) - - -;;; Generated autoloads from lsp-sorbet.el - -(register-definition-prefixes "lsp-sorbet" '("lsp-sorbet-")) - - -;;; Generated autoloads from lsp-sql.el - -(register-definition-prefixes "lsp-sql" '("lsp-sql-")) - - -;;; Generated autoloads from lsp-sqls.el - -(register-definition-prefixes "lsp-sqls" '("lsp-sql")) - - -;;; Generated autoloads from lsp-steep.el - -(register-definition-prefixes "lsp-steep" '("lsp-steep-")) - - -;;; Generated autoloads from lsp-svelte.el - -(register-definition-prefixes "lsp-svelte" '("lsp-svelte-plugin-")) - - -;;; Generated autoloads from lsp-terraform.el - -(register-definition-prefixes "lsp-terraform" '("construct-tf-package" "lsp-t")) - - -;;; Generated autoloads from lsp-tex.el - -(register-definition-prefixes "lsp-tex" '("lsp-")) - - -;;; Generated autoloads from lsp-toml.el - -(register-definition-prefixes "lsp-toml" '("lsp-toml-")) - - -;;; Generated autoloads from lsp-trunk.el - -(register-definition-prefixes "lsp-trunk" '("lsp-trunk-")) - - -;;; Generated autoloads from lsp-ttcn3.el - -(register-definition-prefixes "lsp-ttcn3" '("lsp-ttcn3-lsp-server-command")) - - -;;; Generated autoloads from lsp-typeprof.el - -(register-definition-prefixes "lsp-typeprof" '("lsp-typeprof-")) - - -;;; Generated autoloads from lsp-v.el - -(register-definition-prefixes "lsp-v" '("lsp-v-vls-executable")) - - -;;; Generated autoloads from lsp-vala.el - -(register-definition-prefixes "lsp-vala" '("lsp-clients-vala-ls-executable")) - - -;;; Generated autoloads from lsp-verilog.el - -(register-definition-prefixes "lsp-verilog" '("lsp-clients-")) - - -;;; Generated autoloads from lsp-vetur.el - -(register-definition-prefixes "lsp-vetur" '("lsp-vetur-")) - - -;;; Generated autoloads from lsp-vhdl.el - -(register-definition-prefixes "lsp-vhdl" '("ghdl-ls-bin-name" "hdl-checker-bin-name" "lsp-vhdl-" "vhdl-")) - - -;;; Generated autoloads from lsp-vimscript.el - -(register-definition-prefixes "lsp-vimscript" '("lsp-clients-vim-")) - - -;;; Generated autoloads from lsp-volar.el - -(register-definition-prefixes "lsp-volar" '("lsp-volar-")) - - -;;; Generated autoloads from lsp-wgsl.el - -(register-definition-prefixes "lsp-wgsl" '("lsp-wgsl-")) - - -;;; Generated autoloads from lsp-xml.el - -(register-definition-prefixes "lsp-xml" '("lsp-xml-")) - - -;;; Generated autoloads from lsp-yaml.el - -(register-definition-prefixes "lsp-yaml" '("lsp-yaml-")) - - -;;; Generated autoloads from lsp-yang.el - -(register-definition-prefixes "lsp-yang" '("lsp-yang-")) - - -;;; Generated autoloads from lsp-zig.el - -(register-definition-prefixes "lsp-zig" '("lsp-z")) - -;;; End of scraped data - -(provide 'lsp-mode-autoloads) - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; no-native-compile: t -;; coding: utf-8-emacs-unix -;; End: - -;;; lsp-mode-autoloads.el ends here diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-mode-pkg.el b/emacs/elpa/lsp-mode-20240619.951/lsp-mode-pkg.el @@ -1,21 +0,0 @@ -(define-package "lsp-mode" "20240619.951" "LSP mode" - '((emacs "27.1") - (dash "2.18.0") - (f "0.20.0") - (ht "2.3") - (spinner "1.7.3") - (markdown-mode "2.3") - (lv "0") - (eldoc "1.11")) - :commit "cec9e56390e90d7ced3b18a922ab954e782b8628" :authors - '(("Vibhav Pant, Fangrui Song, Ivan Yonchovski")) - :maintainers - '(("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/emacs/elpa/lsp-mode-20240619.951/lsp-mode.el b/emacs/elpa/lsp-mode-20240619.951/lsp-mode.el @@ -1,9848 +0,0 @@ -;;; lsp-mode.el --- LSP mode -*- lexical-binding: t; -*- - -;; Copyright (C) 2020-2024 emacs-lsp maintainers - -;; Author: Vibhav Pant, Fangrui Song, Ivan Yonchovski -;; Keywords: languages -;; Package-Requires: ((emacs "27.1") (dash "2.18.0") (f "0.20.0") (ht "2.3") (spinner "1.7.3") (markdown-mode "2.3") (lv "0") (eldoc "1.11")) -;; Version: 9.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 <https://www.gnu.org/licenses/>. - -;;; Commentary: - -;; Emacs client/library for the Language Server Protocol - -;;; Code: - -(require 'cl-generic) -(require 'cl-lib) -(require 'compile) -(require 'dash) -(require 'epg) -(require 'ewoc) -(require 'f) -(require 'filenotify) -(require 'files) -(require 'ht) -(require 'imenu) -(require 'inline) -(require 'json) -(require 'lv) -(require 'markdown-mode) -(require 'network-stream) -(require 'pcase) -(require 'rx) -(require 's) -(require 'seq) -(require 'spinner) -(require 'subr-x) -(require 'tree-widget) -(require 'url-parse) -(require 'url-util) -(require 'widget) -(require 'xref) -(require 'minibuffer) -(require 'help-mode) -(require 'lsp-protocol) - -(defgroup lsp-mode nil - "Language Server Protocol client." - :group 'tools - :tag "Language Server (lsp-mode)") - -(declare-function evil-set-command-property "ext:evil-common") -(declare-function projectile-project-root "ext:projectile") -(declare-function yas-expand-snippet "ext:yasnippet") -(declare-function dap-mode "ext:dap-mode") -(declare-function dap-auto-configure-mode "ext:dap-mode") - -(defvar yas-inhibit-overlay-modification-protection) -(defvar yas-indent-line) -(defvar yas-wrap-around-region) -(defvar yas-also-auto-indent-first-line) -(defvar dap-auto-configure-mode) -(defvar dap-ui-menu-items) -(defvar company-minimum-prefix-length) - -(defconst lsp--message-type-face - `((1 . ,compilation-error-face) - (2 . ,compilation-warning-face) - (3 . ,compilation-message-face) - (4 . ,compilation-info-face))) - -(defconst lsp--errors - '((-32700 "Parse Error") - (-32600 "Invalid Request") - (-32601 "Method not Found") - (-32602 "Invalid Parameters") - (-32603 "Internal Error") - (-32099 "Server Start Error") - (-32000 "Server End Error") - (-32002 "Server Not Initialized") - (-32001 "Unknown Error Code") - (-32800 "Request Cancelled")) - "Alist of error codes to user friendly strings.") - -(defconst lsp--empty-ht (make-hash-table)) - -(eval-and-compile - (defun dash-expand:&lsp-wks (key source) - `(,(intern-soft (format "lsp--workspace-%s" (eval key))) ,source)) - - (defun dash-expand:&lsp-cln (key source) - `(,(intern-soft (format "lsp--client-%s" (eval key))) ,source))) - -(define-obsolete-variable-alias 'lsp-print-io 'lsp-log-io "lsp-mode 6.1") - -(defcustom lsp-log-io nil - "If non-nil, log all messages from the language server to a *lsp-log* buffer." - :group 'lsp-mode - :type 'boolean) - -(defcustom lsp-log-io-allowlist-methods '() - "The methods to filter before print to lsp-log-io." - :group 'lsp-mode - :type '(repeat string) - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-log-max message-log-max - "Maximum number of lines to keep in the log buffer. -If nil, disable message logging. If t, log messages but don’t truncate -the buffer when it becomes large." - :group 'lsp-mode - :type '(choice (const :tag "Disable" nil) - (integer :tag "lines") - (const :tag "Unlimited" t)) - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-io-messages-max t - "Maximum number of messages that can be locked in a `lsp-io' buffer." - :group 'lsp-mode - :type '(choice (const :tag "Unlimited" t) - (integer :tag "Messages")) - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-keep-workspace-alive t - "If non nil keep workspace alive when the last workspace buffer is closed." - :group 'lsp-mode - :type 'boolean) - -(defcustom lsp-enable-snippet t - "Enable/disable snippet completion support." - :group 'lsp-completion - :type 'boolean) - -(defcustom lsp-enable-folding t - "Enable/disable code folding support." - :group 'lsp-mode - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(define-obsolete-variable-alias 'lsp-enable-semantic-highlighting 'lsp-semantic-tokens-enable "lsp-mode 8.0.0") - -(defcustom lsp-semantic-tokens-enable nil - "Enable/disable support for semantic tokens. -As defined by the Language Server Protocol 3.16." - :group 'lsp-semantic-tokens - :type 'boolean) - -(defcustom lsp-folding-range-limit nil - "The maximum number of folding ranges to receive from the language server." - :group 'lsp-mode - :type '(choice (const :tag "No limit." nil) - (integer :tag "Number of lines.")) - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-folding-line-folding-only nil - "If non-nil, only fold complete lines." - :group 'lsp-mode - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-client-packages - '( ccls lsp-actionscript lsp-ada lsp-angular lsp-ansible lsp-asm lsp-astro - lsp-autotools lsp-awk lsp-bash lsp-beancount lsp-bufls lsp-clangd - lsp-clojure lsp-cmake lsp-cobol lsp-credo lsp-crystal lsp-csharp lsp-css - lsp-cucumber lsp-cypher lsp-d lsp-dart lsp-dhall lsp-docker lsp-dockerfile - lsp-earthly lsp-elixir lsp-elm lsp-emmet lsp-erlang lsp-eslint lsp-fortran lsp-fsharp - lsp-gdscript lsp-gleam lsp-glsl lsp-go lsp-golangci-lint lsp-grammarly - lsp-graphql lsp-groovy lsp-hack lsp-haskell lsp-haxe lsp-idris lsp-java - lsp-javascript lsp-jq lsp-json lsp-kotlin lsp-latex lsp-lisp lsp-ltex - lsp-lua lsp-magik lsp-markdown lsp-marksman lsp-mdx lsp-meson lsp-metals lsp-mint - lsp-mojo lsp-move lsp-mssql lsp-nginx lsp-nim lsp-nix lsp-nushell lsp-ocaml - lsp-openscad lsp-pascal lsp-perl lsp-perlnavigator lsp-php lsp-pls - lsp-purescript lsp-pwsh lsp-pyls lsp-pylsp lsp-pyright lsp-python-ms - lsp-qml lsp-r lsp-racket lsp-remark lsp-rf lsp-rubocop lsp-ruby-lsp - lsp-ruby-syntax-tree lsp-ruff-lsp lsp-rust lsp-semgrep lsp-shader - lsp-solargraph lsp-solidity lsp-sonarlint lsp-sorbet lsp-sourcekit - lsp-sql lsp-sqls lsp-steep lsp-svelte lsp-tailwindcss lsp-terraform - lsp-tex lsp-tilt lsp-toml lsp-trunk lsp-ttcn3 lsp-typeprof lsp-v - lsp-vala lsp-verilog lsp-vetur lsp-vhdl lsp-vimscript lsp-volar lsp-wgsl - lsp-xml lsp-yaml lsp-yang lsp-zig) - "List of the clients to be automatically required." - :group 'lsp-mode - :type '(repeat symbol)) - -(defcustom lsp-progress-via-spinner t - "If non-nil, display LSP $/progress reports via a spinner in the modeline." - :group 'lsp-mode - :type 'boolean) - -(defcustom lsp-progress-spinner-type 'progress-bar - "Holds the type of spinner to be used in the mode-line. -Takes a value accepted by `spinner-start'." - :group 'lsp-mode - :type `(choice :tag "Choose a spinner by name" - ,@(mapcar (lambda (c) (list 'const (car c))) - spinner-types))) - -(defvar-local lsp-use-workspace-root-for-server-default-directory nil - "Use `lsp-workspace-root' for `default-directory' when starting LSP process.") - -(defvar-local lsp--cur-workspace nil) - -(defvar-local lsp--cur-version 0) -(defvar-local lsp--virtual-buffer-connections nil) -(defvar-local lsp--virtual-buffer nil) -(defvar lsp--virtual-buffer-mappings (ht)) - -(defvar lsp--uri-file-prefix (pcase system-type - (`windows-nt "file:///") - (_ "file://")) - "Prefix for a file-uri.") - -(defvar-local lsp-buffer-uri nil - "If set, return it instead of calculating it using `buffer-file-name'.") - -(define-error 'lsp-error "Unknown lsp-mode error") -(define-error 'lsp-empty-response-error - "Empty response from the language server" 'lsp-error) -(define-error 'lsp-timed-out-error - "Timed out while waiting for a response from the language server" 'lsp-error) -(define-error 'lsp-capability-not-supported - "Capability not supported by the language server" 'lsp-error) -(define-error 'lsp-file-scheme-not-supported - "Unsupported file scheme" 'lsp-error) -(define-error 'lsp-client-already-exists-error - "A client with this server-id already exists" 'lsp-error) -(define-error 'lsp-no-code-actions - "No code actions" 'lsp-error) - -(defcustom lsp-auto-guess-root nil - "Automatically guess the project root using projectile/project. -Do *not* use this setting unless you are familiar with `lsp-mode' -internals and you are sure that all of your projects are -following `projectile'/`project.el' conventions." - :group 'lsp-mode - :type 'boolean) - -(defcustom lsp-guess-root-without-session nil - "Ignore the session file when calculating the project root. -You almost always want to set lsp-auto-guess-root too. -Do *not* use this setting unless you are familiar with `lsp-mode' -internals and you are sure that all of your projects are -following `projectile'/`project.el' conventions." - :group 'lsp-mode - :type 'boolean) - -(defcustom lsp-restart 'interactive - "Defines how server-exited events must be handled." - :group 'lsp-mode - :type '(choice (const interactive) - (const auto-restart) - (const ignore))) - -(defcustom lsp-session-file (expand-file-name (locate-user-emacs-file ".lsp-session-v1")) - "File where session information is stored." - :group 'lsp-mode - :type 'file) - -(defcustom lsp-auto-configure t - "Auto configure `lsp-mode' main features. -When set to t `lsp-mode' will auto-configure completion, -code-actions, breadcrumb, `flycheck', `flymake', `imenu', symbol highlighting, -lenses, links, and so on. - -For finer granularity you may use `lsp-enable-*' properties." - :group 'lsp-mode - :type 'boolean - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-disabled-clients nil - "A list of disabled/blocklisted clients. -Each entry in the list can be either: -a symbol, the server-id for the LSP client, or -a cons pair (MAJOR-MODE . CLIENTS), where MAJOR-MODE is the major-mode, -and CLIENTS is either a client or a list of clients. - -This option can also be used as a file- or directory-local variable to -disable a language server for individual files or directories/projects -respectively." - :group 'lsp-mode - :type '(repeat (symbol)) - :safe 'listp - :package-version '(lsp-mode . "6.1")) - -(defvar lsp-clients (make-hash-table :test 'eql) - "Hash table server-id -> client. -It contains all of the clients that are currently registered.") - -(defvar lsp-enabled-clients nil - "List of clients allowed to be used for projects. -When nil, all registered clients are considered candidates.") - -(defvar lsp-last-id 0 - "Last request id.") - -(defcustom lsp-before-initialize-hook nil - "List of functions to be called before a Language Server has been initialized -for a new workspace." - :type 'hook - :group 'lsp-mode) - -(defcustom lsp-after-initialize-hook nil - "List of functions to be called after a Language Server has been initialized -for a new workspace." - :type 'hook - :group 'lsp-mode) - -(defcustom lsp-before-open-hook nil - "List of functions to be called before a new file with LSP support is opened." - :type 'hook - :group 'lsp-mode) - -(defcustom lsp-after-open-hook nil - "List of functions to be called after a new file with LSP support is opened." - :type 'hook - :group 'lsp-mode) - -(defcustom lsp-enable-file-watchers t - "If non-nil lsp-mode will watch the files in the workspace if -the server has requested that." - :type 'boolean - :group 'lsp-mode - :package-version '(lsp-mode . "6.1")) -;;;###autoload(put 'lsp-enable-file-watchers 'safe-local-variable #'booleanp) - -(define-obsolete-variable-alias 'lsp-file-watch-ignored 'lsp-file-watch-ignored-directories "8.0.0") - -(defcustom lsp-file-watch-ignored-directories - '(; SCM tools - "[/\\\\]\\.git\\'" - "[/\\\\]\\.github\\'" - "[/\\\\]\\.gitlab\\'" - "[/\\\\]\\.circleci\\'" - "[/\\\\]\\.hg\\'" - "[/\\\\]\\.bzr\\'" - "[/\\\\]_darcs\\'" - "[/\\\\]\\.svn\\'" - "[/\\\\]_FOSSIL_\\'" - ;; IDE or build tools - "[/\\\\]\\.idea\\'" - "[/\\\\]\\.ensime_cache\\'" - "[/\\\\]\\.eunit\\'" - "[/\\\\]node_modules" - "[/\\\\]\\.yarn\\'" - "[/\\\\]\\.fslckout\\'" - "[/\\\\]\\.tox\\'" - "[/\\\\]\\.nox\\'" - "[/\\\\]dist\\'" - "[/\\\\]dist-newstyle\\'" - "[/\\\\]\\.stack-work\\'" - "[/\\\\]\\.bloop\\'" - "[/\\\\]\\.metals\\'" - "[/\\\\]target\\'" - "[/\\\\]\\.ccls-cache\\'" - "[/\\\\]\\.vs\\'" - "[/\\\\]\\.vscode\\'" - "[/\\\\]\\.venv\\'" - "[/\\\\]\\.mypy_cache\\'" - "[/\\\\]\\.pytest_cache\\'" - ;; Swift Package Manager - "[/\\\\]\\.build\\'" - ;; Python - "[/\\\\]__pycache__\\'" - ;; Autotools output - "[/\\\\]\\.deps\\'" - "[/\\\\]build-aux\\'" - "[/\\\\]autom4te.cache\\'" - "[/\\\\]\\.reference\\'" - ;; Bazel - "[/\\\\]bazel-[^/\\\\]+\\'" - ;; CSharp - "[/\\\\]\\.cache[/\\\\]lsp-csharp\\'" - "[/\\\\]\\.meta\\'" - "[/\\\\]\\.nuget\\'" - ;; Unity - "[/\\\\]Library\\'" - ;; Clojure - "[/\\\\]\\.lsp\\'" - "[/\\\\]\\.clj-kondo\\'" - "[/\\\\]\\.shadow-cljs\\'" - "[/\\\\]\\.babel_cache\\'" - "[/\\\\]\\.cpcache\\'" - "[/\\\\]\\checkouts\\'" - ;; Gradle - "[/\\\\]\\.gradle\\'" - ;; Maven - "[/\\\\]\\.m2\\'" - ;; .Net Core build-output - "[/\\\\]bin/Debug\\'" - "[/\\\\]obj\\'" - ;; OCaml and Dune - "[/\\\\]_opam\\'" - "[/\\\\]_build\\'" - ;; Elixir - "[/\\\\]\\.elixir_ls\\'" - ;; Elixir Credo - "[/\\\\]\\.elixir-tools\\'" - ;; terraform and terragrunt - "[/\\\\]\\.terraform\\'" - "[/\\\\]\\.terragrunt-cache\\'" - ;; nix-direnv - "[/\\\\]\\result" - "[/\\\\]\\result-bin" - "[/\\\\]\\.direnv\\'") - "List of regexps matching directory paths which won't be monitored when -creating file watches. Customization of this variable is only honored at -the global level or at a root of an lsp workspace." - :group 'lsp-mode - :type '(repeat string) - :package-version '(lsp-mode . "8.0.0")) - -(define-obsolete-function-alias 'lsp-file-watch-ignored 'lsp-file-watch-ignored-directories "7.0.1") - -(defun lsp-file-watch-ignored-directories () - lsp-file-watch-ignored-directories) - -;; Allow lsp-file-watch-ignored-directories as a file or directory-local variable -;;;###autoload(put 'lsp-file-watch-ignored-directories 'safe-local-variable 'lsp--string-listp) - -(defcustom lsp-file-watch-ignored-files - '( - ;; Flycheck tempfiles - "[/\\\\]flycheck_[^/\\\\]+\\'" - ;; lockfiles - "[/\\\\]\\.#[^/\\\\]+\\'" - ;; backup files - "[/\\\\][^/\\\\]+~\\'" ) - "List of regexps matching files for which change events will -not be sent to the server. - -This setting has no impact on whether a file-watch is created for -a directory; it merely prevents notifications pertaining to -matched files from being sent to the server. To prevent a -file-watch from being created for a directory, customize -`lsp-file-watch-ignored-directories' - -Customization of this variable is only honored at the global -level or at a root of an lsp workspace." - :group 'lsp-mode - :type '(repeat string) - :package-version '(lsp-mode . "8.0.0")) - -;; Allow lsp-file-watch-ignored-files as a file or directory-local variable -;;;###autoload(put 'lsp-file-watch-ignored-files 'safe-local-variable 'lsp--string-listp) - -(defcustom lsp-after-uninitialized-functions nil - "List of functions to be called after a Language Server has been uninitialized." - :type 'hook - :group 'lsp-mode - :package-version '(lsp-mode . "6.3")) - -(defconst lsp--sync-full 1) -(defconst lsp--sync-incremental 2) - -(defcustom lsp-debounce-full-sync-notifications t - "If non-nil debounce full sync events. -This flag affects only servers which do not support incremental updates." - :type 'boolean - :group 'lsp-mode - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-debounce-full-sync-notifications-interval 1.0 - "Time to wait before sending full sync synchronization after buffer modification." - :type 'float - :group 'lsp-mode - :package-version '(lsp-mode . "6.1")) - -(defvar lsp--stderr-index 0) - -(defvar lsp--delayed-requests nil) -(defvar lsp--delay-timer nil) - -(defcustom lsp-document-sync-method nil - "How to sync the document with the language server." - :type '(choice (const :tag "Documents are synced by always sending the full content of the document." lsp--sync-full) - (const :tag "Documents are synced by always sending incremental changes to the document." lsp--sync-incremental) - (const :tag "Use the method recommended by the language server." nil)) - :group 'lsp-mode) - -(defcustom lsp-auto-execute-action t - "Auto-execute single action." - :type 'boolean - :group 'lsp-mode) - -(defcustom lsp-enable-links t - "If non-nil, all references to links in a file will be made clickable, if -supported by the language server." - :type 'boolean - :group 'lsp-mode - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-enable-imenu t - "If non-nil, automatically enable `imenu' integration when server provides -`textDocument/documentSymbol'." - :type 'boolean - :group 'lsp-mode - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-enable-dap-auto-configure t - "If non-nil, enable `dap-auto-configure-mode`." - :type 'boolean - :group 'lsp-mode - :package-version '(lsp-mode . "7.0")) - -(defcustom lsp-eldoc-enable-hover t - "If non-nil, `eldoc' will display hover info when it is present." - :type 'boolean - :group 'lsp-mode) - -(defcustom lsp-eldoc-render-all nil - "Display all of the info returned by document/onHover. -If this is set to nil, `eldoc' will show only the symbol information." - :type 'boolean - :group 'lsp-mode) - -(define-obsolete-variable-alias 'lsp-enable-completion-at-point - 'lsp-completion-enable "lsp-mode 7.0.1") - -(defcustom lsp-completion-enable t - "Enable `completion-at-point' integration." - :type 'boolean - :group 'lsp-completion) - -(defcustom lsp-enable-symbol-highlighting t - "Highlight references of the symbol at point." - :type 'boolean - :group 'lsp-mode) - -(defcustom lsp-enable-xref t - "Enable xref integration." - :type 'boolean - :group 'lsp-mode) - -(defcustom lsp-references-exclude-definition nil - "If non-nil, exclude declarations when finding references." - :type 'boolean - :group 'lsp-mode) - -(defcustom lsp-enable-indentation t - "Indent regions using the file formatting functionality provided by the -language server." - :type 'boolean - :group 'lsp-mode) - -(defcustom lsp-enable-on-type-formatting t - "Enable `textDocument/onTypeFormatting' integration." - :type 'boolean - :group 'lsp-mode) - -(defcustom lsp-enable-text-document-color t - "Enable `textDocument/documentColor' integration." - :type 'boolean - :group 'lsp-mode) - -(defcustom lsp-before-save-edits t - "If non-nil, `lsp-mode' will apply edits suggested by the language server -before saving a document." - :type 'boolean - :group 'lsp-mode) - -(defcustom lsp-after-apply-edits-hook nil - "Hooks to run when text edit is applied. -It contains the operation source." - :type 'hook - :group 'lsp-mode - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-apply-edits-after-file-operations t - "Whether to apply edits returned by server after file operations if any. -Applicable only if server supports workspace.fileOperations for operations: -`workspace/willRenameFiles', `workspace/willCreateFiles' and -`workspace/willDeleteFiles'." - :group 'lsp-mode - :type 'boolean) - -(defcustom lsp-modeline-code-actions-enable t - "Whether to show code actions on modeline." - :type 'boolean - :group 'lsp-modeline) - -(defcustom lsp-modeline-diagnostics-enable t - "Whether to show diagnostics on modeline." - :type 'boolean - :group 'lsp-modeline) - -(defcustom lsp-modeline-workspace-status-enable t - "Whether to show workspace status on modeline." - :type 'boolean - :group 'lsp-modeline - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-headerline-breadcrumb-enable t - "Whether to enable breadcrumb on headerline." - :type 'boolean - :group 'lsp-headerline) - -(defcustom lsp-configure-hook nil - "Hooks to run when `lsp-configure-buffer' is called." - :type 'hook - :group 'lsp-mode) - -(defcustom lsp-unconfigure-hook nil - "Hooks to run when `lsp-unconfig-buffer' is called." - :type 'hook - :group 'lsp-mode) - -(defcustom lsp-after-diagnostics-hook nil - "Hooks to run after diagnostics are received. -Note: it runs only if the receiving buffer is open. Use -`lsp-diagnostics-updated-hook'if you want to be notified when -diagnostics have changed." - :type 'hook - :group 'lsp-mode) - -(define-obsolete-variable-alias 'lsp-after-diagnostics-hook - 'lsp-diagnostics-updated-hook "lsp-mode 6.4") - -(defcustom lsp-diagnostics-updated-hook nil - "Hooks to run after diagnostics are received." - :type 'hook - :group 'lsp-mode) - -(define-obsolete-variable-alias 'lsp-workspace-folders-changed-hook - 'lsp-workspace-folders-changed-functions "lsp-mode 6.3") - -(defcustom lsp-workspace-folders-changed-functions nil - "Hooks to run after the folders has changed. -The hook will receive two parameters list of added and removed folders." - :type 'hook - :group 'lsp-mode) - -(define-obsolete-variable-alias 'lsp-eldoc-hook 'eldoc-documentation-functions "lsp-mode 9.0.0") - -(defcustom lsp-before-apply-edits-hook nil - "Hooks to run before applying edits." - :type 'hook - :group 'lsp-mode) - -(defgroup lsp-imenu nil - "LSP Imenu." - :group 'lsp-mode - :tag "LSP Imenu") - -(defcustom lsp-imenu-show-container-name t - "Display the symbol's container name in an imenu entry." - :type 'boolean - :group 'lsp-imenu) - -(defcustom lsp-imenu-container-name-separator "/" - "Separator string to use to separate the container name from the symbol while -displaying imenu entries." - :type 'string - :group 'lsp-imenu) - -(defcustom lsp-imenu-sort-methods '(kind name) - "How to sort the imenu items. - -The value is a list of `kind' `name' or `position'. Priorities -are determined by the index of the element." - :type '(repeat (choice (const name) - (const position) - (const kind))) - :group 'lsp-imenu) - -(defcustom lsp-imenu-index-symbol-kinds nil - "Which symbol kinds to show in imenu." - :type '(repeat (choice (const :tag "Miscellaneous" nil) - (const :tag "File" File) - (const :tag "Module" Module) - (const :tag "Namespace" Namespace) - (const :tag "Package" Package) - (const :tag "Class" Class) - (const :tag "Method" Method) - (const :tag "Property" Property) - (const :tag "Field" Field) - (const :tag "Constructor" Constructor) - (const :tag "Enum" Enum) - (const :tag "Interface" Interface) - (const :tag "Function" Function) - (const :tag "Variable" Variable) - (const :tag "Constant" Constant) - (const :tag "String" String) - (const :tag "Number" Number) - (const :tag "Boolean" Boolean) - (const :tag "Array" Array) - (const :tag "Object" Object) - (const :tag "Key" Key) - (const :tag "Null" Null) - (const :tag "Enum Member" EnumMember) - (const :tag "Struct" Struct) - (const :tag "Event" Event) - (const :tag "Operator" Operator) - (const :tag "Type Parameter" TypeParameter))) - :group 'lsp-imenu) - -;; vibhavp: Should we use a lower value (5)? -(defcustom lsp-response-timeout 10 - "Number of seconds to wait for a response from the language server before -timing out. Nil if no timeout." - :type '(choice - (number :tag "Seconds") - (const :tag "No timeout" nil)) - :group 'lsp-mode) - -(defcustom lsp-tcp-connection-timeout 2 - "The timeout for tcp connection in seconds." - :type 'number - :group 'lsp-mode - :package-version '(lsp-mode . "6.2")) - -(defconst lsp--imenu-compare-function-alist - (list (cons 'name #'lsp--imenu-compare-name) - (cons 'kind #'lsp--imenu-compare-kind) - (cons 'position #'lsp--imenu-compare-line-col)) - "An alist of (METHOD . FUNCTION). -METHOD is one of the symbols accepted by -`lsp-imenu-sort-methods'. - -FUNCTION takes two hash tables representing DocumentSymbol. It -returns a negative number, 0, or a positive number indicating -whether the first parameter is less than, equal to, or greater -than the second parameter.") - -(defcustom lsp-diagnostic-clean-after-change nil - "When non-nil, clean the diagnostics on change. - -Note that when that setting is nil, `lsp-mode' will show stale -diagnostics until server publishes the new set of diagnostics" - :type 'boolean - :group 'lsp-diagnostics - :package-version '(lsp-mode . "7.0.1")) - -(defcustom lsp-server-trace nil - "Request tracing on the server side. -The actual trace output at each level depends on the language server in use. -Changes take effect only when a new session is started." - :type '(choice (const :tag "Disabled" "off") - (const :tag "Messages only" "messages") - (const :tag "Verbose" "verbose") - (const :tag "Default (disabled)" nil)) - :group 'lsp-mode - :package-version '(lsp-mode . "6.1")) - -(defcustom lsp-auto-touch-files t - "If non-nil ensure the files exist before sending -`textDocument/didOpen' notification." - :type 'boolean - :group 'lsp-mode - :package-version '(lsp-mode . "9.0.0")) - -(defvar lsp-language-id-configuration - '(("\\(^CMakeLists\\.txt\\|\\.cmake\\)\\'" . "cmake") - ("\\(^Dockerfile\\(?:\\..*\\)?\\|\\.[Dd]ockerfile\\)\\'" . "dockerfile") - ("\\.astro$" . "astro") - ("\\.cs\\'" . "csharp") - ("\\.css$" . "css") - ("\\.cypher$" . "cypher") - ("Earthfile" . "earthfile") - ("\\.ebuild$" . "shellscript") - ("\\.go\\'" . "go") - ("\\.html$" . "html") - ("\\.hx$" . "haxe") - ("\\.hy$" . "hy") - ("\\.java\\'" . "java") - ("\\.jq$" . "jq") - ("\\.js$" . "javascript") - ("\\.json$" . "json") - ("\\.jsonc$" . "jsonc") - ("\\.jsonnet$" . "jsonnet") - ("\\.jsx$" . "javascriptreact") - ("\\.lua$" . "lua") - ("\\.mdx\\'" . "mdx") - ("\\.nu$" . "nushell") - ("\\.php$" . "php") - ("\\.ps[dm]?1\\'" . "powershell") - ("\\.rs\\'" . "rust") - ("\\.spec\\'" . "rpm-spec") - ("\\.sql$" . "sql") - ("\\.svelte$" . "svelte") - ("\\.toml\\'" . "toml") - ("\\.ts$" . "typescript") - ("\\.tsx$" . "typescriptreact") - ("\\.ttcn3$" . "ttcn3") - ("\\.vue$" . "vue") - ("\\.xml$" . "xml") - ("\\ya?ml$" . "yaml") - ("^PKGBUILD$" . "shellscript") - ("^go\\.mod\\'" . "go.mod") - ("^settings\\.json$" . "jsonc") - ("^yang\\.settings$" . "jsonc") - ("^meson\\(_options\\.txt\\|\\.\\(build\\|format\\)\\)\\'" . "meson") - (ada-mode . "ada") - (ada-ts-mode . "ada") - (gpr-mode . "gpr") - (gpr-ts-mode . "gpr") - (awk-mode . "awk") - (awk-ts-mode . "awk") - (nxml-mode . "xml") - (sql-mode . "sql") - (vimrc-mode . "vim") - (vimscript-ts-mode . "vim") - (sh-mode . "shellscript") - (bash-ts-mode . "shellscript") - (ebuild-mode . "shellscript") - (pkgbuild-mode . "shellscript") - (envrc-file-mode . "shellscript") - (scala-mode . "scala") - (scala-ts-mode . "scala") - (julia-mode . "julia") - (julia-ts-mode . "julia") - (clojure-mode . "clojure") - (clojurec-mode . "clojure") - (clojurescript-mode . "clojurescript") - (clojure-ts-mode . "clojure") - (clojure-ts-clojurec-mode . "clojure") - (clojure-ts-clojurescript-mode . "clojurescript") - (java-mode . "java") - (java-ts-mode . "java") - (jdee-mode . "java") - (groovy-mode . "groovy") - (python-mode . "python") - (python-ts-mode . "python") - (cython-mode . "python") - ("\\(\\.mojo\\|\\.🔥\\)\\'" . "mojo") - (lsp--render-markdown . "markdown") - (move-mode . "move") - (rust-mode . "rust") - (rust-ts-mode . "rust") - (rustic-mode . "rust") - (kotlin-mode . "kotlin") - (kotlin-ts-mode . "kotlin") - (css-mode . "css") - (css-ts-mode . "css") - (less-mode . "less") - (less-css-mode . "less") - (lua-mode . "lua") - (lua-ts-mode . "lua") - (sass-mode . "sass") - (ssass-mode . "sass") - (scss-mode . "scss") - (scad-mode . "openscad") - (xml-mode . "xml") - (c-mode . "c") - (c-ts-mode . "c") - (c++-mode . "cpp") - (c++-ts-mode . "cpp") - (cuda-mode . "cuda") - (objc-mode . "objective-c") - (html-mode . "html") - (html-ts-mode . "html") - (sgml-mode . "html") - (mhtml-mode . "html") - (mint-mode . "mint") - (go-dot-mod-mode . "go.mod") - (go-mod-ts-mode . "go.mod") - (go-mode . "go") - (go-ts-mode . "go") - (graphql-mode . "graphql") - (haskell-mode . "haskell") - (hack-mode . "hack") - (php-mode . "php") - (php-ts-mode . "php") - (powershell-mode . "powershell") - (powershell-mode . "PowerShell") - (powershell-ts-mode . "powershell") - (json-mode . "json") - (json-ts-mode . "json") - (jsonc-mode . "jsonc") - (rjsx-mode . "javascript") - (js2-mode . "javascript") - (js-mode . "javascript") - (js-ts-mode . "javascript") - (typescript-mode . "typescript") - (typescript-ts-mode . "typescript") - (tsx-ts-mode . "typescriptreact") - (svelte-mode . "svelte") - (fsharp-mode . "fsharp") - (reason-mode . "reason") - (caml-mode . "ocaml") - (tuareg-mode . "ocaml") - (swift-mode . "swift") - (elixir-mode . "elixir") - (elixir-ts-mode . "elixir") - (heex-ts-mode . "elixir") - (conf-javaprop-mode . "spring-boot-properties") - (yaml-mode . "yaml") - (yaml-ts-mode . "yaml") - (ruby-mode . "ruby") - (enh-ruby-mode . "ruby") - (ruby-ts-mode . "ruby") - (fortran-mode . "fortran") - (f90-mode . "fortran") - (elm-mode . "elm") - (dart-mode . "dart") - (erlang-mode . "erlang") - (dockerfile-mode . "dockerfile") - (dockerfile-ts-mode . "dockerfile") - (csharp-mode . "csharp") - (csharp-tree-sitter-mode . "csharp") - (csharp-ts-mode . "csharp") - (plain-tex-mode . "plaintex") - (context-mode . "context") - (cypher-mode . "cypher") - (latex-mode . "latex") - (LaTeX-mode . "latex") - (v-mode . "v") - (vhdl-mode . "vhdl") - (vhdl-ts-mode . "vhdl") - (verilog-mode . "verilog") - (terraform-mode . "terraform") - (ess-julia-mode . "julia") - (ess-r-mode . "r") - (crystal-mode . "crystal") - (nim-mode . "nim") - (dhall-mode . "dhall") - (cmake-mode . "cmake") - (cmake-ts-mode . "cmake") - (purescript-mode . "purescript") - (gdscript-mode . "gdscript") - (gdscript-ts-mode . "gdscript") - (perl-mode . "perl") - (cperl-mode . "perl") - (robot-mode . "robot") - (racket-mode . "racket") - (nix-mode . "nix") - (nix-ts-mode . "Nix") - (prolog-mode . "prolog") - (vala-mode . "vala") - (actionscript-mode . "actionscript") - (d-mode . "d") - (zig-mode . "zig") - (text-mode . "plaintext") - (markdown-mode . "markdown") - (gfm-mode . "markdown") - (beancount-mode . "beancount") - (conf-toml-mode . "toml") - (toml-ts-mode . "toml") - (org-mode . "org") - (org-journal-mode . "org") - (nginx-mode . "nginx") - (magik-mode . "magik") - (magik-ts-mode . "magik") - (idris-mode . "idris") - (idris2-mode . "idris2") - (gleam-mode . "gleam") - (gleam-ts-mode . "gleam") - (graphviz-dot-mode . "dot") - (tiltfile-mode . "tiltfile") - (solidity-mode . "solidity") - (bibtex-mode . "bibtex") - (rst-mode . "restructuredtext") - (glsl-mode . "glsl") - (shader-mode . "shaderlab") - (wgsl-mode . "wgsl") - (jq-mode . "jq") - (jq-ts-mode . "jq") - (protobuf-mode . "protobuf") - (nushell-mode . "nushell") - (nushell-ts-mode . "nushell") - (meson-mode . "meson") - (yang-mode . "yang")) - "Language id configuration.") - -(defvar lsp--last-active-workspaces nil - "Keep track of last active workspace. -We want to try the last workspace first when jumping into a library -directory") - -(defvar lsp-method-requirements - '(("textDocument/callHierarchy" :capability :callHierarchyProvider) - ("textDocument/codeAction" :capability :codeActionProvider) - ("codeAction/resolve" - :check-command (lambda (workspace) - (with-lsp-workspace workspace - (lsp:code-action-options-resolve-provider? - (lsp--capability-for-method "textDocument/codeAction"))))) - ("textDocument/codeLens" :capability :codeLensProvider) - ("textDocument/completion" :capability :completionProvider) - ("completionItem/resolve" - :check-command (lambda (wk) - (with-lsp-workspace wk - (lsp:completion-options-resolve-provider? - (lsp--capability-for-method "textDocument/completion"))))) - ("textDocument/declaration" :capability :declarationProvider) - ("textDocument/definition" :capability :definitionProvider) - ("textDocument/documentColor" :capability :colorProvider) - ("textDocument/documentLink" :capability :documentLinkProvider) - ("textDocument/inlayHint" :capability :inlayHintProvider) - ("textDocument/documentHighlight" :capability :documentHighlightProvider) - ("textDocument/documentSymbol" :capability :documentSymbolProvider) - ("textDocument/foldingRange" :capability :foldingRangeProvider) - ("textDocument/formatting" :capability :documentFormattingProvider) - ("textDocument/hover" :capability :hoverProvider) - ("textDocument/implementation" :capability :implementationProvider) - ("textDocument/linkedEditingRange" :capability :linkedEditingRangeProvider) - ("textDocument/onTypeFormatting" :capability :documentOnTypeFormattingProvider) - ("textDocument/prepareRename" - :check-command (lambda (workspace) - (with-lsp-workspace workspace - (lsp:rename-options-prepare-provider? - (lsp--capability-for-method "textDocument/rename"))))) - ("textDocument/rangeFormatting" :capability :documentRangeFormattingProvider) - ("textDocument/references" :capability :referencesProvider) - ("textDocument/rename" :capability :renameProvider) - ("textDocument/selectionRange" :capability :selectionRangeProvider) - ("textDocument/semanticTokens" :capability :semanticTokensProvider) - ("textDocument/semanticTokensFull" - :check-command (lambda (workspace) - (with-lsp-workspace workspace - (lsp-get (lsp--capability :semanticTokensProvider) :full)))) - ("textDocument/semanticTokensFull/Delta" - :check-command (lambda (workspace) - (with-lsp-workspace workspace - (let ((capFull (lsp-get (lsp--capability :semanticTokensProvider) :full))) - (and (not (booleanp capFull)) (lsp-get capFull :delta)))))) - ("textDocument/semanticTokensRangeProvider" - :check-command (lambda (workspace) - (with-lsp-workspace workspace - (lsp-get (lsp--capability :semanticTokensProvider) :range)))) - ("textDocument/signatureHelp" :capability :signatureHelpProvider) - ("textDocument/typeDefinition" :capability :typeDefinitionProvider) - ("textDocument/typeHierarchy" :capability :typeHierarchyProvider) - ("workspace/executeCommand" :capability :executeCommandProvider) - ("workspace/symbol" :capability :workspaceSymbolProvider)) - - "Map methods to requirements. -It is used by request-sending functions to determine which server -must be used for handling a particular message.") - -(defconst lsp--file-change-type - `((created . 1) - (changed . 2) - (deleted . 3))) - -(defconst lsp--watch-kind - `((create . 1) - (change . 2) - (delete . 4))) - -(defvar lsp-window-body-width 40 - "Window body width when rendering doc.") - -(defface lsp-face-highlight-textual - '((t :inherit highlight)) - "Face used for textual occurrences of symbols." - :group 'lsp-mode) - -(defface lsp-face-highlight-read - '((t :inherit highlight :underline t)) - "Face used for highlighting symbols being read." - :group 'lsp-mode) - -(defface lsp-face-highlight-write - '((t :inherit highlight :weight bold)) - "Face used for highlighting symbols being written to." - :group 'lsp-mode) - -(define-obsolete-variable-alias 'lsp-lens-auto-enable - 'lsp-lens-enable "lsp-mode 7.0.1") - -(defcustom lsp-lens-enable t - "Auto enable lenses if server supports." - :group 'lsp-lens - :type 'boolean - :package-version '(lsp-mode . "6.3")) - -(defcustom lsp-symbol-highlighting-skip-current nil - "If non-nil skip current symbol when setting symbol highlights." - :group 'lsp-mode - :type 'boolean) - -(defcustom lsp-file-watch-threshold 1000 - "Show warning if the files to watch are more than. -Set to nil to disable the warning." - :type 'number - :group 'lsp-mode) -;;;###autoload(put 'lsp-file-watch-threshold 'safe-local-variable (lambda (i) (or (numberp i) (not i)))) - -(defvar lsp-custom-markup-modes - '((rust-mode "no_run" "rust,no_run" "rust,ignore" "rust,should_panic")) - "Mode to uses with markdown code blocks. -They are added to `markdown-code-lang-modes'") - -(defcustom lsp-signature-render-documentation t - "Display signature documentation in `eldoc'." - :type 'boolean - :group 'lsp-mode - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-signature-auto-activate '(:on-trigger-char :on-server-request) - "Auto activate signature conditions." - :type '(repeat (choice (const :tag "On trigger chars pressed." :on-trigger-char) - (const :tag "After selected completion." :after-completion) - (const :tag "When the server has sent show signature help." :on-server-request))) - :group 'lsp-mode - :package-version '(lsp-mode . "6.2")) - -(defcustom lsp-signature-doc-lines 20 - "If number, limit the number of lines to show in the docs." - :type 'number - :group 'lsp-mode - :package-version '(lsp-mode . "6.3")) - -(defcustom lsp-signature-function 'lsp-lv-message - "The function used for displaying signature info. -It will be called with one param - the signature info. When -called with nil the signature info must be cleared." - :type 'function - :group 'lsp-mode - :package-version '(lsp-mode . "6.3")) - -(defcustom lsp-keymap-prefix "s-l" - "LSP-mode keymap prefix." - :group 'lsp-mode - :type 'string - :package-version '(lsp-mode . "6.3")) - -(defvar-local lsp--buffer-workspaces () - "List of the buffer workspaces.") - -(defvar-local lsp--buffer-deferred nil - "Whether buffer was loaded via `lsp-deferred'.") - -(defvar lsp--session nil - "Contain the `lsp-session' for the current Emacs instance.") - -(defvar lsp--tcp-port 10000) - -(defvar lsp--client-packages-required nil - "If nil, `lsp-client-packages' are yet to be required.") - -(defvar lsp--tcp-server-port 0 - "The server socket which is opened when using `lsp-tcp-server' (a server -socket is opened in Emacs and the language server connects to it). The -default value of 0 ensures that a random high port is used. Set it to a positive -integer to use a specific port.") - -(defvar lsp--tcp-server-wait-seconds 10 - "Wait this amount of time for the client to connect to our server socket -when using `lsp-tcp-server'.") - -(defvar-local lsp--document-symbols nil - "The latest document symbols.") - -(defvar-local lsp--document-selection-range-cache nil - "The document selection cache.") - -(defvar-local lsp--document-symbols-request-async nil - "If non-nil, request document symbols asynchronously.") - -(defvar-local lsp--document-symbols-tick -1 - "The value of `buffer-chars-modified-tick' when document - symbols were last retrieved.") - -(defvar-local lsp--have-document-highlights nil - "Set to `t' on symbol highlighting, cleared on -`lsp--cleanup-highlights-if-needed'. Checking a separately -defined flag is substantially faster than unconditionally -calling `remove-overlays'.") - -;; Buffer local variable for storing number of lines. -(defvar lsp--log-lines) - -(defvar-local lsp--eldoc-saved-message nil) - -(defvar lsp--on-change-timer nil) -(defvar lsp--on-idle-timer nil) - -(defvar-local lsp--signature-last nil) -(defvar-local lsp--signature-last-index nil) -(defvar lsp--signature-last-buffer nil) - -(defvar-local lsp--virtual-buffer-point-max nil) - -(cl-defmethod lsp-execute-command (_server _command _arguments) - "Ask SERVER to execute COMMAND with ARGUMENTS.") - -(defun lsp-elt (sequence n) - "Return Nth element of SEQUENCE or nil if N is out of range." - (cond - ((listp sequence) (elt sequence n)) - ((arrayp sequence) - (and (> (length sequence) n) (aref sequence n))) - (t (and (> (length sequence) n) (elt sequence n))))) - -;; define seq-first and seq-rest for older emacs -(defun lsp-seq-first (sequence) - "Return the first element of SEQUENCE." - (lsp-elt sequence 0)) - -(defun lsp-seq-rest (sequence) - "Return a sequence of the elements of SEQUENCE except the first one." - (seq-drop sequence 1)) - -;;;###autoload -(defun lsp--string-listp (sequence) - "Return t if all elements of SEQUENCE are strings, else nil." - (not (seq-find (lambda (x) (not (stringp x))) sequence))) - -(defun lsp--string-vector-p (candidate) - "Returns true if CANDIDATE is a vector data structure and -every element of it is of type string, else nil." - (and - (vectorp candidate) - (seq-every-p #'stringp candidate))) - -(make-obsolete 'lsp--string-vector-p nil "lsp-mode 8.0.0") - -(defun lsp--editable-vector-match (widget value) - "Function for `lsp-editable-vector' :match." - ;; Value must be a list or a vector and all the members must match the type. - (and (or (listp value) (vectorp value)) - (length (cdr (lsp--editable-vector-match-inline widget value))))) - -(defun lsp--editable-vector-match-inline (widget value) - "Value for `lsp-editable-vector' :match-inline." - (let ((type (nth 0 (widget-get widget :args))) - (ok t) - found) - (while (and value ok) - (let ((answer (widget-match-inline type value))) - (if answer - (let ((head (if (vectorp answer) (aref answer 0) (car answer))) - (tail (if (vectorp answer) (seq-drop 1 answer) (cdr answer)))) - (setq found (append found head) - value tail)) - (setq ok nil)))) - (cons found value))) - -(defun lsp--editable-vector-value-to-external (_widget internal-value) - "Convert the internal list value to a vector." - (if (listp internal-value) - (apply 'vector internal-value) - internal-value)) - -(defun lsp--editable-vector-value-to-internal (_widget external-value) - "Convert the external vector value to a list." - (if (vectorp external-value) - (append external-value nil) - external-value)) - -(define-widget 'lsp--editable-vector 'editable-list - "A subclass of `editable-list' that accepts and returns a -vector instead of a list." - :value-to-external 'lsp--editable-vector-value-to-external - :value-to-internal 'lsp--editable-vector-value-to-internal - :match 'lsp--editable-vector-match - :match-inline 'lsp--editable-vector-match-inline) - -(define-widget 'lsp-repeatable-vector 'lsp--editable-vector - "A variable length homogeneous vector." - :tag "Repeat" - :format "%{%t%}:\n%v%i\n") - -(define-widget 'lsp-string-vector 'lazy - "A vector of zero or more elements, every element of which is a string. -Appropriate for any language-specific `defcustom' that needs to -serialize as a JSON array of strings. - -Deprecated. Use `lsp-repeatable-vector' instead. " - :offset 4 - :tag "Vector" - :type '(lsp-repeatable-vector string)) - -(make-obsolete 'lsp-string-vector nil "lsp-mode 8.0.0") - -(defvar lsp--show-message t - "If non-nil, show debug message from `lsp-mode'.") - -(defun lsp--message (format &rest args) - "Wrapper for `message' - -We `inhibit-message' the message when the cursor is in the -minibuffer and when emacs version is before emacs 27 due to the -fact that we often use `lsp--info', `lsp--warn' and `lsp--error' -in async context and the call to these function is removing the -minibuffer prompt. The issue with async messages is already fixed -in emacs 27. - -See #2049" - (when lsp--show-message - (let ((inhibit-message (or inhibit-message - (and (minibufferp) - (version< emacs-version "27.0"))))) - (apply #'message format args)))) - -(defun lsp--info (format &rest args) - "Display lsp info message with FORMAT with ARGS." - (lsp--message "%s :: %s" (propertize "LSP" 'face 'success) (apply #'format format args))) - -(defun lsp--warn (format &rest args) - "Display lsp warn message with FORMAT with ARGS." - (lsp--message "%s :: %s" (propertize "LSP" 'face 'warning) (apply #'format format args))) - -(defun lsp--error (format &rest args) - "Display lsp error message with FORMAT with ARGS." - (lsp--message "%s :: %s" (propertize "LSP" 'face 'error) (apply #'format format args))) - -(defun lsp-log (format &rest args) - "Log message to the ’*lsp-log*’ buffer. - -FORMAT and ARGS i the same as for `message'." - (when lsp-log-max - (let ((log-buffer (get-buffer "*lsp-log*")) - (inhibit-read-only t)) - (unless log-buffer - (setq log-buffer (get-buffer-create "*lsp-log*")) - (with-current-buffer log-buffer - (buffer-disable-undo) - (view-mode 1) - (set (make-local-variable 'lsp--log-lines) 0))) - (with-current-buffer log-buffer - (save-excursion - (let* ((message (apply 'format format args)) - ;; Count newlines in message. - (newlines (1+ (cl-loop with start = 0 - for count from 0 - while (string-match "\n" message start) - do (setq start (match-end 0)) - finally return count)))) - (goto-char (point-max)) - - ;; in case the buffer is not empty insert before last \n to preserve - ;; the point position(in case it is in the end) - (if (eq (point) (point-min)) - (progn - (insert "\n") - (backward-char)) - (backward-char) - (insert "\n")) - (insert message) - - (setq lsp--log-lines (+ lsp--log-lines newlines)) - - (when (and (integerp lsp-log-max) (> lsp--log-lines lsp-log-max)) - (let ((to-delete (- lsp--log-lines lsp-log-max))) - (goto-char (point-min)) - (forward-line to-delete) - (delete-region (point-min) (point)) - (setq lsp--log-lines lsp-log-max))))))))) - -(defalias 'lsp-message 'lsp-log) - -(defalias 'lsp-ht 'ht) - -(defalias 'lsp-file-local-name 'file-local-name) - -(defun lsp-f-canonical (file-name) - "Return the canonical FILE-NAME, without a trailing slash." - (directory-file-name (expand-file-name file-name))) - -(defalias 'lsp-canonical-file-name 'lsp-f-canonical) - -(defun lsp-f-same? (path-a path-b) - "Return t if PATH-A and PATH-B are references to the same file. -Symlinks are not followed." - (when (and (f-exists? path-a) - (f-exists? path-b)) - (equal - (lsp-f-canonical (directory-file-name (f-expand path-a))) - (lsp-f-canonical (directory-file-name (f-expand path-b)))))) - -(defun lsp-f-parent (path) - "Return the parent directory to PATH. -Symlinks are not followed." - (let ((parent (file-name-directory - (directory-file-name (f-expand path default-directory))))) - (unless (lsp-f-same? path parent) - (if (f-relative? path) - (f-relative parent) - (directory-file-name parent))))) - -(defun lsp-f-ancestor-of? (path-a path-b) - "Return t if PATH-A is an ancestor of PATH-B. -Symlinks are not followed." - (unless (lsp-f-same? path-a path-b) - (s-prefix? (concat (lsp-f-canonical path-a) (f-path-separator)) - (lsp-f-canonical path-b)))) - -(defun lsp--merge-results (results method) - "Merge RESULTS by filtering the empty hash-tables and merging -the lists according to METHOD." - (pcase (--map (if (vectorp it) - (append it nil) it) - (-filter #'identity results)) - (`() ()) - ;; only one result - simply return it - (`(,fst) fst) - ;; multiple results merge it based on strategy - (results - (pcase method - ("textDocument/hover" (pcase (seq-filter - (-compose #'not #'lsp-empty?) - results) - (`(,hover) hover) - (hovers (lsp-make-hover - :contents - (-mapcat - (-lambda ((&Hover :contents)) - (if (and (sequencep contents) - (not (stringp contents))) - (append contents ()) - (list contents))) - hovers))))) - ("textDocument/completion" - (lsp-make-completion-list - :is-incomplete (seq-some - #'lsp:completion-list-is-incomplete - results) - :items (cl-mapcan (lambda (it) (append (if (lsp-completion-list? it) - (lsp:completion-list-items it) - it) - nil)) - results))) - ("completionItem/resolve" - (let ((item (cl-first results))) - (when-let ((details (seq-filter #'identity - (seq-map #'lsp:completion-item-detail? results)))) - (lsp:set-completion-item-detail? - item - (string-join details " "))) - (when-let ((docs (seq-filter #'identity - (seq-map #'lsp:completion-item-documentation? results)))) - (lsp:set-completion-item-documentation? - item - (lsp-make-markup-content - :kind (or (seq-some (lambda (it) - (when (equal (lsp:markup-content-kind it) - lsp/markup-kind-markdown) - lsp/markup-kind-markdown)) - docs) - lsp/markup-kind-plain-text) - :value (string-join (seq-map (lambda (doc) - (or (lsp:markup-content-value doc) - (and (stringp doc) doc))) - docs) - "\n")))) - (when-let ((edits (seq-filter #'identity - (seq-map #'lsp:completion-item-additional-text-edits? results)))) - (lsp:set-completion-item-additional-text-edits? - item - (cl-mapcan (lambda (it) (if (seqp it) it (list it))) edits))) - item)) - (_ (cl-mapcan (lambda (it) (if (seqp it) it (list it))) results)))))) - -(defun lsp--spinner-start () - "Start spinner indication." - (condition-case _err (spinner-start (lsp-progress-spinner-type)) (error))) - -(defun lsp--propertize (str type) - "Propertize STR as per TYPE." - (propertize str 'face (alist-get type lsp--message-type-face))) - -(defun lsp-workspaces () - "Return the lsp workspaces associated with the current project." - (if lsp--cur-workspace (list lsp--cur-workspace) lsp--buffer-workspaces)) - -(defun lsp--completing-read (prompt collection transform-fn &optional predicate - require-match initial-input - hist def inherit-input-method) - "Wrap `completing-read' to provide transformation function and disable sort. - -TRANSFORM-FN will be used to transform each of the items before displaying. - -PROMPT COLLECTION PREDICATE REQUIRE-MATCH INITIAL-INPUT HIST DEF -INHERIT-INPUT-METHOD will be proxied to `completing-read' without changes." - (let* ((col (--map (cons (funcall transform-fn it) it) collection)) - (completion (completing-read prompt - (lambda (string pred action) - (if (eq action 'metadata) - `(metadata (display-sort-function . identity)) - (complete-with-action action col string pred))) - predicate require-match initial-input hist - def inherit-input-method))) - (cdr (assoc completion col)))) - -(defconst lsp--system-arch (lambda () - (setq lsp--system-arch - (pcase system-type - ('windows-nt - (pcase system-configuration - ((rx bol "x86_64-") 'x64) - (_ 'x86))) - ('darwin - (pcase system-configuration - ((rx "aarch64-") 'arm64) - (_ 'x64))) - ('gnu/linux - (pcase system-configuration - ((rx bol "x86_64") 'x64) - ((rx bol (| "i386" "i886")) 'x32))) - (_ - (pcase system-configuration - ((rx bol "x86_64") 'x64) - ((rx bol (| "i386" "i886")) 'x32)))))) - "Return the system architecture of `Emacs'. -Special values: - `x64' 64bit - `x32' 32bit - `arm64' ARM 64bit") - -(defmacro lsp-with-current-buffer (buffer-id &rest body) - (declare (indent 1) (debug t)) - `(if-let ((wcb (plist-get ,buffer-id :with-current-buffer))) - (with-lsp-workspaces (plist-get ,buffer-id :workspaces) - (funcall wcb (lambda () ,@body))) - (with-current-buffer ,buffer-id - ,@body))) - -(defvar lsp--throw-on-input nil - "Make `lsp-*-while-no-input' throws `input' on interrupted.") - -(defmacro lsp--catch (tag bodyform &rest handlers) - "Catch TAG thrown in BODYFORM. -The return value from TAG will be handled in HANDLERS by `pcase'." - (declare (debug (form form &rest (pcase-PAT body))) (indent 2)) - (let ((re-sym (make-symbol "re"))) - `(let ((,re-sym (catch ,tag ,bodyform))) - (pcase ,re-sym - ,@handlers)))) - -(defmacro lsp--while-no-input (&rest body) - "Wrap BODY in `while-no-input' and respecting `non-essential'. -If `lsp--throw-on-input' is set, will throw if input is pending, else -return value of `body' or nil if interrupted." - (declare (debug t) (indent 0)) - `(if non-essential - (let ((res (while-no-input ,@body))) - (cond - ((and lsp--throw-on-input (equal res t)) - (throw 'input :interrupted)) - ((booleanp res) nil) - (t res))) - ,@body)) - -;; A ‘lsp--client’ object describes the client-side behavior of a language -;; server. It is used to start individual server processes, each of which is -;; represented by a ‘lsp--workspace’ object. Client objects are normally -;; created using ‘lsp-define-stdio-client’ or ‘lsp-define-tcp-client’. Each -;; workspace refers to exactly one client, but there can be multiple workspaces -;; for a single client. -(cl-defstruct lsp--client - ;; ‘language-id’ is a function that receives a buffer as a single argument - ;; and should return the language identifier for that buffer. See - ;; https://microsoft.github.io/language-server-protocol/specification#textdocumentitem - ;; for a list of language identifiers. Also consult the documentation for - ;; the language server represented by this client to find out what language - ;; identifiers it supports or expects. - (language-id nil) - - ;; ‘add-on?’ when set to t the server will be started no matter whether there - ;; is another server handling the same mode. - (add-on? nil) - ;; ‘new-connection’ is a function that should start a language server process - ;; and return a cons (COMMAND-PROCESS . COMMUNICATION-PROCESS). - ;; COMMAND-PROCESS must be a process object representing the server process - ;; just started. COMMUNICATION-PROCESS must be a process (including pipe and - ;; network processes) that ‘lsp-mode’ uses to communicate with the language - ;; server using the language server protocol. COMMAND-PROCESS and - ;; COMMUNICATION-PROCESS may be the same process; in that case - ;; ‘new-connection’ may also return that process as a single - ;; object. ‘new-connection’ is called with two arguments, FILTER and - ;; SENTINEL. FILTER should be used as process filter for - ;; COMMUNICATION-PROCESS, and SENTINEL should be used as process sentinel for - ;; COMMAND-PROCESS. - (new-connection nil) - - ;; ‘ignore-regexps’ is a list of regexps. When a data packet from the - ;; language server matches any of these regexps, it will be ignored. This is - ;; intended for dealing with language servers that output non-protocol data. - (ignore-regexps nil) - - ;; ‘ignore-messages’ is a list of regexps. When a message from the language - ;; server matches any of these regexps, it will be ignored. This is useful - ;; for filtering out unwanted messages; such as servers that send nonstandard - ;; message types, or extraneous log messages. - (ignore-messages nil) - - ;; ‘notification-handlers’ is a hash table mapping notification method names - ;; (strings) to functions handling the respective notifications. Upon - ;; receiving a notification, ‘lsp-mode’ will call the associated handler - ;; function passing two arguments, the ‘lsp--workspace’ object and the - ;; deserialized notification parameters. - (notification-handlers (make-hash-table :test 'equal)) - - ;; ‘request-handlers’ is a hash table mapping request method names - ;; (strings) to functions handling the respective notifications. Upon - ;; receiving a request, ‘lsp-mode’ will call the associated handler function - ;; passing two arguments, the ‘lsp--workspace’ object and the deserialized - ;; request parameters. - (request-handlers (make-hash-table :test 'equal)) - - ;; ‘response-handlers’ is a hash table mapping integral JSON-RPC request - ;; identifiers for pending asynchronous requests to functions handling the - ;; respective responses. Upon receiving a response from the language server, - ;; ‘lsp-mode’ will call the associated response handler function with a - ;; single argument, the deserialized response parameters. - (response-handlers (make-hash-table :test 'eql)) - - ;; ‘prefix-function’ is called for getting the prefix for completion. - ;; The function takes no parameter and returns a cons (start . end) representing - ;; the start and end bounds of the prefix. If it's not set, the client uses a - ;; default prefix function." - (prefix-function nil) - - ;; Contains mapping of scheme to the function that is going to be used to load - ;; the file. - (uri-handlers (make-hash-table :test #'equal)) - - ;; ‘action-handlers’ is a hash table mapping action to a handler function. It - ;; can be used in `lsp-execute-code-action' to determine whether the action - ;; current client is interested in executing the action instead of sending it - ;; to the server. - (action-handlers (make-hash-table :test 'equal)) - - ;; `action-filter' can be set to a function that modifies any incoming - ;; `CodeAction' in place before it is executed. The return value is ignored. - ;; This can be used to patch up broken code action requests before they are - ;; sent back to the LSP server. See `lsp-fix-code-action-booleans' for an - ;; example of a function that can be useful here. - (action-filter nil) - - ;; major modes supported by the client. - major-modes - ;; Function that will be called to decide if this language client - ;; should manage a particular buffer. The function will be passed - ;; the file name and major mode to inform the decision. Setting - ;; `activation-fn' will override `major-modes', if - ;; present. - activation-fn - ;; Break the tie when major-mode is supported by multiple clients. - (priority 0) - ;; Unique identifier for representing the client object. - server-id - ;; defines whether the client supports multi root workspaces. - multi-root - ;; Initialization options or a function that returns initialization options. - initialization-options - ;; `semantic-tokens-faces-overrides’ is a plist that can be used to extend, or - ;; completely replace, the faces used for semantic highlighting on a - ;; client-by-client basis. - ;; - ;; It recognizes four members, all of which are optional: `:types’ and - ;; `:modifiers’, respectively, should be face definition lists akin to - ;; `:lsp-semantic-token-faces’. If specified, each of these face lists will be - ;; merged with the default face definition list. - ;; - ;; Alternatively, if the plist members `:discard-default-types’ or - ;; `:discard-default-modifiers' are non-nil, the default `:type' or `:modifiers' - ;; face definitions will be replaced entirely by their respective overrides. - ;; - ;; For example, setting `:semantic-tokens-faces-overrides' to - ;; `(:types (("macro" . font-lock-keyword-face)))' will remap "macro" tokens from - ;; their default face `lsp-face-semhl-macro' to `font-lock-keyword-face'. - ;; - ;; `(:types (("macro" . font-lock-keyword-face) ("not-quite-a-macro" . some-face)))' - ;; will also remap "macro", but on top of that associate the fictional token type - ;; "not-quite-a-macro" with the face named `some-face'. - ;; - ;; `(:types (("macro" . font-lock-keyword-face)) - ;; :modifiers (("declaration" . lsp-face-semhl-interface)) - ;; :discard-default-types t - ;; :discard-default-modifiers t)' - ;; will discard all default face definitions, hence leaving the client with - ;; only one token type "macro", mapped to `font-lock-keyword-face', and one - ;; modifier type "declaration", mapped to `lsp-face-semhl-interface'. - semantic-tokens-faces-overrides - ;; Provides support for registering LSP Server specific capabilities. - custom-capabilities - ;; Function which returns the folders that are considered to be not projects but library files. - ;; The function accepts one parameter currently active workspace. - ;; See: https://github.com/emacs-lsp/lsp-mode/issues/225. - library-folders-fn - ;; function which will be called when opening file in the workspace to perform - ;; client specific initialization. The function accepts one parameter - ;; currently active workspace. - before-file-open-fn - ;; Function which will be called right after a workspace has been initialized. - initialized-fn - ;; ‘remote?’ indicate whether the client can be used for LSP server over TRAMP. - (remote? nil) - - ;; ‘completion-in-comments?’ t if the client supports completion in comments. - (completion-in-comments? nil) - - ;; ‘path->uri-fn’ the function to use for path->uri conversion for the client. - (path->uri-fn nil) - - ;; ‘uri->path-fn’ the function to use for uri->path conversion for the client. - (uri->path-fn nil) - ;; Function that returns an environment structure that will be used - ;; to set some environment variables when starting the language - ;; server process. These environment variables enable some - ;; additional features in the language server. The environment - ;; structure is an alist of the form (KEY . VALUE), where KEY is a - ;; string (regularly in all caps), and VALUE may be a string, a - ;; boolean, or a sequence of strings. - environment-fn - - ;; ‘after-open-fn’ workspace after open specific hooks. - (after-open-fn nil) - - ;; ‘async-request-handlers’ is a hash table mapping request method names - ;; (strings) to functions handling the respective requests that may take - ;; time to finish. Upon receiving a request, ‘lsp-mode’ will call the - ;; associated handler function passing three arguments, the ‘lsp--workspace’ - ;; object, the deserialized request parameters and the callback which accept - ;; result as its parameter. - (async-request-handlers (make-hash-table :test 'equal)) - download-server-fn - download-in-progress? - buffers - synchronize-sections) - -(defun lsp-clients-executable-find (find-command &rest args) - "Finds an executable by invoking a search command. - -FIND-COMMAND is the executable finder that searches for the -actual language server executable. ARGS is a list of arguments to -give to FIND-COMMAND to find the language server. Returns the -output of FIND-COMMAND if it exits successfully, nil otherwise. - -Typical uses include finding an executable by invoking `find' in -a project, finding LLVM commands on macOS with `xcrun', or -looking up project-specific language servers for projects written -in the various dynamic languages, e.g. `nvm', `pyenv' and `rbenv' -etc." - (when-let* ((find-command-path (executable-find find-command)) - (executable-path - (with-temp-buffer - (when (zerop (apply 'call-process find-command-path nil t nil args)) - (buffer-substring-no-properties (point-min) (point-max)))))) - (string-trim executable-path))) - -(defvar lsp--already-widened nil) - -(defmacro lsp-save-restriction-and-excursion (&rest form) - (declare (indent 0) (debug t)) - `(if lsp--already-widened - (save-excursion ,@form) - (-let [lsp--already-widened t] - (save-restriction - (widen) - (save-excursion ,@form))))) - -;; from http://emacs.stackexchange.com/questions/8082/how-to-get-buffer-position-given-line-number-and-column-number -(defun lsp--line-character-to-point (line character) - "Return the point for character CHARACTER on line LINE." - (or (lsp-virtual-buffer-call :line/character->point line character) - (let ((inhibit-field-text-motion t)) - (lsp-save-restriction-and-excursion - (goto-char (point-min)) - (forward-line line) - ;; server may send character position beyond the current line and we - ;; should fallback to line end. - (-let [line-end (line-end-position)] - (if (> character (- line-end (point))) - line-end - (forward-char character) - (point))))))) - -(lsp-defun lsp--position-to-point ((&Position :line :character)) - "Convert `Position' object in PARAMS to a point." - (lsp--line-character-to-point line character)) - -(lsp-defun lsp--range-to-region ((&RangeToPoint :start :end)) - (cons start end)) - -(lsp-defun lsp--range-text ((&RangeToPoint :start :end)) - (buffer-substring start end)) - -(lsp-defun lsp--find-wrapping-range ((&SelectionRange :parent? :range (&RangeToPoint :start :end))) - (cond - ((and - (region-active-p) - (<= start (region-beginning) end) - (<= start (region-end) end) - (or (not (= start (region-beginning))) - (not (= end (region-end))))) - (cons start end)) - ((and (<= start (point) end) - (not (region-active-p))) - (cons start end)) - (parent? (lsp--find-wrapping-range parent?)))) - -(defun lsp--get-selection-range () - (or - (-when-let ((cache . cache-tick) lsp--document-selection-range-cache) - (when (= cache-tick (buffer-modified-tick)) cache)) - (let ((response (cl-first - (lsp-request - "textDocument/selectionRange" - (list :textDocument (lsp--text-document-identifier) - :positions (vector (lsp--cur-position))))))) - (setq lsp--document-selection-range-cache - (cons response (buffer-modified-tick))) - response))) - -(defun lsp-extend-selection () - "Extend selection." - (interactive) - (unless (lsp-feature? "textDocument/selectionRange") - (signal 'lsp-capability-not-supported (list "selectionRangeProvider"))) - (-when-let ((start . end) (lsp--find-wrapping-range (lsp--get-selection-range))) - (goto-char start) - (set-mark (point)) - (goto-char end) - (exchange-point-and-mark))) - -(defun lsp-warn (message &rest args) - "Display a warning message made from (`format-message' MESSAGE ARGS...). -This is equivalent to `display-warning', using `lsp-mode' as the type and -`:warning' as the level." - (display-warning 'lsp-mode (apply #'format-message message args))) - -(defun lsp--get-uri-handler (scheme) - "Get uri handler for SCHEME in the current workspace." - (--some (gethash scheme (lsp--client-uri-handlers (lsp--workspace-client it))) - (or (lsp-workspaces) (lsp--session-workspaces (lsp-session))))) - -(defun lsp--fix-path-casing (path) - "On windows, downcases path because the windows file system is -case-insensitive. - -On other systems, returns path without change." - (if (eq system-type 'windows-nt) (downcase path) path)) - -(defun lsp--uri-to-path (uri) - "Convert URI to a file path." - (if-let ((fn (->> (lsp-workspaces) - (-keep (-compose #'lsp--client-uri->path-fn #'lsp--workspace-client)) - (cl-first)))) - (funcall fn uri) - (lsp--uri-to-path-1 uri))) - -(defun lsp-remap-path-if-needed (file-name) - (-if-let ((virtual-buffer &as &plist :buffer) (gethash file-name lsp--virtual-buffer-mappings)) - (propertize (buffer-local-value 'buffer-file-name buffer) - 'lsp-virtual-buffer virtual-buffer) - file-name)) - -(defun lsp--uri-to-path-1 (uri) - "Convert URI to a file path." - (let* ((url (url-generic-parse-url (url-unhex-string uri))) - (type (url-type url)) - (target (url-target url)) - (file - (concat (decode-coding-string (url-filename url) - (or locale-coding-system 'utf-8)) - (when (and target - (not (s-match - (rx "#" (group (1+ num)) (or "," "#") - (group (1+ num)) - string-end) - uri))) - (concat "#" target)))) - (file-name (if (and type (not (string= type "file"))) - (if-let ((handler (lsp--get-uri-handler type))) - (funcall handler uri) - uri) - ;; `url-generic-parse-url' is buggy on windows: - ;; https://github.com/emacs-lsp/lsp-mode/pull/265 - (or (and (eq system-type 'windows-nt) - (eq (elt file 0) ?\/) - (substring file 1)) - file)))) - (->> file-name - (concat (-some #'lsp--workspace-host-root (lsp-workspaces))) - (lsp-remap-path-if-needed)))) - -(defun lsp--buffer-uri () - "Return URI of the current buffer." - (or lsp-buffer-uri - (plist-get lsp--virtual-buffer :buffer-uri) - (lsp--path-to-uri - (or (buffer-file-name) (buffer-file-name (buffer-base-buffer)))))) - -(defun lsp-register-client-capabilities (&rest _args) - "Implemented only to make `company-lsp' happy. -DELETE when `lsp-mode.el' is deleted.") - -(defconst lsp--url-path-allowed-chars - (url--allowed-chars (append '(?/) url-unreserved-chars)) - "`url-unreserved-chars' with additional delim ?/. -This set of allowed chars is enough for hexifying local file paths.") - -(defun lsp--path-to-uri-1 (path) - (concat lsp--uri-file-prefix - (--> path - (expand-file-name it) - (or (file-remote-p it 'localname t) it) - (url-hexify-string it lsp--url-path-allowed-chars)))) - -(defun lsp--path-to-uri (path) - "Convert PATH to a uri." - (if-let ((uri-fn (->> (lsp-workspaces) - (-keep (-compose #'lsp--client-path->uri-fn #'lsp--workspace-client)) - (cl-first)))) - (funcall uri-fn path) - (lsp--path-to-uri-1 path))) - -(defun lsp--string-match-any (regex-list str) - "Return the first regex, if any, within REGEX-LIST matching STR." - (--first (string-match it str) regex-list)) - -(cl-defstruct lsp-watch - (descriptors (make-hash-table :test 'equal)) - root-directory) - -(defun lsp--folder-watch-callback (event callback watch ignored-files ignored-directories) - (let ((file-name (cl-third event)) - (event-type (cl-second event))) - (cond - ((and (file-directory-p file-name) - (equal 'created event-type) - (not (lsp--string-match-any ignored-directories file-name))) - - (lsp-watch-root-folder (file-truename file-name) callback ignored-files ignored-directories watch) - - ;; process the files that are already present in - ;; the directory. - (->> (directory-files-recursively file-name ".*" t) - (seq-do (lambda (f) - (unless (file-directory-p f) - (funcall callback (list nil 'created f))))))) - ((and (memq event-type '(created deleted changed)) - (not (file-directory-p file-name)) - (not (lsp--string-match-any ignored-files file-name))) - (funcall callback event)) - ((and (memq event-type '(renamed)) - (not (file-directory-p file-name)) - (not (lsp--string-match-any ignored-files file-name))) - (funcall callback `(,(cl-first event) deleted ,(cl-third event))) - (funcall callback `(,(cl-first event) created ,(cl-fourth event))))))) - -(defun lsp--ask-about-watching-big-repo (number-of-directories dir) - "Ask the user if they want to watch NUMBER-OF-DIRECTORIES from a repository DIR. -This is useful when there is a lot of files in a repository, as -that may slow Emacs down. Returns t if the user wants to watch -the entire repository, nil otherwise." - (prog1 - (yes-or-no-p - (format - "Watching all the files in %s would require adding watches to %s directories, so watching the repo may slow Emacs down. -Do you want to watch all files in %s? " - dir - number-of-directories - dir)) - (lsp--info - (concat "You can configure this warning with the `lsp-enable-file-watchers' " - "and `lsp-file-watch-threshold' variables")))) - - -(defun lsp--path-is-watchable-directory (path dir ignored-directories) - "Figure out whether PATH (inside of DIR) is meant to have a file watcher set. -IGNORED-DIRECTORIES is a list of regexes to filter out directories we don't -want to watch." - (let - ((full-path (f-join dir path))) - (and (file-accessible-directory-p full-path) - (not (equal path ".")) - (not (equal path "..")) - (not (lsp--string-match-any ignored-directories full-path))))) - - -(defun lsp--all-watchable-directories (dir ignored-directories) - "Traverse DIR recursively returning a list of paths that should have watchers. -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 nil - (lsp--ask-about-watching-big-repo number-of-directories dir) - (quit))))) - (dolist (current-dir dirs-to-watch) - (condition-case err - (progn - (puthash - current-dir - (file-notify-add-watch current-dir - '(change) - (lambda (event) - (lsp--folder-watch-callback event callback watch ignored-files ignored-directories))) - (lsp-watch-descriptors watch))) - (error (lsp-log "Failed to create a watch for %s: message" (error-message-string err))) - (file-missing (lsp-log "Failed to create a watch for %s: message" (error-message-string err)))))) - watch)) - -(defun lsp-kill-watch (watch) - "Delete WATCH." - (-> watch lsp-watch-descriptors hash-table-values (-each #'file-notify-rm-watch)) - (ht-clear! (lsp-watch-descriptors watch))) - -(defun lsp-json-bool (val) - "Convert VAL to JSON boolean." - (if val t :json-false)) - -(defmacro with-lsp-workspace (workspace &rest body) - "Helper macro for invoking BODY in WORKSPACE context." - (declare (debug (form body)) - (indent 1)) - `(let ((lsp--cur-workspace ,workspace)) ,@body)) - -(defmacro with-lsp-workspaces (workspaces &rest body) - "Helper macro for invoking BODY against multiple WORKSPACES." - (declare (debug (form body)) - (indent 1)) - `(let ((lsp--buffer-workspaces ,workspaces)) ,@body)) - - - -(defmacro lsp-consistency-check (package) - `(defconst ,(intern (concat (symbol-name package) - "-plist-value-when-compiled")) - (eval-when-compile lsp-use-plists))) - - -;; loading code-workspace files - -;;;###autoload -(defun lsp-load-vscode-workspace (file) - "Load vscode workspace from FILE" - (interactive "fSelect file to import: ") - (mapc #'lsp-workspace-folders-remove (lsp-session-folders (lsp-session))) - - (let ((dir (f-dirname file))) - (->> file - (json-read-file) - (alist-get 'folders) - (-map (-lambda ((&alist 'path)) - (lsp-workspace-folders-add (expand-file-name path dir))))))) - -;;;###autoload -(defun lsp-save-vscode-workspace (file) - "Save vscode workspace to FILE" - (interactive "FSelect file to save to: ") - - (let ((json-encoding-pretty-print t)) - (f-write-text (json-encode - `((folders . ,(->> (lsp-session) - (lsp-session-folders) - (--map `((path . ,it))))))) - 'utf-8 - file))) - - -(defmacro lsp-foreach-workspace (&rest body) - "Execute BODY for each of the current workspaces." - (declare (debug (form body))) - `(--map (with-lsp-workspace it ,@body) (lsp-workspaces))) - -(defmacro when-lsp-workspace (workspace &rest body) - "Helper macro for invoking BODY in WORKSPACE context if present." - (declare (debug (form body)) - (indent 1)) - `(when-let ((lsp--cur-workspace ,workspace)) ,@body)) - -(lsp-defun lsp--window-show-quick-pick (_workspace (&ShowQuickPickParams :place-holder :can-pick-many :items)) - (if-let* ((selectfunc (if can-pick-many #'completing-read-multiple #'completing-read)) - (itemLabels (seq-map (-lambda ((item &as &QuickPickItem :label)) (format "%s" label)) - items)) - (result (funcall-interactively - selectfunc - (format "%s%s " place-holder (if can-pick-many " (* for all)" "")) itemLabels)) - (choices (if (listp result) - (if (equal result '("*")) - itemLabels - result) - (list result)))) - (vconcat (seq-filter #'identity (seq-map (-lambda ((item &as &QuickPickItem :label :user-data)) - (if (member label choices) - (lsp-make-quick-pick-item :label label :picked t :user-data user-data) - nil)) - items))))) - -(lsp-defun lsp--window-show-input-box (_workspace (&ShowInputBoxParams :prompt :value?)) - (read-string (format "%s: " prompt) (or value? ""))) - -(lsp-defun lsp--window-show-message (_workspace (&ShowMessageRequestParams :message :type)) - "Send the server's messages to log. -PARAMS - the data sent from _WORKSPACE." - (funcall (cl-case type - (1 'lsp--error) - (2 'lsp--warn) - (t 'lsp--info)) - "%s" - message)) - -(lsp-defun lsp--window-log-message (workspace (&ShowMessageRequestParams :message :type)) - "Send the server's messages to log. -PARAMS - the data sent from WORKSPACE." - (ignore - (let ((client (lsp--workspace-client workspace))) - (when (or (not client) - (cl-notany (-rpartial #'string-match-p message) - (lsp--client-ignore-messages client))) - (lsp-log "%s" (lsp--propertize message type)))))) - -(lsp-defun lsp--window-log-message-request ((&ShowMessageRequestParams :message :type :actions?)) - "Display a message request to user sending the user selection back to server." - (let* ((message (lsp--propertize message type)) - (choices (seq-map #'lsp:message-action-item-title actions?))) - (if choices - (completing-read (concat message " ") (seq-into choices 'list) nil t) - (lsp-log message)))) - -(lsp-defun lsp--window-show-document ((&ShowDocumentParams :uri :selection?)) - "Show document URI in a buffer and go to SELECTION if any." - (let ((path (lsp--uri-to-path uri))) - (when (f-exists? path) - (with-current-buffer (find-file path) - (when selection? - (goto-char (lsp--position-to-point (lsp:range-start selection?)))) - t)))) - -(defcustom lsp-progress-prefix "⌛ " - "Progress prefix." - :group 'lsp-mode - :type 'string - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-progress-function #'lsp-on-progress-modeline - "Function for handling the progress notifications." - :group 'lsp-mode - :type '(choice - (const :tag "Use modeline" lsp-on-progress-modeline) - (const :tag "Legacy(uses either `progress-reporter' or `spinner' based on `lsp-progress-via-spinner')" - lsp-on-progress-legacy) - (const :tag "Ignore" ignore) - (function :tag "Other function")) - :package-version '(lsp-mode . "8.0.0")) - -(defcustom lsp-request-while-no-input-may-block nil - "Have `lsp-request-while-no-input` block unless `non-essential` is t." - :group 'lsp-mode - :type 'boolean) - -(defun lsp--progress-status () - "Returns the status of the progress for the current workspaces." - (-let ((progress-status - (s-join - "|" - (-keep - (lambda (workspace) - (let ((tokens (lsp--workspace-work-done-tokens workspace))) - (unless (ht-empty? tokens) - (mapconcat - (-lambda ((&WorkDoneProgressBegin :message? :title :percentage?)) - (concat (if percentage? - (if (numberp percentage?) - (format "%.0f%%%% " percentage?) - (format "%s%%%% " percentage?)) - "") - (or message? title))) - (ht-values tokens) - "|")))) - (lsp-workspaces))))) - (unless (s-blank? progress-status) - (concat lsp-progress-prefix progress-status " ")))) - -(lsp-defun lsp-on-progress-modeline (workspace (&ProgressParams :token :value - (value &as &WorkDoneProgress :kind))) - "PARAMS contains the progress data. -WORKSPACE is the workspace that contains the progress token." - (add-to-list 'global-mode-string '(t (:eval (lsp--progress-status)))) - (pcase kind - ("begin" (lsp-workspace-set-work-done-token token value workspace)) - ("report" (lsp-workspace-set-work-done-token token value workspace)) - ("end" (lsp-workspace-rem-work-done-token token workspace))) - (force-mode-line-update)) - -(lsp-defun lsp-on-progress-legacy (workspace (&ProgressParams :token :value - (value &as &WorkDoneProgress :kind))) - "PARAMS contains the progress data. -WORKSPACE is the workspace that contains the progress token." - (pcase kind - ("begin" - (-let* (((&WorkDoneProgressBegin :title :percentage?) value) - (reporter - (if lsp-progress-via-spinner - (let* ((spinner-strings (alist-get (lsp-progress-spinner-type) spinner-types)) - ;; Set message as a tooltip for the spinner strings - (propertized-strings - (seq-map (lambda (string) (propertize string 'help-echo title)) - spinner-strings)) - (spinner-type (vconcat propertized-strings))) - ;; The progress relates to the server as a whole, - ;; display it on all buffers. - (mapcar (lambda (buffer) - (lsp-with-current-buffer buffer - (spinner-start spinner-type)) - buffer) - (lsp--workspace-buffers workspace))) - (if percentage? - (make-progress-reporter title 0 100 percentage?) - ;; No percentage, just progress - (make-progress-reporter title nil nil))))) - (lsp-workspace-set-work-done-token token reporter workspace))) - ("report" - (when-let ((reporter (lsp-workspace-get-work-done-token token workspace))) - (unless lsp-progress-via-spinner - (progress-reporter-update reporter (lsp:work-done-progress-report-percentage? value))))) - - ("end" - (when-let ((reporter (lsp-workspace-get-work-done-token token workspace))) - (if lsp-progress-via-spinner - (mapc (lambda (buffer) - (when (lsp-buffer-live-p buffer) - (lsp-with-current-buffer buffer - (spinner-stop)))) - reporter) - (progress-reporter-done reporter)) - (lsp-workspace-rem-work-done-token token workspace))))) - - -;; diagnostics - -(defvar lsp-diagnostic-filter nil - "A a function which will be called with - `&PublishDiagnosticsParams' and `workspace' which can be used - to filter out the diagnostics. The function should return - `&PublishDiagnosticsParams'. - -Common usecase are: -1. Filter the diagnostics for a particular language server. -2. Filter out the diagnostics under specific level.") - -(defvar lsp-diagnostic-stats (ht)) - -(defun lsp-diagnostics (&optional current-workspace?) - "Return the diagnostics from all workspaces." - (or (pcase (if current-workspace? - (lsp-workspaces) - (lsp--session-workspaces (lsp-session))) - (`() ()) - (`(,workspace) (lsp--workspace-diagnostics workspace)) - (`,workspaces (let ((result (make-hash-table :test 'equal))) - (mapc (lambda (workspace) - (->> workspace - (lsp--workspace-diagnostics) - (maphash (lambda (file-name diagnostics) - (puthash file-name - (append (gethash file-name result) diagnostics) - result))))) - workspaces) - result))) - (ht))) - -(defun lsp-diagnostics-stats-for (path) - "Get diagnostics statistics for PATH. -The result format is vector [_ errors warnings infos hints] or nil." - (gethash (lsp--fix-path-casing path) lsp-diagnostic-stats)) - -(defun lsp-diagnostics--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 () - (when (and lsp-enable-folding - (lsp-feature? "textDocument/foldingRange")) - (if-let ((range (lsp--get-current-innermost-folding-range))) - (cons (lsp--folding-range-beg range) - (lsp--folding-range-end range))))) -(put 'lsp--folding-range 'bounds-of-thing-at-point - #'lsp--folding-range-at-point-bounds) - -(defun lsp--get-nearest-folding-range (&optional backward) - (let ((point (point)) - (found nil)) - (while (not - (or found - (if backward - (<= point (point-min)) - (>= point (point-max))))) - (if backward (cl-decf point) (cl-incf point)) - (setq found (lsp--get-current-innermost-folding-range point))) - found)) - -(defun lsp--folding-range-at-point-forward-op (n) - (when (and lsp-enable-folding - (not (zerop n)) - (lsp-feature? "textDocument/foldingRange")) - (cl-block break - (dotimes (_ (abs n)) - (if-let ((range (lsp--get-nearest-folding-range (< n 0)))) - (goto-char (if (< n 0) - (lsp--folding-range-beg range) - (lsp--folding-range-end range))) - (cl-return-from break)))))) -(put 'lsp--folding-range 'forward-op - #'lsp--folding-range-at-point-forward-op) - -(defun lsp--folding-range-at-point-beginning-op () - (goto-char (car (lsp--folding-range-at-point-bounds)))) -(put 'lsp--folding-range 'beginning-op - #'lsp--folding-range-at-point-beginning-op) - -(defun lsp--folding-range-at-point-end-op () - (goto-char (cdr (lsp--folding-range-at-point-bounds)))) -(put 'lsp--folding-range 'end-op - #'lsp--folding-range-at-point-end-op) - -(defun lsp--range-at-point-bounds () - (or (lsp--folding-range-at-point-bounds) - (when-let ((range (and - (lsp-feature? "textDocument/hover") - (->> (lsp--text-document-position-params) - (lsp-request "textDocument/hover") - (lsp:hover-range?))))) - (lsp--range-to-region range)))) - -;; A more general purpose "thing", useful for applications like focus.el -(put 'lsp--range 'bounds-of-thing-at-point - #'lsp--range-at-point-bounds) - -(defun lsp--log-io-p (method) - "Return non nil if should log for METHOD." - (and lsp-log-io - (or (not lsp-log-io-allowlist-methods) - (member method lsp-log-io-allowlist-methods)))) - - -;; toggles - -(defun lsp-toggle-trace-io () - "Toggle client-server protocol logging." - (interactive) - (setq lsp-log-io (not lsp-log-io)) - (lsp--info "Server logging %s." (if lsp-log-io "enabled" "disabled"))) - -(defun lsp-toggle-signature-auto-activate () - "Toggle signature auto activate." - (interactive) - (setq lsp-signature-auto-activate - (unless lsp-signature-auto-activate '(:on-trigger-char))) - (lsp--info "Signature autoactivate %s." (if lsp-signature-auto-activate "enabled" "disabled")) - (lsp--update-signature-help-hook)) - -(defun lsp-toggle-on-type-formatting () - "Toggle on type formatting." - (interactive) - (setq lsp-enable-on-type-formatting (not lsp-enable-on-type-formatting)) - (lsp--info "On type formatting is %s." (if lsp-enable-on-type-formatting "enabled" "disabled")) - (lsp--update-on-type-formatting-hook)) - -(defun lsp-toggle-symbol-highlight () - "Toggle symbol highlighting." - (interactive) - (setq lsp-enable-symbol-highlighting (not lsp-enable-symbol-highlighting)) - - (cond - ((and lsp-enable-symbol-highlighting - (lsp-feature? "textDocument/documentHighlight")) - (add-hook 'lsp-on-idle-hook #'lsp--document-highlight nil t) - (lsp--info "Symbol highlighting enabled in current buffer.")) - ((not lsp-enable-symbol-highlighting) - (remove-hook 'lsp-on-idle-hook #'lsp--document-highlight t) - (lsp--remove-overlays 'lsp-highlight) - (lsp--info "Symbol highlighting disabled in current buffer.")))) - - -;; keybindings -(defvar lsp--binding-descriptions nil - "List of key binding/short description pair.") - -(defmacro lsp-define-conditional-key (keymap key def desc cond &rest bindings) - "In KEYMAP, define key sequence KEY as DEF conditionally. -This is like `define-key', except the definition disappears -whenever COND evaluates to nil. -DESC is the short-description for the binding. -BINDINGS is a list of (key def desc cond)." - (declare (indent defun) - (debug (form form form form form &rest sexp))) - (->> (cl-list* key def desc cond bindings) - (-partition 4) - (-mapcat (-lambda ((key def desc cond)) - `((define-key ,keymap ,key - '(menu-item - ,(format "maybe-%s" def) - ,def - :filter - (lambda (item) - (when (with-current-buffer (or (when (buffer-live-p lsp--describe-buffer) - lsp--describe-buffer) - (current-buffer)) - ,cond) - item)))) - (when (stringp ,key) - (setq lsp--binding-descriptions - (append lsp--binding-descriptions '(,key ,desc))))))) - macroexp-progn)) - -(defvar lsp--describe-buffer nil) - -(defun lsp-describe-buffer-bindings-advice (fn buffer &optional prefix menus) - (let ((lsp--describe-buffer buffer)) - (funcall fn buffer prefix menus))) - -(advice-add 'describe-buffer-bindings - :around - #'lsp-describe-buffer-bindings-advice) - -(defun lsp--prepend-prefix (mappings) - (->> mappings - (-partition 2) - (-mapcat (-lambda ((key description)) - (list (concat lsp-keymap-prefix " " key) - description))))) - -(defvar lsp-command-map - (-doto (make-sparse-keymap) - (lsp-define-conditional-key - ;; workspaces - "wD" lsp-disconnect "disconnect" (lsp-workspaces) - "wd" lsp-describe-session "describe session" t - "wq" lsp-workspace-shutdown "shutdown server" (lsp-workspaces) - "wr" lsp-workspace-restart "restart server" (lsp-workspaces) - "ws" lsp "start server" t - - ;; formatting - "==" lsp-format-buffer "format buffer" (or (lsp-feature? "textDocument/rangeFormatting") - (lsp-feature? "textDocument/formatting")) - "=r" lsp-format-region "format region" (lsp-feature? "textDocument/rangeFormatting") - - ;; folders - "Fa" lsp-workspace-folders-add "add folder" t - "Fb" lsp-workspace-blocklist-remove "un-blocklist folder" t - "Fr" lsp-workspace-folders-remove "remove folder" t - - ;; toggles - "TD" lsp-modeline-diagnostics-mode "toggle modeline diagnostics" (lsp-feature? - "textDocument/publishDiagnostics") - "TL" lsp-toggle-trace-io "toggle log io" t - "TS" lsp-ui-sideline-mode "toggle sideline" (featurep 'lsp-ui-sideline) - "TT" lsp-treemacs-sync-mode "toggle treemacs integration" (featurep 'lsp-treemacs) - "Ta" lsp-modeline-code-actions-mode "toggle modeline code actions" (lsp-feature? - "textDocument/codeAction") - "Tb" lsp-headerline-breadcrumb-mode "toggle breadcrumb" (lsp-feature? - "textDocument/documentSymbol") - "Td" lsp-ui-doc-mode "toggle documentation popup" (featurep 'lsp-ui-doc) - "Tf" lsp-toggle-on-type-formatting "toggle on type formatting" (lsp-feature? - "textDocument/onTypeFormatting") - "Th" lsp-toggle-symbol-highlight "toggle highlighting" (lsp-feature? "textDocument/documentHighlight") - "Tl" lsp-lens-mode "toggle lenses" (lsp-feature? "textDocument/codeLens") - "Ts" lsp-toggle-signature-auto-activate "toggle signature" (lsp-feature? "textDocument/signatureHelp") - - ;; goto - "ga" xref-find-apropos "find symbol in workspace" (lsp-feature? "workspace/symbol") - "gd" lsp-find-declaration "find declarations" (lsp-feature? "textDocument/declaration") - "ge" lsp-treemacs-errors-list "show errors" (fboundp 'lsp-treemacs-errors-list) - "gg" lsp-find-definition "find definitions" (lsp-feature? "textDocument/definition") - "gh" lsp-treemacs-call-hierarchy "call hierarchy" (and (lsp-feature? "callHierarchy/incomingCalls") - (fboundp 'lsp-treemacs-call-hierarchy)) - "gi" lsp-find-implementation "find implementations" (lsp-feature? "textDocument/implementation") - "gr" lsp-find-references "find references" (lsp-feature? "textDocument/references") - "gt" lsp-find-type-definition "find type definition" (lsp-feature? "textDocument/typeDefinition") - - ;; help - "hg" lsp-ui-doc-glance "glance symbol" (and (featurep 'lsp-ui-doc) - (lsp-feature? "textDocument/hover")) - "hh" lsp-describe-thing-at-point "describe symbol at point" (lsp-feature? "textDocument/hover") - "hs" lsp-signature-activate "signature help" (lsp-feature? "textDocument/signatureHelp") - - ;; refactoring - "ro" lsp-organize-imports "organize imports" (lsp-feature? "textDocument/codeAction") - "rr" lsp-rename "rename" (lsp-feature? "textDocument/rename") - - ;; actions - "aa" lsp-execute-code-action "code actions" (lsp-feature? "textDocument/codeAction") - "ah" lsp-document-highlight "highlight symbol" (lsp-feature? "textDocument/documentHighlight") - "al" lsp-avy-lens "lens" (and (bound-and-true-p lsp-lens-mode) (featurep 'avy)) - - ;; peeks - "Gg" lsp-ui-peek-find-definitions "peek definitions" (and (lsp-feature? "textDocument/definition") - (fboundp 'lsp-ui-peek-find-definitions)) - "Gi" lsp-ui-peek-find-implementation "peek implementations" (and - (fboundp 'lsp-ui-peek-find-implementation) - (lsp-feature? "textDocument/implementation")) - "Gr" lsp-ui-peek-find-references "peek references" (and (fboundp 'lsp-ui-peek-find-references) - (lsp-feature? "textDocument/references")) - "Gs" lsp-ui-peek-find-workspace-symbol "peek workspace symbol" (and (fboundp - 'lsp-ui-peek-find-workspace-symbol) - (lsp-feature? "workspace/symbol"))))) - - -;; which-key integration - -(declare-function which-key-add-major-mode-key-based-replacements "ext:which-key") -(declare-function which-key-add-key-based-replacements "ext:which-key") - -(defun lsp-enable-which-key-integration (&optional all-modes) - "Adds descriptions for `lsp-mode-map' to `which-key-mode' for the current -active `major-mode', or for all major modes when ALL-MODES is t." - (cl-flet ((which-key-fn (if all-modes - 'which-key-add-key-based-replacements - (apply-partially 'which-key-add-major-mode-key-based-replacements major-mode)))) - (apply - #'which-key-fn - (lsp--prepend-prefix - (cl-list* - "" "lsp" - "w" "workspaces" - "F" "folders" - "=" "formatting" - "T" "toggle" - "g" "goto" - "h" "help" - "r" "refactor" - "a" "code actions" - "G" "peek" - lsp--binding-descriptions))))) - - -;; Globbing syntax - -;; We port VSCode's glob-to-regexp code -;; (https://github.com/Microsoft/vscode/blob/466da1c9013c624140f6d1473b23a870abc82d44/src/vs/base/common/glob.ts) -;; since the LSP globbing syntax seems to be the same as that of -;; VSCode. - -(defconst lsp-globstar "**" - "Globstar pattern.") - -(defconst lsp-glob-split ?/ - "The character by which we split path components in a glob -pattern.") - -(defconst lsp-path-regexp "[/\\\\]" - "Forward or backslash to be used as a path separator in -computed regexps.") - -(defconst lsp-non-path-regexp "[^/\\\\]" - "A regexp matching anything other than a slash.") - -(defconst lsp-globstar-regexp - (format "\\(?:%s\\|%s+%s\\|%s%s+\\)*?" - lsp-path-regexp - lsp-non-path-regexp lsp-path-regexp - lsp-path-regexp lsp-non-path-regexp) - "Globstar in regexp form.") - -(defun lsp-split-glob-pattern (pattern split-char) - "Split PATTERN at SPLIT-CHAR while respecting braces and brackets." - (when pattern - (let ((segments nil) - (in-braces nil) - (in-brackets nil) - (current-segment "")) - (dolist (char (string-to-list pattern)) - (cl-block 'exit-point - (if (eq char split-char) - (when (and (null in-braces) - (null in-brackets)) - (push current-segment segments) - (setq current-segment "") - (cl-return-from 'exit-point)) - (pcase char - (?{ - (setq in-braces t)) - (?} - (setq in-braces nil)) - (?\[ - (setq in-brackets t)) - (?\] - (setq in-brackets nil)))) - (setq current-segment (concat current-segment - (char-to-string char))))) - (unless (string-empty-p current-segment) - (push current-segment segments)) - (nreverse segments)))) - -(defun lsp--glob-to-regexp (pattern) - "Helper function to convert a PATTERN from LSP's glob syntax to -an Elisp regexp." - (if (string-empty-p pattern) - "" - (let ((current-regexp "") - (glob-segments (lsp-split-glob-pattern pattern lsp-glob-split))) - (if (-all? (lambda (segment) (eq segment lsp-globstar)) - glob-segments) - ".*" - (let ((prev-segment-was-globstar nil)) - (seq-do-indexed - (lambda (segment index) - (if (string-equal segment lsp-globstar) - (unless prev-segment-was-globstar - (setq current-regexp (concat current-regexp - lsp-globstar-regexp)) - (setq prev-segment-was-globstar t)) - (let ((in-braces nil) - (brace-val "") - (in-brackets nil) - (bracket-val "")) - (dolist (char (string-to-list segment)) - (cond - ((and (not (char-equal char ?\})) - in-braces) - (setq brace-val (concat brace-val - (char-to-string char)))) - ((and in-brackets - (or (not (char-equal char ?\])) - (string-empty-p bracket-val))) - (let ((curr (cond - ((char-equal char ?-) - "-") - ;; NOTE: ?\^ and ?^ are different characters - ((and (memq char '(?^ ?!)) - (string-empty-p bracket-val)) - "^") - ((char-equal char lsp-glob-split) - "") - (t - (regexp-quote (char-to-string char)))))) - (setq bracket-val (concat bracket-val curr)))) - (t - (cl-case char - (?{ - (setq in-braces t)) - (?\[ - (setq in-brackets t)) - (?} - (let* ((choices (lsp-split-glob-pattern brace-val ?\,)) - (brace-regexp (concat "\\(?:" - (mapconcat #'lsp--glob-to-regexp choices "\\|") - "\\)"))) - (setq current-regexp (concat current-regexp - brace-regexp)) - (setq in-braces nil) - (setq brace-val ""))) - (?\] - (setq current-regexp - (concat current-regexp - "[" bracket-val "]")) - (setq in-brackets nil) - (setq bracket-val "")) - (?? - (setq current-regexp - (concat current-regexp - lsp-non-path-regexp))) - (?* - (setq current-regexp - (concat current-regexp - lsp-non-path-regexp "*?"))) - (t - (setq current-regexp - (concat current-regexp - (regexp-quote (char-to-string char))))))))) - (when (and (< index (1- (length glob-segments))) - (or (not (string-equal (nth (1+ index) glob-segments) - lsp-globstar)) - (< (+ index 2) - (length glob-segments)))) - (setq current-regexp - (concat current-regexp - lsp-path-regexp))) - (setq prev-segment-was-globstar nil)))) - glob-segments) - current-regexp))))) - -;; See https://github.com/emacs-lsp/lsp-mode/issues/2365 -(defun lsp-glob-unbrace-at-top-level (glob-pattern) - "If GLOB-PATTERN does not start with a brace, return a singleton list -containing GLOB-PATTERN. - -If GLOB-PATTERN does start with a brace, return a list of the -comma-separated globs within the top-level braces." - (if (not (string-prefix-p "{" glob-pattern)) - (list glob-pattern) - (lsp-split-glob-pattern (substring glob-pattern 1 -1) ?\,))) - -(defun lsp-glob-convert-to-wrapped-regexp (glob-pattern) - "Convert GLOB-PATTERN to a regexp wrapped with the beginning- -and end-of-string meta-characters." - (concat "\\`" (lsp--glob-to-regexp (string-trim glob-pattern)) "\\'")) - -(defun lsp-glob-to-regexps (glob-pattern) - "Convert a GLOB-PATTERN to a list of Elisp regexps." - (when-let* - ((glob-pattern (cond ((hash-table-p glob-pattern) - (ht-get glob-pattern "pattern")) - ((stringp glob-pattern) glob-pattern) - (t (error "Unknown glob-pattern type: %s" glob-pattern)))) - (trimmed-pattern (string-trim glob-pattern)) - (top-level-unbraced-patterns (lsp-glob-unbrace-at-top-level trimmed-pattern))) - (seq-map #'lsp-glob-convert-to-wrapped-regexp - top-level-unbraced-patterns))) - - - -(defvar lsp-mode-menu) - -(defun lsp-mouse-click (event) - (interactive "e") - (let* ((ec (event-start event)) - (choice (x-popup-menu event lsp-mode-menu)) - (action (lookup-key lsp-mode-menu (apply 'vector choice)))) - - (select-window (posn-window ec)) - - (unless (and (region-active-p) (eq action 'lsp-execute-code-action)) - (goto-char (posn-point ec))) - (run-with-idle-timer - 0.001 nil - (lambda () - (cl-labels ((check (value) (not (null value)))) - (when choice - (call-interactively action))))))) - -(defvar lsp-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-<down-mouse-1>") #'lsp-find-definition-mouse) - (define-key map (kbd "C-<mouse-1>") #'ignore) - (define-key map (kbd "<mouse-3>") #'lsp-mouse-click) - (define-key map (kbd "C-S-SPC") #'lsp-signature-activate) - (when lsp-keymap-prefix - (define-key map (kbd lsp-keymap-prefix) lsp-command-map)) - map) - "Keymap for `lsp-mode'.") - -(define-minor-mode lsp-mode "Mode for LSP interaction." - :keymap lsp-mode-map - :lighter - (" LSP[" - (lsp--buffer-workspaces - (:eval (mapconcat #'lsp--workspace-print lsp--buffer-workspaces "][")) - (:propertize "Disconnected" face warning)) - "]") - :group 'lsp-mode - (when (and lsp-mode (not lsp--buffer-workspaces) (not lsp--buffer-deferred)) - ;; fire up `lsp' when someone calls `lsp-mode' instead of `lsp' - (lsp))) - -(defvar lsp-mode-menu - (easy-menu-create-menu - nil - `(["Go to definition" lsp-find-definition - :active (lsp-feature? "textDocument/definition")] - ["Find references" lsp-find-references - :active (lsp-feature? "textDocument/references")] - ["Find implementations" lsp-find-implementation - :active (lsp-feature? "textDocument/implementation")] - ["Find declarations" lsp-find-declaration - :active (lsp-feature? "textDocument/declaration")] - ["Go to type declaration" lsp-find-type-definition - :active (lsp-feature? "textDocument/typeDefinition")] - "--" - ["Describe" lsp-describe-thing-at-point] - ["Code action" lsp-execute-code-action] - ["Format" lsp-format-buffer] - ["Highlight references" lsp-document-highlight] - ["Type Hierarchy" lsp-java-type-hierarchy - :visible (lsp-can-execute-command? "java.navigate.resolveTypeHierarchy")] - ["Type Hierarchy" lsp-treemacs-type-hierarchy - :visible (and (not (lsp-can-execute-command? "java.navigate.resolveTypeHierarchy")) - (functionp 'lsp-treemacs-type-hierarchy) - (lsp-feature? "textDocument/typeHierarchy"))] - ["Call Hierarchy" lsp-treemacs-call-hierarchy - :visible (and (functionp 'lsp-treemacs-call-hierarchy) - (lsp-feature? "textDocument/callHierarchy"))] - ["Rename" lsp-rename - :active (lsp-feature? "textDocument/rename")] - "--" - ("Session" - ["View logs" lsp-workspace-show-log] - ["Describe" lsp-describe-session] - ["Shutdown" lsp-shutdown-workspace] - ["Restart" lsp-restart-workspace]) - ("Workspace Folders" - ["Add" lsp-workspace-folders-add] - ["Remove" lsp-workspace-folders-remove] - ["Open" lsp-workspace-folders-open]) - ("Toggle features" - ["Lenses" lsp-lens-mode] - ["Headerline breadcrumb" lsp-headerline-breadcrumb-mode] - ["Modeline code actions" lsp-modeline-code-actions-mode] - ["Modeline diagnostics" lsp-modeline-diagnostics-mode]) - "---" - ("Debug" - :active (bound-and-true-p dap-ui-mode) - :filter ,(lambda (_) - (and (boundp 'dap-ui-menu-items) - (nthcdr 3 dap-ui-menu-items)))))) - "Menu for lsp-mode.") - -(defalias 'make-lsp-client 'make-lsp--client) - -(cl-defstruct lsp--registered-capability - (id "") - (method " ") - (options nil)) - -;; A ‘lsp--workspace’ object represents exactly one language server process. -(cl-defstruct lsp--workspace - ;; the `ewoc' object for displaying I/O to and from the server - (ewoc nil) - - ;; ‘server-capabilities’ is a hash table of the language server capabilities. - ;; It is the hash table representation of a LSP ServerCapabilities structure; - ;; cf. https://microsoft.github.io/language-server-protocol/specification#initialize. - (server-capabilities nil) - - ;; ‘registered-server-capabilities’ is a list of hash tables that represent - ;; dynamically-registered Registration objects. See - ;; https://microsoft.github.io/language-server-protocol/specification#client_registerCapability. - (registered-server-capabilities nil) - - ;; ‘root’ is a directory name or a directory file name for the workspace - ;; root. ‘lsp-mode’ passes this directory to the ‘initialize’ method of the - ;; language server; see - ;; https://microsoft.github.io/language-server-protocol/specification#initialize. - (root nil) - - ;; ‘client’ is the ‘lsp--client’ object associated with this workspace. - (client nil) - - ;; ‘host-root’ contains the host root info as derived from `file-remote-p'. It - ;; used to derive the file path in `lsp--uri-to-path' when using tramp - ;; connection. - (host-root nil) - - ;; ‘proc’ is a process object; it may represent a regular process, a pipe, or - ;; a network connection. ‘lsp-mode’ communicates with ‘proc’ using the - ;; language server protocol. ‘proc’ corresponds to the COMMUNICATION-PROCESS - ;; element of the return value of the client’s ‘get-root’ field, which see. - (proc nil) - - ;; ‘proc’ is a process object; it must represent a regular process, not a - ;; pipe or network process. It represents the actual server process that - ;; corresponds to this workspace. ‘cmd-proc’ corresponds to the - ;; COMMAND-PROCESS element of the return value of the client’s ‘get-root’ - ;; field, which see. - (cmd-proc nil) - - ;; ‘buffers’ is a list of buffers associated with this workspace. - (buffers nil) - - ;; if semantic tokens is enabled, `semantic-tokens-faces' contains - ;; one face (or nil) for each token type supported by the language server. - (semantic-tokens-faces nil) - - ;; If semantic highlighting is enabled, `semantic-tokens-modifier-faces' - ;; contains one face (or nil) for each modifier type supported by the language - ;; server - (semantic-tokens-modifier-faces nil) - - ;; Extra client capabilities provided by third-party packages using - ;; `lsp-register-client-capabilities'. It's value is an alist of (PACKAGE-NAME - ;; . CAPS), where PACKAGE-NAME is a symbol of the third-party package name, - ;; and CAPS is either a plist of the client capabilities, or a function that - ;; takes no argument and returns a plist of the client capabilities or nil. - (extra-client-capabilities nil) - - ;; Workspace status - (status nil) - - ;; ‘metadata’ is a generic storage for workspace specific data. It is - ;; accessed via `lsp-workspace-set-metadata' and `lsp-workspace-set-metadata' - (metadata (make-hash-table :test 'equal)) - - ;; contains all the file notification watches that have been created for the - ;; current workspace in format filePath->file notification handle. - (watches (make-hash-table :test 'equal)) - - ;; list of workspace folders - (workspace-folders nil) - - ;; ‘last-id’ the last request id for the current workspace. - (last-id 0) - - ;; ‘status-string’ allows extensions to specify custom status string based on - ;; the Language Server specific messages. - (status-string nil) - - ;; ‘shutdown-action’ flag used to mark that workspace should not be restarted (e.g. it - ;; was stopped). - shutdown-action - - ;; ‘diagnostics’ a hashmap with workspace diagnostics. - (diagnostics (make-hash-table :test 'equal)) - - ;; contains all the workDone progress tokens that have been created - ;; for the current workspace. - (work-done-tokens (make-hash-table :test 'equal))) - - -(cl-defstruct lsp-session - ;; contains the folders that are part of the current session - folders - ;; contains the folders that must not be imported in the current workspace. - folders-blocklist - ;; contains the list of folders that must be imported in a project in case of - ;; multi root LSP server. - (server-id->folders (make-hash-table :test 'equal)) - ;; folder to list of the servers that are associated with the folder. - (folder->servers (make-hash-table :test 'equal)) - ;; ‘metadata’ is a generic storage for workspace specific data. It is - ;; accessed via `lsp-workspace-set-metadata' and `lsp-workspace-set-metadata' - (metadata (make-hash-table :test 'equal))) - -(defun lsp-workspace-status (status-string &optional workspace) - "Set current workspace status to STATUS-STRING. -If WORKSPACE is not specified defaults to lsp--cur-workspace." - (let ((status-string (when status-string (replace-regexp-in-string "%" "%%" status-string)))) - (setf (lsp--workspace-status-string (or workspace lsp--cur-workspace)) status-string))) - -(defun lsp-session-set-metadata (key value &optional _workspace) - "Associate KEY with VALUE in the WORKSPACE metadata. -If WORKSPACE is not provided current workspace will be used." - (puthash key value (lsp-session-metadata (lsp-session)))) - -(defalias 'lsp-workspace-set-metadata 'lsp-session-set-metadata) - -(defun lsp-session-get-metadata (key &optional _workspace) - "Lookup KEY in WORKSPACE metadata. -If WORKSPACE is not provided current workspace will be used." - (gethash key (lsp-session-metadata (lsp-session)))) - -(defalias 'lsp-workspace-get-metadata 'lsp-session-get-metadata) - -(defun lsp-workspace-set-work-done-token (token value workspace) - "Associate TOKEN with VALUE in the WORKSPACE work-done-tokens." - (puthash token value (lsp--workspace-work-done-tokens workspace))) - -(defun lsp-workspace-get-work-done-token (token workspace) - "Lookup TOKEN in the WORKSPACE work-done-tokens." - (gethash token (lsp--workspace-work-done-tokens workspace))) - -(defun lsp-workspace-rem-work-done-token (token workspace) - "Remove TOKEN from the WORKSPACE work-done-tokens." - (remhash token (lsp--workspace-work-done-tokens workspace))) - - -(defun lsp--make-notification (method &optional params) - "Create notification body for method METHOD and parameters PARAMS." - (list :jsonrpc "2.0" :method method :params params)) - -(defalias 'lsp--make-request 'lsp--make-notification) -(defalias 'lsp-make-request 'lsp--make-notification) - -(defun lsp--make-response (id result) - "Create response for REQUEST with RESULT." - `(:jsonrpc "2.0" :id ,id :result ,result)) - -(defun lsp-make-notification (method &optional params) - "Create notification body for method METHOD and parameters PARAMS." - (lsp--make-notification method params)) - -(defmacro lsp--json-serialize (params) - (if (progn - (require 'json) - (fboundp 'json-serialize)) - `(json-serialize ,params - :null-object nil - :false-object :json-false) - `(let ((json-false :json-false)) - (json-encode ,params)))) - -(defun lsp--make-message (params) - "Create a LSP message from PARAMS, after encoding it to a JSON string." - (let ((body (lsp--json-serialize params))) - (concat "Content-Length: " - (number-to-string (1+ (string-bytes body))) - "\r\n\r\n" - body - "\n"))) - -(cl-defstruct lsp--log-entry timestamp process-time type method id body) - -(defun lsp--make-log-entry (method id body type &optional process-time) - "Create an outgoing log object from BODY with method METHOD and id ID. -If ID is non-nil, then the body is assumed to be a notification. -TYPE can either be `incoming' or `outgoing'" - (cl-assert (memq type '(incoming-req outgoing-req incoming-notif - outgoing-notif incoming-resp - outgoing-resp))) - (make-lsp--log-entry - :timestamp (format-time-string "%I:%M:%S %p") - :process-time process-time - :method method - :id id - :type type - :body body)) - -(defun lsp--log-font-lock-json (body) - "Font lock JSON BODY." - (with-temp-buffer - (insert body) - ;; We set the temp buffer file-name extension to .json and call `set-auto-mode' - ;; so the users configured json mode is used which could be - ;; `json-mode', `json-ts-mode', `jsonian-mode', etc. - (let ((buffer-file-name "lsp-log.json")) - (delay-mode-hooks - (set-auto-mode) - (if (fboundp 'font-lock-ensure) - (font-lock-ensure) - (with-no-warnings - (font-lock-fontify-buffer))))) - (buffer-string))) - -(defun lsp--log-entry-pp (entry) - (cl-assert (lsp--log-entry-p entry)) - (pcase-let (((cl-struct lsp--log-entry timestamp method id type process-time - body) - entry) - (json-false :json-false) - (json-encoding-pretty-print t) - (str nil)) - (setq str - (concat (format "[Trace - %s] " timestamp) - (pcase type - ('incoming-req (format "Received request '%s - (%s)." method id)) - ('outgoing-req (format "Sending request '%s - (%s)'." method id)) - - ('incoming-notif (format "Received notification '%s'." method)) - ('outgoing-notif (format "Sending notification '%s'." method)) - - ('incoming-resp (format "Received response '%s - (%s)' in %dms." - method id process-time)) - ('outgoing-resp - (format - "Sending response '%s - (%s)'. Processing request took %dms" - method id process-time))) - "\n" - (if (memq type '(incoming-resp ougoing-resp)) - "Result: " - "Params: ") - (lsp--log-font-lock-json (json-encode body)) - "\n\n\n")) - (setq str (propertize str 'mouse-face 'highlight 'read-only t)) - (insert str))) - -(defvar-local lsp--log-io-ewoc nil) - -(defun lsp--get-create-io-ewoc (workspace) - (if (and (lsp--workspace-ewoc workspace) - (buffer-live-p (ewoc-buffer (lsp--workspace-ewoc workspace)))) - (lsp--workspace-ewoc workspace) - (with-current-buffer (lsp--get-log-buffer-create workspace) - (unless (eq 'lsp-log-io-mode major-mode) (lsp-log-io-mode)) - (setq-local window-point-insertion-type t) - (setq lsp--log-io-ewoc (ewoc-create #'lsp--log-entry-pp nil nil t)) - (setf (lsp--workspace-ewoc workspace) lsp--log-io-ewoc)) - (lsp--workspace-ewoc workspace))) - -(defun lsp--ewoc-count (ewoc) - (let* ((count 0) - (count-fn (lambda (_) (setq count (1+ count))))) - (ewoc-map count-fn ewoc) - count)) - -(defun lsp--log-entry-new (entry workspace) - (let* ((ewoc (lsp--get-create-io-ewoc workspace)) - (count (and (not (eq lsp-io-messages-max t)) (lsp--ewoc-count ewoc))) - (node (if (or (eq lsp-io-messages-max t) - (>= lsp-io-messages-max count)) - nil - (ewoc-nth ewoc (1- lsp-io-messages-max)))) - (prev nil) - (inhibit-read-only t)) - (while node - (setq prev (ewoc-prev ewoc node)) - (ewoc-delete ewoc node) - (setq node prev)) - (ewoc-enter-last ewoc entry))) - -(defun lsp--send-notification (body) - "Send BODY as a notification to the language server." - (lsp-foreach-workspace - (when (lsp--log-io-p (plist-get body :method)) - (lsp--log-entry-new (lsp--make-log-entry - (plist-get body :method) - nil (plist-get body :params) 'outgoing-notif) - lsp--cur-workspace)) - (lsp--send-no-wait body - (lsp--workspace-proc lsp--cur-workspace)))) - -(defalias 'lsp-send-notification 'lsp--send-notification) - -(defun lsp-notify (method params) - "Send notification METHOD with PARAMS." - (lsp--send-notification (lsp--make-notification method params))) - -(defun lsp--cur-workspace-check () - "Check whether buffer lsp workspace(s) are set." - (cl-assert (lsp-workspaces) nil - "No language server(s) is associated with this buffer.")) - -(defun lsp--send-request (body &optional no-wait no-merge) - "Send BODY as a request to the language server, get the response. -If NO-WAIT is non-nil, don't synchronously wait for a response. -If NO-MERGE is non-nil, don't merge the results but return an -alist mapping workspace->result." - (lsp-request (plist-get body :method) - (plist-get body :params) - :no-wait no-wait - :no-merge no-merge)) - -(defalias 'lsp-send-request 'lsp--send-request - "Send BODY as a request to the language server and return the response -synchronously. -\n(fn BODY)") - -(cl-defun lsp-request (method params &key no-wait no-merge) - "Send request METHOD with PARAMS. -If NO-MERGE is non-nil, don't merge the results but return alist -workspace->result. -If NO-WAIT is non-nil send the request as notification." - (if no-wait - (lsp-notify method params) - (let* ((send-time (float-time)) - ;; max time by which we must get a response - (expected-time - (and - lsp-response-timeout - (+ send-time lsp-response-timeout))) - resp-result resp-error done?) - (unwind-protect - (progn - (lsp-request-async method params - (lambda (res) (setf resp-result (or res :finished)) (throw 'lsp-done '_)) - :error-handler (lambda (err) (setf resp-error err) (throw 'lsp-done '_)) - :no-merge no-merge - :mode 'detached - :cancel-token :sync-request) - (while (not (or resp-error resp-result)) - (if (functionp 'json-rpc-connection) - (catch 'lsp-done (sit-for 0.01)) - (catch 'lsp-done - (accept-process-output - nil - (if expected-time (- expected-time send-time) 1)))) - (setq send-time (float-time)) - (when (and expected-time (< expected-time send-time)) - (error "Timeout while waiting for response. Method: %s" method))) - (setq done? t) - (cond - ((eq resp-result :finished) nil) - (resp-result resp-result) - ((lsp-json-error? resp-error) (error (lsp:json-error-message resp-error))) - ((lsp-json-error? (cl-first resp-error)) - (error (lsp:json-error-message (cl-first resp-error)))))) - (unless done? - (lsp-cancel-request-by-token :sync-request)))))) - -(cl-defun lsp-request-while-no-input (method params) - "Send request METHOD with PARAMS and waits until there is no input. -Return same value as `lsp--while-no-input' and respecting `non-essential'." - (if (or non-essential (not lsp-request-while-no-input-may-block)) - (let* ((send-time (float-time)) - ;; max time by which we must get a response - (expected-time - (and - lsp-response-timeout - (+ send-time lsp-response-timeout))) - resp-result resp-error done?) - (unwind-protect - (progn - (lsp-request-async method params - (lambda (res) (setf resp-result (or res :finished)) (throw 'lsp-done '_)) - :error-handler (lambda (err) (setf resp-error err) (throw 'lsp-done '_)) - :mode 'detached - :cancel-token :sync-request) - (while (not (or resp-error resp-result (input-pending-p))) - (catch 'lsp-done - (sit-for - (if expected-time (- expected-time send-time) 1))) - (setq send-time (float-time)) - (when (and expected-time (< expected-time send-time)) - (error "Timeout while waiting for response. Method: %s" method))) - (setq done? (or resp-error resp-result)) - (cond - ((eq resp-result :finished) nil) - (resp-result resp-result) - ((lsp-json-error? resp-error) (error (lsp:json-error-message resp-error))) - ((lsp-json-error? (cl-first resp-error)) - (error (lsp:json-error-message (cl-first resp-error)))))) - (unless done? - (lsp-cancel-request-by-token :sync-request)) - (when (and (input-pending-p) lsp--throw-on-input) - (throw 'input :interrupted)))) - (lsp-request method params))) - -(defvar lsp--cancelable-requests (ht)) - -(cl-defun lsp-request-async (method params callback - &key mode error-handler cancel-handler no-merge cancel-token) - "Send METHOD with PARAMS as a request to the language server. -Call CALLBACK with the response received from the server -asynchronously. -MODE determines when the callback will be called depending on the -condition of the original buffer. It could be: -- `detached' which means that the callback will be executed no -matter what has happened to the buffer. -- `alive' - the callback will be executed only if the buffer from -which the call was executed is still alive. -- `current' the callback will be executed only if the original buffer -is still selected. -- `tick' - the callback will be executed only if the buffer was not modified. -- `unchanged' - the callback will be executed only if the buffer hasn't -changed and if the buffer is not modified. - -ERROR-HANDLER will be called in case the request has failed. -CANCEL-HANDLER will be called in case the request is being canceled. -If NO-MERGE is non-nil, don't merge the results but return alist -workspace->result. -CANCEL-TOKEN is the token that can be used to cancel request." - (lsp--send-request-async `(:jsonrpc "2.0" :method ,method :params ,params) - callback mode error-handler cancel-handler no-merge cancel-token)) - -(defun lsp--create-request-cancel (id workspaces hook buf method cancel-callback) - (lambda (&rest _) - (unless (and (equal 'post-command-hook hook) - (equal (current-buffer) buf)) - (lsp--request-cleanup-hooks id) - (with-lsp-workspaces workspaces - (lsp--cancel-request id) - (when cancel-callback (funcall cancel-callback))) - (lsp-log "Cancelling %s(%s) in hook %s" method id hook)))) - -(defun lsp--create-async-callback - (callback method no-merge workspaces) - "Create async handler expecting COUNT results, merge them and call CALLBACK. -MODE determines when the callback will be called depending on the -condition of the original buffer. METHOD is the invoked method. -If NO-MERGE is non-nil, don't merge the results but return alist -workspace->result. ID is the request id." - (let (results errors) - (lambda (result) - (push (cons lsp--cur-workspace result) - (if (eq result :error) errors results)) - (when (and (not (eq (length errors) (length workspaces))) - (eq (+ (length errors) (length results)) (length workspaces))) - (funcall callback - (if no-merge - results - (lsp--merge-results (-map #'cl-rest results) method))))))) - -(defcustom lsp-default-create-error-handler-fn nil - "Default error handler customization. -Handler should give METHOD as argument and return function of one argument -ERROR." - :type 'function - :group 'lsp-mode - :package-version '(lsp-mode . "9.0.0")) - -(defun lsp--create-default-error-handler (method) - "Default error handler. -METHOD is the executed method." - (if lsp-default-create-error-handler-fn - (funcall lsp-default-create-error-handler-fn method) - (lambda (error) - (lsp--warn "%s" (or (lsp--error-string error) - (format "%s Request has failed" method)))))) - -(defvar lsp--request-cleanup-hooks (ht)) - -(defun lsp--request-cleanup-hooks (request-id) - (when-let ((cleanup-function (gethash request-id lsp--request-cleanup-hooks))) - (funcall cleanup-function) - (remhash request-id lsp--request-cleanup-hooks))) - -(defun lsp-cancel-request-by-token (cancel-token) - "Cancel request using CANCEL-TOKEN." - (-when-let ((request-id . workspaces) (gethash cancel-token lsp--cancelable-requests)) - (with-lsp-workspaces workspaces - (lsp--cancel-request request-id)) - (remhash cancel-token lsp--cancelable-requests) - (lsp--request-cleanup-hooks request-id))) - -(defun lsp--send-request-async (body callback - &optional mode error-callback cancel-callback - no-merge cancel-token) - "Send BODY as a request to the language server. -Call CALLBACK with the response received from the server -asynchronously. -MODE determines when the callback will be called depending on the -condition of the original buffer. It could be: -- `detached' which means that the callback will be executed no -matter what has happened to the buffer. -- `alive' - the callback will be executed only if the buffer from -which the call was executed is still alive. -- `current' the callback will be executed only if the original buffer -is still selected. -- `tick' - the callback will be executed only if the buffer was not modified. -- `unchanged' - the callback will be executed only if the buffer hasn't -changed and if the buffer is not modified. - -ERROR-CALLBACK will be called in case the request has failed. -CANCEL-CALLBACK will be called in case the request is being canceled. -If NO-MERGE is non-nil, don't merge the results but return alist -workspace->result. -CANCEL-TOKEN is the token that can be used to cancel request." - (when cancel-token - (lsp-cancel-request-by-token cancel-token)) - - (if-let ((target-workspaces (lsp--find-workspaces-for body))) - (let* ((start-time (current-time)) - (method (plist-get body :method)) - (id (cl-incf lsp-last-id)) - (buf (current-buffer)) - (cancel-callback (when cancel-callback - (pcase mode - ((or 'alive 'tick 'unchanged) - (lambda () - (with-current-buffer buf - (funcall cancel-callback)))) - (_ cancel-callback)))) - ;; calculate what are the (hook . local) pairs which will cancel - ;; the request - (hooks (pcase mode - ('alive '((kill-buffer-hook . t))) - ('tick '((kill-buffer-hook . t) (after-change-functions . t))) - ('unchanged '((after-change-functions . t) (post-command-hook . nil))) - ('current '((post-command-hook . nil))))) - ;; note: lambdas in emacs can be compared but we should make sure - ;; that all of the captured arguments are the same - in our case - ;; `lsp--create-request-cancel' will return the same lambda when - ;; called with the same params. - (cleanup-hooks - (lambda () (mapc - (-lambda ((hook . local)) - (if local - (when (buffer-live-p buf) - (with-current-buffer buf - (remove-hook hook - (lsp--create-request-cancel - id target-workspaces hook buf method cancel-callback) - t))) - (remove-hook hook (lsp--create-request-cancel - id target-workspaces hook buf method cancel-callback)))) - hooks) - (remhash cancel-token lsp--cancelable-requests))) - (callback (pcase mode - ((or 'alive 'tick 'unchanged) (lambda (&rest args) - (with-current-buffer buf - (apply callback args)))) - (_ callback))) - (callback (lsp--create-async-callback callback - method - no-merge - target-workspaces)) - (callback (lambda (result) - (lsp--request-cleanup-hooks id) - (funcall callback result))) - (error-callback (lsp--create-async-callback - (or error-callback - (lsp--create-default-error-handler method)) - method - nil - target-workspaces)) - (error-callback (lambda (error) - (funcall callback :error) - (lsp--request-cleanup-hooks id) - (funcall error-callback error))) - (body (plist-put body :id id))) - - ;; cancel request in any of the hooks - (mapc (-lambda ((hook . local)) - (add-hook hook - (lsp--create-request-cancel - id target-workspaces hook buf method cancel-callback) - nil local)) - hooks) - (puthash id cleanup-hooks lsp--request-cleanup-hooks) - - (setq lsp--last-active-workspaces target-workspaces) - - (when cancel-token - (puthash cancel-token (cons id target-workspaces) lsp--cancelable-requests)) - - (seq-doseq (workspace target-workspaces) - (when (lsp--log-io-p method) - (lsp--log-entry-new (lsp--make-log-entry method id - (plist-get body :params) - 'outgoing-req) - workspace)) - (puthash id - (list callback error-callback method start-time (current-time)) - (-> workspace - (lsp--workspace-client) - (lsp--client-response-handlers))) - (lsp--send-no-wait body (lsp--workspace-proc workspace))) - body) - (error "The connected server(s) does not support method %s. -To find out what capabilities support your server use `M-x lsp-describe-session' -and expand the capabilities section" - (plist-get body :method)))) - -;; deprecated, use lsp-request-async. -(defalias 'lsp-send-request-async 'lsp--send-request-async) -(make-obsolete 'lsp-send-request-async 'lsp-request-async "lsp-mode 7.0.1") - -;; Clean up the entire state of lsp mode when Emacs is killed, to get rid of any -;; pending language servers. -(add-hook 'kill-emacs-hook #'lsp--global-teardown) - -(defun lsp--global-teardown () - "Unload working workspaces." - (lsp-foreach-workspace (lsp--shutdown-workspace))) - -(defun lsp--shutdown-workspace (&optional restart) - "Shut down the language server process for ‘lsp--cur-workspace’." - (with-demoted-errors "LSP error: %S" - (let ((lsp-response-timeout 0.5)) - (condition-case err - (lsp-request "shutdown" nil) - (error (lsp--error "%s" err)))) - (lsp-notify "exit" nil)) - (setf (lsp--workspace-shutdown-action lsp--cur-workspace) (or (and restart 'restart) 'shutdown)) - (lsp--uninitialize-workspace)) - -(defcustom lsp-inlay-hint-enable nil - "If non-nil it will enable inlay hints." - :type 'boolean - :group 'lsp-mode - :package-version '(lsp-mode . "9.0.0")) - -(defun lsp--uninitialize-workspace () - "Cleanup buffer state. -When a workspace is shut down, by request or from just -disappearing, unset all the variables related to it." - (-let [(&lsp-wks 'cmd-proc 'buffers) lsp--cur-workspace] - (lsp-process-kill cmd-proc) - (mapc (lambda (buf) - (when (lsp-buffer-live-p buf) - (lsp-with-current-buffer buf - (lsp-managed-mode -1)))) - buffers) - (lsp-diagnostics--workspace-cleanup lsp--cur-workspace))) - -(defun lsp--client-capabilities (&optional custom-capabilities) - "Return the client capabilities appending CUSTOM-CAPABILITIES." - (append - `((general . ((positionEncodings . ["utf-32", "utf-16"]))) - (workspace . ((workspaceEdit . ((documentChanges . t) - (resourceOperations . ["create" "rename" "delete"]))) - (applyEdit . t) - (symbol . ((symbolKind . ((valueSet . ,(apply 'vector (number-sequence 1 26))))))) - (executeCommand . ((dynamicRegistration . :json-false))) - ,@(when lsp-enable-file-watchers '((didChangeWatchedFiles . ((dynamicRegistration . t))))) - (workspaceFolders . t) - (configuration . t) - ,@(when lsp-semantic-tokens-enable - `((semanticTokens . ((refreshSupport . ,(or (and (boundp 'lsp-semantic-tokens-honor-refresh-requests) - lsp-semantic-tokens-honor-refresh-requests) - :json-false)))))) - ,@(when lsp-lens-enable '((codeLens . ((refreshSupport . t))))) - ,@(when lsp-inlay-hint-enable '((inlayHint . ((refreshSupport . :json-false))))) - (fileOperations . ((didCreate . :json-false) - (willCreate . :json-false) - (didRename . t) - (willRename . t) - (didDelete . :json-false) - (willDelete . :json-false))))) - (textDocument . ((declaration . ((dynamicRegistration . t) - (linkSupport . t))) - (definition . ((dynamicRegistration . t) - (linkSupport . t))) - (references . ((dynamicRegistration . t))) - (implementation . ((dynamicRegistration . t) - (linkSupport . t))) - (typeDefinition . ((dynamicRegistration . t) - (linkSupport . t))) - (synchronization . ((willSave . t) (didSave . t) (willSaveWaitUntil . t))) - (documentSymbol . ((symbolKind . ((valueSet . ,(apply 'vector (number-sequence 1 26))))) - (hierarchicalDocumentSymbolSupport . t))) - (formatting . ((dynamicRegistration . t))) - (rangeFormatting . ((dynamicRegistration . t))) - (onTypeFormatting . ((dynamicRegistration . t))) - ,@(when (and lsp-semantic-tokens-enable - (functionp 'lsp--semantic-tokens-capabilities)) - (lsp--semantic-tokens-capabilities)) - (rename . ((dynamicRegistration . t) (prepareSupport . t))) - (codeAction . ((dynamicRegistration . t) - (isPreferredSupport . t) - (codeActionLiteralSupport . ((codeActionKind . ((valueSet . ["" - "quickfix" - "refactor" - "refactor.extract" - "refactor.inline" - "refactor.rewrite" - "source" - "source.organizeImports"]))))) - (resolveSupport . ((properties . ["edit" "command"]))) - (dataSupport . t))) - (completion . ((completionItem . ((snippetSupport . ,(cond - ((and lsp-enable-snippet (not (fboundp 'yas-minor-mode))) - (lsp--warn (concat - "Yasnippet is not installed, but `lsp-enable-snippet' is set to `t'. " - "You must either install yasnippet, or disable snippet support.")) - :json-false) - (lsp-enable-snippet t) - (t :json-false))) - (documentationFormat . ["markdown" "plaintext"]) - ;; Remove this after jdtls support resolveSupport - (resolveAdditionalTextEditsSupport . t) - (insertReplaceSupport . t) - (deprecatedSupport . t) - (resolveSupport - . ((properties . ["documentation" - "detail" - "additionalTextEdits" - "command"]))) - (insertTextModeSupport . ((valueSet . [1 2]))))) - (contextSupport . t) - (dynamicRegistration . t))) - (signatureHelp . ((signatureInformation . ((parameterInformation . ((labelOffsetSupport . t))))) - (dynamicRegistration . t))) - (documentLink . ((dynamicRegistration . t) - (tooltipSupport . t))) - (hover . ((contentFormat . ["markdown" "plaintext"]) - (dynamicRegistration . t))) - ,@(when lsp-enable-folding - `((foldingRange . ((dynamicRegistration . t) - ,@(when lsp-folding-range-limit - `((rangeLimit . ,lsp-folding-range-limit))) - ,@(when lsp-folding-line-folding-only - `((lineFoldingOnly . t))))))) - (selectionRange . ((dynamicRegistration . t))) - (callHierarchy . ((dynamicRegistration . :json-false))) - (typeHierarchy . ((dynamicRegistration . t))) - (publishDiagnostics . ((relatedInformation . t) - (tagSupport . ((valueSet . [1 2]))) - (versionSupport . t))) - (linkedEditingRange . ((dynamicRegistration . t))))) - (window . ((workDoneProgress . t) - (showDocument . ((support . t)))))) - custom-capabilities)) - -(defun lsp-find-roots-for-workspace (workspace session) - "Get all roots for the WORKSPACE." - (-filter #'identity (ht-map (lambda (folder workspaces) - (when (-contains? workspaces workspace) - folder)) - (lsp-session-folder->servers session)))) - -(defun lsp-session-watches (&optional session) - "Get watches created for SESSION." - (or (gethash "__watches" (lsp-session-metadata (or session (lsp-session)))) - (-let [res (make-hash-table :test 'equal)] - (puthash "__watches" res (lsp-session-metadata (or session (lsp-session)))) - res))) - -(defun lsp--file-process-event (session root-folder event) - "Process file event." - (let* ((changed-file (cl-third event)) - (rel-changed-file (f-relative changed-file root-folder)) - (event-numeric-kind (alist-get (cl-second event) lsp--file-change-type)) - (bit-position (1- event-numeric-kind)) - (watch-bit (ash 1 bit-position))) - (->> - session - lsp-session-folder->servers - (gethash root-folder) - (seq-do (lambda (workspace) - (when (->> - workspace - lsp--workspace-registered-server-capabilities - (-any? - (lambda (capability) - (and - (equal (lsp--registered-capability-method capability) - "workspace/didChangeWatchedFiles") - (->> - capability - lsp--registered-capability-options - (lsp:did-change-watched-files-registration-options-watchers) - (seq-find - (-lambda ((fs-watcher &as &FileSystemWatcher :glob-pattern :kind? :_cachedRegexp cached-regexp)) - (when (or (null kind?) - (> (logand kind? watch-bit) 0)) - (-let [regexes (or cached-regexp - (let ((regexp (lsp-glob-to-regexps glob-pattern))) - (lsp-put fs-watcher :_cachedRegexp regexp) - regexp))] - (-any? (lambda (re) - (or (string-match re changed-file) - (string-match re rel-changed-file))) - regexes)))))))))) - (with-lsp-workspace workspace - (lsp-notify - "workspace/didChangeWatchedFiles" - `((changes . [((type . ,event-numeric-kind) - (uri . ,(lsp--path-to-uri changed-file)))])))))))))) - -(lsp-defun lsp--server-register-capability ((&Registration :method :id :register-options?)) - "Register capability REG." - (when (and lsp-enable-file-watchers - (equal method "workspace/didChangeWatchedFiles")) - (-let* ((created-watches (lsp-session-watches (lsp-session))) - (root-folders (cl-set-difference - (lsp-find-roots-for-workspace lsp--cur-workspace (lsp-session)) - (ht-keys created-watches)))) - ;; create watch for each root folder without such - (dolist (folder root-folders) - (let* ((watch (make-lsp-watch :root-directory folder)) - (ignored-things (lsp--get-ignored-regexes-for-workspace-root folder)) - (ignored-files-regex-list (car ignored-things)) - (ignored-directories-regex-list (cadr ignored-things))) - (puthash folder watch created-watches) - (lsp-watch-root-folder (file-truename folder) - (-partial #'lsp--file-process-event (lsp-session) folder) - ignored-files-regex-list - ignored-directories-regex-list - watch - t))))) - - (push - (make-lsp--registered-capability :id id :method method :options register-options?) - (lsp--workspace-registered-server-capabilities lsp--cur-workspace))) - -(defmacro lsp--with-workspace-temp-buffer (workspace-root &rest body) - "With a temp-buffer under `WORKSPACE-ROOT' and evaluate `BODY', useful to -access dir-local variables." - (declare (indent 1) (debug t)) - `(with-temp-buffer - ;; Set the buffer's name to something under the root so that we can hack the local variables - ;; This file doesn't need to exist and will not be created due to this. - (setq-local buffer-file-name (expand-file-name "lsp-mode-temp" (expand-file-name ,workspace-root))) - (hack-local-variables) - (prog1 ,@body - (setq-local buffer-file-name nil)))) - -(defun lsp--get-ignored-regexes-for-workspace-root (workspace-root) - "Return a list of the form -(lsp-file-watch-ignored-files lsp-file-watch-ignored-directories) for the given -WORKSPACE-ROOT." - ;; The intent of this function is to provide per-root workspace-level customization of the - ;; lsp-file-watch-ignored-directories and lsp-file-watch-ignored-files variables. - (lsp--with-workspace-temp-buffer workspace-root - (list lsp-file-watch-ignored-files (lsp-file-watch-ignored-directories)))) - - -(defun lsp--cleanup-hanging-watches () - "Cleanup watches in case there are no more workspaces that are interested -in that particular folder." - (let* ((session (lsp-session)) - (watches (lsp-session-watches session))) - (dolist (watched-folder (ht-keys watches)) - (when (-none? (lambda (workspace) - (with-lsp-workspace workspace - (lsp--registered-capability "workspace/didChangeWatchedFiles"))) - (gethash watched-folder (lsp-session-folder->servers (lsp-session)))) - (lsp-log "Cleaning up watches for folder %s. There is no workspace watching this folder..." watched-folder) - (lsp-kill-watch (gethash watched-folder watches)) - (remhash watched-folder watches))))) - -(lsp-defun lsp--server-unregister-capability ((&Unregistration :id :method)) - "Unregister capability UNREG." - (setf (lsp--workspace-registered-server-capabilities lsp--cur-workspace) - (seq-remove (lambda (e) (equal (lsp--registered-capability-id e) id)) - (lsp--workspace-registered-server-capabilities lsp--cur-workspace))) - (when (equal method "workspace/didChangeWatchedFiles") - (lsp--cleanup-hanging-watches))) - -(defun lsp--server-capabilities () - "Return the capabilities of the language server associated with the buffer." - (->> (lsp-workspaces) - (-keep #'lsp--workspace-server-capabilities) - (apply #'lsp-merge))) - -(defun lsp--send-open-close-p () - "Return whether open and close notifications should be sent to the server." - (let ((sync (lsp:server-capabilities-text-document-sync? (lsp--server-capabilities)))) - (or (memq sync '(1 2)) - (lsp:text-document-sync-options-open-close? sync)))) - -(defun lsp--send-will-save-p () - "Return whether willSave notifications should be sent to the server." - (-> (lsp--server-capabilities) - (lsp:server-capabilities-text-document-sync?) - (lsp:text-document-sync-options-will-save?))) - -(defun lsp--send-will-save-wait-until-p () - "Return whether willSaveWaitUntil notifications should be sent to the server." - (-> (lsp--server-capabilities) - (lsp:server-capabilities-text-document-sync?) - (lsp:text-document-sync-options-will-save-wait-until?))) - -(defun lsp--send-did-save-p () - "Return whether didSave notifications should be sent to the server." - (let ((sync (lsp:server-capabilities-text-document-sync? (lsp--server-capabilities)))) - (or (memq sync '(1 2)) - (lsp:text-document-sync-options-save? sync)))) - -(defun lsp--save-include-text-p () - "Return whether save notifications should include the text document's contents." - (->> (lsp--server-capabilities) - (lsp:server-capabilities-text-document-sync?) - (lsp:text-document-sync-options-save?) - (lsp:text-document-save-registration-options-include-text?))) - -(defun lsp--send-will-rename-files-p (path) - "Return whether willRenameFiles request should be sent to the server. -If any filters, checks if it applies for PATH." - (let* ((will-rename (-> (lsp--server-capabilities) - (lsp:server-capabilities-workspace?) - (lsp:workspace-server-capabilities-file-operations?) - (lsp:workspace-file-operations-will-rename?))) - (filters (seq-into (lsp:file-operation-registration-options-filters will-rename) 'list))) - (and will-rename - (or (seq-empty-p filters) - (-any? (-lambda ((&FileOperationFilter :scheme? :pattern (&FileOperationPattern :glob))) - (-let [regexes (lsp-glob-to-regexps glob)] - (and (or (not scheme?) - (string-prefix-p scheme? (lsp--path-to-uri path))) - (-any? (lambda (re) - (string-match re path)) - regexes)))) - filters))))) - -(defun lsp--send-did-rename-files-p () - "Return whether didRenameFiles notification should be sent to the server." - (-> (lsp--server-capabilities) - (lsp:server-capabilities-workspace?) - (lsp:workspace-server-capabilities-file-operations?) - (lsp:workspace-file-operations-did-rename?))) - -(declare-function project-roots "ext:project" (project) t) -(declare-function project-root "ext:project" (project) t) - -(defun lsp--suggest-project-root () - "Get project root." - (or - (when (fboundp 'projectile-project-root) - (condition-case nil - (projectile-project-root) - (error nil))) - (when (fboundp 'project-current) - (when-let ((project (project-current))) - (if (fboundp 'project-root) - (project-root project) - (car (with-no-warnings - (project-roots project)))))) - default-directory)) - -(defun lsp--read-from-file (file) - "Read FILE content." - (when (file-exists-p file) - (cl-first (read-from-string (f-read-text file 'utf-8))))) - -(defun lsp--persist (file-name to-persist) - "Persist TO-PERSIST in FILE-NAME. - -This function creates the parent directories if they don't exist -yet." - (let ((print-length nil) - (print-level nil)) - ;; Create all parent directories: - (make-directory (f-parent file-name) t) - (f-write-text (prin1-to-string to-persist) 'utf-8 file-name))) - -(defun lsp-workspace-folders-add (project-root) - "Add PROJECT-ROOT to the list of workspace folders." - (interactive - (list (read-directory-name "Select folder to add: " - (or (lsp--suggest-project-root) default-directory) nil t))) - (cl-pushnew (lsp-f-canonical project-root) - (lsp-session-folders (lsp-session)) :test 'equal) - (lsp--persist-session (lsp-session)) - - (run-hook-with-args 'lsp-workspace-folders-changed-functions (list project-root) nil)) - -(defun lsp-workspace-folders-remove (project-root) - "Remove PROJECT-ROOT from the list of workspace folders." - (interactive (list (completing-read "Select folder to remove: " - (lsp-session-folders (lsp-session)) - nil t nil nil - (lsp-find-session-folder (lsp-session) default-directory)))) - - (setq project-root (lsp-f-canonical project-root)) - - ;; send remove folder to each multiroot workspace associated with the folder - (dolist (wks (->> (lsp-session) - (lsp-session-folder->servers) - (gethash project-root) - (--filter (lsp--client-multi-root (lsp--workspace-client it))))) - (with-lsp-workspace wks - (lsp-notify "workspace/didChangeWorkspaceFolders" - (lsp-make-did-change-workspace-folders-params - :event (lsp-make-workspace-folders-change-event - :removed (vector (lsp-make-workspace-folder - :uri (lsp--path-to-uri project-root) - :name (f-filename project-root))) - :added []))))) - - ;; turn off servers in the removed directory - (let* ((session (lsp-session)) - (folder->servers (lsp-session-folder->servers session)) - (server-id->folders (lsp-session-server-id->folders session)) - (workspaces (gethash project-root folder->servers))) - - (remhash project-root folder->servers) - - ;; turn off the servers without root folders - (dolist (workspace workspaces) - (when (--none? (-contains? it workspace) (ht-values folder->servers)) - (lsp--info "Shutdown %s since folder %s is removed..." - (lsp--workspace-print workspace) project-root) - (with-lsp-workspace workspace (lsp--shutdown-workspace)))) - - (setf (lsp-session-folders session) - (-remove-item project-root (lsp-session-folders session))) - - (ht-aeach (puthash key - (-remove-item project-root value) - server-id->folders) - server-id->folders) - (lsp--persist-session (lsp-session))) - - (run-hook-with-args 'lsp-workspace-folders-changed-functions nil (list project-root))) - -(defun lsp-workspace-blocklist-remove (project-root) - "Remove PROJECT-ROOT from the workspace blocklist." - (interactive (list (completing-read "Select folder to remove:" - (lsp-session-folders-blocklist (lsp-session)) - nil t))) - (setf (lsp-session-folders-blocklist (lsp-session)) - (delete project-root - (lsp-session-folders-blocklist (lsp-session)))) - (lsp--persist-session (lsp-session))) - -(define-obsolete-function-alias 'lsp-workspace-folders-switch - 'lsp-workspace-folders-open "lsp-mode 6.1") - -(defun lsp-workspace-folders-open (project-root) - "Open the directory located at PROJECT-ROOT" - (interactive (list (completing-read "Open folder: " - (lsp-session-folders (lsp-session)) - nil t))) - (find-file project-root)) - -(defun lsp--maybe-enable-signature-help (trigger-characters) - (let ((ch last-command-event)) - (when (cl-find ch trigger-characters :key #'string-to-char) - (lsp-signature-activate)))) - -(defun lsp--on-type-formatting-handler-create () - (when-let ((provider (lsp--capability-for-method "textDocument/onTypeFormatting" ))) - (-let [(&DocumentOnTypeFormattingOptions :more-trigger-character? - :first-trigger-character) provider] - (lambda () - (lsp--on-type-formatting first-trigger-character - more-trigger-character?))))) - -(defun lsp--update-on-type-formatting-hook (&optional cleanup?) - (let ((on-type-formatting-handler (lsp--on-type-formatting-handler-create))) - (cond - ((and lsp-enable-on-type-formatting on-type-formatting-handler (not cleanup?)) - (add-hook 'post-self-insert-hook on-type-formatting-handler nil t)) - ((or cleanup? - (not lsp-enable-on-type-formatting)) - (remove-hook 'post-self-insert-hook on-type-formatting-handler t))))) - -(defun lsp--signature-help-handler-create () - (-when-let ((&SignatureHelpOptions? :trigger-characters?) - (lsp--capability-for-method "textDocument/signatureHelp")) - (lambda () - (lsp--maybe-enable-signature-help trigger-characters?)))) - -(defun lsp--update-signature-help-hook (&optional cleanup?) - (let ((signature-help-handler (lsp--signature-help-handler-create))) - (cond - ((and (or (equal lsp-signature-auto-activate t) - (memq :on-trigger-char lsp-signature-auto-activate)) - signature-help-handler) - (add-hook 'post-self-insert-hook signature-help-handler nil t)) - - ((or cleanup? - (not (or (equal lsp-signature-auto-activate t) - (memq :on-trigger-char lsp-signature-auto-activate)))) - (remove-hook 'post-self-insert-hook signature-help-handler t))))) - -(defun lsp--after-set-visited-file-name () - (lsp-disconnect) - (lsp)) - -;; TODO remove those eldoc workarounds when dropping support for Emacs 27 -;; https://github.com/emacs-lsp/lsp-mode/issues/3295#issuecomment-1308994099 -(defvar eldoc-documentation-default) ; CI -(when (< emacs-major-version 28) - (unless (boundp 'eldoc-documentation-functions) - (load "eldoc" nil 'nomessage)) - (when (memq (default-value 'eldoc-documentation-function) '(nil ignore)) - ;; actually `eldoc-documentation-strategy', but CI was failing - (setq-default eldoc-documentation-function 'eldoc-documentation-default))) - -(define-minor-mode lsp-managed-mode - "Mode for source buffers managed by lsp-mode." - :lighter nil - (cond - (lsp-managed-mode - (when (lsp-feature? "textDocument/hover") - (add-hook 'eldoc-documentation-functions #'lsp-eldoc-function nil t) - (eldoc-mode 1)) - - (add-hook 'after-change-functions #'lsp-on-change nil t) - (add-hook 'after-revert-hook #'lsp-on-revert nil t) - (add-hook 'after-save-hook #'lsp-on-save nil t) - (add-hook 'auto-save-hook #'lsp--on-auto-save nil t) - (add-hook 'before-change-functions #'lsp-before-change nil t) - (add-hook 'before-save-hook #'lsp--before-save nil t) - (add-hook 'kill-buffer-hook #'lsp--text-document-did-close nil t) - (add-hook 'post-command-hook #'lsp--post-command nil t) - - (lsp--update-on-type-formatting-hook) - (lsp--update-signature-help-hook) - - (when lsp-enable-xref - (add-hook 'xref-backend-functions #'lsp--xref-backend nil t)) - - (lsp-configure-buffer) - - ;; make sure we turn off lsp-mode in case major mode changes, because major - ;; mode change will wipe the buffer locals. - (add-hook 'change-major-mode-hook #'lsp-disconnect nil t) - (add-hook 'after-set-visited-file-name-hook #'lsp--after-set-visited-file-name nil t) - - (let ((buffer (lsp-current-buffer))) - (run-with-idle-timer - 0.0 nil - (lambda () - (when (lsp-buffer-live-p buffer) - (lsp-with-current-buffer buffer - (lsp--on-change-debounce buffer) - (lsp--on-idle buffer))))))) - (t - (lsp-unconfig-buffer) - - (remove-hook 'eldoc-documentation-functions #'lsp-eldoc-function t) - (remove-hook 'post-command-hook #'lsp--post-command t) - (remove-hook 'after-change-functions #'lsp-on-change t) - (remove-hook 'after-revert-hook #'lsp-on-revert t) - (remove-hook 'after-save-hook #'lsp-on-save t) - (remove-hook 'auto-save-hook #'lsp--on-auto-save t) - (remove-hook 'before-change-functions #'lsp-before-change t) - (remove-hook 'before-save-hook #'lsp--before-save t) - (remove-hook 'kill-buffer-hook #'lsp--text-document-did-close t) - - (lsp--update-on-type-formatting-hook :cleanup) - (lsp--update-signature-help-hook :cleanup) - - (when lsp--on-idle-timer - (cancel-timer lsp--on-idle-timer) - (setq lsp--on-idle-timer nil)) - - (remove-hook 'lsp-on-idle-hook #'lsp--document-links t) - (remove-hook 'lsp-on-idle-hook #'lsp--document-highlight t) - - (lsp--remove-overlays 'lsp-highlight) - (lsp--remove-overlays 'lsp-links) - - (remove-hook 'xref-backend-functions #'lsp--xref-backend t) - (remove-hook 'change-major-mode-hook #'lsp-disconnect t) - (remove-hook 'after-set-visited-file-name-hook #'lsp--after-set-visited-file-name t) - (setq-local lsp-buffer-uri nil)))) - -(defun lsp-configure-buffer () - "Configure LSP features for current buffer." - ;; make sure the core is running in the context of all available workspaces - ;; to avoid misconfiguration in case we are running in `with-lsp-workspace' context - (let ((lsp--buffer-workspaces (cond - (lsp--buffer-workspaces) - (lsp--cur-workspace (list lsp--cur-workspace)))) - lsp--cur-workspace) - (when lsp-auto-configure - (lsp--auto-configure) - - (when (and lsp-enable-text-document-color - (lsp-feature? "textDocument/documentColor")) - (add-hook 'lsp-on-change-hook #'lsp--document-color nil t)) - - (when (and lsp-enable-imenu - (lsp-feature? "textDocument/documentSymbol")) - (lsp-enable-imenu)) - - (when (and lsp-enable-indentation - (lsp-feature? "textDocument/rangeFormatting")) - (add-function :override (local 'indent-region-function) #'lsp-format-region)) - - (when (and lsp-enable-symbol-highlighting - (lsp-feature? "textDocument/documentHighlight")) - (add-hook 'lsp-on-idle-hook #'lsp--document-highlight nil t)) - - (when (and lsp-enable-links - (lsp-feature? "textDocument/documentLink")) - (add-hook 'lsp-on-idle-hook #'lsp--document-links nil t)) - - (when (and lsp-inlay-hint-enable - (lsp-feature? "textDocument/inlayHint")) - (lsp-inlay-hints-mode)) - - (when (and lsp-enable-dap-auto-configure - (functionp 'dap-mode)) - (dap-auto-configure-mode 1))) - (run-hooks 'lsp-configure-hook))) - -(defun lsp-unconfig-buffer () - "Unconfigure LSP features for buffer." - (lsp--remove-overlays 'lsp-color) - - (when (advice-function-member-p 'lsp--imenu-create-index imenu-create-index-function) - (remove-function (local 'imenu-create-index-function) #'lsp--imenu-create-index) - (setq-local imenu-menubar-modified-tick 0) - (setq-local imenu--index-alist nil) - (imenu--cleanup)) - - (remove-function (local 'indent-region-function) #'lsp-format-region) - - (remove-hook 'lsp-on-change-hook #'lsp--document-color t) - (remove-hook 'lsp-on-idle-hook #'lsp--document-highlight t) - (remove-hook 'lsp-on-idle-hook #'lsp--document-links t) - - (when (and lsp-enable-dap-auto-configure - (functionp 'dap-mode)) - (dap-auto-configure-mode -1)) - - (run-hooks 'lsp-unconfigure-hook)) - -(defun lsp--buffer-content () - (lsp-save-restriction-and-excursion - (or (lsp-virtual-buffer-call :buffer-string) - (buffer-substring-no-properties (point-min) - (point-max))))) - -(defun lsp--text-document-did-open () - "`document/didOpen' event." - (run-hooks 'lsp-before-open-hook) - (when (and lsp-auto-touch-files - (not (f-exists? (lsp--uri-to-path (lsp--buffer-uri))))) - (lsp--info "Saving file '%s' because it is not present on the disk." (lsp--buffer-uri)) - (save-buffer)) - - (setq lsp--cur-version (or lsp--cur-version 0)) - (cl-pushnew (lsp-current-buffer) (lsp--workspace-buffers lsp--cur-workspace)) - (lsp-notify - "textDocument/didOpen" - (list :textDocument - (list :uri (lsp--buffer-uri) - :languageId (lsp-buffer-language) - :version lsp--cur-version - :text (lsp--buffer-content)))) - - (lsp-managed-mode 1) - - (run-hooks 'lsp-after-open-hook) - (when-let ((client (-some-> lsp--cur-workspace (lsp--workspace-client)))) - (-some-> (lsp--client-after-open-fn client) - (funcall)) - (-some-> (format "lsp-%s-after-open-hook" (lsp--client-server-id client)) - (intern-soft) - (run-hooks)))) - -(defun lsp--text-document-identifier () - "Make TextDocumentIdentifier." - (list :uri (lsp--buffer-uri))) - -(defun lsp--versioned-text-document-identifier () - "Make VersionedTextDocumentIdentifier." - (plist-put (lsp--text-document-identifier) :version lsp--cur-version)) - -(defun lsp--cur-line (&optional point) - (1- (line-number-at-pos point))) - -(defun lsp--cur-position () - "Make a Position object for the current point." - (or (lsp-virtual-buffer-call :cur-position) - (lsp-save-restriction-and-excursion - (list :line (lsp--cur-line) - :character (- (point) (line-beginning-position)))))) - -(defun lsp--point-to-position (point) - "Convert POINT to Position." - (lsp-save-restriction-and-excursion - (goto-char point) - (lsp--cur-position))) - -(defun lsp--range (start end) - "Make Range body from START and END." - ;; make sure start and end are Position objects - (list :start start :end end)) - -(defun lsp--region-to-range (start end) - "Make Range object for the current region." - (lsp--range (lsp--point-to-position start) - (lsp--point-to-position end))) - -(defun lsp--region-or-line () - "The active region or the current line." - (if (use-region-p) - (lsp--region-to-range (region-beginning) (region-end)) - (lsp--region-to-range (line-beginning-position) (line-end-position)))) - -(defun lsp--check-document-changes-version (document-changes) - "Verify that DOCUMENT-CHANGES have the proper version." - (unless (seq-every-p - (-lambda ((&TextDocumentEdit :text-document)) - (or - (not text-document) - (let* ((filename (-> text-document - lsp:versioned-text-document-identifier-uri - lsp--uri-to-path)) - (version (lsp:versioned-text-document-identifier-version? text-document))) - (with-current-buffer (find-file-noselect filename) - (or (null version) (zerop version) (= -1 version) - (equal version lsp--cur-version)))))) - document-changes) - (error "Document changes cannot be applied due to different document version"))) - -(defun lsp--apply-workspace-edit (workspace-edit &optional operation) - "Apply the WorkspaceEdit object WORKSPACE-EDIT. -OPERATION is symbol representing the source of this text edit." - (-let (((&WorkspaceEdit :document-changes? :changes?) workspace-edit)) - (if-let ((document-changes (seq-reverse document-changes?))) - (progn - (lsp--check-document-changes-version document-changes) - (->> document-changes - (seq-filter (-lambda ((&CreateFile :kind)) (equal kind "create"))) - (seq-do (lambda (change) (lsp--apply-text-document-edit change operation)))) - (->> document-changes - (seq-filter (-lambda ((&CreateFile :kind)) - (and (or (not kind) (equal kind "edit")) - (not (equal kind "create"))))) - (seq-do (lambda (change) (lsp--apply-text-document-edit change operation)))) - (->> document-changes - (seq-filter (-lambda ((&CreateFile :kind)) - (and (not (or (not kind) (equal kind "edit"))) - (not (equal kind "create"))))) - (seq-do (lambda (change) (lsp--apply-text-document-edit change operation))))) - (lsp-map - (lambda (uri text-edits) - (with-current-buffer (-> uri lsp--uri-to-path find-file-noselect) - (lsp--apply-text-edits text-edits operation))) - changes?)))) - -(defmacro lsp-with-filename (file &rest body) - "Execute BODY with FILE as a context. -Need to handle the case when FILE indicates virtual buffer." - (declare (indent 1) (debug t)) - `(if-let ((lsp--virtual-buffer (get-text-property 0 'lsp-virtual-buffer ,file))) - (lsp-with-current-buffer lsp--virtual-buffer - ,@body) - ,@body)) - -(defun lsp--apply-text-document-edit (edit &optional operation) - "Apply the TextDocumentEdit object EDIT. -OPERATION is symbol representing the source of this text edit. -If the file is not being visited by any buffer, it is opened with -`find-file-noselect'. -Because lsp-mode does not store previous document versions, the edit is only -applied if the version of the textDocument matches the version of the -corresponding file. - -interface TextDocumentEdit { - textDocument: VersionedTextDocumentIdentifier; - edits: TextEdit[]; -}" - (pcase (lsp:edit-kind edit) - ("create" (-let* (((&CreateFile :uri :options?) edit) - (file-name (lsp--uri-to-path uri))) - (mkdir (f-dirname file-name) t) - (f-touch file-name) - (when (lsp:create-file-options-overwrite? options?) - (f-write-text "" nil file-name)) - (find-file-noselect file-name))) - ("delete" (-let (((&DeleteFile :uri :options? (&DeleteFileOptions? :recursive?)) edit)) - (f-delete (lsp--uri-to-path uri) recursive?))) - ("rename" (-let* (((&RenameFile :old-uri :new-uri :options? (&RenameFileOptions? :overwrite?)) edit) - (old-file-name (lsp--uri-to-path old-uri)) - (new-file-name (lsp--uri-to-path new-uri)) - (buf (find-buffer-visiting old-file-name))) - (when buf - (lsp-with-current-buffer buf - (save-buffer) - (lsp--text-document-did-close))) - (mkdir (f-dirname new-file-name) t) - (rename-file old-file-name new-file-name overwrite?) - (when buf - (lsp-with-current-buffer buf - (set-buffer-modified-p nil) - (setq lsp-buffer-uri nil) - (set-visited-file-name new-file-name) - (lsp))))) - (_ (let ((file-name (->> edit - (lsp:text-document-edit-text-document) - (lsp:versioned-text-document-identifier-uri) - (lsp--uri-to-path)))) - (lsp-with-current-buffer (find-buffer-visiting file-name) - (lsp-with-filename file-name - (lsp--apply-text-edits (lsp:text-document-edit-edits edit) operation))))))) - -(lsp-defun lsp--position-compare ((&Position :line left-line - :character left-character) - (&Position :line right-line - :character right-character)) - "Return t if position LEFT is greater than RIGHT." - (if (= left-line right-line) - (> left-character right-character) - (> left-line right-line))) - -(lsp-defun lsp-point-in-range? (position (&Range :start :end)) - "Returns if POINT is in RANGE." - (not (or (lsp--position-compare start position) - (lsp--position-compare position end)))) - -(lsp-defun lsp--position-equal ((&Position :line left-line - :character left-character) - (&Position :line right-line - :character right-character)) - "Return whether LEFT and RIGHT positions are equal." - (and (= left-line right-line) - (= left-character right-character))) - -(lsp-defun lsp--text-edit-sort-predicate ((&TextEdit :range (&Range :start left-start :end left-end)) - (&TextEdit :range (&Range :start right-start :end right-end))) - (if (lsp--position-equal left-start right-start) - (lsp--position-compare left-end right-end) - (lsp--position-compare left-start right-start))) - -(lsp-defun lsp--apply-text-edit ((edit &as &TextEdit :range (&RangeToPoint :start :end) :new-text)) - "Apply the edits described in the TextEdit object in TEXT-EDIT." - (setq new-text (s-replace "\r" "" (or new-text ""))) - (lsp:set-text-edit-new-text edit new-text) - (goto-char start) - (delete-region start end) - (insert new-text)) - -;; WORKAROUND: typescript-language might send -1 when applying code actions. -;; see https://github.com/emacs-lsp/lsp-mode/issues/1582 -(lsp-defun lsp--fix-point ((point &as &Position :character :line)) - (-doto point - (lsp:set-position-line (max 0 line)) - (lsp:set-position-character (max 0 character)))) - -(lsp-defun lsp--apply-text-edit-replace-buffer-contents ((edit &as - &TextEdit - :range (&Range :start :end) - :new-text)) - "Apply the edits described in the TextEdit object in TEXT-EDIT. -The method uses `replace-buffer-contents'." - (setq new-text (s-replace "\r" "" (or new-text ""))) - (lsp:set-text-edit-new-text edit new-text) - (-let* ((source (current-buffer)) - ((beg . end) (lsp--range-to-region (lsp-make-range :start (lsp--fix-point start) - :end (lsp--fix-point end))))) - (with-temp-buffer - (insert new-text) - (let ((temp (current-buffer))) - (with-current-buffer source - (save-excursion - (save-restriction - (narrow-to-region beg end) - - ;; On emacs versions < 26.2, - ;; `replace-buffer-contents' is buggy - it calls - ;; change functions with invalid arguments - so we - ;; manually call the change functions here. - ;; - ;; See emacs bugs #32237, #32278: - ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=32237 - ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=32278 - (let ((inhibit-modification-hooks t) - (length (- end beg))) - (run-hook-with-args 'before-change-functions - beg end) - (replace-buffer-contents temp) - (run-hook-with-args 'after-change-functions - beg (+ beg (length new-text)) - length))))))))) - -(defun lsp--to-yasnippet-snippet (snippet) - "Convert LSP SNIPPET to yasnippet snippet." - ;; LSP snippet doesn't escape "{" and "`", but yasnippet requires escaping it. - (replace-regexp-in-string (rx (or bos (not (any "$" "\\"))) (group (or "{" "`"))) - (rx "\\" (backref 1)) - snippet - nil nil 1)) - -(defvar-local lsp-enable-relative-indentation nil - "Enable relative indentation when insert texts, snippets ... -from language server.") - -(defun lsp--expand-snippet (snippet &optional start end expand-env) - "Wrapper of `yas-expand-snippet' with all of it arguments. -The snippet will be convert to LSP style and indent according to -LSP server result." - (require 'yasnippet nil t) - (let* ((inhibit-field-text-motion t) - (yas-wrap-around-region nil) - (yas-indent-line 'none) - (yas-also-auto-indent-first-line nil)) - (yas-expand-snippet - (lsp--to-yasnippet-snippet snippet) - start end expand-env))) - -(defun lsp--indent-lines (start end &optional insert-text-mode?) - "Indent from START to END based on INSERT-TEXT-MODE? value. -- When INSERT-TEXT-MODE? is provided - - if it's `lsp/insert-text-mode-as-it', do no editor indentation. - - if it's `lsp/insert-text-mode-adjust-indentation', adjust leading - whitespaces to match the line where text is inserted. -- When it's not provided, using `indent-line-function' for each line." - (save-excursion - (goto-char end) - (let* ((end-line (line-number-at-pos)) - (offset (save-excursion - (goto-char start) - (current-indentation))) - (indent-line-function - (cond ((equal insert-text-mode? lsp/insert-text-mode-as-it) - #'ignore) - ((or (equal insert-text-mode? lsp/insert-text-mode-adjust-indentation) - lsp-enable-relative-indentation - ;; Indenting snippets is extremely slow in `org-mode' buffers - ;; since it has to calculate indentation based on SRC block - ;; position. Thus we use relative indentation as default. - (derived-mode-p 'org-mode)) - (lambda () (save-excursion - (beginning-of-line) - (indent-to-column offset)))) - (t indent-line-function)))) - (goto-char start) - (forward-line) - (while (and (not (eobp)) - (<= (line-number-at-pos) end-line)) - (funcall indent-line-function) - (forward-line))))) - -(defun lsp--apply-text-edits (edits &optional operation) - "Apply the EDITS described in the TextEdit[] object. -OPERATION is symbol representing the source of this text edit." - (unless (seq-empty-p edits) - (atomic-change-group - (run-hooks 'lsp-before-apply-edits-hook) - (let* ((change-group (prepare-change-group)) - (howmany (length edits)) - (message (format "Applying %s edits to `%s' ..." howmany (current-buffer))) - (_ (lsp--info message)) - (reporter (make-progress-reporter message 0 howmany)) - (done 0) - (apply-edit (if (not lsp--virtual-buffer) - #'lsp--apply-text-edit-replace-buffer-contents - #'lsp--apply-text-edit))) - (unwind-protect - (->> edits - ;; We sort text edits so as to apply edits that modify latter - ;; parts of the document first. Furthermore, because the LSP - ;; spec dictates that: "If multiple inserts have the same - ;; position, the order in the array defines which edit to - ;; apply first." We reverse the initial list and sort stably - ;; to make sure the order among edits with the same position - ;; is preserved. - (nreverse) - (seq-sort #'lsp--text-edit-sort-predicate) - (mapc (lambda (edit) - (progress-reporter-update reporter (cl-incf done)) - (funcall apply-edit edit) - (when (lsp:snippet-text-edit-insert-text-format? edit) - (-when-let ((&SnippetTextEdit :range (&RangeToPoint :start) - :insert-text-format? :new-text) edit) - (when (eq insert-text-format? lsp/insert-text-format-snippet) - ;; No `save-excursion' needed since expand snippet will change point anyway - (goto-char (+ start (length new-text))) - (lsp--indent-lines start (point)) - (lsp--expand-snippet new-text start (point))))) - (run-hook-with-args 'lsp-after-apply-edits-hook operation)))) - (undo-amalgamate-change-group change-group) - (progress-reporter-done reporter)))))) - -(defun lsp--create-apply-text-edits-handlers () - "Create (handler cleanup-fn) for applying text edits in async request. -Only works when mode is `tick or `alive." - (let* (first-edited - (func (lambda (start &rest _) - (setq first-edited (if first-edited - (min start first-edited) - start))))) - (add-hook 'before-change-functions func nil t) - (list - (lambda (edits) - (if (and first-edited - (seq-find (-lambda ((&TextEdit :range (&RangeToPoint :end))) - ;; Text edit region is overlapped - (> end first-edited)) - edits)) - (lsp--warn "TextEdits will not be applied since document has been modified before of them.") - (lsp--apply-text-edits edits 'completion-cleanup))) - (lambda () - (remove-hook 'before-change-functions func t))))) - -(defun lsp--capability (cap &optional capabilities) - "Get the value of capability CAP. If CAPABILITIES is non-nil, use them instead." - (when (stringp cap) - (setq cap (intern (concat ":" cap)))) - - (lsp-get (or capabilities - (lsp--server-capabilities)) - cap)) - -(defun lsp--registered-capability (method) - "Check whether there is workspace providing METHOD." - (->> (lsp-workspaces) - (--keep (seq-find (lambda (reg) - (equal (lsp--registered-capability-method reg) method)) - (lsp--workspace-registered-server-capabilities it))) - cl-first)) - -(defun lsp--capability-for-method (method) - "Get the value of capability for METHOD." - (-let* ((reqs (cdr (assoc method lsp-method-requirements))) - ((&plist :capability) reqs)) - (or (and capability (lsp--capability capability)) - (-some-> (lsp--registered-capability method) - (lsp--registered-capability-options))))) - -(defvar-local lsp--before-change-vals nil - "Store the positions from the `lsp-before-change' function call, for -validation and use in the `lsp-on-change' function.") - -(defun lsp--text-document-content-change-event (start end length) - "Make a TextDocumentContentChangeEvent body for START to END, of length LENGTH." - ;; So (47 54 0) means add 7 chars starting at pos 47 - ;; must become - ;; {"range":{"start":{"line":5,"character":6} - ;; ,"end" :{"line":5,"character":6}} - ;; ,"rangeLength":0 - ;; ,"text":"\nbb = 5"} - ;; - ;; And (47 47 7) means delete 7 chars starting at pos 47 - ;; must become - ;; {"range":{"start":{"line":6,"character":0} - ;; ,"end" :{"line":7,"character":0}} - ;; ,"rangeLength":7 - ;; ,"text":""} - ;; - ;; (208 221 3) means delete 3 chars starting at pos 208, and replace them with - ;; 13 chars. So it must become - ;; {"range":{"start":{"line":5,"character":8} - ;; ,"end" :{"line":5,"character":11}} - ;; ,"rangeLength":3 - ;; ,"text":"new-chars-xxx"} - ;; - - ;; Adding text: - ;; lsp-before-change:(start,end)=(33,33) - ;; lsp-on-change:(start,end,length)=(33,34,0) - ;; - ;; Changing text: - ;; lsp-before-change:(start,end)=(208,211) - ;; lsp-on-change:(start,end,length)=(208,221,3) - ;; - ;; Deleting text: - ;; lsp-before-change:(start,end)=(19,27) - ;; lsp-on-change:(start,end,length)=(19,19,8) - (if (zerop length) - ;; Adding something only, work from start only - `( :range ,(lsp--range - (lsp--point-to-position start) - (lsp--point-to-position start)) - :rangeLength 0 - :text ,(buffer-substring-no-properties start end)) - - (if (eq start end) - ;; Deleting something only - (if (lsp--bracketed-change-p start length) - ;; The before-change value is bracketed, use it - `( :range ,(lsp--range - (lsp--point-to-position start) - (plist-get lsp--before-change-vals :end-pos)) - :rangeLength ,length - :text "") - ;; If the change is not bracketed, send a full change event instead. - (lsp--full-change-event)) - - ;; Deleting some things, adding others - (if (lsp--bracketed-change-p start length) - ;; The before-change value is valid, use it - `( :range ,(lsp--range - (lsp--point-to-position start) - (plist-get lsp--before-change-vals :end-pos)) - :rangeLength ,length - :text ,(buffer-substring-no-properties start end)) - (lsp--full-change-event))))) - -(defun lsp--bracketed-change-p (start length) - "If the before and after positions are the same, and the length -is the size of the start range, we are probably good." - (-let [(&plist :end before-end :start before-start) lsp--before-change-vals] - (and (eq start before-start) - (eq length (- before-end before-start))))) - -(defun lsp--full-change-event () - `(:text ,(lsp--buffer-content))) - -(defun lsp-before-change (start end) - "Executed before a file is changed. -Added to `before-change-functions'." - ;; Note: - ;; - ;; This variable holds a list of functions to call when Emacs is about to - ;; modify a buffer. Each function gets two arguments, the beginning and end of - ;; the region that is about to change, represented as integers. The buffer - ;; that is about to change is always the current buffer when the function is - ;; called. - ;; - ;; WARNING: - ;; - ;; Do not expect the before-change hooks and the after-change hooks be called - ;; in balanced pairs around each buffer change. Also don't expect the - ;; before-change hooks to be called for every chunk of text Emacs is about to - ;; delete. These hooks are provided on the assumption that Lisp programs will - ;; use either before- or the after-change hooks, but not both, and the - ;; boundaries of the region where the changes happen might include more than - ;; just the actual changed text, or even lump together several changes done - ;; piecemeal. - (save-match-data - (lsp-save-restriction-and-excursion - (setq lsp--before-change-vals - (list :start start - :end end - :end-pos (lsp--point-to-position end)))))) - -(defun lsp--flush-delayed-changes () - (let ((inhibit-quit t)) - (when lsp--delay-timer - (cancel-timer lsp--delay-timer)) - (mapc (-lambda ((workspace buffer document change)) - (with-current-buffer buffer - (with-lsp-workspace workspace - (lsp-notify "textDocument/didChange" - (list :textDocument document - :contentChanges (vector change)))))) - (prog1 (nreverse lsp--delayed-requests) - (setq lsp--delayed-requests nil))))) - -(defun lsp--workspace-sync-method (workspace) - (let ((sync (-> workspace - (lsp--workspace-server-capabilities) - (lsp:server-capabilities-text-document-sync?)))) - (if (lsp-text-document-sync-options? sync) - (lsp:text-document-sync-options-change? sync) - sync))) - -(defun lsp-on-change (start end length &optional content-change-event-fn) - "Executed when a file is changed. -Added to `after-change-functions'." - ;; Note: - ;; - ;; Each function receives three arguments: the beginning and end of the region - ;; just changed, and the length of the text that existed before the change. - ;; All three arguments are integers. The buffer that has been changed is - ;; always the current buffer when the function is called. - ;; - ;; The length of the old text is the difference between the buffer positions - ;; before and after that text as it was before the change. As for the - ;; changed text, its length is simply the difference between the first two - ;; arguments. - ;; - ;; So (47 54 0) means add 7 chars starting at pos 47 - ;; So (47 47 7) means delete 7 chars starting at pos 47 - (save-match-data - (let ((inhibit-quit t) - ;; make sure that `lsp-on-change' is called in multi-workspace context - ;; see #2901 - lsp--cur-workspace) - ;; A (revert-buffer) call with the 'preserve-modes parameter (eg, as done - ;; by auto-revert-mode) will cause this handler to get called with a nil - ;; buffer-file-name. We need the buffer-file-name to send notifications; - ;; so we skip handling revert-buffer-caused changes and instead handle - ;; reverts separately in lsp-on-revert - (when (not revert-buffer-in-progress-p) - (cl-incf lsp--cur-version) - (mapc - (lambda (workspace) - (pcase (or lsp-document-sync-method - (lsp--workspace-sync-method workspace)) - (1 - (if lsp-debounce-full-sync-notifications - (setq lsp--delayed-requests - (->> lsp--delayed-requests - (-remove (-lambda ((_ buffer)) - (equal (current-buffer) buffer))) - (cons (list workspace - (current-buffer) - (lsp--versioned-text-document-identifier) - (lsp--full-change-event))))) - (with-lsp-workspace workspace - (lsp-notify "textDocument/didChange" - (list :contentChanges (vector (lsp--full-change-event)) - :textDocument (lsp--versioned-text-document-identifier)))))) - (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)) - - -(defcustom lsp-trim-trailing-whitespace t - "Trim trailing whitespace on a line." - :group 'lsp-mode - :type 'boolean) - -(defcustom lsp-insert-final-newline t - "Insert a newline character at the end of the file if one does not exist." - :group 'lsp-mode - :type 'boolean) - -(defcustom lsp-trim-final-newlines t - "Trim all newlines after the final newline at the end of the file." - :group 'lsp-mode - :type 'boolean) - - -(defun lsp--on-type-formatting (first-trigger-characters more-trigger-characters) - "Self insert handling. -Applies on type formatting." - (let ((ch last-command-event)) - (when (or (eq (string-to-char first-trigger-characters) ch) - (cl-find ch more-trigger-characters :key #'string-to-char)) - (lsp-request-async "textDocument/onTypeFormatting" - (lsp-make-document-on-type-formatting-params - :text-document (lsp--text-document-identifier) - :options (lsp-make-formatting-options - :tab-size (symbol-value (lsp--get-indent-width major-mode)) - :insert-spaces (lsp-json-bool (not indent-tabs-mode)) - :trim-trailing-whitespace? (lsp-json-bool lsp-trim-trailing-whitespace) - :insert-final-newline? (lsp-json-bool lsp-insert-final-newline) - :trim-final-newlines? (lsp-json-bool lsp-trim-final-newlines)) - :ch (char-to-string ch) - :position (lsp--cur-position)) - (lambda (data) (lsp--apply-text-edits data 'format)) - :mode 'tick)))) - - -;; links -(defun lsp--document-links () - (when (lsp-feature? "textDocument/documentLink") - (lsp-request-async - "textDocument/documentLink" - `(:textDocument ,(lsp--text-document-identifier)) - (lambda (links) - (lsp--remove-overlays 'lsp-link) - (seq-do - (-lambda ((link &as &DocumentLink :range (&Range :start :end))) - (-doto (make-button (lsp--position-to-point start) - (lsp--position-to-point end) - 'action (lsp--document-link-keymap link) - 'keymap (let ((map (make-sparse-keymap))) - (define-key map [M-return] 'push-button) - (define-key map [mouse-2] 'push-button) - map) - 'help-echo "mouse-2, M-RET: Visit this link") - (overlay-put 'lsp-link t))) - links)) - :mode 'unchanged))) - -(defun lsp--document-link-handle-target (url) - (let* ((parsed-url (url-generic-parse-url (url-unhex-string url))) - (type (url-type parsed-url))) - (pcase type - ("file" - (xref-push-marker-stack) - (find-file (lsp--uri-to-path url)) - (-when-let ((_ line column) (s-match (rx "#" (group (1+ num)) (or "," "#") (group (1+ num))) url)) - (goto-char (lsp--position-to-point - (lsp-make-position :character (1- (string-to-number column)) - :line (1- (string-to-number line))))))) - ((or "http" "https") (browse-url url)) - (type (if-let ((handler (lsp--get-uri-handler type))) - (funcall handler url) - (signal 'lsp-file-scheme-not-supported (list url))))))) - -(lsp-defun lsp--document-link-keymap ((link &as &DocumentLink :target?)) - (if target? - (lambda (_) - (interactive) - (lsp--document-link-handle-target target?)) - (lambda (_) - (interactive) - (when (lsp:document-link-registration-options-resolve-provider? - (lsp--capability-for-method "textDocument/documentLink")) - (lsp-request-async - "documentLink/resolve" - link - (-lambda ((&DocumentLink :target?)) - (lsp--document-link-handle-target target?))))))) - - - -(defcustom lsp-warn-no-matched-clients t - "Whether to show messages when there are no supported clients." - :group 'lsp-mode - :type 'boolean) - -(defun lsp-buffer-language--configured-id () - "Return nil when not registered." - (->> lsp-language-id-configuration - (-first - (-lambda ((mode-or-pattern . language)) - (cond - ((and (stringp mode-or-pattern) - (s-matches? mode-or-pattern (buffer-file-name))) - language) - ((eq mode-or-pattern major-mode) language)))) - cl-rest)) - -(defvar-local lsp--buffer-language nil - "Locally cached returned value of `lsp-buffer-language'.") - -(defun lsp-buffer-language () - "Get language corresponding current buffer." - (or lsp--buffer-language - (let* ((configured-language (lsp-buffer-language--configured-id))) - (setq lsp--buffer-language - (or configured-language - ;; ensure non-nil - (string-remove-suffix "-mode" (symbol-name major-mode)))) - (when (and lsp-warn-no-matched-clients - (null configured-language)) - (lsp-warn "Unable to calculate the languageId for buffer `%s'. \ -Take a look at `lsp-language-id-configuration'. The `major-mode' is %s" - (buffer-name) - major-mode)) - lsp--buffer-language))) - -(defun lsp-activate-on (&rest languages) - "Returns language activation function. -The function will return t when the `lsp-buffer-language' returns -one of the LANGUAGES." - (lambda (_file-name _mode) - (-contains? languages (lsp-buffer-language)))) - -(defun lsp-workspace-root (&optional path) - "Find the workspace root for the current file or PATH." - (-when-let* ((file-name (or path (buffer-file-name))) - (file-name (lsp-f-canonical file-name))) - (->> (lsp-session) - (lsp-session-folders) - (--filter (and (lsp--files-same-host it file-name) - (or (lsp-f-ancestor-of? it file-name) - (equal it file-name)))) - (--max-by (> (length it) (length other)))))) - -(defun lsp-on-revert () - "Executed when a file is reverted. -Added to `after-revert-hook'." - (let ((n (buffer-size)) - (revert-buffer-in-progress-p nil)) - (lsp-on-change 0 n n))) - -(defun lsp--text-document-did-close (&optional keep-workspace-alive) - "Executed when the file is closed, added to `kill-buffer-hook'. - -If KEEP-WORKSPACE-ALIVE is non-nil, do not shutdown the workspace -if it's closing the last buffer in the workspace." - (lsp-foreach-workspace - (cl-callf2 delq (lsp-current-buffer) (lsp--workspace-buffers lsp--cur-workspace)) - (with-demoted-errors "Error sending didClose notification in ‘lsp--text-document-did-close’: %S" - (lsp-notify "textDocument/didClose" - `(:textDocument ,(lsp--text-document-identifier)))) - (when (and (not lsp-keep-workspace-alive) - (not keep-workspace-alive) - (not (lsp--workspace-buffers lsp--cur-workspace))) - (lsp--shutdown-workspace)))) - -(defun lsp--will-save-text-document-params (reason) - (list :textDocument (lsp--text-document-identifier) - :reason reason)) - -(defun lsp--before-save () - "Before save handler." - (with-demoted-errors "Error in ‘lsp--before-save’: %S" - (let ((params (lsp--will-save-text-document-params 1))) - (when (lsp--send-will-save-p) - (lsp-notify "textDocument/willSave" params)) - (when (and (lsp--send-will-save-wait-until-p) lsp-before-save-edits) - (let ((lsp-response-timeout 0.1)) - (condition-case nil - (lsp--apply-text-edits - (lsp-request "textDocument/willSaveWaitUntil" - params) - 'before-save) - (error))))))) - -(defun lsp--on-auto-save () - "Handler for auto-save." - (when (lsp--send-will-save-p) - (with-demoted-errors "Error in ‘lsp--on-auto-save’: %S" - (lsp-notify "textDocument/willSave" (lsp--will-save-text-document-params 2))))) - -(defun lsp--text-document-did-save () - "Executed when the file is closed, added to `after-save-hook''." - (when (lsp--send-did-save-p) - (with-demoted-errors "Error on ‘lsp--text-document-did-save: %S’" - (lsp-notify "textDocument/didSave" - `( :textDocument ,(lsp--versioned-text-document-identifier) - ,@(when (lsp--save-include-text-p) - (list :text (lsp--buffer-content)))))))) - -(defun lsp--text-document-position-params (&optional identifier position) - "Make TextDocumentPositionParams for the current point in the current document. -If IDENTIFIER and POSITION are non-nil, they will be used as the document -identifier and the position respectively." - (list :textDocument (or identifier (lsp--text-document-identifier)) - :position (or position (lsp--cur-position)))) - -(defun lsp--get-buffer-diagnostics () - "Return buffer diagnostics." - (gethash (or - (plist-get lsp--virtual-buffer :buffer-file-name) - (lsp--fix-path-casing (buffer-file-name))) - (lsp-diagnostics t))) - -(defun lsp-cur-line-diagnostics () - "Return any diagnostics that apply to the current line." - (-let [(&plist :start (&plist :line start) :end (&plist :line end)) (lsp--region-or-line)] - (cl-coerce (-filter - (-lambda ((&Diagnostic :range (&Range :start (&Position :line)))) - (and (>= line start) (<= line end))) - (lsp--get-buffer-diagnostics)) - 'vector))) - -(lsp-defun lsp-range-overlapping?((left &as &Range :start left-start :end left-end) - (right &as &Range :start right-start :end right-end)) - (or (lsp-point-in-range? right-start left) - (lsp-point-in-range? right-end left) - (lsp-point-in-range? left-start right) - (lsp-point-in-range? left-end right))) - -(defun lsp-make-position-1 (position) - (lsp-make-position :line (plist-get position :line) - :character (plist-get position :character))) - -(defun lsp-cur-possition-diagnostics () - "Return any diagnostics that apply to the current line." - (-let* ((start (if (use-region-p) (region-beginning) (point))) - (end (if (use-region-p) (region-end) (point))) - (current-range (lsp-make-range :start (lsp-make-position-1 (lsp-point-to-position start)) - :end (lsp-make-position-1 (lsp-point-to-position end))))) - (->> (lsp--get-buffer-diagnostics) - (-filter - (-lambda ((&Diagnostic :range)) - (lsp-range-overlapping? range current-range))) - (apply 'vector)))) - -(defalias 'lsp--cur-line-diagnotics 'lsp-cur-line-diagnostics) - -(defun lsp--extract-line-from-buffer (pos) - "Return the line pointed to by POS (a Position object) in the current buffer." - (let* ((point (lsp--position-to-point pos)) - (inhibit-field-text-motion t)) - (save-excursion - (goto-char point) - (buffer-substring (line-beginning-position) (line-end-position))))) - -(lsp-defun lsp--xref-make-item (filename (&Range :start (start &as &Position :character start-char :line start-line) - :end (end &as &Position :character end-char))) - "Return a xref-item from a RANGE in FILENAME." - (let* ((line (lsp--extract-line-from-buffer start)) - (len (length line))) - (add-face-text-property (max (min start-char len) 0) - (max (min end-char len) 0) - 'xref-match t line) - ;; LINE is nil when FILENAME is not being current visited by any buffer. - (xref-make-match (or line filename) - (xref-make-file-location - filename - (lsp-translate-line (1+ start-line)) - (lsp-translate-column start-char)) - (- end-char start-char)))) - -(defun lsp--location-uri (loc) - (if (lsp-location? loc) - (lsp:location-uri loc) - (lsp:location-link-target-uri loc))) - -(lsp-defun lsp-goto-location ((loc &as &Location :uri :range (&Range :start))) - "Go to location." - (let ((path (lsp--uri-to-path uri))) - (if (f-exists? path) - (with-current-buffer (find-file path) - (goto-char (lsp--position-to-point start))) - (error "There is no file %s" path)))) - -(defun lsp--location-range (loc) - (if (lsp-location? loc) - (lsp:location-range loc) - (lsp:location-link-target-selection-range loc))) - -(defun lsp--locations-to-xref-items (locations) - "Return a list of `xref-item' given LOCATIONS, which can be of -type Location, LocationLink, Location[] or LocationLink[]." - (setq locations - (pcase locations - ((seq (or (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 exclude-declaration) - "Make a ReferenceParam object. -If TD-POSITION is non-nil, use it as TextDocumentPositionParams object instead. -If EXCLUDE-DECLARATION is non-nil, request the server to include declarations." - (let ((json-false :json-false)) - (plist-put (or td-position (lsp--text-document-position-params)) - :context `(:includeDeclaration ,(lsp-json-bool (not exclude-declaration)))))) - -(defun lsp--cancel-request (id) - "Cancel request with ID in all workspaces." - (lsp-foreach-workspace - (->> lsp--cur-workspace lsp--workspace-client lsp--client-response-handlers (remhash id)) - (lsp-notify "$/cancelRequest" `(:id ,id)))) - -(defvar-local lsp--hover-saved-bounds nil) - -(defun lsp-eldoc-function (cb &rest _ignored) - "`lsp-mode' eldoc function to display hover info (based on `textDocument/hover')." - (if (and lsp--hover-saved-bounds - (lsp--point-in-bounds-p lsp--hover-saved-bounds)) - lsp--eldoc-saved-message - (setq lsp--hover-saved-bounds nil - lsp--eldoc-saved-message nil) - (if (looking-at-p "[[:space:]\n]") - (setq lsp--eldoc-saved-message nil) ; And returns nil. - (when (and lsp-eldoc-enable-hover (lsp-feature? "textDocument/hover")) - (lsp-request-async - "textDocument/hover" - (lsp--text-document-position-params) - (-lambda ((hover &as &Hover? :range? :contents)) - (setq lsp--hover-saved-bounds (when range? - (lsp--range-to-region range?))) - (funcall cb (setq lsp--eldoc-saved-message - (when contents - (lsp--render-on-hover-content - contents - lsp-eldoc-render-all))))) - :error-handler #'ignore - :mode 'tick - :cancel-token :eldoc-hover))))) - -(defun lsp--point-on-highlight? () - (-some? (lambda (overlay) - (overlay-get overlay 'lsp-highlight)) - (overlays-at (point)))) - -(defun lsp--cleanup-highlights-if-needed () - (when (and lsp-enable-symbol-highlighting - lsp--have-document-highlights - (not (lsp--point-on-highlight?))) - (lsp--remove-overlays 'lsp-highlight) - (setq lsp--have-document-highlights nil) - (lsp-cancel-request-by-token :highlights))) - -(defvar-local lsp--symbol-bounds-of-last-highlight-invocation nil - "The bounds of the symbol from which `lsp--document-highlight' - most recently requested highlights.") - -(defun lsp--document-highlight () - (when (lsp-feature? "textDocument/documentHighlight") - (let ((curr-sym-bounds (bounds-of-thing-at-point 'symbol))) - (unless (or (looking-at-p "[[:space:]\n]") - (not lsp-enable-symbol-highlighting) - (and lsp--have-document-highlights - curr-sym-bounds - (equal curr-sym-bounds - lsp--symbol-bounds-of-last-highlight-invocation))) - (setq lsp--symbol-bounds-of-last-highlight-invocation - curr-sym-bounds) - (lsp-request-async "textDocument/documentHighlight" - (lsp--text-document-position-params) - #'lsp--document-highlight-callback - :mode 'tick - :cancel-token :highlights))))) - -(defun lsp--help-open-link (&rest _) - "Open markdown link at point via mouse or keyboard." - (interactive "P") - (let ((buffer-list-update-hook nil)) - (-let [(buffer point) (if-let* ((valid (and (listp last-input-event) - (eq (car last-input-event) 'mouse-2))) - (event (cadr last-input-event)) - (win (posn-window event)) - (buffer (window-buffer win))) - `(,buffer ,(posn-point event)) - `(,(current-buffer) ,(point)))] - (with-current-buffer buffer - (when-let* ((face (get-text-property point 'face)) - (url (or (and (eq face 'markdown-link-face) - (get-text-property point 'help-echo)) - (and (memq face '(markdown-url-face markdown-plain-url-face)) - (nth 3 (markdown-link-at-pos point)))))) - (lsp--document-link-handle-target url)))))) - -(defvar lsp-help-mode-map - (-doto (make-sparse-keymap) - (define-key [remap markdown-follow-link-at-point] #'lsp--help-open-link)) - "Keymap for `lsp-help-mode'.") - -(define-derived-mode lsp-help-mode help-mode "LspHelp" - "Major mode for displaying lsp help.") - -(defun lsp-describe-thing-at-point () - "Display the type signature and documentation of the thing at point." - (interactive) - (let ((contents (-some->> (lsp--text-document-position-params) - (lsp--make-request "textDocument/hover") - (lsp--send-request) - (lsp:hover-contents)))) - (if (and contents (not (equal contents ""))) - (let ((lsp-help-buf-name "*lsp-help*")) - (with-current-buffer (get-buffer-create lsp-help-buf-name) - (delay-mode-hooks - (lsp-help-mode) - (with-help-window lsp-help-buf-name - (insert (string-trim-right (lsp--render-on-hover-content contents t))))) - (run-mode-hooks))) - (lsp--info "No content at point.")))) - -(defun lsp--point-in-bounds-p (bounds) - "Return whether the current point is within BOUNDS." - (and (<= (car bounds) (point)) (< (point) (cdr bounds)))) - -(defun lsp-get-renderer (language) - "Get renderer for LANGUAGE." - (lambda (str) - (lsp--render-string str language))) - -(defun lsp--setup-markdown (mode) - "Setup the ‘markdown-mode’ in the frame. -MODE is the mode used in the parent frame." - (make-local-variable 'markdown-code-lang-modes) - (dolist (mark (alist-get mode lsp-custom-markup-modes)) - (add-to-list 'markdown-code-lang-modes (cons mark mode))) - (setq-local markdown-fontify-code-blocks-natively t) - (setq-local markdown-fontify-code-block-default-mode mode) - (setq-local markdown-hide-markup t) - - ;; Render some common HTML entities. - ;; This should really happen in markdown-mode instead, - ;; but it doesn't, so we do it here for now. - (setq prettify-symbols-alist - (cl-loop for i from 0 to 255 - collect (cons (format "&#x%02X;" i) i))) - (push '("&lt;" . ?<) prettify-symbols-alist) - (push '("&gt;" . ?>) prettify-symbols-alist) - (push '("&amp;" . ?&) prettify-symbols-alist) - (push '("&nbsp;" . ? ) prettify-symbols-alist) - (setq prettify-symbols-compose-predicate - (lambda (_start _end _match) t)) - (prettify-symbols-mode 1)) - -(defvar lsp-help-link-keymap - (let ((map (make-sparse-keymap))) - (define-key map [mouse-2] #'lsp--help-open-link) - (define-key map "\r" #'lsp--help-open-link) - map) - "Keymap active on links in *lsp-help* mode.") - -(defun lsp--fix-markdown-links () - (let ((inhibit-read-only t) - (inhibit-modification-hooks t) - (prop)) - (save-restriction - (goto-char (point-min)) - (while (setq prop (markdown-find-next-prop 'face)) - (let ((end (or (next-single-property-change (car prop) 'face) - (point-max)))) - (when (memq (get-text-property (car prop) 'face) - '(markdown-link-face - markdown-url-face - markdown-plain-url-face)) - (add-text-properties (car prop) end - (list 'button t - 'category 'lsp-help-link - 'follow-link t - 'keymap lsp-help-link-keymap))) - (goto-char end)))))) - -(defun lsp--buffer-string-visible () - "Return visible buffer string. -Stolen from `org-copy-visible'." - (let ((temp (generate-new-buffer " *temp*")) - (beg (point-min)) - (end (point-max))) - (while (/= beg end) - (when (get-char-property beg 'invisible) - (setq beg (next-single-char-property-change beg 'invisible nil end))) - (let* ((next (next-single-char-property-change beg 'invisible nil end)) - (substring (buffer-substring beg next))) - (with-current-buffer temp (insert substring)) - ;; (setq result (concat result substring)) - (setq beg next))) - (setq deactivate-mark t) - (prog1 (with-current-buffer temp - (s-chop-suffix "\n" (buffer-string))) - (kill-buffer temp)))) - -(defvar lsp-buffer-major-mode nil - "Holds the major mode when fontification function is running. -See #2588") - -(defvar view-inhibit-help-message) - -(defun lsp--render-markdown () - "Render markdown." - - (let ((markdown-enable-math nil)) - (goto-char (point-min)) - (while (re-search-forward - (rx (and "\\" (group (or "\\" "`" "*" "_" ":" "/" - "{" "}" "[" "]" "(" ")" - "#" "+" "-" "." "!" "|")))) - nil t) - (replace-match (rx (backref 1)))) - - ;; markdown-mode v2.3 does not yet provide gfm-view-mode - (if (fboundp 'gfm-view-mode) - (let ((view-inhibit-help-message t)) - (gfm-view-mode)) - (gfm-mode)) - - (lsp--setup-markdown lsp-buffer-major-mode))) - -(defvar lsp--display-inline-image-alist - '((lsp--render-markdown - (:regexp - "!\\[.*?\\](data:image/[a-zA-Z]+;base64,\\([A-Za-z0-9+/\n]+?=*?\\)\\(|[^)]+\\)?)" - :sexp - (create-image - (base64-decode-string - (buffer-substring-no-properties (match-beginning 1) (match-end 1))) - nil t)))) - "Replaced string regexp and function returning image. -Each element should have the form (MODE . (PROPERTY-LIST...)). -MODE (car) is function which is defined in `lsp-language-id-configuration'. -Cdr should be list of PROPERTY-LIST. - -Each PROPERTY-LIST should have properties: -:regexp Regexp which determines what string is relpaced to image. - You should also get information of image, by parenthesis constructs. - By default, all matched string is replaced to image, but you can - change index of replaced string by keyword :replaced-index. - -:sexp Return image when evaluated. You can use information of regexp - by using (match-beggining N), (match-end N) or (match-substring N). - -In addition, each can have property: -:replaced-index Determine index which is used to replace regexp to image. - The value means first argument of `match-beginning' and - `match-end'. If omitted, interpreted as index 0.") - -(defcustom lsp-display-inline-image t - "Showing inline image or not." - :group 'lsp-mode - :type 'boolean) - -(defcustom lsp-enable-suggest-server-download t - "When non-nil enable server downloading suggestions." - :group 'lsp-mode - :type 'boolean - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-auto-register-remote-clients t - "When non-nil register remote when registering the local one." - :group 'lsp-mode - :type 'boolean - :package-version '(lsp-mode . "9.0.0")) - -(defun lsp--display-inline-image (mode) - "Add image property if available." - (let ((plist-list (cdr (assq mode lsp--display-inline-image-alist)))) - (when (and (display-images-p) lsp-display-inline-image) - (cl-loop - for plist in plist-list - with regexp with replaced-index - do - (setq regexp (plist-get plist :regexp)) - (setq replaced-index (or (plist-get plist :replaced-index) 0)) - - (font-lock-remove-keywords nil (list regexp replaced-index)) - (let ((inhibit-read-only t)) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward regexp nil t) - (set-text-properties - (match-beginning replaced-index) (match-end replaced-index) - nil) - (add-text-properties - (match-beginning replaced-index) (match-end replaced-index) - `(display ,(eval (plist-get plist :sexp))))))))))) - -(defun lsp--fontlock-with-mode (str mode) - "Fontlock STR with MODE." - (let ((lsp-buffer-major-mode major-mode)) - (with-temp-buffer - (with-demoted-errors "Error during doc rendering: %s" - (insert str) - (delay-mode-hooks (funcall mode)) - (cl-flet ((window-body-width () lsp-window-body-width)) - ;; This can go wrong in some cases, and the fontification would - ;; not work as expected. - ;; - ;; See #2984 - (ignore-errors (font-lock-ensure)) - (lsp--display-inline-image mode) - (when (eq mode 'lsp--render-markdown) - (lsp--fix-markdown-links)))) - (lsp--buffer-string-visible)))) - -(defun lsp--render-string (str language) - "Render STR using `major-mode' corresponding to LANGUAGE. -When language is nil render as markup if `markdown-mode' is loaded." - (setq str (s-replace "\r" "" (or str ""))) - (if-let* ((modes (-keep (-lambda ((mode . lang)) - (when (and (equal lang language) (functionp mode)) - mode)) - lsp-language-id-configuration)) - (mode (car (or (member major-mode modes) modes)))) - (lsp--fontlock-with-mode str mode) - str)) - -(defun lsp--render-element (content) - "Render CONTENT element." - (let ((inhibit-message t)) - (or - (pcase content - ((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-defmethod lsp-clients-extract-signature-on-hover (contents _server-id) - "Extract a representative line from CONTENTS, to show in the echo area." - (car (s-lines (s-trim (lsp--render-element contents))))) - -(defun lsp--render-on-hover-content (contents render-all) - "Render the content received from `document/onHover' request. -CONTENTS - MarkedString | MarkedString[] | MarkupContent -RENDER-ALL - nil if only the signature should be rendered." - (cond - ((lsp-markup-content? contents) - ;; MarkupContent. - ;; It tends to be long and is not suitable to display fully in the echo area. - ;; Just display the first line which is typically the signature. - (if render-all - (lsp--render-element contents) - (lsp--handle-rendered-for-echo-area contents))) - ((and (stringp contents) (not (string-match-p "\n" contents))) - ;; If the contents is a single string containing a single line, - ;; render it always. - (lsp--render-element contents)) - (t - ;; MarkedString -> MarkedString[] - (when (or (lsp-marked-string? contents) (stringp contents)) - (setq contents (list contents))) - ;; Consider the signature consisting of the elements who have a renderable - ;; "language" property. When render-all is nil, ignore other elements. - (string-join - (seq-map - #'lsp--render-element - (if render-all - contents - ;; Only render contents that have an available renderer. - (seq-take - (seq-filter - (-andfn #'lsp-marked-string? - (-compose #'lsp-get-renderer #'lsp:marked-string-language)) - contents) - 1))) - (if (bound-and-true-p page-break-lines-mode) - "\n \n" - "\n"))))) - - - -(defvar lsp-signature-mode-map - (-doto (make-sparse-keymap) - (define-key (kbd "M-n") #'lsp-signature-next) - (define-key (kbd "M-p") #'lsp-signature-previous) - (define-key (kbd "M-a") #'lsp-signature-toggle-full-docs) - (define-key (kbd "C-c C-k") #'lsp-signature-stop) - (define-key (kbd "C-g") #'lsp-signature-stop)) - "Keymap for `lsp-signature-mode'.") - -(define-minor-mode lsp-signature-mode - "Mode used to show signature popup." - :keymap lsp-signature-mode-map - :lighter "" - :group 'lsp-mode) - -(defun lsp-signature-stop () - "Stop showing current signature help." - (interactive) - (lsp-cancel-request-by-token :signature) - (remove-hook 'post-command-hook #'lsp-signature) - (funcall lsp-signature-function nil) - (lsp-signature-mode -1)) - -(declare-function page-break-lines--update-display-tables "ext:page-break-lines") - -(defun lsp--setup-page-break-mode-if-present () - "Enable `page-break-lines-mode' in current buffer." - (when (fboundp 'page-break-lines-mode) - (page-break-lines-mode) - ;; force page-break-lines-mode to update the display tables. - (page-break-lines--update-display-tables))) - -(defun lsp-lv-message (message) - (add-hook 'lv-window-hook #'lsp--setup-page-break-mode-if-present) - (if message - (progn - (setq lsp--signature-last-buffer (current-buffer)) - (let ((lv-force-update t)) - (lv-message "%s" message))) - (lv-delete-window) - (remove-hook 'lv-window-hook #'lsp--setup-page-break-mode-if-present))) - -(declare-function posframe-show "ext:posframe") -(declare-function posframe-hide "ext:posframe") -(declare-function posframe-poshandler-point-bottom-left-corner-upward "ext:posframe") - -(defface lsp-signature-posframe - '((t :inherit tooltip)) - "Background and foreground for `lsp-signature-posframe'." - :group 'lsp-mode) - -(defvar lsp-signature-posframe-params - (list :poshandler #'posframe-poshandler-point-bottom-left-corner-upward - :height 10 - :width 60 - :border-width 1 - :min-width 60) - "Params for signature and `posframe-show'.") - -(defun lsp-signature-posframe (str) - "Use posframe to show the STR signatureHelp string." - (if str - (apply #'posframe-show - (with-current-buffer (get-buffer-create " *lsp-signature*") - (erase-buffer) - (insert str) - (visual-line-mode 1) - (lsp--setup-page-break-mode-if-present) - (current-buffer)) - (append - lsp-signature-posframe-params - (list :position (point) - :background-color (face-attribute 'lsp-signature-posframe :background nil t) - :foreground-color (face-attribute 'lsp-signature-posframe :foreground nil t) - :border-color (face-attribute '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))) - - - -(defun lsp--action-trigger-parameter-hints (_command) - "Handler for editor.action.triggerParameterHints." - (when (member :on-server-request lsp-signature-auto-activate) - (lsp-signature-activate))) - -(defun lsp--action-trigger-suggest (_command) - "Handler for editor.action.triggerSuggest." - (cond - ((and (bound-and-true-p company-mode) - (fboundp 'company-auto-begin) - (fboundp 'company-post-command)) - (run-at-time 0 nil - (lambda () - (let ((this-command 'company-idle-begin) - (company-minimum-prefix-length 0)) - (company-auto-begin) - (company-post-command))))) - (t - (completion-at-point)))) - -(defconst lsp--default-action-handlers - (ht ("editor.action.triggerParameterHints" #'lsp--action-trigger-parameter-hints) - ("editor.action.triggerSuggest" #'lsp--action-trigger-suggest)) - "Default action handlers.") - -(defun lsp--find-action-handler (command) - "Find action handler for particular COMMAND." - (or - (--some (-some->> it - (lsp--workspace-client) - (lsp--client-action-handlers) - (gethash command)) - (lsp-workspaces)) - (gethash command lsp--default-action-handlers))) - -(defun lsp--text-document-code-action-params (&optional kind) - "Code action params." - (list :textDocument (lsp--text-document-identifier) - :range (if (use-region-p) - (lsp--region-to-range (region-beginning) (region-end)) - (lsp--region-to-range (point) (point))) - :context `( :diagnostics ,(lsp-cur-possition-diagnostics) - ,@(when kind (list :only (vector kind)))))) - -(defun lsp-code-actions-at-point (&optional kind) - "Retrieve the code actions for the active region or the current line. -It will filter by KIND if non nil." - (lsp-request "textDocument/codeAction" (lsp--text-document-code-action-params kind))) - -(defun lsp-execute-code-action-by-kind (command-kind) - "Execute code action by COMMAND-KIND." - (if-let ((action (->> (lsp-get-or-calculate-code-actions command-kind) - (-filter (-lambda ((&CodeAction :kind?)) - (and kind? (s-prefix? command-kind kind?)))) - lsp--select-action))) - (lsp-execute-code-action action) - (signal 'lsp-no-code-actions '(command-kind)))) - -(defalias 'lsp-get-or-calculate-code-actions 'lsp-code-actions-at-point) - -(lsp-defun lsp--execute-command ((action &as &Command :command :arguments?)) - "Parse and execute a code ACTION represented as a Command LSP type." - (let ((server-id (->> (lsp-workspaces) - (cl-first) - (or lsp--cur-workspace) - (lsp--workspace-client) - (lsp--client-server-id)))) - (condition-case nil - (with-no-warnings - (lsp-execute-command server-id (intern command) arguments?)) - (cl-no-applicable-method - (if-let ((action-handler (lsp--find-action-handler command))) - (funcall action-handler action) - (lsp-send-execute-command command arguments?)))))) - -(lsp-defun lsp-execute-code-action ((action &as &CodeAction :command? :edit?)) - "Execute code action ACTION. For example, when text under the -caret has a suggestion to apply a fix from an lsp-server, calling -this function will do so. -If ACTION is not set it will be selected from `lsp-code-actions-at-point'. -Request codeAction/resolve for more info if server supports." - (interactive (list (lsp--select-action (lsp-code-actions-at-point)))) - (if (and (lsp-feature? "codeAction/resolve") - (not command?) - (not edit?)) - (lsp--execute-code-action (lsp-request "codeAction/resolve" action)) - (lsp--execute-code-action action))) - -(lsp-defun lsp--execute-code-action ((action &as &CodeAction :command? :edit?)) - "Execute code action ACTION." - (when edit? - (lsp--apply-workspace-edit edit? 'code-action)) - - (cond - ((stringp command?) (lsp--execute-command action)) - ((lsp-command? command?) (progn - (when-let ((action-filter (->> (lsp-workspaces) - (cl-first) - (or lsp--cur-workspace) - (lsp--workspace-client) - (lsp--client-action-filter)))) - (funcall action-filter command?)) - (lsp--execute-command command?))))) - -(lsp-defun lsp-fix-code-action-booleans ((&Command :arguments?) boolean-action-arguments) - "Patch incorrect boolean argument values in the provided `CodeAction' command -in place, based on the BOOLEAN-ACTION-ARGUMENTS list. The values -in this list can be either symbols or lists of symbols that -represent paths to boolean arguments in code actions: - -> (lsp-fix-code-action-booleans command `(:foo :bar (:some :nested :boolean))) - -When there are available code actions, the server sends -`lsp-mode' a list of possible command names and arguments as -JSON. `lsp-mode' parses all boolean false values as `nil'. As a -result code action arguments containing falsy values don't -roundtrip correctly because `lsp-mode' will end up sending null -values back to the client. This list makes it possible to -selectively transform `nil' values back into `:json-false'." - (seq-doseq (path boolean-action-arguments) - (seq-doseq (args arguments?) - (lsp--fix-nested-boolean args (if (listp path) path (list path)))))) - -(defun lsp--fix-nested-boolean (structure path) - "Traverse STRUCTURE using the paths from the PATH list, changing the value to -`:json-false' if it was `nil'. PATH should be a list containing -one or more symbols, and STRUCTURE should be compatible with -`lsp-member?', `lsp-get', and `lsp-put'." - (let ((key (car path)) - (rest (cdr path))) - (if (null rest) - ;; `lsp-put' returns `nil' both when the key doesn't exist and when the - ;; value is `nil', so we need to explicitly check its presence here - (when (and (lsp-member? structure key) (not (lsp-get structure key))) - (lsp-put structure key :json-false)) - ;; If `key' does not exist, then we'll silently ignore it - (when-let ((child (lsp-get structure key))) - (lsp--fix-nested-boolean child rest))))) - -(defvar lsp--formatting-indent-alist - ;; Taken from `dtrt-indent-mode' - '( - (ada-mode . ada-indent) ; Ada - (ada-ts-mode . ada-ts-mode-indent-offset) - (c++-mode . c-basic-offset) ; C++ - (c++-ts-mode . c-ts-mode-indent-offset) - (c-mode . c-basic-offset) ; C - (c-ts-mode . c-ts-mode-indent-offset) - (cperl-mode . cperl-indent-level) ; Perl - (crystal-mode . crystal-indent-level) ; Crystal (Ruby) - (csharp-mode . c-basic-offset) ; C# - (csharp-tree-sitter-mode . csharp-tree-sitter-indent-offset) ; C# - (csharp-ts-mode . csharp-ts-mode-indent-offset) ; C# (tree-sitter, Emacs29) - (css-mode . css-indent-offset) ; CSS - (d-mode . c-basic-offset) ; D - (enh-ruby-mode . enh-ruby-indent-level) ; Ruby - (erlang-mode . erlang-indent-level) ; Erlang - (ess-mode . ess-indent-offset) ; ESS (R) - (go-ts-mode . go-ts-mode-indent-offset) - (gpr-mode . gpr-indent-offset) ; GNAT Project - (gpr-ts-mode . gpr-ts-mode-indent-offset) - (hack-mode . hack-indent-offset) ; Hack - (java-mode . c-basic-offset) ; Java - (java-ts-mode . java-ts-mode-indent-offset) - (jde-mode . c-basic-offset) ; Java (JDE) - (js-mode . js-indent-level) ; JavaScript - (js-ts-mode . js-indent-level) - (js2-mode . js2-basic-offset) ; JavaScript-IDE - (js3-mode . js3-indent-level) ; JavaScript-IDE - (json-mode . js-indent-level) ; JSON - (json-ts-mode . json-ts-mode-indent-offset) - (lua-mode . lua-indent-level) ; Lua - (lua-ts-mode . lua-ts-indent-offset) - (nxml-mode . nxml-child-indent) ; XML - (objc-mode . c-basic-offset) ; Objective C - (pascal-mode . pascal-indent-level) ; Pascal - (perl-mode . perl-indent-level) ; Perl - (php-mode . c-basic-offset) ; PHP - (php-ts-mode . php-ts-mode-indent-offset) ; PHP - (powershell-mode . powershell-indent) ; PowerShell - (powershell-ts-mode . powershell-ts-mode-indent-offset) ; PowerShell - (raku-mode . raku-indent-offset) ; Perl6/Raku - (ruby-mode . ruby-indent-level) ; Ruby - (rust-mode . rust-indent-offset) ; Rust - (rust-ts-mode . rust-ts-mode-indent-offset) - (rustic-mode . rustic-indent-offset) ; Rust - (scala-mode . scala-indent:step) ; Scala - (sgml-mode . sgml-basic-offset) ; SGML - (sh-mode . sh-basic-offset) ; Shell Script - (toml-ts-mode . toml-ts-mode-indent-offset) - (typescript-mode . typescript-indent-level) ; Typescript - (typescript-ts-mode . typescript-ts-mode-indent-offset) ; Typescript (tree-sitter, Emacs29) - (yaml-mode . yaml-indent-offset) ; YAML - (yang-mode . c-basic-offset) ; YANG (yang-mode) - - (default . standard-indent)) ; default fallback - "A mapping from `major-mode' to its indent variable.") - -(defun lsp--get-indent-width (mode) - "Get indentation offset for MODE." - (or (alist-get mode lsp--formatting-indent-alist) - (lsp--get-indent-width (or (get mode 'derived-mode-parent) 'default)))) - -(defun lsp--make-document-formatting-params () - "Create document formatting params." - (lsp-make-document-formatting-params - :text-document (lsp--text-document-identifier) - :options (lsp-make-formatting-options - :tab-size (symbol-value (lsp--get-indent-width major-mode)) - :insert-spaces (lsp-json-bool (not indent-tabs-mode)) - :trim-trailing-whitespace? (lsp-json-bool lsp-trim-trailing-whitespace) - :insert-final-newline? (lsp-json-bool lsp-insert-final-newline) - :trim-final-newlines? (lsp-json-bool lsp-trim-final-newlines)))) - -(defun lsp-format-buffer () - "Ask the server to format this document." - (interactive "*") - (cond ((lsp-feature? "textDocument/formatting") - (let ((edits (lsp-request "textDocument/formatting" - (lsp--make-document-formatting-params)))) - (if (seq-empty-p edits) - (lsp--info "No formatting changes provided") - (lsp--apply-text-edits edits 'format)))) - ((lsp-feature? "textDocument/rangeFormatting") - (save-restriction - (widen) - (lsp-format-region (point-min) (point-max)))) - (t (signal 'lsp-capability-not-supported (list "documentFormattingProvider"))))) - -(defun lsp-format-region (s e) - "Ask the server to format the region, or if none is selected, the current line." - (interactive "r") - (let ((edits (lsp-request - "textDocument/rangeFormatting" - (lsp--make-document-range-formatting-params s e)))) - (if (seq-empty-p edits) - (lsp--info "No formatting changes provided") - (lsp--apply-text-edits edits 'format)))) - -(defmacro lsp-make-interactive-code-action (func-name code-action-kind) - "Define an interactive function FUNC-NAME that attempts to -execute a CODE-ACTION-KIND action." - `(defun ,(intern (concat "lsp-" (symbol-name func-name))) () - ,(format "Perform the %s code action, if available." code-action-kind) - (interactive) - ;; Even when `lsp-auto-execute-action' is nil, it still makes sense to - ;; auto-execute here: the user has specified exactly what they want. - (let ((lsp-auto-execute-action t)) - (condition-case nil - (lsp-execute-code-action-by-kind ,code-action-kind) - (lsp-no-code-actions - (when (called-interactively-p 'any) - (lsp--info ,(format "%s action not available" code-action-kind)))))))) - -(lsp-make-interactive-code-action organize-imports "source.organizeImports") - -(defun lsp--make-document-range-formatting-params (start end) - "Make DocumentRangeFormattingParams for selected region." - (lsp:set-document-range-formatting-params-range (lsp--make-document-formatting-params) - (lsp--region-to-range start end))) - -(defconst lsp--highlight-kind-face - '((1 . lsp-face-highlight-textual) - (2 . lsp-face-highlight-read) - (3 . lsp-face-highlight-write))) - -(defun lsp--remove-overlays (name) - (save-restriction - (widen) - (remove-overlays (point-min) (point-max) name t))) - -(defun lsp-document-highlight () - "Highlight all relevant references to the symbol under point." - (interactive) - (lsp--remove-overlays 'lsp-highlight) ;; clear any previous highlights - (setq lsp--have-document-highlights nil - lsp--symbol-bounds-of-last-highlight-invocation nil) - (let ((lsp-enable-symbol-highlighting t)) - (lsp--document-highlight))) - -(defun lsp--document-highlight-callback (highlights) - "Create a callback to process the reply of a -`textDocument/documentHighlight' message for the buffer BUF. -A reference is highlighted only if it is visible in a window." - (lsp--remove-overlays 'lsp-highlight) - - (let* ((wins-visible-pos (-map (lambda (win) - (cons (1- (line-number-at-pos (window-start win) t)) - (1+ (line-number-at-pos (window-end win) t)))) - (get-buffer-window-list nil nil 'visible)))) - (setq lsp--have-document-highlights t) - (-map - (-lambda ((&DocumentHighlight :range (&Range :start (start &as &Position :line start-line) - :end (end &as &Position :line end-line)) - :kind?)) - (-map - (-lambda ((start-window . end-window)) - ;; Make the overlay only if the reference is visible - (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 - :cancel-token :document-symbols) - lsp--document-symbols)))) - -(advice-add 'imenu-update-menubar :around - (lambda (oldfun &rest r) - (let ((lsp--document-symbols-request-async t)) - (apply oldfun r)))) - -(defun lsp--document-symbols->document-symbols-hierarchy (document-symbols current-position) - "Convert DOCUMENT-SYMBOLS to symbols hierarchy on CURRENT-POSITION." - (-let (((symbol &as &DocumentSymbol? :children?) - (seq-find (-lambda ((&DocumentSymbol :range)) - (lsp-point-in-range? current-position range)) - document-symbols))) - (if children? - (cons symbol (lsp--document-symbols->document-symbols-hierarchy children? current-position)) - (when symbol - (list symbol))))) - -(lsp-defun lsp--symbol-information->document-symbol ((&SymbolInformation :name :kind :location :container-name? :deprecated?)) - "Convert a SymbolInformation to a DocumentInformation" - (lsp-make-document-symbol :name name - :kind kind - :range (lsp:location-range location) - :children? nil - :deprecated? deprecated? - :selection-range (lsp:location-range location) - :detail? container-name?)) - -(defun lsp--symbols-informations->document-symbols-hierarchy (symbols-informations current-position) - "Convert SYMBOLS-INFORMATIONS to symbols hierarchy on CURRENT-POSITION." - (--> symbols-informations - (-keep (-lambda ((symbol &as &SymbolInformation :location (&Location :range))) - (when (lsp-point-in-range? current-position range) - (lsp--symbol-information->document-symbol symbol))) - it) - (sort it (-lambda ((&DocumentSymbol :range (&Range :start a-start-position :end a-end-position)) - (&DocumentSymbol :range (&Range :start b-start-position :end b-end-position))) - (and (lsp--position-compare b-start-position a-start-position) - (lsp--position-compare a-end-position b-end-position)))))) - -(defun lsp--symbols->document-symbols-hierarchy (symbols) - "Convert SYMBOLS to symbols-hierarchy." - (when-let ((first-symbol (lsp-seq-first symbols))) - (let ((cur-position (lsp-make-position :line (plist-get (lsp--cur-position) :line) - :character (plist-get (lsp--cur-position) :character)))) - (if (lsp-symbol-information? first-symbol) - (lsp--symbols-informations->document-symbols-hierarchy symbols cur-position) - (lsp--document-symbols->document-symbols-hierarchy symbols cur-position))))) - -(defun lsp--xref-backend () 'xref-lsp) - -(cl-defmethod xref-backend-identifier-at-point ((_backend (eql xref-lsp))) - (propertize (or (thing-at-point 'symbol) "") - 'identifier-at-point t)) - -(defun lsp--xref-elements-index (symbols path) - (-mapcat - (-lambda (sym) - (pcase-exhaustive sym - ((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 nil lsp-references-exclude-definition))))) - -(cl-defmethod xref-backend-apropos ((_backend (eql xref-lsp)) pattern) - (seq-map #'lsp--symbol-information-to-xref - (lsp-request "workspace/symbol" `(:query ,pattern)))) - -(defcustom lsp-rename-use-prepare t - "Whether `lsp-rename' should do a prepareRename first. -For some language servers, textDocument/prepareRename might be -too slow, in which case this variable may be set to nil. -`lsp-rename' will then use `thing-at-point' `symbol' to determine -the symbol to rename at point." - :group 'lsp-mode - :type 'boolean) - -(defun lsp--get-symbol-to-rename () - "Get a symbol to rename and placeholder at point. -Returns a cons ((START . END) . PLACEHOLDER?), and nil if -renaming is generally supported but cannot be done at point. -START and END are the bounds of the identifiers being renamed, -while PLACEHOLDER?, is either nil or a string suggested by the -language server as the initial input of a new-name prompt." - (unless (lsp-feature? "textDocument/rename") - (error "The connected server(s) doesn't support renaming")) - (if (and lsp-rename-use-prepare (lsp-feature? "textDocument/prepareRename")) - (when-let ((response - (lsp-request "textDocument/prepareRename" - (lsp--text-document-position-params)))) - (let* ((bounds (lsp--range-to-region - (if (lsp-range? response) - response - (lsp:prepare-rename-result-range response)))) - (placeholder - (and (not (lsp-range? response)) - (lsp:prepare-rename-result-placeholder response)))) - (cons bounds placeholder))) - (when-let ((bounds (bounds-of-thing-at-point 'symbol))) - (cons bounds nil)))) - -(defface lsp-face-rename '((t :underline t)) - "Face used to highlight the identifier being renamed. -Renaming can be done using `lsp-rename'." - :group 'lsp-mode) - -(defface lsp-rename-placeholder-face '((t :inherit font-lock-variable-name-face)) - "Face used to display the rename placeholder in. -When calling `lsp-rename' interactively, this will be the face of -the new name." - :group 'lsp-mode) - -(defvar lsp-rename-history '() - "History for `lsp--read-rename'.") - -(defun lsp--read-rename (at-point) - "Read a new name for a `lsp-rename' at `point' from the user. -AT-POINT shall be a structure as returned by -`lsp--get-symbol-to-rename'. - -Returns a string, which should be the new name for the identifier -at point. If renaming cannot be done at point (as determined from -AT-POINT), throw a `user-error'. - -This function is for use in `lsp-rename' only, and shall not be -relied upon." - (unless at-point - (user-error "`lsp-rename' is invalid here")) - (-let* ((((start . end) . placeholder?) at-point) - ;; Do the `buffer-substring' first to not include `lsp-face-rename' - (rename-me (buffer-substring start end)) - (placeholder (or placeholder? rename-me)) - (placeholder (propertize placeholder 'face 'lsp-rename-placeholder-face)) - - overlay) - ;; We need unwind protect, as the user might cancel here, causing the - ;; overlay to linger. - (unwind-protect - (progn - (setq overlay (make-overlay start end)) - (overlay-put overlay 'face 'lsp-face-rename) - - (read-string (format "Rename %s to: " rename-me) placeholder - 'lsp-rename-history)) - (and overlay (delete-overlay overlay))))) - -(defun lsp-rename (newname) - "Rename the symbol (and all references to it) under point to NEWNAME." - (interactive (list (lsp--read-rename (lsp--get-symbol-to-rename)))) - (when-let ((edits (lsp-request "textDocument/rename" - `( :textDocument ,(lsp--text-document-identifier) - :position ,(lsp--cur-position) - :newName ,newname)))) - (lsp--apply-workspace-edit edits 'rename))) - -(defun lsp--on-rename-file (old-func old-name new-name &optional ok-if-already-exists?) - "Advice around function `rename-file'. -Applies OLD-FUNC with OLD-NAME, NEW-NAME and OK-IF-ALREADY-EXISTS?. - -This advice sends workspace/willRenameFiles before renaming file -to check if server wants to apply any workspaceEdits after renamed." - (if (and lsp-apply-edits-after-file-operations - (lsp--send-will-rename-files-p old-name)) - (let ((params (lsp-make-rename-files-params - :files (vector (lsp-make-file-rename - :oldUri (lsp--path-to-uri old-name) - :newUri (lsp--path-to-uri new-name)))))) - (when-let ((edits (lsp-request "workspace/willRenameFiles" params))) - (lsp--apply-workspace-edit edits 'rename-file) - (funcall old-func old-name new-name ok-if-already-exists?) - (when (lsp--send-did-rename-files-p) - (lsp-notify "workspace/didRenameFiles" params)))) - (funcall old-func old-name new-name ok-if-already-exists?))) - -(advice-add 'rename-file :around #'lsp--on-rename-file) - -(defcustom lsp-xref-force-references nil - "If non-nil threat everything as references(e. g. jump if only one item.)" - :group 'lsp-mode - :type 'boolean) - -(defun lsp-show-xrefs (xrefs display-action references?) - (unless (region-active-p) (push-mark nil t)) - (if (boundp 'xref-show-definitions-function) - (with-no-warnings - (xref-push-marker-stack) - (funcall (if (and references? (not lsp-xref-force-references)) - xref-show-xrefs-function - xref-show-definitions-function) - (-const xrefs) - `((window . ,(selected-window)) - (display-action . ,display-action) - ,(if (and references? (not lsp-xref-force-references)) - `(auto-jump . ,xref-auto-jump-to-first-xref) - `(auto-jump . ,xref-auto-jump-to-first-definition))))) - (xref--show-xrefs xrefs display-action))) - -(cl-defmethod seq-empty-p ((ht hash-table)) - "Function `seq-empty-p' for hash-table." - (hash-table-empty-p ht)) - -(cl-defun lsp-find-locations (method &optional extra &key display-action references?) - "Send request named METHOD and get cross references of the symbol under point. -EXTRA is a plist of extra parameters. -REFERENCES? t when METHOD returns references." - (let ((loc (lsp-request method - (append (lsp--text-document-position-params) extra)))) - (if (seq-empty-p loc) - (lsp--error "Not found for: %s" (or (thing-at-point 'symbol t) "")) - (lsp-show-xrefs (lsp--locations-to-xref-items loc) display-action references?)))) - -(cl-defun lsp-find-declaration (&key display-action) - "Find declarations of the symbol under point." - (interactive) - (lsp-find-locations "textDocument/declaration" nil :display-action display-action)) - -(cl-defun lsp-find-definition (&key display-action) - "Find definitions of the symbol under point." - (interactive) - (lsp-find-locations "textDocument/definition" nil :display-action display-action)) - -(defun lsp-find-definition-mouse (click) - "Click to start `lsp-find-definition' at clicked point." - (interactive "e") - (let* ((ec (event-start click)) - (p1 (posn-point ec)) - (w1 (posn-window ec))) - (select-window w1) - (goto-char p1) - (lsp-find-definition))) - -(cl-defun lsp-find-implementation (&key display-action) - "Find implementations of the symbol under point." - (interactive) - (lsp-find-locations "textDocument/implementation" - nil - :display-action display-action - :references? t)) - -(cl-defun lsp-find-references (&optional exclude-declaration &key display-action) - "Find references of the symbol under point." - (interactive "P") - (lsp-find-locations "textDocument/references" - (list :context `(:includeDeclaration ,(lsp-json-bool (not (or exclude-declaration lsp-references-exclude-definition))))) - :display-action display-action - :references? t)) - -(cl-defun lsp-find-type-definition (&key display-action) - "Find type definitions of the symbol under point." - (interactive) - (lsp-find-locations "textDocument/typeDefinition" nil :display-action display-action)) - -(defalias 'lsp-find-custom #'lsp-find-locations) -(defalias 'lsp-goto-implementation #'lsp-find-implementation) -(defalias 'lsp-goto-type-definition #'lsp-find-type-definition) - -(with-eval-after-load 'evil - (evil-set-command-property 'lsp-find-definition :jump t) - (evil-set-command-property 'lsp-find-implementation :jump t) - (evil-set-command-property 'lsp-find-references :jump t) - (evil-set-command-property 'lsp-find-type-definition :jump t)) - -(defun lsp--workspace-method-supported? (check-command method capability workspace) - (with-lsp-workspace workspace - (if check-command - (funcall check-command workspace) - (or - (when capability (lsp--capability capability)) - (lsp--registered-capability method) - (and (not capability) (not check-command)))))) - -(defun lsp-disable-method-for-server (method server-id) - "Disable METHOD for SERVER-ID." - (cl-callf - (lambda (reqs) - (-let (((&plist :check-command :capability) reqs)) - (list :check-command - (lambda (workspace) - (unless (-> workspace - lsp--workspace-client - lsp--client-server-id - (eq server-id)) - (lsp--workspace-method-supported? check-command - method - capability - workspace)))))) - (alist-get method lsp-method-requirements nil nil 'string=))) - -(defun lsp--find-workspaces-for (msg-or-method) - "Find all workspaces in the current project that can handle MSG." - (let ((method (if (stringp msg-or-method) - msg-or-method - (plist-get msg-or-method :method)))) - (-if-let (reqs (cdr (assoc method lsp-method-requirements))) - (-let (((&plist :capability :check-command) reqs)) - (-filter - (-partial #'lsp--workspace-method-supported? - check-command method capability) - (lsp-workspaces))) - (lsp-workspaces)))) - -(defun lsp-can-execute-command? (command-name) - "Returns non-nil if current language server(s) can execute COMMAND-NAME. -The command is executed via `workspace/executeCommand'" - (cl-position - command-name - (lsp:execute-command-options-commands - (lsp:server-capabilities-execute-command-provider? - (lsp--server-capabilities))) - :test #'equal)) - -(defalias 'lsp-feature? 'lsp--find-workspaces-for) - -(cl-defmethod lsp-execute-command (_server _command _arguments) - "Dispatch COMMAND execution." - (signal 'cl-no-applicable-method nil)) - -(defun lsp-workspace-command-execute (command &optional args) - "Execute workspace COMMAND with ARGS." - (condition-case-unless-debug err - (let ((params (if args - (list :command command :arguments args) - (list :command command)))) - (lsp-request "workspace/executeCommand" params)) - (error - (error "`workspace/executeCommand' with `%s' failed.\n\n%S" - command err)))) - -(defun lsp-send-execute-command (command &optional args) - "Create and send a `workspace/executeCommand' message having command COMMAND -and optional ARGS." - (lsp-workspace-command-execute command args)) - -(defalias 'lsp-point-to-position #'lsp--point-to-position) -(defalias 'lsp-text-document-identifier #'lsp--text-document-identifier) -(defalias 'lsp--send-execute-command #'lsp-send-execute-command) -(defalias 'lsp-on-open #'lsp--text-document-did-open) -(defalias 'lsp-on-save #'lsp--text-document-did-save) - -(defun lsp--set-configuration (settings) - "Set the SETTINGS for the lsp server." - (lsp-notify "workspace/didChangeConfiguration" `(:settings ,settings))) - -(defun lsp-current-buffer () - (or lsp--virtual-buffer - (current-buffer))) - -(defun lsp-buffer-live-p (buffer-id) - (if-let ((buffer-live (plist-get buffer-id :buffer-live?))) - (funcall buffer-live buffer-id) - (buffer-live-p buffer-id))) - -(defun lsp--on-set-visited-file-name (old-func &rest args) - "Advice around function `set-visited-file-name'. - -This advice sends textDocument/didClose for the old file and -textDocument/didOpen for the new file." - (when lsp--cur-workspace - (lsp--text-document-did-close t)) - (prog1 (apply old-func args) - (when lsp--cur-workspace - (lsp--text-document-did-open)))) - -(advice-add 'set-visited-file-name :around #'lsp--on-set-visited-file-name) - -(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))) - (lsp-process-send proc message)) - -(define-error 'lsp-parse-error - "Error parsing message from language server" 'lsp-error) -(define-error 'lsp-unknown-message-type - "Unknown message type" '(lsp-error lsp-parse-error)) -(define-error 'lsp-unknown-json-rpc-version - "Unknown JSON-RPC protocol version" '(lsp-error lsp-parse-error)) -(define-error 'lsp-no-content-length - "Content-Length header missing in message" '(lsp-error lsp-parse-error)) -(define-error 'lsp-invalid-header-name - "Invalid header name" '(lsp-error lsp-parse-error)) - -;; id method -;; x x request -;; x . response -;; . x notification -(defun lsp--get-message-type (json-data) - "Get the message type from JSON-DATA." - (if (lsp:json-message-id? json-data) - (if (lsp:json-message-error? json-data) - 'response-error - (if (lsp:json-message-method? json-data) - 'request - 'response)) - 'notification)) - -(defconst lsp--default-notification-handlers - (ht ("window/showMessage" #'lsp--window-show-message) - ("window/logMessage" #'lsp--window-log-message) - ("window/showInputBox" #'lsp--window-show-input-box) - ("window/showQuickPick" #'lsp--window-show-quick-pick) - ("textDocument/publishDiagnostics" #'lsp--on-diagnostics) - ("textDocument/diagnosticsEnd" #'ignore) - ("textDocument/diagnosticsBegin" #'ignore) - ("telemetry/event" #'ignore) - ("$/progress" (lambda (workspace params) - (funcall lsp-progress-function workspace params))))) - -(lsp-defun lsp--on-notification (workspace (&JSONNotification :params :method)) - "Call the appropriate handler for NOTIFICATION." - (-let ((client (lsp--workspace-client workspace))) - (when (lsp--log-io-p method) - (lsp--log-entry-new (lsp--make-log-entry method nil params 'incoming-notif) - lsp--cur-workspace)) - (if-let ((handler (or (gethash method (lsp--client-notification-handlers client)) - (gethash method lsp--default-notification-handlers)))) - (funcall handler workspace params) - (when (and method (not (string-prefix-p "$" method))) - (lsp-warn "Unknown notification: %s" method))))) - -(lsp-defun lsp--build-workspace-configuration-response ((&ConfigurationParams :items)) - "Get section configuration. -PARAMS are the `workspace/configuration' request params" - (->> items - (-map (-lambda ((&ConfigurationItem :section?)) - (-let* ((path-parts (split-string section? "\\.")) - (path-without-last (s-join "." (-slice path-parts 0 -1))) - (path-parts-len (length path-parts))) - (cond - ((<= path-parts-len 1) - (ht-get (lsp-configuration-section section?) - (car-safe path-parts) - (ht-create))) - ((> path-parts-len 1) - (when-let ((section (lsp-configuration-section path-without-last)) - (keys path-parts)) - (while (and keys section) - (setf section (ht-get section (pop keys)))) - section)))))) - (apply #'vector))) - -(defun lsp--ms-since (timestamp) - "Integer number of milliseconds since TIMESTAMP. Fractions discarded." - (floor (* 1000 (float-time (time-since timestamp))))) - -(defun lsp--send-request-response (workspace recv-time request response) - "Send the RESPONSE for REQUEST in WORKSPACE and log if needed." - (-let* (((&JSONResponse :params :method :id) request) - (process (lsp--workspace-proc workspace)) - (response (lsp--make-response id response)) - (req-entry (and lsp-log-io - (lsp--make-log-entry method id params 'incoming-req))) - (resp-entry (and lsp-log-io - (lsp--make-log-entry method id response 'outgoing-resp - (lsp--ms-since recv-time))))) - ;; Send response to the server. - (when (lsp--log-io-p method) - (lsp--log-entry-new req-entry workspace) - (lsp--log-entry-new resp-entry workspace)) - (lsp--send-no-wait response process))) - -(lsp-defun lsp--on-request (workspace (request &as &JSONRequest :params :method)) - "Call the appropriate handler for REQUEST, and send the return value to the -server. WORKSPACE is the active workspace." - (-let* ((recv-time (current-time)) - (client (lsp--workspace-client workspace)) - (buffers (lsp--workspace-buffers workspace)) - handler - (response (cond - ((setq handler (gethash method (lsp--client-request-handlers client) nil)) - (funcall handler workspace params)) - ((setq handler (gethash method (lsp--client-async-request-handlers client) nil)) - (funcall handler workspace params - (-partial #'lsp--send-request-response - workspace recv-time request)) - 'delay-response) - ((equal method "client/registerCapability") - (mapc #'lsp--server-register-capability - (lsp:registration-params-registrations params)) - (mapc (lambda (buf) - (when (lsp-buffer-live-p buf) - (lsp-with-current-buffer buf - (lsp-unconfig-buffer) - (lsp-configure-buffer)))) - buffers) - nil) - ((equal method "window/showMessageRequest") - (let ((choice (lsp--window-log-message-request params))) - `(:title ,choice))) - ((equal method "window/showDocument") - (let ((success? (lsp--window-show-document params))) - (lsp-make-show-document-result :success (or success? - :json-false)))) - ((equal method "client/unregisterCapability") - (mapc #'lsp--server-unregister-capability - (lsp:unregistration-params-unregisterations params)) - (mapc (lambda (buf) - (when (lsp-buffer-live-p buf) - (lsp-with-current-buffer buf - (lsp-unconfig-buffer) - (lsp-configure-buffer)))) - buffers) - nil) - ((equal method "workspace/applyEdit") - (list :applied (condition-case err - (prog1 t - (lsp--apply-workspace-edit (lsp:apply-workspace-edit-params-edit params) 'server-requested)) - (error - (lsp--error "Failed to apply edits with message %s" - (error-message-string err)) - :json-false)))) - ((equal method "workspace/configuration") - (with-lsp-workspace workspace - (if-let ((buf (car buffers))) - (lsp-with-current-buffer buf - (lsp--build-workspace-configuration-response params)) - (lsp--with-workspace-temp-buffer (lsp--workspace-root workspace) - (lsp--build-workspace-configuration-response params))))) - ((equal method "workspace/workspaceFolders") - (let ((folders (or (-> workspace - (lsp--workspace-client) - (lsp--client-server-id) - (gethash (lsp-session-server-id->folders (lsp-session)))) - (lsp-session-folders (lsp-session))))) - (->> folders - (-distinct) - (-map (lambda (folder) - (list :uri (lsp--path-to-uri folder)))) - (apply #'vector)))) - ((equal method "window/workDoneProgress/create") - nil ;; no specific reply, no processing required - ) - ((equal method "workspace/semanticTokens/refresh") - (when (and lsp-semantic-tokens-enable - (fboundp 'lsp--semantic-tokens-on-refresh)) - (lsp--semantic-tokens-on-refresh workspace)) - nil) - ((equal method "workspace/codeLens/refresh") - (when (and lsp-lens-enable - (fboundp 'lsp--lens-on-refresh)) - (lsp--lens-on-refresh workspace)) - nil) - (t (lsp-warn "Unknown request method: %s" method) nil)))) - ;; Send response to the server. - (unless (eq response 'delay-response) - (lsp--send-request-response workspace recv-time request response)))) - -(lsp-defun lsp--error-string ((&JSONError :message :code)) - "Format ERR as a user friendly string." - (format "Error from the Language Server: %s (%s)" - message - (or (car (alist-get code lsp--errors)) "Unknown error"))) - -(defun lsp--get-body-length (headers) - (let ((content-length (cdr (assoc "Content-Length" headers)))) - (if content-length - (string-to-number content-length) - - ;; This usually means either the server or our parser is - ;; screwed up with a previous Content-Length - (error "No Content-Length header")))) - -(defun lsp--parse-header (s) - "Parse string S as a LSP (KEY . VAL) header." - (let ((pos (string-match "\:" s)) - key val) - (unless pos - (signal 'lsp-invalid-header-name (list s))) - (setq key (substring s 0 pos) - val (s-trim-left (substring s (+ 1 pos)))) - (when (equal key "Content-Length") - (cl-assert (cl-loop for c across val - when (or (> c ?9) (< c ?0)) return nil - finally return t) - nil (format "Invalid Content-Length value: %s" val))) - (cons key val))) - -(defmacro lsp--read-json (str) - "Read json string STR." - (if (progn - (require 'json) - (fboundp 'json-parse-string)) - `(json-parse-string ,str - :object-type (if lsp-use-plists - 'plist - 'hash-table) - :null-object nil - :false-object nil) - `(let ((json-array-type 'vector) - (json-object-type (if lsp-use-plists - 'plist - 'hash-table)) - (json-false nil)) - (json-read-from-string ,str)))) - -(defmacro lsp-json-read-buffer () - "Read json from the current buffer." - (if (progn - (require 'json) - (fboundp 'json-parse-buffer)) - `(json-parse-buffer :object-type (if lsp-use-plists - 'plist - 'hash-table) - :null-object nil - :false-object nil) - `(let ((json-array-type 'vector) - (json-object-type (if lsp-use-plists - 'plist - 'hash-table)) - (json-false nil)) - (json-read)))) - -(defun lsp--read-json-file (file-path) - "Read json file." - (-> file-path - (f-read-text) - (lsp--read-json))) - -(defun lsp--parser-on-message (json-data workspace) - "Called when the parser P read a complete MSG from the server." - (with-demoted-errors "Error processing message %S." - (with-lsp-workspace workspace - (let* ((client (lsp--workspace-client workspace)) - (id (--when-let (lsp:json-response-id json-data) - (if (stringp it) (string-to-number it) it))) - (data (lsp:json-response-result json-data))) - (pcase (lsp--get-message-type json-data) - ('response - (cl-assert id) - (-let [(callback _ method _ before-send) (gethash id (lsp--client-response-handlers client))] - (when (lsp--log-io-p method) - (lsp--log-entry-new - (lsp--make-log-entry method id data 'incoming-resp - (lsp--ms-since before-send)) - workspace)) - (when callback - (remhash id (lsp--client-response-handlers client)) - (funcall callback (lsp:json-response-result json-data))))) - ('response-error - (cl-assert id) - (-let [(_ callback method _ before-send) (gethash id (lsp--client-response-handlers client))] - (when (lsp--log-io-p method) - (lsp--log-entry-new - (lsp--make-log-entry method id (lsp:json-response-error-error json-data) - 'incoming-resp (lsp--ms-since before-send)) - workspace)) - (when callback - (remhash id (lsp--client-response-handlers client)) - (funcall callback (lsp:json-response-error-error json-data))))) - ('notification - (lsp--on-notification workspace json-data)) - ('request (lsp--on-request workspace json-data))))))) - -(defun lsp--create-filter-function (workspace) - "Make filter for the workspace." - (let ((body-received 0) - leftovers body-length body chunk) - (lambda (_proc input) - (setf chunk (if (s-blank? leftovers) - 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) - -(defcustom lsp-imenu-hide-parent-details t - "Whether `lsp-imenu' should hide signatures of parent nodes." - :group 'lsp-imenu - :type 'boolean) - -(defface lsp-details-face '((t :height 0.8 :inherit shadow)) - "Used to display additional information throughout `lsp'. -Things like line numbers, signatures, ... are considered -additional information. Often, additional faces are defined that -inherit from this face by default, like `lsp-signature-face', and -they may be customized for finer control." - :group 'lsp-mode) - -(defface lsp-signature-face '((t :inherit lsp-details-face)) - "Used to display signatures in `imenu', ...." - :group 'lsp-mode) - -(lsp-defun lsp-render-symbol ((&DocumentSymbol :name :detail? :deprecated?) - show-detail?) - "Render INPUT0, an `&DocumentSymbol', to a string. -If SHOW-DETAIL? is set, make use of its `:detail?' field (often -the signature)." - (let ((detail (and show-detail? (s-present? detail?) - (propertize (concat " " (s-trim-left detail?)) - 'face 'lsp-signature-face))) - (name (if deprecated? - (propertize name 'face 'lsp-face-semhl-deprecated) name))) - (concat name detail))) - -(lsp-defun lsp-render-symbol-information ((&SymbolInformation :name :deprecated? :container-name?) - separator) - "Render a piece of SymbolInformation. -Handle :deprecated?. If SEPARATOR is non-nil, the -symbol's (optional) parent, SEPARATOR and the symbol itself are -concatenated." - (when (and separator container-name? (not (string-empty-p container-name?))) - (setq name (concat name separator container-name?))) - (if deprecated? (propertize name 'face 'lsp-face-semhl-deprecated) name)) - -(defun lsp--symbol-to-imenu-elem (sym) - "Convert SYM to imenu element. - -SYM is a SymbolInformation message. - -Return a cons cell (full-name . start-point)." - (let ((start-point (ht-get lsp--line-col-to-point-hash-table - (lsp--get-line-and-col sym)))) - (cons (lsp-render-symbol-information - sym (and lsp-imenu-show-container-name - lsp-imenu-container-name-separator)) - start-point))) - -(lsp-defun lsp--symbol-to-hierarchical-imenu-elem ((sym &as &DocumentSymbol :children?)) - "Convert SYM to hierarchical imenu elements. - -SYM is a DocumentSymbol message. - -Return cons cell (\"symbol-name (symbol-kind)\" . start-point) if -SYM doesn't have any children. Otherwise return a cons cell with -an alist - - (\"symbol-name\" . ((\"(symbol-kind)\" . start-point) - cons-cells-from-children))" - (let ((filtered-children (lsp--imenu-filter-symbols children?)) - (signature (lsp-render-symbol sym lsp-imenu-detailed-outline))) - (if (seq-empty-p filtered-children) - (cons signature - (ht-get lsp--line-col-to-point-hash-table - (lsp--get-line-and-col sym))) - (cons signature - (lsp--imenu-create-hierarchical-index filtered-children))))) - -(lsp-defun lsp--symbol-ignore ((&SymbolInformation :kind)) - "Determine if SYM is for the current document and is to be shown." - ;; It's a SymbolInformation or DocumentSymbol, which is always in the - ;; current buffer file. - (and lsp-imenu-index-symbol-kinds - (numberp kind) - (let ((clamped-kind (if (< 0 kind (length lsp/symbol-kind-lookup)) - kind - 0))) - (not (memql (aref lsp/symbol-kind-lookup clamped-kind) - lsp-imenu-index-symbol-kinds))))) - -(lsp-defun lsp--get-symbol-type ((&SymbolInformation :kind)) - "The string name of the kind of SYM." - (alist-get kind lsp-symbol-kinds "Other")) - -(defun lsp--get-line-and-col (sym) - "Obtain the line and column corresponding to SYM." - (-let* ((location (lsp:symbol-information-location sym)) - (name-range (or (and location (lsp:location-range location)) - (lsp:document-symbol-selection-range sym))) - ((&Range :start (&Position :line :character)) name-range)) - (cons line character))) - -(defun lsp--collect-lines-and-cols (symbols) - "Return a sorted list ((line . col) ...) of the locations of SYMBOLS." - (let ((stack (mapcar 'identity symbols)) - line-col-list) - (while stack - (let ((sym (pop stack))) - (push (lsp--get-line-and-col sym) line-col-list) - (unless (seq-empty-p (lsp:document-symbol-children? sym)) - (setf stack (nconc (lsp--imenu-filter-symbols (lsp:document-symbol-children? sym)) stack))))) - (-sort #'lsp--line-col-comparator line-col-list))) - -(defun lsp--convert-line-col-to-points-batch (line-col-list) - "Convert a sorted list of positions from line-column -representation to point representation." - (let ((line-col-to-point-map (ht-create)) - (inhibit-field-text-motion t) - (curr-line 0)) - (lsp-save-restriction-and-excursion - (goto-char (point-min)) - (cl-loop for (line . col) in line-col-list do - (forward-line (- line curr-line)) - (setq curr-line line) - (let ((line-end (line-end-position))) - (if (or (not col) (> col (- line-end (point)))) - (goto-char line-end) - (forward-char col))) - (ht-set! line-col-to-point-map (cons line col) (if imenu-use-markers - (point-marker) - (point))))) - line-col-to-point-map)) - -(cl-defun lsp--line-col-comparator ((l1 . c1) (l2 . c2)) - (or (< l1 l2) - (and (= l1 l2) - (cond ((and c1 c2) - (< c1 c2)) - (c1 t))))) - -(defun lsp-imenu-create-uncategorized-index (symbols) - "Create imenu index from document SYMBOLS. -This function, unlike `lsp-imenu-create-categorized-index', does -not categorize by type, but instead returns an `imenu' index -corresponding to the symbol hierarchy returned by the server -directly." - (let* ((lsp--line-col-to-point-hash-table (-> symbols - lsp--collect-lines-and-cols - lsp--convert-line-col-to-points-batch))) - (if (lsp--imenu-hierarchical-p symbols) - (lsp--imenu-create-hierarchical-index symbols) - (lsp--imenu-create-non-hierarchical-index symbols)))) - -(defcustom lsp-imenu-symbol-kinds - '((1 . "Files") - (2 . "Modules") - (3 . "Namespaces") - (4 . "Packages") - (5 . "Classes") - (6 . "Methods") - (7 . "Properties") - (8 . "Fields") - (9 . "Constructors") - (10 . "Enums") - (11 . "Interfaces") - (12 . "Functions") - (13 . "Variables") - (14 . "Constants") - (15 . "Strings") - (16 . "Numbers") - (17 . "Booleans") - (18 . "Arrays") - (19 . "Objects") - (20 . "Keys") - (21 . "Nulls") - (22 . "Enum Members") - (23 . "Structs") - (24 . "Events") - (25 . "Operators") - (26 . "Type Parameters")) - "`lsp-symbol-kinds', but only used by `imenu'. -A new variable is needed, as it is `imenu' convention to use -pluralized categories, which `lsp-symbol-kinds' doesn't. If the -non-pluralized names are preferred, this can be set to -`lsp-symbol-kinds'." - :type '(alist :key-type integer :value-type string)) - -(defun lsp--imenu-kind->name (kind) - (alist-get kind lsp-imenu-symbol-kinds "?")) - -(defun lsp-imenu-create-top-level-categorized-index (symbols) - "Create an `imenu' index categorizing SYMBOLS by type. -Only root symbols are categorized. - -See `lsp-symbol-kinds' to customize the category naming. SYMBOLS -shall be a list of DocumentSymbols or SymbolInformation." - (mapcan - (-lambda ((type . symbols)) - (let ((cat (lsp--imenu-kind->name type)) - (symbols (lsp-imenu-create-uncategorized-index symbols))) - ;; If there is no :kind (this is being defensive), or we couldn't look it - ;; up, just display the symbols inline, without categories. - (if cat (list (cons cat symbols)) symbols))) - (sort (seq-group-by #'lsp:document-symbol-kind symbols) - (-lambda ((kinda) (kindb)) (< kinda kindb))))) - -(lsp-defun lsp--symbol->imenu ((sym &as &DocumentSymbol :selection-range (&RangeToPoint :start))) - "Convert an `&DocumentSymbol' to an `imenu' entry." - (cons (lsp-render-symbol sym lsp-imenu-detailed-outline) start)) - -(defun lsp--imenu-create-categorized-index-1 (symbols) - "Returns an `imenu' index from SYMBOLS categorized by type. -The result looks like this: ((\"Variables\" . (...)))." - (->> - symbols - (mapcan - (-lambda ((sym &as &DocumentSymbol :kind :children?)) - (if (seq-empty-p children?) - (list (list kind (lsp--symbol->imenu sym))) - (let ((parent (lsp-render-symbol sym (and lsp-imenu-detailed-outline - (not lsp-imenu-hide-parent-details))))) - (cons - (list kind (lsp--symbol->imenu sym)) - (mapcar (-lambda ((type . imenu-items)) - (list type (cons parent (mapcan #'cdr imenu-items)))) - (-group-by #'car (lsp--imenu-create-categorized-index-1 children?)))))))) - (-group-by #'car) - (mapcar - (-lambda ((kind . syms)) - (cons kind (mapcan #'cdr syms)))))) - -(defun lsp--imenu-create-categorized-index (symbols) - (let ((syms (lsp--imenu-create-categorized-index-1 symbols))) - (dolist (sym syms) - (setcar sym (lsp--imenu-kind->name (car sym)))) - syms)) - -(lsp-defun lsp--symbol-information->imenu ((sym &as &SymbolInformation :location (&Location :range (&RangeToPoint :start)))) - (cons (lsp-render-symbol-information sym nil) start)) - -(defun lsp--imenu-create-categorized-index-flat (symbols) - "Create a kind-categorized index for SymbolInformation." - (mapcar (-lambda ((kind . syms)) - (cons (lsp--imenu-kind->name kind) - (mapcan (-lambda ((parent . children)) - (let ((children (mapcar #'lsp--symbol-information->imenu children))) - (if parent (list (cons parent children)) children))) - (-group-by #'lsp:symbol-information-container-name? syms)))) - (seq-group-by #'lsp:symbol-information-kind symbols))) - -(defun lsp-imenu-create-categorized-index (symbols) - (if (lsp--imenu-hierarchical-p symbols) - (lsp--imenu-create-categorized-index symbols) - (lsp--imenu-create-categorized-index-flat symbols))) - -(defcustom lsp-imenu-index-function #'lsp-imenu-create-uncategorized-index - "Function that should create an `imenu' index. -It will be called with a list of SymbolInformation or -DocumentSymbols, whose first level is already filtered. It shall -then return an appropriate `imenu' index (see -`imenu-create-index-function'). - -Note that this interface is not stable, and subject to change any -time." - :group 'lsp-imenu - :type '(radio - (const :tag "Categorize by type" - lsp-imenu-create-categorized-index) - (const :tag "Categorize root symbols by type" - lsp-imenu-create-top-level-categorized-index) - (const :tag "Uncategorized, inline entries" - lsp-imenu-create-uncategorized-index) - (function :tag "Custom function"))) - -(defun lsp--imenu-create-index () - "Create an `imenu' index based on the language server. -Respects `lsp-imenu-index-function'." - (let ((symbols (lsp--imenu-filter-symbols (lsp--get-document-symbols)))) - (funcall lsp-imenu-index-function symbols))) - -(defun lsp--imenu-filter-symbols (symbols) - "Filter out unsupported symbols from SYMBOLS." - (seq-remove #'lsp--symbol-ignore symbols)) - -(defun lsp--imenu-hierarchical-p (symbols) - "Determine whether any element in SYMBOLS has children." - (seq-some #'lsp-document-symbol? symbols)) - -(defun lsp--imenu-create-non-hierarchical-index (symbols) - "Create imenu index for non-hierarchical SYMBOLS. - -SYMBOLS are a list of DocumentSymbol messages. - -Return a nested alist keyed by symbol names. e.g. - - ((\"SomeClass\" (\"(Class)\" . 10) - (\"someField (Field)\" . 20) - (\"someFunction (Function)\" . 25) - (\"SomeSubClass\" (\"(Class)\" . 30) - (\"someSubField (Field)\" . 35)) - (\"someFunction (Function)\" . 40))" - (seq-map (lambda (nested-alist) - (cons (car nested-alist) - (seq-map #'lsp--symbol-to-imenu-elem (cdr nested-alist)))) - (seq-group-by #'lsp--get-symbol-type symbols))) - -(defun lsp--imenu-create-hierarchical-index (symbols) - "Create imenu index for hierarchical SYMBOLS. - -SYMBOLS are a list of DocumentSymbol messages. - -Return a nested alist keyed by symbol names. e.g. - - ((\"SomeClass\" (\"(Class)\" . 10) - (\"someField (Field)\" . 20) - (\"someFunction (Function)\" . 25) - (\"SomeSubClass\" (\"(Class)\" . 30) - (\"someSubField (Field)\" . 35)) - (\"someFunction (Function)\" . 40))" - (seq-map #'lsp--symbol-to-hierarchical-imenu-elem - (seq-sort #'lsp--imenu-symbol-lessp symbols))) - -(defun lsp--imenu-symbol-lessp (sym1 sym2) - (let* ((compare-results (mapcar (lambda (method) - (funcall (alist-get method lsp--imenu-compare-function-alist) - sym1 sym2)) - lsp-imenu-sort-methods)) - (result (seq-find (lambda (result) - (not (= result 0))) - compare-results - 0))) - (and (numberp result) (< result 0)))) - -(lsp-defun lsp--imenu-compare-kind ((&SymbolInformation :kind left) - (&SymbolInformation :kind right)) - "Compare SYM1 and SYM2 by kind." - (- left right)) - -(defun lsp--imenu-compare-line-col (sym1 sym2) - (if (lsp--line-col-comparator - (lsp--get-line-and-col sym1) - (lsp--get-line-and-col sym2)) - -1 - 1)) - -(lsp-defun lsp--imenu-compare-name ((&SymbolInformation :name name1) - (&SymbolInformation :name name2)) - "Compare SYM1 and SYM2 by name." - (let ((result (compare-strings name1 0 (length name1) name2 0 (length name2)))) - (if (numberp result) result 0))) - -(defun lsp--imenu-refresh () - "Force Imenu to refresh itself." - (imenu--menubar-select imenu--rescan-item)) - -(defun lsp-enable-imenu () - "Use lsp-imenu for the current buffer." - (imenu--cleanup) - (add-function :override (local 'imenu-create-index-function) #'lsp--imenu-create-index) - (setq-local imenu-menubar-modified-tick -1) - (setq-local imenu--index-alist nil) - (when menu-bar-mode - (lsp--imenu-refresh))) - -(defun lsp-resolve-final-command (command &optional test?) - "Resolve final function COMMAND." - (let* ((command (lsp-resolve-value command)) - (command (cl-etypecase command - (list - (cl-assert (seq-every-p (apply-partially #'stringp) command) nil - "Invalid command list") - command) - (string (list command))))) - (if (and (file-remote-p default-directory) (not test?)) - (list shell-file-name "-c" - (string-join (cons "stty raw > /dev/null;" - (mapcar #'shell-quote-argument command)) - " ")) - command))) - -(defun lsp-server-present? (final-command) - "Check whether FINAL-COMMAND is present." - (let ((binary-found? (executable-find (cl-first final-command) t))) - (if binary-found? - (lsp-log "Command \"%s\" is present on the path." (s-join " " final-command)) - (lsp-log "Command \"%s\" is not present on the path." (s-join " " final-command))) - binary-found?)) - -(defun lsp--value-to-string (value) - "Convert VALUE to a string that can be set as value in an environment -variable." - (cond - ((stringp value) value) - ((booleanp value) (if value - "1" - "0")) - ((and (sequencep value) - (seq-every-p #'stringp value)) (string-join value ":")) - (t (user-error "Only strings, booleans, and sequences of strings are supported as environment variables")))) - -(defun lsp--compute-process-environment (environment-fn) - "Append a list of KEY=VALUE from the alist ENVIRONMENT to `process-environment'. -Ignore non-boolean keys whose value is nil." - (let ((environment (if environment-fn - (funcall environment-fn) - nil))) - (-flatten (cons (cl-loop for (key . value) in environment - if (or (eval value) - (eq (get value 'custom-type) 'boolean)) - collect (concat key "=" (lsp--value-to-string - (eval value)))) - process-environment)))) - -(defun lsp--default-directory-for-connection (&optional path) - "Return path to be used for the working directory of a LSP process. - -If `lsp-use-workspace-root-for-server-default-directory' is -non-nil, uses `lsp-workspace-root' to find the directory -corresponding to PATH, else returns `default-directory'." - (if lsp-use-workspace-root-for-server-default-directory - (lsp-workspace-root path) - default-directory)) - -(defun lsp--fix-remote-cmd (program) - "Helper for `lsp-stdio-connection'. -Originally coppied from eglot." - - (if (file-remote-p default-directory) - (list shell-file-name "-c" - (string-join (cons "stty raw > /dev/null;" - (mapcar #'shell-quote-argument program)) - " ")) - program)) - -(defvar tramp-use-ssh-controlmaster-options) -(defvar tramp-ssh-controlmaster-options) - -(defun lsp-stdio-connection (command &optional test-command) - "Returns a connection property list using COMMAND. -COMMAND can be: A string, denoting the command to launch the -language server. A list of strings, denoting an executable with -its command line arguments. A function, that either returns a -string or a list of strings. In all cases, the launched language -server should send and receive messages on standard I/O. -TEST-COMMAND is a function with no arguments which returns -whether the command is present or not. When not specified -`lsp-mode' will check whether the first element of the list -returned by COMMAND is available via `executable-find'" - (cl-check-type command (or string - function - (and list - (satisfies (lambda (l) - (seq-every-p (lambda (el) - (stringp el)) - l)))))) - (list :connect (lambda (filter sentinel name environment-fn workspace) - (if (and (functionp 'json-rpc-connection) - (not (file-remote-p default-directory))) - (lsp-json-rpc-connection workspace (lsp-resolve-final-command command)) - (let ((final-command (lsp-resolve-final-command command)) - (process-name (generate-new-buffer-name name)) - (process-environment - (lsp--compute-process-environment environment-fn))) - (let* ((stderr-buf (get-buffer-create (format "*%s::stderr*" process-name))) - (default-directory (lsp--default-directory-for-connection)) - (tramp-use-ssh-controlmaster-options 'suppress) - (tramp-ssh-controlmaster-options "-o ControlMaster=no -o ControlPath=none") - (proc (make-process - :name process-name - :connection-type 'pipe - :buffer (format "*%s*" process-name) - :coding 'no-conversion - :command final-command - :filter filter - :sentinel sentinel - :stderr stderr-buf - :noquery t - :file-handler t))) - (set-process-query-on-exit-flag proc nil) - (set-process-query-on-exit-flag (get-buffer-process stderr-buf) nil) - (with-current-buffer (get-buffer stderr-buf) - ;; Make the *NAME::stderr* buffer buffer-read-only, q to bury, etc. - (special-mode)) - (cons proc proc))))) - :test? (or - test-command - (lambda () - (lsp-server-present? (lsp-resolve-final-command command t)))))) - -(defun lsp--open-network-stream (host port name) - "Open network stream to HOST:PORT. - NAME will be passed to `open-network-stream'. - RETRY-COUNT is the number of the retries. - SLEEP-INTERVAL is the sleep interval between each retry." - (let* ((retries 0) - (sleep-interval 0.01) - (number-of-retries (/ lsp-tcp-connection-timeout sleep-interval)) - connection) - (while (and (not connection) (< retries number-of-retries)) - (condition-case err - (setq connection (open-network-stream name nil host port - :type 'plain - :coding 'no-conversion)) - (file-error - (let ((inhibit-message t)) - (lsp--warn "Failed to connect to %s:%s with error message %s" - host - port - (error-message-string err)) - (sleep-for sleep-interval) - (cl-incf retries))))) - (or connection (error "Port %s was never taken. Consider increasing `lsp-tcp-connection-timeout'." port)))) - -(defun lsp--port-available (host port) - "Return non-nil if HOST and PORT are available." - (condition-case _err - (delete-process (open-network-stream "*connection-test*" nil host port :type 'plain)) - (file-error t))) - -(defun lsp--find-available-port (host starting-port) - "Find available port on HOST starting from STARTING-PORT." - (let ((port starting-port)) - (while (not (lsp--port-available host port)) - (cl-incf port)) - port)) - -(defun lsp-tcp-connection (command-fn) - "Returns a connection property list similar to `lsp-stdio-connection'. -COMMAND-FN can only be a function that takes a single argument, a -port number. It should return a command for launches a language server -process listening for TCP connections on the provided port." - (cl-check-type command-fn function) - (list - :connect (lambda (filter sentinel name environment-fn _workspace) - (let* ((host "localhost") - (port (lsp--find-available-port host (cl-incf lsp--tcp-port))) - (command (funcall command-fn port)) - (final-command (if (consp command) command (list command))) - (_ (unless (lsp-server-present? final-command) - (user-error (format "Couldn't find executable %s" (cl-first final-command))))) - (process-environment - (lsp--compute-process-environment environment-fn)) - (proc (make-process :name name :connection-type 'pipe :coding 'no-conversion - :command final-command :sentinel sentinel :stderr (format "*%s::stderr*" name) :noquery t)) - (tcp-proc (lsp--open-network-stream host port (concat name "::tcp")))) - - ;; TODO: Same :noquery issue (see above) - (set-process-query-on-exit-flag proc nil) - (set-process-query-on-exit-flag tcp-proc nil) - (set-process-filter tcp-proc filter) - (cons tcp-proc proc))) - :test? (lambda () (lsp-server-present? (funcall command-fn 0))))) - -(defalias 'lsp-tcp-server 'lsp-tcp-server-command) - -(defun lsp-tcp-server-command (command-fn) - "Create tcp server connection. -In this mode Emacs is TCP server and the language server connects -to it. COMMAND is function with one parameter(the port) and it -should return the command to start the LS server." - (cl-check-type command-fn function) - (list - :connect (lambda (filter sentinel name environment-fn _workspace) - (let* (tcp-client-connection - (tcp-server (make-network-process :name (format "*tcp-server-%s*" name) - :buffer (format "*tcp-server-%s*" name) - :family 'ipv4 - :service lsp--tcp-server-port - :sentinel (lambda (proc _string) - (lsp-log "Language server %s is connected." name) - (setf tcp-client-connection proc)) - :server 't)) - (port (process-contact tcp-server :service)) - (final-command (funcall command-fn port)) - (process-environment - (lsp--compute-process-environment environment-fn)) - (cmd-proc (make-process :name name - :connection-type 'pipe - :coding 'no-conversion - :command final-command - :stderr (format "*tcp-server-%s*::stderr" name) - :noquery t))) - (let ((retries 0)) - ;; wait for the client to connect (we sit-for 500 ms, so have to double lsp--tcp-server-wait-seconds) - (while (and (not tcp-client-connection) (< retries (* 2 lsp--tcp-server-wait-seconds))) - (lsp--info "Waiting for connection for %s, retries: %s" name retries) - (sit-for 0.500) - (cl-incf retries))) - - (unless tcp-client-connection - (condition-case nil (delete-process tcp-server) (error)) - (condition-case nil (delete-process cmd-proc) (error)) - (error "Failed to create connection to %s on port %s" name port)) - (lsp--info "Successfully connected to %s" name) - - (set-process-query-on-exit-flag cmd-proc nil) - (set-process-query-on-exit-flag tcp-client-connection nil) - (set-process-query-on-exit-flag tcp-server nil) - - (set-process-filter tcp-client-connection filter) - (set-process-sentinel tcp-client-connection sentinel) - (cons tcp-client-connection cmd-proc))) - :test? (lambda () (lsp-server-present? (funcall command-fn 0))))) - -(defalias 'lsp-tramp-connection 'lsp-stdio-connection) - -(defun lsp--auto-configure () - "Autoconfigure `company', `flycheck', `lsp-ui', etc if they are installed." - (when (functionp 'lsp-ui-mode) - (lsp-ui-mode)) - - (if lsp-headerline-breadcrumb-enable - (add-hook 'lsp-configure-hook 'lsp-headerline-breadcrumb-mode) - (remove-hook 'lsp-configure-hook 'lsp-headerline-breadcrumb-mode)) - (if lsp-modeline-code-actions-enable - (add-hook 'lsp-configure-hook 'lsp-modeline-code-actions-mode) - (remove-hook 'lsp-configure-hook 'lsp-modeline-code-actions-mode)) - (if lsp-modeline-diagnostics-enable - (add-hook 'lsp-configure-hook 'lsp-modeline-diagnostics-mode) - (remove-hook 'lsp-configure-hook 'lsp-modeline-diagnostics-mode)) - (if lsp-modeline-workspace-status-enable - (add-hook 'lsp-configure-hook 'lsp-modeline-workspace-status-mode) - (remove-hook 'lsp-configure-hook 'lsp-modeline-workspace-status-mode)) - (if lsp-lens-enable - (add-hook 'lsp-configure-hook 'lsp-lens--enable) - (remove-hook 'lsp-configure-hook 'lsp-lens--enable)) - (if lsp-semantic-tokens-enable - (add-hook 'lsp-configure-hook 'lsp-semantic-tokens--enable) - (remove-hook 'lsp-configure-hook 'lsp-semantic-tokens--enable)) - - ;; yas-snippet config - (setq-local yas-inhibit-overlay-modification-protection t)) - -(defun lsp--restart-if-needed (workspace) - "Handler restart for WORKSPACE." - (when (or (eq lsp-restart 'auto-restart) - (eq (lsp--workspace-shutdown-action workspace) 'restart) - (and (eq lsp-restart 'interactive) - (let ((query (format - "Server %s exited (check corresponding stderr buffer for details). Do you want to restart it?" - (lsp--workspace-print workspace)))) - (y-or-n-p query)))) - (--each (lsp--workspace-buffers workspace) - (when (lsp-buffer-live-p it) - (lsp-with-current-buffer it - (if lsp--buffer-deferred - (lsp-deferred) - (lsp--info "Restarting LSP in buffer %s" (buffer-name)) - (lsp))))))) - -(defun lsp--update-key (table key fn) - "Apply FN on value corresponding to KEY in TABLE." - (let ((existing-value (gethash key table))) - (if-let ((new-value (funcall fn existing-value))) - (puthash key new-value table) - (remhash key table)))) - -(defun lsp--process-sentinel (workspace process exit-str) - "Create the sentinel for WORKSPACE." - (unless (process-live-p process) - (lsp--handle-process-exit workspace exit-str))) - -(defun lsp--handle-process-exit (workspace exit-str) - (let* ((folder->workspaces (lsp-session-folder->servers (lsp-session))) - (proc (lsp--workspace-proc workspace))) - (lsp--warn "%s has exited (%s)" - (lsp-process-name proc) - (string-trim-right (or exit-str ""))) - (with-lsp-workspace workspace - ;; Clean workspace related data in each of the buffers - ;; in the workspace. - (--each (lsp--workspace-buffers workspace) - (when (lsp-buffer-live-p it) - (lsp-with-current-buffer it - (setq lsp--buffer-workspaces (delete workspace lsp--buffer-workspaces)) - (lsp--uninitialize-workspace) - (lsp--spinner-stop) - (lsp--remove-overlays 'lsp-highlight)))) - - ;; Cleanup session from references to the closed workspace. - (--each (hash-table-keys folder->workspaces) - (lsp--update-key folder->workspaces it (apply-partially 'delete workspace))) - - (lsp-process-cleanup proc)) - - (run-hook-with-args 'lsp-after-uninitialized-functions workspace) - - (if (eq (lsp--workspace-shutdown-action workspace) 'shutdown) - (lsp--info "Workspace %s shutdown." (lsp--workspace-print workspace)) - (lsp--restart-if-needed workspace)) - (lsp--cleanup-hanging-watches))) - -(defun lsp-workspace-folders (workspace) - "Return all folders associated with WORKSPACE." - (let (result) - (->> (lsp-session) - (lsp-session-folder->servers) - (maphash (lambda (folder workspaces) - (when (-contains? workspaces workspace) - (push folder result))))) - result)) - -(defun lsp--start-workspace (session client-template root &optional initialization-options) - "Create new workspace for CLIENT-TEMPLATE with project root ROOT. -INITIALIZATION-OPTIONS are passed to initialize function. -SESSION is the active session." - (lsp--spinner-start) - (-let* ((default-directory root) - (client (copy-lsp--client client-template)) - (workspace (make-lsp--workspace - :root root - :client client - :status 'starting - :buffers (list (lsp-current-buffer)) - :host-root (file-remote-p root))) - ((&lsp-cln 'server-id 'environment-fn 'new-connection 'custom-capabilities - 'multi-root 'initialized-fn) client) - ((proc . cmd-proc) (funcall - (or (plist-get new-connection :connect) - (user-error "Client %s is configured incorrectly" client)) - (lsp--create-filter-function workspace) - (apply-partially #'lsp--process-sentinel workspace) - (format "%s" server-id) - environment-fn - workspace)) - (workspace-folders (gethash server-id (lsp-session-server-id->folders session)))) - (setf (lsp--workspace-proc workspace) proc - (lsp--workspace-cmd-proc workspace) cmd-proc) - - ;; update (lsp-session-folder->servers) depending on whether we are starting - ;; multi/single folder workspace - (mapc (lambda (project-root) - (->> session - (lsp-session-folder->servers) - (gethash project-root) - (cl-pushnew workspace))) - (or workspace-folders (list root))) - - (with-lsp-workspace workspace - (run-hooks 'lsp-before-initialize-hook) - (lsp-request-async - "initialize" - (append - (list :processId (unless (file-remote-p (buffer-file-name)) - (emacs-pid)) - :rootPath (lsp-file-local-name (expand-file-name root)) - :clientInfo (list :name "emacs" - :version (emacs-version)) - :rootUri (lsp--path-to-uri root) - :capabilities (lsp--client-capabilities custom-capabilities) - :initializationOptions initialization-options - :workDoneToken "1") - (when lsp-server-trace - (list :trace lsp-server-trace)) - (when multi-root - (->> workspace-folders - (-distinct) - (-map (lambda (folder) - (list :uri (lsp--path-to-uri folder) - :name (f-filename folder)))) - (apply 'vector) - (list :workspaceFolders)))) - (-lambda ((&InitializeResult :capabilities)) - ;; we know that Rust Analyzer will send {} which will be parsed as null - ;; when using plists - (when (equal 'rust-analyzer server-id) - (-> capabilities - (lsp:server-capabilities-text-document-sync?) - (lsp:set-text-document-sync-options-save? t))) - - (setf (lsp--workspace-server-capabilities workspace) capabilities - (lsp--workspace-status workspace) 'initialized) - - (with-lsp-workspace workspace - (lsp-notify "initialized" lsp--empty-ht)) - - (when initialized-fn (funcall initialized-fn workspace)) - - (cl-callf2 -filter #'lsp-buffer-live-p (lsp--workspace-buffers workspace)) - (->> workspace - (lsp--workspace-buffers) - (mapc (lambda (buffer) - (lsp-with-current-buffer buffer - (lsp--open-in-workspace workspace))))) - - (with-lsp-workspace workspace - (run-hooks 'lsp-after-initialize-hook)) - (lsp--info "%s initialized successfully in folders: %s" - (lsp--workspace-print workspace) - (lsp-workspace-folders workspace))) - :mode 'detached)) - workspace)) - -(defun lsp--load-default-session () - "Load default session." - (setq lsp--session (or (condition-case err - (lsp--read-from-file lsp-session-file) - (error (lsp--error "Failed to parse the session %s, starting with clean one." - (error-message-string err)) - nil)) - (make-lsp-session)))) - -(defun lsp-session () - "Get the session associated with the current buffer." - (or lsp--session (setq lsp--session (lsp--load-default-session)))) - -(defun lsp--client-disabled-p (buffer-major-mode client) - (seq-some - (lambda (entry) - (pcase entry - ((pred symbolp) (eq entry client)) - (`(,mode . ,client-or-list) - (and (eq mode buffer-major-mode) - (if (listp client-or-list) - (memq client client-or-list) - (eq client client-or-list)))))) - lsp-disabled-clients)) - - -;; download server - -(defcustom lsp-server-install-dir (expand-file-name - (locate-user-emacs-file (f-join ".cache" "lsp"))) - "Directory in which the servers will be installed." - :risky t - :type 'directory - :package-version '(lsp-mode . "6.3") - :group 'lsp-mode) - -(defcustom lsp-verify-signature t - "Whether to check GPG signatures of downloaded files." - :type 'boolean - :package-version '(lsp-mode . "8.0.0") - :group 'lsp-mode) - -(defvar lsp--dependencies (ht)) - -(defun lsp-dependency (name &rest definitions) - "Used to specify a language server DEPENDENCY, the server -executable or other required file path. Typically, the -DEPENDENCY is found by locating it on the system path using -`executable-find'. - -You can explicitly call lsp-dependency in your environment to -specify the absolute path to the DEPENDENCY. For example, the -typescript-language-server requires both the server and the -typescript compiler. If you have installed them in a team shared -read-only location, you can instruct lsp-mode to use them via - - (eval-after-load `lsp-mode - `(progn - (require lsp-javascript) - (lsp-dependency typescript-language-server (:system ,tls-exe)) - (lsp-dependency typescript (:system ,ts-js)))) - -where tls-exe is the absolute path to the typescript-language-server -executable and ts-js is the absolute path to the typescript compiler -JavaScript file, tsserver.js (the *.js is required for Windows)." - (ht-set lsp--dependencies name definitions)) - -(defun lsp--server-binary-present? (client) - (unless (equal (lsp--client-server-id client) 'lsp-pwsh) - (condition-case () - (-some-> client lsp--client-new-connection (plist-get :test?) funcall) - (error nil) - (args-out-of-range nil)))) - -(define-minor-mode lsp-installation-buffer-mode - "Mode used in *lsp-installation* buffers. -It can be used to set-up keybindings, etc. Disabling this mode -detaches the installation buffer from commands like -`lsp-select-installation-buffer'." - :init-value nil - :lighter nil) - -(defface lsp-installation-finished-buffer-face '((t :foreground "orange")) - "Face used for finished installation buffers. -Used in `lsp-select-installation-buffer'." - :group 'lsp-mode) - -(defface lsp-installation-buffer-face '((t :foreground "green")) - "Face used for installation buffers still in progress. -Used in `lsp-select-installation-buffer'." - :group 'lsp-mode) - -(defun lsp--installation-buffer? (buf) - "Check whether BUF is an `lsp-async-start-process' buffer." - (buffer-local-value 'lsp-installation-buffer-mode buf)) - -(defun lsp-select-installation-buffer (&optional show-finished) - "Interactively choose an installation buffer. -If SHOW-FINISHED is set, leftover (finished) installation buffers -are still shown." - (interactive "P") - (let ((bufs (--filter (and (lsp--installation-buffer? it) - (or show-finished (get-buffer-process it))) - (buffer-list)))) - (pcase bufs - (`nil (user-error "No installation buffers")) - (`(,buf) (pop-to-buffer buf)) - (bufs (pop-to-buffer (completing-read "Select installation buffer: " - (--map (propertize (buffer-name it) 'face - (if (get-buffer-process it) - 'lsp-installation-buffer-face - 'lsp-installation-finished-buffer-face)) - bufs))))))) - -(defun lsp-cleanup-installation-buffers () - "Delete finished *lsp-installation* buffers." - (interactive) - (dolist (buf (buffer-list)) - (when (and (lsp--installation-buffer? buf) (not (get-buffer-process buf))) - (kill-buffer buf)))) - -(defun lsp--download-status () - (-some--> #'lsp--client-download-in-progress? - (lsp--filter-clients it) - (-map (-compose #'symbol-name #'lsp--client-server-id) it) - (format "%s" it) - (propertize it 'face 'success) - (format " Installing following servers: %s" it) - (propertize it - 'local-map (make-mode-line-mouse-map - 'mouse-1 #'lsp-select-installation-buffer) - 'mouse-face 'highlight))) - -(defun lsp--install-server-internal (client &optional update?) - (unless (lsp--client-download-server-fn client) - (user-error "There is no automatic installation for `%s', you have to install it manually following lsp-mode's documentation." - (lsp--client-server-id client))) - - (setf (lsp--client-download-in-progress? client) t) - (add-to-list 'global-mode-string '(t (:eval (lsp--download-status)))) - (cl-flet ((done - (success? &optional error-message) - ;; run with idle timer to make sure the lsp command is executed in - ;; the main thread, see #2739. - (run-with-timer - 0.0 - nil - (lambda () - (-let [(&lsp-cln 'server-id 'buffers) client] - (setf (lsp--client-download-in-progress? client) nil - (lsp--client-buffers client) nil) - (if success? - (lsp--info "Server %s downloaded, auto-starting in %s buffers." server-id - (length buffers)) - (lsp--error "Server %s install process failed with the following error message: %s. -Check `*lsp-install*' and `*lsp-log*' buffer." - server-id - error-message)) - (seq-do - (lambda (buffer) - (when (lsp-buffer-live-p buffer) - (lsp-with-current-buffer buffer - (cl-callf2 -remove-item '(t (:eval (lsp--download-status))) - global-mode-string) - (when success? (lsp))))) - buffers) - (unless (lsp--filter-clients #'lsp--client-download-in-progress?) - (cl-callf2 -remove-item '(t (:eval (lsp--download-status))) - global-mode-string))))))) - (lsp--info "Download %s started." (lsp--client-server-id client)) - (condition-case err - (funcall - (lsp--client-download-server-fn client) - client - (lambda () (done t)) - (lambda (msg) (done nil msg)) - update?) - (error - (done nil (error-message-string err)))))) - -(defun lsp--require-packages () - "Load `lsp-client-packages' if needed." - (when (and lsp-auto-configure (not lsp--client-packages-required)) - (seq-do (lambda (package) - ;; loading client is slow and `lsp' can be called repeatedly - (unless (featurep package) - (require package nil t))) - lsp-client-packages) - (setq lsp--client-packages-required t))) - -;;;###autoload -(defun lsp-install-server (update? &optional server-id) - "Interactively install or re-install server. -When prefix UPDATE? is t force installation even if the server is present." - (interactive "P") - (lsp--require-packages) - (let* ((chosen-client (or (gethash server-id lsp-clients) - (lsp--completing-read - "Select server to install/re-install: " - (or (->> lsp-clients - (ht-values) - (-filter (-andfn - (-not #'lsp--client-download-in-progress?) - #'lsp--client-download-server-fn))) - (user-error "There are no servers with automatic installation")) - (lambda (client) - (let ((server-name (-> client lsp--client-server-id symbol-name))) - (if (lsp--server-binary-present? client) - (concat server-name " (Already installed)") - server-name))) - nil - t))) - (update? (or update? - (and (not (lsp--client-download-in-progress? chosen-client)) - (lsp--server-binary-present? chosen-client))))) - (lsp--install-server-internal chosen-client update?))) - -;;;###autoload -(defun lsp-uninstall-server (dir) - "Delete a LSP server from `lsp-server-install-dir'." - (interactive - (list (read-directory-name "Uninstall LSP server: " (f-slash lsp-server-install-dir)))) - (unless (file-directory-p dir) - (user-error "Couldn't find %s directory" dir)) - (delete-directory dir 'recursive) - (message "Server `%s' uninstalled." (file-name-nondirectory (directory-file-name dir)))) - -;;;###autoload -(defun lsp-uninstall-servers () - "Uninstall all installed servers." - (interactive) - (let* ((dir lsp-server-install-dir) - (servers (ignore-errors - (directory-files dir t - directory-files-no-dot-files-regexp)))) - (if (or (not (file-directory-p dir)) (zerop (length servers))) - (user-error "No servers to uninstall") - (when (yes-or-no-p - (format "Servers to uninstall: %d (%s), proceed? " - (length servers) - (mapconcat (lambda (server) - (file-name-nondirectory (directory-file-name server))) - servers " "))) - (mapc #'lsp-uninstall-server servers) - (message "All servers uninstalled"))))) - -;;;###autoload -(defun lsp-update-server (&optional server-id) - "Interactively update (reinstall) a server." - (interactive) - (lsp--require-packages) - (let ((chosen-client (or (gethash server-id lsp-clients) - (lsp--completing-read - "Select server to update (if not on the list, probably you need to `lsp-install-server`): " - (or (->> lsp-clients - (ht-values) - (-filter (-andfn - (-not #'lsp--client-download-in-progress?) - #'lsp--client-download-server-fn - #'lsp--server-binary-present?))) - (user-error "There are no servers to update")) - (lambda (client) - (-> client lsp--client-server-id symbol-name)) - nil - t)))) - (lsp--install-server-internal chosen-client t))) - -;;;###autoload -(defun lsp-update-servers () - "Update (reinstall) all installed servers." - (interactive) - (lsp--require-packages) - (mapc (lambda (client) (lsp--install-server-internal client t)) - (-filter (-andfn - (-not #'lsp--client-download-in-progress?) - #'lsp--client-download-server-fn - #'lsp--server-binary-present?) (hash-table-values lsp-clients)))) - -;;;###autoload -(defun lsp-ensure-server (server-id) - "Ensure server SERVER-ID" - (lsp--require-packages) - (if-let ((client (gethash server-id lsp-clients))) - (unless (lsp--server-binary-present? client) - (lsp--info "Server `%s' is not preset, installing..." server-id) - (lsp-install-server nil server-id)) - (warn "Unable to find server registration with id %s" server-id))) - -(defun lsp-async-start-process (callback error-callback &rest command) - "Start async process COMMAND with CALLBACK and ERROR-CALLBACK." - (let ((name (cl-first command))) - (with-current-buffer (compilation-start (mapconcat #'shell-quote-argument (-filter (lambda (cmd) - (not (null cmd))) - command) - " ") t - (lambda (&rest _) - (generate-new-buffer-name (format "*lsp-install: %s*" name)))) - (lsp-installation-buffer-mode +1) - (view-mode +1) - (add-hook - 'compilation-finish-functions - (lambda (_buf status) - (if (string= "finished\n" status) - (condition-case err - (funcall callback) - (error - (funcall error-callback (error-message-string err)))) - (funcall error-callback (s-trim-right status)))) - nil t)))) - -(defun lsp-resolve-value (value) - "Resolve VALUE's value. -If it is function - call it. -If it is a variable - return it's value -Otherwise returns value itself." - (cond - ((functionp value) (funcall value)) - ((and (symbolp value) (boundp value)) (symbol-value value)) - (value))) - -(defvar lsp-deps-providers - (list :npm (list :path #'lsp--npm-dependency-path - :install #'lsp--npm-dependency-install) - :cargo (list :path #'lsp--cargo-dependency-path - :install #'lsp--cargo-dependency-install) - :system (list :path #'lsp--system-path) - :download (list :path #'lsp-download-path - :install #'lsp-download-install))) - -(defun lsp--system-path (path) - "If PATH is absolute and exists return it as is. Otherwise, -return the absolute path to the executable defined by PATH or -nil." - ;; For node.js 'sub-packages' PATH may point to a *.js file. Consider the - ;; typescript-language-server. When lsp invokes the server, lsp needs to - ;; supply the path to the typescript compiler, tsserver.js, as an argument. To - ;; make code platform independent, one must pass the absolute path to the - ;; tsserver.js file (Windows requires a *.js file - see help on the JavaScript - ;; child process spawn command that is invoked by the - ;; typescript-language-server). This is why we check for existence and not - ;; that the path is executable. - (let ((path (lsp-resolve-value path))) - (cond - ((and (f-absolute? path) - (f-exists? path)) - path) - ((executable-find path t) path)))) - -(defun lsp-package-path (dependency) - "Path to the DEPENDENCY each of the registered providers." - (let (path) - (-first (-lambda ((provider . rest)) - (setq path (-some-> lsp-deps-providers - (plist-get provider) - (plist-get :path) - (apply rest)))) - (gethash dependency lsp--dependencies)) - path)) - -(defun lsp-package-ensure (dependency callback error-callback) - "Asynchronously ensure a package." - (or (-first (-lambda ((provider . rest)) - (-some-> lsp-deps-providers - (plist-get provider) - (plist-get :install) - (apply (cl-list* callback error-callback rest)))) - (gethash dependency lsp--dependencies)) - (funcall error-callback (format "Unable to find a way to install %s" dependency)))) - - -;; npm handling - -;; https://docs.npmjs.com/files/folders#executables -(cl-defun lsp--npm-dependency-path (&key package path &allow-other-keys) - "Return npm dependency PATH for PACKAGE." - (let ((path (executable-find - (f-join lsp-server-install-dir "npm" package - (cond ((eq system-type 'windows-nt) "") - (t "bin")) - path) - t))) - (unless (and path (f-exists? path)) - (error "The package %s is not installed. Unable to find %s" package path)) - path)) - -(cl-defun lsp--npm-dependency-install (callback error-callback &key package &allow-other-keys) - (if-let ((npm-binary (executable-find "npm"))) - (progn - ;; Explicitly `make-directory' to work around NPM bug in - ;; versions 7.0.0 through 7.4.1. See - ;; https://github.com/emacs-lsp/lsp-mode/issues/2364 for - ;; discussion. - (make-directory (f-join lsp-server-install-dir "npm" package "lib") 'parents) - (lsp-async-start-process (lambda () - (if (string-empty-p - (string-trim (shell-command-to-string - (mapconcat #'shell-quote-argument `(,npm-binary "view" ,package "peerDependencies") " ")))) - (funcall callback) - (let ((default-directory (f-dirname (car (last (directory-files-recursively (f-join lsp-server-install-dir "npm" package) "package.json"))))) - (process-environment (append '("npm_config_yes=true") process-environment))) ;; Disable prompting for older versions of npx - (when (f-dir-p default-directory) - (lsp-async-start-process callback - error-callback - (executable-find "npx") - "npm-install-peers"))))) - error-callback - npm-binary - "-g" - "--prefix" - (f-join lsp-server-install-dir "npm" package) - "install" - package)) - (lsp-log "Unable to install %s via `npm' because it is not present" package) - nil)) - - -;; Cargo dependency handling -(cl-defun lsp--cargo-dependency-path (&key package path &allow-other-keys) - (let ((path (executable-find - (f-join lsp-server-install-dir - "cargo" - package - "bin" - path) - t))) - (unless (and path (f-exists? path)) - (error "The package %s is not installed. Unable to find %s" package path)) - path)) - -(cl-defun lsp--cargo-dependency-install (callback error-callback &key package git &allow-other-keys) - (if-let ((cargo-binary (executable-find "cargo"))) - (lsp-async-start-process - callback - error-callback - cargo-binary - "install" - package - (when git - "--git") - git - "--root" - (f-join lsp-server-install-dir "cargo" package)) - (lsp-log "Unable to install %s via `cargo' because it is not present" package) - nil)) - - - -;; Download URL handling -(cl-defun lsp-download-install (callback error-callback &key url asc-url pgp-key store-path decompress &allow-other-keys) - (let* ((url (lsp-resolve-value url)) - (store-path (lsp-resolve-value store-path)) - ;; (decompress (lsp-resolve-value decompress)) - (download-path - (pcase decompress - (:gzip (concat store-path ".gz")) - (:zip (concat store-path ".zip")) - (:targz (concat store-path ".tar.gz")) - (`nil store-path) - (_ (error ":decompress must be `:gzip', `:zip', `:targz' or `nil'"))))) - (make-thread - (lambda () - (condition-case err - (progn - (when (f-exists? download-path) - (f-delete download-path)) - (when (f-exists? store-path) - (f-delete store-path)) - (lsp--info "Starting to download %s to %s..." url download-path) - (mkdir (f-parent download-path) t) - (url-copy-file url download-path) - (lsp--info "Finished downloading %s..." download-path) - (when (and lsp-verify-signature asc-url pgp-key) - (if (executable-find epg-gpg-program) - (let ((asc-download-path (concat download-path ".asc")) - (context (epg-make-context)) - (fingerprint) - (signature)) - (when (f-exists? asc-download-path) - (f-delete asc-download-path)) - (lsp--info "Starting to download %s to %s..." asc-url asc-download-path) - (url-copy-file asc-url asc-download-path) - (lsp--info "Finished downloading %s..." asc-download-path) - (epg-import-keys-from-string context pgp-key) - (setq fingerprint (epg-import-status-fingerprint - (car - (epg-import-result-imports - (epg-context-result-for context 'import))))) - (lsp--info "Verifying signature %s..." asc-download-path) - (epg-verify-file context asc-download-path download-path) - (setq signature (car (epg-context-result-for context 'verify))) - (unless (and - (eq (epg-signature-status signature) 'good) - (equal (epg-signature-fingerprint signature) fingerprint)) - (error "Failed to verify GPG signature: %s" (epg-signature-to-string signature)))) - (lsp--warn "GPG is not installed, skipping the signature check."))) - (when decompress - (lsp--info "Decompressing %s..." download-path) - (pcase decompress - (:gzip - (lsp-gunzip download-path)) - (:zip (lsp-unzip download-path (f-parent store-path))) - (:targz (lsp-tar-gz-decompress download-path (f-parent store-path)))) - (lsp--info "Decompressed %s..." store-path)) - (funcall callback)) - (error (funcall error-callback err))))))) - -(cl-defun lsp-download-path (&key store-path binary-path set-executable? &allow-other-keys) - "Download URL and store it into STORE-PATH. - -SET-EXECUTABLE? when non-nil change the executable flags of -STORE-PATH to make it executable. BINARY-PATH can be specified -when the binary to start does not match the name of the -archive (e.g. when the archive has multiple files)" - (let ((store-path (or (lsp-resolve-value binary-path) - (lsp-resolve-value store-path)))) - (cond - ((executable-find store-path) store-path) - ((and set-executable? (f-exists? store-path)) - (set-file-modes store-path #o0700) - store-path) - ((f-exists? store-path) store-path)))) - -(defun lsp--find-latest-gh-release-url (url regex) - "Fetch the latest version in the releases given by URL by using REGEX." - (let ((url-request-method "GET")) - (with-current-buffer (url-retrieve-synchronously url) - (goto-char (point-min)) - (re-search-forward "\n\n" nil 'noerror) - (delete-region (point-min) (point)) - (let* ((json-result (lsp-json-read-buffer))) - (message "Latest version found: %s" (lsp-get json-result :tag_name)) - (--> json-result - (lsp-get it :assets) - (seq-find (lambda (entry) (string-match-p regex (lsp-get entry :name))) it) - (lsp-get it :browser_download_url)))))) - -;; unzip - -(defconst lsp-ext-pwsh-script "powershell -noprofile -noninteractive \ --nologo -ex bypass -command Expand-Archive -path '%s' -dest '%s'" - "Powershell script to unzip file.") - -(defconst lsp-ext-unzip-script "bash -c 'mkdir -p %2$s && unzip -qq -o %1$s -d %2$s'" - "Unzip script to unzip file.") - -(defcustom lsp-unzip-script (lambda () - (cond ((executable-find "unzip") lsp-ext-unzip-script) - ((executable-find "powershell") lsp-ext-pwsh-script) - (t nil))) - "The script to unzip." - :group 'lsp-mode - :type 'string - :package-version '(lsp-mode . "8.0.0")) - -(defun lsp-unzip (zip-file dest) - "Unzip ZIP-FILE to DEST." - (unless lsp-unzip-script - (error "Unable to find `unzip' or `powershell' on the path, please customize `lsp-unzip-script'")) - (shell-command (format (lsp-resolve-value lsp-unzip-script) zip-file dest))) - -;; gunzip - -(defconst lsp-ext-gunzip-script "gzip -d %1$s" - "Script to decompress a gzippped file with gzip.") - -(defcustom lsp-gunzip-script (lambda () - (cond ((executable-find "gzip") lsp-ext-gunzip-script) - (t nil))) - "The script to decompress a gzipped file. -Should be a format string with one argument for the file to be decompressed -in place." - :group 'lsp-mode - :type 'string - :package-version '(lsp-mode . "8.0.0")) - -(defun lsp-gunzip (gz-file) - "Decompress GZ-FILE in place." - (unless lsp-gunzip-script - (error "Unable to find `gzip' on the path, please either customize `lsp-gunzip-script' or manually decompress %s" gz-file)) - (shell-command (format (lsp-resolve-value lsp-gunzip-script) gz-file))) - -;; tar.gz decompression - -(defconst lsp-ext-tar-script "bash -c 'mkdir -p %2$s; tar xf %1$s --directory=%2$s'" - "Script to decompress a .tar.gz file.") - -(defcustom lsp-tar-script (lambda () - (cond ((executable-find "tar") lsp-ext-tar-script) - (t nil))) - "The script to decompress a .tar.gz file. -Should be a format string with one argument for the file to be decompressed -in place." - :group 'lsp-mode - :type 'string) - -(defun lsp-tar-gz-decompress (targz-file dest) - "Decompress TARGZ-FILE in DEST." - (unless lsp-tar-script - (error "Unable to find `tar' on the path, please either customize `lsp-tar-script' or manually decompress %s" targz-file)) - (shell-command (format (lsp-resolve-value lsp-tar-script) targz-file dest))) - - -;; VSCode marketplace - -(defcustom lsp-vscode-ext-url - "https://marketplace.visualstudio.com/_apis/public/gallery/publishers/%s/vsextensions/%s/%s/vspackage%s" - "Vscode extension template url." - :group 'lsp-mode - :type 'string - :package-version '(lsp-mode . "8.0.0")) - -(defun lsp-vscode-extension-url (publisher name version &optional targetPlatform) - "Return the URL to vscode extension. -PUBLISHER is the extension publisher. -NAME is the name of the extension. -VERSION is the version of the extension. -TARGETPLATFORM is the targetPlatform of the extension." - (format lsp-vscode-ext-url publisher name version (or targetPlatform ""))) - - - -;; Queueing prompts - -(defvar lsp--question-queue nil - "List of questions yet to be asked by `lsp-ask-question'.") - -(defun lsp-ask-question (question options callback) - "Prompt the user to answer the QUESTION with one of the OPTIONS from the -minibuffer. Once the user selects an option, the CALLBACK function will be -called, passing the selected option to it. - -If the user is currently being shown a question, the question will be stored in -`lsp--question-queue', and will be asked once the user has answered the current -question." - (add-to-list 'lsp--question-queue `(("question" . ,question) - ("options" . ,options) - ("callback" . ,callback)) t) - (when (eq (length lsp--question-queue) 1) - (lsp--process-question-queue))) - -(defun lsp--process-question-queue () - "Take the first question from `lsp--question-queue', process it, then process -the next question until the queue is empty." - (-let* (((&alist "question" "options" "callback") (car lsp--question-queue)) - (answer (completing-read question options nil t))) - (pop lsp--question-queue) - (funcall callback answer) - (when lsp--question-queue - (lsp--process-question-queue)))) - -(defun lsp--supports-buffer? (client) - (and - ;; both file and client remote or both local - (eq (---truthy? (file-remote-p (buffer-file-name))) - (---truthy? (lsp--client-remote? client))) - - ;; activation function or major-mode match. - (if-let ((activation-fn (lsp--client-activation-fn client))) - (funcall activation-fn (buffer-file-name) major-mode) - (-contains? (lsp--client-major-modes client) major-mode)) - - ;; check whether it is enabled if `lsp-enabled-clients' is not null - (or (null lsp-enabled-clients) - (or (member (lsp--client-server-id client) lsp-enabled-clients) - (ignore (lsp--info "Client %s is not in lsp-enabled-clients" - (lsp--client-server-id client))))) - - ;; check whether it is not disabled. - (not (lsp--client-disabled-p major-mode (lsp--client-server-id client))))) - -(defun lsp--filter-clients (pred) - (->> lsp-clients hash-table-values (-filter pred))) - -(defun lsp--find-clients () - "Find clients which can handle current buffer." - (-when-let (matching-clients (lsp--filter-clients (-andfn #'lsp--supports-buffer? - #'lsp--server-binary-present?))) - (lsp-log "Found the following clients for %s: %s" - (buffer-file-name) - (s-join ", " - (-map (lambda (client) - (format "(server-id %s, priority %s)" - (lsp--client-server-id client) - (lsp--client-priority client))) - matching-clients))) - (-let* (((add-on-clients main-clients) (-separate #'lsp--client-add-on? matching-clients)) - (selected-clients (if-let ((main-client (and main-clients - (--max-by (> (lsp--client-priority it) - (lsp--client-priority other)) - main-clients)))) - (cons main-client add-on-clients) - add-on-clients))) - (lsp-log "The following clients were selected based on priority: %s" - (s-join ", " - (-map (lambda (client) - (format "(server-id %s, priority %s)" - (lsp--client-server-id client) - (lsp--client-priority client))) - selected-clients))) - selected-clients))) - -(defun lsp-workspace-remove-all-folders() - "Delete all lsp tracked folders." - (interactive) - (--each (lsp-session-folders (lsp-session)) - (lsp-workspace-folders-remove it))) - -(defun lsp-register-client (client) - "Registers LSP client CLIENT." - (let ((client-id (lsp--client-server-id client))) - (puthash client-id client lsp-clients) - (setplist (intern (format "lsp-%s-after-open-hook" client-id)) - `( standard-value (nil) custom-type hook - custom-package-version (lsp-mode . "7.0.1") - variable-documentation ,(format "Hooks to run after `%s' server is run." client-id) - custom-requests nil))) - (when (and lsp-auto-register-remote-clients - (not (lsp--client-remote? client))) - (let ((remote-client (copy-lsp--client client))) - (setf (lsp--client-remote? remote-client) t - (lsp--client-server-id remote-client) (intern - (format "%s-tramp" - (lsp--client-server-id client))) - ;; disable automatic download - (lsp--client-download-server-fn remote-client) nil) - (lsp-register-client remote-client)))) - -(defun lsp--create-initialization-options (_session client) - "Create initialization-options from SESSION and CLIENT. -Add workspace folders depending on server being multiroot and -session workspace folder configuration for the server." - (let* ((initialization-options-or-fn (lsp--client-initialization-options client))) - (if (functionp initialization-options-or-fn) - (funcall initialization-options-or-fn) - initialization-options-or-fn))) - -(defvar lsp-client-settings (make-hash-table :test 'equal) - "For internal use, any external users please use - `lsp-register-custom-settings' function instead") - -(defun lsp-register-custom-settings (props) - "Register PROPS. -PROPS is list of triple (path value boolean?) where PATH is the path to the -property; VALUE can be a literal value, symbol to be evaluated, or either a -function or lambda function to be called without arguments; BOOLEAN? is an -optional flag that should be non-nil for boolean settings, when it is nil the -property will be ignored if the VALUE is nil. - -Example: `(lsp-register-custom-settings `((\"foo.bar.buzz.enabled\" t t)))' -\(note the double parentheses)" - (mapc - (-lambda ((path . rest)) - (puthash path rest lsp-client-settings)) - props)) - -(defun lsp-region-text (region) - "Get the text for REGION in current buffer." - (-let (((start . end) (lsp--range-to-region region))) - (buffer-substring-no-properties start end))) - -(defun lsp-ht-set (tbl paths value) - "Set nested hash table value. -TBL - a hash table, PATHS is the path to the nested VALUE." - (pcase paths - (`(,path) (ht-set! tbl path value)) - (`(,path . ,rst) (let ((nested-tbl (or (gethash path tbl) - (let ((temp-tbl (ht))) - (ht-set! tbl path temp-tbl) - temp-tbl)))) - (lsp-ht-set nested-tbl rst value))))) - -;; sections - -(defalias 'defcustom-lsp 'lsp-defcustom) - -(defmacro lsp-defcustom (symbol standard doc &rest args) - "Defines `lsp-mode' server property." - (declare (doc-string 3) (debug (name body)) - (indent defun)) - (let ((path (plist-get args :lsp-path))) - (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))) - (maphash (-lambda (path (variable boolean?)) - (when (s-matches? (concat (regexp-quote section) "\\..*") path) - (let* ((symbol-value (-> variable - lsp-resolve-value - lsp-resolve-value)) - (value (if (and boolean? (not symbol-value)) - :json-false - symbol-value))) - (when (or boolean? value) - (lsp-ht-set ret (s-split "\\." path) value))))) - lsp-client-settings) - ret)) - - -(defun lsp--start-connection (session client project-root) - "Initiates connection created from CLIENT for PROJECT-ROOT. -SESSION is the active session." - (when (lsp--client-multi-root client) - (cl-pushnew project-root (gethash (lsp--client-server-id client) - (lsp-session-server-id->folders session)))) - (run-hook-with-args 'lsp-workspace-folders-changed-functions (list project-root) nil) - - (unwind-protect - (lsp--start-workspace session client project-root (lsp--create-initialization-options session client)) - (lsp--spinner-stop))) - -;; lsp-log-io-mode - -(defvar lsp-log-io-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "M-n") #'lsp-log-io-next) - (define-key map (kbd "M-p") #'lsp-log-io-prev) - (define-key map (kbd "k") #'lsp--erase-log-buffer) - (define-key map (kbd "K") #'lsp--erase-session-log-buffers) - map) - "Keymap for lsp log buffer mode.") - -(define-derived-mode lsp-log-io-mode special-mode "LspLogIo" - "Special mode for viewing IO logs.") - -(defun lsp-workspace-show-log (workspace) - "Display the log buffer of WORKSPACE." - (interactive - (list (if lsp-log-io - (if (eq (length (lsp-workspaces)) 1) - (cl-first (lsp-workspaces)) - (lsp--completing-read "Workspace: " (lsp-workspaces) - #'lsp--workspace-print nil t)) - (user-error "IO logging is disabled")))) - (pop-to-buffer (lsp--get-log-buffer-create workspace))) - -(defalias 'lsp-switch-to-io-log-buffer 'lsp-workspace-show-log) - -(defun lsp--get-log-buffer-create (workspace) - "Return the lsp log buffer of WORKSPACE, creating a new one if needed." - (let* ((server-id (-> workspace lsp--workspace-client lsp--client-server-id symbol-name)) - (pid (-> workspace lsp--workspace-cmd-proc lsp-process-id))) - (get-buffer-create (format "*lsp-log: %s:%s*" server-id pid)))) - -(defun lsp--erase-log-buffer (&optional all) - "Delete contents of current lsp log buffer. -When ALL is t, erase all log buffers of the running session." - (interactive) - (let* ((workspaces (lsp--session-workspaces (lsp-session))) - (current-log-buffer (current-buffer))) - (dolist (w workspaces) - (let ((b (lsp--get-log-buffer-create w))) - (when (or all (eq b current-log-buffer)) - (with-current-buffer b - (let ((inhibit-read-only t)) - (erase-buffer)))))))) - -(defun lsp--erase-session-log-buffers () - "Erase log buffers of the running session." - (interactive) - (lsp--erase-log-buffer t)) - -(defun lsp-log-io-next (arg) - "Move to next log entry." - (interactive "P") - (ewoc-goto-next lsp--log-io-ewoc (or arg 1))) - -(defun lsp-log-io-prev (arg) - "Move to previous log entry." - (interactive "P") - (ewoc-goto-prev lsp--log-io-ewoc (or arg 1))) - - - -(cl-defmethod lsp-process-id ((process process)) - (process-id process)) - -(cl-defmethod lsp-process-name ((process process)) (process-name process)) - -(cl-defmethod lsp-process-status ((process process)) (process-status process)) - -(cl-defmethod lsp-process-kill ((process process)) - (when (process-live-p process) - (kill-process process))) - -(cl-defmethod lsp-process-send ((process process) message) - (condition-case err - (process-send-string process (lsp--make-message message)) - (error (lsp--error "Sending to process failed with the following error: %s" - (error-message-string err))))) - -(cl-defmethod lsp-process-cleanup (process) - ;; Kill standard error buffer only if the process exited normally. - ;; Leave it intact otherwise for debugging purposes. - (let ((buffer (-> process process-name get-buffer))) - (when (and (eq (process-status process) 'exit) - (zerop (process-exit-status process)) - (buffer-live-p buffer)) - (kill-buffer buffer)))) - - -;; native JSONRPC - -(declare-function json-rpc "ext:json") -(declare-function json-rpc-connection "ext:json") -(declare-function json-rpc-send "ext:json") -(declare-function json-rpc-shutdown "ext:json") -(declare-function json-rpc-stderr "ext:json") -(declare-function json-rpc-pid "ext:json") - -(defvar lsp-json-rpc-thread nil) -(defvar lsp-json-rpc-queue nil) -(defvar lsp-json-rpc-done nil) -(defvar lsp-json-rpc-mutex (make-mutex)) -(defvar lsp-json-rpc-condition (make-condition-variable lsp-json-rpc-mutex)) - -(defun lsp-json-rpc-process-queue () - (while (not lsp-json-rpc-done) - (while lsp-json-rpc-queue - (-let (((proc . message) (pop lsp-json-rpc-queue))) - (json-rpc-send - proc message - :null-object nil - :false-object :json-false))) - (with-mutex lsp-json-rpc-mutex - (condition-wait lsp-json-rpc-condition)))) - -(cl-defmethod lsp-process-id (process) (json-rpc-pid process)) - -(cl-defmethod lsp-process-name (_process) "TBD") - -(cl-defmethod lsp-process-kill (process) (json-rpc-shutdown process)) - -(cl-defmethod lsp-process-send (proc message) - (unless lsp-json-rpc-thread - (with-current-buffer (get-buffer-create " *json-rpc*") - (setq lsp-json-rpc-thread (make-thread #'lsp-json-rpc-process-queue "*json-rpc-queue*")))) - - (with-mutex lsp-json-rpc-mutex - (setq lsp-json-rpc-queue (append lsp-json-rpc-queue - (list (cons proc message)))) - (condition-notify lsp-json-rpc-condition))) - -(cl-defmethod lsp-process-cleanup (_proc)) - -(defun lsp-json-rpc-connection (workspace command) - (let ((con (apply #'json-rpc-connection command)) - (object-type (if lsp-use-plists 'plist 'hash-table))) - (with-current-buffer (get-buffer-create " *json-rpc*") - (make-thread - (lambda () - (json-rpc - con - (lambda (result err done) - (run-with-timer - 0.0 - nil - (lambda () - (cond - (result (lsp--parser-on-message result workspace)) - (err (warn "Json parsing failed with the following error: %s" err)) - (done (lsp--handle-process-exit workspace "")))))) - :object-type object-type - :null-object nil - :false-object nil)) - "*json-rpc-connection*")) - (cons con con))) - -(defun lsp-json-rpc-stderr () - (interactive) - (--when-let (pcase (lsp-workspaces) - (`nil (user-error "There are no active servers in the current buffer")) - (`(,workspace) workspace) - (workspaces (lsp--completing-read "Select server: " - workspaces - 'lsp--workspace-print nil t))) - (let ((content (json-rpc-stderr (lsp--workspace-cmd-proc it))) - (buffer (format "*stderr-%s*" (lsp--workspace-print it)) )) - (with-current-buffer (get-buffer-create buffer) - (with-help-window buffer - (insert content)))))) - - -(defun lsp--workspace-print (workspace) - "Visual representation WORKSPACE." - (let* ((proc (lsp--workspace-cmd-proc workspace)) - (status (lsp--workspace-status workspace)) - (server-id (-> workspace lsp--workspace-client lsp--client-server-id symbol-name)) - (pid (lsp-process-id proc))) - - (if (eq 'initialized status) - (format "%s:%s" server-id pid) - (format "%s:%s/%s" server-id pid status)))) - -(defun lsp--map-tree-widget (m) - "Build `tree-widget' from a hash-table or plist M." - (when (lsp-structure-p m) - (let (nodes) - (lsp-map (lambda (k v) - (push `(tree-widget - :tag ,(if (lsp-structure-p v) - (format "%s:" k) - (format "%s: %s" k - (propertize (format "%s" v) - 'face - 'font-lock-string-face))) - :open t - ,@(lsp--map-tree-widget v)) - nodes)) - m) - nodes))) - -(defun lsp-buffer-name (buffer-id) - (if-let ((buffer-name (plist-get buffer-id :buffer-name))) - (funcall buffer-name buffer-id) - (buffer-name buffer-id))) - -(defun lsp--render-workspace (workspace) - "Tree node representation of WORKSPACE." - `(tree-widget :tag ,(lsp--workspace-print workspace) - :open t - (tree-widget :tag ,(propertize "Buffers" 'face 'font-lock-function-name-face) - :open t - ,@(->> workspace - (lsp--workspace-buffers) - (--map `(tree-widget - :tag ,(when (lsp-buffer-live-p it) - (let ((buffer-name (lsp-buffer-name it))) - (if (lsp-with-current-buffer it buffer-read-only) - (propertize buffer-name 'face 'font-lock-constant-face) - buffer-name))))))) - (tree-widget :tag ,(propertize "Capabilities" 'face 'font-lock-function-name-face) - ,@(-> workspace lsp--workspace-server-capabilities lsp--map-tree-widget)))) - -(define-derived-mode lsp-browser-mode special-mode "LspBrowser" - "Define mode for displaying lsp sessions." - (setq-local display-buffer-base-action '(nil . ((inhibit-same-window . t))))) - -(defun lsp-describe-session () - "Describes current `lsp-session'." - (interactive) - (let ((session (lsp-session)) - (buf (get-buffer-create "*lsp session*")) - (root (lsp-workspace-root))) - (with-current-buffer buf - (lsp-browser-mode) - (let ((inhibit-read-only t)) - (erase-buffer) - (--each (lsp-session-folders session) - (widget-create - `(tree-widget - :tag ,(propertize it 'face 'font-lock-keyword-face) - :open t - ,@(->> session - (lsp-session-folder->servers) - (gethash it) - (-map 'lsp--render-workspace))))))) - (pop-to-buffer buf) - (goto-char (point-min)) - (cl-loop for tag = (widget-get (widget-get (widget-at) :node) :tag) - until (or (and root (string= tag root)) (eobp)) - do (goto-char (next-overlay-change (point)))))) - -(defun lsp--session-workspaces (session) - "Get all workspaces that are part of the SESSION." - (-> session lsp-session-folder->servers hash-table-values -flatten -uniq)) - -(defun lsp--find-multiroot-workspace (session client project-root) - "Look for a multiroot connection in SESSION created from CLIENT for -PROJECT-ROOT and BUFFER-MAJOR-MODE." - (when (lsp--client-multi-root client) - (-when-let (multi-root-workspace (->> session - (lsp--session-workspaces) - (--first (eq (-> it lsp--workspace-client lsp--client-server-id) - (lsp--client-server-id client))))) - (with-lsp-workspace multi-root-workspace - (lsp-notify "workspace/didChangeWorkspaceFolders" - (lsp-make-did-change-workspace-folders-params - :event (lsp-make-workspace-folders-change-event - :added (vector (lsp-make-workspace-folder - :uri (lsp--path-to-uri project-root) - :name (f-filename project-root))) - :removed [])))) - - (->> session (lsp-session-folder->servers) (gethash project-root) (cl-pushnew multi-root-workspace)) - (->> session (lsp-session-server-id->folders) (gethash (lsp--client-server-id client)) (cl-pushnew project-root)) - - (lsp--persist-session session) - - (lsp--info "Opened folder %s in workspace %s" project-root (lsp--workspace-print multi-root-workspace)) - (lsp--open-in-workspace multi-root-workspace) - - multi-root-workspace))) - -(defun lsp--ensure-lsp-servers (session clients project-root ignore-multi-folder) - "Ensure that SESSION contain server CLIENTS created for PROJECT-ROOT. -IGNORE-MULTI-FOLDER to ignore multi folder server." - (-map (lambda (client) - (or - (lsp--find-workspace session client project-root) - (unless ignore-multi-folder - (lsp--find-multiroot-workspace session client project-root)) - (lsp--start-connection session client project-root))) - clients)) - -(defun lsp--spinner-stop () - "Stop the spinner in case all of the workspaces are started." - (when (--all? (eq (lsp--workspace-status it) 'initialized) - lsp--buffer-workspaces) - (spinner-stop))) - -(defun lsp--open-in-workspace (workspace) - "Open in existing WORKSPACE." - (if (eq 'initialized (lsp--workspace-status workspace)) - ;; when workspace is initialized just call document did open. - (progn - (with-lsp-workspace workspace - (when-let ((before-document-open-fn (-> workspace - lsp--workspace-client - lsp--client-before-file-open-fn))) - (funcall before-document-open-fn workspace)) - (lsp--text-document-did-open)) - (lsp--spinner-stop)) - ;; when it is not initialized - (lsp--spinner-start) - (cl-pushnew (lsp-current-buffer) (lsp--workspace-buffers workspace)))) - -(defun lsp--find-workspace (session client project-root) - "Find server connection created with CLIENT in SESSION for PROJECT-ROOT." - (when-let ((workspace (->> session - (lsp-session-folder->servers) - (gethash project-root) - (--first (eql (-> it lsp--workspace-client lsp--client-server-id) - (lsp--client-server-id client)))))) - (lsp--open-in-workspace workspace) - workspace)) - -(defun lsp--read-char (prompt &optional options) - "Wrapper for `read-char-from-minibuffer' if Emacs +27. -Fallback to `read-key' otherwise. -PROMPT is the message and OPTIONS the available options." - (if (fboundp 'read-char-from-minibuffer) - (read-char-from-minibuffer prompt options) - (read-key prompt))) - -(defun lsp--find-root-interactively (session) - "Find project interactively. -Returns nil if the project should not be added to the current SESSION." - (condition-case nil - (let* ((project-root-suggestion (or (lsp--suggest-project-root) default-directory)) - (action (lsp--read-char - (format - "%s is not part of any project. - -%s ==> Import project root %s -%s ==> Import project by selecting root directory interactively -%s ==> Import project at current directory %s -%s ==> Do not ask again for the current project by adding %s to lsp-session-folders-blocklist -%s ==> Do not ask again for the current project by selecting ignore path interactively -%s ==> Do nothing: ask again when opening other files from the current project - -Select action: " - (propertize (buffer-name) 'face 'bold) - (propertize "i" 'face 'success) - (propertize project-root-suggestion 'face 'bold) - (propertize "I" 'face 'success) - (propertize "." 'face 'success) - (propertize default-directory 'face 'bold) - (propertize "d" 'face 'warning) - (propertize project-root-suggestion 'face 'bold) - (propertize "D" 'face 'warning) - (propertize "n" 'face 'warning)) - '(?i ?\r ?I ?. ?d ?D ?n)))) - (cl-case action - (?i project-root-suggestion) - (?\r project-root-suggestion) - (?I (read-directory-name "Select workspace folder to add: " - (or project-root-suggestion default-directory) - nil - t)) - (?. default-directory) - (?d (push project-root-suggestion (lsp-session-folders-blocklist session)) - (lsp--persist-session session) - nil) - (?D (push (read-directory-name "Select folder to blocklist: " - (or project-root-suggestion default-directory) - nil - t) - (lsp-session-folders-blocklist session)) - (lsp--persist-session session) - nil) - (t nil))) - (quit))) - -(declare-function tramp-file-name-host "ext:tramp" (file) t) -(declare-function tramp-dissect-file-name "ext:tramp" (file &optional nodefault)) - -(defun lsp--files-same-host (f1 f2) - "Predicate on whether or not two files are on the same host." - (or (not (or (file-remote-p f1) (file-remote-p f2))) - (and (file-remote-p f1) - (file-remote-p f2) - (progn (require 'tramp) - (equal (tramp-file-name-host (tramp-dissect-file-name f1)) - (tramp-file-name-host (tramp-dissect-file-name f2))))))) - -(defun lsp-find-session-folder (session file-name) - "Look in the current SESSION for folder containing FILE-NAME." - (let ((file-name-canonical (lsp-f-canonical file-name))) - (->> session - (lsp-session-folders) - (--filter (and (lsp--files-same-host it file-name-canonical) - (or (lsp-f-same? it file-name-canonical) - (and (f-dir? it) - (lsp-f-ancestor-of? it file-name-canonical))))) - (--max-by (> (length it) - (length other)))))) - -(defun lsp-find-workspace (server-id &optional file-name) - "Find workspace for SERVER-ID for FILE-NAME." - (-when-let* ((session (lsp-session)) - (folder->servers (lsp-session-folder->servers session)) - (workspaces (if file-name - (gethash (lsp-find-session-folder session file-name) folder->servers) - (lsp--session-workspaces session)))) - - (--first (eq (lsp--client-server-id (lsp--workspace-client it)) server-id) workspaces))) - -(defun lsp--calculate-root (session file-name) - "Calculate project root for FILE-NAME in SESSION." - (and - (->> session - (lsp-session-folders-blocklist) - (--first (and (lsp--files-same-host it file-name) - (lsp-f-ancestor-of? it file-name) - (prog1 t - (lsp--info "File %s is in blocklisted directory %s" file-name it)))) - not) - (or - (when lsp-auto-guess-root - (lsp--suggest-project-root)) - (unless lsp-guess-root-without-session - (lsp-find-session-folder session file-name)) - (unless lsp-auto-guess-root - (when-let ((root-folder (lsp--find-root-interactively session))) - (if (or (not (f-equal? root-folder (expand-file-name "~/"))) - (yes-or-no-p - (concat - (propertize "[WARNING] " 'face 'warning) - "You are trying to import your home folder as project root. This may cause performance issue because some language servers (python, lua, etc) will try to scan all files under project root. To avoid that you may: - -1. Use `I' option from the interactive project import to select subfolder(e. g. `~/foo/bar' instead of `~/'). -2. If your file is under `~/' then create a subfolder and move that file in this folder. - -Type `No' to go back to project selection. -Type `Yes' to confirm `HOME' as project root. -Type `C-g' to cancel project import process and stop `lsp'"))) - root-folder - (lsp--calculate-root session file-name))))))) - -(defun lsp--try-open-in-library-workspace () - "Try opening current file as library file in any of the active workspace. -The library folders are defined by each client for each of the active workspace." - (when-let ((workspace (->> (lsp-session) - (lsp--session-workspaces) - ;; Sort the last active workspaces first as they are more likely to be - ;; the correct ones, especially when jumping to a definition. - (-sort (lambda (a _b) - (-contains? lsp--last-active-workspaces a))) - (--first - (and (-> it lsp--workspace-client lsp--supports-buffer?) - (when-let ((library-folders-fn - (-> it lsp--workspace-client lsp--client-library-folders-fn))) - (-first (lambda (library-folder) - (lsp-f-ancestor-of? library-folder (buffer-file-name))) - (funcall library-folders-fn it)))))))) - (lsp--open-in-workspace workspace) - (view-mode t) - (lsp--info "Opening read-only library file %s." (buffer-file-name)) - (list workspace))) - -(defun lsp--persist-session (session) - "Persist SESSION to `lsp-session-file'." - (lsp--persist lsp-session-file (make-lsp-session - :folders (lsp-session-folders session) - :folders-blocklist (lsp-session-folders-blocklist session) - :server-id->folders (lsp-session-server-id->folders session)))) - -(defun lsp--try-project-root-workspaces (ask-for-client ignore-multi-folder) - "Try create opening file as a project file. -When IGNORE-MULTI-FOLDER is t the lsp mode will start new -language server even if there is language server which can handle -current language. When IGNORE-MULTI-FOLDER is nil current file -will be opened in multi folder language server if there is -such." - (-let ((session (lsp-session))) - (-if-let (clients (if ask-for-client - (list (lsp--completing-read "Select server to start: " - (ht-values lsp-clients) - (-compose 'symbol-name 'lsp--client-server-id) nil t)) - (lsp--find-clients))) - (-if-let (project-root (-some-> session - (lsp--calculate-root (buffer-file-name)) - (lsp-f-canonical))) - (progn - ;; update project roots if needed and persist the lsp session - (unless (-contains? (lsp-session-folders session) project-root) - (cl-pushnew project-root (lsp-session-folders session)) - (lsp--persist-session session)) - (lsp--ensure-lsp-servers session clients project-root ignore-multi-folder)) - (lsp--warn "%s not in project or it is blocklisted." (buffer-name)) - nil) - (lsp--warn "No LSP server for %s(check *lsp-log*)." major-mode) - nil))) - -(defun lsp-shutdown-workspace () - "Shutdown language server." - (interactive) - (--when-let (pcase (lsp-workspaces) - (`nil (user-error "There are no active servers in the current buffer")) - (`(,workspace) (when (y-or-n-p (format "Are you sure you want to stop the server %s?" - (lsp--workspace-print workspace))) - workspace)) - (workspaces (lsp--completing-read "Select server: " - workspaces - 'lsp--workspace-print nil t))) - (lsp-workspace-shutdown it))) - -(make-obsolete 'lsp-shutdown-workspace 'lsp-workspace-shutdown "lsp-mode 6.1") - -(defcustom lsp-auto-select-workspace t - "Shutdown or restart a single workspace. -If set and the current buffer has only a single workspace -associated with it, `lsp-shutdown-workspace' and -`lsp-restart-workspace' will act on it without asking." - :type 'boolean - :group 'lsp-mode) - -(defun lsp--read-workspace () - "Ask the user to select a workspace. -Errors if there are none." - (pcase (lsp-workspaces) - (`nil (error "No workspaces associated with the current buffer")) - ((and `(,workspace) (guard lsp-auto-select-workspace)) workspace) - (workspaces (lsp--completing-read "Select workspace: " workspaces - #'lsp--workspace-print nil t)))) - -(defun lsp-workspace-shutdown (workspace) - "Shut the workspace WORKSPACE and the language server associated with it" - (interactive (list (lsp--read-workspace))) - (lsp--warn "Stopping %s" (lsp--workspace-print workspace)) - (with-lsp-workspace workspace (lsp--shutdown-workspace))) - -(defun lsp-disconnect () - "Disconnect the buffer from the language server." - (interactive) - (lsp--text-document-did-close t) - (lsp-managed-mode -1) - (lsp-mode -1) - (setq lsp--buffer-workspaces nil) - (lsp--info "Disconnected")) - -(defun lsp-restart-workspace () - (interactive) - (--when-let (pcase (lsp-workspaces) - (`nil (user-error "There are no active servers in the current buffer")) - (`(,workspace) workspace) - (workspaces (lsp--completing-read "Select server: " - workspaces - 'lsp--workspace-print nil t))) - (lsp-workspace-restart it))) - -(make-obsolete 'lsp-restart-workspace 'lsp-workspace-restart "lsp-mode 6.1") - -(defun lsp-workspace-restart (workspace) - "Restart the workspace WORKSPACE and the language server associated with it" - (interactive (list (lsp--read-workspace))) - (lsp--warn "Restarting %s" (lsp--workspace-print workspace)) - (with-lsp-workspace workspace (lsp--shutdown-workspace t))) - -;;;###autoload -(defun lsp (&optional arg) - "Entry point for the server startup. -When ARG is t the lsp mode will start new language server even if -there is language server which can handle current language. When -ARG is nil current file will be opened in multi folder language -server if there is such. When `lsp' is called with prefix -argument ask the user to select which language server to start." - (interactive "P") - - (lsp--require-packages) - - (when (buffer-file-name) - (let (clients - (matching-clients (lsp--filter-clients - (-andfn #'lsp--supports-buffer? - #'lsp--server-binary-present?)))) - (cond - (matching-clients - (when (setq lsp--buffer-workspaces - (or (and - ;; Don't open as library file if file is part of a project. - (not (lsp-find-session-folder (lsp-session) (buffer-file-name))) - (lsp--try-open-in-library-workspace)) - (lsp--try-project-root-workspaces (equal arg '(4)) - (and arg (not (equal arg 1)))))) - (lsp-mode 1) - (when lsp-auto-configure (lsp--auto-configure)) - (setq lsp-buffer-uri (lsp--buffer-uri)) - (lsp--info "Connected to %s." - (apply 'concat (--map (format "[%s %s]" - (lsp--workspace-print it) - (lsp--workspace-root it)) - lsp--buffer-workspaces))))) - ;; look for servers which are currently being downloaded. - ((setq clients (lsp--filter-clients (-andfn #'lsp--supports-buffer? - #'lsp--client-download-in-progress?))) - (lsp--info "There are language server(%s) installation in progress. -The server(s) will be started in the buffer when it has finished." - (-map #'lsp--client-server-id clients)) - (seq-do (lambda (client) - (cl-pushnew (current-buffer) (lsp--client-buffers client))) - clients)) - ;; look for servers to install - ((setq clients (lsp--filter-clients - (-andfn #'lsp--supports-buffer? - (-const lsp-enable-suggest-server-download) - #'lsp--client-download-server-fn - (-not #'lsp--client-download-in-progress?)))) - (let ((client (lsp--completing-read - (concat "Unable to find installed server supporting this file. " - "The following servers could be installed automatically: ") - clients - (-compose #'symbol-name #'lsp--client-server-id) - nil - t))) - (cl-pushnew (current-buffer) (lsp--client-buffers client)) - (lsp--install-server-internal client))) - ;; ignore other warnings - ((not lsp-warn-no-matched-clients) - nil) - ;; automatic installation disabled - ((setq clients (unless matching-clients - (lsp--filter-clients (-andfn #'lsp--supports-buffer? - #'lsp--client-download-server-fn - (-not (-const lsp-enable-suggest-server-download)) - (-not #'lsp--server-binary-present?))))) - (lsp--warn "The following servers support current file but automatic download is disabled: %s -\(If you have already installed the server check *lsp-log*)." - (mapconcat (lambda (client) - (symbol-name (lsp--client-server-id client))) - clients - " "))) - ;; no clients present - ((setq clients (unless matching-clients - (lsp--filter-clients (-andfn #'lsp--supports-buffer? - (-not #'lsp--server-binary-present?))))) - (lsp--warn "The following servers support current file but do not have automatic installation: %s -You may find the installation instructions at https://emacs-lsp.github.io/lsp-mode/page/languages. -\(If you have already installed the server check *lsp-log*)." - (mapconcat (lambda (client) - (symbol-name (lsp--client-server-id client))) - clients - " "))) - ;; no matches - ((-> #'lsp--supports-buffer? lsp--filter-clients not) - (lsp--error "There are no language servers supporting current mode `%s' registered with `lsp-mode'. -This issue might be caused by: -1. The language you are trying to use does not have built-in support in `lsp-mode'. You must install the required support manually. Examples of this are `lsp-java' or `lsp-metals'. -2. The language server that you expect to run is not configured to run for major mode `%s'. You may check that by checking the `:major-modes' that are passed to `lsp-register-client'. -3. `lsp-mode' doesn't have any integration for the language behind `%s'. Refer to https://emacs-lsp.github.io/lsp-mode/page/languages and https://langserver.org/ . -4. You are over `tramp'. In this case follow https://emacs-lsp.github.io/lsp-mode/page/remote/. -5. You have disabled the `lsp-mode' clients for that file. (Check `lsp-enabled-clients' and `lsp-disabled-clients'). -You can customize `lsp-warn-no-matched-clients' to disable this message." - major-mode major-mode major-mode)))))) - -(defun lsp--buffer-visible-p () - "Return non nil if current buffer is visible." - (or (buffer-modified-p) (get-buffer-window nil t))) - -(defun lsp--init-if-visible () - "Run `lsp' for the current buffer if the buffer is visible. -Returns non nil if `lsp' was run for the buffer." - (when (lsp--buffer-visible-p) - (remove-hook 'window-configuration-change-hook #'lsp--init-if-visible t) - (lsp) - t)) - -;;;###autoload -(defun lsp-deferred () - "Entry point that defers server startup until buffer is visible. -`lsp-deferred' will wait until the buffer is visible before invoking `lsp'. -This avoids overloading the server with many files when starting Emacs." - ;; Workspace may not be initialized yet. Use a buffer local variable to - ;; remember that we deferred loading of this buffer. - (setq lsp--buffer-deferred t) - (let ((buffer (current-buffer))) - ;; Avoid false positives as desktop-mode restores buffers by deferring - ;; visibility check until the stack clears. - (run-with-idle-timer 0 nil (lambda () - (when (buffer-live-p buffer) - (with-current-buffer buffer - (unless (lsp--init-if-visible) - (add-hook 'window-configuration-change-hook #'lsp--init-if-visible nil t)))))))) - - - -(defvar lsp-file-truename-cache (ht)) - -(defmacro lsp-with-cached-filetrue-name (&rest body) - "Executes BODY caching the `file-truename' calls." - `(let ((old-fn (symbol-function 'file-truename))) - (unwind-protect - (progn - (fset 'file-truename - (lambda (file-name &optional counter prev-dirs) - (or (gethash file-name lsp-file-truename-cache) - (puthash file-name (apply old-fn (list file-name counter prev-dirs)) - lsp-file-truename-cache)))) - ,@body) - (fset 'file-truename old-fn)))) - - -(defun lsp-virtual-buffer-call (key &rest args) - (when lsp--virtual-buffer - (when-let ((fn (plist-get lsp--virtual-buffer key))) - (apply fn args)))) - -(defun lsp-translate-column (column) - "Translate COLUMN taking into account virtual buffers." - (or (lsp-virtual-buffer-call :real->virtual-char column) - column)) - -(defun lsp-translate-line (line) - "Translate LINE taking into account virtual buffers." - (or (lsp-virtual-buffer-call :real->virtual-line line) - line)) - - -;; lsp internal validation. - -(defmacro lsp--doctor (&rest checks) - `(-let [buf (current-buffer)] - (with-current-buffer (get-buffer-create "*lsp-performance*") - (with-help-window (current-buffer) - ,@(-map (-lambda ((msg form)) - `(insert (format "%s: %s\n" ,msg - (let ((res (with-current-buffer buf - ,form))) - (cond - ((eq res :optional) (propertize "OPTIONAL" 'face 'warning)) - (res (propertize "OK" 'face 'success)) - (t (propertize "ERROR" 'face 'error))))))) - (-partition 2 checks)))))) - -(define-obsolete-function-alias 'lsp-diagnose - 'lsp-doctor "lsp-mode 8.0.0") - -(defun lsp-doctor () - "Validate performance settings." - (interactive) - (lsp--doctor - "Checking for Native JSON support" (functionp 'json-serialize) - "Check emacs supports `read-process-output-max'" (boundp 'read-process-output-max) - "Check `read-process-output-max' default has been changed from 4k" - (and (boundp 'read-process-output-max) - (> read-process-output-max 4096)) - "Byte compiled against Native JSON (recompile lsp-mode if failing when Native JSON available)" - (condition-case _err - (progn (lsp--make-message (list "a" "b")) - nil) - (error t)) - "`gc-cons-threshold' increased?" (> gc-cons-threshold 800000) - "Using `plist' for deserialized objects? (refer to https://emacs-lsp.github.io/lsp-mode/page/performance/#use-plists-for-deserialization)" (or lsp-use-plists :optional) - "Using emacs 28+ with native compilation?" - (or (and (fboundp 'native-comp-available-p) - (native-comp-available-p)) - :optional))) - -(declare-function package-version-join "ext:package") -(declare-function package-desc-version "ext:package") -(declare-function package--alist "ext:package") - -(defun lsp-version () - "Return string describing current version of `lsp-mode'." - (interactive) - (unless (featurep 'package) - (require 'package)) - (let ((ver (format "lsp-mode %s, Emacs %s, %s" - (package-version-join - (package-desc-version - (car (alist-get 'lsp-mode (package--alist))))) - emacs-version - system-type))) - (if (called-interactively-p 'interactive) - (lsp--info "%s" ver) - ver))) - - - -;; org-mode/virtual-buffer - -(declare-function org-babel-get-src-block-info "ext:ob-core") -(declare-function org-do-remove-indentation "ext:org-macs") -(declare-function org-src-get-lang-mode "ext:org-src") -(declare-function org-element-context "ext:org-element") - -(defun lsp--virtual-buffer-update-position () - (-if-let (virtual-buffer (-first (-lambda ((&plist :in-range)) - (funcall in-range)) - lsp--virtual-buffer-connections)) - (unless (equal virtual-buffer lsp--virtual-buffer) - (lsp-org)) - (when lsp-managed-mode - (lsp-managed-mode -1) - (lsp-mode -1) - (setq lsp--buffer-workspaces nil) - (setq lsp--virtual-buffer nil) - (setq lsp-buffer-uri nil) - - ;; force refresh of diagnostics - (run-hooks 'lsp-after-diagnostics-hook)))) - -(defun lsp-virtual-buffer-on-change (start end length) - "Adjust on change event to be executed against the proper language server." - (let ((max-point (max end - (or (plist-get lsp--before-change-vals :end) 0) - (+ start length)))) - (when-let ((virtual-buffer (-first (lambda (vb) - (let ((lsp--virtual-buffer vb)) - (and (lsp-virtual-buffer-call :in-range start) - (lsp-virtual-buffer-call :in-range max-point)))) - lsp--virtual-buffer-connections))) - (lsp-with-current-buffer virtual-buffer - (lsp-on-change start end length - (lambda (&rest _) - (list :range (lsp--range (list :character 0 :line 0) - lsp--virtual-buffer-point-max) - :text (lsp--buffer-content)))))))) - -(defun lsp-virtual-buffer-before-change (start _end) - (when-let ((virtual-buffer (-first (lambda (vb) - (lsp-with-current-buffer vb - (lsp-virtual-buffer-call :in-range start))) - lsp--virtual-buffer-connections))) - (lsp-with-current-buffer virtual-buffer - (setq lsp--virtual-buffer-point-max - (lsp--point-to-position (lsp-virtual-buffer-call :last-point)))))) - -(defun lsp-patch-on-change-event () - (remove-hook 'after-change-functions #'lsp-on-change t) - (add-hook 'after-change-functions #'lsp-virtual-buffer-on-change nil t) - (add-hook 'before-change-functions #'lsp-virtual-buffer-before-change nil t)) - -(defun lsp-kill-virtual-buffers () - (mapc #'lsp-virtual-buffer-disconnect lsp--virtual-buffer-connections)) - -(defun lsp--move-point-in-indentation (point indentation) - (save-excursion - (goto-char point) - (if (<= point (+ (line-beginning-position) indentation)) - (line-beginning-position) - point))) - -(declare-function flycheck-checker-supports-major-mode-p "ext:flycheck") -(declare-function flycheck-add-mode "ext:flycheck") -(declare-function lsp-diagnostics-lsp-checker-if-needed "lsp-diagnostics") - -(defalias 'lsp-client-download-server-fn 'lsp--client-download-server-fn) - -(defun lsp-flycheck-add-mode (mode) - "Register flycheck support for MODE." - (lsp-diagnostics-lsp-checker-if-needed) - (unless (flycheck-checker-supports-major-mode-p 'lsp mode) - (flycheck-add-mode 'lsp mode))) - -(defun lsp-progress-spinner-type () - "Retrieve the spinner type value, if value is not a symbol of `spinner-types -defaults to `progress-bar." - (or (car (assoc lsp-progress-spinner-type spinner-types)) 'progress-bar)) - -(defun lsp-org () - (interactive) - (-if-let ((virtual-buffer &as &plist :workspaces) (-first (-lambda ((&plist :in-range)) - (funcall in-range)) - lsp--virtual-buffer-connections)) - (unless (equal lsp--virtual-buffer virtual-buffer) - (setq lsp--buffer-workspaces workspaces) - (setq lsp--virtual-buffer virtual-buffer) - (setq lsp-buffer-uri nil) - (lsp-mode 1) - (lsp-managed-mode 1) - (lsp-patch-on-change-event)) - - (save-excursion - (-let* (virtual-buffer - (wcb (lambda (f) - (with-current-buffer (plist-get virtual-buffer :buffer) - (-let* (((&plist :major-mode :buffer-file-name - :goto-buffer :workspaces) virtual-buffer) - (lsp--virtual-buffer virtual-buffer) - (lsp--buffer-workspaces workspaces)) - (save-excursion - (funcall goto-buffer) - (funcall f)))))) - ((&plist :begin :end :post-blank :language) (cl-second (org-element-context))) - ((&alist :tangle file-name) (cl-third (org-babel-get-src-block-info 'light))) - - (file-name (if file-name - (f-expand file-name) - (user-error "You should specify file name in the src block header."))) - (begin-marker (progn - (goto-char begin) - (forward-line) - (set-marker (make-marker) (point)))) - (end-marker (progn - (goto-char end) - (forward-line (1- (- post-blank))) - (set-marker (make-marker) (1+ (point))))) - (buf (current-buffer)) - (src-block (buffer-substring-no-properties begin-marker - (1- end-marker))) - (indentation (with-temp-buffer - (insert src-block) - - (goto-char (point-min)) - (let ((indentation (current-indentation))) - (plist-put lsp--virtual-buffer :indentation indentation) - (org-do-remove-indentation) - (goto-char (point-min)) - (- indentation (current-indentation)))))) - (add-hook 'post-command-hook #'lsp--virtual-buffer-update-position nil t) - - (when (fboundp 'flycheck-add-mode) - (lsp-flycheck-add-mode 'org-mode)) - - (setq lsp--virtual-buffer - (list - :in-range (lambda (&optional point) - (<= begin-marker (or point (point)) (1- end-marker))) - :goto-buffer (lambda () (goto-char begin-marker)) - :buffer-string - (lambda () - (let ((src-block (buffer-substring-no-properties - begin-marker - (1- end-marker)))) - (with-temp-buffer - (insert src-block) - - (goto-char (point-min)) - (while (not (eobp)) - (delete-region (point) (if (> (+ (point) indentation) (line-end-position)) - (line-end-position) - (+ (point) indentation))) - (forward-line)) - (buffer-substring-no-properties (point-min) - (point-max))))) - :buffer buf - :begin begin-marker - :end end-marker - :indentation indentation - :last-point (lambda () (1- end-marker)) - :cur-position (lambda () - (lsp-save-restriction-and-excursion - (list :line (- (lsp--cur-line) - (lsp--cur-line begin-marker)) - :character (let ((character (- (point) - (line-beginning-position) - indentation))) - (if (< character 0) - 0 - character))))) - :line/character->point (-lambda (line character) - (-let [inhibit-field-text-motion t] - (+ indentation - (lsp-save-restriction-and-excursion - (goto-char begin-marker) - (forward-line line) - (-let [line-end (line-end-position)] - (if (> character (- line-end (point))) - line-end - (forward-char character) - (point))))))) - :major-mode (org-src-get-lang-mode language) - :buffer-file-name file-name - :buffer-uri (lsp--path-to-uri file-name) - :with-current-buffer wcb - :buffer-live? (lambda (_) (buffer-live-p buf)) - :buffer-name (lambda (_) - (propertize (format "%s(%s:%s)%s" - (buffer-name buf) - begin-marker - end-marker - language) - 'face 'italic)) - :real->virtual-line (lambda (line) - (+ line (line-number-at-pos begin-marker) -1)) - :real->virtual-char (lambda (char) (+ char indentation)) - :cleanup (lambda () - (set-marker begin-marker nil) - (set-marker end-marker nil)))) - (setf virtual-buffer lsp--virtual-buffer) - (puthash file-name virtual-buffer lsp--virtual-buffer-mappings) - (push virtual-buffer lsp--virtual-buffer-connections) - - ;; TODO: tangle only connected sections - (add-hook 'after-save-hook 'org-babel-tangle nil t) - (add-hook 'lsp-after-open-hook #'lsp-patch-on-change-event nil t) - (add-hook 'kill-buffer-hook #'lsp-kill-virtual-buffers nil t) - - (setq lsp--buffer-workspaces - (lsp-with-current-buffer virtual-buffer - (lsp) - (plist-put virtual-buffer :workspaces (lsp-workspaces)) - (lsp-workspaces))))))) - -(defun lsp-virtual-buffer-disconnect (virtual-buffer) - (interactive (list (or - lsp--virtual-buffer - (when lsp--virtual-buffer-connections - (lsp--completing-read "Select virtual buffer to disconnect: " - lsp--virtual-buffer-connections - (-lambda ((&plist :buffer-file-name)) - buffer-file-name)))))) - (-if-let ((&plist :buffer-file-name file-name :cleanup) virtual-buffer) - (progn - (lsp-with-current-buffer virtual-buffer - (lsp--text-document-did-close)) - (setq lsp--virtual-buffer-connections (-remove-item virtual-buffer lsp--virtual-buffer-connections)) - (when (eq virtual-buffer lsp--virtual-buffer) - (setf lsp--virtual-buffer nil)) - (when cleanup (funcall cleanup)) - (remhash file-name lsp--virtual-buffer-mappings) - - (lsp--virtual-buffer-update-position) - (lsp--info "Disconnected from buffer %s" file-name)) - (lsp--error "Nothing to disconnect from?"))) - - -;; inlay hints - -(defface lsp-inlay-hint-face - '((t :inherit font-lock-comment-face)) - "The face to use for the JavaScript inlays." - :group 'lsp-mode - :package-version '(lsp-mode . "9.0.0")) - -(defface lsp-inlay-hint-type-face - '((t :inherit lsp-inlay-hint-face)) - "Face for inlay type hints (e.g. inferred variable types)." - :group 'lsp-mode - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-inlay-hint-type-format "%s" - "Format string for variable inlays (part of the inlay face)." - :type '(string :tag "String") - :group 'lsp-mode - :package-version '(lsp-mode . "9.0.0")) - -(defface lsp-inlay-hint-parameter-face - '((t :inherit lsp-inlay-hint-face)) - "Face for inlay parameter hints (e.g. function parameter names at -call-site)." - :group 'lsp-mode - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-inlay-hint-param-format "%s" - "Format string for parameter inlays (part of the inlay face)." - :type '(string :tag "String") - :group 'lsp-mode - :package-version '(lsp-mode . "9.0.0")) - -(defcustom lsp-update-inlay-hints-on-scroll t - "If non-nil update inlay hints immediately when scrolling or -modifying window sizes." - :type 'boolean - :package-version '(lsp-mode . "9.0.0")) - -(defun lsp--format-inlay (text kind) - (cond - ((eql kind lsp/inlay-hint-kind-type-hint) (format lsp-inlay-hint-type-format text)) - ((eql kind lsp/inlay-hint-kind-parameter-hint) (format lsp-inlay-hint-param-format text)) - (t text))) - -(defun lsp--face-for-inlay (kind) - (cond - ((eql kind lsp/inlay-hint-kind-type-hint) 'lsp-inlay-hint-type-face) - ((eql kind lsp/inlay-hint-kind-parameter-hint) 'lsp-inlay-hint-parameter-face) - (t 'lsp-inlay-hint-face))) - -(defun lsp--update-inlay-hints-scroll-function (window start) - (lsp-update-inlay-hints start (window-end window t))) - -(defun lsp--update-inlay-hints () - (lsp-update-inlay-hints (window-start) (window-end nil t))) - -(defun lsp--label-from-inlay-hints-response (label) - "Returns a string label built from an array of -InlayHintLabelParts or the argument itself if it's already a -string." - (cl-typecase label - (string label) - (vector - (string-join (mapcar (lambda (part) - (-let (((&InlayHintLabelPart :value) part)) - value)) - label))))) - -(defun lsp-update-inlay-hints (start end) - (lsp-request-async - "textDocument/inlayHint" - (lsp-make-inlay-hints-params - :text-document (lsp--text-document-identifier) - :range (lsp-make-range :start - (lsp-point-to-position start) - :end - (lsp-point-to-position end))) - (lambda (res) - (lsp--remove-overlays 'lsp-inlay-hint) - (dolist (hint res) - (-let* (((&InlayHint :label :position :kind? :padding-left? :padding-right?) hint) - (kind (or kind? lsp/inlay-hint-kind-type-hint)) - (label (lsp--label-from-inlay-hints-response label)) - (pos (lsp--position-to-point position)) - (overlay (make-overlay pos pos nil 'front-advance 'end-advance))) - (when (stringp label) - (overlay-put overlay 'lsp-inlay-hint t) - (overlay-put overlay 'before-string - (format "%s%s%s" - (if padding-left? " " "") - (propertize (lsp--format-inlay label kind) - 'font-lock-face (lsp--face-for-inlay kind)) - (if padding-right? " " ""))))))) - :mode 'tick)) - -(define-minor-mode lsp-inlay-hints-mode - "Mode for displaying inlay hints." - :lighter nil - (cond - ((and lsp-inlay-hints-mode lsp--buffer-workspaces) - (add-hook 'lsp-on-idle-hook #'lsp--update-inlay-hints nil t) - (when lsp-update-inlay-hints-on-scroll - (add-to-list (make-local-variable 'window-scroll-functions) - #'lsp--update-inlay-hints-scroll-function))) - (t - (lsp--remove-overlays 'lsp-inlay-hint) - (remove-hook 'lsp-on-idle-hook #'lsp--update-inlay-hints t) - (setf window-scroll-functions - (delete #'lsp--update-inlay-hints-scroll-function window-scroll-functions))))) - - - -;;;###autoload -(defun lsp-start-plain () - "Start `lsp-mode' using minimal configuration using the latest `melpa' version -of the packages. - -In case the major-mode that you are using for " - (interactive) - (let ((start-plain (make-temp-file "plain" nil ".el"))) - (url-copy-file "https://raw.githubusercontent.com/emacs-lsp/lsp-mode/master/scripts/lsp-start-plain.el" - start-plain t) - (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/emacs/elpa/lsp-mode-20240619.951/lsp-mode.elc b/emacs/elpa/lsp-mode-20240619.951/lsp-mode.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-terraform.elc b/emacs/elpa/lsp-mode-20240619.951/lsp-terraform.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-actionscript.el b/emacs/elpa/lsp-mode-20240625.344/lsp-actionscript.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-actionscript.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-actionscript.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-ada.el b/emacs/elpa/lsp-mode-20240625.344/lsp-ada.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-ada.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-ada.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-angular.el b/emacs/elpa/lsp-mode-20240625.344/lsp-angular.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-angular.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-angular.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-ansible.el b/emacs/elpa/lsp-mode-20240625.344/lsp-ansible.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-ansible.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-ansible.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-asm.el b/emacs/elpa/lsp-mode-20240625.344/lsp-asm.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-asm.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-asm.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-astro.el b/emacs/elpa/lsp-mode-20240625.344/lsp-astro.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-astro.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-astro.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-autotools.el b/emacs/elpa/lsp-mode-20240625.344/lsp-autotools.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-autotools.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-autotools.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-awk.el b/emacs/elpa/lsp-mode-20240625.344/lsp-awk.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-awk.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-awk.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-bash.el b/emacs/elpa/lsp-mode-20240625.344/lsp-bash.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-bash.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-bash.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-beancount.el b/emacs/elpa/lsp-mode-20240625.344/lsp-beancount.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-beancount.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-beancount.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-bufls.el b/emacs/elpa/lsp-mode-20240625.344/lsp-bufls.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-bufls.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-bufls.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-camel.el b/emacs/elpa/lsp-mode-20240625.344/lsp-camel.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-camel.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-camel.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-clangd.el b/emacs/elpa/lsp-mode-20240625.344/lsp-clangd.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-clangd.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-clangd.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-clojure.el b/emacs/elpa/lsp-mode-20240625.344/lsp-clojure.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-clojure.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-clojure.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-cmake.el b/emacs/elpa/lsp-mode-20240625.344/lsp-cmake.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-cmake.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-cmake.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-cobol.el b/emacs/elpa/lsp-mode-20240625.344/lsp-cobol.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-cobol.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-cobol.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-completion.el b/emacs/elpa/lsp-mode-20240625.344/lsp-completion.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-completion.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-completion.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-credo.el b/emacs/elpa/lsp-mode-20240625.344/lsp-credo.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-credo.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-credo.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-crystal.el b/emacs/elpa/lsp-mode-20240625.344/lsp-crystal.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-crystal.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-crystal.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-csharp.el b/emacs/elpa/lsp-mode-20240625.344/lsp-csharp.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-csharp.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-csharp.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-css.el b/emacs/elpa/lsp-mode-20240625.344/lsp-css.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-css.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-css.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240625.344/lsp-cucumber.el b/emacs/elpa/lsp-mode-20240625.344/lsp-cucumber.el @@ -0,0 +1,97 @@ +;;; lsp-cucumber.el --- LSP Clients for Cucumber -*- lexical-binding: t; -*- + +;; Copyright (C) 2024 Shen, Jen-Chieh + +;; This file is not part of GNU Emacs. + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; LSP server implementation for Cucumber +;; + +;;; Code: + +(require 'lsp-mode) + +(defgroup lsp-cucumber nil + "LSP server implementation for Cucumber." + :group 'lsp-mode + :link '(url-link "https://github.com/cucumber/language-server")) + +(defcustom lsp-cucumber-server-path nil + "Path points for Cucumber language server. + +This is only for development use." + :type 'string + :group 'lsp-cucumber) + +(defcustom lsp-cucumber-active-modes + '( feature-mode) + "List of major mode that work with Cucumber language server." + :type 'list + :group 'lsp-cucumber) + +(lsp-defcustom lsp-cucumber-features + ["src/test/**/*.feature" "features/**/*.feature" "tests/**/*.feature" "*specs*/**/*.feature"] + "Configure where the extension should look for .feature files." + :type '(repeat string) + :group 'lsp-cucumber + :package-version '(lsp-mode . "9.0.0") + :lsp-path "cucumber.features") + +(lsp-defcustom lsp-cucumber-glue + ["*specs*/**/*.cs" "features/**/*.js" "features/**/*.jsx" "features/**/*.php" "features/**/*.py" "features/**/*.rs" "features/**/*.rb" "features/**/*.ts" "features/**/*.tsx" "features/**/*_test.go" "**/*_test.go" "src/test/**/*.java" "tests/**/*.py" "tests/**/*.rs"] + "Configure where the extension should look for source code where +step definitions and parameter types are defined." + :type '(repeat string) + :group 'lsp-cucumber + :package-version '(lsp-mode . "9.0.0") + :lsp-path "cucumber.glue") + +(lsp-defcustom lsp-cucumber-parameter-types [] + "Configure parameters types to convert output parameters to your own types. + +Details at https://github.com/cucumber/cucumber-expressions#custom-parameter-types. +Sample: +[(:name \"actor\" + :regexp \"[A-Z][a-z]+\")]" + :type '(lsp-repeatable-vector plist) + :group 'lsp-cucumber + :package-version '(lsp-mode . "9.0.0") + :lsp-path "cucumber.parameterTypes") + +(defun lsp-cucumber--server-command () + "Generate startup command for Cucumber language server." + (or (and lsp-cucumber-server-path + (list lsp-cucumber-server-path "--stdio")) + (list (lsp-package-path 'cucumber-language-server) "--stdio"))) + +(lsp-dependency 'cucumber-language-server + '(:system "cucumber-language-server") + '(:npm :package "@cucumber/language-server" + :path "cucumber-language-server")) + +(lsp-register-client + (make-lsp-client + :new-connection (lsp-stdio-connection #'lsp-cucumber--server-command) + :major-modes lsp-cucumber-active-modes + :priority -1 + :server-id 'cucumber-language-server + :download-server-fn (lambda (_client callback error-callback _update?) + (lsp-package-ensure 'cucumber-language-server callback error-callback)))) + +(provide 'lsp-cucumber) +;;; lsp-cucumber.el ends here diff --git a/emacs/elpa/lsp-mode-20240625.344/lsp-cucumber.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-cucumber.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-cypher.el b/emacs/elpa/lsp-mode-20240625.344/lsp-cypher.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-cypher.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-cypher.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-d.el b/emacs/elpa/lsp-mode-20240625.344/lsp-d.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-d.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-d.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-dhall.el b/emacs/elpa/lsp-mode-20240625.344/lsp-dhall.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-dhall.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-dhall.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-diagnostics.el b/emacs/elpa/lsp-mode-20240625.344/lsp-diagnostics.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-diagnostics.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-diagnostics.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-dired.el b/emacs/elpa/lsp-mode-20240625.344/lsp-dired.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-dired.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-dired.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-dockerfile.el b/emacs/elpa/lsp-mode-20240625.344/lsp-dockerfile.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-dockerfile.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-dockerfile.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-dot.el b/emacs/elpa/lsp-mode-20240625.344/lsp-dot.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-dot.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-dot.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-earthly.el b/emacs/elpa/lsp-mode-20240625.344/lsp-earthly.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-earthly.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-earthly.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-elixir.el b/emacs/elpa/lsp-mode-20240625.344/lsp-elixir.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-elixir.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-elixir.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-elm.el b/emacs/elpa/lsp-mode-20240625.344/lsp-elm.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-elm.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-elm.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-emmet.el b/emacs/elpa/lsp-mode-20240625.344/lsp-emmet.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-emmet.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-emmet.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-erlang.el b/emacs/elpa/lsp-mode-20240625.344/lsp-erlang.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-erlang.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-erlang.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-eslint.el b/emacs/elpa/lsp-mode-20240625.344/lsp-eslint.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-eslint.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-eslint.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-fortran.el b/emacs/elpa/lsp-mode-20240625.344/lsp-fortran.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-fortran.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-fortran.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-fsharp.el b/emacs/elpa/lsp-mode-20240625.344/lsp-fsharp.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-fsharp.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-fsharp.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-gdscript.el b/emacs/elpa/lsp-mode-20240625.344/lsp-gdscript.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-gdscript.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-gdscript.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-gleam.el b/emacs/elpa/lsp-mode-20240625.344/lsp-gleam.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-gleam.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-gleam.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-glsl.el b/emacs/elpa/lsp-mode-20240625.344/lsp-glsl.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-glsl.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-glsl.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-go.el b/emacs/elpa/lsp-mode-20240625.344/lsp-go.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-go.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-go.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-golangci-lint.el b/emacs/elpa/lsp-mode-20240625.344/lsp-golangci-lint.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-golangci-lint.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-golangci-lint.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-graphql.el b/emacs/elpa/lsp-mode-20240625.344/lsp-graphql.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-graphql.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-graphql.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-groovy.el b/emacs/elpa/lsp-mode-20240625.344/lsp-groovy.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-groovy.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-groovy.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-hack.el b/emacs/elpa/lsp-mode-20240625.344/lsp-hack.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-hack.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-hack.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-haxe.el b/emacs/elpa/lsp-mode-20240625.344/lsp-haxe.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-haxe.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-haxe.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-headerline.el b/emacs/elpa/lsp-mode-20240625.344/lsp-headerline.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-headerline.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-headerline.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-html.el b/emacs/elpa/lsp-mode-20240625.344/lsp-html.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-html.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-html.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-hy.el b/emacs/elpa/lsp-mode-20240625.344/lsp-hy.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-hy.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-hy.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-icons.el b/emacs/elpa/lsp-mode-20240625.344/lsp-icons.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-icons.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-icons.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-ido.el b/emacs/elpa/lsp-mode-20240625.344/lsp-ido.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-ido.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-ido.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-idris.el b/emacs/elpa/lsp-mode-20240625.344/lsp-idris.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-idris.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-idris.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-iedit.el b/emacs/elpa/lsp-mode-20240625.344/lsp-iedit.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-iedit.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-iedit.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-javascript.el b/emacs/elpa/lsp-mode-20240625.344/lsp-javascript.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-javascript.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-javascript.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-jq.el b/emacs/elpa/lsp-mode-20240625.344/lsp-jq.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-jq.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-jq.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-json.el b/emacs/elpa/lsp-mode-20240625.344/lsp-json.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-json.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-json.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-jsonnet.el b/emacs/elpa/lsp-mode-20240625.344/lsp-jsonnet.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-jsonnet.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-jsonnet.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-kotlin.el b/emacs/elpa/lsp-mode-20240625.344/lsp-kotlin.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-kotlin.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-kotlin.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-lens.el b/emacs/elpa/lsp-mode-20240625.344/lsp-lens.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-lens.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-lens.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-lisp.el b/emacs/elpa/lsp-mode-20240625.344/lsp-lisp.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-lisp.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-lisp.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-lua.el b/emacs/elpa/lsp-mode-20240625.344/lsp-lua.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-lua.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-lua.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-magik.el b/emacs/elpa/lsp-mode-20240625.344/lsp-magik.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-magik.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-magik.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-markdown.el b/emacs/elpa/lsp-mode-20240625.344/lsp-markdown.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-markdown.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-markdown.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-marksman.el b/emacs/elpa/lsp-mode-20240625.344/lsp-marksman.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-marksman.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-marksman.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-mdx.el b/emacs/elpa/lsp-mode-20240625.344/lsp-mdx.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-mdx.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-mdx.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-meson.el b/emacs/elpa/lsp-mode-20240625.344/lsp-meson.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-meson.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-meson.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-mint.el b/emacs/elpa/lsp-mode-20240625.344/lsp-mint.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-mint.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-mint.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240625.344/lsp-mode-autoloads.el b/emacs/elpa/lsp-mode-20240625.344/lsp-mode-autoloads.el @@ -0,0 +1,984 @@ +;;; lsp-mode-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*- +;; Generated by the `loaddefs-generate' function. + +;; This file is part of GNU Emacs. + +;;; Code: + +(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path))) + + + +;;; Generated autoloads from lsp-actionscript.el + +(register-definition-prefixes "lsp-actionscript" '("lsp-actionscript-")) + + +;;; Generated autoloads from lsp-ada.el + +(register-definition-prefixes "lsp-ada" '("lsp-ada-")) + + +;;; Generated autoloads from lsp-angular.el + +(register-definition-prefixes "lsp-angular" '("lsp-client")) + + +;;; Generated autoloads from lsp-ansible.el + +(register-definition-prefixes "lsp-ansible" '("lsp-ansible-")) + + +;;; Generated autoloads from lsp-asm.el + +(register-definition-prefixes "lsp-asm" '("lsp-asm-")) + + +;;; Generated autoloads from lsp-astro.el + +(register-definition-prefixes "lsp-astro" '("lsp-astro--get-initialization-options")) + + +;;; Generated autoloads from lsp-autotools.el + +(register-definition-prefixes "lsp-autotools" '("lsp-autotools-")) + + +;;; Generated autoloads from lsp-awk.el + +(register-definition-prefixes "lsp-awk" '("lsp-awk-executable")) + + +;;; Generated autoloads from lsp-bash.el + +(register-definition-prefixes "lsp-bash" '("lsp-bash-")) + + +;;; Generated autoloads from lsp-beancount.el + +(register-definition-prefixes "lsp-beancount" '("lsp-beancount-")) + + +;;; Generated autoloads from lsp-bufls.el + +(register-definition-prefixes "lsp-bufls" '("lsp-bufls-")) + + +;;; Generated autoloads from lsp-camel.el + +(register-definition-prefixes "lsp-camel" '("lsp-camel-")) + + +;;; 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)") +(register-definition-prefixes "lsp-clangd" '("lsp-c")) + + +;;; 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) +(autoload 'lsp-clojure-show-project-tree "lsp-clojure" "\ +Show a project tree with source-paths and dependencies. +Focus on it if IGNORE-FOCUS? is nil. + +(fn IGNORE-FOCUS?)" t) +(register-definition-prefixes "lsp-clojure" '("lsp-clojure-")) + + +;;; Generated autoloads from lsp-cmake.el + +(register-definition-prefixes "lsp-cmake" '("lsp-cmake-")) + + +;;; Generated autoloads from lsp-cobol.el + +(add-hook 'cobol-mode-hook #'lsp-cobol-start-ls) +(autoload 'lsp-cobol-start-ls "lsp-cobol" "\ +Start the COBOL language service." t) +(register-definition-prefixes "lsp-cobol" '("lsp-cobol-")) + + +;;; 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.") +(autoload 'lsp-completion--enable "lsp-completion" "\ +Enable LSP completion support.") +(autoload 'lsp-completion-mode "lsp-completion" "\ +Toggle LSP completion support. + +This is a minor mode. If called interactively, toggle the +`Lsp-Completion 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 `lsp-completion-mode'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + +(fn &optional ARG)" t) +(add-hook 'lsp-configure-hook (lambda nil (when (and lsp-auto-configure lsp-completion-enable) (lsp-completion--enable)))) +(register-definition-prefixes "lsp-completion" '("lsp-")) + + +;;; Generated autoloads from lsp-credo.el + +(register-definition-prefixes "lsp-credo" '("lsp-credo-")) + + +;;; Generated autoloads from lsp-crystal.el + +(register-definition-prefixes "lsp-crystal" '("lsp-clients-crystal-executable")) + + +;;; Generated autoloads from lsp-csharp.el + +(register-definition-prefixes "lsp-csharp" '("lsp-csharp-")) + + +;;; Generated autoloads from lsp-css.el + +(register-definition-prefixes "lsp-css" '("lsp-css-")) + + +;;; Generated autoloads from lsp-cucumber.el + +(register-definition-prefixes "lsp-cucumber" '("lsp-cucumber-")) + + +;;; Generated autoloads from lsp-cypher.el + +(register-definition-prefixes "lsp-cypher" '("lsp-client--cypher-ls-server-command")) + + +;;; 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") +(autoload 'lsp-diagnostics--enable "lsp-diagnostics" "\ +Enable LSP checker support.") +(autoload 'lsp-diagnostics-mode "lsp-diagnostics" "\ +Toggle LSP diagnostics integration. + +This is a minor mode. If called interactively, toggle the +`Lsp-Diagnostics 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 `lsp-diagnostics-mode'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + +(fn &optional ARG)" t) +(add-hook 'lsp-configure-hook (lambda nil (when lsp-auto-configure (lsp-diagnostics--enable)))) +(register-definition-prefixes "lsp-diagnostics" '("lsp-diagnostics-")) + + +;;; 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. + +This is a global minor mode. If called interactively, toggle the +`Lsp-Dired 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 `(default-value \\='lsp-dired-mode)'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + +(fn &optional ARG)" t) +(register-definition-prefixes "lsp-dired" '("lsp-dired-")) + + +;;; Generated autoloads from lsp-dockerfile.el + +(register-definition-prefixes "lsp-dockerfile" '("lsp-dockerfile-language-server-command")) + + +;;; Generated autoloads from lsp-dot.el + +(register-definition-prefixes "lsp-dot" '("lsp-dot--dot-ls-server-command")) + + +;;; Generated autoloads from lsp-earthly.el + +(register-definition-prefixes "lsp-earthly" '("lsp-earthly-")) + + +;;; Generated autoloads from lsp-elixir.el + +(register-definition-prefixes "lsp-elixir" '("lsp-elixir-")) + + +;;; Generated autoloads from lsp-elm.el + +(register-definition-prefixes "lsp-elm" '("lsp-")) + + +;;; Generated autoloads from lsp-emmet.el + +(register-definition-prefixes "lsp-emmet" '("lsp-emmet-ls-command")) + + +;;; Generated autoloads from lsp-erlang.el + +(register-definition-prefixes "lsp-erlang" '("lsp-erlang-")) + + +;;; Generated autoloads from lsp-eslint.el + +(register-definition-prefixes "lsp-eslint" '("lsp-")) + + +;;; Generated autoloads from lsp-fortran.el + +(register-definition-prefixes "lsp-fortran" '("lsp-clients-")) + + +;;; Generated autoloads from lsp-fsharp.el + +(autoload 'lsp-fsharp--workspace-load "lsp-fsharp" "\ +Load all of the provided PROJECTS. + +(fn PROJECTS)") +(register-definition-prefixes "lsp-fsharp" '("lsp-fsharp-")) + + +;;; Generated autoloads from lsp-gdscript.el + +(register-definition-prefixes "lsp-gdscript" '("lsp-gdscript-")) + + +;;; Generated autoloads from lsp-gleam.el + +(register-definition-prefixes "lsp-gleam" '("lsp-gleam-executable")) + + +;;; Generated autoloads from lsp-glsl.el + +(register-definition-prefixes "lsp-glsl" '("lsp-glsl-executable")) + + +;;; Generated autoloads from lsp-go.el + +(register-definition-prefixes "lsp-go" '("lsp-go-")) + + +;;; Generated autoloads from lsp-golangci-lint.el + +(register-definition-prefixes "lsp-golangci-lint" '("lsp-golangci-lint-")) + + +;;; Generated autoloads from lsp-graphql.el + +(register-definition-prefixes "lsp-graphql" '("lsp-")) + + +;;; Generated autoloads from lsp-groovy.el + +(register-definition-prefixes "lsp-groovy" '("lsp-groovy-")) + + +;;; Generated autoloads from lsp-hack.el + +(register-definition-prefixes "lsp-hack" '("lsp-clients-hack-command")) + + +;;; Generated autoloads from lsp-haxe.el + +(register-definition-prefixes "lsp-haxe" '("lsp-")) + + +;;; Generated autoloads from lsp-headerline.el + +(autoload 'lsp-headerline-breadcrumb-mode "lsp-headerline" "\ +Toggle breadcrumb on headerline. + +This is a minor mode. If called interactively, toggle the +`Lsp-Headerline-Breadcrumb 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 `lsp-headerline-breadcrumb-mode'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + +(fn &optional ARG)" t) +(autoload 'lsp-breadcrumb-go-to-symbol "lsp-headerline" "\ +Go to the symbol on breadcrumb at SYMBOL-POSITION. + +(fn SYMBOL-POSITION)" t) +(autoload 'lsp-breadcrumb-narrow-to-symbol "lsp-headerline" "\ +Narrow to the symbol range on breadcrumb at SYMBOL-POSITION. + +(fn SYMBOL-POSITION)" t) +(register-definition-prefixes "lsp-headerline" '("lsp-headerline-")) + + +;;; Generated autoloads from lsp-html.el + +(register-definition-prefixes "lsp-html" '("lsp-html-")) + + +;;; Generated autoloads from lsp-hy.el + +(register-definition-prefixes "lsp-hy" '("lsp-clients-hy-server-executable")) + + +;;; Generated autoloads from lsp-icons.el + +(register-definition-prefixes "lsp-icons" '("lsp-")) + + +;;; 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) +(register-definition-prefixes "lsp-ido" '("lsp-ido-")) + + +;;; Generated autoloads from lsp-idris.el + +(register-definition-prefixes "lsp-idris" '("lsp-idris2-lsp-")) + + +;;; 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) +(autoload 'lsp-iedit-linked-ranges "lsp-iedit" "\ +Start an `iedit' for `textDocument/linkedEditingRange'" t) +(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) +(autoload 'lsp-evil-multiedit-linked-ranges "lsp-iedit" "\ +Start an `evil-multiedit' for `textDocument/linkedEditingRange'" t) +(autoload 'lsp-evil-state-highlights "lsp-iedit" "\ +Start `iedit-mode'. for `textDocument/documentHighlight'" t) +(autoload 'lsp-evil-state-linked-ranges "lsp-iedit" "\ +Start `iedit-mode'. for `textDocument/linkedEditingRange'" t) +(register-definition-prefixes "lsp-iedit" '("lsp-iedit--on-ranges")) + + +;;; Generated autoloads from lsp-javascript.el + +(register-definition-prefixes "lsp-javascript" '("lsp-")) + + +;;; Generated autoloads from lsp-jq.el + +(register-definition-prefixes "lsp-jq" '("lsp-clients-jq-server-executable")) + + +;;; Generated autoloads from lsp-json.el + +(register-definition-prefixes "lsp-json" '("lsp-")) + + +;;; Generated autoloads from lsp-jsonnet.el + +(register-definition-prefixes "lsp-jsonnet" '("lsp-clients-jsonnet-server-executable")) + + +;;; Generated autoloads from lsp-kotlin.el + +(register-definition-prefixes "lsp-kotlin" '("lsp-")) + + +;;; Generated autoloads from lsp-lens.el + +(autoload 'lsp-lens--enable "lsp-lens" "\ +Enable lens mode.") +(autoload 'lsp-lens-show "lsp-lens" "\ +Display lenses in the buffer." t) +(autoload 'lsp-lens-hide "lsp-lens" "\ +Delete all lenses." t) +(autoload 'lsp-lens-mode "lsp-lens" "\ +Toggle code-lens overlays. + +This is a minor mode. If called interactively, toggle the +`Lsp-Lens 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 `lsp-lens-mode'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + +(fn &optional ARG)" t) +(autoload 'lsp-avy-lens "lsp-lens" "\ +Click lsp lens using `avy' package." t) +(register-definition-prefixes "lsp-lens" '("lsp-")) + + +;;; Generated autoloads from lsp-lisp.el + +(autoload 'lsp-lisp-alive-start-ls "lsp-lisp" "\ +Start the alive-lsp." t) +(register-definition-prefixes "lsp-lisp" '("lsp-lisp-a")) + + +;;; Generated autoloads from lsp-lua.el + +(register-definition-prefixes "lsp-lua" '("lsp-")) + + +;;; Generated autoloads from lsp-magik.el + +(register-definition-prefixes "lsp-magik" '("lsp-magik-")) + + +;;; Generated autoloads from lsp-markdown.el + +(register-definition-prefixes "lsp-markdown" '("lsp-markdown-")) + + +;;; Generated autoloads from lsp-marksman.el + +(register-definition-prefixes "lsp-marksman" '("lsp-marksman-")) + + +;;; Generated autoloads from lsp-mdx.el + +(register-definition-prefixes "lsp-mdx" '("lsp-mdx-server-command")) + + +;;; Generated autoloads from lsp-meson.el + +(register-definition-prefixes "lsp-meson" '("lsp-meson-")) + + +;;; Generated autoloads from lsp-mint.el + +(register-definition-prefixes "lsp-mint" '("lsp-clients-mint-executable")) + + +;;; 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)") +(autoload 'lsp-load-vscode-workspace "lsp-mode" "\ +Load vscode workspace from FILE + +(fn FILE)" t) +(autoload 'lsp-save-vscode-workspace "lsp-mode" "\ +Save vscode workspace to FILE + +(fn FILE)" t) +(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) +(autoload 'lsp-uninstall-server "lsp-mode" "\ +Delete a LSP server from `lsp-server-install-dir'. + +(fn DIR)" t) +(autoload 'lsp-uninstall-servers "lsp-mode" "\ +Uninstall all installed servers." t) +(autoload 'lsp-update-server "lsp-mode" "\ +Interactively update (reinstall) a server. + +(fn &optional SERVER-ID)" t) +(autoload 'lsp-update-servers "lsp-mode" "\ +Update (reinstall) all installed servers." t) +(autoload 'lsp-ensure-server "lsp-mode" "\ +Ensure server SERVER-ID + +(fn SERVER-ID)") +(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) +(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.") +(autoload 'lsp-start-plain "lsp-mode" "\ +Start `lsp-mode' using minimal configuration using the latest `melpa' version +of the packages. + +In case the major-mode that you are using for " t) +(register-definition-prefixes "lsp-mode" '("defcustom-lsp" "lsp-" "make-lsp-client" "when-lsp-workspace" "with-lsp-workspace")) + + +;;; 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. + +This is a minor mode. If called interactively, toggle the +`Lsp-Modeline-Code-Actions 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 `lsp-modeline-code-actions-mode'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + +(fn &optional ARG)" t) +(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. + +This is a minor mode. If called interactively, toggle the +`Lsp-Modeline-Diagnostics 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 `lsp-modeline-diagnostics-mode'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + +(fn &optional ARG)" t) +(autoload 'lsp-modeline-workspace-status-mode "lsp-modeline" "\ +Toggle workspace status on modeline. + +This is a minor mode. If called interactively, toggle the +`Lsp-Modeline-Workspace-Status 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 `lsp-modeline-workspace-status-mode'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + +(fn &optional ARG)" t) +(register-definition-prefixes "lsp-modeline" '("lsp-")) + + +;;; Generated autoloads from lsp-mojo.el + +(register-definition-prefixes "lsp-mojo" '("lsp-mojo-executable")) + + +;;; Generated autoloads from lsp-move.el + +(register-definition-prefixes "lsp-move" '("lsp-clients-")) + + +;;; Generated autoloads from lsp-nginx.el + +(register-definition-prefixes "lsp-nginx" '("lsp-nginx-")) + + +;;; Generated autoloads from lsp-nim.el + +(register-definition-prefixes "lsp-nim" '("lsp-nim-l")) + + +;;; Generated autoloads from lsp-nix.el + +(register-definition-prefixes "lsp-nix" '("lsp-nix-")) + + +;;; Generated autoloads from lsp-nushell.el + +(register-definition-prefixes "lsp-nushell" '("lsp-nushell-language-server-command")) + + +;;; Generated autoloads from lsp-ocaml.el + +(register-definition-prefixes "lsp-ocaml" '("lsp-")) + + +;;; Generated autoloads from lsp-openscad.el + +(register-definition-prefixes "lsp-openscad" '("lsp-openscad-")) + + +;;; Generated autoloads from lsp-perl.el + +(register-definition-prefixes "lsp-perl" '("lsp-perl-")) + + +;;; Generated autoloads from lsp-perlnavigator.el + +(register-definition-prefixes "lsp-perlnavigator" '("lsp-perlnavigator-")) + + +;;; Generated autoloads from lsp-php.el + +(register-definition-prefixes "lsp-php" '("lsp-")) + + +;;; Generated autoloads from lsp-pls.el + +(register-definition-prefixes "lsp-pls" '("lsp-pls-")) + + +;;; Generated autoloads from lsp-prolog.el + +(register-definition-prefixes "lsp-prolog" '("lsp-prolog-server-command")) + + +;;; Generated autoloads from lsp-protocol.el + +(register-definition-prefixes "lsp-protocol" '("dash-expand:&RangeToPoint" "lsp")) + + +;;; Generated autoloads from lsp-purescript.el + +(register-definition-prefixes "lsp-purescript" '("lsp-purescript-")) + + +;;; Generated autoloads from lsp-pwsh.el + +(register-definition-prefixes "lsp-pwsh" '("lsp-pwsh-")) + + +;;; Generated autoloads from lsp-pyls.el + +(register-definition-prefixes "lsp-pyls" '("lsp-")) + + +;;; Generated autoloads from lsp-pylsp.el + +(register-definition-prefixes "lsp-pylsp" '("lsp-")) + + +;;; Generated autoloads from lsp-qml.el + +(register-definition-prefixes "lsp-qml" '("lsp-qml-server-command")) + + +;;; Generated autoloads from lsp-r.el + +(register-definition-prefixes "lsp-r" '("lsp-clients-r-server-command")) + + +;;; Generated autoloads from lsp-racket.el + +(register-definition-prefixes "lsp-racket" '("lsp-racket-lang")) + + +;;; Generated autoloads from lsp-remark.el + +(register-definition-prefixes "lsp-remark" '("lsp-remark-server-command")) + + +;;; Generated autoloads from lsp-rf.el + +(register-definition-prefixes "lsp-rf" '("expand-start-command" "lsp-rf-language-server-" "parse-rf-language-server-")) + + +;;; Generated autoloads from lsp-roslyn.el + +(register-definition-prefixes "lsp-roslyn" '("lsp-roslyn-")) + + +;;; Generated autoloads from lsp-rpm-spec.el + +(register-definition-prefixes "lsp-rpm-spec" '("lsp-rpm-spec-")) + + +;;; Generated autoloads from lsp-rubocop.el + +(register-definition-prefixes "lsp-rubocop" '("lsp-rubocop-")) + + +;;; Generated autoloads from lsp-ruby-lsp.el + +(register-definition-prefixes "lsp-ruby-lsp" '("lsp-ruby-lsp-")) + + +;;; Generated autoloads from lsp-ruby-syntax-tree.el + +(register-definition-prefixes "lsp-ruby-syntax-tree" '("lsp-ruby-syntax-tree-")) + + +;;; Generated autoloads from lsp-ruff-lsp.el + +(register-definition-prefixes "lsp-ruff-lsp" '("lsp-ruff-lsp-")) + + +;;; Generated autoloads from lsp-rust.el + +(register-definition-prefixes "lsp-rust" '("lsp-")) + + +;;; Generated autoloads from lsp-semantic-tokens.el + +(defvar-local semantic-token-modifier-cache (make-hash-table) "\ +A cache of modifier values to the selected fonts. +This allows whole-bitmap lookup instead of checking each bit. The +expectation is that usage of modifiers will tend to cluster, so +we will not have the full range of possible usages, hence a +tractable hash map. + +This is set as buffer-local. It should probably be shared in a +given workspace/language-server combination. + +This cache should be flushed every time any modifier +configuration changes.") +(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.") +(autoload 'lsp--semantic-tokens-initialize-workspace "lsp-semantic-tokens" "\ +Initialize semantic tokens for WORKSPACE. + +(fn WORKSPACE)") +(autoload 'lsp-semantic-tokens--warn-about-deprecated-setting "lsp-semantic-tokens" "\ +Warn about deprecated semantic highlighting variable.") +(autoload 'lsp-semantic-tokens--enable "lsp-semantic-tokens" "\ +Enable semantic tokens mode.") +(autoload 'lsp-semantic-tokens-mode "lsp-semantic-tokens" "\ +Toggle semantic-tokens support. + +This is a minor mode. If called interactively, toggle the +`Lsp-Semantic-Tokens 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 `lsp-semantic-tokens-mode'. + +The mode's hook is called both when the mode is enabled and when +it is disabled. + +(fn &optional ARG)" t) +(register-definition-prefixes "lsp-semantic-tokens" '("lsp-")) + + +;;; Generated autoloads from lsp-semgrep.el + +(register-definition-prefixes "lsp-semgrep" '("lsp-semgrep-" "semgrep-")) + + +;;; Generated autoloads from lsp-sml.el + +(register-definition-prefixes "lsp-sml" '("lsp-sml-millet-")) + + +;;; Generated autoloads from lsp-solargraph.el + +(register-definition-prefixes "lsp-solargraph" '("lsp-solargraph-")) + + +;;; Generated autoloads from lsp-solidity.el + +(register-definition-prefixes "lsp-solidity" '("lsp-client--solidity-")) + + +;;; Generated autoloads from lsp-sorbet.el + +(register-definition-prefixes "lsp-sorbet" '("lsp-sorbet-")) + + +;;; Generated autoloads from lsp-sql.el + +(register-definition-prefixes "lsp-sql" '("lsp-sql-")) + + +;;; Generated autoloads from lsp-sqls.el + +(register-definition-prefixes "lsp-sqls" '("lsp-sql")) + + +;;; Generated autoloads from lsp-steep.el + +(register-definition-prefixes "lsp-steep" '("lsp-steep-")) + + +;;; Generated autoloads from lsp-svelte.el + +(register-definition-prefixes "lsp-svelte" '("lsp-svelte-plugin-")) + + +;;; Generated autoloads from lsp-terraform.el + +(register-definition-prefixes "lsp-terraform" '("construct-tf-package" "lsp-t")) + + +;;; Generated autoloads from lsp-tex.el + +(register-definition-prefixes "lsp-tex" '("lsp-")) + + +;;; Generated autoloads from lsp-toml.el + +(register-definition-prefixes "lsp-toml" '("lsp-toml-")) + + +;;; Generated autoloads from lsp-trunk.el + +(register-definition-prefixes "lsp-trunk" '("lsp-trunk-")) + + +;;; Generated autoloads from lsp-ttcn3.el + +(register-definition-prefixes "lsp-ttcn3" '("lsp-ttcn3-lsp-server-command")) + + +;;; Generated autoloads from lsp-typeprof.el + +(register-definition-prefixes "lsp-typeprof" '("lsp-typeprof-")) + + +;;; Generated autoloads from lsp-v.el + +(register-definition-prefixes "lsp-v" '("lsp-v-vls-executable")) + + +;;; Generated autoloads from lsp-vala.el + +(register-definition-prefixes "lsp-vala" '("lsp-clients-vala-ls-executable")) + + +;;; Generated autoloads from lsp-verilog.el + +(register-definition-prefixes "lsp-verilog" '("lsp-clients-")) + + +;;; Generated autoloads from lsp-vetur.el + +(register-definition-prefixes "lsp-vetur" '("lsp-vetur-")) + + +;;; Generated autoloads from lsp-vhdl.el + +(register-definition-prefixes "lsp-vhdl" '("ghdl-ls-bin-name" "hdl-checker-bin-name" "lsp-vhdl-" "vhdl-")) + + +;;; Generated autoloads from lsp-vimscript.el + +(register-definition-prefixes "lsp-vimscript" '("lsp-clients-vim-")) + + +;;; Generated autoloads from lsp-volar.el + +(register-definition-prefixes "lsp-volar" '("lsp-volar-")) + + +;;; Generated autoloads from lsp-wgsl.el + +(register-definition-prefixes "lsp-wgsl" '("lsp-wgsl-")) + + +;;; Generated autoloads from lsp-xml.el + +(register-definition-prefixes "lsp-xml" '("lsp-xml-")) + + +;;; Generated autoloads from lsp-yaml.el + +(register-definition-prefixes "lsp-yaml" '("lsp-yaml-")) + + +;;; Generated autoloads from lsp-yang.el + +(register-definition-prefixes "lsp-yang" '("lsp-yang-")) + + +;;; Generated autoloads from lsp-zig.el + +(register-definition-prefixes "lsp-zig" '("lsp-z")) + +;;; End of scraped data + +(provide 'lsp-mode-autoloads) + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; no-native-compile: t +;; coding: utf-8-emacs-unix +;; End: + +;;; lsp-mode-autoloads.el ends here diff --git a/emacs/elpa/lsp-mode-20240625.344/lsp-mode-pkg.el b/emacs/elpa/lsp-mode-20240625.344/lsp-mode-pkg.el @@ -0,0 +1,21 @@ +(define-package "lsp-mode" "20240625.344" "LSP mode" + '((emacs "27.1") + (dash "2.18.0") + (f "0.20.0") + (ht "2.3") + (spinner "1.7.3") + (markdown-mode "2.3") + (lv "0") + (eldoc "1.11")) + :commit "7b1b0c32cc755198cb09f6c3aef069ecfec2e428" :authors + '(("Vibhav Pant, Fangrui Song, Ivan Yonchovski")) + :maintainers + '(("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/emacs/elpa/lsp-mode-20240625.344/lsp-mode.el b/emacs/elpa/lsp-mode-20240625.344/lsp-mode.el @@ -0,0 +1,9849 @@ +;;; lsp-mode.el --- LSP mode -*- lexical-binding: t; -*- + +;; Copyright (C) 2020-2024 emacs-lsp maintainers + +;; Author: Vibhav Pant, Fangrui Song, Ivan Yonchovski +;; Keywords: languages +;; Package-Requires: ((emacs "27.1") (dash "2.18.0") (f "0.20.0") (ht "2.3") (spinner "1.7.3") (markdown-mode "2.3") (lv "0") (eldoc "1.11")) +;; Version: 9.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 <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Emacs client/library for the Language Server Protocol + +;;; Code: + +(require 'cl-generic) +(require 'cl-lib) +(require 'compile) +(require 'dash) +(require 'epg) +(require 'ewoc) +(require 'f) +(require 'filenotify) +(require 'files) +(require 'ht) +(require 'imenu) +(require 'inline) +(require 'json) +(require 'lv) +(require 'markdown-mode) +(require 'network-stream) +(require 'pcase) +(require 'rx) +(require 's) +(require 'seq) +(require 'spinner) +(require 'subr-x) +(require 'tree-widget) +(require 'url-parse) +(require 'url-util) +(require 'widget) +(require 'xref) +(require 'minibuffer) +(require 'help-mode) +(require 'lsp-protocol) + +(defgroup lsp-mode nil + "Language Server Protocol client." + :group 'tools + :tag "Language Server (lsp-mode)") + +(declare-function evil-set-command-property "ext:evil-common") +(declare-function projectile-project-root "ext:projectile") +(declare-function yas-expand-snippet "ext:yasnippet") +(declare-function dap-mode "ext:dap-mode") +(declare-function dap-auto-configure-mode "ext:dap-mode") + +(defvar yas-inhibit-overlay-modification-protection) +(defvar yas-indent-line) +(defvar yas-wrap-around-region) +(defvar yas-also-auto-indent-first-line) +(defvar dap-auto-configure-mode) +(defvar dap-ui-menu-items) +(defvar company-minimum-prefix-length) + +(defconst lsp--message-type-face + `((1 . ,compilation-error-face) + (2 . ,compilation-warning-face) + (3 . ,compilation-message-face) + (4 . ,compilation-info-face))) + +(defconst lsp--errors + '((-32700 "Parse Error") + (-32600 "Invalid Request") + (-32601 "Method not Found") + (-32602 "Invalid Parameters") + (-32603 "Internal Error") + (-32099 "Server Start Error") + (-32000 "Server End Error") + (-32002 "Server Not Initialized") + (-32001 "Unknown Error Code") + (-32800 "Request Cancelled")) + "Alist of error codes to user friendly strings.") + +(defconst lsp--empty-ht (make-hash-table)) + +(eval-and-compile + (defun dash-expand:&lsp-wks (key source) + `(,(intern-soft (format "lsp--workspace-%s" (eval key))) ,source)) + + (defun dash-expand:&lsp-cln (key source) + `(,(intern-soft (format "lsp--client-%s" (eval key))) ,source))) + +(define-obsolete-variable-alias 'lsp-print-io 'lsp-log-io "lsp-mode 6.1") + +(defcustom lsp-log-io nil + "If non-nil, log all messages from the language server to a *lsp-log* buffer." + :group 'lsp-mode + :type 'boolean) + +(defcustom lsp-log-io-allowlist-methods '() + "The methods to filter before print to lsp-log-io." + :group 'lsp-mode + :type '(repeat string) + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-log-max message-log-max + "Maximum number of lines to keep in the log buffer. +If nil, disable message logging. If t, log messages but don’t truncate +the buffer when it becomes large." + :group 'lsp-mode + :type '(choice (const :tag "Disable" nil) + (integer :tag "lines") + (const :tag "Unlimited" t)) + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-io-messages-max t + "Maximum number of messages that can be locked in a `lsp-io' buffer." + :group 'lsp-mode + :type '(choice (const :tag "Unlimited" t) + (integer :tag "Messages")) + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-keep-workspace-alive t + "If non nil keep workspace alive when the last workspace buffer is closed." + :group 'lsp-mode + :type 'boolean) + +(defcustom lsp-enable-snippet t + "Enable/disable snippet completion support." + :group 'lsp-completion + :type 'boolean) + +(defcustom lsp-enable-folding t + "Enable/disable code folding support." + :group 'lsp-mode + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(define-obsolete-variable-alias 'lsp-enable-semantic-highlighting 'lsp-semantic-tokens-enable "lsp-mode 8.0.0") + +(defcustom lsp-semantic-tokens-enable nil + "Enable/disable support for semantic tokens. +As defined by the Language Server Protocol 3.16." + :group 'lsp-semantic-tokens + :type 'boolean) + +(defcustom lsp-folding-range-limit nil + "The maximum number of folding ranges to receive from the language server." + :group 'lsp-mode + :type '(choice (const :tag "No limit." nil) + (integer :tag "Number of lines.")) + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-folding-line-folding-only nil + "If non-nil, only fold complete lines." + :group 'lsp-mode + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-client-packages + '( ccls lsp-actionscript lsp-ada lsp-angular lsp-ansible lsp-asm lsp-astro + lsp-autotools lsp-awk lsp-bash lsp-beancount lsp-bufls lsp-clangd + lsp-clojure lsp-cmake lsp-cobol lsp-credo lsp-crystal lsp-csharp lsp-css + lsp-cucumber lsp-cypher lsp-d lsp-dart lsp-dhall lsp-docker lsp-dockerfile + lsp-earthly lsp-elixir lsp-elm lsp-emmet lsp-erlang lsp-eslint lsp-fortran lsp-fsharp + lsp-gdscript lsp-gleam lsp-glsl lsp-go lsp-golangci-lint lsp-grammarly + lsp-graphql lsp-groovy lsp-hack lsp-haskell lsp-haxe lsp-idris lsp-java + lsp-javascript lsp-jq lsp-json lsp-kotlin lsp-latex lsp-lisp lsp-ltex + lsp-lua lsp-magik lsp-markdown lsp-marksman lsp-mdx lsp-meson lsp-metals lsp-mint + lsp-mojo lsp-move lsp-mssql lsp-nginx lsp-nim lsp-nix lsp-nushell lsp-ocaml + lsp-openscad lsp-pascal lsp-perl lsp-perlnavigator lsp-php lsp-pls + lsp-purescript lsp-pwsh lsp-pyls lsp-pylsp lsp-pyright lsp-python-ms + lsp-qml lsp-r lsp-racket lsp-remark lsp-rf lsp-roslyn lsp-rubocop lsp-ruby-lsp + lsp-ruby-syntax-tree lsp-ruff-lsp lsp-rust lsp-semgrep lsp-shader + lsp-solargraph lsp-solidity lsp-sonarlint lsp-sorbet lsp-sourcekit + lsp-sql lsp-sqls lsp-steep lsp-svelte lsp-tailwindcss lsp-terraform + lsp-tex lsp-tilt lsp-toml lsp-trunk lsp-ttcn3 lsp-typeprof lsp-v + lsp-vala lsp-verilog lsp-vetur lsp-vhdl lsp-vimscript lsp-volar lsp-wgsl + lsp-xml lsp-yaml lsp-yang lsp-zig) + "List of the clients to be automatically required." + :group 'lsp-mode + :type '(repeat symbol)) + +(defcustom lsp-progress-via-spinner t + "If non-nil, display LSP $/progress reports via a spinner in the modeline." + :group 'lsp-mode + :type 'boolean) + +(defcustom lsp-progress-spinner-type 'progress-bar + "Holds the type of spinner to be used in the mode-line. +Takes a value accepted by `spinner-start'." + :group 'lsp-mode + :type `(choice :tag "Choose a spinner by name" + ,@(mapcar (lambda (c) (list 'const (car c))) + spinner-types))) + +(defvar-local lsp-use-workspace-root-for-server-default-directory nil + "Use `lsp-workspace-root' for `default-directory' when starting LSP process.") + +(defvar-local lsp--cur-workspace nil) + +(defvar-local lsp--cur-version 0) +(defvar-local lsp--virtual-buffer-connections nil) +(defvar-local lsp--virtual-buffer nil) +(defvar lsp--virtual-buffer-mappings (ht)) + +(defvar lsp--uri-file-prefix (pcase system-type + (`windows-nt "file:///") + (_ "file://")) + "Prefix for a file-uri.") + +(defvar-local lsp-buffer-uri nil + "If set, return it instead of calculating it using `buffer-file-name'.") + +(define-error 'lsp-error "Unknown lsp-mode error") +(define-error 'lsp-empty-response-error + "Empty response from the language server" 'lsp-error) +(define-error 'lsp-timed-out-error + "Timed out while waiting for a response from the language server" 'lsp-error) +(define-error 'lsp-capability-not-supported + "Capability not supported by the language server" 'lsp-error) +(define-error 'lsp-file-scheme-not-supported + "Unsupported file scheme" 'lsp-error) +(define-error 'lsp-client-already-exists-error + "A client with this server-id already exists" 'lsp-error) +(define-error 'lsp-no-code-actions + "No code actions" 'lsp-error) + +(defcustom lsp-auto-guess-root nil + "Automatically guess the project root using projectile/project. +Do *not* use this setting unless you are familiar with `lsp-mode' +internals and you are sure that all of your projects are +following `projectile'/`project.el' conventions." + :group 'lsp-mode + :type 'boolean) + +(defcustom lsp-guess-root-without-session nil + "Ignore the session file when calculating the project root. +You almost always want to set lsp-auto-guess-root too. +Do *not* use this setting unless you are familiar with `lsp-mode' +internals and you are sure that all of your projects are +following `projectile'/`project.el' conventions." + :group 'lsp-mode + :type 'boolean) + +(defcustom lsp-restart 'interactive + "Defines how server-exited events must be handled." + :group 'lsp-mode + :type '(choice (const interactive) + (const auto-restart) + (const ignore))) + +(defcustom lsp-session-file (expand-file-name (locate-user-emacs-file ".lsp-session-v1")) + "File where session information is stored." + :group 'lsp-mode + :type 'file) + +(defcustom lsp-auto-configure t + "Auto configure `lsp-mode' main features. +When set to t `lsp-mode' will auto-configure completion, +code-actions, breadcrumb, `flycheck', `flymake', `imenu', symbol highlighting, +lenses, links, and so on. + +For finer granularity you may use `lsp-enable-*' properties." + :group 'lsp-mode + :type 'boolean + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-disabled-clients nil + "A list of disabled/blocklisted clients. +Each entry in the list can be either: +a symbol, the server-id for the LSP client, or +a cons pair (MAJOR-MODE . CLIENTS), where MAJOR-MODE is the major-mode, +and CLIENTS is either a client or a list of clients. + +This option can also be used as a file- or directory-local variable to +disable a language server for individual files or directories/projects +respectively." + :group 'lsp-mode + :type '(repeat (symbol)) + :safe 'listp + :package-version '(lsp-mode . "6.1")) + +(defvar lsp-clients (make-hash-table :test 'eql) + "Hash table server-id -> client. +It contains all of the clients that are currently registered.") + +(defvar lsp-enabled-clients nil + "List of clients allowed to be used for projects. +When nil, all registered clients are considered candidates.") + +(defvar lsp-last-id 0 + "Last request id.") + +(defcustom lsp-before-initialize-hook nil + "List of functions to be called before a Language Server has been initialized +for a new workspace." + :type 'hook + :group 'lsp-mode) + +(defcustom lsp-after-initialize-hook nil + "List of functions to be called after a Language Server has been initialized +for a new workspace." + :type 'hook + :group 'lsp-mode) + +(defcustom lsp-before-open-hook nil + "List of functions to be called before a new file with LSP support is opened." + :type 'hook + :group 'lsp-mode) + +(defcustom lsp-after-open-hook nil + "List of functions to be called after a new file with LSP support is opened." + :type 'hook + :group 'lsp-mode) + +(defcustom lsp-enable-file-watchers t + "If non-nil lsp-mode will watch the files in the workspace if +the server has requested that." + :type 'boolean + :group 'lsp-mode + :package-version '(lsp-mode . "6.1")) +;;;###autoload(put 'lsp-enable-file-watchers 'safe-local-variable #'booleanp) + +(define-obsolete-variable-alias 'lsp-file-watch-ignored 'lsp-file-watch-ignored-directories "8.0.0") + +(defcustom lsp-file-watch-ignored-directories + '(; SCM tools + "[/\\\\]\\.git\\'" + "[/\\\\]\\.github\\'" + "[/\\\\]\\.gitlab\\'" + "[/\\\\]\\.circleci\\'" + "[/\\\\]\\.hg\\'" + "[/\\\\]\\.bzr\\'" + "[/\\\\]_darcs\\'" + "[/\\\\]\\.svn\\'" + "[/\\\\]_FOSSIL_\\'" + ;; IDE or build tools + "[/\\\\]\\.idea\\'" + "[/\\\\]\\.ensime_cache\\'" + "[/\\\\]\\.eunit\\'" + "[/\\\\]node_modules" + "[/\\\\]\\.yarn\\'" + "[/\\\\]\\.fslckout\\'" + "[/\\\\]\\.tox\\'" + "[/\\\\]\\.nox\\'" + "[/\\\\]dist\\'" + "[/\\\\]dist-newstyle\\'" + "[/\\\\]\\.stack-work\\'" + "[/\\\\]\\.bloop\\'" + "[/\\\\]\\.metals\\'" + "[/\\\\]target\\'" + "[/\\\\]\\.ccls-cache\\'" + "[/\\\\]\\.vs\\'" + "[/\\\\]\\.vscode\\'" + "[/\\\\]\\.venv\\'" + "[/\\\\]\\.mypy_cache\\'" + "[/\\\\]\\.pytest_cache\\'" + ;; Swift Package Manager + "[/\\\\]\\.build\\'" + ;; Python + "[/\\\\]__pycache__\\'" + ;; Autotools output + "[/\\\\]\\.deps\\'" + "[/\\\\]build-aux\\'" + "[/\\\\]autom4te.cache\\'" + "[/\\\\]\\.reference\\'" + ;; Bazel + "[/\\\\]bazel-[^/\\\\]+\\'" + ;; CSharp + "[/\\\\]\\.cache[/\\\\]lsp-csharp\\'" + "[/\\\\]\\.meta\\'" + "[/\\\\]\\.nuget\\'" + ;; Unity + "[/\\\\]Library\\'" + ;; Clojure + "[/\\\\]\\.lsp\\'" + "[/\\\\]\\.clj-kondo\\'" + "[/\\\\]\\.shadow-cljs\\'" + "[/\\\\]\\.babel_cache\\'" + "[/\\\\]\\.cpcache\\'" + "[/\\\\]\\checkouts\\'" + ;; Gradle + "[/\\\\]\\.gradle\\'" + ;; Maven + "[/\\\\]\\.m2\\'" + ;; .Net Core build-output + "[/\\\\]bin/Debug\\'" + "[/\\\\]obj\\'" + ;; OCaml and Dune + "[/\\\\]_opam\\'" + "[/\\\\]_build\\'" + ;; Elixir + "[/\\\\]\\.elixir_ls\\'" + ;; Elixir Credo + "[/\\\\]\\.elixir-tools\\'" + ;; terraform and terragrunt + "[/\\\\]\\.terraform\\'" + "[/\\\\]\\.terragrunt-cache\\'" + ;; nix-direnv + "[/\\\\]\\result" + "[/\\\\]\\result-bin" + "[/\\\\]\\.direnv\\'") + "List of regexps matching directory paths which won't be monitored when +creating file watches. Customization of this variable is only honored at +the global level or at a root of an lsp workspace." + :group 'lsp-mode + :type '(repeat string) + :package-version '(lsp-mode . "8.0.0")) + +(define-obsolete-function-alias 'lsp-file-watch-ignored 'lsp-file-watch-ignored-directories "7.0.1") + +(defun lsp-file-watch-ignored-directories () + lsp-file-watch-ignored-directories) + +;; Allow lsp-file-watch-ignored-directories as a file or directory-local variable +;;;###autoload(put 'lsp-file-watch-ignored-directories 'safe-local-variable 'lsp--string-listp) + +(defcustom lsp-file-watch-ignored-files + '( + ;; Flycheck tempfiles + "[/\\\\]flycheck_[^/\\\\]+\\'" + ;; lockfiles + "[/\\\\]\\.#[^/\\\\]+\\'" + ;; backup files + "[/\\\\][^/\\\\]+~\\'" ) + "List of regexps matching files for which change events will +not be sent to the server. + +This setting has no impact on whether a file-watch is created for +a directory; it merely prevents notifications pertaining to +matched files from being sent to the server. To prevent a +file-watch from being created for a directory, customize +`lsp-file-watch-ignored-directories' + +Customization of this variable is only honored at the global +level or at a root of an lsp workspace." + :group 'lsp-mode + :type '(repeat string) + :package-version '(lsp-mode . "8.0.0")) + +;; Allow lsp-file-watch-ignored-files as a file or directory-local variable +;;;###autoload(put 'lsp-file-watch-ignored-files 'safe-local-variable 'lsp--string-listp) + +(defcustom lsp-after-uninitialized-functions nil + "List of functions to be called after a Language Server has been uninitialized." + :type 'hook + :group 'lsp-mode + :package-version '(lsp-mode . "6.3")) + +(defconst lsp--sync-full 1) +(defconst lsp--sync-incremental 2) + +(defcustom lsp-debounce-full-sync-notifications t + "If non-nil debounce full sync events. +This flag affects only servers which do not support incremental updates." + :type 'boolean + :group 'lsp-mode + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-debounce-full-sync-notifications-interval 1.0 + "Time to wait before sending full sync synchronization after buffer modification." + :type 'float + :group 'lsp-mode + :package-version '(lsp-mode . "6.1")) + +(defvar lsp--stderr-index 0) + +(defvar lsp--delayed-requests nil) +(defvar lsp--delay-timer nil) + +(defcustom lsp-document-sync-method nil + "How to sync the document with the language server." + :type '(choice (const :tag "Documents are synced by always sending the full content of the document." lsp--sync-full) + (const :tag "Documents are synced by always sending incremental changes to the document." lsp--sync-incremental) + (const :tag "Use the method recommended by the language server." nil)) + :group 'lsp-mode) + +(defcustom lsp-auto-execute-action t + "Auto-execute single action." + :type 'boolean + :group 'lsp-mode) + +(defcustom lsp-enable-links t + "If non-nil, all references to links in a file will be made clickable, if +supported by the language server." + :type 'boolean + :group 'lsp-mode + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-enable-imenu t + "If non-nil, automatically enable `imenu' integration when server provides +`textDocument/documentSymbol'." + :type 'boolean + :group 'lsp-mode + :package-version '(lsp-mode . "6.2")) + +(defcustom lsp-enable-dap-auto-configure t + "If non-nil, enable `dap-auto-configure-mode`." + :type 'boolean + :group 'lsp-mode + :package-version '(lsp-mode . "7.0")) + +(defcustom lsp-eldoc-enable-hover t + "If non-nil, `eldoc' will display hover info when it is present." + :type 'boolean + :group 'lsp-mode) + +(defcustom lsp-eldoc-render-all nil + "Display all of the info returned by document/onHover. +If this is set to nil, `eldoc' will show only the symbol information." + :type 'boolean + :group 'lsp-mode) + +(define-obsolete-variable-alias 'lsp-enable-completion-at-point + 'lsp-completion-enable "lsp-mode 7.0.1") + +(defcustom lsp-completion-enable t + "Enable `completion-at-point' integration." + :type 'boolean + :group 'lsp-completion) + +(defcustom lsp-enable-symbol-highlighting t + "Highlight references of the symbol at point." + :type 'boolean + :group 'lsp-mode) + +(defcustom lsp-enable-xref t + "Enable xref integration." + :type 'boolean + :group 'lsp-mode) + +(defcustom lsp-references-exclude-definition nil + "If non-nil, exclude declarations when finding references." + :type 'boolean + :group 'lsp-mode) + +(defcustom lsp-enable-indentation t + "Indent regions using the file formatting functionality provided by the +language server." + :type 'boolean + :group 'lsp-mode) + +(defcustom lsp-enable-on-type-formatting t + "Enable `textDocument/onTypeFormatting' integration." + :type 'boolean + :group 'lsp-mode) + +(defcustom lsp-enable-text-document-color t + "Enable `textDocument/documentColor' integration." + :type 'boolean + :group 'lsp-mode) + +(defcustom lsp-before-save-edits t + "If non-nil, `lsp-mode' will apply edits suggested by the language server +before saving a document." + :type 'boolean + :group 'lsp-mode) + +(defcustom lsp-after-apply-edits-hook nil + "Hooks to run when text edit is applied. +It contains the operation source." + :type 'hook + :group 'lsp-mode + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-apply-edits-after-file-operations t + "Whether to apply edits returned by server after file operations if any. +Applicable only if server supports workspace.fileOperations for operations: +`workspace/willRenameFiles', `workspace/willCreateFiles' and +`workspace/willDeleteFiles'." + :group 'lsp-mode + :type 'boolean) + +(defcustom lsp-modeline-code-actions-enable t + "Whether to show code actions on modeline." + :type 'boolean + :group 'lsp-modeline) + +(defcustom lsp-modeline-diagnostics-enable t + "Whether to show diagnostics on modeline." + :type 'boolean + :group 'lsp-modeline) + +(defcustom lsp-modeline-workspace-status-enable t + "Whether to show workspace status on modeline." + :type 'boolean + :group 'lsp-modeline + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-headerline-breadcrumb-enable t + "Whether to enable breadcrumb on headerline." + :type 'boolean + :group 'lsp-headerline) + +(defcustom lsp-configure-hook nil + "Hooks to run when `lsp-configure-buffer' is called." + :type 'hook + :group 'lsp-mode) + +(defcustom lsp-unconfigure-hook nil + "Hooks to run when `lsp-unconfig-buffer' is called." + :type 'hook + :group 'lsp-mode) + +(defcustom lsp-after-diagnostics-hook nil + "Hooks to run after diagnostics are received. +Note: it runs only if the receiving buffer is open. Use +`lsp-diagnostics-updated-hook'if you want to be notified when +diagnostics have changed." + :type 'hook + :group 'lsp-mode) + +(define-obsolete-variable-alias 'lsp-after-diagnostics-hook + 'lsp-diagnostics-updated-hook "lsp-mode 6.4") + +(defcustom lsp-diagnostics-updated-hook nil + "Hooks to run after diagnostics are received." + :type 'hook + :group 'lsp-mode) + +(define-obsolete-variable-alias 'lsp-workspace-folders-changed-hook + 'lsp-workspace-folders-changed-functions "lsp-mode 6.3") + +(defcustom lsp-workspace-folders-changed-functions nil + "Hooks to run after the folders has changed. +The hook will receive two parameters list of added and removed folders." + :type 'hook + :group 'lsp-mode) + +(define-obsolete-variable-alias 'lsp-eldoc-hook 'eldoc-documentation-functions "lsp-mode 9.0.0") + +(defcustom lsp-before-apply-edits-hook nil + "Hooks to run before applying edits." + :type 'hook + :group 'lsp-mode) + +(defgroup lsp-imenu nil + "LSP Imenu." + :group 'lsp-mode + :tag "LSP Imenu") + +(defcustom lsp-imenu-show-container-name t + "Display the symbol's container name in an imenu entry." + :type 'boolean + :group 'lsp-imenu) + +(defcustom lsp-imenu-container-name-separator "/" + "Separator string to use to separate the container name from the symbol while +displaying imenu entries." + :type 'string + :group 'lsp-imenu) + +(defcustom lsp-imenu-sort-methods '(kind name) + "How to sort the imenu items. + +The value is a list of `kind' `name' or `position'. Priorities +are determined by the index of the element." + :type '(repeat (choice (const name) + (const position) + (const kind))) + :group 'lsp-imenu) + +(defcustom lsp-imenu-index-symbol-kinds nil + "Which symbol kinds to show in imenu." + :type '(repeat (choice (const :tag "Miscellaneous" nil) + (const :tag "File" File) + (const :tag "Module" Module) + (const :tag "Namespace" Namespace) + (const :tag "Package" Package) + (const :tag "Class" Class) + (const :tag "Method" Method) + (const :tag "Property" Property) + (const :tag "Field" Field) + (const :tag "Constructor" Constructor) + (const :tag "Enum" Enum) + (const :tag "Interface" Interface) + (const :tag "Function" Function) + (const :tag "Variable" Variable) + (const :tag "Constant" Constant) + (const :tag "String" String) + (const :tag "Number" Number) + (const :tag "Boolean" Boolean) + (const :tag "Array" Array) + (const :tag "Object" Object) + (const :tag "Key" Key) + (const :tag "Null" Null) + (const :tag "Enum Member" EnumMember) + (const :tag "Struct" Struct) + (const :tag "Event" Event) + (const :tag "Operator" Operator) + (const :tag "Type Parameter" TypeParameter))) + :group 'lsp-imenu) + +;; vibhavp: Should we use a lower value (5)? +(defcustom lsp-response-timeout 10 + "Number of seconds to wait for a response from the language server before +timing out. Nil if no timeout." + :type '(choice + (number :tag "Seconds") + (const :tag "No timeout" nil)) + :group 'lsp-mode) + +(defcustom lsp-tcp-connection-timeout 2 + "The timeout for tcp connection in seconds." + :type 'number + :group 'lsp-mode + :package-version '(lsp-mode . "6.2")) + +(defconst lsp--imenu-compare-function-alist + (list (cons 'name #'lsp--imenu-compare-name) + (cons 'kind #'lsp--imenu-compare-kind) + (cons 'position #'lsp--imenu-compare-line-col)) + "An alist of (METHOD . FUNCTION). +METHOD is one of the symbols accepted by +`lsp-imenu-sort-methods'. + +FUNCTION takes two hash tables representing DocumentSymbol. It +returns a negative number, 0, or a positive number indicating +whether the first parameter is less than, equal to, or greater +than the second parameter.") + +(defcustom lsp-diagnostic-clean-after-change nil + "When non-nil, clean the diagnostics on change. + +Note that when that setting is nil, `lsp-mode' will show stale +diagnostics until server publishes the new set of diagnostics" + :type 'boolean + :group 'lsp-diagnostics + :package-version '(lsp-mode . "7.0.1")) + +(defcustom lsp-server-trace nil + "Request tracing on the server side. +The actual trace output at each level depends on the language server in use. +Changes take effect only when a new session is started." + :type '(choice (const :tag "Disabled" "off") + (const :tag "Messages only" "messages") + (const :tag "Verbose" "verbose") + (const :tag "Default (disabled)" nil)) + :group 'lsp-mode + :package-version '(lsp-mode . "6.1")) + +(defcustom lsp-auto-touch-files t + "If non-nil ensure the files exist before sending +`textDocument/didOpen' notification." + :type 'boolean + :group 'lsp-mode + :package-version '(lsp-mode . "9.0.0")) + +(defvar lsp-language-id-configuration + '(("\\(^CMakeLists\\.txt\\|\\.cmake\\)\\'" . "cmake") + ("\\(^Dockerfile\\(?:\\..*\\)?\\|\\.[Dd]ockerfile\\)\\'" . "dockerfile") + ("\\.astro$" . "astro") + ("\\.cs\\'" . "csharp") + ("\\.css$" . "css") + ("\\.cypher$" . "cypher") + ("Earthfile" . "earthfile") + ("\\.ebuild$" . "shellscript") + ("\\.go\\'" . "go") + ("\\.html$" . "html") + ("\\.hx$" . "haxe") + ("\\.hy$" . "hy") + ("\\.java\\'" . "java") + ("\\.jq$" . "jq") + ("\\.js$" . "javascript") + ("\\.json$" . "json") + ("\\.jsonc$" . "jsonc") + ("\\.jsonnet$" . "jsonnet") + ("\\.jsx$" . "javascriptreact") + ("\\.lua$" . "lua") + ("\\.mdx\\'" . "mdx") + ("\\.nu$" . "nushell") + ("\\.php$" . "php") + ("\\.ps[dm]?1\\'" . "powershell") + ("\\.rs\\'" . "rust") + ("\\.spec\\'" . "rpm-spec") + ("\\.sql$" . "sql") + ("\\.svelte$" . "svelte") + ("\\.toml\\'" . "toml") + ("\\.ts$" . "typescript") + ("\\.tsx$" . "typescriptreact") + ("\\.ttcn3$" . "ttcn3") + ("\\.vue$" . "vue") + ("\\.xml$" . "xml") + ("\\ya?ml$" . "yaml") + ("^PKGBUILD$" . "shellscript") + ("^go\\.mod\\'" . "go.mod") + ("^settings\\.json$" . "jsonc") + ("^yang\\.settings$" . "jsonc") + ("^meson\\(_options\\.txt\\|\\.\\(build\\|format\\)\\)\\'" . "meson") + (ada-mode . "ada") + (ada-ts-mode . "ada") + (gpr-mode . "gpr") + (gpr-ts-mode . "gpr") + (awk-mode . "awk") + (awk-ts-mode . "awk") + (nxml-mode . "xml") + (sql-mode . "sql") + (vimrc-mode . "vim") + (vimscript-ts-mode . "vim") + (sh-mode . "shellscript") + (bash-ts-mode . "shellscript") + (ebuild-mode . "shellscript") + (pkgbuild-mode . "shellscript") + (envrc-file-mode . "shellscript") + (scala-mode . "scala") + (scala-ts-mode . "scala") + (julia-mode . "julia") + (julia-ts-mode . "julia") + (clojure-mode . "clojure") + (clojurec-mode . "clojure") + (clojurescript-mode . "clojurescript") + (clojure-ts-mode . "clojure") + (clojure-ts-clojurec-mode . "clojure") + (clojure-ts-clojurescript-mode . "clojurescript") + (java-mode . "java") + (java-ts-mode . "java") + (jdee-mode . "java") + (groovy-mode . "groovy") + (python-mode . "python") + (python-ts-mode . "python") + (cython-mode . "python") + ("\\(\\.mojo\\|\\.🔥\\)\\'" . "mojo") + (lsp--render-markdown . "markdown") + (move-mode . "move") + (rust-mode . "rust") + (rust-ts-mode . "rust") + (rustic-mode . "rust") + (kotlin-mode . "kotlin") + (kotlin-ts-mode . "kotlin") + (css-mode . "css") + (css-ts-mode . "css") + (less-mode . "less") + (less-css-mode . "less") + (lua-mode . "lua") + (lua-ts-mode . "lua") + (sass-mode . "sass") + (ssass-mode . "sass") + (scss-mode . "scss") + (scad-mode . "openscad") + (xml-mode . "xml") + (c-mode . "c") + (c-ts-mode . "c") + (c++-mode . "cpp") + (c++-ts-mode . "cpp") + (cuda-mode . "cuda") + (objc-mode . "objective-c") + (html-mode . "html") + (html-ts-mode . "html") + (sgml-mode . "html") + (mhtml-mode . "html") + (mint-mode . "mint") + (go-dot-mod-mode . "go.mod") + (go-mod-ts-mode . "go.mod") + (go-mode . "go") + (go-ts-mode . "go") + (graphql-mode . "graphql") + (haskell-mode . "haskell") + (hack-mode . "hack") + (php-mode . "php") + (php-ts-mode . "php") + (powershell-mode . "powershell") + (powershell-mode . "PowerShell") + (powershell-ts-mode . "powershell") + (json-mode . "json") + (json-ts-mode . "json") + (jsonc-mode . "jsonc") + (rjsx-mode . "javascript") + (js2-mode . "javascript") + (js-mode . "javascript") + (js-ts-mode . "javascript") + (typescript-mode . "typescript") + (typescript-ts-mode . "typescript") + (tsx-ts-mode . "typescriptreact") + (svelte-mode . "svelte") + (fsharp-mode . "fsharp") + (reason-mode . "reason") + (caml-mode . "ocaml") + (tuareg-mode . "ocaml") + (swift-mode . "swift") + (elixir-mode . "elixir") + (elixir-ts-mode . "elixir") + (heex-ts-mode . "elixir") + (conf-javaprop-mode . "spring-boot-properties") + (yaml-mode . "yaml") + (yaml-ts-mode . "yaml") + (ruby-mode . "ruby") + (enh-ruby-mode . "ruby") + (ruby-ts-mode . "ruby") + (feature-mode . "cucumber") + (fortran-mode . "fortran") + (f90-mode . "fortran") + (elm-mode . "elm") + (dart-mode . "dart") + (erlang-mode . "erlang") + (dockerfile-mode . "dockerfile") + (dockerfile-ts-mode . "dockerfile") + (csharp-mode . "csharp") + (csharp-tree-sitter-mode . "csharp") + (csharp-ts-mode . "csharp") + (plain-tex-mode . "plaintex") + (context-mode . "context") + (cypher-mode . "cypher") + (latex-mode . "latex") + (LaTeX-mode . "latex") + (v-mode . "v") + (vhdl-mode . "vhdl") + (vhdl-ts-mode . "vhdl") + (verilog-mode . "verilog") + (terraform-mode . "terraform") + (ess-julia-mode . "julia") + (ess-r-mode . "r") + (crystal-mode . "crystal") + (nim-mode . "nim") + (dhall-mode . "dhall") + (cmake-mode . "cmake") + (cmake-ts-mode . "cmake") + (purescript-mode . "purescript") + (gdscript-mode . "gdscript") + (gdscript-ts-mode . "gdscript") + (perl-mode . "perl") + (cperl-mode . "perl") + (robot-mode . "robot") + (racket-mode . "racket") + (nix-mode . "nix") + (nix-ts-mode . "Nix") + (prolog-mode . "prolog") + (vala-mode . "vala") + (actionscript-mode . "actionscript") + (d-mode . "d") + (zig-mode . "zig") + (text-mode . "plaintext") + (markdown-mode . "markdown") + (gfm-mode . "markdown") + (beancount-mode . "beancount") + (conf-toml-mode . "toml") + (toml-ts-mode . "toml") + (org-mode . "org") + (org-journal-mode . "org") + (nginx-mode . "nginx") + (magik-mode . "magik") + (magik-ts-mode . "magik") + (idris-mode . "idris") + (idris2-mode . "idris2") + (gleam-mode . "gleam") + (gleam-ts-mode . "gleam") + (graphviz-dot-mode . "dot") + (tiltfile-mode . "tiltfile") + (solidity-mode . "solidity") + (bibtex-mode . "bibtex") + (rst-mode . "restructuredtext") + (glsl-mode . "glsl") + (shader-mode . "shaderlab") + (wgsl-mode . "wgsl") + (jq-mode . "jq") + (jq-ts-mode . "jq") + (protobuf-mode . "protobuf") + (nushell-mode . "nushell") + (nushell-ts-mode . "nushell") + (meson-mode . "meson") + (yang-mode . "yang")) + "Language id configuration.") + +(defvar lsp--last-active-workspaces nil + "Keep track of last active workspace. +We want to try the last workspace first when jumping into a library +directory") + +(defvar lsp-method-requirements + '(("textDocument/callHierarchy" :capability :callHierarchyProvider) + ("textDocument/codeAction" :capability :codeActionProvider) + ("codeAction/resolve" + :check-command (lambda (workspace) + (with-lsp-workspace workspace + (lsp:code-action-options-resolve-provider? + (lsp--capability-for-method "textDocument/codeAction"))))) + ("textDocument/codeLens" :capability :codeLensProvider) + ("textDocument/completion" :capability :completionProvider) + ("completionItem/resolve" + :check-command (lambda (wk) + (with-lsp-workspace wk + (lsp:completion-options-resolve-provider? + (lsp--capability-for-method "textDocument/completion"))))) + ("textDocument/declaration" :capability :declarationProvider) + ("textDocument/definition" :capability :definitionProvider) + ("textDocument/documentColor" :capability :colorProvider) + ("textDocument/documentLink" :capability :documentLinkProvider) + ("textDocument/inlayHint" :capability :inlayHintProvider) + ("textDocument/documentHighlight" :capability :documentHighlightProvider) + ("textDocument/documentSymbol" :capability :documentSymbolProvider) + ("textDocument/foldingRange" :capability :foldingRangeProvider) + ("textDocument/formatting" :capability :documentFormattingProvider) + ("textDocument/hover" :capability :hoverProvider) + ("textDocument/implementation" :capability :implementationProvider) + ("textDocument/linkedEditingRange" :capability :linkedEditingRangeProvider) + ("textDocument/onTypeFormatting" :capability :documentOnTypeFormattingProvider) + ("textDocument/prepareRename" + :check-command (lambda (workspace) + (with-lsp-workspace workspace + (lsp:rename-options-prepare-provider? + (lsp--capability-for-method "textDocument/rename"))))) + ("textDocument/rangeFormatting" :capability :documentRangeFormattingProvider) + ("textDocument/references" :capability :referencesProvider) + ("textDocument/rename" :capability :renameProvider) + ("textDocument/selectionRange" :capability :selectionRangeProvider) + ("textDocument/semanticTokens" :capability :semanticTokensProvider) + ("textDocument/semanticTokensFull" + :check-command (lambda (workspace) + (with-lsp-workspace workspace + (lsp-get (lsp--capability :semanticTokensProvider) :full)))) + ("textDocument/semanticTokensFull/Delta" + :check-command (lambda (workspace) + (with-lsp-workspace workspace + (let ((capFull (lsp-get (lsp--capability :semanticTokensProvider) :full))) + (and (not (booleanp capFull)) (lsp-get capFull :delta)))))) + ("textDocument/semanticTokensRangeProvider" + :check-command (lambda (workspace) + (with-lsp-workspace workspace + (lsp-get (lsp--capability :semanticTokensProvider) :range)))) + ("textDocument/signatureHelp" :capability :signatureHelpProvider) + ("textDocument/typeDefinition" :capability :typeDefinitionProvider) + ("textDocument/typeHierarchy" :capability :typeHierarchyProvider) + ("workspace/executeCommand" :capability :executeCommandProvider) + ("workspace/symbol" :capability :workspaceSymbolProvider)) + + "Map methods to requirements. +It is used by request-sending functions to determine which server +must be used for handling a particular message.") + +(defconst lsp--file-change-type + `((created . 1) + (changed . 2) + (deleted . 3))) + +(defconst lsp--watch-kind + `((create . 1) + (change . 2) + (delete . 4))) + +(defvar lsp-window-body-width 40 + "Window body width when rendering doc.") + +(defface lsp-face-highlight-textual + '((t :inherit highlight)) + "Face used for textual occurrences of symbols." + :group 'lsp-mode) + +(defface lsp-face-highlight-read + '((t :inherit highlight :underline t)) + "Face used for highlighting symbols being read." + :group 'lsp-mode) + +(defface lsp-face-highlight-write + '((t :inherit highlight :weight bold)) + "Face used for highlighting symbols being written to." + :group 'lsp-mode) + +(define-obsolete-variable-alias 'lsp-lens-auto-enable + 'lsp-lens-enable "lsp-mode 7.0.1") + +(defcustom lsp-lens-enable t + "Auto enable lenses if server supports." + :group 'lsp-lens + :type 'boolean + :package-version '(lsp-mode . "6.3")) + +(defcustom lsp-symbol-highlighting-skip-current nil + "If non-nil skip current symbol when setting symbol highlights." + :group 'lsp-mode + :type 'boolean) + +(defcustom lsp-file-watch-threshold 1000 + "Show warning if the files to watch are more than. +Set to nil to disable the warning." + :type 'number + :group 'lsp-mode) +;;;###autoload(put 'lsp-file-watch-threshold 'safe-local-variable (lambda (i) (or (numberp i) (not i)))) + +(defvar lsp-custom-markup-modes + '((rust-mode "no_run" "rust,no_run" "rust,ignore" "rust,should_panic")) + "Mode to uses with markdown code blocks. +They are added to `markdown-code-lang-modes'") + +(defcustom lsp-signature-render-documentation t + "Display signature documentation in `eldoc'." + :type 'boolean + :group 'lsp-mode + :package-version '(lsp-mode . "6.2")) + +(defcustom lsp-signature-auto-activate '(:on-trigger-char :on-server-request) + "Auto activate signature conditions." + :type '(repeat (choice (const :tag "On trigger chars pressed." :on-trigger-char) + (const :tag "After selected completion." :after-completion) + (const :tag "When the server has sent show signature help." :on-server-request))) + :group 'lsp-mode + :package-version '(lsp-mode . "6.2")) + +(defcustom lsp-signature-doc-lines 20 + "If number, limit the number of lines to show in the docs." + :type 'number + :group 'lsp-mode + :package-version '(lsp-mode . "6.3")) + +(defcustom lsp-signature-function 'lsp-lv-message + "The function used for displaying signature info. +It will be called with one param - the signature info. When +called with nil the signature info must be cleared." + :type 'function + :group 'lsp-mode + :package-version '(lsp-mode . "6.3")) + +(defcustom lsp-keymap-prefix "s-l" + "LSP-mode keymap prefix." + :group 'lsp-mode + :type 'string + :package-version '(lsp-mode . "6.3")) + +(defvar-local lsp--buffer-workspaces () + "List of the buffer workspaces.") + +(defvar-local lsp--buffer-deferred nil + "Whether buffer was loaded via `lsp-deferred'.") + +(defvar lsp--session nil + "Contain the `lsp-session' for the current Emacs instance.") + +(defvar lsp--tcp-port 10000) + +(defvar lsp--client-packages-required nil + "If nil, `lsp-client-packages' are yet to be required.") + +(defvar lsp--tcp-server-port 0 + "The server socket which is opened when using `lsp-tcp-server' (a server +socket is opened in Emacs and the language server connects to it). The +default value of 0 ensures that a random high port is used. Set it to a positive +integer to use a specific port.") + +(defvar lsp--tcp-server-wait-seconds 10 + "Wait this amount of time for the client to connect to our server socket +when using `lsp-tcp-server'.") + +(defvar-local lsp--document-symbols nil + "The latest document symbols.") + +(defvar-local lsp--document-selection-range-cache nil + "The document selection cache.") + +(defvar-local lsp--document-symbols-request-async nil + "If non-nil, request document symbols asynchronously.") + +(defvar-local lsp--document-symbols-tick -1 + "The value of `buffer-chars-modified-tick' when document + symbols were last retrieved.") + +(defvar-local lsp--have-document-highlights nil + "Set to `t' on symbol highlighting, cleared on +`lsp--cleanup-highlights-if-needed'. Checking a separately +defined flag is substantially faster than unconditionally +calling `remove-overlays'.") + +;; Buffer local variable for storing number of lines. +(defvar lsp--log-lines) + +(defvar-local lsp--eldoc-saved-message nil) + +(defvar lsp--on-change-timer nil) +(defvar lsp--on-idle-timer nil) + +(defvar-local lsp--signature-last nil) +(defvar-local lsp--signature-last-index nil) +(defvar lsp--signature-last-buffer nil) + +(defvar-local lsp--virtual-buffer-point-max nil) + +(cl-defmethod lsp-execute-command (_server _command _arguments) + "Ask SERVER to execute COMMAND with ARGUMENTS.") + +(defun lsp-elt (sequence n) + "Return Nth element of SEQUENCE or nil if N is out of range." + (cond + ((listp sequence) (elt sequence n)) + ((arrayp sequence) + (and (> (length sequence) n) (aref sequence n))) + (t (and (> (length sequence) n) (elt sequence n))))) + +;; define seq-first and seq-rest for older emacs +(defun lsp-seq-first (sequence) + "Return the first element of SEQUENCE." + (lsp-elt sequence 0)) + +(defun lsp-seq-rest (sequence) + "Return a sequence of the elements of SEQUENCE except the first one." + (seq-drop sequence 1)) + +;;;###autoload +(defun lsp--string-listp (sequence) + "Return t if all elements of SEQUENCE are strings, else nil." + (not (seq-find (lambda (x) (not (stringp x))) sequence))) + +(defun lsp--string-vector-p (candidate) + "Returns true if CANDIDATE is a vector data structure and +every element of it is of type string, else nil." + (and + (vectorp candidate) + (seq-every-p #'stringp candidate))) + +(make-obsolete 'lsp--string-vector-p nil "lsp-mode 8.0.0") + +(defun lsp--editable-vector-match (widget value) + "Function for `lsp-editable-vector' :match." + ;; Value must be a list or a vector and all the members must match the type. + (and (or (listp value) (vectorp value)) + (length (cdr (lsp--editable-vector-match-inline widget value))))) + +(defun lsp--editable-vector-match-inline (widget value) + "Value for `lsp-editable-vector' :match-inline." + (let ((type (nth 0 (widget-get widget :args))) + (ok t) + found) + (while (and value ok) + (let ((answer (widget-match-inline type value))) + (if answer + (let ((head (if (vectorp answer) (aref answer 0) (car answer))) + (tail (if (vectorp answer) (seq-drop 1 answer) (cdr answer)))) + (setq found (append found head) + value tail)) + (setq ok nil)))) + (cons found value))) + +(defun lsp--editable-vector-value-to-external (_widget internal-value) + "Convert the internal list value to a vector." + (if (listp internal-value) + (apply 'vector internal-value) + internal-value)) + +(defun lsp--editable-vector-value-to-internal (_widget external-value) + "Convert the external vector value to a list." + (if (vectorp external-value) + (append external-value nil) + external-value)) + +(define-widget 'lsp--editable-vector 'editable-list + "A subclass of `editable-list' that accepts and returns a +vector instead of a list." + :value-to-external 'lsp--editable-vector-value-to-external + :value-to-internal 'lsp--editable-vector-value-to-internal + :match 'lsp--editable-vector-match + :match-inline 'lsp--editable-vector-match-inline) + +(define-widget 'lsp-repeatable-vector 'lsp--editable-vector + "A variable length homogeneous vector." + :tag "Repeat" + :format "%{%t%}:\n%v%i\n") + +(define-widget 'lsp-string-vector 'lazy + "A vector of zero or more elements, every element of which is a string. +Appropriate for any language-specific `defcustom' that needs to +serialize as a JSON array of strings. + +Deprecated. Use `lsp-repeatable-vector' instead. " + :offset 4 + :tag "Vector" + :type '(lsp-repeatable-vector string)) + +(make-obsolete 'lsp-string-vector nil "lsp-mode 8.0.0") + +(defvar lsp--show-message t + "If non-nil, show debug message from `lsp-mode'.") + +(defun lsp--message (format &rest args) + "Wrapper for `message' + +We `inhibit-message' the message when the cursor is in the +minibuffer and when emacs version is before emacs 27 due to the +fact that we often use `lsp--info', `lsp--warn' and `lsp--error' +in async context and the call to these function is removing the +minibuffer prompt. The issue with async messages is already fixed +in emacs 27. + +See #2049" + (when lsp--show-message + (let ((inhibit-message (or inhibit-message + (and (minibufferp) + (version< emacs-version "27.0"))))) + (apply #'message format args)))) + +(defun lsp--info (format &rest args) + "Display lsp info message with FORMAT with ARGS." + (lsp--message "%s :: %s" (propertize "LSP" 'face 'success) (apply #'format format args))) + +(defun lsp--warn (format &rest args) + "Display lsp warn message with FORMAT with ARGS." + (lsp--message "%s :: %s" (propertize "LSP" 'face 'warning) (apply #'format format args))) + +(defun lsp--error (format &rest args) + "Display lsp error message with FORMAT with ARGS." + (lsp--message "%s :: %s" (propertize "LSP" 'face 'error) (apply #'format format args))) + +(defun lsp-log (format &rest args) + "Log message to the ’*lsp-log*’ buffer. + +FORMAT and ARGS i the same as for `message'." + (when lsp-log-max + (let ((log-buffer (get-buffer "*lsp-log*")) + (inhibit-read-only t)) + (unless log-buffer + (setq log-buffer (get-buffer-create "*lsp-log*")) + (with-current-buffer log-buffer + (buffer-disable-undo) + (view-mode 1) + (set (make-local-variable 'lsp--log-lines) 0))) + (with-current-buffer log-buffer + (save-excursion + (let* ((message (apply 'format format args)) + ;; Count newlines in message. + (newlines (1+ (cl-loop with start = 0 + for count from 0 + while (string-match "\n" message start) + do (setq start (match-end 0)) + finally return count)))) + (goto-char (point-max)) + + ;; in case the buffer is not empty insert before last \n to preserve + ;; the point position(in case it is in the end) + (if (eq (point) (point-min)) + (progn + (insert "\n") + (backward-char)) + (backward-char) + (insert "\n")) + (insert message) + + (setq lsp--log-lines (+ lsp--log-lines newlines)) + + (when (and (integerp lsp-log-max) (> lsp--log-lines lsp-log-max)) + (let ((to-delete (- lsp--log-lines lsp-log-max))) + (goto-char (point-min)) + (forward-line to-delete) + (delete-region (point-min) (point)) + (setq lsp--log-lines lsp-log-max))))))))) + +(defalias 'lsp-message 'lsp-log) + +(defalias 'lsp-ht 'ht) + +(defalias 'lsp-file-local-name 'file-local-name) + +(defun lsp-f-canonical (file-name) + "Return the canonical FILE-NAME, without a trailing slash." + (directory-file-name (expand-file-name file-name))) + +(defalias 'lsp-canonical-file-name 'lsp-f-canonical) + +(defun lsp-f-same? (path-a path-b) + "Return t if PATH-A and PATH-B are references to the same file. +Symlinks are not followed." + (when (and (f-exists? path-a) + (f-exists? path-b)) + (equal + (lsp-f-canonical (directory-file-name (f-expand path-a))) + (lsp-f-canonical (directory-file-name (f-expand path-b)))))) + +(defun lsp-f-parent (path) + "Return the parent directory to PATH. +Symlinks are not followed." + (let ((parent (file-name-directory + (directory-file-name (f-expand path default-directory))))) + (unless (lsp-f-same? path parent) + (if (f-relative? path) + (f-relative parent) + (directory-file-name parent))))) + +(defun lsp-f-ancestor-of? (path-a path-b) + "Return t if PATH-A is an ancestor of PATH-B. +Symlinks are not followed." + (unless (lsp-f-same? path-a path-b) + (s-prefix? (concat (lsp-f-canonical path-a) (f-path-separator)) + (lsp-f-canonical path-b)))) + +(defun lsp--merge-results (results method) + "Merge RESULTS by filtering the empty hash-tables and merging +the lists according to METHOD." + (pcase (--map (if (vectorp it) + (append it nil) it) + (-filter #'identity results)) + (`() ()) + ;; only one result - simply return it + (`(,fst) fst) + ;; multiple results merge it based on strategy + (results + (pcase method + ("textDocument/hover" (pcase (seq-filter + (-compose #'not #'lsp-empty?) + results) + (`(,hover) hover) + (hovers (lsp-make-hover + :contents + (-mapcat + (-lambda ((&Hover :contents)) + (if (and (sequencep contents) + (not (stringp contents))) + (append contents ()) + (list contents))) + hovers))))) + ("textDocument/completion" + (lsp-make-completion-list + :is-incomplete (seq-some + #'lsp:completion-list-is-incomplete + results) + :items (cl-mapcan (lambda (it) (append (if (lsp-completion-list? it) + (lsp:completion-list-items it) + it) + nil)) + results))) + ("completionItem/resolve" + (let ((item (cl-first results))) + (when-let ((details (seq-filter #'identity + (seq-map #'lsp:completion-item-detail? results)))) + (lsp:set-completion-item-detail? + item + (string-join details " "))) + (when-let ((docs (seq-filter #'identity + (seq-map #'lsp:completion-item-documentation? results)))) + (lsp:set-completion-item-documentation? + item + (lsp-make-markup-content + :kind (or (seq-some (lambda (it) + (when (equal (lsp:markup-content-kind it) + lsp/markup-kind-markdown) + lsp/markup-kind-markdown)) + docs) + lsp/markup-kind-plain-text) + :value (string-join (seq-map (lambda (doc) + (or (lsp:markup-content-value doc) + (and (stringp doc) doc))) + docs) + "\n")))) + (when-let ((edits (seq-filter #'identity + (seq-map #'lsp:completion-item-additional-text-edits? results)))) + (lsp:set-completion-item-additional-text-edits? + item + (cl-mapcan (lambda (it) (if (seqp it) it (list it))) edits))) + item)) + (_ (cl-mapcan (lambda (it) (if (seqp it) it (list it))) results)))))) + +(defun lsp--spinner-start () + "Start spinner indication." + (condition-case _err (spinner-start (lsp-progress-spinner-type)) (error))) + +(defun lsp--propertize (str type) + "Propertize STR as per TYPE." + (propertize str 'face (alist-get type lsp--message-type-face))) + +(defun lsp-workspaces () + "Return the lsp workspaces associated with the current project." + (if lsp--cur-workspace (list lsp--cur-workspace) lsp--buffer-workspaces)) + +(defun lsp--completing-read (prompt collection transform-fn &optional predicate + require-match initial-input + hist def inherit-input-method) + "Wrap `completing-read' to provide transformation function and disable sort. + +TRANSFORM-FN will be used to transform each of the items before displaying. + +PROMPT COLLECTION PREDICATE REQUIRE-MATCH INITIAL-INPUT HIST DEF +INHERIT-INPUT-METHOD will be proxied to `completing-read' without changes." + (let* ((col (--map (cons (funcall transform-fn it) it) collection)) + (completion (completing-read prompt + (lambda (string pred action) + (if (eq action 'metadata) + `(metadata (display-sort-function . identity)) + (complete-with-action action col string pred))) + predicate require-match initial-input hist + def inherit-input-method))) + (cdr (assoc completion col)))) + +(defconst lsp--system-arch (lambda () + (setq lsp--system-arch + (pcase system-type + ('windows-nt + (pcase system-configuration + ((rx bol "x86_64-") 'x64) + (_ 'x86))) + ('darwin + (pcase system-configuration + ((rx "aarch64-") 'arm64) + (_ 'x64))) + ('gnu/linux + (pcase system-configuration + ((rx bol "x86_64") 'x64) + ((rx bol (| "i386" "i886")) 'x32))) + (_ + (pcase system-configuration + ((rx bol "x86_64") 'x64) + ((rx bol (| "i386" "i886")) 'x32)))))) + "Return the system architecture of `Emacs'. +Special values: + `x64' 64bit + `x32' 32bit + `arm64' ARM 64bit") + +(defmacro lsp-with-current-buffer (buffer-id &rest body) + (declare (indent 1) (debug t)) + `(if-let ((wcb (plist-get ,buffer-id :with-current-buffer))) + (with-lsp-workspaces (plist-get ,buffer-id :workspaces) + (funcall wcb (lambda () ,@body))) + (with-current-buffer ,buffer-id + ,@body))) + +(defvar lsp--throw-on-input nil + "Make `lsp-*-while-no-input' throws `input' on interrupted.") + +(defmacro lsp--catch (tag bodyform &rest handlers) + "Catch TAG thrown in BODYFORM. +The return value from TAG will be handled in HANDLERS by `pcase'." + (declare (debug (form form &rest (pcase-PAT body))) (indent 2)) + (let ((re-sym (make-symbol "re"))) + `(let ((,re-sym (catch ,tag ,bodyform))) + (pcase ,re-sym + ,@handlers)))) + +(defmacro lsp--while-no-input (&rest body) + "Wrap BODY in `while-no-input' and respecting `non-essential'. +If `lsp--throw-on-input' is set, will throw if input is pending, else +return value of `body' or nil if interrupted." + (declare (debug t) (indent 0)) + `(if non-essential + (let ((res (while-no-input ,@body))) + (cond + ((and lsp--throw-on-input (equal res t)) + (throw 'input :interrupted)) + ((booleanp res) nil) + (t res))) + ,@body)) + +;; A ‘lsp--client’ object describes the client-side behavior of a language +;; server. It is used to start individual server processes, each of which is +;; represented by a ‘lsp--workspace’ object. Client objects are normally +;; created using ‘lsp-define-stdio-client’ or ‘lsp-define-tcp-client’. Each +;; workspace refers to exactly one client, but there can be multiple workspaces +;; for a single client. +(cl-defstruct lsp--client + ;; ‘language-id’ is a function that receives a buffer as a single argument + ;; and should return the language identifier for that buffer. See + ;; https://microsoft.github.io/language-server-protocol/specification#textdocumentitem + ;; for a list of language identifiers. Also consult the documentation for + ;; the language server represented by this client to find out what language + ;; identifiers it supports or expects. + (language-id nil) + + ;; ‘add-on?’ when set to t the server will be started no matter whether there + ;; is another server handling the same mode. + (add-on? nil) + ;; ‘new-connection’ is a function that should start a language server process + ;; and return a cons (COMMAND-PROCESS . COMMUNICATION-PROCESS). + ;; COMMAND-PROCESS must be a process object representing the server process + ;; just started. COMMUNICATION-PROCESS must be a process (including pipe and + ;; network processes) that ‘lsp-mode’ uses to communicate with the language + ;; server using the language server protocol. COMMAND-PROCESS and + ;; COMMUNICATION-PROCESS may be the same process; in that case + ;; ‘new-connection’ may also return that process as a single + ;; object. ‘new-connection’ is called with two arguments, FILTER and + ;; SENTINEL. FILTER should be used as process filter for + ;; COMMUNICATION-PROCESS, and SENTINEL should be used as process sentinel for + ;; COMMAND-PROCESS. + (new-connection nil) + + ;; ‘ignore-regexps’ is a list of regexps. When a data packet from the + ;; language server matches any of these regexps, it will be ignored. This is + ;; intended for dealing with language servers that output non-protocol data. + (ignore-regexps nil) + + ;; ‘ignore-messages’ is a list of regexps. When a message from the language + ;; server matches any of these regexps, it will be ignored. This is useful + ;; for filtering out unwanted messages; such as servers that send nonstandard + ;; message types, or extraneous log messages. + (ignore-messages nil) + + ;; ‘notification-handlers’ is a hash table mapping notification method names + ;; (strings) to functions handling the respective notifications. Upon + ;; receiving a notification, ‘lsp-mode’ will call the associated handler + ;; function passing two arguments, the ‘lsp--workspace’ object and the + ;; deserialized notification parameters. + (notification-handlers (make-hash-table :test 'equal)) + + ;; ‘request-handlers’ is a hash table mapping request method names + ;; (strings) to functions handling the respective notifications. Upon + ;; receiving a request, ‘lsp-mode’ will call the associated handler function + ;; passing two arguments, the ‘lsp--workspace’ object and the deserialized + ;; request parameters. + (request-handlers (make-hash-table :test 'equal)) + + ;; ‘response-handlers’ is a hash table mapping integral JSON-RPC request + ;; identifiers for pending asynchronous requests to functions handling the + ;; respective responses. Upon receiving a response from the language server, + ;; ‘lsp-mode’ will call the associated response handler function with a + ;; single argument, the deserialized response parameters. + (response-handlers (make-hash-table :test 'eql)) + + ;; ‘prefix-function’ is called for getting the prefix for completion. + ;; The function takes no parameter and returns a cons (start . end) representing + ;; the start and end bounds of the prefix. If it's not set, the client uses a + ;; default prefix function." + (prefix-function nil) + + ;; Contains mapping of scheme to the function that is going to be used to load + ;; the file. + (uri-handlers (make-hash-table :test #'equal)) + + ;; ‘action-handlers’ is a hash table mapping action to a handler function. It + ;; can be used in `lsp-execute-code-action' to determine whether the action + ;; current client is interested in executing the action instead of sending it + ;; to the server. + (action-handlers (make-hash-table :test 'equal)) + + ;; `action-filter' can be set to a function that modifies any incoming + ;; `CodeAction' in place before it is executed. The return value is ignored. + ;; This can be used to patch up broken code action requests before they are + ;; sent back to the LSP server. See `lsp-fix-code-action-booleans' for an + ;; example of a function that can be useful here. + (action-filter nil) + + ;; major modes supported by the client. + major-modes + ;; Function that will be called to decide if this language client + ;; should manage a particular buffer. The function will be passed + ;; the file name and major mode to inform the decision. Setting + ;; `activation-fn' will override `major-modes', if + ;; present. + activation-fn + ;; Break the tie when major-mode is supported by multiple clients. + (priority 0) + ;; Unique identifier for representing the client object. + server-id + ;; defines whether the client supports multi root workspaces. + multi-root + ;; Initialization options or a function that returns initialization options. + initialization-options + ;; `semantic-tokens-faces-overrides’ is a plist that can be used to extend, or + ;; completely replace, the faces used for semantic highlighting on a + ;; client-by-client basis. + ;; + ;; It recognizes four members, all of which are optional: `:types’ and + ;; `:modifiers’, respectively, should be face definition lists akin to + ;; `:lsp-semantic-token-faces’. If specified, each of these face lists will be + ;; merged with the default face definition list. + ;; + ;; Alternatively, if the plist members `:discard-default-types’ or + ;; `:discard-default-modifiers' are non-nil, the default `:type' or `:modifiers' + ;; face definitions will be replaced entirely by their respective overrides. + ;; + ;; For example, setting `:semantic-tokens-faces-overrides' to + ;; `(:types (("macro" . font-lock-keyword-face)))' will remap "macro" tokens from + ;; their default face `lsp-face-semhl-macro' to `font-lock-keyword-face'. + ;; + ;; `(:types (("macro" . font-lock-keyword-face) ("not-quite-a-macro" . some-face)))' + ;; will also remap "macro", but on top of that associate the fictional token type + ;; "not-quite-a-macro" with the face named `some-face'. + ;; + ;; `(:types (("macro" . font-lock-keyword-face)) + ;; :modifiers (("declaration" . lsp-face-semhl-interface)) + ;; :discard-default-types t + ;; :discard-default-modifiers t)' + ;; will discard all default face definitions, hence leaving the client with + ;; only one token type "macro", mapped to `font-lock-keyword-face', and one + ;; modifier type "declaration", mapped to `lsp-face-semhl-interface'. + semantic-tokens-faces-overrides + ;; Provides support for registering LSP Server specific capabilities. + custom-capabilities + ;; Function which returns the folders that are considered to be not projects but library files. + ;; The function accepts one parameter currently active workspace. + ;; See: https://github.com/emacs-lsp/lsp-mode/issues/225. + library-folders-fn + ;; function which will be called when opening file in the workspace to perform + ;; client specific initialization. The function accepts one parameter + ;; currently active workspace. + before-file-open-fn + ;; Function which will be called right after a workspace has been initialized. + initialized-fn + ;; ‘remote?’ indicate whether the client can be used for LSP server over TRAMP. + (remote? nil) + + ;; ‘completion-in-comments?’ t if the client supports completion in comments. + (completion-in-comments? nil) + + ;; ‘path->uri-fn’ the function to use for path->uri conversion for the client. + (path->uri-fn nil) + + ;; ‘uri->path-fn’ the function to use for uri->path conversion for the client. + (uri->path-fn nil) + ;; Function that returns an environment structure that will be used + ;; to set some environment variables when starting the language + ;; server process. These environment variables enable some + ;; additional features in the language server. The environment + ;; structure is an alist of the form (KEY . VALUE), where KEY is a + ;; string (regularly in all caps), and VALUE may be a string, a + ;; boolean, or a sequence of strings. + environment-fn + + ;; ‘after-open-fn’ workspace after open specific hooks. + (after-open-fn nil) + + ;; ‘async-request-handlers’ is a hash table mapping request method names + ;; (strings) to functions handling the respective requests that may take + ;; time to finish. Upon receiving a request, ‘lsp-mode’ will call the + ;; associated handler function passing three arguments, the ‘lsp--workspace’ + ;; object, the deserialized request parameters and the callback which accept + ;; result as its parameter. + (async-request-handlers (make-hash-table :test 'equal)) + download-server-fn + download-in-progress? + buffers + synchronize-sections) + +(defun lsp-clients-executable-find (find-command &rest args) + "Finds an executable by invoking a search command. + +FIND-COMMAND is the executable finder that searches for the +actual language server executable. ARGS is a list of arguments to +give to FIND-COMMAND to find the language server. Returns the +output of FIND-COMMAND if it exits successfully, nil otherwise. + +Typical uses include finding an executable by invoking `find' in +a project, finding LLVM commands on macOS with `xcrun', or +looking up project-specific language servers for projects written +in the various dynamic languages, e.g. `nvm', `pyenv' and `rbenv' +etc." + (when-let* ((find-command-path (executable-find find-command)) + (executable-path + (with-temp-buffer + (when (zerop (apply 'call-process find-command-path nil t nil args)) + (buffer-substring-no-properties (point-min) (point-max)))))) + (string-trim executable-path))) + +(defvar lsp--already-widened nil) + +(defmacro lsp-save-restriction-and-excursion (&rest form) + (declare (indent 0) (debug t)) + `(if lsp--already-widened + (save-excursion ,@form) + (-let [lsp--already-widened t] + (save-restriction + (widen) + (save-excursion ,@form))))) + +;; from http://emacs.stackexchange.com/questions/8082/how-to-get-buffer-position-given-line-number-and-column-number +(defun lsp--line-character-to-point (line character) + "Return the point for character CHARACTER on line LINE." + (or (lsp-virtual-buffer-call :line/character->point line character) + (let ((inhibit-field-text-motion t)) + (lsp-save-restriction-and-excursion + (goto-char (point-min)) + (forward-line line) + ;; server may send character position beyond the current line and we + ;; should fallback to line end. + (-let [line-end (line-end-position)] + (if (> character (- line-end (point))) + line-end + (forward-char character) + (point))))))) + +(lsp-defun lsp--position-to-point ((&Position :line :character)) + "Convert `Position' object in PARAMS to a point." + (lsp--line-character-to-point line character)) + +(lsp-defun lsp--range-to-region ((&RangeToPoint :start :end)) + (cons start end)) + +(lsp-defun lsp--range-text ((&RangeToPoint :start :end)) + (buffer-substring start end)) + +(lsp-defun lsp--find-wrapping-range ((&SelectionRange :parent? :range (&RangeToPoint :start :end))) + (cond + ((and + (region-active-p) + (<= start (region-beginning) end) + (<= start (region-end) end) + (or (not (= start (region-beginning))) + (not (= end (region-end))))) + (cons start end)) + ((and (<= start (point) end) + (not (region-active-p))) + (cons start end)) + (parent? (lsp--find-wrapping-range parent?)))) + +(defun lsp--get-selection-range () + (or + (-when-let ((cache . cache-tick) lsp--document-selection-range-cache) + (when (= cache-tick (buffer-modified-tick)) cache)) + (let ((response (cl-first + (lsp-request + "textDocument/selectionRange" + (list :textDocument (lsp--text-document-identifier) + :positions (vector (lsp--cur-position))))))) + (setq lsp--document-selection-range-cache + (cons response (buffer-modified-tick))) + response))) + +(defun lsp-extend-selection () + "Extend selection." + (interactive) + (unless (lsp-feature? "textDocument/selectionRange") + (signal 'lsp-capability-not-supported (list "selectionRangeProvider"))) + (-when-let ((start . end) (lsp--find-wrapping-range (lsp--get-selection-range))) + (goto-char start) + (set-mark (point)) + (goto-char end) + (exchange-point-and-mark))) + +(defun lsp-warn (message &rest args) + "Display a warning message made from (`format-message' MESSAGE ARGS...). +This is equivalent to `display-warning', using `lsp-mode' as the type and +`:warning' as the level." + (display-warning 'lsp-mode (apply #'format-message message args))) + +(defun lsp--get-uri-handler (scheme) + "Get uri handler for SCHEME in the current workspace." + (--some (gethash scheme (lsp--client-uri-handlers (lsp--workspace-client it))) + (or (lsp-workspaces) (lsp--session-workspaces (lsp-session))))) + +(defun lsp--fix-path-casing (path) + "On windows, downcases path because the windows file system is +case-insensitive. + +On other systems, returns path without change." + (if (eq system-type 'windows-nt) (downcase path) path)) + +(defun lsp--uri-to-path (uri) + "Convert URI to a file path." + (if-let ((fn (->> (lsp-workspaces) + (-keep (-compose #'lsp--client-uri->path-fn #'lsp--workspace-client)) + (cl-first)))) + (funcall fn uri) + (lsp--uri-to-path-1 uri))) + +(defun lsp-remap-path-if-needed (file-name) + (-if-let ((virtual-buffer &as &plist :buffer) (gethash file-name lsp--virtual-buffer-mappings)) + (propertize (buffer-local-value 'buffer-file-name buffer) + 'lsp-virtual-buffer virtual-buffer) + file-name)) + +(defun lsp--uri-to-path-1 (uri) + "Convert URI to a file path." + (let* ((url (url-generic-parse-url (url-unhex-string uri))) + (type (url-type url)) + (target (url-target url)) + (file + (concat (decode-coding-string (url-filename url) + (or locale-coding-system 'utf-8)) + (when (and target + (not (s-match + (rx "#" (group (1+ num)) (or "," "#") + (group (1+ num)) + string-end) + uri))) + (concat "#" target)))) + (file-name (if (and type (not (string= type "file"))) + (if-let ((handler (lsp--get-uri-handler type))) + (funcall handler uri) + uri) + ;; `url-generic-parse-url' is buggy on windows: + ;; https://github.com/emacs-lsp/lsp-mode/pull/265 + (or (and (eq system-type 'windows-nt) + (eq (elt file 0) ?\/) + (substring file 1)) + file)))) + (->> file-name + (concat (-some #'lsp--workspace-host-root (lsp-workspaces))) + (lsp-remap-path-if-needed)))) + +(defun lsp--buffer-uri () + "Return URI of the current buffer." + (or lsp-buffer-uri + (plist-get lsp--virtual-buffer :buffer-uri) + (lsp--path-to-uri + (or (buffer-file-name) (buffer-file-name (buffer-base-buffer)))))) + +(defun lsp-register-client-capabilities (&rest _args) + "Implemented only to make `company-lsp' happy. +DELETE when `lsp-mode.el' is deleted.") + +(defconst lsp--url-path-allowed-chars + (url--allowed-chars (append '(?/) url-unreserved-chars)) + "`url-unreserved-chars' with additional delim ?/. +This set of allowed chars is enough for hexifying local file paths.") + +(defun lsp--path-to-uri-1 (path) + (concat lsp--uri-file-prefix + (--> path + (expand-file-name it) + (or (file-remote-p it 'localname t) it) + (url-hexify-string it lsp--url-path-allowed-chars)))) + +(defun lsp--path-to-uri (path) + "Convert PATH to a uri." + (if-let ((uri-fn (->> (lsp-workspaces) + (-keep (-compose #'lsp--client-path->uri-fn #'lsp--workspace-client)) + (cl-first)))) + (funcall uri-fn path) + (lsp--path-to-uri-1 path))) + +(defun lsp--string-match-any (regex-list str) + "Return the first regex, if any, within REGEX-LIST matching STR." + (--first (string-match it str) regex-list)) + +(cl-defstruct lsp-watch + (descriptors (make-hash-table :test 'equal)) + root-directory) + +(defun lsp--folder-watch-callback (event callback watch ignored-files ignored-directories) + (let ((file-name (cl-third event)) + (event-type (cl-second event))) + (cond + ((and (file-directory-p file-name) + (equal 'created event-type) + (not (lsp--string-match-any ignored-directories file-name))) + + (lsp-watch-root-folder (file-truename file-name) callback ignored-files ignored-directories watch) + + ;; process the files that are already present in + ;; the directory. + (->> (directory-files-recursively file-name ".*" t) + (seq-do (lambda (f) + (unless (file-directory-p f) + (funcall callback (list nil 'created f))))))) + ((and (memq event-type '(created deleted changed)) + (not (file-directory-p file-name)) + (not (lsp--string-match-any ignored-files file-name))) + (funcall callback event)) + ((and (memq event-type '(renamed)) + (not (file-directory-p file-name)) + (not (lsp--string-match-any ignored-files file-name))) + (funcall callback `(,(cl-first event) deleted ,(cl-third event))) + (funcall callback `(,(cl-first event) created ,(cl-fourth event))))))) + +(defun lsp--ask-about-watching-big-repo (number-of-directories dir) + "Ask the user if they want to watch NUMBER-OF-DIRECTORIES from a repository DIR. +This is useful when there is a lot of files in a repository, as +that may slow Emacs down. Returns t if the user wants to watch +the entire repository, nil otherwise." + (prog1 + (yes-or-no-p + (format + "Watching all the files in %s would require adding watches to %s directories, so watching the repo may slow Emacs down. +Do you want to watch all files in %s? " + dir + number-of-directories + dir)) + (lsp--info + (concat "You can configure this warning with the `lsp-enable-file-watchers' " + "and `lsp-file-watch-threshold' variables")))) + + +(defun lsp--path-is-watchable-directory (path dir ignored-directories) + "Figure out whether PATH (inside of DIR) is meant to have a file watcher set. +IGNORED-DIRECTORIES is a list of regexes to filter out directories we don't +want to watch." + (let + ((full-path (f-join dir path))) + (and (file-accessible-directory-p full-path) + (not (equal path ".")) + (not (equal path "..")) + (not (lsp--string-match-any ignored-directories full-path))))) + + +(defun lsp--all-watchable-directories (dir ignored-directories) + "Traverse DIR recursively returning a list of paths that should have watchers. +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 nil + (lsp--ask-about-watching-big-repo number-of-directories dir) + (quit))))) + (dolist (current-dir dirs-to-watch) + (condition-case err + (progn + (puthash + current-dir + (file-notify-add-watch current-dir + '(change) + (lambda (event) + (lsp--folder-watch-callback event callback watch ignored-files ignored-directories))) + (lsp-watch-descriptors watch))) + (error (lsp-log "Failed to create a watch for %s: message" (error-message-string err))) + (file-missing (lsp-log "Failed to create a watch for %s: message" (error-message-string err)))))) + watch)) + +(defun lsp-kill-watch (watch) + "Delete WATCH." + (-> watch lsp-watch-descriptors hash-table-values (-each #'file-notify-rm-watch)) + (ht-clear! (lsp-watch-descriptors watch))) + +(defun lsp-json-bool (val) + "Convert VAL to JSON boolean." + (if val t :json-false)) + +(defmacro with-lsp-workspace (workspace &rest body) + "Helper macro for invoking BODY in WORKSPACE context." + (declare (debug (form body)) + (indent 1)) + `(let ((lsp--cur-workspace ,workspace)) ,@body)) + +(defmacro with-lsp-workspaces (workspaces &rest body) + "Helper macro for invoking BODY against multiple WORKSPACES." + (declare (debug (form body)) + (indent 1)) + `(let ((lsp--buffer-workspaces ,workspaces)) ,@body)) + + + +(defmacro lsp-consistency-check (package) + `(defconst ,(intern (concat (symbol-name package) + "-plist-value-when-compiled")) + (eval-when-compile lsp-use-plists))) + + +;; loading code-workspace files + +;;;###autoload +(defun lsp-load-vscode-workspace (file) + "Load vscode workspace from FILE" + (interactive "fSelect file to import: ") + (mapc #'lsp-workspace-folders-remove (lsp-session-folders (lsp-session))) + + (let ((dir (f-dirname file))) + (->> file + (json-read-file) + (alist-get 'folders) + (-map (-lambda ((&alist 'path)) + (lsp-workspace-folders-add (expand-file-name path dir))))))) + +;;;###autoload +(defun lsp-save-vscode-workspace (file) + "Save vscode workspace to FILE" + (interactive "FSelect file to save to: ") + + (let ((json-encoding-pretty-print t)) + (f-write-text (json-encode + `((folders . ,(->> (lsp-session) + (lsp-session-folders) + (--map `((path . ,it))))))) + 'utf-8 + file))) + + +(defmacro lsp-foreach-workspace (&rest body) + "Execute BODY for each of the current workspaces." + (declare (debug (form body))) + `(--map (with-lsp-workspace it ,@body) (lsp-workspaces))) + +(defmacro when-lsp-workspace (workspace &rest body) + "Helper macro for invoking BODY in WORKSPACE context if present." + (declare (debug (form body)) + (indent 1)) + `(when-let ((lsp--cur-workspace ,workspace)) ,@body)) + +(lsp-defun lsp--window-show-quick-pick (_workspace (&ShowQuickPickParams :place-holder :can-pick-many :items)) + (if-let* ((selectfunc (if can-pick-many #'completing-read-multiple #'completing-read)) + (itemLabels (seq-map (-lambda ((item &as &QuickPickItem :label)) (format "%s" label)) + items)) + (result (funcall-interactively + selectfunc + (format "%s%s " place-holder (if can-pick-many " (* for all)" "")) itemLabels)) + (choices (if (listp result) + (if (equal result '("*")) + itemLabels + result) + (list result)))) + (vconcat (seq-filter #'identity (seq-map (-lambda ((item &as &QuickPickItem :label :user-data)) + (if (member label choices) + (lsp-make-quick-pick-item :label label :picked t :user-data user-data) + nil)) + items))))) + +(lsp-defun lsp--window-show-input-box (_workspace (&ShowInputBoxParams :prompt :value?)) + (read-string (format "%s: " prompt) (or value? ""))) + +(lsp-defun lsp--window-show-message (_workspace (&ShowMessageRequestParams :message :type)) + "Send the server's messages to log. +PARAMS - the data sent from _WORKSPACE." + (funcall (cl-case type + (1 'lsp--error) + (2 'lsp--warn) + (t 'lsp--info)) + "%s" + message)) + +(lsp-defun lsp--window-log-message (workspace (&ShowMessageRequestParams :message :type)) + "Send the server's messages to log. +PARAMS - the data sent from WORKSPACE." + (ignore + (let ((client (lsp--workspace-client workspace))) + (when (or (not client) + (cl-notany (-rpartial #'string-match-p message) + (lsp--client-ignore-messages client))) + (lsp-log "%s" (lsp--propertize message type)))))) + +(lsp-defun lsp--window-log-message-request ((&ShowMessageRequestParams :message :type :actions?)) + "Display a message request to user sending the user selection back to server." + (let* ((message (lsp--propertize message type)) + (choices (seq-map #'lsp:message-action-item-title actions?))) + (if choices + (completing-read (concat message " ") (seq-into choices 'list) nil t) + (lsp-log message)))) + +(lsp-defun lsp--window-show-document ((&ShowDocumentParams :uri :selection?)) + "Show document URI in a buffer and go to SELECTION if any." + (let ((path (lsp--uri-to-path uri))) + (when (f-exists? path) + (with-current-buffer (find-file path) + (when selection? + (goto-char (lsp--position-to-point (lsp:range-start selection?)))) + t)))) + +(defcustom lsp-progress-prefix "⌛ " + "Progress prefix." + :group 'lsp-mode + :type 'string + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-progress-function #'lsp-on-progress-modeline + "Function for handling the progress notifications." + :group 'lsp-mode + :type '(choice + (const :tag "Use modeline" lsp-on-progress-modeline) + (const :tag "Legacy(uses either `progress-reporter' or `spinner' based on `lsp-progress-via-spinner')" + lsp-on-progress-legacy) + (const :tag "Ignore" ignore) + (function :tag "Other function")) + :package-version '(lsp-mode . "8.0.0")) + +(defcustom lsp-request-while-no-input-may-block nil + "Have `lsp-request-while-no-input` block unless `non-essential` is t." + :group 'lsp-mode + :type 'boolean) + +(defun lsp--progress-status () + "Returns the status of the progress for the current workspaces." + (-let ((progress-status + (s-join + "|" + (-keep + (lambda (workspace) + (let ((tokens (lsp--workspace-work-done-tokens workspace))) + (unless (ht-empty? tokens) + (mapconcat + (-lambda ((&WorkDoneProgressBegin :message? :title :percentage?)) + (concat (if percentage? + (if (numberp percentage?) + (format "%.0f%%%% " percentage?) + (format "%s%%%% " percentage?)) + "") + (or message? title))) + (ht-values tokens) + "|")))) + (lsp-workspaces))))) + (unless (s-blank? progress-status) + (concat lsp-progress-prefix progress-status " ")))) + +(lsp-defun lsp-on-progress-modeline (workspace (&ProgressParams :token :value + (value &as &WorkDoneProgress :kind))) + "PARAMS contains the progress data. +WORKSPACE is the workspace that contains the progress token." + (add-to-list 'global-mode-string '(t (:eval (lsp--progress-status)))) + (pcase kind + ("begin" (lsp-workspace-set-work-done-token token value workspace)) + ("report" (lsp-workspace-set-work-done-token token value workspace)) + ("end" (lsp-workspace-rem-work-done-token token workspace))) + (force-mode-line-update)) + +(lsp-defun lsp-on-progress-legacy (workspace (&ProgressParams :token :value + (value &as &WorkDoneProgress :kind))) + "PARAMS contains the progress data. +WORKSPACE is the workspace that contains the progress token." + (pcase kind + ("begin" + (-let* (((&WorkDoneProgressBegin :title :percentage?) value) + (reporter + (if lsp-progress-via-spinner + (let* ((spinner-strings (alist-get (lsp-progress-spinner-type) spinner-types)) + ;; Set message as a tooltip for the spinner strings + (propertized-strings + (seq-map (lambda (string) (propertize string 'help-echo title)) + spinner-strings)) + (spinner-type (vconcat propertized-strings))) + ;; The progress relates to the server as a whole, + ;; display it on all buffers. + (mapcar (lambda (buffer) + (lsp-with-current-buffer buffer + (spinner-start spinner-type)) + buffer) + (lsp--workspace-buffers workspace))) + (if percentage? + (make-progress-reporter title 0 100 percentage?) + ;; No percentage, just progress + (make-progress-reporter title nil nil))))) + (lsp-workspace-set-work-done-token token reporter workspace))) + ("report" + (when-let ((reporter (lsp-workspace-get-work-done-token token workspace))) + (unless lsp-progress-via-spinner + (progress-reporter-update reporter (lsp:work-done-progress-report-percentage? value))))) + + ("end" + (when-let ((reporter (lsp-workspace-get-work-done-token token workspace))) + (if lsp-progress-via-spinner + (mapc (lambda (buffer) + (when (lsp-buffer-live-p buffer) + (lsp-with-current-buffer buffer + (spinner-stop)))) + reporter) + (progress-reporter-done reporter)) + (lsp-workspace-rem-work-done-token token workspace))))) + + +;; diagnostics + +(defvar lsp-diagnostic-filter nil + "A a function which will be called with + `&PublishDiagnosticsParams' and `workspace' which can be used + to filter out the diagnostics. The function should return + `&PublishDiagnosticsParams'. + +Common usecase are: +1. Filter the diagnostics for a particular language server. +2. Filter out the diagnostics under specific level.") + +(defvar lsp-diagnostic-stats (ht)) + +(defun lsp-diagnostics (&optional current-workspace?) + "Return the diagnostics from all workspaces." + (or (pcase (if current-workspace? + (lsp-workspaces) + (lsp--session-workspaces (lsp-session))) + (`() ()) + (`(,workspace) (lsp--workspace-diagnostics workspace)) + (`,workspaces (let ((result (make-hash-table :test 'equal))) + (mapc (lambda (workspace) + (->> workspace + (lsp--workspace-diagnostics) + (maphash (lambda (file-name diagnostics) + (puthash file-name + (append (gethash file-name result) diagnostics) + result))))) + workspaces) + result))) + (ht))) + +(defun lsp-diagnostics-stats-for (path) + "Get diagnostics statistics for PATH. +The result format is vector [_ errors warnings infos hints] or nil." + (gethash (lsp--fix-path-casing path) lsp-diagnostic-stats)) + +(defun lsp-diagnostics--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 () + (when (and lsp-enable-folding + (lsp-feature? "textDocument/foldingRange")) + (if-let ((range (lsp--get-current-innermost-folding-range))) + (cons (lsp--folding-range-beg range) + (lsp--folding-range-end range))))) +(put 'lsp--folding-range 'bounds-of-thing-at-point + #'lsp--folding-range-at-point-bounds) + +(defun lsp--get-nearest-folding-range (&optional backward) + (let ((point (point)) + (found nil)) + (while (not + (or found + (if backward + (<= point (point-min)) + (>= point (point-max))))) + (if backward (cl-decf point) (cl-incf point)) + (setq found (lsp--get-current-innermost-folding-range point))) + found)) + +(defun lsp--folding-range-at-point-forward-op (n) + (when (and lsp-enable-folding + (not (zerop n)) + (lsp-feature? "textDocument/foldingRange")) + (cl-block break + (dotimes (_ (abs n)) + (if-let ((range (lsp--get-nearest-folding-range (< n 0)))) + (goto-char (if (< n 0) + (lsp--folding-range-beg range) + (lsp--folding-range-end range))) + (cl-return-from break)))))) +(put 'lsp--folding-range 'forward-op + #'lsp--folding-range-at-point-forward-op) + +(defun lsp--folding-range-at-point-beginning-op () + (goto-char (car (lsp--folding-range-at-point-bounds)))) +(put 'lsp--folding-range 'beginning-op + #'lsp--folding-range-at-point-beginning-op) + +(defun lsp--folding-range-at-point-end-op () + (goto-char (cdr (lsp--folding-range-at-point-bounds)))) +(put 'lsp--folding-range 'end-op + #'lsp--folding-range-at-point-end-op) + +(defun lsp--range-at-point-bounds () + (or (lsp--folding-range-at-point-bounds) + (when-let ((range (and + (lsp-feature? "textDocument/hover") + (->> (lsp--text-document-position-params) + (lsp-request "textDocument/hover") + (lsp:hover-range?))))) + (lsp--range-to-region range)))) + +;; A more general purpose "thing", useful for applications like focus.el +(put 'lsp--range 'bounds-of-thing-at-point + #'lsp--range-at-point-bounds) + +(defun lsp--log-io-p (method) + "Return non nil if should log for METHOD." + (and lsp-log-io + (or (not lsp-log-io-allowlist-methods) + (member method lsp-log-io-allowlist-methods)))) + + +;; toggles + +(defun lsp-toggle-trace-io () + "Toggle client-server protocol logging." + (interactive) + (setq lsp-log-io (not lsp-log-io)) + (lsp--info "Server logging %s." (if lsp-log-io "enabled" "disabled"))) + +(defun lsp-toggle-signature-auto-activate () + "Toggle signature auto activate." + (interactive) + (setq lsp-signature-auto-activate + (unless lsp-signature-auto-activate '(:on-trigger-char))) + (lsp--info "Signature autoactivate %s." (if lsp-signature-auto-activate "enabled" "disabled")) + (lsp--update-signature-help-hook)) + +(defun lsp-toggle-on-type-formatting () + "Toggle on type formatting." + (interactive) + (setq lsp-enable-on-type-formatting (not lsp-enable-on-type-formatting)) + (lsp--info "On type formatting is %s." (if lsp-enable-on-type-formatting "enabled" "disabled")) + (lsp--update-on-type-formatting-hook)) + +(defun lsp-toggle-symbol-highlight () + "Toggle symbol highlighting." + (interactive) + (setq lsp-enable-symbol-highlighting (not lsp-enable-symbol-highlighting)) + + (cond + ((and lsp-enable-symbol-highlighting + (lsp-feature? "textDocument/documentHighlight")) + (add-hook 'lsp-on-idle-hook #'lsp--document-highlight nil t) + (lsp--info "Symbol highlighting enabled in current buffer.")) + ((not lsp-enable-symbol-highlighting) + (remove-hook 'lsp-on-idle-hook #'lsp--document-highlight t) + (lsp--remove-overlays 'lsp-highlight) + (lsp--info "Symbol highlighting disabled in current buffer.")))) + + +;; keybindings +(defvar lsp--binding-descriptions nil + "List of key binding/short description pair.") + +(defmacro lsp-define-conditional-key (keymap key def desc cond &rest bindings) + "In KEYMAP, define key sequence KEY as DEF conditionally. +This is like `define-key', except the definition disappears +whenever COND evaluates to nil. +DESC is the short-description for the binding. +BINDINGS is a list of (key def desc cond)." + (declare (indent defun) + (debug (form form form form form &rest sexp))) + (->> (cl-list* key def desc cond bindings) + (-partition 4) + (-mapcat (-lambda ((key def desc cond)) + `((define-key ,keymap ,key + '(menu-item + ,(format "maybe-%s" def) + ,def + :filter + (lambda (item) + (when (with-current-buffer (or (when (buffer-live-p lsp--describe-buffer) + lsp--describe-buffer) + (current-buffer)) + ,cond) + item)))) + (when (stringp ,key) + (setq lsp--binding-descriptions + (append lsp--binding-descriptions '(,key ,desc))))))) + macroexp-progn)) + +(defvar lsp--describe-buffer nil) + +(defun lsp-describe-buffer-bindings-advice (fn buffer &optional prefix menus) + (let ((lsp--describe-buffer buffer)) + (funcall fn buffer prefix menus))) + +(advice-add 'describe-buffer-bindings + :around + #'lsp-describe-buffer-bindings-advice) + +(defun lsp--prepend-prefix (mappings) + (->> mappings + (-partition 2) + (-mapcat (-lambda ((key description)) + (list (concat lsp-keymap-prefix " " key) + description))))) + +(defvar lsp-command-map + (-doto (make-sparse-keymap) + (lsp-define-conditional-key + ;; workspaces + "wD" lsp-disconnect "disconnect" (lsp-workspaces) + "wd" lsp-describe-session "describe session" t + "wq" lsp-workspace-shutdown "shutdown server" (lsp-workspaces) + "wr" lsp-workspace-restart "restart server" (lsp-workspaces) + "ws" lsp "start server" t + + ;; formatting + "==" lsp-format-buffer "format buffer" (or (lsp-feature? "textDocument/rangeFormatting") + (lsp-feature? "textDocument/formatting")) + "=r" lsp-format-region "format region" (lsp-feature? "textDocument/rangeFormatting") + + ;; folders + "Fa" lsp-workspace-folders-add "add folder" t + "Fb" lsp-workspace-blocklist-remove "un-blocklist folder" t + "Fr" lsp-workspace-folders-remove "remove folder" t + + ;; toggles + "TD" lsp-modeline-diagnostics-mode "toggle modeline diagnostics" (lsp-feature? + "textDocument/publishDiagnostics") + "TL" lsp-toggle-trace-io "toggle log io" t + "TS" lsp-ui-sideline-mode "toggle sideline" (featurep 'lsp-ui-sideline) + "TT" lsp-treemacs-sync-mode "toggle treemacs integration" (featurep 'lsp-treemacs) + "Ta" lsp-modeline-code-actions-mode "toggle modeline code actions" (lsp-feature? + "textDocument/codeAction") + "Tb" lsp-headerline-breadcrumb-mode "toggle breadcrumb" (lsp-feature? + "textDocument/documentSymbol") + "Td" lsp-ui-doc-mode "toggle documentation popup" (featurep 'lsp-ui-doc) + "Tf" lsp-toggle-on-type-formatting "toggle on type formatting" (lsp-feature? + "textDocument/onTypeFormatting") + "Th" lsp-toggle-symbol-highlight "toggle highlighting" (lsp-feature? "textDocument/documentHighlight") + "Tl" lsp-lens-mode "toggle lenses" (lsp-feature? "textDocument/codeLens") + "Ts" lsp-toggle-signature-auto-activate "toggle signature" (lsp-feature? "textDocument/signatureHelp") + + ;; goto + "ga" xref-find-apropos "find symbol in workspace" (lsp-feature? "workspace/symbol") + "gd" lsp-find-declaration "find declarations" (lsp-feature? "textDocument/declaration") + "ge" lsp-treemacs-errors-list "show errors" (fboundp 'lsp-treemacs-errors-list) + "gg" lsp-find-definition "find definitions" (lsp-feature? "textDocument/definition") + "gh" lsp-treemacs-call-hierarchy "call hierarchy" (and (lsp-feature? "callHierarchy/incomingCalls") + (fboundp 'lsp-treemacs-call-hierarchy)) + "gi" lsp-find-implementation "find implementations" (lsp-feature? "textDocument/implementation") + "gr" lsp-find-references "find references" (lsp-feature? "textDocument/references") + "gt" lsp-find-type-definition "find type definition" (lsp-feature? "textDocument/typeDefinition") + + ;; help + "hg" lsp-ui-doc-glance "glance symbol" (and (featurep 'lsp-ui-doc) + (lsp-feature? "textDocument/hover")) + "hh" lsp-describe-thing-at-point "describe symbol at point" (lsp-feature? "textDocument/hover") + "hs" lsp-signature-activate "signature help" (lsp-feature? "textDocument/signatureHelp") + + ;; refactoring + "ro" lsp-organize-imports "organize imports" (lsp-feature? "textDocument/codeAction") + "rr" lsp-rename "rename" (lsp-feature? "textDocument/rename") + + ;; actions + "aa" lsp-execute-code-action "code actions" (lsp-feature? "textDocument/codeAction") + "ah" lsp-document-highlight "highlight symbol" (lsp-feature? "textDocument/documentHighlight") + "al" lsp-avy-lens "lens" (and (bound-and-true-p lsp-lens-mode) (featurep 'avy)) + + ;; peeks + "Gg" lsp-ui-peek-find-definitions "peek definitions" (and (lsp-feature? "textDocument/definition") + (fboundp 'lsp-ui-peek-find-definitions)) + "Gi" lsp-ui-peek-find-implementation "peek implementations" (and + (fboundp 'lsp-ui-peek-find-implementation) + (lsp-feature? "textDocument/implementation")) + "Gr" lsp-ui-peek-find-references "peek references" (and (fboundp 'lsp-ui-peek-find-references) + (lsp-feature? "textDocument/references")) + "Gs" lsp-ui-peek-find-workspace-symbol "peek workspace symbol" (and (fboundp + 'lsp-ui-peek-find-workspace-symbol) + (lsp-feature? "workspace/symbol"))))) + + +;; which-key integration + +(declare-function which-key-add-major-mode-key-based-replacements "ext:which-key") +(declare-function which-key-add-key-based-replacements "ext:which-key") + +(defun lsp-enable-which-key-integration (&optional all-modes) + "Adds descriptions for `lsp-mode-map' to `which-key-mode' for the current +active `major-mode', or for all major modes when ALL-MODES is t." + (cl-flet ((which-key-fn (if all-modes + 'which-key-add-key-based-replacements + (apply-partially 'which-key-add-major-mode-key-based-replacements major-mode)))) + (apply + #'which-key-fn + (lsp--prepend-prefix + (cl-list* + "" "lsp" + "w" "workspaces" + "F" "folders" + "=" "formatting" + "T" "toggle" + "g" "goto" + "h" "help" + "r" "refactor" + "a" "code actions" + "G" "peek" + lsp--binding-descriptions))))) + + +;; Globbing syntax + +;; We port VSCode's glob-to-regexp code +;; (https://github.com/Microsoft/vscode/blob/466da1c9013c624140f6d1473b23a870abc82d44/src/vs/base/common/glob.ts) +;; since the LSP globbing syntax seems to be the same as that of +;; VSCode. + +(defconst lsp-globstar "**" + "Globstar pattern.") + +(defconst lsp-glob-split ?/ + "The character by which we split path components in a glob +pattern.") + +(defconst lsp-path-regexp "[/\\\\]" + "Forward or backslash to be used as a path separator in +computed regexps.") + +(defconst lsp-non-path-regexp "[^/\\\\]" + "A regexp matching anything other than a slash.") + +(defconst lsp-globstar-regexp + (format "\\(?:%s\\|%s+%s\\|%s%s+\\)*?" + lsp-path-regexp + lsp-non-path-regexp lsp-path-regexp + lsp-path-regexp lsp-non-path-regexp) + "Globstar in regexp form.") + +(defun lsp-split-glob-pattern (pattern split-char) + "Split PATTERN at SPLIT-CHAR while respecting braces and brackets." + (when pattern + (let ((segments nil) + (in-braces nil) + (in-brackets nil) + (current-segment "")) + (dolist (char (string-to-list pattern)) + (cl-block 'exit-point + (if (eq char split-char) + (when (and (null in-braces) + (null in-brackets)) + (push current-segment segments) + (setq current-segment "") + (cl-return-from 'exit-point)) + (pcase char + (?{ + (setq in-braces t)) + (?} + (setq in-braces nil)) + (?\[ + (setq in-brackets t)) + (?\] + (setq in-brackets nil)))) + (setq current-segment (concat current-segment + (char-to-string char))))) + (unless (string-empty-p current-segment) + (push current-segment segments)) + (nreverse segments)))) + +(defun lsp--glob-to-regexp (pattern) + "Helper function to convert a PATTERN from LSP's glob syntax to +an Elisp regexp." + (if (string-empty-p pattern) + "" + (let ((current-regexp "") + (glob-segments (lsp-split-glob-pattern pattern lsp-glob-split))) + (if (-all? (lambda (segment) (eq segment lsp-globstar)) + glob-segments) + ".*" + (let ((prev-segment-was-globstar nil)) + (seq-do-indexed + (lambda (segment index) + (if (string-equal segment lsp-globstar) + (unless prev-segment-was-globstar + (setq current-regexp (concat current-regexp + lsp-globstar-regexp)) + (setq prev-segment-was-globstar t)) + (let ((in-braces nil) + (brace-val "") + (in-brackets nil) + (bracket-val "")) + (dolist (char (string-to-list segment)) + (cond + ((and (not (char-equal char ?\})) + in-braces) + (setq brace-val (concat brace-val + (char-to-string char)))) + ((and in-brackets + (or (not (char-equal char ?\])) + (string-empty-p bracket-val))) + (let ((curr (cond + ((char-equal char ?-) + "-") + ;; NOTE: ?\^ and ?^ are different characters + ((and (memq char '(?^ ?!)) + (string-empty-p bracket-val)) + "^") + ((char-equal char lsp-glob-split) + "") + (t + (regexp-quote (char-to-string char)))))) + (setq bracket-val (concat bracket-val curr)))) + (t + (cl-case char + (?{ + (setq in-braces t)) + (?\[ + (setq in-brackets t)) + (?} + (let* ((choices (lsp-split-glob-pattern brace-val ?\,)) + (brace-regexp (concat "\\(?:" + (mapconcat #'lsp--glob-to-regexp choices "\\|") + "\\)"))) + (setq current-regexp (concat current-regexp + brace-regexp)) + (setq in-braces nil) + (setq brace-val ""))) + (?\] + (setq current-regexp + (concat current-regexp + "[" bracket-val "]")) + (setq in-brackets nil) + (setq bracket-val "")) + (?? + (setq current-regexp + (concat current-regexp + lsp-non-path-regexp))) + (?* + (setq current-regexp + (concat current-regexp + lsp-non-path-regexp "*?"))) + (t + (setq current-regexp + (concat current-regexp + (regexp-quote (char-to-string char))))))))) + (when (and (< index (1- (length glob-segments))) + (or (not (string-equal (nth (1+ index) glob-segments) + lsp-globstar)) + (< (+ index 2) + (length glob-segments)))) + (setq current-regexp + (concat current-regexp + lsp-path-regexp))) + (setq prev-segment-was-globstar nil)))) + glob-segments) + current-regexp))))) + +;; See https://github.com/emacs-lsp/lsp-mode/issues/2365 +(defun lsp-glob-unbrace-at-top-level (glob-pattern) + "If GLOB-PATTERN does not start with a brace, return a singleton list +containing GLOB-PATTERN. + +If GLOB-PATTERN does start with a brace, return a list of the +comma-separated globs within the top-level braces." + (if (not (string-prefix-p "{" glob-pattern)) + (list glob-pattern) + (lsp-split-glob-pattern (substring glob-pattern 1 -1) ?\,))) + +(defun lsp-glob-convert-to-wrapped-regexp (glob-pattern) + "Convert GLOB-PATTERN to a regexp wrapped with the beginning- +and end-of-string meta-characters." + (concat "\\`" (lsp--glob-to-regexp (string-trim glob-pattern)) "\\'")) + +(defun lsp-glob-to-regexps (glob-pattern) + "Convert a GLOB-PATTERN to a list of Elisp regexps." + (when-let* + ((glob-pattern (cond ((hash-table-p glob-pattern) + (ht-get glob-pattern "pattern")) + ((stringp glob-pattern) glob-pattern) + (t (error "Unknown glob-pattern type: %s" glob-pattern)))) + (trimmed-pattern (string-trim glob-pattern)) + (top-level-unbraced-patterns (lsp-glob-unbrace-at-top-level trimmed-pattern))) + (seq-map #'lsp-glob-convert-to-wrapped-regexp + top-level-unbraced-patterns))) + + + +(defvar lsp-mode-menu) + +(defun lsp-mouse-click (event) + (interactive "e") + (let* ((ec (event-start event)) + (choice (x-popup-menu event lsp-mode-menu)) + (action (lookup-key lsp-mode-menu (apply 'vector choice)))) + + (select-window (posn-window ec)) + + (unless (and (region-active-p) (eq action 'lsp-execute-code-action)) + (goto-char (posn-point ec))) + (run-with-idle-timer + 0.001 nil + (lambda () + (cl-labels ((check (value) (not (null value)))) + (when choice + (call-interactively action))))))) + +(defvar lsp-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-<down-mouse-1>") #'lsp-find-definition-mouse) + (define-key map (kbd "C-<mouse-1>") #'ignore) + (define-key map (kbd "<mouse-3>") #'lsp-mouse-click) + (define-key map (kbd "C-S-SPC") #'lsp-signature-activate) + (when lsp-keymap-prefix + (define-key map (kbd lsp-keymap-prefix) lsp-command-map)) + map) + "Keymap for `lsp-mode'.") + +(define-minor-mode lsp-mode "Mode for LSP interaction." + :keymap lsp-mode-map + :lighter + (" LSP[" + (lsp--buffer-workspaces + (:eval (mapconcat #'lsp--workspace-print lsp--buffer-workspaces "][")) + (:propertize "Disconnected" face warning)) + "]") + :group 'lsp-mode + (when (and lsp-mode (not lsp--buffer-workspaces) (not lsp--buffer-deferred)) + ;; fire up `lsp' when someone calls `lsp-mode' instead of `lsp' + (lsp))) + +(defvar lsp-mode-menu + (easy-menu-create-menu + nil + `(["Go to definition" lsp-find-definition + :active (lsp-feature? "textDocument/definition")] + ["Find references" lsp-find-references + :active (lsp-feature? "textDocument/references")] + ["Find implementations" lsp-find-implementation + :active (lsp-feature? "textDocument/implementation")] + ["Find declarations" lsp-find-declaration + :active (lsp-feature? "textDocument/declaration")] + ["Go to type declaration" lsp-find-type-definition + :active (lsp-feature? "textDocument/typeDefinition")] + "--" + ["Describe" lsp-describe-thing-at-point] + ["Code action" lsp-execute-code-action] + ["Format" lsp-format-buffer] + ["Highlight references" lsp-document-highlight] + ["Type Hierarchy" lsp-java-type-hierarchy + :visible (lsp-can-execute-command? "java.navigate.resolveTypeHierarchy")] + ["Type Hierarchy" lsp-treemacs-type-hierarchy + :visible (and (not (lsp-can-execute-command? "java.navigate.resolveTypeHierarchy")) + (functionp 'lsp-treemacs-type-hierarchy) + (lsp-feature? "textDocument/typeHierarchy"))] + ["Call Hierarchy" lsp-treemacs-call-hierarchy + :visible (and (functionp 'lsp-treemacs-call-hierarchy) + (lsp-feature? "textDocument/callHierarchy"))] + ["Rename" lsp-rename + :active (lsp-feature? "textDocument/rename")] + "--" + ("Session" + ["View logs" lsp-workspace-show-log] + ["Describe" lsp-describe-session] + ["Shutdown" lsp-shutdown-workspace] + ["Restart" lsp-restart-workspace]) + ("Workspace Folders" + ["Add" lsp-workspace-folders-add] + ["Remove" lsp-workspace-folders-remove] + ["Open" lsp-workspace-folders-open]) + ("Toggle features" + ["Lenses" lsp-lens-mode] + ["Headerline breadcrumb" lsp-headerline-breadcrumb-mode] + ["Modeline code actions" lsp-modeline-code-actions-mode] + ["Modeline diagnostics" lsp-modeline-diagnostics-mode]) + "---" + ("Debug" + :active (bound-and-true-p dap-ui-mode) + :filter ,(lambda (_) + (and (boundp 'dap-ui-menu-items) + (nthcdr 3 dap-ui-menu-items)))))) + "Menu for lsp-mode.") + +(defalias 'make-lsp-client 'make-lsp--client) + +(cl-defstruct lsp--registered-capability + (id "") + (method " ") + (options nil)) + +;; A ‘lsp--workspace’ object represents exactly one language server process. +(cl-defstruct lsp--workspace + ;; the `ewoc' object for displaying I/O to and from the server + (ewoc nil) + + ;; ‘server-capabilities’ is a hash table of the language server capabilities. + ;; It is the hash table representation of a LSP ServerCapabilities structure; + ;; cf. https://microsoft.github.io/language-server-protocol/specification#initialize. + (server-capabilities nil) + + ;; ‘registered-server-capabilities’ is a list of hash tables that represent + ;; dynamically-registered Registration objects. See + ;; https://microsoft.github.io/language-server-protocol/specification#client_registerCapability. + (registered-server-capabilities nil) + + ;; ‘root’ is a directory name or a directory file name for the workspace + ;; root. ‘lsp-mode’ passes this directory to the ‘initialize’ method of the + ;; language server; see + ;; https://microsoft.github.io/language-server-protocol/specification#initialize. + (root nil) + + ;; ‘client’ is the ‘lsp--client’ object associated with this workspace. + (client nil) + + ;; ‘host-root’ contains the host root info as derived from `file-remote-p'. It + ;; used to derive the file path in `lsp--uri-to-path' when using tramp + ;; connection. + (host-root nil) + + ;; ‘proc’ is a process object; it may represent a regular process, a pipe, or + ;; a network connection. ‘lsp-mode’ communicates with ‘proc’ using the + ;; language server protocol. ‘proc’ corresponds to the COMMUNICATION-PROCESS + ;; element of the return value of the client’s ‘get-root’ field, which see. + (proc nil) + + ;; ‘proc’ is a process object; it must represent a regular process, not a + ;; pipe or network process. It represents the actual server process that + ;; corresponds to this workspace. ‘cmd-proc’ corresponds to the + ;; COMMAND-PROCESS element of the return value of the client’s ‘get-root’ + ;; field, which see. + (cmd-proc nil) + + ;; ‘buffers’ is a list of buffers associated with this workspace. + (buffers nil) + + ;; if semantic tokens is enabled, `semantic-tokens-faces' contains + ;; one face (or nil) for each token type supported by the language server. + (semantic-tokens-faces nil) + + ;; If semantic highlighting is enabled, `semantic-tokens-modifier-faces' + ;; contains one face (or nil) for each modifier type supported by the language + ;; server + (semantic-tokens-modifier-faces nil) + + ;; Extra client capabilities provided by third-party packages using + ;; `lsp-register-client-capabilities'. It's value is an alist of (PACKAGE-NAME + ;; . CAPS), where PACKAGE-NAME is a symbol of the third-party package name, + ;; and CAPS is either a plist of the client capabilities, or a function that + ;; takes no argument and returns a plist of the client capabilities or nil. + (extra-client-capabilities nil) + + ;; Workspace status + (status nil) + + ;; ‘metadata’ is a generic storage for workspace specific data. It is + ;; accessed via `lsp-workspace-set-metadata' and `lsp-workspace-set-metadata' + (metadata (make-hash-table :test 'equal)) + + ;; contains all the file notification watches that have been created for the + ;; current workspace in format filePath->file notification handle. + (watches (make-hash-table :test 'equal)) + + ;; list of workspace folders + (workspace-folders nil) + + ;; ‘last-id’ the last request id for the current workspace. + (last-id 0) + + ;; ‘status-string’ allows extensions to specify custom status string based on + ;; the Language Server specific messages. + (status-string nil) + + ;; ‘shutdown-action’ flag used to mark that workspace should not be restarted (e.g. it + ;; was stopped). + shutdown-action + + ;; ‘diagnostics’ a hashmap with workspace diagnostics. + (diagnostics (make-hash-table :test 'equal)) + + ;; contains all the workDone progress tokens that have been created + ;; for the current workspace. + (work-done-tokens (make-hash-table :test 'equal))) + + +(cl-defstruct lsp-session + ;; contains the folders that are part of the current session + folders + ;; contains the folders that must not be imported in the current workspace. + folders-blocklist + ;; contains the list of folders that must be imported in a project in case of + ;; multi root LSP server. + (server-id->folders (make-hash-table :test 'equal)) + ;; folder to list of the servers that are associated with the folder. + (folder->servers (make-hash-table :test 'equal)) + ;; ‘metadata’ is a generic storage for workspace specific data. It is + ;; accessed via `lsp-workspace-set-metadata' and `lsp-workspace-set-metadata' + (metadata (make-hash-table :test 'equal))) + +(defun lsp-workspace-status (status-string &optional workspace) + "Set current workspace status to STATUS-STRING. +If WORKSPACE is not specified defaults to lsp--cur-workspace." + (let ((status-string (when status-string (replace-regexp-in-string "%" "%%" status-string)))) + (setf (lsp--workspace-status-string (or workspace lsp--cur-workspace)) status-string))) + +(defun lsp-session-set-metadata (key value &optional _workspace) + "Associate KEY with VALUE in the WORKSPACE metadata. +If WORKSPACE is not provided current workspace will be used." + (puthash key value (lsp-session-metadata (lsp-session)))) + +(defalias 'lsp-workspace-set-metadata 'lsp-session-set-metadata) + +(defun lsp-session-get-metadata (key &optional _workspace) + "Lookup KEY in WORKSPACE metadata. +If WORKSPACE is not provided current workspace will be used." + (gethash key (lsp-session-metadata (lsp-session)))) + +(defalias 'lsp-workspace-get-metadata 'lsp-session-get-metadata) + +(defun lsp-workspace-set-work-done-token (token value workspace) + "Associate TOKEN with VALUE in the WORKSPACE work-done-tokens." + (puthash token value (lsp--workspace-work-done-tokens workspace))) + +(defun lsp-workspace-get-work-done-token (token workspace) + "Lookup TOKEN in the WORKSPACE work-done-tokens." + (gethash token (lsp--workspace-work-done-tokens workspace))) + +(defun lsp-workspace-rem-work-done-token (token workspace) + "Remove TOKEN from the WORKSPACE work-done-tokens." + (remhash token (lsp--workspace-work-done-tokens workspace))) + + +(defun lsp--make-notification (method &optional params) + "Create notification body for method METHOD and parameters PARAMS." + (list :jsonrpc "2.0" :method method :params params)) + +(defalias 'lsp--make-request 'lsp--make-notification) +(defalias 'lsp-make-request 'lsp--make-notification) + +(defun lsp--make-response (id result) + "Create response for REQUEST with RESULT." + `(:jsonrpc "2.0" :id ,id :result ,result)) + +(defun lsp-make-notification (method &optional params) + "Create notification body for method METHOD and parameters PARAMS." + (lsp--make-notification method params)) + +(defmacro lsp--json-serialize (params) + (if (progn + (require 'json) + (fboundp 'json-serialize)) + `(json-serialize ,params + :null-object nil + :false-object :json-false) + `(let ((json-false :json-false)) + (json-encode ,params)))) + +(defun lsp--make-message (params) + "Create a LSP message from PARAMS, after encoding it to a JSON string." + (let ((body (lsp--json-serialize params))) + (concat "Content-Length: " + (number-to-string (1+ (string-bytes body))) + "\r\n\r\n" + body + "\n"))) + +(cl-defstruct lsp--log-entry timestamp process-time type method id body) + +(defun lsp--make-log-entry (method id body type &optional process-time) + "Create an outgoing log object from BODY with method METHOD and id ID. +If ID is non-nil, then the body is assumed to be a notification. +TYPE can either be `incoming' or `outgoing'" + (cl-assert (memq type '(incoming-req outgoing-req incoming-notif + outgoing-notif incoming-resp + outgoing-resp))) + (make-lsp--log-entry + :timestamp (format-time-string "%I:%M:%S %p") + :process-time process-time + :method method + :id id + :type type + :body body)) + +(defun lsp--log-font-lock-json (body) + "Font lock JSON BODY." + (with-temp-buffer + (insert body) + ;; We set the temp buffer file-name extension to .json and call `set-auto-mode' + ;; so the users configured json mode is used which could be + ;; `json-mode', `json-ts-mode', `jsonian-mode', etc. + (let ((buffer-file-name "lsp-log.json")) + (delay-mode-hooks + (set-auto-mode) + (if (fboundp 'font-lock-ensure) + (font-lock-ensure) + (with-no-warnings + (font-lock-fontify-buffer))))) + (buffer-string))) + +(defun lsp--log-entry-pp (entry) + (cl-assert (lsp--log-entry-p entry)) + (pcase-let (((cl-struct lsp--log-entry timestamp method id type process-time + body) + entry) + (json-false :json-false) + (json-encoding-pretty-print t) + (str nil)) + (setq str + (concat (format "[Trace - %s] " timestamp) + (pcase type + ('incoming-req (format "Received request '%s - (%s)." method id)) + ('outgoing-req (format "Sending request '%s - (%s)'." method id)) + + ('incoming-notif (format "Received notification '%s'." method)) + ('outgoing-notif (format "Sending notification '%s'." method)) + + ('incoming-resp (format "Received response '%s - (%s)' in %dms." + method id process-time)) + ('outgoing-resp + (format + "Sending response '%s - (%s)'. Processing request took %dms" + method id process-time))) + "\n" + (if (memq type '(incoming-resp ougoing-resp)) + "Result: " + "Params: ") + (lsp--log-font-lock-json (json-encode body)) + "\n\n\n")) + (setq str (propertize str 'mouse-face 'highlight 'read-only t)) + (insert str))) + +(defvar-local lsp--log-io-ewoc nil) + +(defun lsp--get-create-io-ewoc (workspace) + (if (and (lsp--workspace-ewoc workspace) + (buffer-live-p (ewoc-buffer (lsp--workspace-ewoc workspace)))) + (lsp--workspace-ewoc workspace) + (with-current-buffer (lsp--get-log-buffer-create workspace) + (unless (eq 'lsp-log-io-mode major-mode) (lsp-log-io-mode)) + (setq-local window-point-insertion-type t) + (setq lsp--log-io-ewoc (ewoc-create #'lsp--log-entry-pp nil nil t)) + (setf (lsp--workspace-ewoc workspace) lsp--log-io-ewoc)) + (lsp--workspace-ewoc workspace))) + +(defun lsp--ewoc-count (ewoc) + (let* ((count 0) + (count-fn (lambda (_) (setq count (1+ count))))) + (ewoc-map count-fn ewoc) + count)) + +(defun lsp--log-entry-new (entry workspace) + (let* ((ewoc (lsp--get-create-io-ewoc workspace)) + (count (and (not (eq lsp-io-messages-max t)) (lsp--ewoc-count ewoc))) + (node (if (or (eq lsp-io-messages-max t) + (>= lsp-io-messages-max count)) + nil + (ewoc-nth ewoc (1- lsp-io-messages-max)))) + (prev nil) + (inhibit-read-only t)) + (while node + (setq prev (ewoc-prev ewoc node)) + (ewoc-delete ewoc node) + (setq node prev)) + (ewoc-enter-last ewoc entry))) + +(defun lsp--send-notification (body) + "Send BODY as a notification to the language server." + (lsp-foreach-workspace + (when (lsp--log-io-p (plist-get body :method)) + (lsp--log-entry-new (lsp--make-log-entry + (plist-get body :method) + nil (plist-get body :params) 'outgoing-notif) + lsp--cur-workspace)) + (lsp--send-no-wait body + (lsp--workspace-proc lsp--cur-workspace)))) + +(defalias 'lsp-send-notification 'lsp--send-notification) + +(defun lsp-notify (method params) + "Send notification METHOD with PARAMS." + (lsp--send-notification (lsp--make-notification method params))) + +(defun lsp--cur-workspace-check () + "Check whether buffer lsp workspace(s) are set." + (cl-assert (lsp-workspaces) nil + "No language server(s) is associated with this buffer.")) + +(defun lsp--send-request (body &optional no-wait no-merge) + "Send BODY as a request to the language server, get the response. +If NO-WAIT is non-nil, don't synchronously wait for a response. +If NO-MERGE is non-nil, don't merge the results but return an +alist mapping workspace->result." + (lsp-request (plist-get body :method) + (plist-get body :params) + :no-wait no-wait + :no-merge no-merge)) + +(defalias 'lsp-send-request 'lsp--send-request + "Send BODY as a request to the language server and return the response +synchronously. +\n(fn BODY)") + +(cl-defun lsp-request (method params &key no-wait no-merge) + "Send request METHOD with PARAMS. +If NO-MERGE is non-nil, don't merge the results but return alist +workspace->result. +If NO-WAIT is non-nil send the request as notification." + (if no-wait + (lsp-notify method params) + (let* ((send-time (float-time)) + ;; max time by which we must get a response + (expected-time + (and + lsp-response-timeout + (+ send-time lsp-response-timeout))) + resp-result resp-error done?) + (unwind-protect + (progn + (lsp-request-async method params + (lambda (res) (setf resp-result (or res :finished)) (throw 'lsp-done '_)) + :error-handler (lambda (err) (setf resp-error err) (throw 'lsp-done '_)) + :no-merge no-merge + :mode 'detached + :cancel-token :sync-request) + (while (not (or resp-error resp-result)) + (if (functionp 'json-rpc-connection) + (catch 'lsp-done (sit-for 0.01)) + (catch 'lsp-done + (accept-process-output + nil + (if expected-time (- expected-time send-time) 1)))) + (setq send-time (float-time)) + (when (and expected-time (< expected-time send-time)) + (error "Timeout while waiting for response. Method: %s" method))) + (setq done? t) + (cond + ((eq resp-result :finished) nil) + (resp-result resp-result) + ((lsp-json-error? resp-error) (error (lsp:json-error-message resp-error))) + ((lsp-json-error? (cl-first resp-error)) + (error (lsp:json-error-message (cl-first resp-error)))))) + (unless done? + (lsp-cancel-request-by-token :sync-request)))))) + +(cl-defun lsp-request-while-no-input (method params) + "Send request METHOD with PARAMS and waits until there is no input. +Return same value as `lsp--while-no-input' and respecting `non-essential'." + (if (or non-essential (not lsp-request-while-no-input-may-block)) + (let* ((send-time (float-time)) + ;; max time by which we must get a response + (expected-time + (and + lsp-response-timeout + (+ send-time lsp-response-timeout))) + resp-result resp-error done?) + (unwind-protect + (progn + (lsp-request-async method params + (lambda (res) (setf resp-result (or res :finished)) (throw 'lsp-done '_)) + :error-handler (lambda (err) (setf resp-error err) (throw 'lsp-done '_)) + :mode 'detached + :cancel-token :sync-request) + (while (not (or resp-error resp-result (input-pending-p))) + (catch 'lsp-done + (sit-for + (if expected-time (- expected-time send-time) 1))) + (setq send-time (float-time)) + (when (and expected-time (< expected-time send-time)) + (error "Timeout while waiting for response. Method: %s" method))) + (setq done? (or resp-error resp-result)) + (cond + ((eq resp-result :finished) nil) + (resp-result resp-result) + ((lsp-json-error? resp-error) (error (lsp:json-error-message resp-error))) + ((lsp-json-error? (cl-first resp-error)) + (error (lsp:json-error-message (cl-first resp-error)))))) + (unless done? + (lsp-cancel-request-by-token :sync-request)) + (when (and (input-pending-p) lsp--throw-on-input) + (throw 'input :interrupted)))) + (lsp-request method params))) + +(defvar lsp--cancelable-requests (ht)) + +(cl-defun lsp-request-async (method params callback + &key mode error-handler cancel-handler no-merge cancel-token) + "Send METHOD with PARAMS as a request to the language server. +Call CALLBACK with the response received from the server +asynchronously. +MODE determines when the callback will be called depending on the +condition of the original buffer. It could be: +- `detached' which means that the callback will be executed no +matter what has happened to the buffer. +- `alive' - the callback will be executed only if the buffer from +which the call was executed is still alive. +- `current' the callback will be executed only if the original buffer +is still selected. +- `tick' - the callback will be executed only if the buffer was not modified. +- `unchanged' - the callback will be executed only if the buffer hasn't +changed and if the buffer is not modified. + +ERROR-HANDLER will be called in case the request has failed. +CANCEL-HANDLER will be called in case the request is being canceled. +If NO-MERGE is non-nil, don't merge the results but return alist +workspace->result. +CANCEL-TOKEN is the token that can be used to cancel request." + (lsp--send-request-async `(:jsonrpc "2.0" :method ,method :params ,params) + callback mode error-handler cancel-handler no-merge cancel-token)) + +(defun lsp--create-request-cancel (id workspaces hook buf method cancel-callback) + (lambda (&rest _) + (unless (and (equal 'post-command-hook hook) + (equal (current-buffer) buf)) + (lsp--request-cleanup-hooks id) + (with-lsp-workspaces workspaces + (lsp--cancel-request id) + (when cancel-callback (funcall cancel-callback))) + (lsp-log "Cancelling %s(%s) in hook %s" method id hook)))) + +(defun lsp--create-async-callback + (callback method no-merge workspaces) + "Create async handler expecting COUNT results, merge them and call CALLBACK. +MODE determines when the callback will be called depending on the +condition of the original buffer. METHOD is the invoked method. +If NO-MERGE is non-nil, don't merge the results but return alist +workspace->result. ID is the request id." + (let (results errors) + (lambda (result) + (push (cons lsp--cur-workspace result) + (if (eq result :error) errors results)) + (when (and (not (eq (length errors) (length workspaces))) + (eq (+ (length errors) (length results)) (length workspaces))) + (funcall callback + (if no-merge + results + (lsp--merge-results (-map #'cl-rest results) method))))))) + +(defcustom lsp-default-create-error-handler-fn nil + "Default error handler customization. +Handler should give METHOD as argument and return function of one argument +ERROR." + :type 'function + :group 'lsp-mode + :package-version '(lsp-mode . "9.0.0")) + +(defun lsp--create-default-error-handler (method) + "Default error handler. +METHOD is the executed method." + (if lsp-default-create-error-handler-fn + (funcall lsp-default-create-error-handler-fn method) + (lambda (error) + (lsp--warn "%s" (or (lsp--error-string error) + (format "%s Request has failed" method)))))) + +(defvar lsp--request-cleanup-hooks (ht)) + +(defun lsp--request-cleanup-hooks (request-id) + (when-let ((cleanup-function (gethash request-id lsp--request-cleanup-hooks))) + (funcall cleanup-function) + (remhash request-id lsp--request-cleanup-hooks))) + +(defun lsp-cancel-request-by-token (cancel-token) + "Cancel request using CANCEL-TOKEN." + (-when-let ((request-id . workspaces) (gethash cancel-token lsp--cancelable-requests)) + (with-lsp-workspaces workspaces + (lsp--cancel-request request-id)) + (remhash cancel-token lsp--cancelable-requests) + (lsp--request-cleanup-hooks request-id))) + +(defun lsp--send-request-async (body callback + &optional mode error-callback cancel-callback + no-merge cancel-token) + "Send BODY as a request to the language server. +Call CALLBACK with the response received from the server +asynchronously. +MODE determines when the callback will be called depending on the +condition of the original buffer. It could be: +- `detached' which means that the callback will be executed no +matter what has happened to the buffer. +- `alive' - the callback will be executed only if the buffer from +which the call was executed is still alive. +- `current' the callback will be executed only if the original buffer +is still selected. +- `tick' - the callback will be executed only if the buffer was not modified. +- `unchanged' - the callback will be executed only if the buffer hasn't +changed and if the buffer is not modified. + +ERROR-CALLBACK will be called in case the request has failed. +CANCEL-CALLBACK will be called in case the request is being canceled. +If NO-MERGE is non-nil, don't merge the results but return alist +workspace->result. +CANCEL-TOKEN is the token that can be used to cancel request." + (when cancel-token + (lsp-cancel-request-by-token cancel-token)) + + (if-let ((target-workspaces (lsp--find-workspaces-for body))) + (let* ((start-time (current-time)) + (method (plist-get body :method)) + (id (cl-incf lsp-last-id)) + (buf (current-buffer)) + (cancel-callback (when cancel-callback + (pcase mode + ((or 'alive 'tick 'unchanged) + (lambda () + (with-current-buffer buf + (funcall cancel-callback)))) + (_ cancel-callback)))) + ;; calculate what are the (hook . local) pairs which will cancel + ;; the request + (hooks (pcase mode + ('alive '((kill-buffer-hook . t))) + ('tick '((kill-buffer-hook . t) (after-change-functions . t))) + ('unchanged '((after-change-functions . t) (post-command-hook . nil))) + ('current '((post-command-hook . nil))))) + ;; note: lambdas in emacs can be compared but we should make sure + ;; that all of the captured arguments are the same - in our case + ;; `lsp--create-request-cancel' will return the same lambda when + ;; called with the same params. + (cleanup-hooks + (lambda () (mapc + (-lambda ((hook . local)) + (if local + (when (buffer-live-p buf) + (with-current-buffer buf + (remove-hook hook + (lsp--create-request-cancel + id target-workspaces hook buf method cancel-callback) + t))) + (remove-hook hook (lsp--create-request-cancel + id target-workspaces hook buf method cancel-callback)))) + hooks) + (remhash cancel-token lsp--cancelable-requests))) + (callback (pcase mode + ((or 'alive 'tick 'unchanged) (lambda (&rest args) + (with-current-buffer buf + (apply callback args)))) + (_ callback))) + (callback (lsp--create-async-callback callback + method + no-merge + target-workspaces)) + (callback (lambda (result) + (lsp--request-cleanup-hooks id) + (funcall callback result))) + (error-callback (lsp--create-async-callback + (or error-callback + (lsp--create-default-error-handler method)) + method + nil + target-workspaces)) + (error-callback (lambda (error) + (funcall callback :error) + (lsp--request-cleanup-hooks id) + (funcall error-callback error))) + (body (plist-put body :id id))) + + ;; cancel request in any of the hooks + (mapc (-lambda ((hook . local)) + (add-hook hook + (lsp--create-request-cancel + id target-workspaces hook buf method cancel-callback) + nil local)) + hooks) + (puthash id cleanup-hooks lsp--request-cleanup-hooks) + + (setq lsp--last-active-workspaces target-workspaces) + + (when cancel-token + (puthash cancel-token (cons id target-workspaces) lsp--cancelable-requests)) + + (seq-doseq (workspace target-workspaces) + (when (lsp--log-io-p method) + (lsp--log-entry-new (lsp--make-log-entry method id + (plist-get body :params) + 'outgoing-req) + workspace)) + (puthash id + (list callback error-callback method start-time (current-time)) + (-> workspace + (lsp--workspace-client) + (lsp--client-response-handlers))) + (lsp--send-no-wait body (lsp--workspace-proc workspace))) + body) + (error "The connected server(s) does not support method %s. +To find out what capabilities support your server use `M-x lsp-describe-session' +and expand the capabilities section" + (plist-get body :method)))) + +;; deprecated, use lsp-request-async. +(defalias 'lsp-send-request-async 'lsp--send-request-async) +(make-obsolete 'lsp-send-request-async 'lsp-request-async "lsp-mode 7.0.1") + +;; Clean up the entire state of lsp mode when Emacs is killed, to get rid of any +;; pending language servers. +(add-hook 'kill-emacs-hook #'lsp--global-teardown) + +(defun lsp--global-teardown () + "Unload working workspaces." + (lsp-foreach-workspace (lsp--shutdown-workspace))) + +(defun lsp--shutdown-workspace (&optional restart) + "Shut down the language server process for ‘lsp--cur-workspace’." + (with-demoted-errors "LSP error: %S" + (let ((lsp-response-timeout 0.5)) + (condition-case err + (lsp-request "shutdown" nil) + (error (lsp--error "%s" err)))) + (lsp-notify "exit" nil)) + (setf (lsp--workspace-shutdown-action lsp--cur-workspace) (or (and restart 'restart) 'shutdown)) + (lsp--uninitialize-workspace)) + +(defcustom lsp-inlay-hint-enable nil + "If non-nil it will enable inlay hints." + :type 'boolean + :group 'lsp-mode + :package-version '(lsp-mode . "9.0.0")) + +(defun lsp--uninitialize-workspace () + "Cleanup buffer state. +When a workspace is shut down, by request or from just +disappearing, unset all the variables related to it." + (-let [(&lsp-wks 'cmd-proc 'buffers) lsp--cur-workspace] + (lsp-process-kill cmd-proc) + (mapc (lambda (buf) + (when (lsp-buffer-live-p buf) + (lsp-with-current-buffer buf + (lsp-managed-mode -1)))) + buffers) + (lsp-diagnostics--workspace-cleanup lsp--cur-workspace))) + +(defun lsp--client-capabilities (&optional custom-capabilities) + "Return the client capabilities appending CUSTOM-CAPABILITIES." + (append + `((general . ((positionEncodings . ["utf-32", "utf-16"]))) + (workspace . ((workspaceEdit . ((documentChanges . t) + (resourceOperations . ["create" "rename" "delete"]))) + (applyEdit . t) + (symbol . ((symbolKind . ((valueSet . ,(apply 'vector (number-sequence 1 26))))))) + (executeCommand . ((dynamicRegistration . :json-false))) + ,@(when lsp-enable-file-watchers '((didChangeWatchedFiles . ((dynamicRegistration . t))))) + (workspaceFolders . t) + (configuration . t) + ,@(when lsp-semantic-tokens-enable + `((semanticTokens . ((refreshSupport . ,(or (and (boundp 'lsp-semantic-tokens-honor-refresh-requests) + lsp-semantic-tokens-honor-refresh-requests) + :json-false)))))) + ,@(when lsp-lens-enable '((codeLens . ((refreshSupport . t))))) + ,@(when lsp-inlay-hint-enable '((inlayHint . ((refreshSupport . :json-false))))) + (fileOperations . ((didCreate . :json-false) + (willCreate . :json-false) + (didRename . t) + (willRename . t) + (didDelete . :json-false) + (willDelete . :json-false))))) + (textDocument . ((declaration . ((dynamicRegistration . t) + (linkSupport . t))) + (definition . ((dynamicRegistration . t) + (linkSupport . t))) + (references . ((dynamicRegistration . t))) + (implementation . ((dynamicRegistration . t) + (linkSupport . t))) + (typeDefinition . ((dynamicRegistration . t) + (linkSupport . t))) + (synchronization . ((willSave . t) (didSave . t) (willSaveWaitUntil . t))) + (documentSymbol . ((symbolKind . ((valueSet . ,(apply 'vector (number-sequence 1 26))))) + (hierarchicalDocumentSymbolSupport . t))) + (formatting . ((dynamicRegistration . t))) + (rangeFormatting . ((dynamicRegistration . t))) + (onTypeFormatting . ((dynamicRegistration . t))) + ,@(when (and lsp-semantic-tokens-enable + (functionp 'lsp--semantic-tokens-capabilities)) + (lsp--semantic-tokens-capabilities)) + (rename . ((dynamicRegistration . t) (prepareSupport . t))) + (codeAction . ((dynamicRegistration . t) + (isPreferredSupport . t) + (codeActionLiteralSupport . ((codeActionKind . ((valueSet . ["" + "quickfix" + "refactor" + "refactor.extract" + "refactor.inline" + "refactor.rewrite" + "source" + "source.organizeImports"]))))) + (resolveSupport . ((properties . ["edit" "command"]))) + (dataSupport . t))) + (completion . ((completionItem . ((snippetSupport . ,(cond + ((and lsp-enable-snippet (not (fboundp 'yas-minor-mode))) + (lsp--warn (concat + "Yasnippet is not installed, but `lsp-enable-snippet' is set to `t'. " + "You must either install yasnippet, or disable snippet support.")) + :json-false) + (lsp-enable-snippet t) + (t :json-false))) + (documentationFormat . ["markdown" "plaintext"]) + ;; Remove this after jdtls support resolveSupport + (resolveAdditionalTextEditsSupport . t) + (insertReplaceSupport . t) + (deprecatedSupport . t) + (resolveSupport + . ((properties . ["documentation" + "detail" + "additionalTextEdits" + "command"]))) + (insertTextModeSupport . ((valueSet . [1 2]))))) + (contextSupport . t) + (dynamicRegistration . t))) + (signatureHelp . ((signatureInformation . ((parameterInformation . ((labelOffsetSupport . t))))) + (dynamicRegistration . t))) + (documentLink . ((dynamicRegistration . t) + (tooltipSupport . t))) + (hover . ((contentFormat . ["markdown" "plaintext"]) + (dynamicRegistration . t))) + ,@(when lsp-enable-folding + `((foldingRange . ((dynamicRegistration . t) + ,@(when lsp-folding-range-limit + `((rangeLimit . ,lsp-folding-range-limit))) + ,@(when lsp-folding-line-folding-only + `((lineFoldingOnly . t))))))) + (selectionRange . ((dynamicRegistration . t))) + (callHierarchy . ((dynamicRegistration . :json-false))) + (typeHierarchy . ((dynamicRegistration . t))) + (publishDiagnostics . ((relatedInformation . t) + (tagSupport . ((valueSet . [1 2]))) + (versionSupport . t))) + (linkedEditingRange . ((dynamicRegistration . t))))) + (window . ((workDoneProgress . t) + (showDocument . ((support . t)))))) + custom-capabilities)) + +(defun lsp-find-roots-for-workspace (workspace session) + "Get all roots for the WORKSPACE." + (-filter #'identity (ht-map (lambda (folder workspaces) + (when (-contains? workspaces workspace) + folder)) + (lsp-session-folder->servers session)))) + +(defun lsp-session-watches (&optional session) + "Get watches created for SESSION." + (or (gethash "__watches" (lsp-session-metadata (or session (lsp-session)))) + (-let [res (make-hash-table :test 'equal)] + (puthash "__watches" res (lsp-session-metadata (or session (lsp-session)))) + res))) + +(defun lsp--file-process-event (session root-folder event) + "Process file event." + (let* ((changed-file (cl-third event)) + (rel-changed-file (f-relative changed-file root-folder)) + (event-numeric-kind (alist-get (cl-second event) lsp--file-change-type)) + (bit-position (1- event-numeric-kind)) + (watch-bit (ash 1 bit-position))) + (->> + session + lsp-session-folder->servers + (gethash root-folder) + (seq-do (lambda (workspace) + (when (->> + workspace + lsp--workspace-registered-server-capabilities + (-any? + (lambda (capability) + (and + (equal (lsp--registered-capability-method capability) + "workspace/didChangeWatchedFiles") + (->> + capability + lsp--registered-capability-options + (lsp:did-change-watched-files-registration-options-watchers) + (seq-find + (-lambda ((fs-watcher &as &FileSystemWatcher :glob-pattern :kind? :_cachedRegexp cached-regexp)) + (when (or (null kind?) + (> (logand kind? watch-bit) 0)) + (-let [regexes (or cached-regexp + (let ((regexp (lsp-glob-to-regexps glob-pattern))) + (lsp-put fs-watcher :_cachedRegexp regexp) + regexp))] + (-any? (lambda (re) + (or (string-match re changed-file) + (string-match re rel-changed-file))) + regexes)))))))))) + (with-lsp-workspace workspace + (lsp-notify + "workspace/didChangeWatchedFiles" + `((changes . [((type . ,event-numeric-kind) + (uri . ,(lsp--path-to-uri changed-file)))])))))))))) + +(lsp-defun lsp--server-register-capability ((&Registration :method :id :register-options?)) + "Register capability REG." + (when (and lsp-enable-file-watchers + (equal method "workspace/didChangeWatchedFiles")) + (-let* ((created-watches (lsp-session-watches (lsp-session))) + (root-folders (cl-set-difference + (lsp-find-roots-for-workspace lsp--cur-workspace (lsp-session)) + (ht-keys created-watches)))) + ;; create watch for each root folder without such + (dolist (folder root-folders) + (let* ((watch (make-lsp-watch :root-directory folder)) + (ignored-things (lsp--get-ignored-regexes-for-workspace-root folder)) + (ignored-files-regex-list (car ignored-things)) + (ignored-directories-regex-list (cadr ignored-things))) + (puthash folder watch created-watches) + (lsp-watch-root-folder (file-truename folder) + (-partial #'lsp--file-process-event (lsp-session) folder) + ignored-files-regex-list + ignored-directories-regex-list + watch + t))))) + + (push + (make-lsp--registered-capability :id id :method method :options register-options?) + (lsp--workspace-registered-server-capabilities lsp--cur-workspace))) + +(defmacro lsp--with-workspace-temp-buffer (workspace-root &rest body) + "With a temp-buffer under `WORKSPACE-ROOT' and evaluate `BODY', useful to +access dir-local variables." + (declare (indent 1) (debug t)) + `(with-temp-buffer + ;; Set the buffer's name to something under the root so that we can hack the local variables + ;; This file doesn't need to exist and will not be created due to this. + (setq-local buffer-file-name (expand-file-name "lsp-mode-temp" (expand-file-name ,workspace-root))) + (hack-local-variables) + (prog1 ,@body + (setq-local buffer-file-name nil)))) + +(defun lsp--get-ignored-regexes-for-workspace-root (workspace-root) + "Return a list of the form +(lsp-file-watch-ignored-files lsp-file-watch-ignored-directories) for the given +WORKSPACE-ROOT." + ;; The intent of this function is to provide per-root workspace-level customization of the + ;; lsp-file-watch-ignored-directories and lsp-file-watch-ignored-files variables. + (lsp--with-workspace-temp-buffer workspace-root + (list lsp-file-watch-ignored-files (lsp-file-watch-ignored-directories)))) + + +(defun lsp--cleanup-hanging-watches () + "Cleanup watches in case there are no more workspaces that are interested +in that particular folder." + (let* ((session (lsp-session)) + (watches (lsp-session-watches session))) + (dolist (watched-folder (ht-keys watches)) + (when (-none? (lambda (workspace) + (with-lsp-workspace workspace + (lsp--registered-capability "workspace/didChangeWatchedFiles"))) + (gethash watched-folder (lsp-session-folder->servers (lsp-session)))) + (lsp-log "Cleaning up watches for folder %s. There is no workspace watching this folder..." watched-folder) + (lsp-kill-watch (gethash watched-folder watches)) + (remhash watched-folder watches))))) + +(lsp-defun lsp--server-unregister-capability ((&Unregistration :id :method)) + "Unregister capability UNREG." + (setf (lsp--workspace-registered-server-capabilities lsp--cur-workspace) + (seq-remove (lambda (e) (equal (lsp--registered-capability-id e) id)) + (lsp--workspace-registered-server-capabilities lsp--cur-workspace))) + (when (equal method "workspace/didChangeWatchedFiles") + (lsp--cleanup-hanging-watches))) + +(defun lsp--server-capabilities () + "Return the capabilities of the language server associated with the buffer." + (->> (lsp-workspaces) + (-keep #'lsp--workspace-server-capabilities) + (apply #'lsp-merge))) + +(defun lsp--send-open-close-p () + "Return whether open and close notifications should be sent to the server." + (let ((sync (lsp:server-capabilities-text-document-sync? (lsp--server-capabilities)))) + (or (memq sync '(1 2)) + (lsp:text-document-sync-options-open-close? sync)))) + +(defun lsp--send-will-save-p () + "Return whether willSave notifications should be sent to the server." + (-> (lsp--server-capabilities) + (lsp:server-capabilities-text-document-sync?) + (lsp:text-document-sync-options-will-save?))) + +(defun lsp--send-will-save-wait-until-p () + "Return whether willSaveWaitUntil notifications should be sent to the server." + (-> (lsp--server-capabilities) + (lsp:server-capabilities-text-document-sync?) + (lsp:text-document-sync-options-will-save-wait-until?))) + +(defun lsp--send-did-save-p () + "Return whether didSave notifications should be sent to the server." + (let ((sync (lsp:server-capabilities-text-document-sync? (lsp--server-capabilities)))) + (or (memq sync '(1 2)) + (lsp:text-document-sync-options-save? sync)))) + +(defun lsp--save-include-text-p () + "Return whether save notifications should include the text document's contents." + (->> (lsp--server-capabilities) + (lsp:server-capabilities-text-document-sync?) + (lsp:text-document-sync-options-save?) + (lsp:text-document-save-registration-options-include-text?))) + +(defun lsp--send-will-rename-files-p (path) + "Return whether willRenameFiles request should be sent to the server. +If any filters, checks if it applies for PATH." + (let* ((will-rename (-> (lsp--server-capabilities) + (lsp:server-capabilities-workspace?) + (lsp:workspace-server-capabilities-file-operations?) + (lsp:workspace-file-operations-will-rename?))) + (filters (seq-into (lsp:file-operation-registration-options-filters will-rename) 'list))) + (and will-rename + (or (seq-empty-p filters) + (-any? (-lambda ((&FileOperationFilter :scheme? :pattern (&FileOperationPattern :glob))) + (-let [regexes (lsp-glob-to-regexps glob)] + (and (or (not scheme?) + (string-prefix-p scheme? (lsp--path-to-uri path))) + (-any? (lambda (re) + (string-match re path)) + regexes)))) + filters))))) + +(defun lsp--send-did-rename-files-p () + "Return whether didRenameFiles notification should be sent to the server." + (-> (lsp--server-capabilities) + (lsp:server-capabilities-workspace?) + (lsp:workspace-server-capabilities-file-operations?) + (lsp:workspace-file-operations-did-rename?))) + +(declare-function project-roots "ext:project" (project) t) +(declare-function project-root "ext:project" (project) t) + +(defun lsp--suggest-project-root () + "Get project root." + (or + (when (fboundp 'projectile-project-root) + (condition-case nil + (projectile-project-root) + (error nil))) + (when (fboundp 'project-current) + (when-let ((project (project-current))) + (if (fboundp 'project-root) + (project-root project) + (car (with-no-warnings + (project-roots project)))))) + default-directory)) + +(defun lsp--read-from-file (file) + "Read FILE content." + (when (file-exists-p file) + (cl-first (read-from-string (f-read-text file 'utf-8))))) + +(defun lsp--persist (file-name to-persist) + "Persist TO-PERSIST in FILE-NAME. + +This function creates the parent directories if they don't exist +yet." + (let ((print-length nil) + (print-level nil)) + ;; Create all parent directories: + (make-directory (f-parent file-name) t) + (f-write-text (prin1-to-string to-persist) 'utf-8 file-name))) + +(defun lsp-workspace-folders-add (project-root) + "Add PROJECT-ROOT to the list of workspace folders." + (interactive + (list (read-directory-name "Select folder to add: " + (or (lsp--suggest-project-root) default-directory) nil t))) + (cl-pushnew (lsp-f-canonical project-root) + (lsp-session-folders (lsp-session)) :test 'equal) + (lsp--persist-session (lsp-session)) + + (run-hook-with-args 'lsp-workspace-folders-changed-functions (list project-root) nil)) + +(defun lsp-workspace-folders-remove (project-root) + "Remove PROJECT-ROOT from the list of workspace folders." + (interactive (list (completing-read "Select folder to remove: " + (lsp-session-folders (lsp-session)) + nil t nil nil + (lsp-find-session-folder (lsp-session) default-directory)))) + + (setq project-root (lsp-f-canonical project-root)) + + ;; send remove folder to each multiroot workspace associated with the folder + (dolist (wks (->> (lsp-session) + (lsp-session-folder->servers) + (gethash project-root) + (--filter (lsp--client-multi-root (lsp--workspace-client it))))) + (with-lsp-workspace wks + (lsp-notify "workspace/didChangeWorkspaceFolders" + (lsp-make-did-change-workspace-folders-params + :event (lsp-make-workspace-folders-change-event + :removed (vector (lsp-make-workspace-folder + :uri (lsp--path-to-uri project-root) + :name (f-filename project-root))) + :added []))))) + + ;; turn off servers in the removed directory + (let* ((session (lsp-session)) + (folder->servers (lsp-session-folder->servers session)) + (server-id->folders (lsp-session-server-id->folders session)) + (workspaces (gethash project-root folder->servers))) + + (remhash project-root folder->servers) + + ;; turn off the servers without root folders + (dolist (workspace workspaces) + (when (--none? (-contains? it workspace) (ht-values folder->servers)) + (lsp--info "Shutdown %s since folder %s is removed..." + (lsp--workspace-print workspace) project-root) + (with-lsp-workspace workspace (lsp--shutdown-workspace)))) + + (setf (lsp-session-folders session) + (-remove-item project-root (lsp-session-folders session))) + + (ht-aeach (puthash key + (-remove-item project-root value) + server-id->folders) + server-id->folders) + (lsp--persist-session (lsp-session))) + + (run-hook-with-args 'lsp-workspace-folders-changed-functions nil (list project-root))) + +(defun lsp-workspace-blocklist-remove (project-root) + "Remove PROJECT-ROOT from the workspace blocklist." + (interactive (list (completing-read "Select folder to remove:" + (lsp-session-folders-blocklist (lsp-session)) + nil t))) + (setf (lsp-session-folders-blocklist (lsp-session)) + (delete project-root + (lsp-session-folders-blocklist (lsp-session)))) + (lsp--persist-session (lsp-session))) + +(define-obsolete-function-alias 'lsp-workspace-folders-switch + 'lsp-workspace-folders-open "lsp-mode 6.1") + +(defun lsp-workspace-folders-open (project-root) + "Open the directory located at PROJECT-ROOT" + (interactive (list (completing-read "Open folder: " + (lsp-session-folders (lsp-session)) + nil t))) + (find-file project-root)) + +(defun lsp--maybe-enable-signature-help (trigger-characters) + (let ((ch last-command-event)) + (when (cl-find ch trigger-characters :key #'string-to-char) + (lsp-signature-activate)))) + +(defun lsp--on-type-formatting-handler-create () + (when-let ((provider (lsp--capability-for-method "textDocument/onTypeFormatting" ))) + (-let [(&DocumentOnTypeFormattingOptions :more-trigger-character? + :first-trigger-character) provider] + (lambda () + (lsp--on-type-formatting first-trigger-character + more-trigger-character?))))) + +(defun lsp--update-on-type-formatting-hook (&optional cleanup?) + (let ((on-type-formatting-handler (lsp--on-type-formatting-handler-create))) + (cond + ((and lsp-enable-on-type-formatting on-type-formatting-handler (not cleanup?)) + (add-hook 'post-self-insert-hook on-type-formatting-handler nil t)) + ((or cleanup? + (not lsp-enable-on-type-formatting)) + (remove-hook 'post-self-insert-hook on-type-formatting-handler t))))) + +(defun lsp--signature-help-handler-create () + (-when-let ((&SignatureHelpOptions? :trigger-characters?) + (lsp--capability-for-method "textDocument/signatureHelp")) + (lambda () + (lsp--maybe-enable-signature-help trigger-characters?)))) + +(defun lsp--update-signature-help-hook (&optional cleanup?) + (let ((signature-help-handler (lsp--signature-help-handler-create))) + (cond + ((and (or (equal lsp-signature-auto-activate t) + (memq :on-trigger-char lsp-signature-auto-activate)) + signature-help-handler) + (add-hook 'post-self-insert-hook signature-help-handler nil t)) + + ((or cleanup? + (not (or (equal lsp-signature-auto-activate t) + (memq :on-trigger-char lsp-signature-auto-activate)))) + (remove-hook 'post-self-insert-hook signature-help-handler t))))) + +(defun lsp--after-set-visited-file-name () + (lsp-disconnect) + (lsp)) + +;; TODO remove those eldoc workarounds when dropping support for Emacs 27 +;; https://github.com/emacs-lsp/lsp-mode/issues/3295#issuecomment-1308994099 +(defvar eldoc-documentation-default) ; CI +(when (< emacs-major-version 28) + (unless (boundp 'eldoc-documentation-functions) + (load "eldoc" nil 'nomessage)) + (when (memq (default-value 'eldoc-documentation-function) '(nil ignore)) + ;; actually `eldoc-documentation-strategy', but CI was failing + (setq-default eldoc-documentation-function 'eldoc-documentation-default))) + +(define-minor-mode lsp-managed-mode + "Mode for source buffers managed by lsp-mode." + :lighter nil + (cond + (lsp-managed-mode + (when (lsp-feature? "textDocument/hover") + (add-hook 'eldoc-documentation-functions #'lsp-eldoc-function nil t) + (eldoc-mode 1)) + + (add-hook 'after-change-functions #'lsp-on-change nil t) + (add-hook 'after-revert-hook #'lsp-on-revert nil t) + (add-hook 'after-save-hook #'lsp-on-save nil t) + (add-hook 'auto-save-hook #'lsp--on-auto-save nil t) + (add-hook 'before-change-functions #'lsp-before-change nil t) + (add-hook 'before-save-hook #'lsp--before-save nil t) + (add-hook 'kill-buffer-hook #'lsp--text-document-did-close nil t) + (add-hook 'post-command-hook #'lsp--post-command nil t) + + (lsp--update-on-type-formatting-hook) + (lsp--update-signature-help-hook) + + (when lsp-enable-xref + (add-hook 'xref-backend-functions #'lsp--xref-backend nil t)) + + (lsp-configure-buffer) + + ;; make sure we turn off lsp-mode in case major mode changes, because major + ;; mode change will wipe the buffer locals. + (add-hook 'change-major-mode-hook #'lsp-disconnect nil t) + (add-hook 'after-set-visited-file-name-hook #'lsp--after-set-visited-file-name nil t) + + (let ((buffer (lsp-current-buffer))) + (run-with-idle-timer + 0.0 nil + (lambda () + (when (lsp-buffer-live-p buffer) + (lsp-with-current-buffer buffer + (lsp--on-change-debounce buffer) + (lsp--on-idle buffer))))))) + (t + (lsp-unconfig-buffer) + + (remove-hook 'eldoc-documentation-functions #'lsp-eldoc-function t) + (remove-hook 'post-command-hook #'lsp--post-command t) + (remove-hook 'after-change-functions #'lsp-on-change t) + (remove-hook 'after-revert-hook #'lsp-on-revert t) + (remove-hook 'after-save-hook #'lsp-on-save t) + (remove-hook 'auto-save-hook #'lsp--on-auto-save t) + (remove-hook 'before-change-functions #'lsp-before-change t) + (remove-hook 'before-save-hook #'lsp--before-save t) + (remove-hook 'kill-buffer-hook #'lsp--text-document-did-close t) + + (lsp--update-on-type-formatting-hook :cleanup) + (lsp--update-signature-help-hook :cleanup) + + (when lsp--on-idle-timer + (cancel-timer lsp--on-idle-timer) + (setq lsp--on-idle-timer nil)) + + (remove-hook 'lsp-on-idle-hook #'lsp--document-links t) + (remove-hook 'lsp-on-idle-hook #'lsp--document-highlight t) + + (lsp--remove-overlays 'lsp-highlight) + (lsp--remove-overlays 'lsp-links) + + (remove-hook 'xref-backend-functions #'lsp--xref-backend t) + (remove-hook 'change-major-mode-hook #'lsp-disconnect t) + (remove-hook 'after-set-visited-file-name-hook #'lsp--after-set-visited-file-name t) + (setq-local lsp-buffer-uri nil)))) + +(defun lsp-configure-buffer () + "Configure LSP features for current buffer." + ;; make sure the core is running in the context of all available workspaces + ;; to avoid misconfiguration in case we are running in `with-lsp-workspace' context + (let ((lsp--buffer-workspaces (cond + (lsp--buffer-workspaces) + (lsp--cur-workspace (list lsp--cur-workspace)))) + lsp--cur-workspace) + (when lsp-auto-configure + (lsp--auto-configure) + + (when (and lsp-enable-text-document-color + (lsp-feature? "textDocument/documentColor")) + (add-hook 'lsp-on-change-hook #'lsp--document-color nil t)) + + (when (and lsp-enable-imenu + (lsp-feature? "textDocument/documentSymbol")) + (lsp-enable-imenu)) + + (when (and lsp-enable-indentation + (lsp-feature? "textDocument/rangeFormatting")) + (add-function :override (local 'indent-region-function) #'lsp-format-region)) + + (when (and lsp-enable-symbol-highlighting + (lsp-feature? "textDocument/documentHighlight")) + (add-hook 'lsp-on-idle-hook #'lsp--document-highlight nil t)) + + (when (and lsp-enable-links + (lsp-feature? "textDocument/documentLink")) + (add-hook 'lsp-on-idle-hook #'lsp--document-links nil t)) + + (when (and lsp-inlay-hint-enable + (lsp-feature? "textDocument/inlayHint")) + (lsp-inlay-hints-mode)) + + (when (and lsp-enable-dap-auto-configure + (functionp 'dap-mode)) + (dap-auto-configure-mode 1))) + (run-hooks 'lsp-configure-hook))) + +(defun lsp-unconfig-buffer () + "Unconfigure LSP features for buffer." + (lsp--remove-overlays 'lsp-color) + + (when (advice-function-member-p 'lsp--imenu-create-index imenu-create-index-function) + (remove-function (local 'imenu-create-index-function) #'lsp--imenu-create-index) + (setq-local imenu-menubar-modified-tick 0) + (setq-local imenu--index-alist nil) + (imenu--cleanup)) + + (remove-function (local 'indent-region-function) #'lsp-format-region) + + (remove-hook 'lsp-on-change-hook #'lsp--document-color t) + (remove-hook 'lsp-on-idle-hook #'lsp--document-highlight t) + (remove-hook 'lsp-on-idle-hook #'lsp--document-links t) + + (when (and lsp-enable-dap-auto-configure + (functionp 'dap-mode)) + (dap-auto-configure-mode -1)) + + (run-hooks 'lsp-unconfigure-hook)) + +(defun lsp--buffer-content () + (lsp-save-restriction-and-excursion + (or (lsp-virtual-buffer-call :buffer-string) + (buffer-substring-no-properties (point-min) + (point-max))))) + +(defun lsp--text-document-did-open () + "`document/didOpen' event." + (run-hooks 'lsp-before-open-hook) + (when (and lsp-auto-touch-files + (not (f-exists? (lsp--uri-to-path (lsp--buffer-uri))))) + (lsp--info "Saving file '%s' because it is not present on the disk." (lsp--buffer-uri)) + (save-buffer)) + + (setq lsp--cur-version (or lsp--cur-version 0)) + (cl-pushnew (lsp-current-buffer) (lsp--workspace-buffers lsp--cur-workspace)) + (lsp-notify + "textDocument/didOpen" + (list :textDocument + (list :uri (lsp--buffer-uri) + :languageId (lsp-buffer-language) + :version lsp--cur-version + :text (lsp--buffer-content)))) + + (lsp-managed-mode 1) + + (run-hooks 'lsp-after-open-hook) + (when-let ((client (-some-> lsp--cur-workspace (lsp--workspace-client)))) + (-some-> (lsp--client-after-open-fn client) + (funcall)) + (-some-> (format "lsp-%s-after-open-hook" (lsp--client-server-id client)) + (intern-soft) + (run-hooks)))) + +(defun lsp--text-document-identifier () + "Make TextDocumentIdentifier." + (list :uri (lsp--buffer-uri))) + +(defun lsp--versioned-text-document-identifier () + "Make VersionedTextDocumentIdentifier." + (plist-put (lsp--text-document-identifier) :version lsp--cur-version)) + +(defun lsp--cur-line (&optional point) + (1- (line-number-at-pos point))) + +(defun lsp--cur-position () + "Make a Position object for the current point." + (or (lsp-virtual-buffer-call :cur-position) + (lsp-save-restriction-and-excursion + (list :line (lsp--cur-line) + :character (- (point) (line-beginning-position)))))) + +(defun lsp--point-to-position (point) + "Convert POINT to Position." + (lsp-save-restriction-and-excursion + (goto-char point) + (lsp--cur-position))) + +(defun lsp--range (start end) + "Make Range body from START and END." + ;; make sure start and end are Position objects + (list :start start :end end)) + +(defun lsp--region-to-range (start end) + "Make Range object for the current region." + (lsp--range (lsp--point-to-position start) + (lsp--point-to-position end))) + +(defun lsp--region-or-line () + "The active region or the current line." + (if (use-region-p) + (lsp--region-to-range (region-beginning) (region-end)) + (lsp--region-to-range (line-beginning-position) (line-end-position)))) + +(defun lsp--check-document-changes-version (document-changes) + "Verify that DOCUMENT-CHANGES have the proper version." + (unless (seq-every-p + (-lambda ((&TextDocumentEdit :text-document)) + (or + (not text-document) + (let* ((filename (-> text-document + lsp:versioned-text-document-identifier-uri + lsp--uri-to-path)) + (version (lsp:versioned-text-document-identifier-version? text-document))) + (with-current-buffer (find-file-noselect filename) + (or (null version) (zerop version) (= -1 version) + (equal version lsp--cur-version)))))) + document-changes) + (error "Document changes cannot be applied due to different document version"))) + +(defun lsp--apply-workspace-edit (workspace-edit &optional operation) + "Apply the WorkspaceEdit object WORKSPACE-EDIT. +OPERATION is symbol representing the source of this text edit." + (-let (((&WorkspaceEdit :document-changes? :changes?) workspace-edit)) + (if-let ((document-changes (seq-reverse document-changes?))) + (progn + (lsp--check-document-changes-version document-changes) + (->> document-changes + (seq-filter (-lambda ((&CreateFile :kind)) (equal kind "create"))) + (seq-do (lambda (change) (lsp--apply-text-document-edit change operation)))) + (->> document-changes + (seq-filter (-lambda ((&CreateFile :kind)) + (and (or (not kind) (equal kind "edit")) + (not (equal kind "create"))))) + (seq-do (lambda (change) (lsp--apply-text-document-edit change operation)))) + (->> document-changes + (seq-filter (-lambda ((&CreateFile :kind)) + (and (not (or (not kind) (equal kind "edit"))) + (not (equal kind "create"))))) + (seq-do (lambda (change) (lsp--apply-text-document-edit change operation))))) + (lsp-map + (lambda (uri text-edits) + (with-current-buffer (-> uri lsp--uri-to-path find-file-noselect) + (lsp--apply-text-edits text-edits operation))) + changes?)))) + +(defmacro lsp-with-filename (file &rest body) + "Execute BODY with FILE as a context. +Need to handle the case when FILE indicates virtual buffer." + (declare (indent 1) (debug t)) + `(if-let ((lsp--virtual-buffer (get-text-property 0 'lsp-virtual-buffer ,file))) + (lsp-with-current-buffer lsp--virtual-buffer + ,@body) + ,@body)) + +(defun lsp--apply-text-document-edit (edit &optional operation) + "Apply the TextDocumentEdit object EDIT. +OPERATION is symbol representing the source of this text edit. +If the file is not being visited by any buffer, it is opened with +`find-file-noselect'. +Because lsp-mode does not store previous document versions, the edit is only +applied if the version of the textDocument matches the version of the +corresponding file. + +interface TextDocumentEdit { + textDocument: VersionedTextDocumentIdentifier; + edits: TextEdit[]; +}" + (pcase (lsp:edit-kind edit) + ("create" (-let* (((&CreateFile :uri :options?) edit) + (file-name (lsp--uri-to-path uri))) + (mkdir (f-dirname file-name) t) + (f-touch file-name) + (when (lsp:create-file-options-overwrite? options?) + (f-write-text "" nil file-name)) + (find-file-noselect file-name))) + ("delete" (-let (((&DeleteFile :uri :options? (&DeleteFileOptions? :recursive?)) edit)) + (f-delete (lsp--uri-to-path uri) recursive?))) + ("rename" (-let* (((&RenameFile :old-uri :new-uri :options? (&RenameFileOptions? :overwrite?)) edit) + (old-file-name (lsp--uri-to-path old-uri)) + (new-file-name (lsp--uri-to-path new-uri)) + (buf (find-buffer-visiting old-file-name))) + (when buf + (lsp-with-current-buffer buf + (save-buffer) + (lsp--text-document-did-close))) + (mkdir (f-dirname new-file-name) t) + (rename-file old-file-name new-file-name overwrite?) + (when buf + (lsp-with-current-buffer buf + (set-buffer-modified-p nil) + (setq lsp-buffer-uri nil) + (set-visited-file-name new-file-name) + (lsp))))) + (_ (let ((file-name (->> edit + (lsp:text-document-edit-text-document) + (lsp:versioned-text-document-identifier-uri) + (lsp--uri-to-path)))) + (lsp-with-current-buffer (find-buffer-visiting file-name) + (lsp-with-filename file-name + (lsp--apply-text-edits (lsp:text-document-edit-edits edit) operation))))))) + +(lsp-defun lsp--position-compare ((&Position :line left-line + :character left-character) + (&Position :line right-line + :character right-character)) + "Return t if position LEFT is greater than RIGHT." + (if (= left-line right-line) + (> left-character right-character) + (> left-line right-line))) + +(lsp-defun lsp-point-in-range? (position (&Range :start :end)) + "Returns if POINT is in RANGE." + (not (or (lsp--position-compare start position) + (lsp--position-compare position end)))) + +(lsp-defun lsp--position-equal ((&Position :line left-line + :character left-character) + (&Position :line right-line + :character right-character)) + "Return whether LEFT and RIGHT positions are equal." + (and (= left-line right-line) + (= left-character right-character))) + +(lsp-defun lsp--text-edit-sort-predicate ((&TextEdit :range (&Range :start left-start :end left-end)) + (&TextEdit :range (&Range :start right-start :end right-end))) + (if (lsp--position-equal left-start right-start) + (lsp--position-compare left-end right-end) + (lsp--position-compare left-start right-start))) + +(lsp-defun lsp--apply-text-edit ((edit &as &TextEdit :range (&RangeToPoint :start :end) :new-text)) + "Apply the edits described in the TextEdit object in TEXT-EDIT." + (setq new-text (s-replace "\r" "" (or new-text ""))) + (lsp:set-text-edit-new-text edit new-text) + (goto-char start) + (delete-region start end) + (insert new-text)) + +;; WORKAROUND: typescript-language might send -1 when applying code actions. +;; see https://github.com/emacs-lsp/lsp-mode/issues/1582 +(lsp-defun lsp--fix-point ((point &as &Position :character :line)) + (-doto point + (lsp:set-position-line (max 0 line)) + (lsp:set-position-character (max 0 character)))) + +(lsp-defun lsp--apply-text-edit-replace-buffer-contents ((edit &as + &TextEdit + :range (&Range :start :end) + :new-text)) + "Apply the edits described in the TextEdit object in TEXT-EDIT. +The method uses `replace-buffer-contents'." + (setq new-text (s-replace "\r" "" (or new-text ""))) + (lsp:set-text-edit-new-text edit new-text) + (-let* ((source (current-buffer)) + ((beg . end) (lsp--range-to-region (lsp-make-range :start (lsp--fix-point start) + :end (lsp--fix-point end))))) + (with-temp-buffer + (insert new-text) + (let ((temp (current-buffer))) + (with-current-buffer source + (save-excursion + (save-restriction + (narrow-to-region beg end) + + ;; On emacs versions < 26.2, + ;; `replace-buffer-contents' is buggy - it calls + ;; change functions with invalid arguments - so we + ;; manually call the change functions here. + ;; + ;; See emacs bugs #32237, #32278: + ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=32237 + ;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=32278 + (let ((inhibit-modification-hooks t) + (length (- end beg))) + (run-hook-with-args 'before-change-functions + beg end) + (replace-buffer-contents temp) + (run-hook-with-args 'after-change-functions + beg (+ beg (length new-text)) + length))))))))) + +(defun lsp--to-yasnippet-snippet (snippet) + "Convert LSP SNIPPET to yasnippet snippet." + ;; LSP snippet doesn't escape "{" and "`", but yasnippet requires escaping it. + (replace-regexp-in-string (rx (or bos (not (any "$" "\\"))) (group (or "{" "`"))) + (rx "\\" (backref 1)) + snippet + nil nil 1)) + +(defvar-local lsp-enable-relative-indentation nil + "Enable relative indentation when insert texts, snippets ... +from language server.") + +(defun lsp--expand-snippet (snippet &optional start end expand-env) + "Wrapper of `yas-expand-snippet' with all of it arguments. +The snippet will be convert to LSP style and indent according to +LSP server result." + (require 'yasnippet nil t) + (let* ((inhibit-field-text-motion t) + (yas-wrap-around-region nil) + (yas-indent-line 'none) + (yas-also-auto-indent-first-line nil)) + (yas-expand-snippet + (lsp--to-yasnippet-snippet snippet) + start end expand-env))) + +(defun lsp--indent-lines (start end &optional insert-text-mode?) + "Indent from START to END based on INSERT-TEXT-MODE? value. +- When INSERT-TEXT-MODE? is provided + - if it's `lsp/insert-text-mode-as-it', do no editor indentation. + - if it's `lsp/insert-text-mode-adjust-indentation', adjust leading + whitespaces to match the line where text is inserted. +- When it's not provided, using `indent-line-function' for each line." + (save-excursion + (goto-char end) + (let* ((end-line (line-number-at-pos)) + (offset (save-excursion + (goto-char start) + (current-indentation))) + (indent-line-function + (cond ((equal insert-text-mode? lsp/insert-text-mode-as-it) + #'ignore) + ((or (equal insert-text-mode? lsp/insert-text-mode-adjust-indentation) + lsp-enable-relative-indentation + ;; Indenting snippets is extremely slow in `org-mode' buffers + ;; since it has to calculate indentation based on SRC block + ;; position. Thus we use relative indentation as default. + (derived-mode-p 'org-mode)) + (lambda () (save-excursion + (beginning-of-line) + (indent-to-column offset)))) + (t indent-line-function)))) + (goto-char start) + (forward-line) + (while (and (not (eobp)) + (<= (line-number-at-pos) end-line)) + (funcall indent-line-function) + (forward-line))))) + +(defun lsp--apply-text-edits (edits &optional operation) + "Apply the EDITS described in the TextEdit[] object. +OPERATION is symbol representing the source of this text edit." + (unless (seq-empty-p edits) + (atomic-change-group + (run-hooks 'lsp-before-apply-edits-hook) + (let* ((change-group (prepare-change-group)) + (howmany (length edits)) + (message (format "Applying %s edits to `%s' ..." howmany (current-buffer))) + (_ (lsp--info message)) + (reporter (make-progress-reporter message 0 howmany)) + (done 0) + (apply-edit (if (not lsp--virtual-buffer) + #'lsp--apply-text-edit-replace-buffer-contents + #'lsp--apply-text-edit))) + (unwind-protect + (->> edits + ;; We sort text edits so as to apply edits that modify latter + ;; parts of the document first. Furthermore, because the LSP + ;; spec dictates that: "If multiple inserts have the same + ;; position, the order in the array defines which edit to + ;; apply first." We reverse the initial list and sort stably + ;; to make sure the order among edits with the same position + ;; is preserved. + (nreverse) + (seq-sort #'lsp--text-edit-sort-predicate) + (mapc (lambda (edit) + (progress-reporter-update reporter (cl-incf done)) + (funcall apply-edit edit) + (when (lsp:snippet-text-edit-insert-text-format? edit) + (-when-let ((&SnippetTextEdit :range (&RangeToPoint :start) + :insert-text-format? :new-text) edit) + (when (eq insert-text-format? lsp/insert-text-format-snippet) + ;; No `save-excursion' needed since expand snippet will change point anyway + (goto-char (+ start (length new-text))) + (lsp--indent-lines start (point)) + (lsp--expand-snippet new-text start (point))))) + (run-hook-with-args 'lsp-after-apply-edits-hook operation)))) + (undo-amalgamate-change-group change-group) + (progress-reporter-done reporter)))))) + +(defun lsp--create-apply-text-edits-handlers () + "Create (handler cleanup-fn) for applying text edits in async request. +Only works when mode is `tick or `alive." + (let* (first-edited + (func (lambda (start &rest _) + (setq first-edited (if first-edited + (min start first-edited) + start))))) + (add-hook 'before-change-functions func nil t) + (list + (lambda (edits) + (if (and first-edited + (seq-find (-lambda ((&TextEdit :range (&RangeToPoint :end))) + ;; Text edit region is overlapped + (> end first-edited)) + edits)) + (lsp--warn "TextEdits will not be applied since document has been modified before of them.") + (lsp--apply-text-edits edits 'completion-cleanup))) + (lambda () + (remove-hook 'before-change-functions func t))))) + +(defun lsp--capability (cap &optional capabilities) + "Get the value of capability CAP. If CAPABILITIES is non-nil, use them instead." + (when (stringp cap) + (setq cap (intern (concat ":" cap)))) + + (lsp-get (or capabilities + (lsp--server-capabilities)) + cap)) + +(defun lsp--registered-capability (method) + "Check whether there is workspace providing METHOD." + (->> (lsp-workspaces) + (--keep (seq-find (lambda (reg) + (equal (lsp--registered-capability-method reg) method)) + (lsp--workspace-registered-server-capabilities it))) + cl-first)) + +(defun lsp--capability-for-method (method) + "Get the value of capability for METHOD." + (-let* ((reqs (cdr (assoc method lsp-method-requirements))) + ((&plist :capability) reqs)) + (or (and capability (lsp--capability capability)) + (-some-> (lsp--registered-capability method) + (lsp--registered-capability-options))))) + +(defvar-local lsp--before-change-vals nil + "Store the positions from the `lsp-before-change' function call, for +validation and use in the `lsp-on-change' function.") + +(defun lsp--text-document-content-change-event (start end length) + "Make a TextDocumentContentChangeEvent body for START to END, of length LENGTH." + ;; So (47 54 0) means add 7 chars starting at pos 47 + ;; must become + ;; {"range":{"start":{"line":5,"character":6} + ;; ,"end" :{"line":5,"character":6}} + ;; ,"rangeLength":0 + ;; ,"text":"\nbb = 5"} + ;; + ;; And (47 47 7) means delete 7 chars starting at pos 47 + ;; must become + ;; {"range":{"start":{"line":6,"character":0} + ;; ,"end" :{"line":7,"character":0}} + ;; ,"rangeLength":7 + ;; ,"text":""} + ;; + ;; (208 221 3) means delete 3 chars starting at pos 208, and replace them with + ;; 13 chars. So it must become + ;; {"range":{"start":{"line":5,"character":8} + ;; ,"end" :{"line":5,"character":11}} + ;; ,"rangeLength":3 + ;; ,"text":"new-chars-xxx"} + ;; + + ;; Adding text: + ;; lsp-before-change:(start,end)=(33,33) + ;; lsp-on-change:(start,end,length)=(33,34,0) + ;; + ;; Changing text: + ;; lsp-before-change:(start,end)=(208,211) + ;; lsp-on-change:(start,end,length)=(208,221,3) + ;; + ;; Deleting text: + ;; lsp-before-change:(start,end)=(19,27) + ;; lsp-on-change:(start,end,length)=(19,19,8) + (if (zerop length) + ;; Adding something only, work from start only + `( :range ,(lsp--range + (lsp--point-to-position start) + (lsp--point-to-position start)) + :rangeLength 0 + :text ,(buffer-substring-no-properties start end)) + + (if (eq start end) + ;; Deleting something only + (if (lsp--bracketed-change-p start length) + ;; The before-change value is bracketed, use it + `( :range ,(lsp--range + (lsp--point-to-position start) + (plist-get lsp--before-change-vals :end-pos)) + :rangeLength ,length + :text "") + ;; If the change is not bracketed, send a full change event instead. + (lsp--full-change-event)) + + ;; Deleting some things, adding others + (if (lsp--bracketed-change-p start length) + ;; The before-change value is valid, use it + `( :range ,(lsp--range + (lsp--point-to-position start) + (plist-get lsp--before-change-vals :end-pos)) + :rangeLength ,length + :text ,(buffer-substring-no-properties start end)) + (lsp--full-change-event))))) + +(defun lsp--bracketed-change-p (start length) + "If the before and after positions are the same, and the length +is the size of the start range, we are probably good." + (-let [(&plist :end before-end :start before-start) lsp--before-change-vals] + (and (eq start before-start) + (eq length (- before-end before-start))))) + +(defun lsp--full-change-event () + `(:text ,(lsp--buffer-content))) + +(defun lsp-before-change (start end) + "Executed before a file is changed. +Added to `before-change-functions'." + ;; Note: + ;; + ;; This variable holds a list of functions to call when Emacs is about to + ;; modify a buffer. Each function gets two arguments, the beginning and end of + ;; the region that is about to change, represented as integers. The buffer + ;; that is about to change is always the current buffer when the function is + ;; called. + ;; + ;; WARNING: + ;; + ;; Do not expect the before-change hooks and the after-change hooks be called + ;; in balanced pairs around each buffer change. Also don't expect the + ;; before-change hooks to be called for every chunk of text Emacs is about to + ;; delete. These hooks are provided on the assumption that Lisp programs will + ;; use either before- or the after-change hooks, but not both, and the + ;; boundaries of the region where the changes happen might include more than + ;; just the actual changed text, or even lump together several changes done + ;; piecemeal. + (save-match-data + (lsp-save-restriction-and-excursion + (setq lsp--before-change-vals + (list :start start + :end end + :end-pos (lsp--point-to-position end)))))) + +(defun lsp--flush-delayed-changes () + (let ((inhibit-quit t)) + (when lsp--delay-timer + (cancel-timer lsp--delay-timer)) + (mapc (-lambda ((workspace buffer document change)) + (with-current-buffer buffer + (with-lsp-workspace workspace + (lsp-notify "textDocument/didChange" + (list :textDocument document + :contentChanges (vector change)))))) + (prog1 (nreverse lsp--delayed-requests) + (setq lsp--delayed-requests nil))))) + +(defun lsp--workspace-sync-method (workspace) + (let ((sync (-> workspace + (lsp--workspace-server-capabilities) + (lsp:server-capabilities-text-document-sync?)))) + (if (lsp-text-document-sync-options? sync) + (lsp:text-document-sync-options-change? sync) + sync))) + +(defun lsp-on-change (start end length &optional content-change-event-fn) + "Executed when a file is changed. +Added to `after-change-functions'." + ;; Note: + ;; + ;; Each function receives three arguments: the beginning and end of the region + ;; just changed, and the length of the text that existed before the change. + ;; All three arguments are integers. The buffer that has been changed is + ;; always the current buffer when the function is called. + ;; + ;; The length of the old text is the difference between the buffer positions + ;; before and after that text as it was before the change. As for the + ;; changed text, its length is simply the difference between the first two + ;; arguments. + ;; + ;; So (47 54 0) means add 7 chars starting at pos 47 + ;; So (47 47 7) means delete 7 chars starting at pos 47 + (save-match-data + (let ((inhibit-quit t) + ;; make sure that `lsp-on-change' is called in multi-workspace context + ;; see #2901 + lsp--cur-workspace) + ;; A (revert-buffer) call with the 'preserve-modes parameter (eg, as done + ;; by auto-revert-mode) will cause this handler to get called with a nil + ;; buffer-file-name. We need the buffer-file-name to send notifications; + ;; so we skip handling revert-buffer-caused changes and instead handle + ;; reverts separately in lsp-on-revert + (when (not revert-buffer-in-progress-p) + (cl-incf lsp--cur-version) + (mapc + (lambda (workspace) + (pcase (or lsp-document-sync-method + (lsp--workspace-sync-method workspace)) + (1 + (if lsp-debounce-full-sync-notifications + (setq lsp--delayed-requests + (->> lsp--delayed-requests + (-remove (-lambda ((_ buffer)) + (equal (current-buffer) buffer))) + (cons (list workspace + (current-buffer) + (lsp--versioned-text-document-identifier) + (lsp--full-change-event))))) + (with-lsp-workspace workspace + (lsp-notify "textDocument/didChange" + (list :contentChanges (vector (lsp--full-change-event)) + :textDocument (lsp--versioned-text-document-identifier)))))) + (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)) + + +(defcustom lsp-trim-trailing-whitespace t + "Trim trailing whitespace on a line." + :group 'lsp-mode + :type 'boolean) + +(defcustom lsp-insert-final-newline t + "Insert a newline character at the end of the file if one does not exist." + :group 'lsp-mode + :type 'boolean) + +(defcustom lsp-trim-final-newlines t + "Trim all newlines after the final newline at the end of the file." + :group 'lsp-mode + :type 'boolean) + + +(defun lsp--on-type-formatting (first-trigger-characters more-trigger-characters) + "Self insert handling. +Applies on type formatting." + (let ((ch last-command-event)) + (when (or (eq (string-to-char first-trigger-characters) ch) + (cl-find ch more-trigger-characters :key #'string-to-char)) + (lsp-request-async "textDocument/onTypeFormatting" + (lsp-make-document-on-type-formatting-params + :text-document (lsp--text-document-identifier) + :options (lsp-make-formatting-options + :tab-size (symbol-value (lsp--get-indent-width major-mode)) + :insert-spaces (lsp-json-bool (not indent-tabs-mode)) + :trim-trailing-whitespace? (lsp-json-bool lsp-trim-trailing-whitespace) + :insert-final-newline? (lsp-json-bool lsp-insert-final-newline) + :trim-final-newlines? (lsp-json-bool lsp-trim-final-newlines)) + :ch (char-to-string ch) + :position (lsp--cur-position)) + (lambda (data) (lsp--apply-text-edits data 'format)) + :mode 'tick)))) + + +;; links +(defun lsp--document-links () + (when (lsp-feature? "textDocument/documentLink") + (lsp-request-async + "textDocument/documentLink" + `(:textDocument ,(lsp--text-document-identifier)) + (lambda (links) + (lsp--remove-overlays 'lsp-link) + (seq-do + (-lambda ((link &as &DocumentLink :range (&Range :start :end))) + (-doto (make-button (lsp--position-to-point start) + (lsp--position-to-point end) + 'action (lsp--document-link-keymap link) + 'keymap (let ((map (make-sparse-keymap))) + (define-key map [M-return] 'push-button) + (define-key map [mouse-2] 'push-button) + map) + 'help-echo "mouse-2, M-RET: Visit this link") + (overlay-put 'lsp-link t))) + links)) + :mode 'unchanged))) + +(defun lsp--document-link-handle-target (url) + (let* ((parsed-url (url-generic-parse-url (url-unhex-string url))) + (type (url-type parsed-url))) + (pcase type + ("file" + (xref-push-marker-stack) + (find-file (lsp--uri-to-path url)) + (-when-let ((_ line column) (s-match (rx "#" (group (1+ num)) (or "," "#") (group (1+ num))) url)) + (goto-char (lsp--position-to-point + (lsp-make-position :character (1- (string-to-number column)) + :line (1- (string-to-number line))))))) + ((or "http" "https") (browse-url url)) + (type (if-let ((handler (lsp--get-uri-handler type))) + (funcall handler url) + (signal 'lsp-file-scheme-not-supported (list url))))))) + +(lsp-defun lsp--document-link-keymap ((link &as &DocumentLink :target?)) + (if target? + (lambda (_) + (interactive) + (lsp--document-link-handle-target target?)) + (lambda (_) + (interactive) + (when (lsp:document-link-registration-options-resolve-provider? + (lsp--capability-for-method "textDocument/documentLink")) + (lsp-request-async + "documentLink/resolve" + link + (-lambda ((&DocumentLink :target?)) + (lsp--document-link-handle-target target?))))))) + + + +(defcustom lsp-warn-no-matched-clients t + "Whether to show messages when there are no supported clients." + :group 'lsp-mode + :type 'boolean) + +(defun lsp-buffer-language--configured-id () + "Return nil when not registered." + (->> lsp-language-id-configuration + (-first + (-lambda ((mode-or-pattern . language)) + (cond + ((and (stringp mode-or-pattern) + (s-matches? mode-or-pattern (buffer-file-name))) + language) + ((eq mode-or-pattern major-mode) language)))) + cl-rest)) + +(defvar-local lsp--buffer-language nil + "Locally cached returned value of `lsp-buffer-language'.") + +(defun lsp-buffer-language () + "Get language corresponding current buffer." + (or lsp--buffer-language + (let* ((configured-language (lsp-buffer-language--configured-id))) + (setq lsp--buffer-language + (or configured-language + ;; ensure non-nil + (string-remove-suffix "-mode" (symbol-name major-mode)))) + (when (and lsp-warn-no-matched-clients + (null configured-language)) + (lsp-warn "Unable to calculate the languageId for buffer `%s'. \ +Take a look at `lsp-language-id-configuration'. The `major-mode' is %s" + (buffer-name) + major-mode)) + lsp--buffer-language))) + +(defun lsp-activate-on (&rest languages) + "Returns language activation function. +The function will return t when the `lsp-buffer-language' returns +one of the LANGUAGES." + (lambda (_file-name _mode) + (-contains? languages (lsp-buffer-language)))) + +(defun lsp-workspace-root (&optional path) + "Find the workspace root for the current file or PATH." + (-when-let* ((file-name (or path (buffer-file-name))) + (file-name (lsp-f-canonical file-name))) + (->> (lsp-session) + (lsp-session-folders) + (--filter (and (lsp--files-same-host it file-name) + (or (lsp-f-ancestor-of? it file-name) + (equal it file-name)))) + (--max-by (> (length it) (length other)))))) + +(defun lsp-on-revert () + "Executed when a file is reverted. +Added to `after-revert-hook'." + (let ((n (buffer-size)) + (revert-buffer-in-progress-p nil)) + (lsp-on-change 0 n n))) + +(defun lsp--text-document-did-close (&optional keep-workspace-alive) + "Executed when the file is closed, added to `kill-buffer-hook'. + +If KEEP-WORKSPACE-ALIVE is non-nil, do not shutdown the workspace +if it's closing the last buffer in the workspace." + (lsp-foreach-workspace + (cl-callf2 delq (lsp-current-buffer) (lsp--workspace-buffers lsp--cur-workspace)) + (with-demoted-errors "Error sending didClose notification in ‘lsp--text-document-did-close’: %S" + (lsp-notify "textDocument/didClose" + `(:textDocument ,(lsp--text-document-identifier)))) + (when (and (not lsp-keep-workspace-alive) + (not keep-workspace-alive) + (not (lsp--workspace-buffers lsp--cur-workspace))) + (lsp--shutdown-workspace)))) + +(defun lsp--will-save-text-document-params (reason) + (list :textDocument (lsp--text-document-identifier) + :reason reason)) + +(defun lsp--before-save () + "Before save handler." + (with-demoted-errors "Error in ‘lsp--before-save’: %S" + (let ((params (lsp--will-save-text-document-params 1))) + (when (lsp--send-will-save-p) + (lsp-notify "textDocument/willSave" params)) + (when (and (lsp--send-will-save-wait-until-p) lsp-before-save-edits) + (let ((lsp-response-timeout 0.1)) + (condition-case nil + (lsp--apply-text-edits + (lsp-request "textDocument/willSaveWaitUntil" + params) + 'before-save) + (error))))))) + +(defun lsp--on-auto-save () + "Handler for auto-save." + (when (lsp--send-will-save-p) + (with-demoted-errors "Error in ‘lsp--on-auto-save’: %S" + (lsp-notify "textDocument/willSave" (lsp--will-save-text-document-params 2))))) + +(defun lsp--text-document-did-save () + "Executed when the file is closed, added to `after-save-hook''." + (when (lsp--send-did-save-p) + (with-demoted-errors "Error on ‘lsp--text-document-did-save: %S’" + (lsp-notify "textDocument/didSave" + `( :textDocument ,(lsp--versioned-text-document-identifier) + ,@(when (lsp--save-include-text-p) + (list :text (lsp--buffer-content)))))))) + +(defun lsp--text-document-position-params (&optional identifier position) + "Make TextDocumentPositionParams for the current point in the current document. +If IDENTIFIER and POSITION are non-nil, they will be used as the document +identifier and the position respectively." + (list :textDocument (or identifier (lsp--text-document-identifier)) + :position (or position (lsp--cur-position)))) + +(defun lsp--get-buffer-diagnostics () + "Return buffer diagnostics." + (gethash (or + (plist-get lsp--virtual-buffer :buffer-file-name) + (lsp--fix-path-casing (buffer-file-name))) + (lsp-diagnostics t))) + +(defun lsp-cur-line-diagnostics () + "Return any diagnostics that apply to the current line." + (-let [(&plist :start (&plist :line start) :end (&plist :line end)) (lsp--region-or-line)] + (cl-coerce (-filter + (-lambda ((&Diagnostic :range (&Range :start (&Position :line)))) + (and (>= line start) (<= line end))) + (lsp--get-buffer-diagnostics)) + 'vector))) + +(lsp-defun lsp-range-overlapping?((left &as &Range :start left-start :end left-end) + (right &as &Range :start right-start :end right-end)) + (or (lsp-point-in-range? right-start left) + (lsp-point-in-range? right-end left) + (lsp-point-in-range? left-start right) + (lsp-point-in-range? left-end right))) + +(defun lsp-make-position-1 (position) + (lsp-make-position :line (plist-get position :line) + :character (plist-get position :character))) + +(defun lsp-cur-possition-diagnostics () + "Return any diagnostics that apply to the current line." + (-let* ((start (if (use-region-p) (region-beginning) (point))) + (end (if (use-region-p) (region-end) (point))) + (current-range (lsp-make-range :start (lsp-make-position-1 (lsp-point-to-position start)) + :end (lsp-make-position-1 (lsp-point-to-position end))))) + (->> (lsp--get-buffer-diagnostics) + (-filter + (-lambda ((&Diagnostic :range)) + (lsp-range-overlapping? range current-range))) + (apply 'vector)))) + +(defalias 'lsp--cur-line-diagnotics 'lsp-cur-line-diagnostics) + +(defun lsp--extract-line-from-buffer (pos) + "Return the line pointed to by POS (a Position object) in the current buffer." + (let* ((point (lsp--position-to-point pos)) + (inhibit-field-text-motion t)) + (save-excursion + (goto-char point) + (buffer-substring (line-beginning-position) (line-end-position))))) + +(lsp-defun lsp--xref-make-item (filename (&Range :start (start &as &Position :character start-char :line start-line) + :end (end &as &Position :character end-char))) + "Return a xref-item from a RANGE in FILENAME." + (let* ((line (lsp--extract-line-from-buffer start)) + (len (length line))) + (add-face-text-property (max (min start-char len) 0) + (max (min end-char len) 0) + 'xref-match t line) + ;; LINE is nil when FILENAME is not being current visited by any buffer. + (xref-make-match (or line filename) + (xref-make-file-location + filename + (lsp-translate-line (1+ start-line)) + (lsp-translate-column start-char)) + (- end-char start-char)))) + +(defun lsp--location-uri (loc) + (if (lsp-location? loc) + (lsp:location-uri loc) + (lsp:location-link-target-uri loc))) + +(lsp-defun lsp-goto-location ((loc &as &Location :uri :range (&Range :start))) + "Go to location." + (let ((path (lsp--uri-to-path uri))) + (if (f-exists? path) + (with-current-buffer (find-file path) + (goto-char (lsp--position-to-point start))) + (error "There is no file %s" path)))) + +(defun lsp--location-range (loc) + (if (lsp-location? loc) + (lsp:location-range loc) + (lsp:location-link-target-selection-range loc))) + +(defun lsp--locations-to-xref-items (locations) + "Return a list of `xref-item' given LOCATIONS, which can be of +type Location, LocationLink, Location[] or LocationLink[]." + (setq locations + (pcase locations + ((seq (or (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 exclude-declaration) + "Make a ReferenceParam object. +If TD-POSITION is non-nil, use it as TextDocumentPositionParams object instead. +If EXCLUDE-DECLARATION is non-nil, request the server to include declarations." + (let ((json-false :json-false)) + (plist-put (or td-position (lsp--text-document-position-params)) + :context `(:includeDeclaration ,(lsp-json-bool (not exclude-declaration)))))) + +(defun lsp--cancel-request (id) + "Cancel request with ID in all workspaces." + (lsp-foreach-workspace + (->> lsp--cur-workspace lsp--workspace-client lsp--client-response-handlers (remhash id)) + (lsp-notify "$/cancelRequest" `(:id ,id)))) + +(defvar-local lsp--hover-saved-bounds nil) + +(defun lsp-eldoc-function (cb &rest _ignored) + "`lsp-mode' eldoc function to display hover info (based on `textDocument/hover')." + (if (and lsp--hover-saved-bounds + (lsp--point-in-bounds-p lsp--hover-saved-bounds)) + lsp--eldoc-saved-message + (setq lsp--hover-saved-bounds nil + lsp--eldoc-saved-message nil) + (if (looking-at-p "[[:space:]\n]") + (setq lsp--eldoc-saved-message nil) ; And returns nil. + (when (and lsp-eldoc-enable-hover (lsp-feature? "textDocument/hover")) + (lsp-request-async + "textDocument/hover" + (lsp--text-document-position-params) + (-lambda ((hover &as &Hover? :range? :contents)) + (setq lsp--hover-saved-bounds (when range? + (lsp--range-to-region range?))) + (funcall cb (setq lsp--eldoc-saved-message + (when contents + (lsp--render-on-hover-content + contents + lsp-eldoc-render-all))))) + :error-handler #'ignore + :mode 'tick + :cancel-token :eldoc-hover))))) + +(defun lsp--point-on-highlight? () + (-some? (lambda (overlay) + (overlay-get overlay 'lsp-highlight)) + (overlays-at (point)))) + +(defun lsp--cleanup-highlights-if-needed () + (when (and lsp-enable-symbol-highlighting + lsp--have-document-highlights + (not (lsp--point-on-highlight?))) + (lsp--remove-overlays 'lsp-highlight) + (setq lsp--have-document-highlights nil) + (lsp-cancel-request-by-token :highlights))) + +(defvar-local lsp--symbol-bounds-of-last-highlight-invocation nil + "The bounds of the symbol from which `lsp--document-highlight' + most recently requested highlights.") + +(defun lsp--document-highlight () + (when (lsp-feature? "textDocument/documentHighlight") + (let ((curr-sym-bounds (bounds-of-thing-at-point 'symbol))) + (unless (or (looking-at-p "[[:space:]\n]") + (not lsp-enable-symbol-highlighting) + (and lsp--have-document-highlights + curr-sym-bounds + (equal curr-sym-bounds + lsp--symbol-bounds-of-last-highlight-invocation))) + (setq lsp--symbol-bounds-of-last-highlight-invocation + curr-sym-bounds) + (lsp-request-async "textDocument/documentHighlight" + (lsp--text-document-position-params) + #'lsp--document-highlight-callback + :mode 'tick + :cancel-token :highlights))))) + +(defun lsp--help-open-link (&rest _) + "Open markdown link at point via mouse or keyboard." + (interactive "P") + (let ((buffer-list-update-hook nil)) + (-let [(buffer point) (if-let* ((valid (and (listp last-input-event) + (eq (car last-input-event) 'mouse-2))) + (event (cadr last-input-event)) + (win (posn-window event)) + (buffer (window-buffer win))) + `(,buffer ,(posn-point event)) + `(,(current-buffer) ,(point)))] + (with-current-buffer buffer + (when-let* ((face (get-text-property point 'face)) + (url (or (and (eq face 'markdown-link-face) + (get-text-property point 'help-echo)) + (and (memq face '(markdown-url-face markdown-plain-url-face)) + (nth 3 (markdown-link-at-pos point)))))) + (lsp--document-link-handle-target url)))))) + +(defvar lsp-help-mode-map + (-doto (make-sparse-keymap) + (define-key [remap markdown-follow-link-at-point] #'lsp--help-open-link)) + "Keymap for `lsp-help-mode'.") + +(define-derived-mode lsp-help-mode help-mode "LspHelp" + "Major mode for displaying lsp help.") + +(defun lsp-describe-thing-at-point () + "Display the type signature and documentation of the thing at point." + (interactive) + (let ((contents (-some->> (lsp--text-document-position-params) + (lsp--make-request "textDocument/hover") + (lsp--send-request) + (lsp:hover-contents)))) + (if (and contents (not (equal contents ""))) + (let ((lsp-help-buf-name "*lsp-help*")) + (with-current-buffer (get-buffer-create lsp-help-buf-name) + (delay-mode-hooks + (lsp-help-mode) + (with-help-window lsp-help-buf-name + (insert (string-trim-right (lsp--render-on-hover-content contents t))))) + (run-mode-hooks))) + (lsp--info "No content at point.")))) + +(defun lsp--point-in-bounds-p (bounds) + "Return whether the current point is within BOUNDS." + (and (<= (car bounds) (point)) (< (point) (cdr bounds)))) + +(defun lsp-get-renderer (language) + "Get renderer for LANGUAGE." + (lambda (str) + (lsp--render-string str language))) + +(defun lsp--setup-markdown (mode) + "Setup the ‘markdown-mode’ in the frame. +MODE is the mode used in the parent frame." + (make-local-variable 'markdown-code-lang-modes) + (dolist (mark (alist-get mode lsp-custom-markup-modes)) + (add-to-list 'markdown-code-lang-modes (cons mark mode))) + (setq-local markdown-fontify-code-blocks-natively t) + (setq-local markdown-fontify-code-block-default-mode mode) + (setq-local markdown-hide-markup t) + + ;; Render some common HTML entities. + ;; This should really happen in markdown-mode instead, + ;; but it doesn't, so we do it here for now. + (setq prettify-symbols-alist + (cl-loop for i from 0 to 255 + collect (cons (format "&#x%02X;" i) i))) + (push '("&lt;" . ?<) prettify-symbols-alist) + (push '("&gt;" . ?>) prettify-symbols-alist) + (push '("&amp;" . ?&) prettify-symbols-alist) + (push '("&nbsp;" . ? ) prettify-symbols-alist) + (setq prettify-symbols-compose-predicate + (lambda (_start _end _match) t)) + (prettify-symbols-mode 1)) + +(defvar lsp-help-link-keymap + (let ((map (make-sparse-keymap))) + (define-key map [mouse-2] #'lsp--help-open-link) + (define-key map "\r" #'lsp--help-open-link) + map) + "Keymap active on links in *lsp-help* mode.") + +(defun lsp--fix-markdown-links () + (let ((inhibit-read-only t) + (inhibit-modification-hooks t) + (prop)) + (save-restriction + (goto-char (point-min)) + (while (setq prop (markdown-find-next-prop 'face)) + (let ((end (or (next-single-property-change (car prop) 'face) + (point-max)))) + (when (memq (get-text-property (car prop) 'face) + '(markdown-link-face + markdown-url-face + markdown-plain-url-face)) + (add-text-properties (car prop) end + (list 'button t + 'category 'lsp-help-link + 'follow-link t + 'keymap lsp-help-link-keymap))) + (goto-char end)))))) + +(defun lsp--buffer-string-visible () + "Return visible buffer string. +Stolen from `org-copy-visible'." + (let ((temp (generate-new-buffer " *temp*")) + (beg (point-min)) + (end (point-max))) + (while (/= beg end) + (when (get-char-property beg 'invisible) + (setq beg (next-single-char-property-change beg 'invisible nil end))) + (let* ((next (next-single-char-property-change beg 'invisible nil end)) + (substring (buffer-substring beg next))) + (with-current-buffer temp (insert substring)) + ;; (setq result (concat result substring)) + (setq beg next))) + (setq deactivate-mark t) + (prog1 (with-current-buffer temp + (s-chop-suffix "\n" (buffer-string))) + (kill-buffer temp)))) + +(defvar lsp-buffer-major-mode nil + "Holds the major mode when fontification function is running. +See #2588") + +(defvar view-inhibit-help-message) + +(defun lsp--render-markdown () + "Render markdown." + + (let ((markdown-enable-math nil)) + (goto-char (point-min)) + (while (re-search-forward + (rx (and "\\" (group (or "\\" "`" "*" "_" ":" "/" + "{" "}" "[" "]" "(" ")" + "#" "+" "-" "." "!" "|")))) + nil t) + (replace-match (rx (backref 1)))) + + ;; markdown-mode v2.3 does not yet provide gfm-view-mode + (if (fboundp 'gfm-view-mode) + (let ((view-inhibit-help-message t)) + (gfm-view-mode)) + (gfm-mode)) + + (lsp--setup-markdown lsp-buffer-major-mode))) + +(defvar lsp--display-inline-image-alist + '((lsp--render-markdown + (:regexp + "!\\[.*?\\](data:image/[a-zA-Z]+;base64,\\([A-Za-z0-9+/\n]+?=*?\\)\\(|[^)]+\\)?)" + :sexp + (create-image + (base64-decode-string + (buffer-substring-no-properties (match-beginning 1) (match-end 1))) + nil t)))) + "Replaced string regexp and function returning image. +Each element should have the form (MODE . (PROPERTY-LIST...)). +MODE (car) is function which is defined in `lsp-language-id-configuration'. +Cdr should be list of PROPERTY-LIST. + +Each PROPERTY-LIST should have properties: +:regexp Regexp which determines what string is relpaced to image. + You should also get information of image, by parenthesis constructs. + By default, all matched string is replaced to image, but you can + change index of replaced string by keyword :replaced-index. + +:sexp Return image when evaluated. You can use information of regexp + by using (match-beggining N), (match-end N) or (match-substring N). + +In addition, each can have property: +:replaced-index Determine index which is used to replace regexp to image. + The value means first argument of `match-beginning' and + `match-end'. If omitted, interpreted as index 0.") + +(defcustom lsp-display-inline-image t + "Showing inline image or not." + :group 'lsp-mode + :type 'boolean) + +(defcustom lsp-enable-suggest-server-download t + "When non-nil enable server downloading suggestions." + :group 'lsp-mode + :type 'boolean + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-auto-register-remote-clients t + "When non-nil register remote when registering the local one." + :group 'lsp-mode + :type 'boolean + :package-version '(lsp-mode . "9.0.0")) + +(defun lsp--display-inline-image (mode) + "Add image property if available." + (let ((plist-list (cdr (assq mode lsp--display-inline-image-alist)))) + (when (and (display-images-p) lsp-display-inline-image) + (cl-loop + for plist in plist-list + with regexp with replaced-index + do + (setq regexp (plist-get plist :regexp)) + (setq replaced-index (or (plist-get plist :replaced-index) 0)) + + (font-lock-remove-keywords nil (list regexp replaced-index)) + (let ((inhibit-read-only t)) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (set-text-properties + (match-beginning replaced-index) (match-end replaced-index) + nil) + (add-text-properties + (match-beginning replaced-index) (match-end replaced-index) + `(display ,(eval (plist-get plist :sexp))))))))))) + +(defun lsp--fontlock-with-mode (str mode) + "Fontlock STR with MODE." + (let ((lsp-buffer-major-mode major-mode)) + (with-temp-buffer + (with-demoted-errors "Error during doc rendering: %s" + (insert str) + (delay-mode-hooks (funcall mode)) + (cl-flet ((window-body-width () lsp-window-body-width)) + ;; This can go wrong in some cases, and the fontification would + ;; not work as expected. + ;; + ;; See #2984 + (ignore-errors (font-lock-ensure)) + (lsp--display-inline-image mode) + (when (eq mode 'lsp--render-markdown) + (lsp--fix-markdown-links)))) + (lsp--buffer-string-visible)))) + +(defun lsp--render-string (str language) + "Render STR using `major-mode' corresponding to LANGUAGE. +When language is nil render as markup if `markdown-mode' is loaded." + (setq str (s-replace "\r" "" (or str ""))) + (if-let* ((modes (-keep (-lambda ((mode . lang)) + (when (and (equal lang language) (functionp mode)) + mode)) + lsp-language-id-configuration)) + (mode (car (or (member major-mode modes) modes)))) + (lsp--fontlock-with-mode str mode) + str)) + +(defun lsp--render-element (content) + "Render CONTENT element." + (let ((inhibit-message t)) + (or + (pcase content + ((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-defmethod lsp-clients-extract-signature-on-hover (contents _server-id) + "Extract a representative line from CONTENTS, to show in the echo area." + (car (s-lines (s-trim (lsp--render-element contents))))) + +(defun lsp--render-on-hover-content (contents render-all) + "Render the content received from `document/onHover' request. +CONTENTS - MarkedString | MarkedString[] | MarkupContent +RENDER-ALL - nil if only the signature should be rendered." + (cond + ((lsp-markup-content? contents) + ;; MarkupContent. + ;; It tends to be long and is not suitable to display fully in the echo area. + ;; Just display the first line which is typically the signature. + (if render-all + (lsp--render-element contents) + (lsp--handle-rendered-for-echo-area contents))) + ((and (stringp contents) (not (string-match-p "\n" contents))) + ;; If the contents is a single string containing a single line, + ;; render it always. + (lsp--render-element contents)) + (t + ;; MarkedString -> MarkedString[] + (when (or (lsp-marked-string? contents) (stringp contents)) + (setq contents (list contents))) + ;; Consider the signature consisting of the elements who have a renderable + ;; "language" property. When render-all is nil, ignore other elements. + (string-join + (seq-map + #'lsp--render-element + (if render-all + contents + ;; Only render contents that have an available renderer. + (seq-take + (seq-filter + (-andfn #'lsp-marked-string? + (-compose #'lsp-get-renderer #'lsp:marked-string-language)) + contents) + 1))) + (if (bound-and-true-p page-break-lines-mode) + "\n \n" + "\n"))))) + + + +(defvar lsp-signature-mode-map + (-doto (make-sparse-keymap) + (define-key (kbd "M-n") #'lsp-signature-next) + (define-key (kbd "M-p") #'lsp-signature-previous) + (define-key (kbd "M-a") #'lsp-signature-toggle-full-docs) + (define-key (kbd "C-c C-k") #'lsp-signature-stop) + (define-key (kbd "C-g") #'lsp-signature-stop)) + "Keymap for `lsp-signature-mode'.") + +(define-minor-mode lsp-signature-mode + "Mode used to show signature popup." + :keymap lsp-signature-mode-map + :lighter "" + :group 'lsp-mode) + +(defun lsp-signature-stop () + "Stop showing current signature help." + (interactive) + (lsp-cancel-request-by-token :signature) + (remove-hook 'post-command-hook #'lsp-signature) + (funcall lsp-signature-function nil) + (lsp-signature-mode -1)) + +(declare-function page-break-lines--update-display-tables "ext:page-break-lines") + +(defun lsp--setup-page-break-mode-if-present () + "Enable `page-break-lines-mode' in current buffer." + (when (fboundp 'page-break-lines-mode) + (page-break-lines-mode) + ;; force page-break-lines-mode to update the display tables. + (page-break-lines--update-display-tables))) + +(defun lsp-lv-message (message) + (add-hook 'lv-window-hook #'lsp--setup-page-break-mode-if-present) + (if message + (progn + (setq lsp--signature-last-buffer (current-buffer)) + (let ((lv-force-update t)) + (lv-message "%s" message))) + (lv-delete-window) + (remove-hook 'lv-window-hook #'lsp--setup-page-break-mode-if-present))) + +(declare-function posframe-show "ext:posframe") +(declare-function posframe-hide "ext:posframe") +(declare-function posframe-poshandler-point-bottom-left-corner-upward "ext:posframe") + +(defface lsp-signature-posframe + '((t :inherit tooltip)) + "Background and foreground for `lsp-signature-posframe'." + :group 'lsp-mode) + +(defvar lsp-signature-posframe-params + (list :poshandler #'posframe-poshandler-point-bottom-left-corner-upward + :height 10 + :width 60 + :border-width 1 + :min-width 60) + "Params for signature and `posframe-show'.") + +(defun lsp-signature-posframe (str) + "Use posframe to show the STR signatureHelp string." + (if str + (apply #'posframe-show + (with-current-buffer (get-buffer-create " *lsp-signature*") + (erase-buffer) + (insert str) + (visual-line-mode 1) + (lsp--setup-page-break-mode-if-present) + (current-buffer)) + (append + lsp-signature-posframe-params + (list :position (point) + :background-color (face-attribute 'lsp-signature-posframe :background nil t) + :foreground-color (face-attribute 'lsp-signature-posframe :foreground nil t) + :border-color (face-attribute '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))) + + + +(defun lsp--action-trigger-parameter-hints (_command) + "Handler for editor.action.triggerParameterHints." + (when (member :on-server-request lsp-signature-auto-activate) + (lsp-signature-activate))) + +(defun lsp--action-trigger-suggest (_command) + "Handler for editor.action.triggerSuggest." + (cond + ((and (bound-and-true-p company-mode) + (fboundp 'company-auto-begin) + (fboundp 'company-post-command)) + (run-at-time 0 nil + (lambda () + (let ((this-command 'company-idle-begin) + (company-minimum-prefix-length 0)) + (company-auto-begin) + (company-post-command))))) + (t + (completion-at-point)))) + +(defconst lsp--default-action-handlers + (ht ("editor.action.triggerParameterHints" #'lsp--action-trigger-parameter-hints) + ("editor.action.triggerSuggest" #'lsp--action-trigger-suggest)) + "Default action handlers.") + +(defun lsp--find-action-handler (command) + "Find action handler for particular COMMAND." + (or + (--some (-some->> it + (lsp--workspace-client) + (lsp--client-action-handlers) + (gethash command)) + (lsp-workspaces)) + (gethash command lsp--default-action-handlers))) + +(defun lsp--text-document-code-action-params (&optional kind) + "Code action params." + (list :textDocument (lsp--text-document-identifier) + :range (if (use-region-p) + (lsp--region-to-range (region-beginning) (region-end)) + (lsp--region-to-range (point) (point))) + :context `( :diagnostics ,(lsp-cur-possition-diagnostics) + ,@(when kind (list :only (vector kind)))))) + +(defun lsp-code-actions-at-point (&optional kind) + "Retrieve the code actions for the active region or the current line. +It will filter by KIND if non nil." + (lsp-request "textDocument/codeAction" (lsp--text-document-code-action-params kind))) + +(defun lsp-execute-code-action-by-kind (command-kind) + "Execute code action by COMMAND-KIND." + (if-let ((action (->> (lsp-get-or-calculate-code-actions command-kind) + (-filter (-lambda ((&CodeAction :kind?)) + (and kind? (s-prefix? command-kind kind?)))) + lsp--select-action))) + (lsp-execute-code-action action) + (signal 'lsp-no-code-actions '(command-kind)))) + +(defalias 'lsp-get-or-calculate-code-actions 'lsp-code-actions-at-point) + +(lsp-defun lsp--execute-command ((action &as &Command :command :arguments?)) + "Parse and execute a code ACTION represented as a Command LSP type." + (let ((server-id (->> (lsp-workspaces) + (cl-first) + (or lsp--cur-workspace) + (lsp--workspace-client) + (lsp--client-server-id)))) + (condition-case nil + (with-no-warnings + (lsp-execute-command server-id (intern command) arguments?)) + (cl-no-applicable-method + (if-let ((action-handler (lsp--find-action-handler command))) + (funcall action-handler action) + (lsp-send-execute-command command arguments?)))))) + +(lsp-defun lsp-execute-code-action ((action &as &CodeAction :command? :edit?)) + "Execute code action ACTION. For example, when text under the +caret has a suggestion to apply a fix from an lsp-server, calling +this function will do so. +If ACTION is not set it will be selected from `lsp-code-actions-at-point'. +Request codeAction/resolve for more info if server supports." + (interactive (list (lsp--select-action (lsp-code-actions-at-point)))) + (if (and (lsp-feature? "codeAction/resolve") + (not command?) + (not edit?)) + (lsp--execute-code-action (lsp-request "codeAction/resolve" action)) + (lsp--execute-code-action action))) + +(lsp-defun lsp--execute-code-action ((action &as &CodeAction :command? :edit?)) + "Execute code action ACTION." + (when edit? + (lsp--apply-workspace-edit edit? 'code-action)) + + (cond + ((stringp command?) (lsp--execute-command action)) + ((lsp-command? command?) (progn + (when-let ((action-filter (->> (lsp-workspaces) + (cl-first) + (or lsp--cur-workspace) + (lsp--workspace-client) + (lsp--client-action-filter)))) + (funcall action-filter command?)) + (lsp--execute-command command?))))) + +(lsp-defun lsp-fix-code-action-booleans ((&Command :arguments?) boolean-action-arguments) + "Patch incorrect boolean argument values in the provided `CodeAction' command +in place, based on the BOOLEAN-ACTION-ARGUMENTS list. The values +in this list can be either symbols or lists of symbols that +represent paths to boolean arguments in code actions: + +> (lsp-fix-code-action-booleans command `(:foo :bar (:some :nested :boolean))) + +When there are available code actions, the server sends +`lsp-mode' a list of possible command names and arguments as +JSON. `lsp-mode' parses all boolean false values as `nil'. As a +result code action arguments containing falsy values don't +roundtrip correctly because `lsp-mode' will end up sending null +values back to the client. This list makes it possible to +selectively transform `nil' values back into `:json-false'." + (seq-doseq (path boolean-action-arguments) + (seq-doseq (args arguments?) + (lsp--fix-nested-boolean args (if (listp path) path (list path)))))) + +(defun lsp--fix-nested-boolean (structure path) + "Traverse STRUCTURE using the paths from the PATH list, changing the value to +`:json-false' if it was `nil'. PATH should be a list containing +one or more symbols, and STRUCTURE should be compatible with +`lsp-member?', `lsp-get', and `lsp-put'." + (let ((key (car path)) + (rest (cdr path))) + (if (null rest) + ;; `lsp-put' returns `nil' both when the key doesn't exist and when the + ;; value is `nil', so we need to explicitly check its presence here + (when (and (lsp-member? structure key) (not (lsp-get structure key))) + (lsp-put structure key :json-false)) + ;; If `key' does not exist, then we'll silently ignore it + (when-let ((child (lsp-get structure key))) + (lsp--fix-nested-boolean child rest))))) + +(defvar lsp--formatting-indent-alist + ;; Taken from `dtrt-indent-mode' + '( + (ada-mode . ada-indent) ; Ada + (ada-ts-mode . ada-ts-mode-indent-offset) + (c++-mode . c-basic-offset) ; C++ + (c++-ts-mode . c-ts-mode-indent-offset) + (c-mode . c-basic-offset) ; C + (c-ts-mode . c-ts-mode-indent-offset) + (cperl-mode . cperl-indent-level) ; Perl + (crystal-mode . crystal-indent-level) ; Crystal (Ruby) + (csharp-mode . c-basic-offset) ; C# + (csharp-tree-sitter-mode . csharp-tree-sitter-indent-offset) ; C# + (csharp-ts-mode . csharp-ts-mode-indent-offset) ; C# (tree-sitter, Emacs29) + (css-mode . css-indent-offset) ; CSS + (d-mode . c-basic-offset) ; D + (enh-ruby-mode . enh-ruby-indent-level) ; Ruby + (erlang-mode . erlang-indent-level) ; Erlang + (ess-mode . ess-indent-offset) ; ESS (R) + (go-ts-mode . go-ts-mode-indent-offset) + (gpr-mode . gpr-indent-offset) ; GNAT Project + (gpr-ts-mode . gpr-ts-mode-indent-offset) + (hack-mode . hack-indent-offset) ; Hack + (java-mode . c-basic-offset) ; Java + (java-ts-mode . java-ts-mode-indent-offset) + (jde-mode . c-basic-offset) ; Java (JDE) + (js-mode . js-indent-level) ; JavaScript + (js-ts-mode . js-indent-level) + (js2-mode . js2-basic-offset) ; JavaScript-IDE + (js3-mode . js3-indent-level) ; JavaScript-IDE + (json-mode . js-indent-level) ; JSON + (json-ts-mode . json-ts-mode-indent-offset) + (lua-mode . lua-indent-level) ; Lua + (lua-ts-mode . lua-ts-indent-offset) + (nxml-mode . nxml-child-indent) ; XML + (objc-mode . c-basic-offset) ; Objective C + (pascal-mode . pascal-indent-level) ; Pascal + (perl-mode . perl-indent-level) ; Perl + (php-mode . c-basic-offset) ; PHP + (php-ts-mode . php-ts-mode-indent-offset) ; PHP + (powershell-mode . powershell-indent) ; PowerShell + (powershell-ts-mode . powershell-ts-mode-indent-offset) ; PowerShell + (raku-mode . raku-indent-offset) ; Perl6/Raku + (ruby-mode . ruby-indent-level) ; Ruby + (rust-mode . rust-indent-offset) ; Rust + (rust-ts-mode . rust-ts-mode-indent-offset) + (rustic-mode . rustic-indent-offset) ; Rust + (scala-mode . scala-indent:step) ; Scala + (sgml-mode . sgml-basic-offset) ; SGML + (sh-mode . sh-basic-offset) ; Shell Script + (toml-ts-mode . toml-ts-mode-indent-offset) + (typescript-mode . typescript-indent-level) ; Typescript + (typescript-ts-mode . typescript-ts-mode-indent-offset) ; Typescript (tree-sitter, Emacs29) + (yaml-mode . yaml-indent-offset) ; YAML + (yang-mode . c-basic-offset) ; YANG (yang-mode) + + (default . standard-indent)) ; default fallback + "A mapping from `major-mode' to its indent variable.") + +(defun lsp--get-indent-width (mode) + "Get indentation offset for MODE." + (or (alist-get mode lsp--formatting-indent-alist) + (lsp--get-indent-width (or (get mode 'derived-mode-parent) 'default)))) + +(defun lsp--make-document-formatting-params () + "Create document formatting params." + (lsp-make-document-formatting-params + :text-document (lsp--text-document-identifier) + :options (lsp-make-formatting-options + :tab-size (symbol-value (lsp--get-indent-width major-mode)) + :insert-spaces (lsp-json-bool (not indent-tabs-mode)) + :trim-trailing-whitespace? (lsp-json-bool lsp-trim-trailing-whitespace) + :insert-final-newline? (lsp-json-bool lsp-insert-final-newline) + :trim-final-newlines? (lsp-json-bool lsp-trim-final-newlines)))) + +(defun lsp-format-buffer () + "Ask the server to format this document." + (interactive "*") + (cond ((lsp-feature? "textDocument/formatting") + (let ((edits (lsp-request "textDocument/formatting" + (lsp--make-document-formatting-params)))) + (if (seq-empty-p edits) + (lsp--info "No formatting changes provided") + (lsp--apply-text-edits edits 'format)))) + ((lsp-feature? "textDocument/rangeFormatting") + (save-restriction + (widen) + (lsp-format-region (point-min) (point-max)))) + (t (signal 'lsp-capability-not-supported (list "documentFormattingProvider"))))) + +(defun lsp-format-region (s e) + "Ask the server to format the region, or if none is selected, the current line." + (interactive "r") + (let ((edits (lsp-request + "textDocument/rangeFormatting" + (lsp--make-document-range-formatting-params s e)))) + (if (seq-empty-p edits) + (lsp--info "No formatting changes provided") + (lsp--apply-text-edits edits 'format)))) + +(defmacro lsp-make-interactive-code-action (func-name code-action-kind) + "Define an interactive function FUNC-NAME that attempts to +execute a CODE-ACTION-KIND action." + `(defun ,(intern (concat "lsp-" (symbol-name func-name))) () + ,(format "Perform the %s code action, if available." code-action-kind) + (interactive) + ;; Even when `lsp-auto-execute-action' is nil, it still makes sense to + ;; auto-execute here: the user has specified exactly what they want. + (let ((lsp-auto-execute-action t)) + (condition-case nil + (lsp-execute-code-action-by-kind ,code-action-kind) + (lsp-no-code-actions + (when (called-interactively-p 'any) + (lsp--info ,(format "%s action not available" code-action-kind)))))))) + +(lsp-make-interactive-code-action organize-imports "source.organizeImports") + +(defun lsp--make-document-range-formatting-params (start end) + "Make DocumentRangeFormattingParams for selected region." + (lsp:set-document-range-formatting-params-range (lsp--make-document-formatting-params) + (lsp--region-to-range start end))) + +(defconst lsp--highlight-kind-face + '((1 . lsp-face-highlight-textual) + (2 . lsp-face-highlight-read) + (3 . lsp-face-highlight-write))) + +(defun lsp--remove-overlays (name) + (save-restriction + (widen) + (remove-overlays (point-min) (point-max) name t))) + +(defun lsp-document-highlight () + "Highlight all relevant references to the symbol under point." + (interactive) + (lsp--remove-overlays 'lsp-highlight) ;; clear any previous highlights + (setq lsp--have-document-highlights nil + lsp--symbol-bounds-of-last-highlight-invocation nil) + (let ((lsp-enable-symbol-highlighting t)) + (lsp--document-highlight))) + +(defun lsp--document-highlight-callback (highlights) + "Create a callback to process the reply of a +`textDocument/documentHighlight' message for the buffer BUF. +A reference is highlighted only if it is visible in a window." + (lsp--remove-overlays 'lsp-highlight) + + (let* ((wins-visible-pos (-map (lambda (win) + (cons (1- (line-number-at-pos (window-start win) t)) + (1+ (line-number-at-pos (window-end win) t)))) + (get-buffer-window-list nil nil 'visible)))) + (setq lsp--have-document-highlights t) + (-map + (-lambda ((&DocumentHighlight :range (&Range :start (start &as &Position :line start-line) + :end (end &as &Position :line end-line)) + :kind?)) + (-map + (-lambda ((start-window . end-window)) + ;; Make the overlay only if the reference is visible + (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 + :cancel-token :document-symbols) + lsp--document-symbols)))) + +(advice-add 'imenu-update-menubar :around + (lambda (oldfun &rest r) + (let ((lsp--document-symbols-request-async t)) + (apply oldfun r)))) + +(defun lsp--document-symbols->document-symbols-hierarchy (document-symbols current-position) + "Convert DOCUMENT-SYMBOLS to symbols hierarchy on CURRENT-POSITION." + (-let (((symbol &as &DocumentSymbol? :children?) + (seq-find (-lambda ((&DocumentSymbol :range)) + (lsp-point-in-range? current-position range)) + document-symbols))) + (if children? + (cons symbol (lsp--document-symbols->document-symbols-hierarchy children? current-position)) + (when symbol + (list symbol))))) + +(lsp-defun lsp--symbol-information->document-symbol ((&SymbolInformation :name :kind :location :container-name? :deprecated?)) + "Convert a SymbolInformation to a DocumentInformation" + (lsp-make-document-symbol :name name + :kind kind + :range (lsp:location-range location) + :children? nil + :deprecated? deprecated? + :selection-range (lsp:location-range location) + :detail? container-name?)) + +(defun lsp--symbols-informations->document-symbols-hierarchy (symbols-informations current-position) + "Convert SYMBOLS-INFORMATIONS to symbols hierarchy on CURRENT-POSITION." + (--> symbols-informations + (-keep (-lambda ((symbol &as &SymbolInformation :location (&Location :range))) + (when (lsp-point-in-range? current-position range) + (lsp--symbol-information->document-symbol symbol))) + it) + (sort it (-lambda ((&DocumentSymbol :range (&Range :start a-start-position :end a-end-position)) + (&DocumentSymbol :range (&Range :start b-start-position :end b-end-position))) + (and (lsp--position-compare b-start-position a-start-position) + (lsp--position-compare a-end-position b-end-position)))))) + +(defun lsp--symbols->document-symbols-hierarchy (symbols) + "Convert SYMBOLS to symbols-hierarchy." + (when-let ((first-symbol (lsp-seq-first symbols))) + (let ((cur-position (lsp-make-position :line (plist-get (lsp--cur-position) :line) + :character (plist-get (lsp--cur-position) :character)))) + (if (lsp-symbol-information? first-symbol) + (lsp--symbols-informations->document-symbols-hierarchy symbols cur-position) + (lsp--document-symbols->document-symbols-hierarchy symbols cur-position))))) + +(defun lsp--xref-backend () 'xref-lsp) + +(cl-defmethod xref-backend-identifier-at-point ((_backend (eql xref-lsp))) + (propertize (or (thing-at-point 'symbol) "") + 'identifier-at-point t)) + +(defun lsp--xref-elements-index (symbols path) + (-mapcat + (-lambda (sym) + (pcase-exhaustive sym + ((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 nil lsp-references-exclude-definition))))) + +(cl-defmethod xref-backend-apropos ((_backend (eql xref-lsp)) pattern) + (seq-map #'lsp--symbol-information-to-xref + (lsp-request "workspace/symbol" `(:query ,pattern)))) + +(defcustom lsp-rename-use-prepare t + "Whether `lsp-rename' should do a prepareRename first. +For some language servers, textDocument/prepareRename might be +too slow, in which case this variable may be set to nil. +`lsp-rename' will then use `thing-at-point' `symbol' to determine +the symbol to rename at point." + :group 'lsp-mode + :type 'boolean) + +(defun lsp--get-symbol-to-rename () + "Get a symbol to rename and placeholder at point. +Returns a cons ((START . END) . PLACEHOLDER?), and nil if +renaming is generally supported but cannot be done at point. +START and END are the bounds of the identifiers being renamed, +while PLACEHOLDER?, is either nil or a string suggested by the +language server as the initial input of a new-name prompt." + (unless (lsp-feature? "textDocument/rename") + (error "The connected server(s) doesn't support renaming")) + (if (and lsp-rename-use-prepare (lsp-feature? "textDocument/prepareRename")) + (when-let ((response + (lsp-request "textDocument/prepareRename" + (lsp--text-document-position-params)))) + (let* ((bounds (lsp--range-to-region + (if (lsp-range? response) + response + (lsp:prepare-rename-result-range response)))) + (placeholder + (and (not (lsp-range? response)) + (lsp:prepare-rename-result-placeholder response)))) + (cons bounds placeholder))) + (when-let ((bounds (bounds-of-thing-at-point 'symbol))) + (cons bounds nil)))) + +(defface lsp-face-rename '((t :underline t)) + "Face used to highlight the identifier being renamed. +Renaming can be done using `lsp-rename'." + :group 'lsp-mode) + +(defface lsp-rename-placeholder-face '((t :inherit font-lock-variable-name-face)) + "Face used to display the rename placeholder in. +When calling `lsp-rename' interactively, this will be the face of +the new name." + :group 'lsp-mode) + +(defvar lsp-rename-history '() + "History for `lsp--read-rename'.") + +(defun lsp--read-rename (at-point) + "Read a new name for a `lsp-rename' at `point' from the user. +AT-POINT shall be a structure as returned by +`lsp--get-symbol-to-rename'. + +Returns a string, which should be the new name for the identifier +at point. If renaming cannot be done at point (as determined from +AT-POINT), throw a `user-error'. + +This function is for use in `lsp-rename' only, and shall not be +relied upon." + (unless at-point + (user-error "`lsp-rename' is invalid here")) + (-let* ((((start . end) . placeholder?) at-point) + ;; Do the `buffer-substring' first to not include `lsp-face-rename' + (rename-me (buffer-substring start end)) + (placeholder (or placeholder? rename-me)) + (placeholder (propertize placeholder 'face 'lsp-rename-placeholder-face)) + + overlay) + ;; We need unwind protect, as the user might cancel here, causing the + ;; overlay to linger. + (unwind-protect + (progn + (setq overlay (make-overlay start end)) + (overlay-put overlay 'face 'lsp-face-rename) + + (read-string (format "Rename %s to: " rename-me) placeholder + 'lsp-rename-history)) + (and overlay (delete-overlay overlay))))) + +(defun lsp-rename (newname) + "Rename the symbol (and all references to it) under point to NEWNAME." + (interactive (list (lsp--read-rename (lsp--get-symbol-to-rename)))) + (when-let ((edits (lsp-request "textDocument/rename" + `( :textDocument ,(lsp--text-document-identifier) + :position ,(lsp--cur-position) + :newName ,newname)))) + (lsp--apply-workspace-edit edits 'rename))) + +(defun lsp--on-rename-file (old-func old-name new-name &optional ok-if-already-exists?) + "Advice around function `rename-file'. +Applies OLD-FUNC with OLD-NAME, NEW-NAME and OK-IF-ALREADY-EXISTS?. + +This advice sends workspace/willRenameFiles before renaming file +to check if server wants to apply any workspaceEdits after renamed." + (if (and lsp-apply-edits-after-file-operations + (lsp--send-will-rename-files-p old-name)) + (let ((params (lsp-make-rename-files-params + :files (vector (lsp-make-file-rename + :oldUri (lsp--path-to-uri old-name) + :newUri (lsp--path-to-uri new-name)))))) + (when-let ((edits (lsp-request "workspace/willRenameFiles" params))) + (lsp--apply-workspace-edit edits 'rename-file) + (funcall old-func old-name new-name ok-if-already-exists?) + (when (lsp--send-did-rename-files-p) + (lsp-notify "workspace/didRenameFiles" params)))) + (funcall old-func old-name new-name ok-if-already-exists?))) + +(advice-add 'rename-file :around #'lsp--on-rename-file) + +(defcustom lsp-xref-force-references nil + "If non-nil threat everything as references(e. g. jump if only one item.)" + :group 'lsp-mode + :type 'boolean) + +(defun lsp-show-xrefs (xrefs display-action references?) + (unless (region-active-p) (push-mark nil t)) + (if (boundp 'xref-show-definitions-function) + (with-no-warnings + (xref-push-marker-stack) + (funcall (if (and references? (not lsp-xref-force-references)) + xref-show-xrefs-function + xref-show-definitions-function) + (-const xrefs) + `((window . ,(selected-window)) + (display-action . ,display-action) + ,(if (and references? (not lsp-xref-force-references)) + `(auto-jump . ,xref-auto-jump-to-first-xref) + `(auto-jump . ,xref-auto-jump-to-first-definition))))) + (xref--show-xrefs xrefs display-action))) + +(cl-defmethod seq-empty-p ((ht hash-table)) + "Function `seq-empty-p' for hash-table." + (hash-table-empty-p ht)) + +(cl-defun lsp-find-locations (method &optional extra &key display-action references?) + "Send request named METHOD and get cross references of the symbol under point. +EXTRA is a plist of extra parameters. +REFERENCES? t when METHOD returns references." + (let ((loc (lsp-request method + (append (lsp--text-document-position-params) extra)))) + (if (seq-empty-p loc) + (lsp--error "Not found for: %s" (or (thing-at-point 'symbol t) "")) + (lsp-show-xrefs (lsp--locations-to-xref-items loc) display-action references?)))) + +(cl-defun lsp-find-declaration (&key display-action) + "Find declarations of the symbol under point." + (interactive) + (lsp-find-locations "textDocument/declaration" nil :display-action display-action)) + +(cl-defun lsp-find-definition (&key display-action) + "Find definitions of the symbol under point." + (interactive) + (lsp-find-locations "textDocument/definition" nil :display-action display-action)) + +(defun lsp-find-definition-mouse (click) + "Click to start `lsp-find-definition' at clicked point." + (interactive "e") + (let* ((ec (event-start click)) + (p1 (posn-point ec)) + (w1 (posn-window ec))) + (select-window w1) + (goto-char p1) + (lsp-find-definition))) + +(cl-defun lsp-find-implementation (&key display-action) + "Find implementations of the symbol under point." + (interactive) + (lsp-find-locations "textDocument/implementation" + nil + :display-action display-action + :references? t)) + +(cl-defun lsp-find-references (&optional exclude-declaration &key display-action) + "Find references of the symbol under point." + (interactive "P") + (lsp-find-locations "textDocument/references" + (list :context `(:includeDeclaration ,(lsp-json-bool (not (or exclude-declaration lsp-references-exclude-definition))))) + :display-action display-action + :references? t)) + +(cl-defun lsp-find-type-definition (&key display-action) + "Find type definitions of the symbol under point." + (interactive) + (lsp-find-locations "textDocument/typeDefinition" nil :display-action display-action)) + +(defalias 'lsp-find-custom #'lsp-find-locations) +(defalias 'lsp-goto-implementation #'lsp-find-implementation) +(defalias 'lsp-goto-type-definition #'lsp-find-type-definition) + +(with-eval-after-load 'evil + (evil-set-command-property 'lsp-find-definition :jump t) + (evil-set-command-property 'lsp-find-implementation :jump t) + (evil-set-command-property 'lsp-find-references :jump t) + (evil-set-command-property 'lsp-find-type-definition :jump t)) + +(defun lsp--workspace-method-supported? (check-command method capability workspace) + (with-lsp-workspace workspace + (if check-command + (funcall check-command workspace) + (or + (when capability (lsp--capability capability)) + (lsp--registered-capability method) + (and (not capability) (not check-command)))))) + +(defun lsp-disable-method-for-server (method server-id) + "Disable METHOD for SERVER-ID." + (cl-callf + (lambda (reqs) + (-let (((&plist :check-command :capability) reqs)) + (list :check-command + (lambda (workspace) + (unless (-> workspace + lsp--workspace-client + lsp--client-server-id + (eq server-id)) + (lsp--workspace-method-supported? check-command + method + capability + workspace)))))) + (alist-get method lsp-method-requirements nil nil 'string=))) + +(defun lsp--find-workspaces-for (msg-or-method) + "Find all workspaces in the current project that can handle MSG." + (let ((method (if (stringp msg-or-method) + msg-or-method + (plist-get msg-or-method :method)))) + (-if-let (reqs (cdr (assoc method lsp-method-requirements))) + (-let (((&plist :capability :check-command) reqs)) + (-filter + (-partial #'lsp--workspace-method-supported? + check-command method capability) + (lsp-workspaces))) + (lsp-workspaces)))) + +(defun lsp-can-execute-command? (command-name) + "Returns non-nil if current language server(s) can execute COMMAND-NAME. +The command is executed via `workspace/executeCommand'" + (cl-position + command-name + (lsp:execute-command-options-commands + (lsp:server-capabilities-execute-command-provider? + (lsp--server-capabilities))) + :test #'equal)) + +(defalias 'lsp-feature? 'lsp--find-workspaces-for) + +(cl-defmethod lsp-execute-command (_server _command _arguments) + "Dispatch COMMAND execution." + (signal 'cl-no-applicable-method nil)) + +(defun lsp-workspace-command-execute (command &optional args) + "Execute workspace COMMAND with ARGS." + (condition-case-unless-debug err + (let ((params (if args + (list :command command :arguments args) + (list :command command)))) + (lsp-request "workspace/executeCommand" params)) + (error + (error "`workspace/executeCommand' with `%s' failed.\n\n%S" + command err)))) + +(defun lsp-send-execute-command (command &optional args) + "Create and send a `workspace/executeCommand' message having command COMMAND +and optional ARGS." + (lsp-workspace-command-execute command args)) + +(defalias 'lsp-point-to-position #'lsp--point-to-position) +(defalias 'lsp-text-document-identifier #'lsp--text-document-identifier) +(defalias 'lsp--send-execute-command #'lsp-send-execute-command) +(defalias 'lsp-on-open #'lsp--text-document-did-open) +(defalias 'lsp-on-save #'lsp--text-document-did-save) + +(defun lsp--set-configuration (settings) + "Set the SETTINGS for the lsp server." + (lsp-notify "workspace/didChangeConfiguration" `(:settings ,settings))) + +(defun lsp-current-buffer () + (or lsp--virtual-buffer + (current-buffer))) + +(defun lsp-buffer-live-p (buffer-id) + (if-let ((buffer-live (plist-get buffer-id :buffer-live?))) + (funcall buffer-live buffer-id) + (buffer-live-p buffer-id))) + +(defun lsp--on-set-visited-file-name (old-func &rest args) + "Advice around function `set-visited-file-name'. + +This advice sends textDocument/didClose for the old file and +textDocument/didOpen for the new file." + (when lsp--cur-workspace + (lsp--text-document-did-close t)) + (prog1 (apply old-func args) + (when lsp--cur-workspace + (lsp--text-document-did-open)))) + +(advice-add 'set-visited-file-name :around #'lsp--on-set-visited-file-name) + +(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))) + (lsp-process-send proc message)) + +(define-error 'lsp-parse-error + "Error parsing message from language server" 'lsp-error) +(define-error 'lsp-unknown-message-type + "Unknown message type" '(lsp-error lsp-parse-error)) +(define-error 'lsp-unknown-json-rpc-version + "Unknown JSON-RPC protocol version" '(lsp-error lsp-parse-error)) +(define-error 'lsp-no-content-length + "Content-Length header missing in message" '(lsp-error lsp-parse-error)) +(define-error 'lsp-invalid-header-name + "Invalid header name" '(lsp-error lsp-parse-error)) + +;; id method +;; x x request +;; x . response +;; . x notification +(defun lsp--get-message-type (json-data) + "Get the message type from JSON-DATA." + (if (lsp:json-message-id? json-data) + (if (lsp:json-message-error? json-data) + 'response-error + (if (lsp:json-message-method? json-data) + 'request + 'response)) + 'notification)) + +(defconst lsp--default-notification-handlers + (ht ("window/showMessage" #'lsp--window-show-message) + ("window/logMessage" #'lsp--window-log-message) + ("window/showInputBox" #'lsp--window-show-input-box) + ("window/showQuickPick" #'lsp--window-show-quick-pick) + ("textDocument/publishDiagnostics" #'lsp--on-diagnostics) + ("textDocument/diagnosticsEnd" #'ignore) + ("textDocument/diagnosticsBegin" #'ignore) + ("telemetry/event" #'ignore) + ("$/progress" (lambda (workspace params) + (funcall lsp-progress-function workspace params))))) + +(lsp-defun lsp--on-notification (workspace (&JSONNotification :params :method)) + "Call the appropriate handler for NOTIFICATION." + (-let ((client (lsp--workspace-client workspace))) + (when (lsp--log-io-p method) + (lsp--log-entry-new (lsp--make-log-entry method nil params 'incoming-notif) + lsp--cur-workspace)) + (if-let ((handler (or (gethash method (lsp--client-notification-handlers client)) + (gethash method lsp--default-notification-handlers)))) + (funcall handler workspace params) + (when (and method (not (string-prefix-p "$" method))) + (lsp-warn "Unknown notification: %s" method))))) + +(lsp-defun lsp--build-workspace-configuration-response ((&ConfigurationParams :items)) + "Get section configuration. +PARAMS are the `workspace/configuration' request params" + (->> items + (-map (-lambda ((&ConfigurationItem :section?)) + (-let* ((path-parts (split-string section? "\\.")) + (path-without-last (s-join "." (-slice path-parts 0 -1))) + (path-parts-len (length path-parts))) + (cond + ((<= path-parts-len 1) + (ht-get (lsp-configuration-section section?) + (car-safe path-parts) + (ht-create))) + ((> path-parts-len 1) + (when-let ((section (lsp-configuration-section path-without-last)) + (keys path-parts)) + (while (and keys section) + (setf section (ht-get section (pop keys)))) + section)))))) + (apply #'vector))) + +(defun lsp--ms-since (timestamp) + "Integer number of milliseconds since TIMESTAMP. Fractions discarded." + (floor (* 1000 (float-time (time-since timestamp))))) + +(defun lsp--send-request-response (workspace recv-time request response) + "Send the RESPONSE for REQUEST in WORKSPACE and log if needed." + (-let* (((&JSONResponse :params :method :id) request) + (process (lsp--workspace-proc workspace)) + (response (lsp--make-response id response)) + (req-entry (and lsp-log-io + (lsp--make-log-entry method id params 'incoming-req))) + (resp-entry (and lsp-log-io + (lsp--make-log-entry method id response 'outgoing-resp + (lsp--ms-since recv-time))))) + ;; Send response to the server. + (when (lsp--log-io-p method) + (lsp--log-entry-new req-entry workspace) + (lsp--log-entry-new resp-entry workspace)) + (lsp--send-no-wait response process))) + +(lsp-defun lsp--on-request (workspace (request &as &JSONRequest :params :method)) + "Call the appropriate handler for REQUEST, and send the return value to the +server. WORKSPACE is the active workspace." + (-let* ((recv-time (current-time)) + (client (lsp--workspace-client workspace)) + (buffers (lsp--workspace-buffers workspace)) + handler + (response (cond + ((setq handler (gethash method (lsp--client-request-handlers client) nil)) + (funcall handler workspace params)) + ((setq handler (gethash method (lsp--client-async-request-handlers client) nil)) + (funcall handler workspace params + (-partial #'lsp--send-request-response + workspace recv-time request)) + 'delay-response) + ((equal method "client/registerCapability") + (mapc #'lsp--server-register-capability + (lsp:registration-params-registrations params)) + (mapc (lambda (buf) + (when (lsp-buffer-live-p buf) + (lsp-with-current-buffer buf + (lsp-unconfig-buffer) + (lsp-configure-buffer)))) + buffers) + nil) + ((equal method "window/showMessageRequest") + (let ((choice (lsp--window-log-message-request params))) + `(:title ,choice))) + ((equal method "window/showDocument") + (let ((success? (lsp--window-show-document params))) + (lsp-make-show-document-result :success (or success? + :json-false)))) + ((equal method "client/unregisterCapability") + (mapc #'lsp--server-unregister-capability + (lsp:unregistration-params-unregisterations params)) + (mapc (lambda (buf) + (when (lsp-buffer-live-p buf) + (lsp-with-current-buffer buf + (lsp-unconfig-buffer) + (lsp-configure-buffer)))) + buffers) + nil) + ((equal method "workspace/applyEdit") + (list :applied (condition-case err + (prog1 t + (lsp--apply-workspace-edit (lsp:apply-workspace-edit-params-edit params) 'server-requested)) + (error + (lsp--error "Failed to apply edits with message %s" + (error-message-string err)) + :json-false)))) + ((equal method "workspace/configuration") + (with-lsp-workspace workspace + (if-let ((buf (car buffers))) + (lsp-with-current-buffer buf + (lsp--build-workspace-configuration-response params)) + (lsp--with-workspace-temp-buffer (lsp--workspace-root workspace) + (lsp--build-workspace-configuration-response params))))) + ((equal method "workspace/workspaceFolders") + (let ((folders (or (-> workspace + (lsp--workspace-client) + (lsp--client-server-id) + (gethash (lsp-session-server-id->folders (lsp-session)))) + (lsp-session-folders (lsp-session))))) + (->> folders + (-distinct) + (-map (lambda (folder) + (list :uri (lsp--path-to-uri folder)))) + (apply #'vector)))) + ((equal method "window/workDoneProgress/create") + nil ;; no specific reply, no processing required + ) + ((equal method "workspace/semanticTokens/refresh") + (when (and lsp-semantic-tokens-enable + (fboundp 'lsp--semantic-tokens-on-refresh)) + (lsp--semantic-tokens-on-refresh workspace)) + nil) + ((equal method "workspace/codeLens/refresh") + (when (and lsp-lens-enable + (fboundp 'lsp--lens-on-refresh)) + (lsp--lens-on-refresh workspace)) + nil) + (t (lsp-warn "Unknown request method: %s" method) nil)))) + ;; Send response to the server. + (unless (eq response 'delay-response) + (lsp--send-request-response workspace recv-time request response)))) + +(lsp-defun lsp--error-string ((&JSONError :message :code)) + "Format ERR as a user friendly string." + (format "Error from the Language Server: %s (%s)" + message + (or (car (alist-get code lsp--errors)) "Unknown error"))) + +(defun lsp--get-body-length (headers) + (let ((content-length (cdr (assoc "Content-Length" headers)))) + (if content-length + (string-to-number content-length) + + ;; This usually means either the server or our parser is + ;; screwed up with a previous Content-Length + (error "No Content-Length header")))) + +(defun lsp--parse-header (s) + "Parse string S as a LSP (KEY . VAL) header." + (let ((pos (string-match "\:" s)) + key val) + (unless pos + (signal 'lsp-invalid-header-name (list s))) + (setq key (substring s 0 pos) + val (s-trim-left (substring s (+ 1 pos)))) + (when (equal key "Content-Length") + (cl-assert (cl-loop for c across val + when (or (> c ?9) (< c ?0)) return nil + finally return t) + nil (format "Invalid Content-Length value: %s" val))) + (cons key val))) + +(defmacro lsp--read-json (str) + "Read json string STR." + (if (progn + (require 'json) + (fboundp 'json-parse-string)) + `(json-parse-string ,str + :object-type (if lsp-use-plists + 'plist + 'hash-table) + :null-object nil + :false-object nil) + `(let ((json-array-type 'vector) + (json-object-type (if lsp-use-plists + 'plist + 'hash-table)) + (json-false nil)) + (json-read-from-string ,str)))) + +(defmacro lsp-json-read-buffer () + "Read json from the current buffer." + (if (progn + (require 'json) + (fboundp 'json-parse-buffer)) + `(json-parse-buffer :object-type (if lsp-use-plists + 'plist + 'hash-table) + :null-object nil + :false-object nil) + `(let ((json-array-type 'vector) + (json-object-type (if lsp-use-plists + 'plist + 'hash-table)) + (json-false nil)) + (json-read)))) + +(defun lsp--read-json-file (file-path) + "Read json file." + (-> file-path + (f-read-text) + (lsp--read-json))) + +(defun lsp--parser-on-message (json-data workspace) + "Called when the parser P read a complete MSG from the server." + (with-demoted-errors "Error processing message %S." + (with-lsp-workspace workspace + (let* ((client (lsp--workspace-client workspace)) + (id (--when-let (lsp:json-response-id json-data) + (if (stringp it) (string-to-number it) it))) + (data (lsp:json-response-result json-data))) + (pcase (lsp--get-message-type json-data) + ('response + (cl-assert id) + (-let [(callback _ method _ before-send) (gethash id (lsp--client-response-handlers client))] + (when (lsp--log-io-p method) + (lsp--log-entry-new + (lsp--make-log-entry method id data 'incoming-resp + (lsp--ms-since before-send)) + workspace)) + (when callback + (remhash id (lsp--client-response-handlers client)) + (funcall callback (lsp:json-response-result json-data))))) + ('response-error + (cl-assert id) + (-let [(_ callback method _ before-send) (gethash id (lsp--client-response-handlers client))] + (when (lsp--log-io-p method) + (lsp--log-entry-new + (lsp--make-log-entry method id (lsp:json-response-error-error json-data) + 'incoming-resp (lsp--ms-since before-send)) + workspace)) + (when callback + (remhash id (lsp--client-response-handlers client)) + (funcall callback (lsp:json-response-error-error json-data))))) + ('notification + (lsp--on-notification workspace json-data)) + ('request (lsp--on-request workspace json-data))))))) + +(defun lsp--create-filter-function (workspace) + "Make filter for the workspace." + (let ((body-received 0) + leftovers body-length body chunk) + (lambda (_proc input) + (setf chunk (if (s-blank? leftovers) + 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) + +(defcustom lsp-imenu-hide-parent-details t + "Whether `lsp-imenu' should hide signatures of parent nodes." + :group 'lsp-imenu + :type 'boolean) + +(defface lsp-details-face '((t :height 0.8 :inherit shadow)) + "Used to display additional information throughout `lsp'. +Things like line numbers, signatures, ... are considered +additional information. Often, additional faces are defined that +inherit from this face by default, like `lsp-signature-face', and +they may be customized for finer control." + :group 'lsp-mode) + +(defface lsp-signature-face '((t :inherit lsp-details-face)) + "Used to display signatures in `imenu', ...." + :group 'lsp-mode) + +(lsp-defun lsp-render-symbol ((&DocumentSymbol :name :detail? :deprecated?) + show-detail?) + "Render INPUT0, an `&DocumentSymbol', to a string. +If SHOW-DETAIL? is set, make use of its `:detail?' field (often +the signature)." + (let ((detail (and show-detail? (s-present? detail?) + (propertize (concat " " (s-trim-left detail?)) + 'face 'lsp-signature-face))) + (name (if deprecated? + (propertize name 'face 'lsp-face-semhl-deprecated) name))) + (concat name detail))) + +(lsp-defun lsp-render-symbol-information ((&SymbolInformation :name :deprecated? :container-name?) + separator) + "Render a piece of SymbolInformation. +Handle :deprecated?. If SEPARATOR is non-nil, the +symbol's (optional) parent, SEPARATOR and the symbol itself are +concatenated." + (when (and separator container-name? (not (string-empty-p container-name?))) + (setq name (concat name separator container-name?))) + (if deprecated? (propertize name 'face 'lsp-face-semhl-deprecated) name)) + +(defun lsp--symbol-to-imenu-elem (sym) + "Convert SYM to imenu element. + +SYM is a SymbolInformation message. + +Return a cons cell (full-name . start-point)." + (let ((start-point (ht-get lsp--line-col-to-point-hash-table + (lsp--get-line-and-col sym)))) + (cons (lsp-render-symbol-information + sym (and lsp-imenu-show-container-name + lsp-imenu-container-name-separator)) + start-point))) + +(lsp-defun lsp--symbol-to-hierarchical-imenu-elem ((sym &as &DocumentSymbol :children?)) + "Convert SYM to hierarchical imenu elements. + +SYM is a DocumentSymbol message. + +Return cons cell (\"symbol-name (symbol-kind)\" . start-point) if +SYM doesn't have any children. Otherwise return a cons cell with +an alist + + (\"symbol-name\" . ((\"(symbol-kind)\" . start-point) + cons-cells-from-children))" + (let ((filtered-children (lsp--imenu-filter-symbols children?)) + (signature (lsp-render-symbol sym lsp-imenu-detailed-outline))) + (if (seq-empty-p filtered-children) + (cons signature + (ht-get lsp--line-col-to-point-hash-table + (lsp--get-line-and-col sym))) + (cons signature + (lsp--imenu-create-hierarchical-index filtered-children))))) + +(lsp-defun lsp--symbol-ignore ((&SymbolInformation :kind)) + "Determine if SYM is for the current document and is to be shown." + ;; It's a SymbolInformation or DocumentSymbol, which is always in the + ;; current buffer file. + (and lsp-imenu-index-symbol-kinds + (numberp kind) + (let ((clamped-kind (if (< 0 kind (length lsp/symbol-kind-lookup)) + kind + 0))) + (not (memql (aref lsp/symbol-kind-lookup clamped-kind) + lsp-imenu-index-symbol-kinds))))) + +(lsp-defun lsp--get-symbol-type ((&SymbolInformation :kind)) + "The string name of the kind of SYM." + (alist-get kind lsp-symbol-kinds "Other")) + +(defun lsp--get-line-and-col (sym) + "Obtain the line and column corresponding to SYM." + (-let* ((location (lsp:symbol-information-location sym)) + (name-range (or (and location (lsp:location-range location)) + (lsp:document-symbol-selection-range sym))) + ((&Range :start (&Position :line :character)) name-range)) + (cons line character))) + +(defun lsp--collect-lines-and-cols (symbols) + "Return a sorted list ((line . col) ...) of the locations of SYMBOLS." + (let ((stack (mapcar 'identity symbols)) + line-col-list) + (while stack + (let ((sym (pop stack))) + (push (lsp--get-line-and-col sym) line-col-list) + (unless (seq-empty-p (lsp:document-symbol-children? sym)) + (setf stack (nconc (lsp--imenu-filter-symbols (lsp:document-symbol-children? sym)) stack))))) + (-sort #'lsp--line-col-comparator line-col-list))) + +(defun lsp--convert-line-col-to-points-batch (line-col-list) + "Convert a sorted list of positions from line-column +representation to point representation." + (let ((line-col-to-point-map (ht-create)) + (inhibit-field-text-motion t) + (curr-line 0)) + (lsp-save-restriction-and-excursion + (goto-char (point-min)) + (cl-loop for (line . col) in line-col-list do + (forward-line (- line curr-line)) + (setq curr-line line) + (let ((line-end (line-end-position))) + (if (or (not col) (> col (- line-end (point)))) + (goto-char line-end) + (forward-char col))) + (ht-set! line-col-to-point-map (cons line col) (if imenu-use-markers + (point-marker) + (point))))) + line-col-to-point-map)) + +(cl-defun lsp--line-col-comparator ((l1 . c1) (l2 . c2)) + (or (< l1 l2) + (and (= l1 l2) + (cond ((and c1 c2) + (< c1 c2)) + (c1 t))))) + +(defun lsp-imenu-create-uncategorized-index (symbols) + "Create imenu index from document SYMBOLS. +This function, unlike `lsp-imenu-create-categorized-index', does +not categorize by type, but instead returns an `imenu' index +corresponding to the symbol hierarchy returned by the server +directly." + (let* ((lsp--line-col-to-point-hash-table (-> symbols + lsp--collect-lines-and-cols + lsp--convert-line-col-to-points-batch))) + (if (lsp--imenu-hierarchical-p symbols) + (lsp--imenu-create-hierarchical-index symbols) + (lsp--imenu-create-non-hierarchical-index symbols)))) + +(defcustom lsp-imenu-symbol-kinds + '((1 . "Files") + (2 . "Modules") + (3 . "Namespaces") + (4 . "Packages") + (5 . "Classes") + (6 . "Methods") + (7 . "Properties") + (8 . "Fields") + (9 . "Constructors") + (10 . "Enums") + (11 . "Interfaces") + (12 . "Functions") + (13 . "Variables") + (14 . "Constants") + (15 . "Strings") + (16 . "Numbers") + (17 . "Booleans") + (18 . "Arrays") + (19 . "Objects") + (20 . "Keys") + (21 . "Nulls") + (22 . "Enum Members") + (23 . "Structs") + (24 . "Events") + (25 . "Operators") + (26 . "Type Parameters")) + "`lsp-symbol-kinds', but only used by `imenu'. +A new variable is needed, as it is `imenu' convention to use +pluralized categories, which `lsp-symbol-kinds' doesn't. If the +non-pluralized names are preferred, this can be set to +`lsp-symbol-kinds'." + :type '(alist :key-type integer :value-type string)) + +(defun lsp--imenu-kind->name (kind) + (alist-get kind lsp-imenu-symbol-kinds "?")) + +(defun lsp-imenu-create-top-level-categorized-index (symbols) + "Create an `imenu' index categorizing SYMBOLS by type. +Only root symbols are categorized. + +See `lsp-symbol-kinds' to customize the category naming. SYMBOLS +shall be a list of DocumentSymbols or SymbolInformation." + (mapcan + (-lambda ((type . symbols)) + (let ((cat (lsp--imenu-kind->name type)) + (symbols (lsp-imenu-create-uncategorized-index symbols))) + ;; If there is no :kind (this is being defensive), or we couldn't look it + ;; up, just display the symbols inline, without categories. + (if cat (list (cons cat symbols)) symbols))) + (sort (seq-group-by #'lsp:document-symbol-kind symbols) + (-lambda ((kinda) (kindb)) (< kinda kindb))))) + +(lsp-defun lsp--symbol->imenu ((sym &as &DocumentSymbol :selection-range (&RangeToPoint :start))) + "Convert an `&DocumentSymbol' to an `imenu' entry." + (cons (lsp-render-symbol sym lsp-imenu-detailed-outline) start)) + +(defun lsp--imenu-create-categorized-index-1 (symbols) + "Returns an `imenu' index from SYMBOLS categorized by type. +The result looks like this: ((\"Variables\" . (...)))." + (->> + symbols + (mapcan + (-lambda ((sym &as &DocumentSymbol :kind :children?)) + (if (seq-empty-p children?) + (list (list kind (lsp--symbol->imenu sym))) + (let ((parent (lsp-render-symbol sym (and lsp-imenu-detailed-outline + (not lsp-imenu-hide-parent-details))))) + (cons + (list kind (lsp--symbol->imenu sym)) + (mapcar (-lambda ((type . imenu-items)) + (list type (cons parent (mapcan #'cdr imenu-items)))) + (-group-by #'car (lsp--imenu-create-categorized-index-1 children?)))))))) + (-group-by #'car) + (mapcar + (-lambda ((kind . syms)) + (cons kind (mapcan #'cdr syms)))))) + +(defun lsp--imenu-create-categorized-index (symbols) + (let ((syms (lsp--imenu-create-categorized-index-1 symbols))) + (dolist (sym syms) + (setcar sym (lsp--imenu-kind->name (car sym)))) + syms)) + +(lsp-defun lsp--symbol-information->imenu ((sym &as &SymbolInformation :location (&Location :range (&RangeToPoint :start)))) + (cons (lsp-render-symbol-information sym nil) start)) + +(defun lsp--imenu-create-categorized-index-flat (symbols) + "Create a kind-categorized index for SymbolInformation." + (mapcar (-lambda ((kind . syms)) + (cons (lsp--imenu-kind->name kind) + (mapcan (-lambda ((parent . children)) + (let ((children (mapcar #'lsp--symbol-information->imenu children))) + (if parent (list (cons parent children)) children))) + (-group-by #'lsp:symbol-information-container-name? syms)))) + (seq-group-by #'lsp:symbol-information-kind symbols))) + +(defun lsp-imenu-create-categorized-index (symbols) + (if (lsp--imenu-hierarchical-p symbols) + (lsp--imenu-create-categorized-index symbols) + (lsp--imenu-create-categorized-index-flat symbols))) + +(defcustom lsp-imenu-index-function #'lsp-imenu-create-uncategorized-index + "Function that should create an `imenu' index. +It will be called with a list of SymbolInformation or +DocumentSymbols, whose first level is already filtered. It shall +then return an appropriate `imenu' index (see +`imenu-create-index-function'). + +Note that this interface is not stable, and subject to change any +time." + :group 'lsp-imenu + :type '(radio + (const :tag "Categorize by type" + lsp-imenu-create-categorized-index) + (const :tag "Categorize root symbols by type" + lsp-imenu-create-top-level-categorized-index) + (const :tag "Uncategorized, inline entries" + lsp-imenu-create-uncategorized-index) + (function :tag "Custom function"))) + +(defun lsp--imenu-create-index () + "Create an `imenu' index based on the language server. +Respects `lsp-imenu-index-function'." + (let ((symbols (lsp--imenu-filter-symbols (lsp--get-document-symbols)))) + (funcall lsp-imenu-index-function symbols))) + +(defun lsp--imenu-filter-symbols (symbols) + "Filter out unsupported symbols from SYMBOLS." + (seq-remove #'lsp--symbol-ignore symbols)) + +(defun lsp--imenu-hierarchical-p (symbols) + "Determine whether any element in SYMBOLS has children." + (seq-some #'lsp-document-symbol? symbols)) + +(defun lsp--imenu-create-non-hierarchical-index (symbols) + "Create imenu index for non-hierarchical SYMBOLS. + +SYMBOLS are a list of DocumentSymbol messages. + +Return a nested alist keyed by symbol names. e.g. + + ((\"SomeClass\" (\"(Class)\" . 10) + (\"someField (Field)\" . 20) + (\"someFunction (Function)\" . 25) + (\"SomeSubClass\" (\"(Class)\" . 30) + (\"someSubField (Field)\" . 35)) + (\"someFunction (Function)\" . 40))" + (seq-map (lambda (nested-alist) + (cons (car nested-alist) + (seq-map #'lsp--symbol-to-imenu-elem (cdr nested-alist)))) + (seq-group-by #'lsp--get-symbol-type symbols))) + +(defun lsp--imenu-create-hierarchical-index (symbols) + "Create imenu index for hierarchical SYMBOLS. + +SYMBOLS are a list of DocumentSymbol messages. + +Return a nested alist keyed by symbol names. e.g. + + ((\"SomeClass\" (\"(Class)\" . 10) + (\"someField (Field)\" . 20) + (\"someFunction (Function)\" . 25) + (\"SomeSubClass\" (\"(Class)\" . 30) + (\"someSubField (Field)\" . 35)) + (\"someFunction (Function)\" . 40))" + (seq-map #'lsp--symbol-to-hierarchical-imenu-elem + (seq-sort #'lsp--imenu-symbol-lessp symbols))) + +(defun lsp--imenu-symbol-lessp (sym1 sym2) + (let* ((compare-results (mapcar (lambda (method) + (funcall (alist-get method lsp--imenu-compare-function-alist) + sym1 sym2)) + lsp-imenu-sort-methods)) + (result (seq-find (lambda (result) + (not (= result 0))) + compare-results + 0))) + (and (numberp result) (< result 0)))) + +(lsp-defun lsp--imenu-compare-kind ((&SymbolInformation :kind left) + (&SymbolInformation :kind right)) + "Compare SYM1 and SYM2 by kind." + (- left right)) + +(defun lsp--imenu-compare-line-col (sym1 sym2) + (if (lsp--line-col-comparator + (lsp--get-line-and-col sym1) + (lsp--get-line-and-col sym2)) + -1 + 1)) + +(lsp-defun lsp--imenu-compare-name ((&SymbolInformation :name name1) + (&SymbolInformation :name name2)) + "Compare SYM1 and SYM2 by name." + (let ((result (compare-strings name1 0 (length name1) name2 0 (length name2)))) + (if (numberp result) result 0))) + +(defun lsp--imenu-refresh () + "Force Imenu to refresh itself." + (imenu--menubar-select imenu--rescan-item)) + +(defun lsp-enable-imenu () + "Use lsp-imenu for the current buffer." + (imenu--cleanup) + (add-function :override (local 'imenu-create-index-function) #'lsp--imenu-create-index) + (setq-local imenu-menubar-modified-tick -1) + (setq-local imenu--index-alist nil) + (when menu-bar-mode + (lsp--imenu-refresh))) + +(defun lsp-resolve-final-command (command &optional test?) + "Resolve final function COMMAND." + (let* ((command (lsp-resolve-value command)) + (command (cl-etypecase command + (list + (cl-assert (seq-every-p (apply-partially #'stringp) command) nil + "Invalid command list") + command) + (string (list command))))) + (if (and (file-remote-p default-directory) (not test?)) + (list shell-file-name "-c" + (string-join (cons "stty raw > /dev/null;" + (mapcar #'shell-quote-argument command)) + " ")) + command))) + +(defun lsp-server-present? (final-command) + "Check whether FINAL-COMMAND is present." + (let ((binary-found? (executable-find (cl-first final-command) t))) + (if binary-found? + (lsp-log "Command \"%s\" is present on the path." (s-join " " final-command)) + (lsp-log "Command \"%s\" is not present on the path." (s-join " " final-command))) + binary-found?)) + +(defun lsp--value-to-string (value) + "Convert VALUE to a string that can be set as value in an environment +variable." + (cond + ((stringp value) value) + ((booleanp value) (if value + "1" + "0")) + ((and (sequencep value) + (seq-every-p #'stringp value)) (string-join value ":")) + (t (user-error "Only strings, booleans, and sequences of strings are supported as environment variables")))) + +(defun lsp--compute-process-environment (environment-fn) + "Append a list of KEY=VALUE from the alist ENVIRONMENT to `process-environment'. +Ignore non-boolean keys whose value is nil." + (let ((environment (if environment-fn + (funcall environment-fn) + nil))) + (-flatten (cons (cl-loop for (key . value) in environment + if (or (eval value) + (eq (get value 'custom-type) 'boolean)) + collect (concat key "=" (lsp--value-to-string + (eval value)))) + process-environment)))) + +(defun lsp--default-directory-for-connection (&optional path) + "Return path to be used for the working directory of a LSP process. + +If `lsp-use-workspace-root-for-server-default-directory' is +non-nil, uses `lsp-workspace-root' to find the directory +corresponding to PATH, else returns `default-directory'." + (if lsp-use-workspace-root-for-server-default-directory + (lsp-workspace-root path) + default-directory)) + +(defun lsp--fix-remote-cmd (program) + "Helper for `lsp-stdio-connection'. +Originally coppied from eglot." + + (if (file-remote-p default-directory) + (list shell-file-name "-c" + (string-join (cons "stty raw > /dev/null;" + (mapcar #'shell-quote-argument program)) + " ")) + program)) + +(defvar tramp-use-ssh-controlmaster-options) +(defvar tramp-ssh-controlmaster-options) + +(defun lsp-stdio-connection (command &optional test-command) + "Returns a connection property list using COMMAND. +COMMAND can be: A string, denoting the command to launch the +language server. A list of strings, denoting an executable with +its command line arguments. A function, that either returns a +string or a list of strings. In all cases, the launched language +server should send and receive messages on standard I/O. +TEST-COMMAND is a function with no arguments which returns +whether the command is present or not. When not specified +`lsp-mode' will check whether the first element of the list +returned by COMMAND is available via `executable-find'" + (cl-check-type command (or string + function + (and list + (satisfies (lambda (l) + (seq-every-p (lambda (el) + (stringp el)) + l)))))) + (list :connect (lambda (filter sentinel name environment-fn workspace) + (if (and (functionp 'json-rpc-connection) + (not (file-remote-p default-directory))) + (lsp-json-rpc-connection workspace (lsp-resolve-final-command command)) + (let ((final-command (lsp-resolve-final-command command)) + (process-name (generate-new-buffer-name name)) + (process-environment + (lsp--compute-process-environment environment-fn))) + (let* ((stderr-buf (get-buffer-create (format "*%s::stderr*" process-name))) + (default-directory (lsp--default-directory-for-connection)) + (tramp-use-ssh-controlmaster-options 'suppress) + (tramp-ssh-controlmaster-options "-o ControlMaster=no -o ControlPath=none") + (proc (make-process + :name process-name + :connection-type 'pipe + :buffer (format "*%s*" process-name) + :coding 'no-conversion + :command final-command + :filter filter + :sentinel sentinel + :stderr stderr-buf + :noquery t + :file-handler t))) + (set-process-query-on-exit-flag proc nil) + (set-process-query-on-exit-flag (get-buffer-process stderr-buf) nil) + (with-current-buffer (get-buffer stderr-buf) + ;; Make the *NAME::stderr* buffer buffer-read-only, q to bury, etc. + (special-mode)) + (cons proc proc))))) + :test? (or + test-command + (lambda () + (lsp-server-present? (lsp-resolve-final-command command t)))))) + +(defun lsp--open-network-stream (host port name) + "Open network stream to HOST:PORT. + NAME will be passed to `open-network-stream'. + RETRY-COUNT is the number of the retries. + SLEEP-INTERVAL is the sleep interval between each retry." + (let* ((retries 0) + (sleep-interval 0.01) + (number-of-retries (/ lsp-tcp-connection-timeout sleep-interval)) + connection) + (while (and (not connection) (< retries number-of-retries)) + (condition-case err + (setq connection (open-network-stream name nil host port + :type 'plain + :coding 'no-conversion)) + (file-error + (let ((inhibit-message t)) + (lsp--warn "Failed to connect to %s:%s with error message %s" + host + port + (error-message-string err)) + (sleep-for sleep-interval) + (cl-incf retries))))) + (or connection (error "Port %s was never taken. Consider increasing `lsp-tcp-connection-timeout'." port)))) + +(defun lsp--port-available (host port) + "Return non-nil if HOST and PORT are available." + (condition-case _err + (delete-process (open-network-stream "*connection-test*" nil host port :type 'plain)) + (file-error t))) + +(defun lsp--find-available-port (host starting-port) + "Find available port on HOST starting from STARTING-PORT." + (let ((port starting-port)) + (while (not (lsp--port-available host port)) + (cl-incf port)) + port)) + +(defun lsp-tcp-connection (command-fn) + "Returns a connection property list similar to `lsp-stdio-connection'. +COMMAND-FN can only be a function that takes a single argument, a +port number. It should return a command for launches a language server +process listening for TCP connections on the provided port." + (cl-check-type command-fn function) + (list + :connect (lambda (filter sentinel name environment-fn _workspace) + (let* ((host "localhost") + (port (lsp--find-available-port host (cl-incf lsp--tcp-port))) + (command (funcall command-fn port)) + (final-command (if (consp command) command (list command))) + (_ (unless (lsp-server-present? final-command) + (user-error (format "Couldn't find executable %s" (cl-first final-command))))) + (process-environment + (lsp--compute-process-environment environment-fn)) + (proc (make-process :name name :connection-type 'pipe :coding 'no-conversion + :command final-command :sentinel sentinel :stderr (format "*%s::stderr*" name) :noquery t)) + (tcp-proc (lsp--open-network-stream host port (concat name "::tcp")))) + + ;; TODO: Same :noquery issue (see above) + (set-process-query-on-exit-flag proc nil) + (set-process-query-on-exit-flag tcp-proc nil) + (set-process-filter tcp-proc filter) + (cons tcp-proc proc))) + :test? (lambda () (lsp-server-present? (funcall command-fn 0))))) + +(defalias 'lsp-tcp-server 'lsp-tcp-server-command) + +(defun lsp-tcp-server-command (command-fn) + "Create tcp server connection. +In this mode Emacs is TCP server and the language server connects +to it. COMMAND is function with one parameter(the port) and it +should return the command to start the LS server." + (cl-check-type command-fn function) + (list + :connect (lambda (filter sentinel name environment-fn _workspace) + (let* (tcp-client-connection + (tcp-server (make-network-process :name (format "*tcp-server-%s*" name) + :buffer (format "*tcp-server-%s*" name) + :family 'ipv4 + :service lsp--tcp-server-port + :sentinel (lambda (proc _string) + (lsp-log "Language server %s is connected." name) + (setf tcp-client-connection proc)) + :server 't)) + (port (process-contact tcp-server :service)) + (final-command (funcall command-fn port)) + (process-environment + (lsp--compute-process-environment environment-fn)) + (cmd-proc (make-process :name name + :connection-type 'pipe + :coding 'no-conversion + :command final-command + :stderr (format "*tcp-server-%s*::stderr" name) + :noquery t))) + (let ((retries 0)) + ;; wait for the client to connect (we sit-for 500 ms, so have to double lsp--tcp-server-wait-seconds) + (while (and (not tcp-client-connection) (< retries (* 2 lsp--tcp-server-wait-seconds))) + (lsp--info "Waiting for connection for %s, retries: %s" name retries) + (sit-for 0.500) + (cl-incf retries))) + + (unless tcp-client-connection + (condition-case nil (delete-process tcp-server) (error)) + (condition-case nil (delete-process cmd-proc) (error)) + (error "Failed to create connection to %s on port %s" name port)) + (lsp--info "Successfully connected to %s" name) + + (set-process-query-on-exit-flag cmd-proc nil) + (set-process-query-on-exit-flag tcp-client-connection nil) + (set-process-query-on-exit-flag tcp-server nil) + + (set-process-filter tcp-client-connection filter) + (set-process-sentinel tcp-client-connection sentinel) + (cons tcp-client-connection cmd-proc))) + :test? (lambda () (lsp-server-present? (funcall command-fn 0))))) + +(defalias 'lsp-tramp-connection 'lsp-stdio-connection) + +(defun lsp--auto-configure () + "Autoconfigure `company', `flycheck', `lsp-ui', etc if they are installed." + (when (functionp 'lsp-ui-mode) + (lsp-ui-mode)) + + (if lsp-headerline-breadcrumb-enable + (add-hook 'lsp-configure-hook 'lsp-headerline-breadcrumb-mode) + (remove-hook 'lsp-configure-hook 'lsp-headerline-breadcrumb-mode)) + (if lsp-modeline-code-actions-enable + (add-hook 'lsp-configure-hook 'lsp-modeline-code-actions-mode) + (remove-hook 'lsp-configure-hook 'lsp-modeline-code-actions-mode)) + (if lsp-modeline-diagnostics-enable + (add-hook 'lsp-configure-hook 'lsp-modeline-diagnostics-mode) + (remove-hook 'lsp-configure-hook 'lsp-modeline-diagnostics-mode)) + (if lsp-modeline-workspace-status-enable + (add-hook 'lsp-configure-hook 'lsp-modeline-workspace-status-mode) + (remove-hook 'lsp-configure-hook 'lsp-modeline-workspace-status-mode)) + (if lsp-lens-enable + (add-hook 'lsp-configure-hook 'lsp-lens--enable) + (remove-hook 'lsp-configure-hook 'lsp-lens--enable)) + (if lsp-semantic-tokens-enable + (add-hook 'lsp-configure-hook 'lsp-semantic-tokens--enable) + (remove-hook 'lsp-configure-hook 'lsp-semantic-tokens--enable)) + + ;; yas-snippet config + (setq-local yas-inhibit-overlay-modification-protection t)) + +(defun lsp--restart-if-needed (workspace) + "Handler restart for WORKSPACE." + (when (or (eq lsp-restart 'auto-restart) + (eq (lsp--workspace-shutdown-action workspace) 'restart) + (and (eq lsp-restart 'interactive) + (let ((query (format + "Server %s exited (check corresponding stderr buffer for details). Do you want to restart it?" + (lsp--workspace-print workspace)))) + (y-or-n-p query)))) + (--each (lsp--workspace-buffers workspace) + (when (lsp-buffer-live-p it) + (lsp-with-current-buffer it + (if lsp--buffer-deferred + (lsp-deferred) + (lsp--info "Restarting LSP in buffer %s" (buffer-name)) + (lsp))))))) + +(defun lsp--update-key (table key fn) + "Apply FN on value corresponding to KEY in TABLE." + (let ((existing-value (gethash key table))) + (if-let ((new-value (funcall fn existing-value))) + (puthash key new-value table) + (remhash key table)))) + +(defun lsp--process-sentinel (workspace process exit-str) + "Create the sentinel for WORKSPACE." + (unless (process-live-p process) + (lsp--handle-process-exit workspace exit-str))) + +(defun lsp--handle-process-exit (workspace exit-str) + (let* ((folder->workspaces (lsp-session-folder->servers (lsp-session))) + (proc (lsp--workspace-proc workspace))) + (lsp--warn "%s has exited (%s)" + (lsp-process-name proc) + (string-trim-right (or exit-str ""))) + (with-lsp-workspace workspace + ;; Clean workspace related data in each of the buffers + ;; in the workspace. + (--each (lsp--workspace-buffers workspace) + (when (lsp-buffer-live-p it) + (lsp-with-current-buffer it + (setq lsp--buffer-workspaces (delete workspace lsp--buffer-workspaces)) + (lsp--uninitialize-workspace) + (lsp--spinner-stop) + (lsp--remove-overlays 'lsp-highlight)))) + + ;; Cleanup session from references to the closed workspace. + (--each (hash-table-keys folder->workspaces) + (lsp--update-key folder->workspaces it (apply-partially 'delete workspace))) + + (lsp-process-cleanup proc)) + + (run-hook-with-args 'lsp-after-uninitialized-functions workspace) + + (if (eq (lsp--workspace-shutdown-action workspace) 'shutdown) + (lsp--info "Workspace %s shutdown." (lsp--workspace-print workspace)) + (lsp--restart-if-needed workspace)) + (lsp--cleanup-hanging-watches))) + +(defun lsp-workspace-folders (workspace) + "Return all folders associated with WORKSPACE." + (let (result) + (->> (lsp-session) + (lsp-session-folder->servers) + (maphash (lambda (folder workspaces) + (when (-contains? workspaces workspace) + (push folder result))))) + result)) + +(defun lsp--start-workspace (session client-template root &optional initialization-options) + "Create new workspace for CLIENT-TEMPLATE with project root ROOT. +INITIALIZATION-OPTIONS are passed to initialize function. +SESSION is the active session." + (lsp--spinner-start) + (-let* ((default-directory root) + (client (copy-lsp--client client-template)) + (workspace (make-lsp--workspace + :root root + :client client + :status 'starting + :buffers (list (lsp-current-buffer)) + :host-root (file-remote-p root))) + ((&lsp-cln 'server-id 'environment-fn 'new-connection 'custom-capabilities + 'multi-root 'initialized-fn) client) + ((proc . cmd-proc) (funcall + (or (plist-get new-connection :connect) + (user-error "Client %s is configured incorrectly" client)) + (lsp--create-filter-function workspace) + (apply-partially #'lsp--process-sentinel workspace) + (format "%s" server-id) + environment-fn + workspace)) + (workspace-folders (gethash server-id (lsp-session-server-id->folders session)))) + (setf (lsp--workspace-proc workspace) proc + (lsp--workspace-cmd-proc workspace) cmd-proc) + + ;; update (lsp-session-folder->servers) depending on whether we are starting + ;; multi/single folder workspace + (mapc (lambda (project-root) + (->> session + (lsp-session-folder->servers) + (gethash project-root) + (cl-pushnew workspace))) + (or workspace-folders (list root))) + + (with-lsp-workspace workspace + (run-hooks 'lsp-before-initialize-hook) + (lsp-request-async + "initialize" + (append + (list :processId (unless (file-remote-p (buffer-file-name)) + (emacs-pid)) + :rootPath (lsp-file-local-name (expand-file-name root)) + :clientInfo (list :name "emacs" + :version (emacs-version)) + :rootUri (lsp--path-to-uri root) + :capabilities (lsp--client-capabilities custom-capabilities) + :initializationOptions initialization-options + :workDoneToken "1") + (when lsp-server-trace + (list :trace lsp-server-trace)) + (when multi-root + (->> workspace-folders + (-distinct) + (-map (lambda (folder) + (list :uri (lsp--path-to-uri folder) + :name (f-filename folder)))) + (apply 'vector) + (list :workspaceFolders)))) + (-lambda ((&InitializeResult :capabilities)) + ;; we know that Rust Analyzer will send {} which will be parsed as null + ;; when using plists + (when (equal 'rust-analyzer server-id) + (-> capabilities + (lsp:server-capabilities-text-document-sync?) + (lsp:set-text-document-sync-options-save? t))) + + (setf (lsp--workspace-server-capabilities workspace) capabilities + (lsp--workspace-status workspace) 'initialized) + + (with-lsp-workspace workspace + (lsp-notify "initialized" lsp--empty-ht)) + + (when initialized-fn (funcall initialized-fn workspace)) + + (cl-callf2 -filter #'lsp-buffer-live-p (lsp--workspace-buffers workspace)) + (->> workspace + (lsp--workspace-buffers) + (mapc (lambda (buffer) + (lsp-with-current-buffer buffer + (lsp--open-in-workspace workspace))))) + + (with-lsp-workspace workspace + (run-hooks 'lsp-after-initialize-hook)) + (lsp--info "%s initialized successfully in folders: %s" + (lsp--workspace-print workspace) + (lsp-workspace-folders workspace))) + :mode 'detached)) + workspace)) + +(defun lsp--load-default-session () + "Load default session." + (setq lsp--session (or (condition-case err + (lsp--read-from-file lsp-session-file) + (error (lsp--error "Failed to parse the session %s, starting with clean one." + (error-message-string err)) + nil)) + (make-lsp-session)))) + +(defun lsp-session () + "Get the session associated with the current buffer." + (or lsp--session (setq lsp--session (lsp--load-default-session)))) + +(defun lsp--client-disabled-p (buffer-major-mode client) + (seq-some + (lambda (entry) + (pcase entry + ((pred symbolp) (eq entry client)) + (`(,mode . ,client-or-list) + (and (eq mode buffer-major-mode) + (if (listp client-or-list) + (memq client client-or-list) + (eq client client-or-list)))))) + lsp-disabled-clients)) + + +;; download server + +(defcustom lsp-server-install-dir (expand-file-name + (locate-user-emacs-file (f-join ".cache" "lsp"))) + "Directory in which the servers will be installed." + :risky t + :type 'directory + :package-version '(lsp-mode . "6.3") + :group 'lsp-mode) + +(defcustom lsp-verify-signature t + "Whether to check GPG signatures of downloaded files." + :type 'boolean + :package-version '(lsp-mode . "8.0.0") + :group 'lsp-mode) + +(defvar lsp--dependencies (ht)) + +(defun lsp-dependency (name &rest definitions) + "Used to specify a language server DEPENDENCY, the server +executable or other required file path. Typically, the +DEPENDENCY is found by locating it on the system path using +`executable-find'. + +You can explicitly call lsp-dependency in your environment to +specify the absolute path to the DEPENDENCY. For example, the +typescript-language-server requires both the server and the +typescript compiler. If you have installed them in a team shared +read-only location, you can instruct lsp-mode to use them via + + (eval-after-load `lsp-mode + `(progn + (require lsp-javascript) + (lsp-dependency typescript-language-server (:system ,tls-exe)) + (lsp-dependency typescript (:system ,ts-js)))) + +where tls-exe is the absolute path to the typescript-language-server +executable and ts-js is the absolute path to the typescript compiler +JavaScript file, tsserver.js (the *.js is required for Windows)." + (ht-set lsp--dependencies name definitions)) + +(defun lsp--server-binary-present? (client) + (unless (equal (lsp--client-server-id client) 'lsp-pwsh) + (condition-case () + (-some-> client lsp--client-new-connection (plist-get :test?) funcall) + (error nil) + (args-out-of-range nil)))) + +(define-minor-mode lsp-installation-buffer-mode + "Mode used in *lsp-installation* buffers. +It can be used to set-up keybindings, etc. Disabling this mode +detaches the installation buffer from commands like +`lsp-select-installation-buffer'." + :init-value nil + :lighter nil) + +(defface lsp-installation-finished-buffer-face '((t :foreground "orange")) + "Face used for finished installation buffers. +Used in `lsp-select-installation-buffer'." + :group 'lsp-mode) + +(defface lsp-installation-buffer-face '((t :foreground "green")) + "Face used for installation buffers still in progress. +Used in `lsp-select-installation-buffer'." + :group 'lsp-mode) + +(defun lsp--installation-buffer? (buf) + "Check whether BUF is an `lsp-async-start-process' buffer." + (buffer-local-value 'lsp-installation-buffer-mode buf)) + +(defun lsp-select-installation-buffer (&optional show-finished) + "Interactively choose an installation buffer. +If SHOW-FINISHED is set, leftover (finished) installation buffers +are still shown." + (interactive "P") + (let ((bufs (--filter (and (lsp--installation-buffer? it) + (or show-finished (get-buffer-process it))) + (buffer-list)))) + (pcase bufs + (`nil (user-error "No installation buffers")) + (`(,buf) (pop-to-buffer buf)) + (bufs (pop-to-buffer (completing-read "Select installation buffer: " + (--map (propertize (buffer-name it) 'face + (if (get-buffer-process it) + 'lsp-installation-buffer-face + 'lsp-installation-finished-buffer-face)) + bufs))))))) + +(defun lsp-cleanup-installation-buffers () + "Delete finished *lsp-installation* buffers." + (interactive) + (dolist (buf (buffer-list)) + (when (and (lsp--installation-buffer? buf) (not (get-buffer-process buf))) + (kill-buffer buf)))) + +(defun lsp--download-status () + (-some--> #'lsp--client-download-in-progress? + (lsp--filter-clients it) + (-map (-compose #'symbol-name #'lsp--client-server-id) it) + (format "%s" it) + (propertize it 'face 'success) + (format " Installing following servers: %s" it) + (propertize it + 'local-map (make-mode-line-mouse-map + 'mouse-1 #'lsp-select-installation-buffer) + 'mouse-face 'highlight))) + +(defun lsp--install-server-internal (client &optional update?) + (unless (lsp--client-download-server-fn client) + (user-error "There is no automatic installation for `%s', you have to install it manually following lsp-mode's documentation." + (lsp--client-server-id client))) + + (setf (lsp--client-download-in-progress? client) t) + (add-to-list 'global-mode-string '(t (:eval (lsp--download-status)))) + (cl-flet ((done + (success? &optional error-message) + ;; run with idle timer to make sure the lsp command is executed in + ;; the main thread, see #2739. + (run-with-timer + 0.0 + nil + (lambda () + (-let [(&lsp-cln 'server-id 'buffers) client] + (setf (lsp--client-download-in-progress? client) nil + (lsp--client-buffers client) nil) + (if success? + (lsp--info "Server %s downloaded, auto-starting in %s buffers." server-id + (length buffers)) + (lsp--error "Server %s install process failed with the following error message: %s. +Check `*lsp-install*' and `*lsp-log*' buffer." + server-id + error-message)) + (seq-do + (lambda (buffer) + (when (lsp-buffer-live-p buffer) + (lsp-with-current-buffer buffer + (cl-callf2 -remove-item '(t (:eval (lsp--download-status))) + global-mode-string) + (when success? (lsp))))) + buffers) + (unless (lsp--filter-clients #'lsp--client-download-in-progress?) + (cl-callf2 -remove-item '(t (:eval (lsp--download-status))) + global-mode-string))))))) + (lsp--info "Download %s started." (lsp--client-server-id client)) + (condition-case err + (funcall + (lsp--client-download-server-fn client) + client + (lambda () (done t)) + (lambda (msg) (done nil msg)) + update?) + (error + (done nil (error-message-string err)))))) + +(defun lsp--require-packages () + "Load `lsp-client-packages' if needed." + (when (and lsp-auto-configure (not lsp--client-packages-required)) + (seq-do (lambda (package) + ;; loading client is slow and `lsp' can be called repeatedly + (unless (featurep package) + (require package nil t))) + lsp-client-packages) + (setq lsp--client-packages-required t))) + +;;;###autoload +(defun lsp-install-server (update? &optional server-id) + "Interactively install or re-install server. +When prefix UPDATE? is t force installation even if the server is present." + (interactive "P") + (lsp--require-packages) + (let* ((chosen-client (or (gethash server-id lsp-clients) + (lsp--completing-read + "Select server to install/re-install: " + (or (->> lsp-clients + (ht-values) + (-filter (-andfn + (-not #'lsp--client-download-in-progress?) + #'lsp--client-download-server-fn))) + (user-error "There are no servers with automatic installation")) + (lambda (client) + (let ((server-name (-> client lsp--client-server-id symbol-name))) + (if (lsp--server-binary-present? client) + (concat server-name " (Already installed)") + server-name))) + nil + t))) + (update? (or update? + (and (not (lsp--client-download-in-progress? chosen-client)) + (lsp--server-binary-present? chosen-client))))) + (lsp--install-server-internal chosen-client update?))) + +;;;###autoload +(defun lsp-uninstall-server (dir) + "Delete a LSP server from `lsp-server-install-dir'." + (interactive + (list (read-directory-name "Uninstall LSP server: " (f-slash lsp-server-install-dir)))) + (unless (file-directory-p dir) + (user-error "Couldn't find %s directory" dir)) + (delete-directory dir 'recursive) + (message "Server `%s' uninstalled." (file-name-nondirectory (directory-file-name dir)))) + +;;;###autoload +(defun lsp-uninstall-servers () + "Uninstall all installed servers." + (interactive) + (let* ((dir lsp-server-install-dir) + (servers (ignore-errors + (directory-files dir t + directory-files-no-dot-files-regexp)))) + (if (or (not (file-directory-p dir)) (zerop (length servers))) + (user-error "No servers to uninstall") + (when (yes-or-no-p + (format "Servers to uninstall: %d (%s), proceed? " + (length servers) + (mapconcat (lambda (server) + (file-name-nondirectory (directory-file-name server))) + servers " "))) + (mapc #'lsp-uninstall-server servers) + (message "All servers uninstalled"))))) + +;;;###autoload +(defun lsp-update-server (&optional server-id) + "Interactively update (reinstall) a server." + (interactive) + (lsp--require-packages) + (let ((chosen-client (or (gethash server-id lsp-clients) + (lsp--completing-read + "Select server to update (if not on the list, probably you need to `lsp-install-server`): " + (or (->> lsp-clients + (ht-values) + (-filter (-andfn + (-not #'lsp--client-download-in-progress?) + #'lsp--client-download-server-fn + #'lsp--server-binary-present?))) + (user-error "There are no servers to update")) + (lambda (client) + (-> client lsp--client-server-id symbol-name)) + nil + t)))) + (lsp--install-server-internal chosen-client t))) + +;;;###autoload +(defun lsp-update-servers () + "Update (reinstall) all installed servers." + (interactive) + (lsp--require-packages) + (mapc (lambda (client) (lsp--install-server-internal client t)) + (-filter (-andfn + (-not #'lsp--client-download-in-progress?) + #'lsp--client-download-server-fn + #'lsp--server-binary-present?) (hash-table-values lsp-clients)))) + +;;;###autoload +(defun lsp-ensure-server (server-id) + "Ensure server SERVER-ID" + (lsp--require-packages) + (if-let ((client (gethash server-id lsp-clients))) + (unless (lsp--server-binary-present? client) + (lsp--info "Server `%s' is not preset, installing..." server-id) + (lsp-install-server nil server-id)) + (warn "Unable to find server registration with id %s" server-id))) + +(defun lsp-async-start-process (callback error-callback &rest command) + "Start async process COMMAND with CALLBACK and ERROR-CALLBACK." + (let ((name (cl-first command))) + (with-current-buffer (compilation-start (mapconcat #'shell-quote-argument (-filter (lambda (cmd) + (not (null cmd))) + command) + " ") t + (lambda (&rest _) + (generate-new-buffer-name (format "*lsp-install: %s*" name)))) + (lsp-installation-buffer-mode +1) + (view-mode +1) + (add-hook + 'compilation-finish-functions + (lambda (_buf status) + (if (string= "finished\n" status) + (condition-case err + (funcall callback) + (error + (funcall error-callback (error-message-string err)))) + (funcall error-callback (s-trim-right status)))) + nil t)))) + +(defun lsp-resolve-value (value) + "Resolve VALUE's value. +If it is function - call it. +If it is a variable - return it's value +Otherwise returns value itself." + (cond + ((functionp value) (funcall value)) + ((and (symbolp value) (boundp value)) (symbol-value value)) + (value))) + +(defvar lsp-deps-providers + (list :npm (list :path #'lsp--npm-dependency-path + :install #'lsp--npm-dependency-install) + :cargo (list :path #'lsp--cargo-dependency-path + :install #'lsp--cargo-dependency-install) + :system (list :path #'lsp--system-path) + :download (list :path #'lsp-download-path + :install #'lsp-download-install))) + +(defun lsp--system-path (path) + "If PATH is absolute and exists return it as is. Otherwise, +return the absolute path to the executable defined by PATH or +nil." + ;; For node.js 'sub-packages' PATH may point to a *.js file. Consider the + ;; typescript-language-server. When lsp invokes the server, lsp needs to + ;; supply the path to the typescript compiler, tsserver.js, as an argument. To + ;; make code platform independent, one must pass the absolute path to the + ;; tsserver.js file (Windows requires a *.js file - see help on the JavaScript + ;; child process spawn command that is invoked by the + ;; typescript-language-server). This is why we check for existence and not + ;; that the path is executable. + (let ((path (lsp-resolve-value path))) + (cond + ((and (f-absolute? path) + (f-exists? path)) + path) + ((executable-find path t) path)))) + +(defun lsp-package-path (dependency) + "Path to the DEPENDENCY each of the registered providers." + (let (path) + (-first (-lambda ((provider . rest)) + (setq path (-some-> lsp-deps-providers + (plist-get provider) + (plist-get :path) + (apply rest)))) + (gethash dependency lsp--dependencies)) + path)) + +(defun lsp-package-ensure (dependency callback error-callback) + "Asynchronously ensure a package." + (or (-first (-lambda ((provider . rest)) + (-some-> lsp-deps-providers + (plist-get provider) + (plist-get :install) + (apply (cl-list* callback error-callback rest)))) + (gethash dependency lsp--dependencies)) + (funcall error-callback (format "Unable to find a way to install %s" dependency)))) + + +;; npm handling + +;; https://docs.npmjs.com/files/folders#executables +(cl-defun lsp--npm-dependency-path (&key package path &allow-other-keys) + "Return npm dependency PATH for PACKAGE." + (let ((path (executable-find + (f-join lsp-server-install-dir "npm" package + (cond ((eq system-type 'windows-nt) "") + (t "bin")) + path) + t))) + (unless (and path (f-exists? path)) + (error "The package %s is not installed. Unable to find %s" package path)) + path)) + +(cl-defun lsp--npm-dependency-install (callback error-callback &key package &allow-other-keys) + (if-let ((npm-binary (executable-find "npm"))) + (progn + ;; Explicitly `make-directory' to work around NPM bug in + ;; versions 7.0.0 through 7.4.1. See + ;; https://github.com/emacs-lsp/lsp-mode/issues/2364 for + ;; discussion. + (make-directory (f-join lsp-server-install-dir "npm" package "lib") 'parents) + (lsp-async-start-process (lambda () + (if (string-empty-p + (string-trim (shell-command-to-string + (mapconcat #'shell-quote-argument `(,npm-binary "view" ,package "peerDependencies") " ")))) + (funcall callback) + (let ((default-directory (f-dirname (car (last (directory-files-recursively (f-join lsp-server-install-dir "npm" package) "package.json"))))) + (process-environment (append '("npm_config_yes=true") process-environment))) ;; Disable prompting for older versions of npx + (when (f-dir-p default-directory) + (lsp-async-start-process callback + error-callback + (executable-find "npx") + "npm-install-peers"))))) + error-callback + npm-binary + "-g" + "--prefix" + (f-join lsp-server-install-dir "npm" package) + "install" + package)) + (lsp-log "Unable to install %s via `npm' because it is not present" package) + nil)) + + +;; Cargo dependency handling +(cl-defun lsp--cargo-dependency-path (&key package path &allow-other-keys) + (let ((path (executable-find + (f-join lsp-server-install-dir + "cargo" + package + "bin" + path) + t))) + (unless (and path (f-exists? path)) + (error "The package %s is not installed. Unable to find %s" package path)) + path)) + +(cl-defun lsp--cargo-dependency-install (callback error-callback &key package git &allow-other-keys) + (if-let ((cargo-binary (executable-find "cargo"))) + (lsp-async-start-process + callback + error-callback + cargo-binary + "install" + package + (when git + "--git") + git + "--root" + (f-join lsp-server-install-dir "cargo" package)) + (lsp-log "Unable to install %s via `cargo' because it is not present" package) + nil)) + + + +;; Download URL handling +(cl-defun lsp-download-install (callback error-callback &key url asc-url pgp-key store-path decompress &allow-other-keys) + (let* ((url (lsp-resolve-value url)) + (store-path (lsp-resolve-value store-path)) + ;; (decompress (lsp-resolve-value decompress)) + (download-path + (pcase decompress + (:gzip (concat store-path ".gz")) + (:zip (concat store-path ".zip")) + (:targz (concat store-path ".tar.gz")) + (`nil store-path) + (_ (error ":decompress must be `:gzip', `:zip', `:targz' or `nil'"))))) + (make-thread + (lambda () + (condition-case err + (progn + (when (f-exists? download-path) + (f-delete download-path)) + (when (f-exists? store-path) + (f-delete store-path)) + (lsp--info "Starting to download %s to %s..." url download-path) + (mkdir (f-parent download-path) t) + (url-copy-file url download-path) + (lsp--info "Finished downloading %s..." download-path) + (when (and lsp-verify-signature asc-url pgp-key) + (if (executable-find epg-gpg-program) + (let ((asc-download-path (concat download-path ".asc")) + (context (epg-make-context)) + (fingerprint) + (signature)) + (when (f-exists? asc-download-path) + (f-delete asc-download-path)) + (lsp--info "Starting to download %s to %s..." asc-url asc-download-path) + (url-copy-file asc-url asc-download-path) + (lsp--info "Finished downloading %s..." asc-download-path) + (epg-import-keys-from-string context pgp-key) + (setq fingerprint (epg-import-status-fingerprint + (car + (epg-import-result-imports + (epg-context-result-for context 'import))))) + (lsp--info "Verifying signature %s..." asc-download-path) + (epg-verify-file context asc-download-path download-path) + (setq signature (car (epg-context-result-for context 'verify))) + (unless (and + (eq (epg-signature-status signature) 'good) + (equal (epg-signature-fingerprint signature) fingerprint)) + (error "Failed to verify GPG signature: %s" (epg-signature-to-string signature)))) + (lsp--warn "GPG is not installed, skipping the signature check."))) + (when decompress + (lsp--info "Decompressing %s..." download-path) + (pcase decompress + (:gzip + (lsp-gunzip download-path)) + (:zip (lsp-unzip download-path (f-parent store-path))) + (:targz (lsp-tar-gz-decompress download-path (f-parent store-path)))) + (lsp--info "Decompressed %s..." store-path)) + (funcall callback)) + (error (funcall error-callback err))))))) + +(cl-defun lsp-download-path (&key store-path binary-path set-executable? &allow-other-keys) + "Download URL and store it into STORE-PATH. + +SET-EXECUTABLE? when non-nil change the executable flags of +STORE-PATH to make it executable. BINARY-PATH can be specified +when the binary to start does not match the name of the +archive (e.g. when the archive has multiple files)" + (let ((store-path (or (lsp-resolve-value binary-path) + (lsp-resolve-value store-path)))) + (cond + ((executable-find store-path) store-path) + ((and set-executable? (f-exists? store-path)) + (set-file-modes store-path #o0700) + store-path) + ((f-exists? store-path) store-path)))) + +(defun lsp--find-latest-gh-release-url (url regex) + "Fetch the latest version in the releases given by URL by using REGEX." + (let ((url-request-method "GET")) + (with-current-buffer (url-retrieve-synchronously url) + (goto-char (point-min)) + (re-search-forward "\n\n" nil 'noerror) + (delete-region (point-min) (point)) + (let* ((json-result (lsp-json-read-buffer))) + (message "Latest version found: %s" (lsp-get json-result :tag_name)) + (--> json-result + (lsp-get it :assets) + (seq-find (lambda (entry) (string-match-p regex (lsp-get entry :name))) it) + (lsp-get it :browser_download_url)))))) + +;; unzip + +(defconst lsp-ext-pwsh-script "powershell -noprofile -noninteractive \ +-nologo -ex bypass -command Expand-Archive -path '%s' -dest '%s'" + "Powershell script to unzip file.") + +(defconst lsp-ext-unzip-script "bash -c 'mkdir -p %2$s && unzip -qq -o %1$s -d %2$s'" + "Unzip script to unzip file.") + +(defcustom lsp-unzip-script (lambda () + (cond ((executable-find "unzip") lsp-ext-unzip-script) + ((executable-find "powershell") lsp-ext-pwsh-script) + (t nil))) + "The script to unzip." + :group 'lsp-mode + :type 'string + :package-version '(lsp-mode . "8.0.0")) + +(defun lsp-unzip (zip-file dest) + "Unzip ZIP-FILE to DEST." + (unless lsp-unzip-script + (error "Unable to find `unzip' or `powershell' on the path, please customize `lsp-unzip-script'")) + (shell-command (format (lsp-resolve-value lsp-unzip-script) zip-file dest))) + +;; gunzip + +(defconst lsp-ext-gunzip-script "gzip -d %1$s" + "Script to decompress a gzippped file with gzip.") + +(defcustom lsp-gunzip-script (lambda () + (cond ((executable-find "gzip") lsp-ext-gunzip-script) + (t nil))) + "The script to decompress a gzipped file. +Should be a format string with one argument for the file to be decompressed +in place." + :group 'lsp-mode + :type 'string + :package-version '(lsp-mode . "8.0.0")) + +(defun lsp-gunzip (gz-file) + "Decompress GZ-FILE in place." + (unless lsp-gunzip-script + (error "Unable to find `gzip' on the path, please either customize `lsp-gunzip-script' or manually decompress %s" gz-file)) + (shell-command (format (lsp-resolve-value lsp-gunzip-script) gz-file))) + +;; tar.gz decompression + +(defconst lsp-ext-tar-script "bash -c 'mkdir -p %2$s; tar xf %1$s --directory=%2$s'" + "Script to decompress a .tar.gz file.") + +(defcustom lsp-tar-script (lambda () + (cond ((executable-find "tar") lsp-ext-tar-script) + (t nil))) + "The script to decompress a .tar.gz file. +Should be a format string with one argument for the file to be decompressed +in place." + :group 'lsp-mode + :type 'string) + +(defun lsp-tar-gz-decompress (targz-file dest) + "Decompress TARGZ-FILE in DEST." + (unless lsp-tar-script + (error "Unable to find `tar' on the path, please either customize `lsp-tar-script' or manually decompress %s" targz-file)) + (shell-command (format (lsp-resolve-value lsp-tar-script) targz-file dest))) + + +;; VSCode marketplace + +(defcustom lsp-vscode-ext-url + "https://marketplace.visualstudio.com/_apis/public/gallery/publishers/%s/vsextensions/%s/%s/vspackage%s" + "Vscode extension template url." + :group 'lsp-mode + :type 'string + :package-version '(lsp-mode . "8.0.0")) + +(defun lsp-vscode-extension-url (publisher name version &optional targetPlatform) + "Return the URL to vscode extension. +PUBLISHER is the extension publisher. +NAME is the name of the extension. +VERSION is the version of the extension. +TARGETPLATFORM is the targetPlatform of the extension." + (format lsp-vscode-ext-url publisher name version (or targetPlatform ""))) + + + +;; Queueing prompts + +(defvar lsp--question-queue nil + "List of questions yet to be asked by `lsp-ask-question'.") + +(defun lsp-ask-question (question options callback) + "Prompt the user to answer the QUESTION with one of the OPTIONS from the +minibuffer. Once the user selects an option, the CALLBACK function will be +called, passing the selected option to it. + +If the user is currently being shown a question, the question will be stored in +`lsp--question-queue', and will be asked once the user has answered the current +question." + (add-to-list 'lsp--question-queue `(("question" . ,question) + ("options" . ,options) + ("callback" . ,callback)) t) + (when (eq (length lsp--question-queue) 1) + (lsp--process-question-queue))) + +(defun lsp--process-question-queue () + "Take the first question from `lsp--question-queue', process it, then process +the next question until the queue is empty." + (-let* (((&alist "question" "options" "callback") (car lsp--question-queue)) + (answer (completing-read question options nil t))) + (pop lsp--question-queue) + (funcall callback answer) + (when lsp--question-queue + (lsp--process-question-queue)))) + +(defun lsp--supports-buffer? (client) + (and + ;; both file and client remote or both local + (eq (---truthy? (file-remote-p (buffer-file-name))) + (---truthy? (lsp--client-remote? client))) + + ;; activation function or major-mode match. + (if-let ((activation-fn (lsp--client-activation-fn client))) + (funcall activation-fn (buffer-file-name) major-mode) + (-contains? (lsp--client-major-modes client) major-mode)) + + ;; check whether it is enabled if `lsp-enabled-clients' is not null + (or (null lsp-enabled-clients) + (or (member (lsp--client-server-id client) lsp-enabled-clients) + (ignore (lsp--info "Client %s is not in lsp-enabled-clients" + (lsp--client-server-id client))))) + + ;; check whether it is not disabled. + (not (lsp--client-disabled-p major-mode (lsp--client-server-id client))))) + +(defun lsp--filter-clients (pred) + (->> lsp-clients hash-table-values (-filter pred))) + +(defun lsp--find-clients () + "Find clients which can handle current buffer." + (-when-let (matching-clients (lsp--filter-clients (-andfn #'lsp--supports-buffer? + #'lsp--server-binary-present?))) + (lsp-log "Found the following clients for %s: %s" + (buffer-file-name) + (s-join ", " + (-map (lambda (client) + (format "(server-id %s, priority %s)" + (lsp--client-server-id client) + (lsp--client-priority client))) + matching-clients))) + (-let* (((add-on-clients main-clients) (-separate #'lsp--client-add-on? matching-clients)) + (selected-clients (if-let ((main-client (and main-clients + (--max-by (> (lsp--client-priority it) + (lsp--client-priority other)) + main-clients)))) + (cons main-client add-on-clients) + add-on-clients))) + (lsp-log "The following clients were selected based on priority: %s" + (s-join ", " + (-map (lambda (client) + (format "(server-id %s, priority %s)" + (lsp--client-server-id client) + (lsp--client-priority client))) + selected-clients))) + selected-clients))) + +(defun lsp-workspace-remove-all-folders() + "Delete all lsp tracked folders." + (interactive) + (--each (lsp-session-folders (lsp-session)) + (lsp-workspace-folders-remove it))) + +(defun lsp-register-client (client) + "Registers LSP client CLIENT." + (let ((client-id (lsp--client-server-id client))) + (puthash client-id client lsp-clients) + (setplist (intern (format "lsp-%s-after-open-hook" client-id)) + `( standard-value (nil) custom-type hook + custom-package-version (lsp-mode . "7.0.1") + variable-documentation ,(format "Hooks to run after `%s' server is run." client-id) + custom-requests nil))) + (when (and lsp-auto-register-remote-clients + (not (lsp--client-remote? client))) + (let ((remote-client (copy-lsp--client client))) + (setf (lsp--client-remote? remote-client) t + (lsp--client-server-id remote-client) (intern + (format "%s-tramp" + (lsp--client-server-id client))) + ;; disable automatic download + (lsp--client-download-server-fn remote-client) nil) + (lsp-register-client remote-client)))) + +(defun lsp--create-initialization-options (_session client) + "Create initialization-options from SESSION and CLIENT. +Add workspace folders depending on server being multiroot and +session workspace folder configuration for the server." + (let* ((initialization-options-or-fn (lsp--client-initialization-options client))) + (if (functionp initialization-options-or-fn) + (funcall initialization-options-or-fn) + initialization-options-or-fn))) + +(defvar lsp-client-settings (make-hash-table :test 'equal) + "For internal use, any external users please use + `lsp-register-custom-settings' function instead") + +(defun lsp-register-custom-settings (props) + "Register PROPS. +PROPS is list of triple (path value boolean?) where PATH is the path to the +property; VALUE can be a literal value, symbol to be evaluated, or either a +function or lambda function to be called without arguments; BOOLEAN? is an +optional flag that should be non-nil for boolean settings, when it is nil the +property will be ignored if the VALUE is nil. + +Example: `(lsp-register-custom-settings `((\"foo.bar.buzz.enabled\" t t)))' +\(note the double parentheses)" + (mapc + (-lambda ((path . rest)) + (puthash path rest lsp-client-settings)) + props)) + +(defun lsp-region-text (region) + "Get the text for REGION in current buffer." + (-let (((start . end) (lsp--range-to-region region))) + (buffer-substring-no-properties start end))) + +(defun lsp-ht-set (tbl paths value) + "Set nested hash table value. +TBL - a hash table, PATHS is the path to the nested VALUE." + (pcase paths + (`(,path) (ht-set! tbl path value)) + (`(,path . ,rst) (let ((nested-tbl (or (gethash path tbl) + (let ((temp-tbl (ht))) + (ht-set! tbl path temp-tbl) + temp-tbl)))) + (lsp-ht-set nested-tbl rst value))))) + +;; sections + +(defalias 'defcustom-lsp 'lsp-defcustom) + +(defmacro lsp-defcustom (symbol standard doc &rest args) + "Defines `lsp-mode' server property." + (declare (doc-string 3) (debug (name body)) + (indent defun)) + (let ((path (plist-get args :lsp-path))) + (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))) + (maphash (-lambda (path (variable boolean?)) + (when (s-matches? (concat (regexp-quote section) "\\..*") path) + (let* ((symbol-value (-> variable + lsp-resolve-value + lsp-resolve-value)) + (value (if (and boolean? (not symbol-value)) + :json-false + symbol-value))) + (when (or boolean? value) + (lsp-ht-set ret (s-split "\\." path) value))))) + lsp-client-settings) + ret)) + + +(defun lsp--start-connection (session client project-root) + "Initiates connection created from CLIENT for PROJECT-ROOT. +SESSION is the active session." + (when (lsp--client-multi-root client) + (cl-pushnew project-root (gethash (lsp--client-server-id client) + (lsp-session-server-id->folders session)))) + (run-hook-with-args 'lsp-workspace-folders-changed-functions (list project-root) nil) + + (unwind-protect + (lsp--start-workspace session client project-root (lsp--create-initialization-options session client)) + (lsp--spinner-stop))) + +;; lsp-log-io-mode + +(defvar lsp-log-io-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "M-n") #'lsp-log-io-next) + (define-key map (kbd "M-p") #'lsp-log-io-prev) + (define-key map (kbd "k") #'lsp--erase-log-buffer) + (define-key map (kbd "K") #'lsp--erase-session-log-buffers) + map) + "Keymap for lsp log buffer mode.") + +(define-derived-mode lsp-log-io-mode special-mode "LspLogIo" + "Special mode for viewing IO logs.") + +(defun lsp-workspace-show-log (workspace) + "Display the log buffer of WORKSPACE." + (interactive + (list (if lsp-log-io + (if (eq (length (lsp-workspaces)) 1) + (cl-first (lsp-workspaces)) + (lsp--completing-read "Workspace: " (lsp-workspaces) + #'lsp--workspace-print nil t)) + (user-error "IO logging is disabled")))) + (pop-to-buffer (lsp--get-log-buffer-create workspace))) + +(defalias 'lsp-switch-to-io-log-buffer 'lsp-workspace-show-log) + +(defun lsp--get-log-buffer-create (workspace) + "Return the lsp log buffer of WORKSPACE, creating a new one if needed." + (let* ((server-id (-> workspace lsp--workspace-client lsp--client-server-id symbol-name)) + (pid (-> workspace lsp--workspace-cmd-proc lsp-process-id))) + (get-buffer-create (format "*lsp-log: %s:%s*" server-id pid)))) + +(defun lsp--erase-log-buffer (&optional all) + "Delete contents of current lsp log buffer. +When ALL is t, erase all log buffers of the running session." + (interactive) + (let* ((workspaces (lsp--session-workspaces (lsp-session))) + (current-log-buffer (current-buffer))) + (dolist (w workspaces) + (let ((b (lsp--get-log-buffer-create w))) + (when (or all (eq b current-log-buffer)) + (with-current-buffer b + (let ((inhibit-read-only t)) + (erase-buffer)))))))) + +(defun lsp--erase-session-log-buffers () + "Erase log buffers of the running session." + (interactive) + (lsp--erase-log-buffer t)) + +(defun lsp-log-io-next (arg) + "Move to next log entry." + (interactive "P") + (ewoc-goto-next lsp--log-io-ewoc (or arg 1))) + +(defun lsp-log-io-prev (arg) + "Move to previous log entry." + (interactive "P") + (ewoc-goto-prev lsp--log-io-ewoc (or arg 1))) + + + +(cl-defmethod lsp-process-id ((process process)) + (process-id process)) + +(cl-defmethod lsp-process-name ((process process)) (process-name process)) + +(cl-defmethod lsp-process-status ((process process)) (process-status process)) + +(cl-defmethod lsp-process-kill ((process process)) + (when (process-live-p process) + (kill-process process))) + +(cl-defmethod lsp-process-send ((process process) message) + (condition-case err + (process-send-string process (lsp--make-message message)) + (error (lsp--error "Sending to process failed with the following error: %s" + (error-message-string err))))) + +(cl-defmethod lsp-process-cleanup (process) + ;; Kill standard error buffer only if the process exited normally. + ;; Leave it intact otherwise for debugging purposes. + (let ((buffer (-> process process-name get-buffer))) + (when (and (eq (process-status process) 'exit) + (zerop (process-exit-status process)) + (buffer-live-p buffer)) + (kill-buffer buffer)))) + + +;; native JSONRPC + +(declare-function json-rpc "ext:json") +(declare-function json-rpc-connection "ext:json") +(declare-function json-rpc-send "ext:json") +(declare-function json-rpc-shutdown "ext:json") +(declare-function json-rpc-stderr "ext:json") +(declare-function json-rpc-pid "ext:json") + +(defvar lsp-json-rpc-thread nil) +(defvar lsp-json-rpc-queue nil) +(defvar lsp-json-rpc-done nil) +(defvar lsp-json-rpc-mutex (make-mutex)) +(defvar lsp-json-rpc-condition (make-condition-variable lsp-json-rpc-mutex)) + +(defun lsp-json-rpc-process-queue () + (while (not lsp-json-rpc-done) + (while lsp-json-rpc-queue + (-let (((proc . message) (pop lsp-json-rpc-queue))) + (json-rpc-send + proc message + :null-object nil + :false-object :json-false))) + (with-mutex lsp-json-rpc-mutex + (condition-wait lsp-json-rpc-condition)))) + +(cl-defmethod lsp-process-id (process) (json-rpc-pid process)) + +(cl-defmethod lsp-process-name (_process) "TBD") + +(cl-defmethod lsp-process-kill (process) (json-rpc-shutdown process)) + +(cl-defmethod lsp-process-send (proc message) + (unless lsp-json-rpc-thread + (with-current-buffer (get-buffer-create " *json-rpc*") + (setq lsp-json-rpc-thread (make-thread #'lsp-json-rpc-process-queue "*json-rpc-queue*")))) + + (with-mutex lsp-json-rpc-mutex + (setq lsp-json-rpc-queue (append lsp-json-rpc-queue + (list (cons proc message)))) + (condition-notify lsp-json-rpc-condition))) + +(cl-defmethod lsp-process-cleanup (_proc)) + +(defun lsp-json-rpc-connection (workspace command) + (let ((con (apply #'json-rpc-connection command)) + (object-type (if lsp-use-plists 'plist 'hash-table))) + (with-current-buffer (get-buffer-create " *json-rpc*") + (make-thread + (lambda () + (json-rpc + con + (lambda (result err done) + (run-with-timer + 0.0 + nil + (lambda () + (cond + (result (lsp--parser-on-message result workspace)) + (err (warn "Json parsing failed with the following error: %s" err)) + (done (lsp--handle-process-exit workspace "")))))) + :object-type object-type + :null-object nil + :false-object nil)) + "*json-rpc-connection*")) + (cons con con))) + +(defun lsp-json-rpc-stderr () + (interactive) + (--when-let (pcase (lsp-workspaces) + (`nil (user-error "There are no active servers in the current buffer")) + (`(,workspace) workspace) + (workspaces (lsp--completing-read "Select server: " + workspaces + 'lsp--workspace-print nil t))) + (let ((content (json-rpc-stderr (lsp--workspace-cmd-proc it))) + (buffer (format "*stderr-%s*" (lsp--workspace-print it)) )) + (with-current-buffer (get-buffer-create buffer) + (with-help-window buffer + (insert content)))))) + + +(defun lsp--workspace-print (workspace) + "Visual representation WORKSPACE." + (let* ((proc (lsp--workspace-cmd-proc workspace)) + (status (lsp--workspace-status workspace)) + (server-id (-> workspace lsp--workspace-client lsp--client-server-id symbol-name)) + (pid (lsp-process-id proc))) + + (if (eq 'initialized status) + (format "%s:%s" server-id pid) + (format "%s:%s/%s" server-id pid status)))) + +(defun lsp--map-tree-widget (m) + "Build `tree-widget' from a hash-table or plist M." + (when (lsp-structure-p m) + (let (nodes) + (lsp-map (lambda (k v) + (push `(tree-widget + :tag ,(if (lsp-structure-p v) + (format "%s:" k) + (format "%s: %s" k + (propertize (format "%s" v) + 'face + 'font-lock-string-face))) + :open t + ,@(lsp--map-tree-widget v)) + nodes)) + m) + nodes))) + +(defun lsp-buffer-name (buffer-id) + (if-let ((buffer-name (plist-get buffer-id :buffer-name))) + (funcall buffer-name buffer-id) + (buffer-name buffer-id))) + +(defun lsp--render-workspace (workspace) + "Tree node representation of WORKSPACE." + `(tree-widget :tag ,(lsp--workspace-print workspace) + :open t + (tree-widget :tag ,(propertize "Buffers" 'face 'font-lock-function-name-face) + :open t + ,@(->> workspace + (lsp--workspace-buffers) + (--map `(tree-widget + :tag ,(when (lsp-buffer-live-p it) + (let ((buffer-name (lsp-buffer-name it))) + (if (lsp-with-current-buffer it buffer-read-only) + (propertize buffer-name 'face 'font-lock-constant-face) + buffer-name))))))) + (tree-widget :tag ,(propertize "Capabilities" 'face 'font-lock-function-name-face) + ,@(-> workspace lsp--workspace-server-capabilities lsp--map-tree-widget)))) + +(define-derived-mode lsp-browser-mode special-mode "LspBrowser" + "Define mode for displaying lsp sessions." + (setq-local display-buffer-base-action '(nil . ((inhibit-same-window . t))))) + +(defun lsp-describe-session () + "Describes current `lsp-session'." + (interactive) + (let ((session (lsp-session)) + (buf (get-buffer-create "*lsp session*")) + (root (lsp-workspace-root))) + (with-current-buffer buf + (lsp-browser-mode) + (let ((inhibit-read-only t)) + (erase-buffer) + (--each (lsp-session-folders session) + (widget-create + `(tree-widget + :tag ,(propertize it 'face 'font-lock-keyword-face) + :open t + ,@(->> session + (lsp-session-folder->servers) + (gethash it) + (-map 'lsp--render-workspace))))))) + (pop-to-buffer buf) + (goto-char (point-min)) + (cl-loop for tag = (widget-get (widget-get (widget-at) :node) :tag) + until (or (and root (string= tag root)) (eobp)) + do (goto-char (next-overlay-change (point)))))) + +(defun lsp--session-workspaces (session) + "Get all workspaces that are part of the SESSION." + (-> session lsp-session-folder->servers hash-table-values -flatten -uniq)) + +(defun lsp--find-multiroot-workspace (session client project-root) + "Look for a multiroot connection in SESSION created from CLIENT for +PROJECT-ROOT and BUFFER-MAJOR-MODE." + (when (lsp--client-multi-root client) + (-when-let (multi-root-workspace (->> session + (lsp--session-workspaces) + (--first (eq (-> it lsp--workspace-client lsp--client-server-id) + (lsp--client-server-id client))))) + (with-lsp-workspace multi-root-workspace + (lsp-notify "workspace/didChangeWorkspaceFolders" + (lsp-make-did-change-workspace-folders-params + :event (lsp-make-workspace-folders-change-event + :added (vector (lsp-make-workspace-folder + :uri (lsp--path-to-uri project-root) + :name (f-filename project-root))) + :removed [])))) + + (->> session (lsp-session-folder->servers) (gethash project-root) (cl-pushnew multi-root-workspace)) + (->> session (lsp-session-server-id->folders) (gethash (lsp--client-server-id client)) (cl-pushnew project-root)) + + (lsp--persist-session session) + + (lsp--info "Opened folder %s in workspace %s" project-root (lsp--workspace-print multi-root-workspace)) + (lsp--open-in-workspace multi-root-workspace) + + multi-root-workspace))) + +(defun lsp--ensure-lsp-servers (session clients project-root ignore-multi-folder) + "Ensure that SESSION contain server CLIENTS created for PROJECT-ROOT. +IGNORE-MULTI-FOLDER to ignore multi folder server." + (-map (lambda (client) + (or + (lsp--find-workspace session client project-root) + (unless ignore-multi-folder + (lsp--find-multiroot-workspace session client project-root)) + (lsp--start-connection session client project-root))) + clients)) + +(defun lsp--spinner-stop () + "Stop the spinner in case all of the workspaces are started." + (when (--all? (eq (lsp--workspace-status it) 'initialized) + lsp--buffer-workspaces) + (spinner-stop))) + +(defun lsp--open-in-workspace (workspace) + "Open in existing WORKSPACE." + (if (eq 'initialized (lsp--workspace-status workspace)) + ;; when workspace is initialized just call document did open. + (progn + (with-lsp-workspace workspace + (when-let ((before-document-open-fn (-> workspace + lsp--workspace-client + lsp--client-before-file-open-fn))) + (funcall before-document-open-fn workspace)) + (lsp--text-document-did-open)) + (lsp--spinner-stop)) + ;; when it is not initialized + (lsp--spinner-start) + (cl-pushnew (lsp-current-buffer) (lsp--workspace-buffers workspace)))) + +(defun lsp--find-workspace (session client project-root) + "Find server connection created with CLIENT in SESSION for PROJECT-ROOT." + (when-let ((workspace (->> session + (lsp-session-folder->servers) + (gethash project-root) + (--first (eql (-> it lsp--workspace-client lsp--client-server-id) + (lsp--client-server-id client)))))) + (lsp--open-in-workspace workspace) + workspace)) + +(defun lsp--read-char (prompt &optional options) + "Wrapper for `read-char-from-minibuffer' if Emacs +27. +Fallback to `read-key' otherwise. +PROMPT is the message and OPTIONS the available options." + (if (fboundp 'read-char-from-minibuffer) + (read-char-from-minibuffer prompt options) + (read-key prompt))) + +(defun lsp--find-root-interactively (session) + "Find project interactively. +Returns nil if the project should not be added to the current SESSION." + (condition-case nil + (let* ((project-root-suggestion (or (lsp--suggest-project-root) default-directory)) + (action (lsp--read-char + (format + "%s is not part of any project. + +%s ==> Import project root %s +%s ==> Import project by selecting root directory interactively +%s ==> Import project at current directory %s +%s ==> Do not ask again for the current project by adding %s to lsp-session-folders-blocklist +%s ==> Do not ask again for the current project by selecting ignore path interactively +%s ==> Do nothing: ask again when opening other files from the current project + +Select action: " + (propertize (buffer-name) 'face 'bold) + (propertize "i" 'face 'success) + (propertize project-root-suggestion 'face 'bold) + (propertize "I" 'face 'success) + (propertize "." 'face 'success) + (propertize default-directory 'face 'bold) + (propertize "d" 'face 'warning) + (propertize project-root-suggestion 'face 'bold) + (propertize "D" 'face 'warning) + (propertize "n" 'face 'warning)) + '(?i ?\r ?I ?. ?d ?D ?n)))) + (cl-case action + (?i project-root-suggestion) + (?\r project-root-suggestion) + (?I (read-directory-name "Select workspace folder to add: " + (or project-root-suggestion default-directory) + nil + t)) + (?. default-directory) + (?d (push project-root-suggestion (lsp-session-folders-blocklist session)) + (lsp--persist-session session) + nil) + (?D (push (read-directory-name "Select folder to blocklist: " + (or project-root-suggestion default-directory) + nil + t) + (lsp-session-folders-blocklist session)) + (lsp--persist-session session) + nil) + (t nil))) + (quit))) + +(declare-function tramp-file-name-host "ext:tramp" (file) t) +(declare-function tramp-dissect-file-name "ext:tramp" (file &optional nodefault)) + +(defun lsp--files-same-host (f1 f2) + "Predicate on whether or not two files are on the same host." + (or (not (or (file-remote-p f1) (file-remote-p f2))) + (and (file-remote-p f1) + (file-remote-p f2) + (progn (require 'tramp) + (equal (tramp-file-name-host (tramp-dissect-file-name f1)) + (tramp-file-name-host (tramp-dissect-file-name f2))))))) + +(defun lsp-find-session-folder (session file-name) + "Look in the current SESSION for folder containing FILE-NAME." + (let ((file-name-canonical (lsp-f-canonical file-name))) + (->> session + (lsp-session-folders) + (--filter (and (lsp--files-same-host it file-name-canonical) + (or (lsp-f-same? it file-name-canonical) + (and (f-dir? it) + (lsp-f-ancestor-of? it file-name-canonical))))) + (--max-by (> (length it) + (length other)))))) + +(defun lsp-find-workspace (server-id &optional file-name) + "Find workspace for SERVER-ID for FILE-NAME." + (-when-let* ((session (lsp-session)) + (folder->servers (lsp-session-folder->servers session)) + (workspaces (if file-name + (gethash (lsp-find-session-folder session file-name) folder->servers) + (lsp--session-workspaces session)))) + + (--first (eq (lsp--client-server-id (lsp--workspace-client it)) server-id) workspaces))) + +(defun lsp--calculate-root (session file-name) + "Calculate project root for FILE-NAME in SESSION." + (and + (->> session + (lsp-session-folders-blocklist) + (--first (and (lsp--files-same-host it file-name) + (lsp-f-ancestor-of? it file-name) + (prog1 t + (lsp--info "File %s is in blocklisted directory %s" file-name it)))) + not) + (or + (when lsp-auto-guess-root + (lsp--suggest-project-root)) + (unless lsp-guess-root-without-session + (lsp-find-session-folder session file-name)) + (unless lsp-auto-guess-root + (when-let ((root-folder (lsp--find-root-interactively session))) + (if (or (not (f-equal? root-folder (expand-file-name "~/"))) + (yes-or-no-p + (concat + (propertize "[WARNING] " 'face 'warning) + "You are trying to import your home folder as project root. This may cause performance issue because some language servers (python, lua, etc) will try to scan all files under project root. To avoid that you may: + +1. Use `I' option from the interactive project import to select subfolder(e. g. `~/foo/bar' instead of `~/'). +2. If your file is under `~/' then create a subfolder and move that file in this folder. + +Type `No' to go back to project selection. +Type `Yes' to confirm `HOME' as project root. +Type `C-g' to cancel project import process and stop `lsp'"))) + root-folder + (lsp--calculate-root session file-name))))))) + +(defun lsp--try-open-in-library-workspace () + "Try opening current file as library file in any of the active workspace. +The library folders are defined by each client for each of the active workspace." + (when-let ((workspace (->> (lsp-session) + (lsp--session-workspaces) + ;; Sort the last active workspaces first as they are more likely to be + ;; the correct ones, especially when jumping to a definition. + (-sort (lambda (a _b) + (-contains? lsp--last-active-workspaces a))) + (--first + (and (-> it lsp--workspace-client lsp--supports-buffer?) + (when-let ((library-folders-fn + (-> it lsp--workspace-client lsp--client-library-folders-fn))) + (-first (lambda (library-folder) + (lsp-f-ancestor-of? library-folder (buffer-file-name))) + (funcall library-folders-fn it)))))))) + (lsp--open-in-workspace workspace) + (view-mode t) + (lsp--info "Opening read-only library file %s." (buffer-file-name)) + (list workspace))) + +(defun lsp--persist-session (session) + "Persist SESSION to `lsp-session-file'." + (lsp--persist lsp-session-file (make-lsp-session + :folders (lsp-session-folders session) + :folders-blocklist (lsp-session-folders-blocklist session) + :server-id->folders (lsp-session-server-id->folders session)))) + +(defun lsp--try-project-root-workspaces (ask-for-client ignore-multi-folder) + "Try create opening file as a project file. +When IGNORE-MULTI-FOLDER is t the lsp mode will start new +language server even if there is language server which can handle +current language. When IGNORE-MULTI-FOLDER is nil current file +will be opened in multi folder language server if there is +such." + (-let ((session (lsp-session))) + (-if-let (clients (if ask-for-client + (list (lsp--completing-read "Select server to start: " + (ht-values lsp-clients) + (-compose 'symbol-name 'lsp--client-server-id) nil t)) + (lsp--find-clients))) + (-if-let (project-root (-some-> session + (lsp--calculate-root (buffer-file-name)) + (lsp-f-canonical))) + (progn + ;; update project roots if needed and persist the lsp session + (unless (-contains? (lsp-session-folders session) project-root) + (cl-pushnew project-root (lsp-session-folders session)) + (lsp--persist-session session)) + (lsp--ensure-lsp-servers session clients project-root ignore-multi-folder)) + (lsp--warn "%s not in project or it is blocklisted." (buffer-name)) + nil) + (lsp--warn "No LSP server for %s(check *lsp-log*)." major-mode) + nil))) + +(defun lsp-shutdown-workspace () + "Shutdown language server." + (interactive) + (--when-let (pcase (lsp-workspaces) + (`nil (user-error "There are no active servers in the current buffer")) + (`(,workspace) (when (y-or-n-p (format "Are you sure you want to stop the server %s?" + (lsp--workspace-print workspace))) + workspace)) + (workspaces (lsp--completing-read "Select server: " + workspaces + 'lsp--workspace-print nil t))) + (lsp-workspace-shutdown it))) + +(make-obsolete 'lsp-shutdown-workspace 'lsp-workspace-shutdown "lsp-mode 6.1") + +(defcustom lsp-auto-select-workspace t + "Shutdown or restart a single workspace. +If set and the current buffer has only a single workspace +associated with it, `lsp-shutdown-workspace' and +`lsp-restart-workspace' will act on it without asking." + :type 'boolean + :group 'lsp-mode) + +(defun lsp--read-workspace () + "Ask the user to select a workspace. +Errors if there are none." + (pcase (lsp-workspaces) + (`nil (error "No workspaces associated with the current buffer")) + ((and `(,workspace) (guard lsp-auto-select-workspace)) workspace) + (workspaces (lsp--completing-read "Select workspace: " workspaces + #'lsp--workspace-print nil t)))) + +(defun lsp-workspace-shutdown (workspace) + "Shut the workspace WORKSPACE and the language server associated with it" + (interactive (list (lsp--read-workspace))) + (lsp--warn "Stopping %s" (lsp--workspace-print workspace)) + (with-lsp-workspace workspace (lsp--shutdown-workspace))) + +(defun lsp-disconnect () + "Disconnect the buffer from the language server." + (interactive) + (lsp--text-document-did-close t) + (lsp-managed-mode -1) + (lsp-mode -1) + (setq lsp--buffer-workspaces nil) + (lsp--info "Disconnected")) + +(defun lsp-restart-workspace () + (interactive) + (--when-let (pcase (lsp-workspaces) + (`nil (user-error "There are no active servers in the current buffer")) + (`(,workspace) workspace) + (workspaces (lsp--completing-read "Select server: " + workspaces + 'lsp--workspace-print nil t))) + (lsp-workspace-restart it))) + +(make-obsolete 'lsp-restart-workspace 'lsp-workspace-restart "lsp-mode 6.1") + +(defun lsp-workspace-restart (workspace) + "Restart the workspace WORKSPACE and the language server associated with it" + (interactive (list (lsp--read-workspace))) + (lsp--warn "Restarting %s" (lsp--workspace-print workspace)) + (with-lsp-workspace workspace (lsp--shutdown-workspace t))) + +;;;###autoload +(defun lsp (&optional arg) + "Entry point for the server startup. +When ARG is t the lsp mode will start new language server even if +there is language server which can handle current language. When +ARG is nil current file will be opened in multi folder language +server if there is such. When `lsp' is called with prefix +argument ask the user to select which language server to start." + (interactive "P") + + (lsp--require-packages) + + (when (buffer-file-name) + (let (clients + (matching-clients (lsp--filter-clients + (-andfn #'lsp--supports-buffer? + #'lsp--server-binary-present?)))) + (cond + (matching-clients + (when (setq lsp--buffer-workspaces + (or (and + ;; Don't open as library file if file is part of a project. + (not (lsp-find-session-folder (lsp-session) (buffer-file-name))) + (lsp--try-open-in-library-workspace)) + (lsp--try-project-root-workspaces (equal arg '(4)) + (and arg (not (equal arg 1)))))) + (lsp-mode 1) + (when lsp-auto-configure (lsp--auto-configure)) + (setq lsp-buffer-uri (lsp--buffer-uri)) + (lsp--info "Connected to %s." + (apply 'concat (--map (format "[%s %s]" + (lsp--workspace-print it) + (lsp--workspace-root it)) + lsp--buffer-workspaces))))) + ;; look for servers which are currently being downloaded. + ((setq clients (lsp--filter-clients (-andfn #'lsp--supports-buffer? + #'lsp--client-download-in-progress?))) + (lsp--info "There are language server(%s) installation in progress. +The server(s) will be started in the buffer when it has finished." + (-map #'lsp--client-server-id clients)) + (seq-do (lambda (client) + (cl-pushnew (current-buffer) (lsp--client-buffers client))) + clients)) + ;; look for servers to install + ((setq clients (lsp--filter-clients + (-andfn #'lsp--supports-buffer? + (-const lsp-enable-suggest-server-download) + #'lsp--client-download-server-fn + (-not #'lsp--client-download-in-progress?)))) + (let ((client (lsp--completing-read + (concat "Unable to find installed server supporting this file. " + "The following servers could be installed automatically: ") + clients + (-compose #'symbol-name #'lsp--client-server-id) + nil + t))) + (cl-pushnew (current-buffer) (lsp--client-buffers client)) + (lsp--install-server-internal client))) + ;; ignore other warnings + ((not lsp-warn-no-matched-clients) + nil) + ;; automatic installation disabled + ((setq clients (unless matching-clients + (lsp--filter-clients (-andfn #'lsp--supports-buffer? + #'lsp--client-download-server-fn + (-not (-const lsp-enable-suggest-server-download)) + (-not #'lsp--server-binary-present?))))) + (lsp--warn "The following servers support current file but automatic download is disabled: %s +\(If you have already installed the server check *lsp-log*)." + (mapconcat (lambda (client) + (symbol-name (lsp--client-server-id client))) + clients + " "))) + ;; no clients present + ((setq clients (unless matching-clients + (lsp--filter-clients (-andfn #'lsp--supports-buffer? + (-not #'lsp--server-binary-present?))))) + (lsp--warn "The following servers support current file but do not have automatic installation: %s +You may find the installation instructions at https://emacs-lsp.github.io/lsp-mode/page/languages. +\(If you have already installed the server check *lsp-log*)." + (mapconcat (lambda (client) + (symbol-name (lsp--client-server-id client))) + clients + " "))) + ;; no matches + ((-> #'lsp--supports-buffer? lsp--filter-clients not) + (lsp--error "There are no language servers supporting current mode `%s' registered with `lsp-mode'. +This issue might be caused by: +1. The language you are trying to use does not have built-in support in `lsp-mode'. You must install the required support manually. Examples of this are `lsp-java' or `lsp-metals'. +2. The language server that you expect to run is not configured to run for major mode `%s'. You may check that by checking the `:major-modes' that are passed to `lsp-register-client'. +3. `lsp-mode' doesn't have any integration for the language behind `%s'. Refer to https://emacs-lsp.github.io/lsp-mode/page/languages and https://langserver.org/ . +4. You are over `tramp'. In this case follow https://emacs-lsp.github.io/lsp-mode/page/remote/. +5. You have disabled the `lsp-mode' clients for that file. (Check `lsp-enabled-clients' and `lsp-disabled-clients'). +You can customize `lsp-warn-no-matched-clients' to disable this message." + major-mode major-mode major-mode)))))) + +(defun lsp--buffer-visible-p () + "Return non nil if current buffer is visible." + (or (buffer-modified-p) (get-buffer-window nil t))) + +(defun lsp--init-if-visible () + "Run `lsp' for the current buffer if the buffer is visible. +Returns non nil if `lsp' was run for the buffer." + (when (lsp--buffer-visible-p) + (remove-hook 'window-configuration-change-hook #'lsp--init-if-visible t) + (lsp) + t)) + +;;;###autoload +(defun lsp-deferred () + "Entry point that defers server startup until buffer is visible. +`lsp-deferred' will wait until the buffer is visible before invoking `lsp'. +This avoids overloading the server with many files when starting Emacs." + ;; Workspace may not be initialized yet. Use a buffer local variable to + ;; remember that we deferred loading of this buffer. + (setq lsp--buffer-deferred t) + (let ((buffer (current-buffer))) + ;; Avoid false positives as desktop-mode restores buffers by deferring + ;; visibility check until the stack clears. + (run-with-idle-timer 0 nil (lambda () + (when (buffer-live-p buffer) + (with-current-buffer buffer + (unless (lsp--init-if-visible) + (add-hook 'window-configuration-change-hook #'lsp--init-if-visible nil t)))))))) + + + +(defvar lsp-file-truename-cache (ht)) + +(defmacro lsp-with-cached-filetrue-name (&rest body) + "Executes BODY caching the `file-truename' calls." + `(let ((old-fn (symbol-function 'file-truename))) + (unwind-protect + (progn + (fset 'file-truename + (lambda (file-name &optional counter prev-dirs) + (or (gethash file-name lsp-file-truename-cache) + (puthash file-name (apply old-fn (list file-name counter prev-dirs)) + lsp-file-truename-cache)))) + ,@body) + (fset 'file-truename old-fn)))) + + +(defun lsp-virtual-buffer-call (key &rest args) + (when lsp--virtual-buffer + (when-let ((fn (plist-get lsp--virtual-buffer key))) + (apply fn args)))) + +(defun lsp-translate-column (column) + "Translate COLUMN taking into account virtual buffers." + (or (lsp-virtual-buffer-call :real->virtual-char column) + column)) + +(defun lsp-translate-line (line) + "Translate LINE taking into account virtual buffers." + (or (lsp-virtual-buffer-call :real->virtual-line line) + line)) + + +;; lsp internal validation. + +(defmacro lsp--doctor (&rest checks) + `(-let [buf (current-buffer)] + (with-current-buffer (get-buffer-create "*lsp-performance*") + (with-help-window (current-buffer) + ,@(-map (-lambda ((msg form)) + `(insert (format "%s: %s\n" ,msg + (let ((res (with-current-buffer buf + ,form))) + (cond + ((eq res :optional) (propertize "OPTIONAL" 'face 'warning)) + (res (propertize "OK" 'face 'success)) + (t (propertize "ERROR" 'face 'error))))))) + (-partition 2 checks)))))) + +(define-obsolete-function-alias 'lsp-diagnose + 'lsp-doctor "lsp-mode 8.0.0") + +(defun lsp-doctor () + "Validate performance settings." + (interactive) + (lsp--doctor + "Checking for Native JSON support" (functionp 'json-serialize) + "Check emacs supports `read-process-output-max'" (boundp 'read-process-output-max) + "Check `read-process-output-max' default has been changed from 4k" + (and (boundp 'read-process-output-max) + (> read-process-output-max 4096)) + "Byte compiled against Native JSON (recompile lsp-mode if failing when Native JSON available)" + (condition-case _err + (progn (lsp--make-message (list "a" "b")) + nil) + (error t)) + "`gc-cons-threshold' increased?" (> gc-cons-threshold 800000) + "Using `plist' for deserialized objects? (refer to https://emacs-lsp.github.io/lsp-mode/page/performance/#use-plists-for-deserialization)" (or lsp-use-plists :optional) + "Using emacs 28+ with native compilation?" + (or (and (fboundp 'native-comp-available-p) + (native-comp-available-p)) + :optional))) + +(declare-function package-version-join "ext:package") +(declare-function package-desc-version "ext:package") +(declare-function package--alist "ext:package") + +(defun lsp-version () + "Return string describing current version of `lsp-mode'." + (interactive) + (unless (featurep 'package) + (require 'package)) + (let ((ver (format "lsp-mode %s, Emacs %s, %s" + (package-version-join + (package-desc-version + (car (alist-get 'lsp-mode (package--alist))))) + emacs-version + system-type))) + (if (called-interactively-p 'interactive) + (lsp--info "%s" ver) + ver))) + + + +;; org-mode/virtual-buffer + +(declare-function org-babel-get-src-block-info "ext:ob-core") +(declare-function org-do-remove-indentation "ext:org-macs") +(declare-function org-src-get-lang-mode "ext:org-src") +(declare-function org-element-context "ext:org-element") + +(defun lsp--virtual-buffer-update-position () + (-if-let (virtual-buffer (-first (-lambda ((&plist :in-range)) + (funcall in-range)) + lsp--virtual-buffer-connections)) + (unless (equal virtual-buffer lsp--virtual-buffer) + (lsp-org)) + (when lsp-managed-mode + (lsp-managed-mode -1) + (lsp-mode -1) + (setq lsp--buffer-workspaces nil) + (setq lsp--virtual-buffer nil) + (setq lsp-buffer-uri nil) + + ;; force refresh of diagnostics + (run-hooks 'lsp-after-diagnostics-hook)))) + +(defun lsp-virtual-buffer-on-change (start end length) + "Adjust on change event to be executed against the proper language server." + (let ((max-point (max end + (or (plist-get lsp--before-change-vals :end) 0) + (+ start length)))) + (when-let ((virtual-buffer (-first (lambda (vb) + (let ((lsp--virtual-buffer vb)) + (and (lsp-virtual-buffer-call :in-range start) + (lsp-virtual-buffer-call :in-range max-point)))) + lsp--virtual-buffer-connections))) + (lsp-with-current-buffer virtual-buffer + (lsp-on-change start end length + (lambda (&rest _) + (list :range (lsp--range (list :character 0 :line 0) + lsp--virtual-buffer-point-max) + :text (lsp--buffer-content)))))))) + +(defun lsp-virtual-buffer-before-change (start _end) + (when-let ((virtual-buffer (-first (lambda (vb) + (lsp-with-current-buffer vb + (lsp-virtual-buffer-call :in-range start))) + lsp--virtual-buffer-connections))) + (lsp-with-current-buffer virtual-buffer + (setq lsp--virtual-buffer-point-max + (lsp--point-to-position (lsp-virtual-buffer-call :last-point)))))) + +(defun lsp-patch-on-change-event () + (remove-hook 'after-change-functions #'lsp-on-change t) + (add-hook 'after-change-functions #'lsp-virtual-buffer-on-change nil t) + (add-hook 'before-change-functions #'lsp-virtual-buffer-before-change nil t)) + +(defun lsp-kill-virtual-buffers () + (mapc #'lsp-virtual-buffer-disconnect lsp--virtual-buffer-connections)) + +(defun lsp--move-point-in-indentation (point indentation) + (save-excursion + (goto-char point) + (if (<= point (+ (line-beginning-position) indentation)) + (line-beginning-position) + point))) + +(declare-function flycheck-checker-supports-major-mode-p "ext:flycheck") +(declare-function flycheck-add-mode "ext:flycheck") +(declare-function lsp-diagnostics-lsp-checker-if-needed "lsp-diagnostics") + +(defalias 'lsp-client-download-server-fn 'lsp--client-download-server-fn) + +(defun lsp-flycheck-add-mode (mode) + "Register flycheck support for MODE." + (lsp-diagnostics-lsp-checker-if-needed) + (unless (flycheck-checker-supports-major-mode-p 'lsp mode) + (flycheck-add-mode 'lsp mode))) + +(defun lsp-progress-spinner-type () + "Retrieve the spinner type value, if value is not a symbol of `spinner-types +defaults to `progress-bar." + (or (car (assoc lsp-progress-spinner-type spinner-types)) 'progress-bar)) + +(defun lsp-org () + (interactive) + (-if-let ((virtual-buffer &as &plist :workspaces) (-first (-lambda ((&plist :in-range)) + (funcall in-range)) + lsp--virtual-buffer-connections)) + (unless (equal lsp--virtual-buffer virtual-buffer) + (setq lsp--buffer-workspaces workspaces) + (setq lsp--virtual-buffer virtual-buffer) + (setq lsp-buffer-uri nil) + (lsp-mode 1) + (lsp-managed-mode 1) + (lsp-patch-on-change-event)) + + (save-excursion + (-let* (virtual-buffer + (wcb (lambda (f) + (with-current-buffer (plist-get virtual-buffer :buffer) + (-let* (((&plist :major-mode :buffer-file-name + :goto-buffer :workspaces) virtual-buffer) + (lsp--virtual-buffer virtual-buffer) + (lsp--buffer-workspaces workspaces)) + (save-excursion + (funcall goto-buffer) + (funcall f)))))) + ((&plist :begin :end :post-blank :language) (cl-second (org-element-context))) + ((&alist :tangle file-name) (cl-third (org-babel-get-src-block-info 'light))) + + (file-name (if file-name + (f-expand file-name) + (user-error "You should specify file name in the src block header."))) + (begin-marker (progn + (goto-char begin) + (forward-line) + (set-marker (make-marker) (point)))) + (end-marker (progn + (goto-char end) + (forward-line (1- (- post-blank))) + (set-marker (make-marker) (1+ (point))))) + (buf (current-buffer)) + (src-block (buffer-substring-no-properties begin-marker + (1- end-marker))) + (indentation (with-temp-buffer + (insert src-block) + + (goto-char (point-min)) + (let ((indentation (current-indentation))) + (plist-put lsp--virtual-buffer :indentation indentation) + (org-do-remove-indentation) + (goto-char (point-min)) + (- indentation (current-indentation)))))) + (add-hook 'post-command-hook #'lsp--virtual-buffer-update-position nil t) + + (when (fboundp 'flycheck-add-mode) + (lsp-flycheck-add-mode 'org-mode)) + + (setq lsp--virtual-buffer + (list + :in-range (lambda (&optional point) + (<= begin-marker (or point (point)) (1- end-marker))) + :goto-buffer (lambda () (goto-char begin-marker)) + :buffer-string + (lambda () + (let ((src-block (buffer-substring-no-properties + begin-marker + (1- end-marker)))) + (with-temp-buffer + (insert src-block) + + (goto-char (point-min)) + (while (not (eobp)) + (delete-region (point) (if (> (+ (point) indentation) (line-end-position)) + (line-end-position) + (+ (point) indentation))) + (forward-line)) + (buffer-substring-no-properties (point-min) + (point-max))))) + :buffer buf + :begin begin-marker + :end end-marker + :indentation indentation + :last-point (lambda () (1- end-marker)) + :cur-position (lambda () + (lsp-save-restriction-and-excursion + (list :line (- (lsp--cur-line) + (lsp--cur-line begin-marker)) + :character (let ((character (- (point) + (line-beginning-position) + indentation))) + (if (< character 0) + 0 + character))))) + :line/character->point (-lambda (line character) + (-let [inhibit-field-text-motion t] + (+ indentation + (lsp-save-restriction-and-excursion + (goto-char begin-marker) + (forward-line line) + (-let [line-end (line-end-position)] + (if (> character (- line-end (point))) + line-end + (forward-char character) + (point))))))) + :major-mode (org-src-get-lang-mode language) + :buffer-file-name file-name + :buffer-uri (lsp--path-to-uri file-name) + :with-current-buffer wcb + :buffer-live? (lambda (_) (buffer-live-p buf)) + :buffer-name (lambda (_) + (propertize (format "%s(%s:%s)%s" + (buffer-name buf) + begin-marker + end-marker + language) + 'face 'italic)) + :real->virtual-line (lambda (line) + (+ line (line-number-at-pos begin-marker) -1)) + :real->virtual-char (lambda (char) (+ char indentation)) + :cleanup (lambda () + (set-marker begin-marker nil) + (set-marker end-marker nil)))) + (setf virtual-buffer lsp--virtual-buffer) + (puthash file-name virtual-buffer lsp--virtual-buffer-mappings) + (push virtual-buffer lsp--virtual-buffer-connections) + + ;; TODO: tangle only connected sections + (add-hook 'after-save-hook 'org-babel-tangle nil t) + (add-hook 'lsp-after-open-hook #'lsp-patch-on-change-event nil t) + (add-hook 'kill-buffer-hook #'lsp-kill-virtual-buffers nil t) + + (setq lsp--buffer-workspaces + (lsp-with-current-buffer virtual-buffer + (lsp) + (plist-put virtual-buffer :workspaces (lsp-workspaces)) + (lsp-workspaces))))))) + +(defun lsp-virtual-buffer-disconnect (virtual-buffer) + (interactive (list (or + lsp--virtual-buffer + (when lsp--virtual-buffer-connections + (lsp--completing-read "Select virtual buffer to disconnect: " + lsp--virtual-buffer-connections + (-lambda ((&plist :buffer-file-name)) + buffer-file-name)))))) + (-if-let ((&plist :buffer-file-name file-name :cleanup) virtual-buffer) + (progn + (lsp-with-current-buffer virtual-buffer + (lsp--text-document-did-close)) + (setq lsp--virtual-buffer-connections (-remove-item virtual-buffer lsp--virtual-buffer-connections)) + (when (eq virtual-buffer lsp--virtual-buffer) + (setf lsp--virtual-buffer nil)) + (when cleanup (funcall cleanup)) + (remhash file-name lsp--virtual-buffer-mappings) + + (lsp--virtual-buffer-update-position) + (lsp--info "Disconnected from buffer %s" file-name)) + (lsp--error "Nothing to disconnect from?"))) + + +;; inlay hints + +(defface lsp-inlay-hint-face + '((t :inherit font-lock-comment-face)) + "The face to use for the JavaScript inlays." + :group 'lsp-mode + :package-version '(lsp-mode . "9.0.0")) + +(defface lsp-inlay-hint-type-face + '((t :inherit lsp-inlay-hint-face)) + "Face for inlay type hints (e.g. inferred variable types)." + :group 'lsp-mode + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-inlay-hint-type-format "%s" + "Format string for variable inlays (part of the inlay face)." + :type '(string :tag "String") + :group 'lsp-mode + :package-version '(lsp-mode . "9.0.0")) + +(defface lsp-inlay-hint-parameter-face + '((t :inherit lsp-inlay-hint-face)) + "Face for inlay parameter hints (e.g. function parameter names at +call-site)." + :group 'lsp-mode + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-inlay-hint-param-format "%s" + "Format string for parameter inlays (part of the inlay face)." + :type '(string :tag "String") + :group 'lsp-mode + :package-version '(lsp-mode . "9.0.0")) + +(defcustom lsp-update-inlay-hints-on-scroll t + "If non-nil update inlay hints immediately when scrolling or +modifying window sizes." + :type 'boolean + :package-version '(lsp-mode . "9.0.0")) + +(defun lsp--format-inlay (text kind) + (cond + ((eql kind lsp/inlay-hint-kind-type-hint) (format lsp-inlay-hint-type-format text)) + ((eql kind lsp/inlay-hint-kind-parameter-hint) (format lsp-inlay-hint-param-format text)) + (t text))) + +(defun lsp--face-for-inlay (kind) + (cond + ((eql kind lsp/inlay-hint-kind-type-hint) 'lsp-inlay-hint-type-face) + ((eql kind lsp/inlay-hint-kind-parameter-hint) 'lsp-inlay-hint-parameter-face) + (t 'lsp-inlay-hint-face))) + +(defun lsp--update-inlay-hints-scroll-function (window start) + (lsp-update-inlay-hints start (window-end window t))) + +(defun lsp--update-inlay-hints () + (lsp-update-inlay-hints (window-start) (window-end nil t))) + +(defun lsp--label-from-inlay-hints-response (label) + "Returns a string label built from an array of +InlayHintLabelParts or the argument itself if it's already a +string." + (cl-typecase label + (string label) + (vector + (string-join (mapcar (lambda (part) + (-let (((&InlayHintLabelPart :value) part)) + value)) + label))))) + +(defun lsp-update-inlay-hints (start end) + (lsp-request-async + "textDocument/inlayHint" + (lsp-make-inlay-hints-params + :text-document (lsp--text-document-identifier) + :range (lsp-make-range :start + (lsp-point-to-position start) + :end + (lsp-point-to-position end))) + (lambda (res) + (lsp--remove-overlays 'lsp-inlay-hint) + (dolist (hint res) + (-let* (((&InlayHint :label :position :kind? :padding-left? :padding-right?) hint) + (kind (or kind? lsp/inlay-hint-kind-type-hint)) + (label (lsp--label-from-inlay-hints-response label)) + (pos (lsp--position-to-point position)) + (overlay (make-overlay pos pos nil 'front-advance 'end-advance))) + (when (stringp label) + (overlay-put overlay 'lsp-inlay-hint t) + (overlay-put overlay 'before-string + (format "%s%s%s" + (if padding-left? " " "") + (propertize (lsp--format-inlay label kind) + 'font-lock-face (lsp--face-for-inlay kind)) + (if padding-right? " " ""))))))) + :mode 'tick)) + +(define-minor-mode lsp-inlay-hints-mode + "Mode for displaying inlay hints." + :lighter nil + (cond + ((and lsp-inlay-hints-mode lsp--buffer-workspaces) + (add-hook 'lsp-on-idle-hook #'lsp--update-inlay-hints nil t) + (when lsp-update-inlay-hints-on-scroll + (add-to-list (make-local-variable 'window-scroll-functions) + #'lsp--update-inlay-hints-scroll-function))) + (t + (lsp--remove-overlays 'lsp-inlay-hint) + (remove-hook 'lsp-on-idle-hook #'lsp--update-inlay-hints t) + (setf window-scroll-functions + (delete #'lsp--update-inlay-hints-scroll-function window-scroll-functions))))) + + + +;;;###autoload +(defun lsp-start-plain () + "Start `lsp-mode' using minimal configuration using the latest `melpa' version +of the packages. + +In case the major-mode that you are using for " + (interactive) + (let ((start-plain (make-temp-file "plain" nil ".el"))) + (url-copy-file "https://raw.githubusercontent.com/emacs-lsp/lsp-mode/master/scripts/lsp-start-plain.el" + start-plain t) + (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/emacs/elpa/lsp-mode-20240625.344/lsp-mode.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-mode.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-modeline.el b/emacs/elpa/lsp-mode-20240625.344/lsp-modeline.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-modeline.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-modeline.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-mojo.el b/emacs/elpa/lsp-mode-20240625.344/lsp-mojo.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-mojo.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-mojo.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-move.el b/emacs/elpa/lsp-mode-20240625.344/lsp-move.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-move.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-move.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-nginx.el b/emacs/elpa/lsp-mode-20240625.344/lsp-nginx.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-nginx.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-nginx.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-nim.el b/emacs/elpa/lsp-mode-20240625.344/lsp-nim.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-nim.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-nim.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-nix.el b/emacs/elpa/lsp-mode-20240625.344/lsp-nix.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-nix.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-nix.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-nushell.el b/emacs/elpa/lsp-mode-20240625.344/lsp-nushell.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-nushell.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-nushell.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-ocaml.el b/emacs/elpa/lsp-mode-20240625.344/lsp-ocaml.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-ocaml.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-ocaml.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-openscad.el b/emacs/elpa/lsp-mode-20240625.344/lsp-openscad.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-openscad.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-openscad.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-perl.el b/emacs/elpa/lsp-mode-20240625.344/lsp-perl.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-perl.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-perl.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-perlnavigator.el b/emacs/elpa/lsp-mode-20240625.344/lsp-perlnavigator.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-perlnavigator.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-perlnavigator.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-php.el b/emacs/elpa/lsp-mode-20240625.344/lsp-php.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-php.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-php.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-pls.el b/emacs/elpa/lsp-mode-20240625.344/lsp-pls.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-pls.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-pls.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-prolog.el b/emacs/elpa/lsp-mode-20240625.344/lsp-prolog.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-prolog.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-prolog.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-protocol.el b/emacs/elpa/lsp-mode-20240625.344/lsp-protocol.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-protocol.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-protocol.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-purescript.el b/emacs/elpa/lsp-mode-20240625.344/lsp-purescript.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-purescript.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-purescript.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-pwsh.el b/emacs/elpa/lsp-mode-20240625.344/lsp-pwsh.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-pwsh.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-pwsh.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-pyls.el b/emacs/elpa/lsp-mode-20240625.344/lsp-pyls.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-pyls.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-pyls.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-pylsp.el b/emacs/elpa/lsp-mode-20240625.344/lsp-pylsp.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-pylsp.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-pylsp.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-qml.el b/emacs/elpa/lsp-mode-20240625.344/lsp-qml.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-qml.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-qml.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-r.el b/emacs/elpa/lsp-mode-20240625.344/lsp-r.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-r.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-r.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-racket.el b/emacs/elpa/lsp-mode-20240625.344/lsp-racket.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-racket.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-racket.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-remark.el b/emacs/elpa/lsp-mode-20240625.344/lsp-remark.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-remark.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-remark.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-rf.el b/emacs/elpa/lsp-mode-20240625.344/lsp-rf.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-rf.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-rf.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240625.344/lsp-roslyn.el b/emacs/elpa/lsp-mode-20240625.344/lsp-roslyn.el @@ -0,0 +1,361 @@ +;;; lsp-roslyn.el --- description -*- lexical-binding: t; -*- + +;; Copyright (C) 2023 Ruin0x11 + +;; Author: Ruin0x11 <ipickering2@gmail.com> +;; Keywords: + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; C# client using the Roslyn language server + +;;; Code: + +(require 'lsp-mode) + +(defgroup lsp-roslyn nil + "LSP support for the C# programming language, using the Roslyn language server." + :link '(url-link "https://github.com/dotnet/roslyn/tree/main/src/Features/LanguageServer") + :group 'lsp-mode + :package-version '(lsp-mode . "8.0.0")) + +(defvar lsp-roslyn--stdpipe-path (expand-file-name + "lsp-roslyn-stdpipe.ps1" + (file-name-directory (file-truename load-file-name))) + "Path to the `stdpipe' script. +On Windows, this script is used as a proxy for the language server's named pipe. +Unused on other platforms.") + +(defcustom lsp-roslyn-install-path (expand-file-name "roslyn" lsp-server-install-dir) + "The path to install the Roslyn server to." + :type 'string + :package-version '(lsp-mode . "8.0.0") + :group 'lsp-roslyn) + +(defcustom lsp-roslyn-server-dll-override-path nil + "Custom path to Microsoft.CodeAnalysis.LanguageServer.dll." + :type '(choice (const nil) string) + :package-version '(lsp-mode . "8.0.0") + :group 'lsp-roslyn) + +(defcustom lsp-roslyn-server-timeout-seconds 60 + "Amount of time to wait for Roslyn server startup, in seconds." + :type 'integer + :package-version '(lsp-mode . "8.0.0") + :group 'lsp-roslyn) + +(defcustom lsp-roslyn-server-log-level "Information" + "Log level for the Roslyn language server." + :type '(choice (:tag "None" "Trace" "Debug" "Information" "Warning" "Error" "Critical")) + :package-version '(lsp-mode . "8.0.0") + :group 'lsp-roslyn) + +(defcustom lsp-roslyn-server-log-directory (concat (temporary-file-directory) (file-name-as-directory "lsp-roslyn")) + "Log directory for the Roslyn language server." + :type 'string + :package-version '(lsp-mode . "8.0.0") + :group 'lsp-roslyn) + +(defcustom lsp-roslyn-server-extra-args '() + "Extra arguments for the Roslyn language server." + :type '(repeat string) + :package-version '(lsp-mode . "8.0.0") + :group 'lsp-roslyn) + +(defcustom lsp-roslyn-dotnet-executable "dotnet" + "Dotnet executable to use with the Roslyn language server." + :type 'string + :package-version '(lsp-mode . "8.0.0") + :group 'lsp-roslyn) + +(defcustom lsp-roslyn-package-version "4.9.0-3.23604.10" + "Version of the Roslyn package to install." + :type 'string + :package-version '(lsp-mode . "8.0.0") + :group 'lsp-roslyn) + +(defvar lsp-roslyn--pipe-name nil) + +(defun lsp-roslyn--parse-pipe-name (pipe) + (if (eq system-type 'windows-nt) + (progn + (string-match "\\([a-z0-9]+\\)$" pipe) + (match-string 1 pipe)) + pipe)) + +(defun lsp-roslyn--parent-process-filter (_process output) + "Parses the named pipe's name that the Roslyn server process prints on stdout." + (let* ((data (json-parse-string output :object-type 'plist)) + (pipe (plist-get data :pipeName))) + (when pipe + (setq lsp-roslyn--pipe-name (lsp-roslyn--parse-pipe-name pipe))))) + +(defun lsp-roslyn--make-named-pipe-process (filter sentinel environment-fn process-name stderr-buf) + "Creates the process that will handle the JSON-RPC communication." + (let* ((process-environment + (lsp--compute-process-environment environment-fn)) + (default-directory (lsp--default-directory-for-connection))) + (cond + ((eq system-type 'windows-nt) + (make-process + :name process-name + :connection-type 'pipe + :buffer (format "*%s*" process-name) + :coding 'no-conversion + :filter filter + :sentinel sentinel + :stderr stderr-buf + :noquery t + :command (list "PowerShell" "-NoProfile" "-ExecutionPolicy" "Bypass" "-Command" lsp-roslyn--stdpipe-path "." lsp-roslyn--pipe-name))) + (t (make-network-process + :name process-name + :remote lsp-roslyn--pipe-name + :sentinel sentinel + :filter filter + :noquery t))))) + +(defun lsp-roslyn--connect (filter sentinel name environment-fn _workspace) + "Creates a connection to the Roslyn language server's named pipe. + +First creates an instance of the language server process, then +creates another process connecting to the named pipe it specifies." + (setq lsp-roslyn--pipe-name nil) + (let* ((parent-process-name name) + (parent-stderr-buf (format "*%s::stderr*" parent-process-name)) + (command-process (make-process + :name parent-process-name + :buffer (generate-new-buffer-name parent-process-name) + :coding 'no-conversion + :filter 'lsp-roslyn--parent-process-filter + :sentinel sentinel + :stderr parent-stderr-buf + :command (append + (list lsp-roslyn-dotnet-executable + (lsp-roslyn--get-server-dll-path) + (format "--logLevel=%s" lsp-roslyn-server-log-level) + (format "--extensionLogDirectory=%s" lsp-roslyn-server-log-directory)) + lsp-roslyn-server-extra-args) + :noquery t))) + (accept-process-output command-process lsp-roslyn-server-timeout-seconds) ; wait for JSON with pipe name to print on stdout, like {"pipeName":"\\\\.\\pipe\\d1b72351"} + (when (not lsp-roslyn--pipe-name) + (error "Failed to receieve pipe name from Roslyn server process")) + (let* ((process-name (generate-new-buffer-name (format "%s-pipe" name))) + (stderr-buf (format "*%s::stderr*" process-name)) + (communication-process + (lsp-roslyn--make-named-pipe-process filter sentinel environment-fn process-name stderr-buf))) + (with-current-buffer (get-buffer parent-stderr-buf) + (special-mode)) + (when-let ((stderr-buffer (get-buffer stderr-buf))) + (with-current-buffer stderr-buffer + ;; Make the *NAME::stderr* buffer buffer-read-only, q to bury, etc. + (special-mode)) + (set-process-query-on-exit-flag (get-buffer-process stderr-buffer) nil)) + (set-process-query-on-exit-flag command-process nil) + (set-process-query-on-exit-flag communication-process nil) + (cons communication-process communication-process)))) + +(defun lsp-roslyn--uri-to-path (uri) + "Convert a URI to a file path, without unhexifying." + (let* ((url (url-generic-parse-url uri)) + (type (url-type url)) + (target (url-target url)) + (file + (concat (decode-coding-string (url-filename url) + (or locale-coding-system 'utf-8)) + (when (and target + (not (s-match + (rx "#" (group (1+ num)) (or "," "#") + (group (1+ num)) + string-end) + uri))) + (concat "#" target)))) + (file-name (if (and type (not (string= type "file"))) + (if-let ((handler (lsp--get-uri-handler type))) + (funcall handler uri) + uri) + ;; `url-generic-parse-url' is buggy on windows: + ;; https://github.com/emacs-lsp/lsp-mode/pull/265 + (or (and (eq system-type 'windows-nt) + (eq (elt file 0) ?\/) + (substring file 1)) + file)))) + (->> file-name + (concat (-some #'lsp--workspace-host-root (lsp-workspaces))) + (lsp-remap-path-if-needed)))) + +(defun lsp-roslyn--path-to-uri (path) + "Convert PATH to a URI, without hexifying." + (url-unhex-string (lsp--path-to-uri-1 path))) + +(lsp-defun lsp-roslyn--log-message (_workspace params) + (let ((type (gethash "type" params)) + (mes (gethash "message" params))) + (cl-case type + (1 (lsp--error "%s" mes)) ; Error + (2 (lsp--warn "%s" mes)) ; Warning + (3 (lsp--info "%s" mes)) ; Info + (t (lsp--info "%s" mes))))) ; Log + +(lsp-defun lsp-roslyn--on-project-initialization-complete (workspace _params) + (lsp--info "%s: Project initialized successfully." + (lsp--workspace-print workspace))) + +(defun lsp-roslyn--find-files-in-parent-directories (directory regex &optional result) + "Search DIRECTORY for files matching REGEX and return their full paths if found." + (let* ((parent-dir (file-truename (concat (file-name-directory directory) "../"))) + (found (directory-files directory 't regex)) + (result (append (or result '()) found))) + (if (and (not (string= (file-truename directory) parent-dir)) + (< (length parent-dir) (length (file-truename directory)))) + (lsp-roslyn--find-files-in-parent-directories parent-dir regex result) + result))) + +(defun lsp-roslyn--pick-solution-file-interactively (solution-files) + (completing-read "Solution file for this workspace: " solution-files nil t)) + +(defun lsp-roslyn--find-solution-file () + (let ((solutions (lsp-roslyn--find-files-in-parent-directories + (file-name-directory (buffer-file-name)) + (rx (* any) ".sln" eos)))) + (cond + ((not solutions) nil) + ((eq (length solutions) 1) (cl-first solutions)) + (t (lsp-roslyn--pick-solution-file-interactively solutions))))) + +(defun lsp-roslyn-open-solution-file () + "Chooses the solution file to associate with the Roslyn language server." + (interactive) + (let ((solution-file (lsp-roslyn--find-solution-file))) + (if solution-file + (lsp-notify "solution/open" (list :solution (lsp--path-to-uri solution-file))) + (lsp--error "No solution file was found for this workspace.")))) + +(defun lsp-roslyn--on-initialized (_workspace) + "Handler for Roslyn server initialization." + (lsp-roslyn-open-solution-file)) + +(defun lsp-roslyn--get-package-name () + "Gets the package name of the Roslyn language server." + (format "microsoft.codeanalysis.languageserver.%s" (lsp-roslyn--get-rid))) + +(defun lsp-roslyn--get-server-dll-path () + "Gets the path to the language server DLL. +Assumes it was installed with the server install function." + (if lsp-roslyn-server-dll-override-path + lsp-roslyn-server-dll-override-path + (f-join lsp-roslyn-install-path "out" + (lsp-roslyn--get-package-name) + lsp-roslyn-package-version + "content" "LanguageServer" + (lsp-roslyn--get-rid) + "Microsoft.CodeAnalysis.LanguageServer.dll"))) + +(defun lsp-roslyn--get-rid () + "Retrieves the .NET Runtime Identifier (RID) for the current system." + (let* ((is-x64 (string-match-p "x86_64" system-configuration)) + (is-x86 (and (string-match-p "x86" system-configuration) (not is-x64))) + (is-arm (string-match-p "arm" system-configuration))) + (if-let ((platform-name (cond + ((eq system-type 'gnu/linux) "linux") + ((eq system-type 'darwin) "osx") + ((eq system-type 'windows-nt) "win"))) + (arch-name (cond + (is-x64 "x64") + (is-x86 "x86") + (is-arm "arm64")))) + (format "%s-%s" platform-name arch-name) + (error "Unsupported platform: %s (%s)" system-type system-configuration)))) + +;; Adapted from roslyn.nvim's version +(defconst lsp-roslyn--temp-project-nuget-config + "<?xml version=\"1.0\" encoding=\"utf-8\"?> +<configuration> + <packageSources> + <clear /> + <add key=\"msft_consumption\" value=\"https://pkgs.dev.azure.com/azure-public/vside/_packaging/msft_consumption/nuget/v3/index.json\" /> + </packageSources> + <disabledPackageSources> + <clear /> + </disabledPackageSources> +</configuration>" + "The nuget.config to use when downloading Roslyn.") + +;; Adapted from roslyn.nvim's version +(defun lsp-roslyn--temp-project-csproj (pkg-name pkg-version) + "Generates a temporary .csproj to use for downloading the language server." + (format + "<Project Sdk=\"Microsoft.Build.NoTargets/1.0.80\"> + <PropertyGroup> + <!-- Changes the global packages folder --> + <RestorePackagesPath>out</RestorePackagesPath> + <!-- This is not super relevant, as long as your SDK version supports it. --> + <TargetFramework>net7.0</TargetFramework> + <!-- If a package is resolved to a fallback folder, it may not be downloaded --> + <DisableImplicitNuGetFallbackFolder>true</DisableImplicitNuGetFallbackFolder> + <!-- We don't want to build this project, so we do not need the reference assemblies for the framework we chose --> + <AutomaticallyUseReferenceAssemblyPackages>false</AutomaticallyUseReferenceAssemblyPackages> + </PropertyGroup> + <ItemGroup> + <PackageDownload Include=\"%s\" version=\"[%s]\" /> + </ItemGroup> +</Project>" + pkg-name pkg-version)) + +(defun lsp-roslyn--download-server (_client callback error-callback update?) + "Downloads the Roslyn language server to `lsp-roslyn-install-path'. +CALLBACK is called when the download finish successfully otherwise +ERROR-CALLBACK is called. +UPDATE is non-nil if it is already downloaded. +FORCED if specified with prefix argument." + + (let ((pkg-name (lsp-roslyn--get-package-name))) + (when update? + (ignore-errors (delete-directory lsp-roslyn-install-path t))) + (unless (f-exists? lsp-roslyn-install-path) + (mkdir lsp-roslyn-install-path 'create-parent)) + (f-write-text lsp-roslyn--temp-project-nuget-config + 'utf-8 (expand-file-name "nuget.config" lsp-roslyn-install-path)) + (f-write-text (lsp-roslyn--temp-project-csproj pkg-name lsp-roslyn-package-version) + 'utf-8 (expand-file-name "DownloadRoslyn.csproj" lsp-roslyn-install-path)) + (lsp-async-start-process + callback + error-callback + lsp-roslyn-dotnet-executable "restore" lsp-roslyn-install-path + (format "/p:PackageName=%s" pkg-name) + (format "/p:PackageVersion=%s" lsp-roslyn-package-version)))) + +(defun lsp-roslyn--make-connection () + (list :connect (lambda (f s n e w) (lsp-roslyn--connect f s n e w)) + :test? (lambda () (f-exists? (lsp-roslyn--get-server-dll-path))))) + +(lsp-register-client + (make-lsp-client :new-connection (lsp-roslyn--make-connection) + :priority 0 + :server-id 'csharp-roslyn + :activation-fn (lsp-activate-on "csharp") + :notification-handlers (ht ("window/logMessage" 'lsp-roslyn--log-message) + ("workspace/projectInitializationComplete" 'lsp-roslyn--on-project-initialization-complete)) + + ;; These two functions are the same as lsp-mode's except they do not + ;; (un)hexify URIs. + :path->uri-fn 'lsp-roslyn--path-to-uri + :uri->path-fn 'lsp-roslyn--uri-to-path + + :initialized-fn #'lsp-roslyn--on-initialized + :download-server-fn #'lsp-roslyn--download-server)) + +(provide 'lsp-roslyn) +;;; lsp-roslyn.el ends here diff --git a/emacs/elpa/lsp-mode-20240625.344/lsp-roslyn.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-roslyn.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-rpm-spec.el b/emacs/elpa/lsp-mode-20240625.344/lsp-rpm-spec.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-rpm-spec.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-rpm-spec.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-rubocop.el b/emacs/elpa/lsp-mode-20240625.344/lsp-rubocop.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-rubocop.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-rubocop.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-ruby-lsp.el b/emacs/elpa/lsp-mode-20240625.344/lsp-ruby-lsp.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-ruby-lsp.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-ruby-lsp.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-ruby-syntax-tree.el b/emacs/elpa/lsp-mode-20240625.344/lsp-ruby-syntax-tree.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-ruby-syntax-tree.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-ruby-syntax-tree.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-ruff-lsp.el b/emacs/elpa/lsp-mode-20240625.344/lsp-ruff-lsp.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-ruff-lsp.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-ruff-lsp.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-rust.el b/emacs/elpa/lsp-mode-20240625.344/lsp-rust.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-rust.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-rust.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-semantic-tokens.el b/emacs/elpa/lsp-mode-20240625.344/lsp-semantic-tokens.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-semantic-tokens.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-semantic-tokens.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-semgrep.el b/emacs/elpa/lsp-mode-20240625.344/lsp-semgrep.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-semgrep.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-semgrep.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-sml.el b/emacs/elpa/lsp-mode-20240625.344/lsp-sml.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-sml.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-sml.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-solargraph.el b/emacs/elpa/lsp-mode-20240625.344/lsp-solargraph.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-solargraph.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-solargraph.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-solidity.el b/emacs/elpa/lsp-mode-20240625.344/lsp-solidity.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-solidity.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-solidity.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-sorbet.el b/emacs/elpa/lsp-mode-20240625.344/lsp-sorbet.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-sorbet.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-sorbet.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-sql.el b/emacs/elpa/lsp-mode-20240625.344/lsp-sql.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-sql.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-sql.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-sqls.el b/emacs/elpa/lsp-mode-20240625.344/lsp-sqls.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-sqls.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-sqls.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-steep.el b/emacs/elpa/lsp-mode-20240625.344/lsp-steep.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-steep.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-steep.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-svelte.el b/emacs/elpa/lsp-mode-20240625.344/lsp-svelte.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-svelte.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-svelte.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-terraform.el b/emacs/elpa/lsp-mode-20240625.344/lsp-terraform.el diff --git a/emacs/elpa/lsp-mode-20240625.344/lsp-terraform.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-terraform.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-tex.el b/emacs/elpa/lsp-mode-20240625.344/lsp-tex.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-tex.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-tex.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-tilt.el b/emacs/elpa/lsp-mode-20240625.344/lsp-tilt.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-tilt.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-tilt.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-toml.el b/emacs/elpa/lsp-mode-20240625.344/lsp-toml.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-toml.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-toml.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-trunk.el b/emacs/elpa/lsp-mode-20240625.344/lsp-trunk.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-trunk.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-trunk.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-ttcn3.el b/emacs/elpa/lsp-mode-20240625.344/lsp-ttcn3.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-ttcn3.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-ttcn3.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-typeprof.el b/emacs/elpa/lsp-mode-20240625.344/lsp-typeprof.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-typeprof.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-typeprof.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-v.el b/emacs/elpa/lsp-mode-20240625.344/lsp-v.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-v.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-v.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-vala.el b/emacs/elpa/lsp-mode-20240625.344/lsp-vala.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-vala.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-vala.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-verilog.el b/emacs/elpa/lsp-mode-20240625.344/lsp-verilog.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-verilog.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-verilog.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-vetur.el b/emacs/elpa/lsp-mode-20240625.344/lsp-vetur.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-vetur.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-vetur.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-vhdl.el b/emacs/elpa/lsp-mode-20240625.344/lsp-vhdl.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-vhdl.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-vhdl.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-vimscript.el b/emacs/elpa/lsp-mode-20240625.344/lsp-vimscript.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-vimscript.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-vimscript.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-volar.el b/emacs/elpa/lsp-mode-20240625.344/lsp-volar.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-volar.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-volar.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-wgsl.el b/emacs/elpa/lsp-mode-20240625.344/lsp-wgsl.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-wgsl.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-wgsl.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-xml.el b/emacs/elpa/lsp-mode-20240625.344/lsp-xml.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-xml.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-xml.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-yaml.el b/emacs/elpa/lsp-mode-20240625.344/lsp-yaml.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-yaml.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-yaml.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-yang.el b/emacs/elpa/lsp-mode-20240625.344/lsp-yang.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-yang.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-yang.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-zig.el b/emacs/elpa/lsp-mode-20240625.344/lsp-zig.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp-zig.elc b/emacs/elpa/lsp-mode-20240625.344/lsp-zig.elc Binary files differ. diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp.el b/emacs/elpa/lsp-mode-20240625.344/lsp.el diff --git a/emacs/elpa/lsp-mode-20240619.951/lsp.elc b/emacs/elpa/lsp-mode-20240625.344/lsp.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/magit-apply.el b/emacs/elpa/magit-20240622.1531/magit-apply.el @@ -1,856 +0,0 @@ -;;; magit-apply.el --- Apply Git diffs -*- lexical-binding:t -*- - -;; Copyright (C) 2008-2024 The Magit Project Contributors - -;; Author: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> -;; Maintainer: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> - -;; SPDX-License-Identifier: GPL-3.0-or-later - -;; 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. -;; -;; 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 Magit. If not, see <https://www.gnu.org/licenses/>. - -;;; Commentary: - -;; This library implements commands for applying Git diffs or parts -;; of such a diff. The supported "apply variants" are apply, stage, -;; unstage, discard, and reverse - more than Git itself knows about, -;; at least at the porcelain level. - -;;; Code: - -(require 'magit-core) -(require 'magit-diff) -(require 'magit-wip) - -(require 'transient) ; See #3732. - -;; For `magit-apply' -(declare-function magit-am "magit-sequence" () t) -(declare-function magit-patch-apply "magit-patch" () t) -;; For `magit-discard-files' -(declare-function magit-checkout-stage "magit-merge" (file arg)) -(declare-function magit-checkout-read-stage "magit-merge" (file)) -(defvar auto-revert-verbose) -;; For `magit-stage-untracked' -(declare-function magit-submodule-add-1 "magit-submodule" - (url &optional path name args)) -(declare-function magit-submodule-read-name-for-path "magit-submodule" - (path &optional prefer-short)) -(defvar borg-user-emacs-directory) - -;;; Options - -(defcustom magit-delete-by-moving-to-trash t - "Whether Magit uses the system's trash can. - -You should absolutely not disable this and also remove `discard' -from `magit-no-confirm'. You shouldn't do that even if you have -all of the Magit-Wip modes enabled, because those modes do not -track any files that are not tracked in the proper branch." - :package-version '(magit . "2.1.0") - :group 'magit-essentials - :type 'boolean) - -(defcustom magit-unstage-committed t - "Whether unstaging a committed change reverts it instead. - -A committed change cannot be unstaged, because staging and -unstaging are actions that are concerned with the differences -between the index and the working tree, not with committed -changes. - -If this option is non-nil (the default), then typing \"u\" -\(`magit-unstage') on a committed change, causes it to be -reversed in the index but not the working tree. For more -information see command `magit-reverse-in-index'." - :package-version '(magit . "2.4.1") - :group 'magit-commands - :type 'boolean) - -(defcustom magit-reverse-atomically nil - "Whether to reverse changes atomically. - -If some changes can be reversed while others cannot, then nothing -is reversed if the value of this option is non-nil. But when it -is nil, then the changes that can be reversed are reversed and -for the other changes diff files are created that contain the -rejected reversals." - :package-version '(magit . "2.7.0") - :group 'magit-commands - :type 'boolean) - -(defcustom magit-post-stage-hook nil - "Hook run after staging changes. -This hook is run by `magit-refresh' if `this-command' -is a member of `magit-post-stage-hook-commands'." - :package-version '(magit . "2.90.0") - :group 'magit-commands - :type 'hook) - -(defcustom magit-post-unstage-hook nil - "Hook run after unstaging changes. -This hook is run by `magit-refresh' if `this-command' -is a member of `magit-post-unstage-hook-commands'." - :package-version '(magit . "2.90.0") - :group 'magit-commands - :type 'hook) - -;;; Commands -;;;; Apply - -(defun magit-apply (&rest args) - "Apply the change at point to the working tree. -With a prefix argument fallback to a 3-way merge. Doing -so causes the change to be applied to the index as well." - (interactive (and current-prefix-arg (list "--3way"))) - (when-let ((s (magit-apply--get-selection))) - (pcase (list (magit-diff-type) (magit-diff-scope)) - (`(,(or 'unstaged 'staged) ,_) - (user-error "Change is already in the working tree")) - (`(untracked ,(or 'file 'files)) - (call-interactively #'magit-am)) - (`(,_ region) (magit-apply-region s args)) - (`(,_ hunk) (magit-apply-hunk s args)) - (`(,_ hunks) (magit-apply-hunks s args)) - (`(rebase-sequence file) - (call-interactively #'magit-patch-apply)) - (`(,_ file) (magit-apply-diff s args)) - (`(,_ files) (magit-apply-diffs s args))))) - -(defun magit-apply--section-content (section) - (buffer-substring-no-properties (if (magit-hunk-section-p section) - (oref section start) - (oref section content)) - (oref section end))) - -(defun magit-apply-diffs (sections &rest args) - (setq sections (magit-apply--get-diffs sections)) - (magit-apply-patch sections args - (mapconcat - (lambda (s) - (concat (magit-diff-file-header s) - (magit-apply--section-content s))) - sections ""))) - -(defun magit-apply-diff (section &rest args) - (setq section (car (magit-apply--get-diffs (list section)))) - (magit-apply-patch section args - (concat (magit-diff-file-header section) - (magit-apply--section-content section)))) - -(defun magit-apply--adjust-hunk-new-starts (hunks) - "Adjust new line numbers in headers of HUNKS for partial application. -HUNKS should be a list of ordered, contiguous hunks to be applied -from a file. For example, if there is a sequence of hunks with -the headers - - @@ -2,6 +2,7 @@ - @@ -10,6 +11,7 @@ - @@ -18,6 +20,7 @@ - -and only the second and third are to be applied, they would be -adjusted as \"@@ -10,6 +10,7 @@\" and \"@@ -18,6 +19,7 @@\"." - (let* ((first-hunk (car hunks)) - (offset (if (string-match diff-hunk-header-re-unified first-hunk) - (- (string-to-number (match-string 3 first-hunk)) - (string-to-number (match-string 1 first-hunk))) - (error "Header hunks have to be applied individually")))) - (if (= offset 0) - hunks - (mapcar (lambda (hunk) - (if (string-match diff-hunk-header-re-unified hunk) - (replace-match (number-to-string - (- (string-to-number (match-string 3 hunk)) - offset)) - t t hunk 3) - (error "Hunk does not have expected header"))) - hunks)))) - -(defun magit-apply--adjust-hunk-new-start (hunk) - (car (magit-apply--adjust-hunk-new-starts (list hunk)))) - -(defun magit-apply-hunks (hunks &rest args) - (let ((file (oref (car hunks) parent))) - (when (magit-diff--combined-p file) - (user-error "Cannot un-/stage resolution hunks. Stage the whole file")) - (magit-apply-patch - file args - (concat (oref file header) - (mapconcat #'identity - (magit-apply--adjust-hunk-new-starts - (mapcar #'magit-apply--section-content hunks)) - ""))))) - -(defun magit-apply-hunk (hunk &rest args) - (let ((file (oref hunk parent))) - (when (magit-diff--combined-p file) - (user-error "Cannot un-/stage resolution hunks. Stage the whole file")) - (let* ((header (car (oref hunk value))) - (header (and (symbolp header) header)) - (content (magit-apply--section-content hunk))) - (magit-apply-patch - file args - (concat (magit-diff-file-header hunk (not (eq header 'rename))) - (if header - content - (magit-apply--adjust-hunk-new-start content))))))) - -(defun magit-apply-region (hunk &rest args) - (let ((file (oref hunk parent))) - (when (magit-diff--combined-p file) - (user-error "Cannot un-/stage resolution hunks. Stage the whole file")) - (magit-apply-patch - file args - (concat (magit-diff-file-header hunk) - (magit-apply--adjust-hunk-new-start - (magit-diff-hunk-region-patch hunk args)))))) - -(defun magit-apply-patch (section:s args patch) - (let* ((files (if (atom section:s) - (list (oref section:s value)) - (--map (oref it value) section:s))) - (command (symbol-name this-command)) - (command (if (and command (string-match "^magit-\\([^-]+\\)" command)) - (match-string 1 command) - "apply")) - (ignore-context (magit-diff-ignore-any-space-p))) - (unless (magit-diff-context-p) - (user-error "Not enough context to apply patch. Increase the context")) - (when (and magit-wip-before-change-mode (not magit-inhibit-refresh)) - (magit-wip-commit-before-change files (concat " before " command))) - (with-temp-buffer - (insert patch) - (magit-run-git-with-input - "apply" args "-p0" - (and ignore-context "-C0") - "--ignore-space-change" "-")) - (unless magit-inhibit-refresh - (when magit-wip-after-apply-mode - (magit-wip-commit-after-apply files (concat " after " command))) - (magit-refresh)))) - -(defun magit-apply--get-selection () - (or (magit-region-sections '(hunk file module) t) - (let ((section (magit-current-section))) - (pcase (oref section type) - ((or 'hunk 'file 'module) section) - ((or 'staged 'unstaged 'untracked - 'stashed-index 'stashed-worktree 'stashed-untracked) - (oref section children)) - (_ (user-error "Cannot apply this, it's not a change")))))) - -(defun magit-apply--get-diffs (sections) - (magit-section-case - ([file diffstat] - (--map (or (magit-get-section - (append `((file . ,(oref it value))) - (magit-section-ident magit-root-section))) - (error "Cannot get required diff headers")) - sections)) - (t sections))) - -(defun magit-apply--ignore-whitespace-p (selection type scope) - "Return t if it is necessary and possible to ignore whitespace. -It is necessary to do so when the diff ignores whitespace changes -and whole files are being applied. It is possible when no binary -files are involved. If it is both necessary and impossible, then -return nil, possibly causing whitespace changes to be applied." - (and (memq type '(unstaged staged)) - (memq scope '(file files list)) - (cl-find-if (lambda (arg) - (member arg '("--ignore-space-at-eol" - "--ignore-space-change" - "--ignore-all-space" - "--ignore-blank-lines"))) - magit-buffer-diff-args) - (not (cl-find-if (lambda (section) - (oref section binary)) - (ensure-list selection))))) - -;;;; Stage - -(defun magit-stage (&optional intent) - "Add the change at point to the staging area. -With a prefix argument, INTENT, and an untracked file (or files) -at point, stage the file but not its content." - (interactive "P") - (if-let ((s (and (derived-mode-p 'magit-mode) - (magit-apply--get-selection))) - (type (magit-diff-type)) - (scope (magit-diff-scope))) - (pcase (list type scope - (magit-apply--ignore-whitespace-p s type scope)) - (`(untracked ,_ ,_) (magit-stage-untracked intent)) - (`(unstaged region ,_) (magit-apply-region s "--cached")) - (`(unstaged hunk ,_) (magit-apply-hunk s "--cached")) - (`(unstaged hunks ,_) (magit-apply-hunks s "--cached")) - ('(unstaged file t) (magit-apply-diff s "--cached")) - ('(unstaged files t) (magit-apply-diffs s "--cached")) - ('(unstaged list t) (magit-apply-diffs s "--cached")) - ('(unstaged file nil) (magit-stage-1 "-u" (list (oref s value)))) - ('(unstaged files nil) (magit-stage-1 "-u" (magit-region-values nil t))) - ('(unstaged list nil) (magit-stage-modified)) - (`(staged ,_ ,_) (user-error "Already staged")) - (`(committed ,_ ,_) (user-error "Cannot stage committed changes")) - (`(undefined ,_ ,_) (user-error "Cannot stage this change"))) - (call-interactively #'magit-stage-file))) - -;;;###autoload -(defun magit-stage-buffer-file () - "Stage all changes to the file being visited in the current buffer." - (interactive) - (unless buffer-file-name - (user-error "Not visiting a file")) - (magit-with-toplevel - (magit-stage-1 (and (magit-file-ignored-p buffer-file-name) - (if (y-or-n-p "Visited file is ignored; stage anyway?") - "--force" - (user-error "Abort"))) - (list (magit-file-relative-name))))) - -;;;###autoload -(defun magit-stage-file (files &optional force) - "Read one or more files and stage all changes in those files. -With prefix argument FORCE, offer ignored files for completion." - (interactive - (let* ((choices (if current-prefix-arg - (magit-ignored-files) - (nconc (magit-unstaged-files) - (magit-untracked-files)))) - (default (or (magit-section-value-if 'file) - (magit-file-relative-name))) - (default (car (member default choices)))) - (list (magit-completing-read-multiple - (if current-prefix-arg "Stage ignored file,s: " "Stage file,s: ") - choices nil t nil nil default) - current-prefix-arg))) - (magit-with-toplevel - ;; For backward compatibility, and because of - ;; the function's name, don't require a list. - (magit-stage-1 (and force "--force") - (if (listp files) files (list files))))) - -;;;###autoload -(defun magit-stage-modified (&optional all) - "Stage all changes to files modified in the worktree. -Stage all new content of tracked files and remove tracked files -that no longer exist in the working tree from the index also. -With a prefix argument also stage previously untracked (but not -ignored) files." - (interactive "P") - (when (magit-anything-staged-p) - (magit-confirm 'stage-all-changes)) - (magit-with-toplevel - (magit-stage-1 (if all "--all" "-u") magit-buffer-diff-files))) - -(defun magit-stage-1 (arg &optional files) - (magit-wip-commit-before-change files " before stage") - (magit-run-git "add" arg (if files (cons "--" files) ".")) - (when magit-auto-revert-mode - (mapc #'magit-turn-on-auto-revert-mode-if-desired files)) - (magit-wip-commit-after-apply files " after stage")) - -(defun magit-stage-untracked (&optional intent) - (let* ((section (magit-current-section)) - (files (pcase (magit-diff-scope) - ('file (list (oref section value))) - ('files (magit-region-values nil t)) - ('list (magit-untracked-files)))) - plain repos) - (dolist (file files) - (if (and (not (file-symlink-p file)) - (magit-git-repo-p file t)) - (push file repos) - (push file plain))) - (magit-wip-commit-before-change files " before stage") - (when plain - (magit-run-git "add" (and intent "--intent-to-add") - "--" plain) - (when magit-auto-revert-mode - (mapc #'magit-turn-on-auto-revert-mode-if-desired plain))) - (dolist (repo repos) - (save-excursion - (goto-char (oref (magit-get-section - `((file . ,repo) (untracked) (status))) - start)) - (when (and (fboundp 'borg-assimilate) - (fboundp 'borg--maybe-absorb-gitdir) - (fboundp 'borg--sort-submodule-sections)) - (let* ((topdir (magit-toplevel)) - (url (let ((default-directory - (file-name-as-directory (expand-file-name repo)))) - (or (magit-get "remote" (magit-get-some-remote) "url") - (concat (file-name-as-directory ".") repo)))) - (package - (and (equal borg-user-emacs-directory topdir) - (file-name-nondirectory (directory-file-name repo))))) - (if (and package - (y-or-n-p (format "Also assimilate `%s' drone?" package))) - (borg-assimilate package url) - (magit-submodule-add-1 - url repo (magit-submodule-read-name-for-path repo package)) - (when package - (borg--sort-submodule-sections - (expand-file-name ".gitmodules" topdir)) - (let ((default-directory borg-user-emacs-directory)) - (borg--maybe-absorb-gitdir package)))))))) - (magit-wip-commit-after-apply files " after stage"))) - -(defvar magit-post-stage-hook-commands - '(magit-stage - magit-stage-buffer-file - magit-stage-file - magit-stage-modified)) - -(defun magit-run-post-stage-hook () - (when (memq this-command magit-post-stage-hook-commands) - (magit-run-hook-with-benchmark 'magit-post-stage-hook))) - -;;;; Unstage - -(defun magit-unstage () - "Remove the change at point from the staging area." - (interactive) - (when-let ((s (magit-apply--get-selection)) - (type (magit-diff-type)) - (scope (magit-diff-scope))) - (pcase (list type scope - (magit-apply--ignore-whitespace-p s type scope)) - (`(untracked ,_ ,_) (user-error "Cannot unstage untracked changes")) - (`(unstaged file ,_) (magit-unstage-intent (list (oref s value)))) - (`(unstaged files ,_) (magit-unstage-intent (magit-region-values nil t))) - (`(unstaged ,_ ,_) (user-error "Already unstaged")) - (`(staged region ,_) (magit-apply-region s "--reverse" "--cached")) - (`(staged hunk ,_) (magit-apply-hunk s "--reverse" "--cached")) - (`(staged hunks ,_) (magit-apply-hunks s "--reverse" "--cached")) - ('(staged file t) (magit-apply-diff s "--reverse" "--cached")) - ('(staged files t) (magit-apply-diffs s "--reverse" "--cached")) - ('(staged list t) (magit-apply-diffs s "--reverse" "--cached")) - ('(staged file nil) (magit-unstage-1 (list (oref s value)))) - ('(staged files nil) (magit-unstage-1 (magit-region-values nil t))) - ('(staged list nil) (magit-unstage-all)) - (`(committed ,_ ,_) (if magit-unstage-committed - (magit-reverse-in-index) - (user-error "Cannot unstage committed changes"))) - (`(undefined ,_ ,_) (user-error "Cannot unstage this change"))))) - -;;;###autoload -(defun magit-unstage-buffer-file () - "Unstage all changes to the file being visited in the current buffer." - (interactive) - (unless buffer-file-name - (user-error "Not visiting a file")) - (magit-with-toplevel - (magit-unstage-1 (list (magit-file-relative-name))))) - -;;;###autoload -(defun magit-unstage-file (files) - "Read one or more files and unstage all changes to those files." - (interactive - (let* ((choices (magit-staged-files)) - (default (or (magit-section-value-if 'file) - (magit-file-relative-name))) - (default (car (member default choices)))) - (list (magit-completing-read-multiple "Unstage file,s: " choices - nil t nil nil default)))) - (magit-with-toplevel - ;; For backward compatibility, and because of - ;; the function's name, don't require a list. - (magit-unstage-1 (if (listp files) files (list files))))) - -(defun magit-unstage-1 (files) - (magit-wip-commit-before-change files " before unstage") - (if (magit-no-commit-p) - (magit-run-git "rm" "--cached" "--" files) - (magit-run-git "reset" "HEAD" "--" files)) - (magit-wip-commit-after-apply files " after unstage")) - -(defun magit-unstage-intent (files) - (if-let ((staged (magit-staged-files)) - (intent (--filter (member it staged) files))) - (magit-unstage-1 intent) - (user-error "Already unstaged"))) - -;;;###autoload -(defun magit-unstage-all () - "Remove all changes from the staging area." - (interactive) - (unless (magit-anything-staged-p) - (user-error "Nothing to unstage")) - (when (or (magit-anything-unstaged-p) - (magit-untracked-files)) - (magit-confirm 'unstage-all-changes)) - (magit-wip-commit-before-change nil " before unstage") - (magit-run-git "reset" "HEAD" "--" magit-buffer-diff-files) - (magit-wip-commit-after-apply nil " after unstage")) - -(defvar magit-post-unstage-hook-commands - '(magit-unstage - magit-unstage-buffer-file - magit-unstage-file - magit-unstage-all)) - -(defun magit-run-post-unstage-hook () - (when (memq this-command magit-post-unstage-hook-commands) - (magit-run-hook-with-benchmark 'magit-post-unstage-hook))) - -;;;; Discard - -(defun magit-discard () - "Remove the change at point. - -On a hunk or file with unresolved conflicts prompt which side to -keep (while discarding the other). If point is within the text -of a side, then keep that side without prompting." - (interactive) - (when-let ((s (magit-apply--get-selection))) - (pcase (list (magit-diff-type) (magit-diff-scope)) - (`(committed ,_) (user-error "Cannot discard committed changes")) - (`(undefined ,_) (user-error "Cannot discard this change")) - (`(,_ region) (magit-discard-region s)) - (`(,_ hunk) (magit-discard-hunk s)) - (`(,_ hunks) (magit-discard-hunks s)) - (`(,_ file) (magit-discard-file s)) - (`(,_ files) (magit-discard-files s)) - (`(,_ list) (magit-discard-files s))))) - -(defun magit-discard-region (section) - (magit-confirm 'discard "Discard region") - (magit-discard-apply section 'magit-apply-region)) - -(defun magit-discard-hunk (section) - (magit-confirm 'discard "Discard hunk") - (let ((file (magit-section-parent-value section))) - (pcase (cddr (car (magit-file-status file))) - ('(?U ?U) (magit-smerge-keep-current)) - (_ (magit-discard-apply section #'magit-apply-hunk))))) - -(defun magit-discard-apply (section apply) - (if (eq (magit-diff-type section) 'unstaged) - (funcall apply section "--reverse") - (if (magit-anything-unstaged-p - nil (if (magit-file-section-p section) - (oref section value) - (magit-section-parent-value section))) - (progn (let ((magit-inhibit-refresh t)) - (funcall apply section "--reverse" "--cached") - (funcall apply section "--reverse" "--reject")) - (magit-refresh)) - (funcall apply section "--reverse" "--index")))) - -(defun magit-discard-hunks (sections) - (magit-confirm 'discard (format "Discard %s hunks from %s" - (length sections) - (magit-section-parent-value (car sections)))) - (magit-discard-apply-n sections #'magit-apply-hunks)) - -(defun magit-discard-apply-n (sections apply) - (let ((section (car sections))) - (if (eq (magit-diff-type section) 'unstaged) - (funcall apply sections "--reverse") - (if (magit-anything-unstaged-p - nil (if (magit-file-section-p section) - (oref section value) - (magit-section-parent-value section))) - (progn (let ((magit-inhibit-refresh t)) - (funcall apply sections "--reverse" "--cached") - (funcall apply sections "--reverse" "--reject")) - (magit-refresh)) - (funcall apply sections "--reverse" "--index"))))) - -(defun magit-discard-file (section) - (magit-discard-files (list section))) - -(defun magit-discard-files (sections) - (let ((auto-revert-verbose nil) - (type (magit-diff-type (car sections))) - (status (magit-file-status)) - files delete resurrect rename discard discard-new resolve) - (dolist (section sections) - (let ((file (oref section value))) - (push file files) - (pcase (cons (pcase type - (`staged ?X) - (`unstaged ?Y) - (`untracked ?Z)) - (cddr (assoc file status))) - ('(?Z) (dolist (f (magit-untracked-files nil file)) - (push f delete))) - ((or '(?Z ?? ??) '(?Z ?! ?!)) (push file delete)) - ('(?Z ?D ? ) (push file delete)) - (`(,_ ?D ?D) (push file resolve)) - ((or `(,_ ?U ,_) `(,_ ,_ ?U)) (push file resolve)) - (`(,_ ?A ?A) (push file resolve)) - (`(?X ?M ,(or ? ?M ?D)) (push section discard)) - (`(?Y ,_ ?M ) (push section discard)) - ('(?X ?A ?M ) (push file discard-new)) - ('(?X ?C ?M ) (push file discard-new)) - (`(?X ?A ,(or ? ?D)) (push file delete)) - (`(?X ?C ,(or ? ?D)) (push file delete)) - (`(?X ?D ,(or ? ?M )) (push file resurrect)) - (`(?Y ,_ ?D ) (push file resurrect)) - (`(?X ?R ,(or ? ?M ?D)) (push file rename))))) - (unwind-protect - (let ((magit-inhibit-refresh t)) - (magit-wip-commit-before-change files " before discard") - (when resolve - (magit-discard-files--resolve (nreverse resolve))) - (when resurrect - (magit-discard-files--resurrect (nreverse resurrect))) - (when delete - (magit-discard-files--delete (nreverse delete) status)) - (when rename - (magit-discard-files--rename (nreverse rename) status)) - (when (or discard discard-new) - (magit-discard-files--discard (nreverse discard) - (nreverse discard-new))) - (magit-wip-commit-after-apply files " after discard")) - (magit-refresh)))) - -(defun magit-discard-files--resolve (files) - (if-let ((arg (and (cdr files) - (magit-read-char-case - (format "For these %d files\n%s\ncheckout:\n" - (length files) - (mapconcat (lambda (file) - (concat " " file)) - files "\n")) - t - (?o "[o]ur stage" "--ours") - (?t "[t]heir stage" "--theirs") - (?c "[c]onflict" "--merge") - (?i "decide [i]ndividually" nil))))) - (dolist (file files) - (magit-checkout-stage file arg)) - (dolist (file files) - (magit-checkout-stage file (magit-checkout-read-stage file))))) - -(defun magit-discard-files--resurrect (files) - (magit-confirm-files 'resurrect files) - (if (eq (magit-diff-type) 'staged) - (magit-call-git "reset" "--" files) - (magit-call-git "checkout" "--" files))) - -(defun magit-discard-files--delete (files status) - (magit-confirm-files (if magit-delete-by-moving-to-trash 'trash 'delete) - files) - (let ((delete-by-moving-to-trash magit-delete-by-moving-to-trash)) - (dolist (file files) - (when (string-match-p "\\`\\\\?~" file) - (error "Refusing to delete %S, too dangerous" file)) - (pcase (nth 3 (assoc file status)) - ((guard (memq (magit-diff-type) '(unstaged untracked))) - (dired-delete-file file dired-recursive-deletes - magit-delete-by-moving-to-trash) - (dired-clean-up-after-deletion file)) - (?\s (delete-file file t) - (magit-call-git "rm" "--cached" "--" file)) - (?M (let ((temp (magit-git-string "checkout-index" "--temp" file))) - (string-match - (format "\\(.+?\\)\t%s" (regexp-quote file)) temp) - (rename-file (match-string 1 temp) - (setq temp (concat file ".~{index}~"))) - (delete-file temp t)) - (magit-call-git "rm" "--cached" "--force" "--" file)) - (?D (magit-call-git "checkout" "--" file) - (delete-file file t) - (magit-call-git "rm" "--cached" "--force" "--" file)))))) - -(defun magit-discard-files--rename (files status) - (magit-confirm 'rename "Undo rename %s" "Undo %d renames" nil - (mapcar (lambda (file) - (setq file (assoc file status)) - (format "%s -> %s" (cadr file) (car file))) - files)) - (dolist (file files) - (let ((orig (cadr (assoc file status)))) - (if (file-exists-p file) - (progn - (when-let ((path (file-name-directory orig))) - (make-directory path t)) - (magit-call-git "mv" file orig)) - (magit-call-git "rm" "--cached" "--" file) - (magit-call-git "reset" "--" orig))))) - -(defun magit-discard-files--discard (sections new-files) - (let ((files (--map (oref it value) sections))) - (magit-confirm-files 'discard (append files new-files) - (format "Discard %s changes in" (magit-diff-type))) - (if (eq (magit-diff-type (car sections)) 'unstaged) - (magit-call-git "checkout" "--" files) - (when new-files - (magit-call-git "add" "--" new-files) - (magit-call-git "reset" "--" new-files)) - (let ((binaries (magit-binary-files "--cached"))) - (when binaries - (setq sections - (--remove (member (oref it value) binaries) - sections))) - (cond ((length= sections 1) - (magit-discard-apply (car sections) 'magit-apply-diff)) - (sections - (magit-discard-apply-n sections #'magit-apply-diffs))) - (when binaries - (let ((modified (magit-unstaged-files t))) - (setq binaries (--separate (member it modified) binaries))) - (when (cadr binaries) - (magit-call-git "reset" "--" (cadr binaries))) - (when (car binaries) - (user-error - (concat - "Cannot discard staged changes to binary files, " - "which also have unstaged changes. Unstage instead.")))))))) - -;;;; Reverse - -(defun magit-reverse (&rest args) - "Reverse the change at point in the working tree. -With a prefix argument fallback to a 3-way merge. Doing -so causes the change to be applied to the index as well." - (interactive (and current-prefix-arg (list "--3way"))) - (when-let ((s (magit-apply--get-selection))) - (pcase (list (magit-diff-type) (magit-diff-scope)) - (`(untracked ,_) (user-error "Cannot reverse untracked changes")) - (`(unstaged ,_) (user-error "Cannot reverse unstaged changes")) - (`(,_ region) (magit-reverse-region s args)) - (`(,_ hunk) (magit-reverse-hunk s args)) - (`(,_ hunks) (magit-reverse-hunks s args)) - (`(,_ file) (magit-reverse-file s args)) - (`(,_ files) (magit-reverse-files s args)) - (`(,_ list) (magit-reverse-files s args))))) - -(defun magit-reverse-region (section args) - (magit-confirm 'reverse "Reverse region") - (magit-reverse-apply section #'magit-apply-region args)) - -(defun magit-reverse-hunk (section args) - (magit-confirm 'reverse "Reverse hunk") - (magit-reverse-apply section #'magit-apply-hunk args)) - -(defun magit-reverse-hunks (sections args) - (magit-confirm 'reverse - (format "Reverse %s hunks from %s" - (length sections) - (magit-section-parent-value (car sections)))) - (magit-reverse-apply sections #'magit-apply-hunks args)) - -(defun magit-reverse-file (section args) - (magit-reverse-files (list section) args)) - -(defun magit-reverse-files (sections args) - (pcase-let ((`(,binaries ,sections) - (let ((bs (magit-binary-files - (cond ((derived-mode-p 'magit-revision-mode) - magit-buffer-range) - ((derived-mode-p 'magit-diff-mode) - magit-buffer-range) - (t - "--cached"))))) - (--separate (member (oref it value) bs) - sections)))) - (magit-confirm-files 'reverse (--map (oref it value) sections)) - (cond ((length= sections 1) - (magit-reverse-apply (car sections) #'magit-apply-diff args)) - (sections - (magit-reverse-apply sections #'magit-apply-diffs args))) - (when binaries - (user-error "Cannot reverse binary files")))) - -(defun magit-reverse-apply (section:s apply args) - (funcall apply section:s "--reverse" args - (and (not magit-reverse-atomically) - (not (member "--3way" args)) - "--reject"))) - -(defun magit-reverse-in-index (&rest args) - "Reverse the change at point in the index but not the working tree. - -Use this command to extract a change from `HEAD', while leaving -it in the working tree, so that it can later be committed using -a separate commit. A typical workflow would be: - -0. Optionally make sure that there are no uncommitted changes. -1. Visit the `HEAD' commit and navigate to the change that should - not have been included in that commit. -2. Type \"u\" (`magit-unstage') to reverse it in the index. - This assumes that `magit-unstage-committed-changes' is non-nil. -3. Type \"c e\" to extend `HEAD' with the staged changes, - including those that were already staged before. -4. Optionally stage the remaining changes using \"s\" or \"S\" - and then type \"c c\" to create a new commit." - (interactive) - (magit-reverse (cons "--cached" args))) - -;;; Smerge Support - -(defun magit-smerge-keep-current () - "Keep the current version of the conflict at point." - (interactive) - (magit-call-smerge #'smerge-keep-current)) - -(defun magit-smerge-keep-upper () - "Keep the upper/our version of the conflict at point." - (interactive) - (magit-call-smerge #'smerge-keep-upper)) - -(defun magit-smerge-keep-base () - "Keep the base version of the conflict at point." - (interactive) - (magit-call-smerge #'smerge-keep-base)) - -(defun magit-smerge-keep-lower () - "Keep the lower/their version of the conflict at point." - (interactive) - (magit-call-smerge #'smerge-keep-lower)) - -(defun magit-smerge-keep-all () - "Keep all versions of the conflict at point." - (interactive) - (magit-call-smerge #'smerge-keep-all)) - -(defun magit-call-smerge (fn) - (pcase-let* ((file (magit-file-at-point t t)) - (keep (get-file-buffer file)) - (`(,buf ,pos) - (let ((magit-diff-visit-jump-to-change nil)) - (magit-diff-visit-file--noselect file)))) - (with-current-buffer buf - (save-excursion - (save-restriction - (unless (<= (point-min) pos (point-max)) - (widen)) - (goto-char pos) - (condition-case nil - (smerge-match-conflict) - (error - (if (eq fn #'smerge-keep-current) - (when (eq this-command #'magit-discard) - (re-search-forward smerge-begin-re nil t) - (setq fn - (magit-read-char-case "Keep side: " t - (?o "[o]urs/upper" #'smerge-keep-upper) - (?b "[b]ase" #'smerge-keep-base) - (?t "[t]heirs/lower" #'smerge-keep-lower)))) - (re-search-forward smerge-begin-re nil t)))) - (funcall fn))) - (when (and keep (magit-anything-unmerged-p file)) - (smerge-start-session)) - (save-buffer)) - (unless keep - (kill-buffer buf)) - (magit-refresh))) - -;;; _ -(provide 'magit-apply) -;;; magit-apply.el ends here diff --git a/emacs/elpa/magit-20240622.1531/magit-apply.elc b/emacs/elpa/magit-20240622.1531/magit-apply.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/magit-base.el b/emacs/elpa/magit-20240622.1531/magit-base.el @@ -1,1257 +0,0 @@ -;;; magit-base.el --- Early birds -*- lexical-binding:t; coding:utf-8 -*- - -;; Copyright (C) 2008-2024 The Magit Project Contributors - -;; Author: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> -;; Maintainer: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> - -;; SPDX-License-Identifier: GPL-3.0-or-later - -;; 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. -;; -;; 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 Magit. If not, see <https://www.gnu.org/licenses/>. - -;; This file contains code taken from GNU Emacs, which is -;; Copyright (C) 1976-2023 Free Software Foundation, Inc. - -;;; Commentary: - -;; This library defines utility functions, options and other things that -;; have to be available early on because they are used by several other -;; libraries, which cannot depend on one another, because that would lead -;; to circular dependencies. - -;;; Code: - -(defconst magit--minimal-git "2.2.0") -(defconst magit--minimal-emacs "26.1") - -(require 'cl-lib) -(require 'compat) -(require 'dash) -(require 'eieio) -(require 'subr-x) - -;; For older Emacs releases we depend on an updated `seq' release from -;; GNU ELPA, for `seq-keep'. Unfortunately something else may already -;; have required `seq', before `package' had a chance to put the more -;; recent version earlier on the `load-path'. -(when (and (featurep 'seq) - (not (fboundp 'seq-keep))) - (unload-feature 'seq 'force)) -(require 'seq) - -(require 'crm) - -(require 'magit-section) - -(eval-when-compile (require 'info)) -(declare-function Info-get-token "info" (pos start all &optional errorstring)) - -(eval-when-compile (require 'vc-git)) -(declare-function vc-git--run-command-string "vc-git" (file &rest args)) - -(eval-when-compile (require 'which-func)) -(declare-function which-function "which-func" ()) - -;;; Options - -(defcustom magit-completing-read-function #'magit-builtin-completing-read - "Function to be called when requesting input from the user. - -If you have enabled `ivy-mode' or `helm-mode', then you don't -have to customize this option; `magit-builtin-completing-read' -will work just fine. However, if you use Ido completion, then -you do have to use `magit-ido-completing-read', because Ido is -less well behaved than the former, more modern alternatives. - -If you would like to use Ivy or Helm completion with Magit but -not enable the respective modes globally, then customize this -option to use `ivy-completing-read' or -`helm--completing-read-default'. If you choose to use -`ivy-completing-read', note that the items may always be shown in -alphabetical order, depending on your version of Ivy." - :group 'magit-essentials - :type '(radio (function-item magit-builtin-completing-read) - (function-item magit-ido-completing-read) - (function-item ivy-completing-read) - (function-item helm--completing-read-default) - (function :tag "Other function"))) - -(defcustom magit-dwim-selection - '((magit-stash-apply nil t) - (magit-ediff-resolve-all nil t) - (magit-ediff-resolve-rest nil t) - (magit-stash-branch nil t) - (magit-stash-branch-here nil t) - (magit-stash-format-patch nil t) - (magit-stash-drop nil ask) - (magit-stash-pop nil ask)) - "When not to offer alternatives and ask for confirmation. - -Many commands by default ask the user to select from a list of -possible candidates. They do so even when there is a thing at -point that they can act on, which is then offered as the default. - -This option can be used to tell certain commands to use the thing -at point instead of asking the user to select a candidate to act -on, with or without confirmation. - -The value has the form ((COMMAND nil|PROMPT DEFAULT)...). - -- COMMAND is the command that should not prompt for a choice. - To have an effect, the command has to use the function - `magit-completing-read' or a utility function which in turn uses - that function. - -- If the command uses `magit-completing-read' multiple times, then - PROMPT can be used to only affect one of these uses. PROMPT, if - non-nil, is a regular expression that is used to match against - the PROMPT argument passed to `magit-completing-read'. - -- DEFAULT specifies how to use the default. If it is t, then - the DEFAULT argument passed to `magit-completing-read' is used - without confirmation. If it is `ask', then the user is given - a chance to abort. DEFAULT can also be nil, in which case the - entry has no effect." - :package-version '(magit . "2.12.0") - :group 'magit-commands - :type '(repeat - (list (symbol :tag "Command") ; It might not be fboundp yet. - (choice (const :tag "for all prompts" nil) - (regexp :tag "for prompts matching regexp")) - (choice (const :tag "offer other choices" nil) - (const :tag "require confirmation" ask) - (const :tag "use default without confirmation" t))))) - -(defconst magit--confirm-actions - '((const discard) - (const reverse) - (const stage-all-changes) - (const unstage-all-changes) - (const delete) - (const trash) - (const resurrect) - (const untrack) - (const rename) - (const reset-bisect) - (const abort-cherry-pick) - (const abort-revert) - (const abort-rebase) - (const abort-merge) - (const merge-dirty) - (const delete-unmerged-branch) - (const delete-branch-on-remote) - (const delete-pr-remote) - (const drop-stashes) - (const set-and-push) - (const amend-published) - (const rebase-published) - (const edit-published) - (const remove-modules) - (const remove-dirty-modules) - (const trash-module-gitdirs) - (const stash-apply-3way) - (const kill-process) - (const safe-with-wip))) - -(defcustom magit-no-confirm '(set-and-push) - "A list of symbols for actions Magit should not confirm, or t. - -Many potentially dangerous commands by default ask the user for -confirmation. Each of the below symbols stands for an action -which, when invoked unintentionally or without being fully aware -of the consequences, could lead to tears. In many cases there -are several commands that perform variations of a certain action, -so we don't use the command names but more generic symbols. - -Applying changes: - - `discard' Discarding one or more changes (i.e., hunks or the - complete diff for a file) loses that change, obviously. - - `reverse' Reverting one or more changes can usually be undone - by reverting the reversion. - - `stage-all-changes', `unstage-all-changes' When there are both - staged and unstaged changes, then un-/staging everything would - destroy that distinction. Of course that also applies when - un-/staging a single change, but then less is lost and one does - that so often that having to confirm every time would be - unacceptable. - -Files: - - `delete' When a file that isn't yet tracked by Git is deleted - then it is completely lost, not just the last changes. Very - dangerous. - - `trash' Instead of deleting a file it can also be move to the - system trash. Obviously much less dangerous than deleting it. - - Also see option `magit-delete-by-moving-to-trash'. - - `resurrect' A deleted file can easily be resurrected by - \"deleting\" the deletion, which is done using the same command - that was used to delete the same file in the first place. - - `untrack' Untracking a file can be undone by tracking it again. - - `rename' Renaming a file can easily be undone. - -Sequences: - - `reset-bisect' Aborting (known to Git as \"resetting\") a - bisect operation loses all information collected so far. - - `abort-cherry-pick' Aborting a cherry-pick throws away all - conflict resolutions which has already been carried out by the - user. - - `abort-revert' Aborting a revert throws away all conflict - resolutions which has already been carried out by the user. - - `abort-rebase' Aborting a rebase throws away all already - modified commits, but it's possible to restore those from the - reflog. - - `abort-merge' Aborting a merge throws away all conflict - resolutions which has already been carried out by the user. - - `merge-dirty' Merging with a dirty worktree can make it hard to - go back to the state before the merge was initiated. - -References: - - `delete-unmerged-branch' Once a branch has been deleted it can - only be restored using low-level recovery tools provided by - Git. And even then the reflog is gone. The user always has - to confirm the deletion of a branch by accepting the default - choice (or selecting another branch), but when a branch has - not been merged yet, also make sure the user is aware of that. - - `delete-branch-on-remote' Deleting a \"remote branch\" may mean - deleting the (local) \"remote-tracking\" branch only, or also - removing it from the remote itself. The latter often makes more - sense because otherwise simply fetching from the remote would - restore the remote-tracking branch, but doing that can be - surprising and hard to recover from, so we ask. - - `delete-pr-remote' When deleting a branch that was created from - a pull-request and if no other branches still exist on that - remote, then `magit-branch-delete' offers to delete the remote - as well. This should be safe because it only happens if no - other refs exist in the remotes namespace, and you can recreate - the remote if necessary. - - `drop-stashes' Dropping a stash is dangerous because Git stores - stashes in the reflog. Once a stash is removed, there is no - going back without using low-level recovery tools provided by - Git. When a single stash is dropped, then the user always has - to confirm by accepting the default (or selecting another). - This action only concerns the deletion of multiple stashes at - once. - -Publishing: - - `set-and-push' When pushing to the upstream or the push-remote - and that isn't actually configured yet, then the user can first - set the target. If s/he confirms the default too quickly, then - s/he might end up pushing to the wrong branch and if the remote - repository is configured to disallow fixing such mistakes, then - that can be quite embarrassing and annoying. - -Edit published history: - - Without adding these symbols here, you will be warned before - editing commits that have already been pushed to one of the - branches listed in `magit-published-branches'. - - `amend-published' Affects most commands that amend to `HEAD'. - - `rebase-published' Affects commands that perform interactive - rebases. This includes commands from the commit popup that - modify a commit other than `HEAD', namely the various fixup - and squash variants. - - `edit-published' Affects the commands `magit-edit-line-commit' - and `magit-diff-edit-hunk-commit'. These two commands make - it quite easy to accidentally edit a published commit, so you - should think twice before configuring them not to ask for - confirmation. - - To disable confirmation completely, add all three symbols here - or set `magit-published-branches' to nil. - -Removing modules: - - `remove-modules' When you remove the working directory of a - module that does not contain uncommitted changes, then that is - safer than doing so when there are uncommitted changes and/or - when you also remove the gitdir. Still, you don't want to do - that by accident. - - `remove-dirty-modules' When you remove the working directory of - a module that contains uncommitted changes, then those changes - are gone for good. It is better to go to the module, inspect - these changes and only if appropriate discard them manually. - - `trash-module-gitdirs' When you remove the gitdir of a module, - then all unpushed changes are gone for good. It is very easy - to forget that you have some unfinished work on an unpublished - feature branch or even in a stash. - - Actually there are some safety precautions in place, that might - help you out if you make an unwise choice here, but don't count - on it. In case of emergency, stay calm and check the stash and - the `trash-directory' for traces of lost work. - -Various: - - `stash-apply-3way' When a stash cannot be applied using \"git - stash apply\", then Magit uses \"git apply\" instead, possibly - using the \"--3way\" argument, which isn't always perfectly - safe. See also `magit-stash-apply'. - - `kill-process' There seldom is a reason to kill a process. - -Global settings: - - Instead of adding all of the above symbols to the value of this - option you can also set it to the atom `t', which has the same - effect as adding all of the above symbols. Doing that most - certainly is a bad idea, especially because other symbols might - be added in the future. So even if you don't want to be asked - for confirmation for any of these actions, you are still better - of adding all of the respective symbols individually. - - When `magit-wip-before-change-mode' is enabled then these actions - can fairly easily be undone: `discard', `reverse', - `stage-all-changes', and `unstage-all-changes'. If and only if - this mode is enabled, then `safe-with-wip' has the same effect - as adding all of these symbols individually." - :package-version '(magit . "2.1.0") - :group 'magit-essentials - :group 'magit-commands - :type `(choice (const :tag "Always require confirmation" nil) - (const :tag "Never require confirmation" t) - (set :tag "Require confirmation except for" - ;; `remove-dirty-modules' and - ;; `trash-module-gitdirs' intentionally - ;; omitted. - ,@magit--confirm-actions))) - -(defcustom magit-slow-confirm '(drop-stashes) - "Whether to ask user \"y or n\" or \"yes or no\" questions. - -When this is nil, then `y-or-n-p' is used when the user has to -confirm a potentially destructive action. When this is t, then -`yes-or-no-p' is used instead. If this is a list of symbols -identifying actions, then `yes-or-no-p' is used for those, -`y-or-no-p' for all others. The list of actions is the same as -for `magit-no-confirm' (which see)." - :package-version '(magit . "2.9.0") - :group 'magit-miscellaneous - :type `(choice (const :tag "Always ask \"yes or no\" questions" t) - (const :tag "Always ask \"y or n\" questions" nil) - (set :tag "Ask \"yes or no\" questions only for" - ,@magit--confirm-actions))) - -(defcustom magit-no-message nil - "A list of messages Magit should not display. - -Magit displays most echo area messages using `message', but a few -are displayed using `magit-message' instead, which takes the same -arguments as the former, FORMAT-STRING and ARGS. `magit-message' -forgoes printing a message if any member of this list is a prefix -of the respective FORMAT-STRING. - -If Magit prints a message which causes you grief, then please -first investigate whether there is another option which can be -used to suppress it. If that is not the case, then ask the Magit -maintainers to start using `magit-message' instead of `message' -in that case. We are not proactively replacing all uses of -`message' with `magit-message', just in case someone *might* find -some of these messages useless. - -Messages which can currently be suppressed using this option are: -* \"Turning on magit-auto-revert-mode...\"" - :package-version '(magit . "2.8.0") - :group 'magit-miscellaneous - :type '(repeat string)) - -(defcustom magit-verbose-messages nil - "Whether to make certain prompts and messages more verbose. - -Occasionally a user suggests that a certain prompt or message -should be more verbose, but I would prefer to keep it as-is -because I don't think that the fact that that one user did not -understand the existing prompt/message means that a large number -of users would have the same difficulty, and that making it more -verbose would actually do a disservice to users who understand -the shorter prompt well enough. - -Going forward I will start offering both messages when I feel the -suggested longer message is reasonable enough, and the value of -this option decides which will be used. Note that changing the -value of this option affects all such messages and that I do not -intend to add an option per prompt." - :package-version '(magit . "4.0.0") - :group 'magit-miscellaneous - :type 'boolean) - -(defcustom magit-ellipsis - '((margin (?… . ">")) - (t (?… . "..."))) - "Characters or strings used to abbreviate text in some buffers. - -Each element has the form (WHERE (FANCY . UNIVERSAL)). - -FANCY is a single character or nil whereas UNIVERSAL is a string -of any length. The ellipsis produced by `magit--ellipsis' will -be FANCY if it's a non-nil character that can be displayed with -the available fonts, otherwise UNIVERSAL will be used. FANCY is -meant to be a rich character like a horizontal ellipsis symbol or -an emoji whereas UNIVERSAL something simpler available in a less -rich environment like the CLI. WHERE determines the use-case for -the ellipsis definition. Currently the only acceptable values -for WHERE are `margin' or t (representing the default). - -Whether collapsed sections are indicated using ellipsis is -controlled by `magit-section-visibility-indicator'." - :package-version '(magit . "4.0.0") - :group 'magit-miscellaneous - :type '(repeat (list (symbol :tag "Where") - (cons (choice :tag "Fancy" character (const nil)) - (string :tag "Universal"))))) - -(defcustom magit-update-other-window-delay 0.2 - "Delay before automatically updating the other window. - -When moving around in certain buffers, then certain other -buffers, which are being displayed in another window, may -optionally be updated to display information about the -section at point. - -When holding down a key to move by more than just one section, -then that would update that buffer for each section on the way. -To prevent that, updating the revision buffer is delayed, and -this option controls for how long. For optimal experience you -might have to adjust this delay and/or the keyboard repeat rate -and delay of your graphical environment or operating system." - :package-version '(magit . "2.3.0") - :group 'magit-miscellaneous - :type 'number) - -(defcustom magit-view-git-manual-method 'info - "How links to Git documentation are followed from Magit's Info manuals. - -`info' Follow the link to the node in the `gitman' Info manual - as usual. Unfortunately that manual is not installed by - default on some platforms, and when it is then the nodes - look worse than the actual manpages. - -`man' View the respective man-page using the `man' package. - -`woman' View the respective man-page using the `woman' package." - :package-version '(magit . "2.9.0") - :group 'magit-miscellaneous - :type '(choice (const :tag "view info manual" info) - (const :tag "view manpage using `man'" man) - (const :tag "view manpage using `woman'" woman))) - -;;; Section Classes - -(defclass magit-commit-section (magit-section) - ((keymap :initform 'magit-commit-section-map))) - -(setf (alist-get 'commit magit--section-type-alist) 'magit-commit-section) - -(defclass magit-diff-section (magit-section) - ((keymap :initform 'magit-diff-section-map)) - :abstract t) - -(defclass magit-file-section (magit-diff-section) - ((keymap :initform 'magit-file-section-map) - (source :initform nil :initarg :source) - (header :initform nil :initarg :header) - (binary :initform nil :initarg :binary))) - -(defclass magit-module-section (magit-file-section) - ((keymap :initform 'magit-module-section-map) - (range :initform nil :initarg :range))) - -(defclass magit-hunk-section (magit-diff-section) - ((keymap :initform 'magit-hunk-section-map) - (refined :initform nil) - (combined :initform nil :initarg :combined) - (from-range :initform nil :initarg :from-range) - (from-ranges :initform nil) - (to-range :initform nil :initarg :to-range) - (about :initform nil :initarg :about))) - -(setf (alist-get 'file magit--section-type-alist) 'magit-file-section) -(setf (alist-get 'module magit--section-type-alist) 'magit-module-section) -(setf (alist-get 'hunk magit--section-type-alist) 'magit-hunk-section) - -(defclass magit-log-section (magit-section) - ((keymap :initform 'magit-log-section-map)) - :abstract t) -(defclass magit-unpulled-section (magit-log-section) ()) -(defclass magit-unpushed-section (magit-log-section) ()) -(defclass magit-unmerged-section (magit-log-section) ()) - -(setf (alist-get 'unpulled magit--section-type-alist) 'magit-unpulled-section) -(setf (alist-get 'unpushed magit--section-type-alist) 'magit-unpushed-section) -(setf (alist-get 'unmerged magit--section-type-alist) 'magit-unmerged-section) - -;;; User Input - -(defvar helm-completion-in-region-default-sort-fn) -(defvar helm-crm-default-separator) -(defvar ivy-sort-functions-alist) -(defvar ivy-sort-matches-functions-alist) -(defvar vertico-sort-function) - -(defvar magit-completing-read--silent-default nil) - -(defvar magit-completing-read-default-prompt-predicate - (lambda () - (and (eq magit-completing-read-function - 'magit-builtin-completing-read) - (not (or (bound-and-true-p helm-mode) - (bound-and-true-p ivy-mode) - (bound-and-true-p selectrum-mode) - (bound-and-true-p vertico-mode))))) - "Function used to determine whether to add default to prompt. - -This is used by `magit-completing-read' (which see). - -The default function returns nil, when a completion frameworks is used -for which this is undesirable. More precisely, it returns nil, when -`magit-completing-read-function' is not `magit-builtin-completing-read', -or one of `helm-mode', `ivy-mode', `selectrum-mode' or `vertico-mode' -is enabled. When this function returns nil, then nil is passed to -`format-prompt' (which see), instead of the default (DEF or FALLBACK).") - -(defun magit-completing-read ( prompt collection &optional - predicate require-match initial-input - hist def fallback) - "Read a choice in the minibuffer, or use the default choice. - -This is the function that Magit commands use when they need the -user to select a single thing to act on. The arguments have the -same meaning as for `completing-read', except for FALLBACK, which -is unique to this function and is described below. - -Instead of asking the user to choose from a list of possible -candidates, this function may instead just return the default -specified by DEF, with or without requiring user confirmation. -Whether that is the case depends on PROMPT, `this-command' and -`magit-dwim-selection'. See the documentation of the latter for -more information. - -If it does use the default without the user even having to -confirm that, then `magit-completing-read--silent-default' is set -to t, otherwise nil. - -If it does read a value in the minibuffer, then this function -acts similarly to `completing-read', except for the following: - -- COLLECTION must be a list of choices. A function is not - supported. - -- If REQUIRE-MATCH is nil and the user exits without a choice, - then nil is returned instead of an empty string. - -- If REQUIRE-MATCH is non-nil and the user exits without a - choice, `user-error' is raised. - -- FALLBACK specifies a secondary default that is only used if - the primary default DEF is nil. The secondary default is not - subject to `magit-dwim-selection' — if DEF is nil but FALLBACK - is not, then this function always asks the user to choose a - candidate, just as if both defaults were nil. - -- `format-prompt' is called on PROMPT and DEF (or FALLBACK if - DEF is nil). This appends \": \" to the prompt and may also - add the default to the prompt, using the format specified by - `minibuffer-default-prompt-format' and depending on - `magit-completing-read-default-prompt-predicate'." - (setq magit-completing-read--silent-default nil) - (if-let ((dwim (and def - (nth 2 (seq-find (pcase-lambda (`(,cmd ,re ,_)) - (and (eq this-command cmd) - (or (not re) - (string-match-p re prompt)))) - magit-dwim-selection))))) - (if (eq dwim 'ask) - (if (y-or-n-p (format "%s %s? " prompt def)) - def - (user-error "Abort")) - (setq magit-completing-read--silent-default t) - def) - (unless def - (setq def fallback)) - (let ((command this-command) - (reply (funcall - magit-completing-read-function - (format-prompt - prompt - (and (funcall magit-completing-read-default-prompt-predicate) - def)) - (if (and (not (functionp collection)) - def - (not (member def collection))) - (cons def collection) - collection) - predicate - require-match initial-input hist def))) - (setq this-command command) - ;; Note: Avoid `string=' to support `helm-comp-read-use-marked'. - (if (equal reply "") - (if require-match - (user-error "Nothing selected") - nil) - reply)))) - -(defun magit--completion-table (collection) - (lambda (string pred action) - (if (eq action 'metadata) - '(metadata (display-sort-function . identity)) - (complete-with-action action collection string pred)))) - -(defun magit-builtin-completing-read - (prompt choices &optional predicate require-match initial-input hist def) - "Magit wrapper for standard `completing-read' function." - (unless (or (bound-and-true-p helm-mode) - (bound-and-true-p ivy-mode)) - (setq choices (magit--completion-table choices))) - (let ((ivy-sort-functions-alist nil) - (vertico-sort-function nil)) - (completing-read prompt choices - predicate require-match - initial-input hist def))) - -(define-obsolete-function-alias 'magit-completing-read-multiple* - 'magit-completing-read-multiple "Magit-Section 4.0.0") - -(defun magit-completing-read-multiple - ( prompt table &optional predicate require-match initial-input - hist def inherit-input-method - no-split) - "Read multiple strings in the minibuffer, with completion. -Like `completing-read-multiple' but don't mess with order of -TABLE and take an additional argument NO-SPLIT, which causes -the user input to be returned as a single unmodified string. -Also work around various incompatible features of various -third-party completion frameworks." - (cl-letf* - (;; To implement NO-SPLIT we have to manipulate the respective - ;; `split-string' invocation. We cannot simply advice it to - ;; return the input string because `SELECTRUM' would choke on - ;; that string. Use a variable to pass along the raw user - ;; input string. aa5f098ab - (input nil) - (split-string (symbol-function #'split-string)) - ((symbol-function #'split-string) - (lambda (string &optional separators omit-nulls trim) - (when (and no-split - (equal separators crm-separator) - (equal omit-nulls t)) - (setq input string)) - (funcall split-string string separators omit-nulls trim))) - ;; Prevent `BUILT-IN' completion from messing up our existing - ;; order of the completion candidates. aa5f098ab - (table (magit--completion-table table)) - ;; Prevent `IVY' from messing up our existing order. c7af78726 - (ivy-sort-matches-functions-alist nil) - ;; Prevent `HELM' from messing up our existing order. 6fcf994bd - (helm-completion-in-region-default-sort-fn nil) - ;; Prevent `HELM' from automatically appending the separator, - ;; which is counterproductive when NO-SPLIT is non-nil and/or - ;; when reading commit ranges. 798aff564 - (helm-crm-default-separator - (if no-split nil (bound-and-true-p helm-crm-default-separator))) - ;; And now, the moment we have all been waiting for... - (values (completing-read-multiple - prompt table predicate require-match initial-input - hist def inherit-input-method))) - (if no-split input values))) - -(defun magit-ido-completing-read - (prompt choices &optional predicate require-match initial-input hist def) - "Ido-based `completing-read' almost-replacement. - -Unfortunately `ido-completing-read' is not suitable as a -drop-in replacement for `completing-read', instead we use -`ido-completing-read+' from the third-party package by the -same name." - (if (and (require 'ido-completing-read+ nil t) - (fboundp 'ido-completing-read+)) - (ido-completing-read+ prompt choices predicate require-match - initial-input hist - (or def (and require-match (car choices)))) - (display-warning 'magit "ido-completing-read+ is not installed - -To use Ido completion with Magit you need to install the -third-party `ido-completing-read+' packages. Falling -back to built-in `completing-read' for now." :error) - (magit-builtin-completing-read prompt choices predicate require-match - initial-input hist def))) - -(defvar-keymap magit-minibuffer-local-ns-map - :parent minibuffer-local-map - "SPC" #'magit-whitespace-disallowed - "TAB" #'magit-whitespace-disallowed) - -(defun magit-whitespace-disallowed () - "Beep to tell the user that whitespace is not allowed." - (interactive) - (ding) - (message "Whitespace isn't allowed here") - (setq defining-kbd-macro nil) - (force-mode-line-update)) - -(defun magit-read-string ( prompt &optional initial-input history default-value - inherit-input-method no-whitespace) - "Read a string from the minibuffer, prompting with string PROMPT. - -This is similar to `read-string', but -* empty input is only allowed if DEFAULT-VALUE is non-nil in - which case that is returned, -* whitespace is not allowed and leading and trailing whitespace is - removed automatically if NO-WHITESPACE is non-nil, -* `format-prompt' is used internally. -* an invalid DEFAULT-VALUE is silently ignored." - (when default-value - (when (consp default-value) - (setq default-value (car default-value))) - (unless (stringp default-value) - (setq default-value nil))) - (let* ((minibuffer-completion-table nil) - (val (read-from-minibuffer - (format-prompt prompt default-value) - initial-input (and no-whitespace magit-minibuffer-local-ns-map) - nil history default-value inherit-input-method)) - (trim (lambda (regexp string) - (save-match-data - (if (string-match regexp string) - (replace-match "" t t string) - string))))) - (when (and (string= val "") default-value) - (setq val default-value)) - (when no-whitespace - (setq val (funcall trim "\\`\\(?:[ \t\n\r]+\\)" - (funcall trim "\\(?:[ \t\n\r]+\\)\\'" val)))) - (cond ((string= val "") - (user-error "Need non-empty input")) - ((and no-whitespace (string-match-p "[\s\t\n]" val)) - (user-error "Input contains whitespace")) - (t val)))) - -(defun magit-read-string-ns ( prompt &optional initial-input history - default-value inherit-input-method) - "Call `magit-read-string' with non-nil NO-WHITESPACE." - (magit-read-string prompt initial-input history default-value - inherit-input-method t)) - -(defmacro magit-read-char-case (prompt verbose &rest clauses) - (declare (indent 2) - (debug (form form &rest (characterp form body)))) - `(prog1 (pcase (read-char-choice - (let ((parts (nconc (list ,@(mapcar #'cadr clauses)) - ,(and verbose '(list "[C-g] to abort"))))) - (concat ,prompt - (mapconcat #'identity (butlast parts) ", ") - ", or " (car (last parts)) " ")) - ',(mapcar #'car clauses)) - ,@(--map `(,(car it) ,@(cddr it)) clauses)) - (message ""))) - -(defun magit-y-or-n-p (prompt &optional action) - "Ask user a \"y or n\" or a \"yes or no\" question using PROMPT. -Which kind of question is used depends on whether -ACTION is a member of option `magit-slow-confirm'." - (if (or (eq magit-slow-confirm t) - (and action (member action magit-slow-confirm))) - (yes-or-no-p prompt) - (y-or-n-p prompt))) - -(defvar magit--no-confirm-alist - '((safe-with-wip magit-wip-before-change-mode - discard reverse stage-all-changes unstage-all-changes))) - -(cl-defun magit-confirm ( action &optional prompt prompt-n noabort - (items nil sitems) prompt-suffix) - (declare (indent defun)) - (setq prompt-n (format (concat (or prompt-n prompt) "? ") (length items))) - (setq prompt (format (concat (or prompt (magit-confirm-make-prompt action)) - "? ") - (car items))) - (when prompt-suffix - (setq prompt (concat prompt prompt-suffix))) - (or (cond ((and (not (eq action t)) - (or (eq magit-no-confirm t) - (memq action magit-no-confirm) - (cl-member-if (pcase-lambda (`(,key ,var . ,sub)) - (and (memq key magit-no-confirm) - (memq action sub) - (or (not var) - (and (boundp var) - (symbol-value var))))) - magit--no-confirm-alist))) - (or (not sitems) items)) - ((not sitems) - (magit-y-or-n-p prompt action)) - ((length= items 1) - (and (magit-y-or-n-p prompt action) items)) - ((length> items 1) - (and (magit-y-or-n-p (concat (mapconcat #'identity items "\n") - "\n\n" prompt-n) - action) - items))) - (if noabort nil (user-error "Abort")))) - -(defun magit-confirm-files (action files &optional prompt prompt-suffix noabort) - (when files - (unless prompt - (setq prompt (magit-confirm-make-prompt action))) - (magit-confirm action - (concat prompt " \"%s\"") - (concat prompt " %d files") - noabort files prompt-suffix))) - -(defun magit-confirm-make-prompt (action) - (let ((prompt (symbol-name action))) - (string-replace "-" " " - (concat (upcase (substring prompt 0 1)) - (substring prompt 1))))) - -(defun magit-read-number-string (prompt &optional default _history) - "Like `read-number' but return value is a string. -DEFAULT may be a number or a numeric string." - (number-to-string - (read-number prompt (if (stringp default) - (string-to-number default) - default)))) - -;;; Debug Utilities - -;;;###autoload -(defun magit-emacs-Q-command () - "Show a shell command that runs an uncustomized Emacs with only Magit loaded. -See info node `(magit)Debugging Tools' for more information." - (interactive) - (let ((cmd (mapconcat - #'shell-quote-argument - `(,(concat invocation-directory invocation-name) - "-Q" "--eval" "(setq debug-on-error t)" - ,@(cl-mapcan - (lambda (dir) (list "-L" dir)) - (delete-dups - (cl-mapcan - (lambda (lib) - (let ((path (locate-library lib))) - (cond - (path - (list (file-name-directory path))) - ((not (equal lib "libgit")) - (error "Cannot find mandatory dependency %s" lib))))) - '(;; Like `LOAD_PATH' in `default.mk'. - "compat" - "dash" - "libgit" - "transient" - "with-editor" - ;; Obviously `magit' itself is needed too. - "magit" - ;; While these are part of the Magit repository, - ;; they are distributed as separate packages. - "magit-section" - "git-commit" - )))) - ;; Avoid Emacs bug#16406 by using full path. - "-l" ,(file-name-sans-extension (locate-library "magit"))) - " "))) - (message "Uncustomized Magit command saved to kill-ring, %s" - "please run it in a terminal.") - (kill-new cmd))) - -;;; Text Utilities - -(defmacro magit-bind-match-strings (varlist string &rest body) - "Bind variables to submatches according to VARLIST then evaluate BODY. -Bind the symbols in VARLIST to submatches of the current match -data, starting with 1 and incrementing by 1 for each symbol. If -the last match was against a string, then that has to be provided -as STRING." - (declare (indent 2) (debug (listp form body))) - (let ((s (cl-gensym "string")) - (i 0)) - `(let ((,s ,string)) - (let ,(save-match-data - (cl-mapcan (lambda (sym) - (cl-incf i) - (and (not (eq (aref (symbol-name sym) 0) ?_)) - (list (list sym (list 'match-string i s))))) - varlist)) - ,@body)))) - -(defun magit-delete-line () - "Delete the rest of the current line." - (delete-region (point) (1+ (line-end-position)))) - -(defun magit-delete-match (&optional num) - "Delete text matched by last search. -If optional NUM is specified, only delete that subexpression." - (delete-region (match-beginning (or num 0)) - (match-end (or num 0)))) - -(defun magit-file-line (file) - "Return the first line of FILE as a string." - (when (file-regular-p file) - (with-temp-buffer - (insert-file-contents file) - (buffer-substring-no-properties (point-min) - (line-end-position))))) - -(defun magit-file-lines (file &optional keep-empty-lines) - "Return a list of strings containing one element per line in FILE. -Unless optional argument KEEP-EMPTY-LINES is t, trim all empty lines." - (when (file-regular-p file) - (with-temp-buffer - (insert-file-contents file) - (split-string (buffer-string) "\n" (not keep-empty-lines))))) - -(defun magit-set-header-line-format (string) - "Set `header-line-format' in the current buffer based on STRING. -Pad the left side of STRING so that it aligns with the text area." - (setq header-line-format - (concat (propertize " " 'display '(space :align-to 0)) - string))) - -(defun magit--format-spec (format specification) - "Like `format-spec' but preserve text properties in SPECIFICATION." - (with-temp-buffer - (insert format) - (goto-char (point-min)) - (while (search-forward "%" nil t) - (cond - ;; Quoted percent sign. - ((eq (char-after) ?%) - (delete-char 1)) - ;; Valid format spec. - ((looking-at "\\([-0-9.]*\\)\\([a-zA-Z]\\)") - (let* ((num (match-string 1)) - (spec (string-to-char (match-string 2))) - (val (assq spec specification))) - (unless val - (error "Invalid format character: `%%%c'" spec)) - (setq val (cdr val)) - ;; Pad result to desired length. - (let ((text (format (concat "%" num "s") val))) - ;; Insert first, to preserve text properties. - (if (next-property-change 0 (concat " " text)) - ;; If the inserted text has properties, then preserve those. - (insert text) - ;; Otherwise preserve FORMAT's properties, like `format-spec'. - (insert-and-inherit text)) - ;; Delete the specifier body. - (delete-region (+ (match-beginning 0) (length text)) - (+ (match-end 0) (length text))) - ;; Delete the percent sign. - (delete-region (1- (match-beginning 0)) (match-beginning 0))))) - ;; Signal an error on bogus format strings. - (t - (error "Invalid format string")))) - (buffer-string))) - -;;; Missing from Emacs - -(defun magit-kill-this-buffer () - "Kill the current buffer." - (interactive) - (kill-buffer (current-buffer))) - -(defun magit--buffer-string (&optional min max trim) - "Like `buffer-substring-no-properties' but the arguments are optional. - -This combines the benefits of `buffer-string', `buffer-substring' -and `buffer-substring-no-properties' into one function that is -not as painful to use as the latter. I.e., you can write - (magit--buffer-string) -instead of - (buffer-substring-no-properties (point-min) - (point-max)) - -Optional MIN defaults to the value of `point-min'. -Optional MAX defaults to the value of `point-max'. - -If optional TRIM is non-nil, then all leading and trailing -whitespace is remove. If it is the newline character, then -one trailing newline is added." - ;; Lets write that one last time and be done with it: - (let ((str (buffer-substring-no-properties (or min (point-min)) - (or max (point-max))))) - (if trim - (concat (string-trim str) - (and (eq trim ?\n) "\n")) - str))) - -(defun magit--version> (v1 v2) - "Return t if version V1 is higher (younger) than V2. -This function should be named `version>' and be part of Emacs." - (version-list-< (version-to-list v2) (version-to-list v1))) - -(defun magit--version>= (v1 v2) - "Return t if version V1 is higher (younger) than or equal to V2. -This function should be named `version>=' and be part of Emacs." - (version-list-<= (version-to-list v2) (version-to-list v1))) - -;;; Kludges for Emacs Bugs - -(when (< emacs-major-version 27) - ;; Work around https://debbugs.gnu.org/cgi/bugreport.cgi?bug=21559. - ;; Fixed by cb55ccae8be946f1562d74718086a4c8c8308ee5 in Emacs 27.1. - (with-eval-after-load 'vc-git - (defun vc-git-conflicted-files (directory) - "Return the list of files with conflicts in DIRECTORY." - (let* ((status - (vc-git--run-command-string directory "diff-files" - "--name-status")) - (lines (when status (split-string status "\n" 'omit-nulls))) - files) - (dolist (line lines files) - (when (string-match "\\([ MADRCU?!]\\)[ \t]+\\(.+\\)" line) - (let ((state (match-string 1 line)) - (file (match-string 2 line))) - (when (equal state "U") - (push (expand-file-name file directory) files))))))))) - -(when (< emacs-major-version 27) - (defun vc-git--call@bug21559 (fn buffer command &rest args) - "Backport https://debbugs.gnu.org/cgi/bugreport.cgi?bug=21559." - (let ((process-environment process-environment)) - (when revert-buffer-in-progress-p - (push "GIT_OPTIONAL_LOCKS=0" process-environment)) - (apply fn buffer command args))) - (advice-add 'vc-git--call :around 'vc-git--call@bug21559) - - (defun vc-git-command@bug21559 - (fn buffer okstatus file-or-list &rest flags) - "Backport https://debbugs.gnu.org/cgi/bugreport.cgi?bug=21559." - (let ((process-environment process-environment)) - (when revert-buffer-in-progress-p - (push "GIT_OPTIONAL_LOCKS=0" process-environment)) - (apply fn buffer okstatus file-or-list flags))) - (advice-add 'vc-git-command :around 'vc-git-command@bug21559) - - (defun auto-revert-handler@bug21559 (fn) - "Backport https://debbugs.gnu.org/cgi/bugreport.cgi?bug=21559." - (let ((revert-buffer-in-progress-p t)) - (funcall fn))) - (advice-add 'auto-revert-handler :around 'auto-revert-handler@bug21559) - ) - -(defun magit-which-function () - "Return current function name based on point. - -This is a simple wrapper around `which-function', that resets -Imenu's potentially outdated and therefore unreliable cache by -setting `imenu--index-alist' to nil before calling that function." - (setq imenu--index-alist nil) - (which-function)) - -;;; Kludges for Custom - -(defun magit-custom-initialize-reset (symbol exp) - "Initialize SYMBOL based on EXP. -Set the value of the variable SYMBOL, using `set-default' -\(unlike `custom-initialize-reset', which uses the `:set' -function if any). The value is either the symbol's current -value (as obtained using the `:get' function), if any, or -the value in the symbol's `saved-value' property if any, or -\(last of all) the value of EXP." - (set-default-toplevel-value - symbol - (condition-case nil - (let ((def (default-toplevel-value symbol)) - (getter (get symbol 'custom-get))) - (if getter (funcall getter symbol) def)) - (error - (eval (let ((sv (get symbol 'saved-value))) - (if sv (car sv) exp))))))) - -(defun magit-hook-custom-get (symbol) - (if (symbol-file symbol 'defvar) - (default-toplevel-value symbol) - ;; - ;; Called by `custom-initialize-reset' on behalf of `symbol's - ;; `defcustom', which is being evaluated for the first time to - ;; set the initial value, but there's already a default value, - ;; which most likely was established by one or more `add-hook' - ;; calls. - ;; - ;; We combine the `standard-value' and the current value, while - ;; preserving the order established by `:options', and return - ;; the result of that to be used as the "initial" default value. - ;; - (let ((standard (eval (car (get symbol 'standard-value)))) - (current (default-toplevel-value symbol)) - (value nil)) - (dolist (fn (get symbol 'custom-options)) - (when (or (memq fn standard) - (memq fn current)) - (push fn value))) - (dolist (fn current) - (unless (memq fn value) - (push fn value))) - (nreverse value)))) - -;;; Kludges for Info Manuals - -;;;###autoload -(define-advice Info-follow-nearest-node (:around (fn &optional fork) gitman) - (let ((node (Info-get-token - (point) "\\*note[ \n\t]+" - "\\*note[ \n\t]+\\([^:]*\\):\\(:\\|[ \n\t]*(\\)?"))) - (if (and node (string-match "^(gitman)\\(.+\\)" node)) - (pcase magit-view-git-manual-method - ('info (funcall fn fork)) - ('man (require 'man) - (man (match-string 1 node))) - ('woman (require 'woman) - (woman (match-string 1 node))) - (_ (user-error "Invalid value for `magit-view-git-manual-method'"))) - (funcall fn fork)))) - -;; When making changes here, then also adjust the copy in docs/Makefile. -;;;###autoload -(define-advice org-man-export (:around (fn link description format) gitman) - (if (and (eq format 'texinfo) - (string-prefix-p "git" link)) - (string-replace "%s" link " -@ifinfo -@ref{%s,,,gitman,}. -@end ifinfo -@ifhtml -@html -the <a href=\"http://git-scm.com/docs/%s\">%s(1)</a> manpage. -@end html -@end ifhtml -@iftex -the %s(1) manpage. -@end iftex -") - (funcall fn link description format))) - -;;; Kludges for Package Managers - -(defun magit--straight-chase-links (filename) - "Chase links in FILENAME until a name that is not a link. - -This is the same as `file-chase-links', except that it also -handles fake symlinks that are created by the package manager -straight.el on Windows. - -See <https://github.com/raxod502/straight.el/issues/520>." - (when (and (bound-and-true-p straight-symlink-emulation-mode) - (fboundp 'straight-chase-emulated-symlink)) - (when-let ((target (straight-chase-emulated-symlink filename))) - (unless (eq target 'broken) - (setq filename target)))) - (file-chase-links filename)) - -;;; Kludges for older Emacs versions - -(if (fboundp 'with-connection-local-variables) - (defalias 'magit--with-connection-local-variables - #'with-connection-local-variables) - (defmacro magit--with-connection-local-variables (&rest body) - "Abridged `with-connection-local-variables' for pre Emacs 27 compatibility. -Bind shell file name and switch for remote execution. -`with-connection-local-variables' isn't available until Emacs 27. -This kludge provides the minimal functionality required by -Magit." - `(if (file-remote-p default-directory) - (pcase-let ((`(,shell-file-name ,shell-command-switch) - (with-no-warnings ; about unknown tramp functions - (require 'tramp) - (let ((vec (tramp-dissect-file-name - default-directory))) - (list (tramp-get-method-parameter - vec 'tramp-remote-shell) - (mapconcat #'identity - (tramp-get-method-parameter - vec 'tramp-remote-shell-args) - " ")))))) - ,@body) - ,@body))) - -(put 'magit--with-connection-local-variables 'lisp-indent-function 'defun) - -;;; Miscellaneous - -(defun magit-message (format-string &rest args) - "Display a message at the bottom of the screen, or not. -Like `message', except that if the users configured option -`magit-no-message' to prevent the message corresponding to -FORMAT-STRING to be displayed, then don't." - (unless (--first (string-prefix-p it format-string) magit-no-message) - (apply #'message format-string args))) - -(defun magit-msg (format-string &rest args) - "Display a message at the bottom of the screen, but don't log it. -Like `message', except that `message-log-max' is bound to nil." - (let ((message-log-max nil)) - (apply #'message format-string args))) - -(defmacro magit--with-temp-position (buf pos &rest body) - (declare (indent 2)) - `(with-current-buffer ,buf - (save-excursion - (save-restriction - (widen) - (goto-char (or ,pos 1)) - ,@body)))) - -(defun magit--ellipsis (&optional where) - "Build an ellipsis always as string, depending on WHERE." - (if (stringp magit-ellipsis) - magit-ellipsis - (if-let ((pair (car (or - (alist-get (or where t) magit-ellipsis) - (alist-get t magit-ellipsis))))) - (pcase-let ((`(,fancy . ,universal) pair)) - (let ((ellipsis (if (and fancy (char-displayable-p fancy)) - fancy - universal))) - (if (characterp ellipsis) - (char-to-string ellipsis) - ellipsis))) - (user-error "Variable magit-ellipsis is invalid")))) - -(defun magit--ext-regexp-quote (str) - "Like `reqexp-quote', but for Extended Regular Expressions." - (let ((special (string-to-list "[*.\\?+^$({")) - (quoted nil)) - (mapc (lambda (c) - (when (memq c special) - (push ?\\ quoted)) - (push c quoted)) - str) - (concat (nreverse quoted)))) - -;;; _ -(provide 'magit-base) -;;; magit-base.el ends here diff --git a/emacs/elpa/magit-20240622.1531/magit-base.elc b/emacs/elpa/magit-20240622.1531/magit-base.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/magit-bisect.el b/emacs/elpa/magit-20240622.1531/magit-bisect.el @@ -1,322 +0,0 @@ -;;; magit-bisect.el --- Bisect support for Magit -*- lexical-binding:t -*- - -;; Copyright (C) 2008-2024 The Magit Project Contributors - -;; Author: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> -;; Maintainer: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> - -;; SPDX-License-Identifier: GPL-3.0-or-later - -;; 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. -;; -;; 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 Magit. If not, see <https://www.gnu.org/licenses/>. - -;;; Commentary: - -;; Use a binary search to find the commit that introduced a bug. - -;;; Code: - -(require 'magit) - -;;; Options - -(defcustom magit-bisect-show-graph t - "Whether to use `--graph' in the log showing commits yet to be bisected." - :package-version '(magit . "2.8.0") - :group 'magit-status - :type 'boolean) - -(defface magit-bisect-good - '((t :foreground "DarkOliveGreen")) - "Face for good bisect revisions." - :group 'magit-faces) - -(defface magit-bisect-skip - '((t :foreground "DarkGoldenrod")) - "Face for skipped bisect revisions." - :group 'magit-faces) - -(defface magit-bisect-bad - '((t :foreground "IndianRed4")) - "Face for bad bisect revisions." - :group 'magit-faces) - -;;; Commands - -;;;###autoload (autoload 'magit-bisect "magit-bisect" nil t) -(transient-define-prefix magit-bisect () - "Narrow in on the commit that introduced a bug." - :man-page "git-bisect" - [:class transient-subgroups - :if-not magit-bisect-in-progress-p - ["Arguments" - ("-n" "Don't checkout commits" "--no-checkout") - ("-p" "Follow only first parent of a merge" "--first-parent" - :if (lambda () (magit-git-version>= "2.29"))) - (6 magit-bisect:--term-old - :if (lambda () (magit-git-version>= "2.7"))) - (6 magit-bisect:--term-new - :if (lambda () (magit-git-version>= "2.7")))] - ["Actions" - ("B" "Start" magit-bisect-start) - ("s" "Start script" magit-bisect-run)]] - ["Actions" - :if magit-bisect-in-progress-p - ("B" "Bad" magit-bisect-bad) - ("g" "Good" magit-bisect-good) - (6 "m" "Mark" magit-bisect-mark - :if (lambda () (magit-git-version>= "2.7"))) - ("k" "Skip" magit-bisect-skip) - ("r" "Reset" magit-bisect-reset) - ("s" "Run script" magit-bisect-run)]) - -(transient-define-argument magit-bisect:--term-old () - :description "Old/good term" - :class 'transient-option - :key "=o" - :argument "--term-old=") - -(transient-define-argument magit-bisect:--term-new () - :description "New/bad term" - :class 'transient-option - :key "=n" - :argument "--term-new=") - -;;;###autoload -(defun magit-bisect-start (bad good args) - "Start a bisect session. - -Bisecting a bug means to find the commit that introduced it. -This command starts such a bisect session by asking for a known -good and a known bad commit. To move the session forward use the -other actions from the bisect transient command (\ -\\<magit-status-mode-map>\\[magit-bisect])." - (interactive (if (magit-bisect-in-progress-p) - (user-error "Already bisecting") - (magit-bisect-start-read-args))) - (magit-bisect-start--assert bad good args) - (magit-repository-local-set 'bisect--first-parent - (transient-arg-value "--first-parent" args)) - (magit-git-bisect "start" (list args bad good) t)) - -(defun magit-bisect-start-read-args () - (let* ((args (transient-args 'magit-bisect)) - (bad (magit-read-branch-or-commit - (format "Start bisect with %s revision" - (or (transient-arg-value "--term-new=" args) - "bad"))))) - (list bad - (magit-read-other-branch-or-commit - (format "%s revision" (or (transient-arg-value "--term-old=" args) - "Good")) - bad) - args))) - -(defun magit-bisect-start--assert (bad good args) - (unless (magit-rev-ancestor-p good bad) - (user-error - "The %s revision (%s) has to be an ancestor of the %s one (%s)" - (or (transient-arg-value "--term-old=" args) "good") - good - (or (transient-arg-value "--term-new=" args) "bad") - bad)) - (when (magit-anything-modified-p) - (user-error "Cannot bisect with uncommitted changes"))) - -;;;###autoload -(defun magit-bisect-reset () - "After bisecting, cleanup bisection state and return to original `HEAD'." - (interactive) - (magit-confirm 'reset-bisect) - (magit-run-git "bisect" "reset") - (magit-repository-local-delete 'bisect--first-parent) - (ignore-errors - (delete-file (expand-file-name "BISECT_CMD_OUTPUT" (magit-gitdir))))) - -;;;###autoload -(defun magit-bisect-good () - "While bisecting, mark the current commit as good. -Use this after you have asserted that the commit does not contain -the bug in question." - (interactive) - (magit-git-bisect (or (cadr (magit-bisect-terms)) - (user-error "Not bisecting")))) - -;;;###autoload -(defun magit-bisect-bad () - "While bisecting, mark the current commit as bad. -Use this after you have asserted that the commit does contain the -bug in question." - (interactive) - (magit-git-bisect (or (car (magit-bisect-terms)) - (user-error "Not bisecting")))) - -;;;###autoload -(defun magit-bisect-mark () - "While bisecting, mark the current commit with a bisect term. -During a bisect using alternate terms, commits can still be -marked with `magit-bisect-good' and `magit-bisect-bad', as those -commands map to the correct term (\"good\" to --term-old's value -and \"bad\" to --term-new's). However, in some cases, it can be -difficult to keep that mapping straight in your head; this -command provides an interface that exposes the underlying terms." - (interactive) - (magit-git-bisect - (pcase-let ((`(,term-new ,term-old) (or (magit-bisect-terms) - (user-error "Not bisecting")))) - (pcase (read-char-choice - (format "Mark HEAD as %s ([n]ew) or %s ([o]ld)" - term-new term-old) - (list ?n ?o)) - (?n term-new) - (?o term-old))))) - -;;;###autoload -(defun magit-bisect-skip () - "While bisecting, skip the current commit. -Use this if for some reason the current commit is not a good one -to test. This command lets Git choose a different one." - (interactive) - (magit-git-bisect "skip")) - -;;;###autoload -(defun magit-bisect-run (cmdline &optional bad good args) - "Bisect automatically by running commands after each step. - -Unlike `git bisect run' this can be used before bisecting has -begun. In that case it behaves like `git bisect start; git -bisect run'." - (interactive (let ((args (and (not (magit-bisect-in-progress-p)) - (magit-bisect-start-read-args)))) - (cons (read-shell-command "Bisect shell command: ") args))) - (when (and bad good) - (magit-bisect-start--assert bad good args) - ;; Avoid `magit-git-bisect' because it's asynchronous, but the - ;; next `git bisect run' call requires the bisect to be started. - (magit-with-toplevel - (magit-process-git - (list :file (expand-file-name "BISECT_CMD_OUTPUT" (magit-gitdir))) - (magit-process-git-arguments - (list "bisect" "start" bad good args))) - (magit-refresh))) - (magit--with-connection-local-variables - (magit-git-bisect "run" (list shell-file-name - shell-command-switch cmdline)))) - -(defun magit-git-bisect (subcommand &optional args no-assert) - (unless (or no-assert (magit-bisect-in-progress-p)) - (user-error "Not bisecting")) - (message "Bisecting...") - (magit-with-toplevel - (magit-run-git-async "bisect" subcommand args)) - (set-process-sentinel - magit-this-process - (lambda (process event) - (when (memq (process-status process) '(exit signal)) - (if (> (process-exit-status process) 0) - (magit-process-sentinel process event) - (process-put process 'inhibit-refresh t) - (magit-process-sentinel process event) - (when (buffer-live-p (process-buffer process)) - (with-current-buffer (process-buffer process) - (when-let* ((section (magit-section-at)) - (output (buffer-substring-no-properties - (oref section content) - (oref section end)))) - (with-temp-file - (expand-file-name "BISECT_CMD_OUTPUT" (magit-gitdir)) - (insert output))))) - (magit-refresh)) - (message "Bisecting...done"))))) - -;;; Sections - -(defun magit-bisect-in-progress-p () - (file-exists-p (expand-file-name "BISECT_LOG" (magit-gitdir)))) - -(defun magit-bisect-terms () - (magit-file-lines (expand-file-name "BISECT_TERMS" (magit-gitdir)))) - -(defun magit-insert-bisect-output () - "While bisecting, insert section with output from `git bisect'." - (when (magit-bisect-in-progress-p) - (let* ((lines - (or (magit-file-lines - (expand-file-name "BISECT_CMD_OUTPUT" (magit-gitdir))) - (list "Bisecting: (no saved bisect output)" - "It appears you have invoked `git bisect' from a shell." - "There is nothing wrong with that, we just cannot display" - "anything useful here. Consult the shell output instead."))) - (done-re "^\\([a-z0-9]\\{40,\\}\\) is the first bad commit$") - (bad-line (or (and (string-match done-re (car lines)) - (pop lines)) - (--first (string-match done-re it) lines)))) - (magit-insert-section ((eval (if bad-line 'commit 'bisect-output)) - (and bad-line (match-string 1 bad-line))) - (magit-insert-heading - (propertize (or bad-line (pop lines)) - 'font-lock-face 'magit-section-heading)) - (dolist (line lines) - (insert line "\n")))) - (insert "\n"))) - -(defun magit-insert-bisect-rest () - "While bisecting, insert section visualizing the bisect state." - (when (magit-bisect-in-progress-p) - (magit-insert-section (bisect-view) - (magit-insert-heading "Bisect Rest:") - (magit-git-wash (apply-partially #'magit-log-wash-log 'bisect-vis) - "bisect" "visualize" "git" "log" - "--format=%h%x00%D%x00%s" "--decorate=full" - (and magit-bisect-show-graph "--graph") - (and (magit-repository-local-get 'bisect--first-parent) - "--first-parent"))))) - -(defun magit-insert-bisect-log () - "While bisecting, insert section logging bisect progress." - (when (magit-bisect-in-progress-p) - (magit-insert-section (bisect-log) - (magit-insert-heading "Bisect Log:") - (magit-git-wash #'magit-wash-bisect-log "bisect" "log") - (insert ?\n)))) - -(defun magit-wash-bisect-log (_args) - (let (beg) - (while (progn (setq beg (point-marker)) - (re-search-forward - "^\\(\\(?:git bisect\\|# status:\\) [^\n]+\n\\)" nil t)) - (if (string-prefix-p "# status:" (match-string 1)) - (magit-delete-match) - (magit-bind-match-strings (heading) nil - (magit-delete-match) - (save-restriction - (narrow-to-region beg (point)) - (goto-char (point-min)) - (magit-insert-section (bisect-item heading t) - (insert (propertize heading 'font-lock-face - 'magit-section-secondary-heading)) - (magit-insert-heading) - (magit-wash-sequence - (apply-partially #'magit-log-wash-rev 'bisect-log - (magit-abbrev-length))) - (insert ?\n)))))) - (when (re-search-forward - "# first bad commit: \\[\\([a-z0-9]\\{40,\\}\\)\\] [^\n]+\n" nil t) - (magit-bind-match-strings (hash) nil - (magit-delete-match) - (magit-insert-section (bisect-item) - (insert hash " is the first bad commit\n")))))) - -;;; _ -(provide 'magit-bisect) -;;; magit-bisect.el ends here diff --git a/emacs/elpa/magit-20240622.1531/magit-bisect.elc b/emacs/elpa/magit-20240622.1531/magit-bisect.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/magit-bookmark.el b/emacs/elpa/magit-20240622.1531/magit-bookmark.el @@ -1,154 +0,0 @@ -;;; magit-bookmark.el --- Bookmarks for Magit buffers -*- lexical-binding:t -*- - -;; Copyright (C) 2008-2024 The Magit Project Contributors - -;; Inspired by an earlier implementation by Yuri Khan. - -;; Author: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> -;; Maintainer: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> - -;; SPDX-License-Identifier: GPL-3.0-or-later - -;; 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. -;; -;; 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 Magit. If not, see <https://www.gnu.org/licenses/>. - -;;; Commentary: - -;; Support for bookmarks for most Magit buffers. - -;;; Code: - -(require 'magit) - -(require 'bookmark) - -;;; Common - -(cl-defmethod magit-bookmark-get-filename (&context (major-mode magit-mode)) - (magit-toplevel)) - -(cl-defmethod magit-bookmark-get-buffer-create - (bookmark (mode (derived-mode magit-mode))) - (let ((default-directory (bookmark-get-filename bookmark)) - (magit-display-buffer-function #'identity) - (magit-display-buffer-noselect t)) - (apply (intern (format "%s-setup-buffer" - (substring (symbol-name mode) 0 -5))) - (--map (bookmark-prop-get bookmark it) - (get mode 'magit-bookmark-variables))))) - -;;; Diff -;;;; Diff - -(put 'magit-diff-mode 'magit-bookmark-variables - '(magit-buffer-range-hashed - magit-buffer-typearg - magit-buffer-diff-args - magit-buffer-diff-files)) - -(cl-defmethod magit-bookmark-name (&context (major-mode magit-diff-mode)) - (format "magit-diff(%s%s)" - (pcase (magit-diff-type) - ('staged "staged") - ('unstaged "unstaged") - ('committed magit-buffer-range) - ('undefined - (delq nil (list magit-buffer-typearg magit-buffer-range-hashed)))) - (if magit-buffer-diff-files - (concat " -- " (mapconcat #'identity magit-buffer-diff-files " ")) - ""))) - -;;;; Revision - -(put 'magit-revision-mode 'magit-bookmark-variables - '(magit-buffer-revision-hash - magit-buffer-diff-args - magit-buffer-diff-files)) - -(cl-defmethod magit-bookmark-name (&context (major-mode magit-revision-mode)) - (format "magit-revision(%s %s)" - (magit-rev-abbrev magit-buffer-revision) - (if magit-buffer-diff-files - (mapconcat #'identity magit-buffer-diff-files " ") - (magit-rev-format "%s" magit-buffer-revision)))) - -;;;; Stash - -(put 'magit-stash-mode 'magit-bookmark-variables - '(magit-buffer-revision-hash - magit-buffer-diff-args - magit-buffer-diff-files)) - -(cl-defmethod magit-bookmark-name (&context (major-mode magit-stash-mode)) - (format "magit-stash(%s %s)" - (magit-rev-abbrev magit-buffer-revision) - (if magit-buffer-diff-files - (mapconcat #'identity magit-buffer-diff-files " ") - (magit-rev-format "%s" magit-buffer-revision)))) - -(cl-defmethod magit-bookmark--get-child-value - (section &context (major-mode magit-stash-mode)) - (string-replace magit-buffer-revision - magit-buffer-revision-hash - (oref section value))) - -;;; Log -;;;; Log - -(put 'magit-log-mode 'magit-bookmark-variables - '(magit-buffer-revisions - magit-buffer-log-args - magit-buffer-log-files)) - -(cl-defmethod magit-bookmark-name (&context (major-mode magit-log-mode)) - (format "magit-log(%s%s)" - (mapconcat #'identity magit-buffer-revisions " ") - (if magit-buffer-log-files - (concat " -- " (mapconcat #'identity magit-buffer-log-files " ")) - ""))) - -;;;; Cherry - -(put 'magit-cherry-mode 'magit-bookmark-variables - '(magit-buffer-refname - magit-buffer-upstream)) - -(cl-defmethod magit-bookmark-name (&context (major-mode magit-cherry-mode)) - (format "magit-cherry(%s > %s)" - magit-buffer-refname - magit-buffer-upstream)) - -;;;; Reflog - -(put 'magit-reflog-mode 'magit-bookmark-variables - '(magit-buffer-refname)) - -(cl-defmethod magit-bookmark-name (&context (major-mode magit-reflog-mode)) - (format "magit-reflog(%s)" magit-buffer-refname)) - -;;; Misc - -(put 'magit-status-mode 'magit-bookmark-variables nil) - -(put 'magit-refs-mode 'magit-bookmark-variables - '(magit-buffer-upstream - magit-buffer-arguments)) - -(put 'magit-stashes-mode 'magit-bookmark-variables nil) - -(cl-defmethod magit-bookmark-name (&context (major-mode magit-stashes-mode)) - (format "magit-states(%s)" magit-buffer-refname)) - -;;; _ -(provide 'magit-bookmark) -;;; magit-bookmark.el ends here diff --git a/emacs/elpa/magit-20240622.1531/magit-bookmark.elc b/emacs/elpa/magit-20240622.1531/magit-bookmark.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/magit-branch.el b/emacs/elpa/magit-20240622.1531/magit-branch.el @@ -1,987 +0,0 @@ -;;; magit-branch.el --- Branch support -*- lexical-binding:t -*- - -;; Copyright (C) 2008-2024 The Magit Project Contributors - -;; Author: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> -;; Maintainer: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> - -;; SPDX-License-Identifier: GPL-3.0-or-later - -;; 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. -;; -;; 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 Magit. If not, see <https://www.gnu.org/licenses/>. - -;;; Commentary: - -;; This library implements support for branches. It defines commands -;; for creating, checking out, manipulating, and configuring branches. -;; Commands defined here are mainly concerned with branches as -;; pointers, commands that deal with what a branch points at, are -;; defined elsewhere. - -;;; Code: - -(require 'magit) -(require 'magit-reset) - -;;; Options - -(defcustom magit-branch-read-upstream-first t - "Whether to read upstream before name of new branch when creating a branch. - -`nil' Read the branch name first. -`t' Read the upstream first. -`fallback' Read the upstream first, but if it turns out that the chosen - value is not a valid upstream (because it cannot be resolved - as an existing revision), then treat it as the name of the - new branch and continue by reading the upstream next." - :package-version '(magit . "2.2.0") - :group 'magit-commands - :type '(choice (const :tag "read branch name first" nil) - (const :tag "read upstream first" t) - (const :tag "read upstream first, with fallback" fallback))) - -(defcustom magit-branch-prefer-remote-upstream nil - "Whether to favor remote upstreams when creating new branches. - -When a new branch is created, then the branch, commit, or stash -at point is suggested as the default starting point of the new -branch, or if there is no such revision at point the current -branch. In either case the user may choose another starting -point. - -If the chosen starting point is a branch, then it may also be set -as the upstream of the new branch, depending on the value of the -Git variable `branch.autoSetupMerge'. By default this is done -for remote branches, but not for local branches. - -You might prefer to always use some remote branch as upstream. -If the chosen starting point is (1) a local branch, (2) whose -name matches a member of the value of this option, (3) the -upstream of that local branch is a remote branch with the same -name, and (4) that remote branch can be fast-forwarded to the -local branch, then the chosen branch is used as starting point, -but its own upstream is used as the upstream of the new branch. - -Members of this option's value are treated as branch names that -have to match exactly unless they contain a character that makes -them invalid as a branch name. Recommended characters to use -to trigger interpretation as a regexp are \"*\" and \"^\". Some -other characters which you might expect to be invalid, actually -are not, e.g., \".+$\" are all perfectly valid. More precisely, -if `git check-ref-format --branch STRING' exits with a non-zero -status, then treat STRING as a regexp. - -Assuming the chosen branch matches these conditions you would end -up with with e.g.: - - feature --upstream--> origin/master - -instead of - - feature --upstream--> master --upstream--> origin/master - -Which you prefer is a matter of personal preference. If you do -prefer the former, then you should add branches such as \"master\", -\"next\", and \"maint\" to the value of this options." - :package-version '(magit . "2.4.0") - :group 'magit-commands - :type '(repeat string)) - -(defcustom magit-branch-adjust-remote-upstream-alist nil - "Alist of upstreams to be used when branching from remote branches. - -When creating a local branch from an ephemeral branch located -on a remote, e.g., a feature or hotfix branch, then that remote -branch should usually not be used as the upstream branch, since -the push-remote already allows accessing it and having both the -upstream and the push-remote reference the same related branch -would be wasteful. Instead a branch like \"maint\" or \"master\" -should be used as the upstream. - -This option allows specifying the branch that should be used as -the upstream when branching certain remote branches. The value -is an alist of the form ((UPSTREAM . RULE)...). The first -element is used whose UPSTREAM exists and whose RULE matches -the name of the new branch. Subsequent elements are ignored. - -UPSTREAM is the branch to be used as the upstream for branches -specified by RULE. It can be a local or a remote branch. - -RULE can either be a regular expression, matching branches whose -upstream should be the one specified by UPSTREAM. Or it can be -a list of the only branches that should *not* use UPSTREAM; all -other branches will. Matching is done after stripping the remote -part of the name of the branch that is being branched from. - -If you use a finite set of non-ephemeral branches across all your -repositories, then you might use something like: - - ((\"origin/master\" . (\"master\" \"next\" \"maint\"))) - -Or if the names of all your ephemeral branches contain a slash, -at least in some repositories, then a good value could be: - - ((\"origin/master\" . \"/\")) - -Of course you can also fine-tune: - - ((\"origin/maint\" . \"\\\\\\=`hotfix/\") - (\"origin/master\" . \"\\\\\\=`feature/\")) - -UPSTREAM can be a local branch: - - ((\"master\" . (\"master\" \"next\" \"maint\"))) - -Because the main branch is no longer almost always named \"master\" -you should also account for other common names: - - ((\"main\" . (\"main\" \"master\" \"next\" \"maint\")) - (\"master\" . (\"main\" \"master\" \"next\" \"maint\"))) - -If you use remote branches as UPSTREAM, then you might also want -to set `magit-branch-prefer-remote-upstream' to a non-nil value. -However, I recommend that you use local branches as UPSTREAM." - :package-version '(magit . "2.9.0") - :group 'magit-commands - :type '(repeat (cons (string :tag "Use upstream") - (choice :tag "for branches" - (regexp :tag "matching") - (repeat :tag "except" - (string :tag "branch")))))) - -(defcustom magit-branch-rename-push-target t - "Whether the push-remote setup is preserved when renaming a branch. - -The command `magit-branch-rename' renames a branch named OLD to -NEW. This option controls how much of the push-remote setup is -preserved when doing so. - -When nil, then preserve nothing and unset `branch.OLD.pushRemote'. - -When `local-only', then first set `branch.NEW.pushRemote' to the - same value as `branch.OLD.pushRemote', provided the latter is - actually set and unless the former already has another value. - -When t, then rename the branch named OLD on the remote specified - by `branch.OLD.pushRemote' to NEW, provided OLD exists on that - remote and unless NEW already exists on the remote. - -When `forge-only' and the `forge' package is available, then - behave like `t' if the remote points to a repository on a forge - (currently Github or Gitlab), otherwise like `local-only'." - :package-version '(magit . "2.90.0") - :group 'magit-commands - :type '(choice - (const :tag "Don't preserve push-remote setup" nil) - (const :tag "Preserve push-remote setup" local-only) - (const :tag "... and rename corresponding branch on remote" t) - (const :tag "... but only if remote is on a forge" forge-only))) - -(defcustom magit-branch-direct-configure t - "Whether the command `magit-branch' shows Git variables. -When set to nil, no variables are displayed by this transient -command, instead the sub-transient `magit-branch-configure' -has to be used to view and change branch related variables." - :package-version '(magit . "2.7.0") - :group 'magit-commands - :type 'boolean) - -(defcustom magit-published-branches '("origin/master") - "List of branches that are considered to be published." - :package-version '(magit . "2.13.0") - :group 'magit-commands - :type '(repeat string)) - -;;; Commands - -;;;###autoload (autoload 'magit-branch "magit" nil t) -(transient-define-prefix magit-branch (branch) - "Add, configure or remove a branch." - :man-page "git-branch" - [:if (lambda () - (and magit-branch-direct-configure - (oref (transient-prefix-object) scope))) - :description - (lambda () - (concat (propertize "Configure " 'face 'transient-heading) - (propertize (oref (transient-prefix-object) scope) - 'face 'magit-branch-local))) - ("d" magit-branch.<branch>.description) - ("u" magit-branch.<branch>.merge/remote) - ("r" magit-branch.<branch>.rebase) - ("p" magit-branch.<branch>.pushRemote)] - [:if-non-nil magit-branch-direct-configure - :description "Configure repository defaults" - ("R" magit-pull.rebase) - ("P" magit-remote.pushDefault) - ("B" "Update default branch" magit-update-default-branch - :inapt-if-not magit-get-some-remote)] - ["Arguments" - (7 "-r" "Recurse submodules when checking out an existing branch" - "--recurse-submodules" - :if (lambda () (magit-git-version>= "2.13")))] - [["Checkout" - ("b" "branch/revision" magit-checkout) - ("l" "local branch" magit-branch-checkout) - (6 "o" "new orphan" magit-branch-orphan)] - ["" - ("c" "new branch" magit-branch-and-checkout) - ("s" "new spin-off" magit-branch-spinoff) - (5 "w" "new worktree" magit-worktree-checkout)] - ["Create" - ("n" "new branch" magit-branch-create) - ("S" "new spin-out" magit-branch-spinout) - (5 "W" "new worktree" magit-worktree-branch)] - ["Do" - ("C" "configure..." magit-branch-configure) - ("m" "rename" magit-branch-rename) - ("x" "reset" magit-branch-reset) - ("k" "delete" magit-branch-delete)] - ["" - (7 "h" "shelve" magit-branch-shelve) - (7 "H" "unshelve" magit-branch-unshelve)]] - (interactive (list (magit-get-current-branch))) - (transient-setup 'magit-branch nil nil :scope branch)) - -(defun magit-branch-arguments () - (transient-args 'magit-branch)) - -;;;###autoload -(defun magit-checkout (revision &optional args) - "Checkout REVISION, updating the index and the working tree. -If REVISION is a local branch, then that becomes the current -branch. If it is something else, then `HEAD' becomes detached. -Checkout fails if the working tree or the staging area contain -changes. -\n(git checkout REVISION)." - (declare (interactive-only magit--checkout)) - (interactive (list (magit-read-other-branch-or-commit "Checkout") - (magit-branch-arguments))) - (when (string-match "\\`heads/\\(.+\\)" revision) - (setq revision (match-string 1 revision))) - (magit-run-git-async "checkout" args revision)) - -(defun magit--checkout (revision &optional args) - (when (string-match "\\`heads/\\(.+\\)" revision) - (setq revision (match-string 1 revision))) - (magit-call-git "checkout" args revision)) - -;;;###autoload -(defun magit-branch-create (branch start-point) - "Create BRANCH at branch or revision START-POINT." - (declare (interactive-only magit-call-git)) - (interactive (magit-branch-read-args "Create branch")) - (magit-run-git-async "branch" branch start-point) - (set-process-sentinel - magit-this-process - (lambda (process event) - (when (memq (process-status process) '(exit signal)) - (magit-branch-maybe-adjust-upstream branch start-point) - (magit-process-sentinel process event))))) - -;;;###autoload -(defun magit-branch-and-checkout (branch start-point &optional args) - "Create and checkout BRANCH at branch or revision START-POINT." - (declare (interactive-only magit-call-git)) - (interactive (append (magit-branch-read-args "Create and checkout branch") - (list (magit-branch-arguments)))) - (if (string-match-p "^stash@{[0-9]+}$" start-point) - (magit-run-git "stash" "branch" branch start-point) - (magit-run-git-async "checkout" args "-b" branch start-point) - (set-process-sentinel - magit-this-process - (lambda (process event) - (when (memq (process-status process) '(exit signal)) - (magit-branch-maybe-adjust-upstream branch start-point) - (magit-process-sentinel process event)))))) - -;;;###autoload -(defun magit-branch-or-checkout (arg &optional start-point) - "Hybrid between `magit-checkout' and `magit-branch-and-checkout'. - -Ask the user for an existing branch or revision. If the user -input actually can be resolved as a branch or revision, then -check that out, just like `magit-checkout' would. - -Otherwise create and checkout a new branch using the input as -its name. Before doing so read the starting-point for the new -branch. This is similar to what `magit-branch-and-checkout' -does." - (declare (interactive-only magit-call-git)) - (interactive - (let ((arg (magit-read-other-branch-or-commit "Checkout"))) - (list arg - (and (not (magit-commit-p arg)) - (magit-read-starting-point "Create and checkout branch" arg))))) - (when (string-match "\\`heads/\\(.+\\)" arg) - (setq arg (match-string 1 arg))) - (if start-point - (with-suppressed-warnings ((interactive-only magit-branch-and-checkout)) - (magit-branch-and-checkout arg start-point)) - (magit--checkout arg) - (magit-refresh))) - -;;;###autoload -(defun magit-branch-checkout (branch &optional start-point) - "Checkout an existing or new local branch. - -Read a branch name from the user offering all local branches and -a subset of remote branches as candidates. Omit remote branches -for which a local branch by the same name exists from the list -of candidates. The user can also enter a completely new branch -name. - -- If the user selects an existing local branch, then check that - out. - -- If the user selects a remote branch, then create and checkout - a new local branch with the same name. Configure the selected - remote branch as push target. - -- If the user enters a new branch name, then create and check - that out, after also reading the starting-point from the user. - -In the latter two cases the upstream is also set. Whether it is -set to the chosen START-POINT or something else depends on the -value of `magit-branch-adjust-remote-upstream-alist', just like -when using `magit-branch-and-checkout'." - (declare (interactive-only magit-call-git)) - (interactive - (let* ((current (magit-get-current-branch)) - (local (magit-list-local-branch-names)) - (remote (--filter (and (string-match "[^/]+/" it) - (not (member (substring it (match-end 0)) - (cons "HEAD" local)))) - (magit-list-remote-branch-names))) - (choices (nconc (delete current local) remote)) - (atpoint (magit-branch-at-point)) - (choice (magit-completing-read - "Checkout branch" choices - nil nil nil 'magit-revision-history - (or (car (member atpoint choices)) - (and atpoint - (car (member (and (string-match "[^/]+/" atpoint) - (substring atpoint (match-end 0))) - choices))))))) - (cond ((member choice remote) - (list (and (string-match "[^/]+/" choice) - (substring choice (match-end 0))) - choice)) - ((member choice local) - (list choice)) - (t - (list choice (magit-read-starting-point "Create" choice)))))) - (cond - ((not start-point) - (magit--checkout branch (magit-branch-arguments)) - (magit-refresh)) - (t - (when (magit-anything-modified-p t) - (user-error "Cannot checkout when there are uncommitted changes")) - (magit-run-git-async "checkout" (magit-branch-arguments) - "-b" branch start-point) - (set-process-sentinel - magit-this-process - (lambda (process event) - (when (memq (process-status process) '(exit signal)) - (magit-branch-maybe-adjust-upstream branch start-point) - (when (magit-remote-branch-p start-point) - (pcase-let ((`(,remote . ,remote-branch) - (magit-split-branch-name start-point))) - (when (and (equal branch remote-branch) - (not (equal remote (magit-get "remote.pushDefault")))) - (magit-set remote "branch" branch "pushRemote")))) - (magit-process-sentinel process event))))))) - -(defun magit-branch-maybe-adjust-upstream (branch start-point) - (when-let ((upstream - (or (and (magit-get-upstream-branch branch) - (magit-get-indirect-upstream-branch start-point)) - (and (magit-remote-branch-p start-point) - (let ((name (cdr (magit-split-branch-name start-point)))) - (seq-some - (pcase-lambda (`(,upstream . ,rule)) - (and (magit-branch-p upstream) - (if (listp rule) - (not (member name rule)) - (string-match-p rule name)) - upstream)) - magit-branch-adjust-remote-upstream-alist)))))) - (magit-call-git "branch" (concat "--set-upstream-to=" upstream) branch))) - -;;;###autoload -(defun magit-branch-orphan (branch start-point) - "Create and checkout an orphan BRANCH with contents from revision START-POINT." - (interactive (magit-branch-read-args "Create and checkout orphan branch")) - (magit-run-git "checkout" "--orphan" branch start-point)) - -(defun magit-branch-read-args (prompt &optional default-start) - (if magit-branch-read-upstream-first - (let ((choice (magit-read-starting-point prompt nil default-start))) - (cond - ((magit-rev-verify choice) - (list (magit-read-string-ns - (if magit-completing-read--silent-default - (format "%s (starting at `%s')" prompt choice) - "Name for new branch") - (let ((def (mapconcat #'identity - (cdr (split-string choice "/")) - "/"))) - (and (member choice (magit-list-remote-branch-names)) - (not (member def (magit-list-local-branch-names))) - def))) - choice)) - ((eq magit-branch-read-upstream-first 'fallback) - (list choice - (magit-read-starting-point prompt choice default-start))) - ((user-error "Not a valid starting-point: %s" choice)))) - (let ((branch (magit-read-string-ns (concat prompt " named")))) - (if (magit-branch-p branch) - (magit-branch-read-args - (format "Branch `%s' already exists; pick another name" branch) - default-start) - (list branch (magit-read-starting-point prompt branch default-start)))))) - -;;;###autoload -(defun magit-branch-spinout (branch &optional from) - "Create new branch from the unpushed commits. -Like `magit-branch-spinoff' but remain on the current branch. -If there are any uncommitted changes, then behave exactly like -`magit-branch-spinoff'." - (interactive (list (magit-read-string-ns "Spin out branch") - (car (last (magit-region-values 'commit))))) - (magit--branch-spinoff branch from nil)) - -;;;###autoload -(defun magit-branch-spinoff (branch &optional from) - "Create new branch from the unpushed commits. - -Create and checkout a new branch starting at and tracking the -current branch. That branch in turn is reset to the last commit -it shares with its upstream. If the current branch has no -upstream or no unpushed commits, then the new branch is created -anyway and the previously current branch is not touched. - -This is useful to create a feature branch after work has already -began on the old branch (likely but not necessarily \"master\"). - -If the current branch is a member of the value of option -`magit-branch-prefer-remote-upstream' (which see), then the -current branch will be used as the starting point as usual, but -the upstream of the starting-point may be used as the upstream -of the new branch, instead of the starting-point itself. - -If optional FROM is non-nil, then the source branch is reset -to `FROM~', instead of to the last commit it shares with its -upstream. Interactively, FROM is only ever non-nil, if the -region selects some commits, and among those commits, FROM is -the commit that is the fewest commits ahead of the source -branch. - -The commit at the other end of the selection actually does not -matter, all commits between FROM and `HEAD' are moved to the new -branch. If FROM is not reachable from `HEAD' or is reachable -from the source branch's upstream, then an error is raised." - (interactive (list (magit-read-string-ns "Spin off branch") - (car (last (magit-region-values 'commit))))) - (magit--branch-spinoff branch from t)) - -(defun magit--branch-spinoff (branch from checkout) - (when (magit-branch-p branch) - (user-error "Cannot spin off %s. It already exists" branch)) - (when (and (not checkout) - (magit-anything-modified-p)) - (message "Staying on HEAD due to uncommitted changes") - (setq checkout t)) - (if-let ((current (magit-get-current-branch))) - (let ((tracked (magit-get-upstream-branch current)) - base) - (when from - (unless (magit-rev-ancestor-p from current) - (user-error "Cannot spin off %s. %s is not reachable from %s" - branch from current)) - (when (and tracked - (magit-rev-ancestor-p from tracked)) - (user-error "Cannot spin off %s. %s is ancestor of upstream %s" - branch from tracked))) - (let ((magit-process-raise-error t)) - (if checkout - (magit-call-git "checkout" "-b" branch current) - (magit-call-git "branch" branch current))) - (when-let ((upstream (magit-get-indirect-upstream-branch current))) - (magit-call-git "branch" "--set-upstream-to" upstream branch)) - (when (and tracked - (setq base - (if from - (concat from "^") - (magit-git-string "merge-base" current tracked))) - (not (magit-rev-eq base current))) - (if checkout - (magit-call-git "update-ref" "-m" - (format "reset: moving to %s" base) - (concat "refs/heads/" current) base) - (magit-call-git "reset" "--hard" base)))) - (if checkout - (magit-call-git "checkout" "-b" branch) - (magit-call-git "branch" branch))) - (magit-refresh)) - -;;;###autoload -(defun magit-branch-reset (branch to &optional set-upstream) - "Reset a branch to the tip of another branch or any other commit. - -When the branch being reset is the current branch, then do a -hard reset. If there are any uncommitted changes, then the user -has to confirm the reset because those changes would be lost. - -This is useful when you have started work on a feature branch but -realize it's all crap and want to start over. - -When resetting to another branch and a prefix argument is used, -then also set the target branch as the upstream of the branch -that is being reset." - (interactive - (let* ((atpoint (magit-local-branch-at-point)) - (branch (magit-read-local-branch "Reset branch" atpoint)) - (minibuffer-default-add-function (magit--minibuf-default-add-commit))) - (list branch - (magit-completing-read (format "Reset %s to" branch) - (delete branch (magit-list-branch-names)) - nil nil nil 'magit-revision-history - (or (and (not (equal branch atpoint)) atpoint) - (magit-get-upstream-branch branch))) - current-prefix-arg))) - (let ((magit-inhibit-refresh t)) - (if (equal branch (magit-get-current-branch)) - (if (and (magit-anything-modified-p) - (not (yes-or-no-p - "Uncommitted changes will be lost. Proceed? "))) - (user-error "Abort") - (magit-reset-hard to)) - (magit-call-git "update-ref" - "-m" (format "reset: moving to %s" to) - (magit-git-string "rev-parse" "--symbolic-full-name" - branch) - to)) - (when (and set-upstream (magit-branch-p to)) - (magit-set-upstream-branch branch to) - (magit-branch-maybe-adjust-upstream branch to))) - (magit-refresh)) - -(defvar magit-branch-delete-never-verify nil - "Whether `magit-branch-delete' always pushes with \"--no-verify\".") - -;;;###autoload -(defun magit-branch-delete (branches &optional force) - "Delete one or multiple branches. - -If the region marks multiple branches, then offer to delete -those, otherwise prompt for a single branch to be deleted, -defaulting to the branch at point. - -Require confirmation when deleting branches is dangerous in some -way. Option `magit-no-confirm' can be customized to not require -confirmation in certain cases. See its docstring to learn why -confirmation is required by default in certain cases or if a -prompt is confusing." - ;; One would expect this to be a command as simple as, for example, - ;; `magit-branch-rename'; but it turns out everyone wants to squeeze - ;; a bit of extra functionality into this one, including myself. - (interactive - (let ((branches (magit-region-values 'branch t)) - (force current-prefix-arg)) - (if (length> branches 1) - (magit-confirm t nil "Delete %d branches" nil branches) - (setq branches - (list (magit-read-branch-prefer-other - (if force "Force delete branch" "Delete branch"))))) - (unless force - (when-let ((unmerged (seq-remove #'magit-branch-merged-p branches))) - (if (magit-confirm 'delete-unmerged-branch - "Delete unmerged branch %s" - "Delete %d unmerged branches" - 'noabort unmerged) - (setq force branches) - (or (setq branches - (cl-set-difference branches unmerged :test #'equal)) - (user-error "Abort"))))) - (list branches force))) - (let* ((refs (mapcar #'magit-ref-fullname branches)) - (ambiguous (--remove it refs))) - (when ambiguous - (user-error - "%s ambiguous. Please cleanup using git directly." - (let ((len (length ambiguous))) - (cond - ((= len 1) - (format "%s is" (seq-find #'magit-ref-ambiguous-p branches))) - ((= len (length refs)) - (format "These %s names are" len)) - (t - (format "%s of these names are" len)))))) - (cond - ((string-match "^refs/remotes/\\([^/]+\\)" (car refs)) - (let* ((remote (match-string 1 (car refs))) - (offset (1+ (length remote)))) - (cond - ((magit-confirm 'delete-branch-on-remote - (format "Deleting local %s. Also delete on %s" - (magit-ref-fullname (car branches)) - remote) - (format "Deleting %d local refs. Also delete on %s" - (length refs) - remote) - 'noabort refs) - ;; The ref may actually point at another rev on the remote, - ;; but this is better than nothing. - (dolist (ref refs) - (message "Delete %s (was %s)" ref - (magit-rev-parse "--short" ref))) - ;; Assume the branches actually still exist on the remote. - (magit-run-git-async - "push" - (and (or force magit-branch-delete-never-verify) "--no-verify") - remote - (--map (concat ":" (substring it offset)) branches)) - ;; If that is not the case, then this deletes the tracking branches. - (set-process-sentinel - magit-this-process - (apply-partially #'magit-delete-remote-branch-sentinel remote refs))) - (t - (dolist (ref refs) - (message "Delete %s (was %s)" ref - (magit-rev-parse "--short" ref)) - (magit-call-git "update-ref" "-d" ref)) - (magit-refresh))))) - ((length> branches 1) - (setq branches (delete (magit-get-current-branch) branches)) - (mapc #'magit-branch-maybe-delete-pr-remote branches) - (mapc #'magit-branch-unset-pushRemote branches) - (magit-run-git "branch" (if force "-D" "-d") branches)) - (t ; And now for something completely different. - (let* ((branch (car branches)) - (prompt (format "Branch %s is checked out. " branch)) - (target (magit-get-indirect-upstream-branch branch t))) - (when (equal branch (magit-get-current-branch)) - (when (or (equal branch target) - (not target)) - (setq target (magit-main-branch))) - (pcase (if (or (equal branch target) - (not target)) - (magit-read-char-case prompt nil - (?d "[d]etach HEAD & delete" 'detach) - (?a "[a]bort" 'abort)) - (magit-read-char-case prompt nil - (?d "[d]etach HEAD & delete" 'detach) - (?c (format "[c]heckout %s & delete" target) 'target) - (?a "[a]bort" 'abort))) - (`detach (unless (or (equal force '(4)) - (member branch force) - (magit-branch-merged-p branch t)) - (magit-confirm 'delete-unmerged-branch - "Delete unmerged branch %s" "" - nil (list branch))) - (magit-call-git "checkout" "--detach")) - (`target (unless (or (equal force '(4)) - (member branch force) - (magit-branch-merged-p branch target)) - (magit-confirm 'delete-unmerged-branch - "Delete unmerged branch %s" "" - nil (list branch))) - (magit-call-git "checkout" target)) - (`abort (user-error "Abort"))) - (setq force t)) - (magit-branch-maybe-delete-pr-remote branch) - (magit-branch-unset-pushRemote branch) - (magit-run-git "branch" (if force "-D" "-d") branch)))))) - -(put 'magit-branch-delete 'interactive-only t) - -(defun magit-branch-maybe-delete-pr-remote (branch) - (when-let ((remote (magit-get "branch" branch "pullRequestRemote"))) - (let* ((variable (format "remote.%s.fetch" remote)) - (refspecs (magit-get-all variable))) - (unless (member (format "+refs/heads/*:refs/remotes/%s/*" remote) - refspecs) - (let ((refspec - (if (equal (magit-get "branch" branch "pushRemote") remote) - (format "+refs/heads/%s:refs/remotes/%s/%s" - branch remote branch) - (let ((merge (magit-get "branch" branch "merge"))) - (and merge - (string-prefix-p "refs/heads/" merge) - (setq merge (substring merge 11)) - (format "+refs/heads/%s:refs/remotes/%s/%s" - merge remote merge)))))) - (when (member refspec refspecs) - (if (and (length= refspecs 1) - (magit-confirm 'delete-pr-remote - (format "Also delete remote %s (%s)" remote - "no pull-request branch remains") - nil t)) - (magit-call-git "remote" "rm" remote) - (magit-call-git "config" "--unset-all" variable - (format "^%s$" (regexp-quote refspec)))))))))) - -(defun magit-branch-unset-pushRemote (branch) - (magit-set nil "branch" branch "pushRemote")) - -(defun magit-delete-remote-branch-sentinel (remote refs process event) - (when (memq (process-status process) '(exit signal)) - (if (= (process-exit-status process) 1) - (if-let ((on-remote (--map (concat "refs/remotes/" remote "/" it) - (magit-remote-list-branches remote))) - (rest (--filter (and (not (member it on-remote)) - (magit-ref-exists-p it)) - refs))) - (progn - (process-put process 'inhibit-refresh t) - (magit-process-sentinel process event) - (setq magit-this-error nil) - (message "Some remote branches no longer exist. %s" - "Deleting just the local tracking refs instead...") - (dolist (ref rest) - (magit-call-git "update-ref" "-d" ref)) - (magit-refresh) - (message "Deleting local remote-tracking refs...done")) - (magit-process-sentinel process event)) - (magit-process-sentinel process event)))) - -;;;###autoload -(defun magit-branch-rename (old new &optional force) - "Rename the branch named OLD to NEW. - -With a prefix argument FORCE, rename even if a branch named NEW -already exists. - -If `branch.OLD.pushRemote' is set, then unset it. Depending on -the value of `magit-branch-rename-push-target' (which see) maybe -set `branch.NEW.pushRemote' and maybe rename the push-target on -the remote." - (interactive - (let ((branch (magit-read-local-branch "Rename branch"))) - (list branch - (magit-read-string-ns (format "Rename branch '%s' to" branch) - nil 'magit-revision-history) - current-prefix-arg))) - (when (string-match "\\`heads/\\(.+\\)" old) - (setq old (match-string 1 old))) - (when (equal old new) - (user-error "Old and new branch names are the same")) - (magit-call-git "branch" (if force "-M" "-m") old new) - (when magit-branch-rename-push-target - (let ((remote (magit-get-push-remote old)) - (old-specified (magit-get "branch" old "pushRemote")) - (new-specified (magit-get "branch" new "pushRemote"))) - (when (and old-specified (or force (not new-specified))) - ;; Keep the target setting branch specified, even if that is - ;; redundant. But if a branch by the same name existed before - ;; and the rename isn't forced, then do not change a leftover - ;; setting. Such a leftover setting may or may not conform to - ;; what we expect here... - (magit-set old-specified "branch" new "pushRemote")) - (when (and (equal (magit-get-push-remote new) remote) - ;; ...and if it does not, then we must abort. - (not (eq magit-branch-rename-push-target 'local-only)) - (or (not (eq magit-branch-rename-push-target 'forge-only)) - (and (require (quote forge) nil t) - (fboundp 'forge--split-forge-url) - (and-let* ((url (magit-git-string - "remote" "get-url" remote))) - (forge--split-forge-url url))))) - (let ((old-target (magit-get-push-branch old t)) - (new-target (magit-get-push-branch new t)) - (remote (magit-get-push-remote new))) - (when (and old-target - (not new-target) - (magit-y-or-n-p (format "Also rename %S to %S on \"%s\"" - old new remote))) - ;; Rename on (i.e., within) the remote, but only if the - ;; destination ref doesn't exist yet. If that ref already - ;; exists, then it probably is of some value and we better - ;; not touch it. Ignore what the local ref points at, - ;; i.e., if the local and the remote ref didn't point at - ;; the same commit before the rename then keep it that way. - (magit-call-git "push" "-v" remote - (format "%s:refs/heads/%s" old-target new) - (format ":refs/heads/%s" old))))))) - (magit-branch-unset-pushRemote old) - (magit-refresh)) - -;;;###autoload -(defun magit-branch-shelve (branch) - "Shelve a BRANCH. -Rename \"refs/heads/BRANCH\" to \"refs/shelved/BRANCH\", -and also rename the respective reflog file." - (interactive (list (magit-read-other-local-branch "Shelve branch"))) - (let ((old (concat "refs/heads/" branch)) - (new (concat "refs/shelved/" branch))) - (magit-git "update-ref" new old "") - (magit--rename-reflog-file old new) - (magit-branch-unset-pushRemote branch) - (magit-run-git "branch" "-D" branch))) - -;;;###autoload -(defun magit-branch-unshelve (branch) - "Unshelve a BRANCH -Rename \"refs/shelved/BRANCH\" to \"refs/heads/BRANCH\", -and also rename the respective reflog file." - (interactive - (list (magit-completing-read - "Unshelve branch" - (--map (substring it 8) - (magit-list-refnames "refs/shelved")) - nil t))) - (let ((old (concat "refs/shelved/" branch)) - (new (concat "refs/heads/" branch))) - (magit-git "update-ref" new old "") - (magit--rename-reflog-file old new) - (magit-run-git "update-ref" "-d" old))) - -(defun magit--rename-reflog-file (old new) - (let* ((dir (magit-gitdir)) - (old (expand-file-name (concat "logs/" old) dir)) - (new (expand-file-name (concat "logs/" new) dir))) - (when (file-exists-p old) - (make-directory (file-name-directory new) t) - (rename-file old new t)))) - -;;; Configure - -;;;###autoload (autoload 'magit-branch-configure "magit-branch" nil t) -(transient-define-prefix magit-branch-configure (branch) - "Configure a branch." - :man-page "git-branch" - [:description - (lambda () - (concat (propertize "Configure " 'face 'transient-heading) - (propertize (oref (transient-prefix-object) scope) - 'face 'magit-branch-local))) - ("d" magit-branch.<branch>.description) - ("u" magit-branch.<branch>.merge/remote) - ("r" magit-branch.<branch>.rebase) - ("p" magit-branch.<branch>.pushRemote)] - ["Configure repository defaults" - ("R" magit-pull.rebase) - ("P" magit-remote.pushDefault) - ("B" "Update default branch" magit-update-default-branch - :inapt-if-not magit-get-some-remote)] - ["Configure branch creation" - ("a m" magit-branch.autoSetupMerge) - ("a r" magit-branch.autoSetupRebase)] - (interactive - (list (or (and (not current-prefix-arg) - (not (and magit-branch-direct-configure - (eq transient-current-command 'magit-branch))) - (magit-get-current-branch)) - (magit--read-branch-scope)))) - (transient-setup 'magit-branch-configure nil nil :scope branch)) - -(defun magit--read-branch-scope (&optional obj) - (magit-read-local-branch - (if obj - (format "Set %s for branch" - (format (oref obj variable) "<name>")) - "Configure branch"))) - -(transient-define-suffix magit-branch.<branch>.description (branch) - "Edit the description of BRANCH." - :class 'magit--git-variable - :transient nil - :variable "branch.%s.description" - (interactive (list (oref transient-current-prefix scope))) - (magit-run-git-with-editor "branch" "--edit-description" branch)) - -(defclass magit--git-branch:upstream (magit--git-variable) - ((format :initform " %k %m %M\n %r %R"))) - -(transient-define-infix magit-branch.<branch>.merge/remote () - :class 'magit--git-branch:upstream) - -(cl-defmethod transient-init-value ((obj magit--git-branch:upstream)) - (when-let* ((branch (oref (transient-prefix-object) scope)) - (remote (magit-get "branch" branch "remote")) - (merge (magit-get "branch" branch "merge"))) - (oset obj value (list remote merge)))) - -(cl-defmethod transient-infix-read ((obj magit--git-branch:upstream)) - (if (oref obj value) - (oset obj value nil) - (magit-read-upstream-branch (oref (transient-prefix-object) scope) - "Upstream"))) - -(cl-defmethod transient-infix-set ((obj magit--git-branch:upstream) refname) - (magit-set-upstream-branch (oref (transient-prefix-object) scope) refname) - (oset obj value - (and-let* ((branch (oref (transient-prefix-object) scope)) - (r (magit-get "branch" branch "remote")) - (m (magit-get "branch" branch "merge"))) - (list r m))) - (magit-refresh)) - -(cl-defmethod transient-format ((obj magit--git-branch:upstream)) - (let ((branch (oref (transient-prefix-object) scope))) - (format-spec - (oref obj format) - `((?k . ,(transient-format-key obj)) - (?r . ,(format "branch.%s.remote" branch)) - (?m . ,(format "branch.%s.merge" branch)) - (?R . ,(transient-format-value obj #'car)) - (?M . ,(transient-format-value obj #'cadr)))))) - -(cl-defmethod transient-format-value ((obj magit--git-branch:upstream) key) - (if-let ((value (funcall key (oref obj value)))) - (propertize value 'face 'transient-argument) - (propertize "unset" 'face 'transient-inactive-argument))) - -(transient-define-infix magit-branch.<branch>.rebase () - :class 'magit--git-variable:choices - :scope #'magit--read-branch-scope - :variable "branch.%s.rebase" - :fallback "pull.rebase" - :choices '("true" "false") - :default "false") - -(transient-define-infix magit-branch.<branch>.pushRemote () - :class 'magit--git-variable:choices - :scope #'magit--read-branch-scope - :variable "branch.%s.pushRemote" - :fallback "remote.pushDefault" - :choices #'magit-list-remotes) - -(transient-define-infix magit-pull.rebase () - :class 'magit--git-variable:choices - :variable "pull.rebase" - :choices '("true" "false") - :default "false") - -(transient-define-infix magit-remote.pushDefault () - :class 'magit--git-variable:choices - :variable "remote.pushDefault" - :choices #'magit-list-remotes) - -(transient-define-infix magit-branch.autoSetupMerge () - :class 'magit--git-variable:choices - :variable "branch.autoSetupMerge" - :choices '("always" "true" "false") - :default "true") - -(transient-define-infix magit-branch.autoSetupRebase () - :class 'magit--git-variable:choices - :variable "branch.autoSetupRebase" - :choices '("always" "local" "remote" "never") - :default "never") - -;;; _ -(provide 'magit-branch) -;;; magit-branch.el ends here diff --git a/emacs/elpa/magit-20240622.1531/magit-branch.elc b/emacs/elpa/magit-20240622.1531/magit-branch.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/magit-clone.elc b/emacs/elpa/magit-20240622.1531/magit-clone.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/magit-commit.elc b/emacs/elpa/magit-20240622.1531/magit-commit.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/magit-core.el b/emacs/elpa/magit-20240622.1531/magit-core.el @@ -1,132 +0,0 @@ -;;; magit-core.el --- Core functionality -*- lexical-binding:t -*- - -;; Copyright (C) 2008-2024 The Magit Project Contributors - -;; Author: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> -;; Maintainer: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> - -;; SPDX-License-Identifier: GPL-3.0-or-later - -;; 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. -;; -;; 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 Magit. If not, see <https://www.gnu.org/licenses/>. - -;;; Commentary: - -;; This library requires several other libraries, so that yet other -;; libraries can just require this one, instead of having to require -;; all the other ones. In other words this separates the low-level -;; stuff from the rest. It also defines some Custom groups. - -;;; Code: - -(require 'magit-base) -(require 'magit-git) -(require 'magit-mode) -(require 'magit-margin) -(require 'magit-process) -(require 'magit-transient) -(require 'magit-autorevert) - -(when (and (not magit-inhibit-libgit) - (magit--libgit-available-p)) - (condition-case err - (require 'magit-libgit) - (error - (setq magit-inhibit-libgit 'error) - (message "Error while loading `magit-libgit': %S" err) - (message "That is not fatal. The `libegit2' module just won't be used.")))) - -;;; Options - -(defgroup magit nil - "Controlling Git from Emacs." - :link '(url-link "https://magit.vc") - :link '(info-link "(magit)FAQ") - :link '(info-link "(magit)") - :group 'tools) - -(defgroup magit-essentials nil - "Options that every Magit user should briefly think about. - -Each of these options falls into one or more of these categories: - -* Options that affect Magit's behavior in fundamental ways. -* Options that affect safety. -* Options that affect performance. -* Options that are of a personal nature." - :link '(info-link "(magit)Essential Settings") - :group 'magit) - -(defgroup magit-miscellaneous nil - "Miscellaneous Magit options." - :group 'magit) - -(defgroup magit-commands nil - "Options controlling behavior of certain commands." - :group 'magit) - -(defgroup magit-modes nil - "Modes used or provided by Magit." - :group 'magit) - -(defgroup magit-buffers nil - "Options concerning Magit buffers." - :link '(info-link "(magit)Modes and Buffers") - :group 'magit) - -(defgroup magit-refresh nil - "Options controlling how Magit buffers are refreshed." - :link '(info-link "(magit)Automatic Refreshing of Magit Buffers") - :group 'magit - :group 'magit-buffers) - -(defgroup magit-faces nil - "Faces used by Magit." - :group 'magit - :group 'faces) - -(custom-add-to-group 'magit-faces 'diff-refine-added 'custom-face) -(custom-add-to-group 'magit-faces 'diff-refine-removed 'custom-face) - -(defgroup magit-extensions nil - "Extensions to Magit." - :group 'magit) - -(custom-add-to-group 'magit-modes 'git-commit 'custom-group) -(custom-add-to-group 'magit-faces 'git-commit-faces 'custom-group) -(custom-add-to-group 'magit-modes 'git-rebase 'custom-group) -(custom-add-to-group 'magit-faces 'git-rebase-faces 'custom-group) -(custom-add-to-group 'magit 'magit-section 'custom-group) -(custom-add-to-group 'magit-faces 'magit-section-faces 'custom-group) -(custom-add-to-group 'magit-process 'with-editor 'custom-group) - -(defgroup magit-related nil - "Options that are relevant to Magit but that are defined elsewhere." - :link '(custom-group-link vc) - :link '(custom-group-link smerge) - :link '(custom-group-link ediff) - :link '(custom-group-link auto-revert) - :group 'magit - :group 'magit-extensions - :group 'magit-essentials) - -(custom-add-to-group 'magit-related 'auto-revert-check-vc-info 'custom-variable) -(custom-add-to-group 'magit-auto-revert 'auto-revert-check-vc-info 'custom-variable) - -(custom-add-to-group 'magit-related 'ediff-window-setup-function 'custom-variable) -(custom-add-to-group 'magit-related 'smerge-refine-ignore-whitespace 'custom-variable) -(custom-add-to-group 'magit-related 'vc-follow-symlinks 'custom-variable) - -;;; _ -(provide 'magit-core) -;;; magit-core.el ends here diff --git a/emacs/elpa/magit-20240622.1531/magit-core.elc b/emacs/elpa/magit-20240622.1531/magit-core.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/magit-diff.el b/emacs/elpa/magit-20240622.1531/magit-diff.el @@ -1,3564 +0,0 @@ -;;; magit-diff.el --- Inspect Git diffs -*- lexical-binding:t -*- - -;; Copyright (C) 2008-2024 The Magit Project Contributors - -;; Author: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> -;; Maintainer: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> - -;; SPDX-License-Identifier: GPL-3.0-or-later - -;; 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. -;; -;; 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 Magit. If not, see <https://www.gnu.org/licenses/>. - -;;; Commentary: - -;; This library implements support for looking at Git diffs and -;; commits. - -;;; Code: - -(require 'magit-core) -(require 'git-commit) - -(eval-when-compile (require 'ansi-color)) -(require 'diff-mode) -(require 'image) -(require 'smerge-mode) - -;; For `magit-diff-popup' -(declare-function magit-stash-show "magit-stash" (stash &optional args files)) -;; For `magit-diff-visit-file' -(declare-function magit-find-file-noselect "magit-files" (rev file)) -(declare-function magit-status-setup-buffer "magit-status" (&optional directory)) -;; For `magit-diff-while-committing' -(declare-function magit-commit-diff-1 "magit-commit" ()) -(declare-function magit-commit-message-buffer "magit-commit" ()) -;; For `magit-insert-revision-gravatar' -(defvar gravatar-size) -;; For `magit-show-commit' and `magit-diff-show-or-scroll' -(declare-function magit-current-blame-chunk "magit-blame" (&optional type noerror)) -(declare-function magit-blame-mode "magit-blame" (&optional arg)) -(defvar magit-blame-mode) -;; For `magit-diff-show-or-scroll' -(declare-function git-rebase-current-line "git-rebase" ()) -;; For `magit-diff-unmerged' -(declare-function magit-merge-in-progress-p "magit-merge" ()) -(declare-function magit--merge-range "magit-merge" (&optional head)) -;; For `magit-diff--dwim' -(declare-function forge--pullreq-range "forge-pullreq" - (pullreq &optional endpoints)) -(declare-function forge--pullreq-ref "forge-pullreq" (pullreq)) -;; For `magit-diff-wash-diff' -(declare-function ansi-color-apply-on-region "ansi-color") -;; For `magit-diff-wash-submodule' -(declare-function magit-log-wash-log "magit-log" (style args)) -;; For keymaps and menus -(declare-function magit-apply "magit-apply" (&rest args)) -(declare-function magit-stage "magit-apply" (&optional indent)) -(declare-function magit-unstage "magit-apply" ()) -(declare-function magit-discard "magit-apply" ()) -(declare-function magit-reverse "magit-apply" (&rest args)) -(declare-function magit-file-rename "magit-files" (file newname)) -(declare-function magit-file-untrack "magit-files" (files &optional force)) -(declare-function magit-commit-add-log "magit-commit" ()) -(declare-function magit-diff-trace-definition "magit-log" ()) -(declare-function magit-patch-save "magit-patch" (files &optional arg)) -(declare-function magit-do-async-shell-command "magit-extras" (file)) -(declare-function magit-add-change-log-entry "magit-extras" - (&optional whoami file-name other-window)) -(declare-function magit-add-change-log-entry-other-window "magit-extras" - (&optional whoami file-name)) -(declare-function magit-diff-edit-hunk-commit "magit-extras" (file)) -(declare-function magit-smerge-keep-current "magit-apply" ()) -(declare-function magit-smerge-keep-upper "magit-apply" ()) -(declare-function magit-smerge-keep-base "magit-apply" ()) -(declare-function magit-smerge-keep-lower "magit-apply" ()) - -(eval-when-compile - (cl-pushnew 'orig-rev eieio--known-slot-names) - (cl-pushnew 'action-type eieio--known-slot-names) - (cl-pushnew 'target eieio--known-slot-names)) - -;;; Options -;;;; Diff Mode - -(defgroup magit-diff nil - "Inspect and manipulate Git diffs." - :link '(info-link "(magit)Diffing") - :group 'magit-commands - :group 'magit-modes) - -(defcustom magit-diff-mode-hook nil - "Hook run after entering Magit-Diff mode." - :group 'magit-diff - :type 'hook) - -(defcustom magit-diff-sections-hook - '(magit-insert-diff - magit-insert-xref-buttons) - "Hook run to insert sections into a `magit-diff-mode' buffer." - :package-version '(magit . "2.3.0") - :group 'magit-diff - :type 'hook) - -(defcustom magit-diff-expansion-threshold 60 - "After how many seconds not to expand anymore diffs. - -Except in status buffers, diffs usually start out fully expanded. -Because that can take a long time, all diffs that haven't been -fontified during a refresh before the threshold defined here are -instead displayed with their bodies collapsed. - -Note that this can cause sections that were previously expanded -to be collapsed. So you should not pick a very low value here. - -The hook function `magit-diff-expansion-threshold' has to be a -member of `magit-section-set-visibility-hook' for this option -to have any effect." - :package-version '(magit . "2.9.0") - :group 'magit-diff - :type 'float) - -(defcustom magit-diff-highlight-hunk-body t - "Whether to highlight bodies of selected hunk sections. -This only has an effect if `magit-diff-highlight' is a -member of `magit-section-highlight-hook', which see." - :package-version '(magit . "2.1.0") - :group 'magit-diff - :type 'boolean) - -(defcustom magit-diff-highlight-hunk-region-functions - '(magit-diff-highlight-hunk-region-dim-outside - magit-diff-highlight-hunk-region-using-overlays) - "The functions used to highlight the hunk-internal region. - -`magit-diff-highlight-hunk-region-dim-outside' overlays the outside -of the hunk internal selection with a face that causes the added and -removed lines to have the same background color as context lines. -This function should not be removed from the value of this option. - -`magit-diff-highlight-hunk-region-using-overlays' and -`magit-diff-highlight-hunk-region-using-underline' emphasize the -region by placing delimiting horizontal lines before and after it. -The underline variant was implemented because Eli said that is -how we should do it. However the overlay variant actually works -better. Also see https://github.com/magit/magit/issues/2758. - -Instead of, or in addition to, using delimiting horizontal lines, -to emphasize the boundaries, you may wish to emphasize the text -itself, using `magit-diff-highlight-hunk-region-using-face'. - -In terminal frames it's not possible to draw lines as the overlay -and underline variants normally do, so there they fall back to -calling the face function instead." - :package-version '(magit . "2.9.0") - :set-after '(magit-diff-show-lines-boundaries) - :group 'magit-diff - :type 'hook - :options '(magit-diff-highlight-hunk-region-dim-outside - magit-diff-highlight-hunk-region-using-underline - magit-diff-highlight-hunk-region-using-overlays - magit-diff-highlight-hunk-region-using-face)) - -(defcustom magit-diff-unmarked-lines-keep-foreground t - "Whether `magit-diff-highlight-hunk-region-dim-outside' preserves foreground. -When this is set to nil, then that function only adjusts the -foreground color but added and removed lines outside the region -keep their distinct foreground colors." - :package-version '(magit . "2.9.0") - :group 'magit-diff - :type 'boolean) - -(defcustom magit-diff-refine-hunk nil - "Whether to show word-granularity differences within diff hunks. - -nil Never show fine differences. -t Show fine differences for the current diff hunk only. -`all' Show fine differences for all displayed diff hunks." - :group 'magit-diff - :safe (lambda (val) (memq val '(nil t all))) - :type '(choice (const :tag "Never" nil) - (const :tag "Current" t) - (const :tag "All" all))) - -(defcustom magit-diff-refine-ignore-whitespace smerge-refine-ignore-whitespace - "Whether to ignore whitespace changes in word-granularity differences." - :package-version '(magit . "3.0.0") - :set-after '(smerge-refine-ignore-whitespace) - :group 'magit-diff - :safe 'booleanp - :type 'boolean) - -(put 'magit-diff-refine-hunk 'permanent-local t) - -(defcustom magit-diff-adjust-tab-width nil - "Whether to adjust the width of tabs in diffs. - -Determining the correct width can be expensive if it requires -opening large and/or many files, so the widths are cached in -the variable `magit-diff--tab-width-cache'. Set that to nil -to invalidate the cache. - -nil Never adjust tab width. Use `tab-width's value from - the Magit buffer itself instead. - -t If the corresponding file-visiting buffer exits, then - use `tab-width's value from that buffer. Doing this is - cheap, so this value is used even if a corresponding - cache entry exists. - -`always' If there is no such buffer, then temporarily visit the - file to determine the value. - -NUMBER Like `always', but don't visit files larger than NUMBER - bytes." - :package-version '(magit . "2.12.0") - :group 'magit-diff - :type '(choice (const :tag "Never" nil) - (const :tag "If file-visiting buffer exists" t) - (integer :tag "If file isn't larger than N bytes") - (const :tag "Always" always))) - -(defcustom magit-diff-paint-whitespace t - "Specify where to highlight whitespace errors. - -nil Never highlight whitespace errors. -t Highlight whitespace errors everywhere. -`uncommitted' Only highlight whitespace errors in diffs - showing uncommitted changes. - -For backward compatibility `status' is treated as a synonym -for `uncommitted'. - -The option `magit-diff-paint-whitespace-lines' controls for -what lines (added/remove/context) errors are highlighted. - -The options `magit-diff-highlight-trailing' and -`magit-diff-highlight-indentation' control what kind of -whitespace errors are highlighted." - :group 'magit-diff - :safe (lambda (val) (memq val '(t nil uncommitted status))) - :type '(choice (const :tag "In all diffs" t) - (const :tag "Only in uncommitted changes" uncommitted) - (const :tag "Never" nil))) - -(defcustom magit-diff-paint-whitespace-lines t - "Specify in what kind of lines to highlight whitespace errors. - -t Highlight only in added lines. -`both' Highlight in added and removed lines. -`all' Highlight in added, removed and context lines." - :package-version '(magit . "3.0.0") - :group 'magit-diff - :safe (lambda (val) (memq val '(t both all))) - :type '(choice (const :tag "in added lines" t) - (const :tag "in added and removed lines" both) - (const :tag "in added, removed and context lines" all))) - -(defcustom magit-diff-highlight-trailing t - "Whether to highlight whitespace at the end of a line in diffs. -Used only when `magit-diff-paint-whitespace' is non-nil." - :group 'magit-diff - :safe 'booleanp - :type 'boolean) - -(defcustom magit-diff-highlight-indentation nil - "Highlight the \"wrong\" indentation style. -Used only when `magit-diff-paint-whitespace' is non-nil. - -The value is an alist of the form ((REGEXP . INDENT)...). The -path to the current repository is matched against each element -in reverse order. Therefore if a REGEXP matches, then earlier -elements are not tried. - -If the used INDENT is `tabs', highlight indentation with tabs. -If INDENT is an integer, highlight indentation with at least -that many spaces. Otherwise, highlight neither." - :group 'magit-diff - :type `(repeat (cons (string :tag "Directory regexp") - (choice (const :tag "Tabs" tabs) - (integer :tag "Spaces" :value ,tab-width) - (const :tag "Neither" nil))))) - -(defcustom magit-diff-hide-trailing-cr-characters - (and (memq system-type '(ms-dos windows-nt)) t) - "Whether to hide ^M characters at the end of a line in diffs." - :package-version '(magit . "2.6.0") - :group 'magit-diff - :type 'boolean) - -(defcustom magit-diff-highlight-keywords t - "Whether to highlight bracketed keywords in commit messages." - :package-version '(magit . "2.12.0") - :group 'magit-diff - :type 'boolean) - -(defcustom magit-diff-extra-stat-arguments nil - "Additional arguments to be used alongside `--stat'. - -A list of zero or more arguments or a function that takes no -argument and returns such a list. These arguments are allowed -here: `--stat-width', `--stat-name-width', `--stat-graph-width' -and `--compact-summary'. See the git-diff(1) manpage." - :package-version '(magit . "3.0.0") - :group 'magit-diff - :type '(radio (function-item magit-diff-use-window-width-as-stat-width) - function - (list string) - (const :tag "None" nil))) - -;;;; File Diff - -(defcustom magit-diff-buffer-file-locked t - "Whether `magit-diff-buffer-file' uses a dedicated buffer." - :package-version '(magit . "2.7.0") - :group 'magit-commands - :group 'magit-diff - :type 'boolean) - -;;;; Revision Mode - -(defgroup magit-revision nil - "Inspect and manipulate Git commits." - :link '(info-link "(magit)Revision Buffer") - :group 'magit-modes) - -(defcustom magit-revision-mode-hook - '(bug-reference-mode - goto-address-mode) - "Hook run after entering Magit-Revision mode." - :group 'magit-revision - :type 'hook - :options '(bug-reference-mode - goto-address-mode)) - -(defcustom magit-revision-sections-hook - '(magit-insert-revision-tag - magit-insert-revision-headers - magit-insert-revision-message - magit-insert-revision-notes - magit-insert-revision-diff - magit-insert-xref-buttons) - "Hook run to insert sections into a `magit-revision-mode' buffer." - :package-version '(magit . "2.3.0") - :group 'magit-revision - :type 'hook) - -(defcustom magit-revision-headers-format "\ -Author: %aN <%aE> -AuthorDate: %ad -Commit: %cN <%cE> -CommitDate: %cd -" - "Format string used to insert headers in revision buffers. - -All headers in revision buffers are inserted by the section -inserter `magit-insert-revision-headers'. Some of the headers -are created by calling `git show --format=FORMAT' where FORMAT -is the format specified here. Other headers are hard coded or -subject to option `magit-revision-insert-related-refs'." - :package-version '(magit . "2.3.0") - :group 'magit-revision - :type 'string) - -(defcustom magit-revision-insert-related-refs t - "Whether to show related branches in revision buffers - -`nil' Don't show any related branches. -`t' Show related local branches. -`all' Show related local and remote branches. -`mixed' Show all containing branches and local merged branches. - -See user option `magit-revision-insert-related-refs-display-alist' -to hide specific sets of related branches." - :package-version '(magit . "2.1.0") - :group 'magit-revision - :type '(choice (const :tag "don't" nil) - (const :tag "local only" t) - (const :tag "all related" all) - (const :tag "all containing, local merged" mixed))) - -(defcustom magit-revision-insert-related-refs-display-alist nil - "How `magit-insert-revision-headers' displays related branch types. - -This is an alist, with recognised keys being the symbols -`parents', `merged', `contained', `follows', and `precedes'; -and the supported values for each key being: - -`nil' Hide these related branches. -`t' Show these related branches. - -Keys which are not present in the alist have an implicit value `t' -\(so the default alist value of nil means all related branch types -will be shown.) - -The types to be shown are additionally subject to user option -`magit-revision-insert-related-refs'." - :package-version '(magit . "3.3.1") - :group 'magit-revision - :type '(alist :key-type (symbol :tag "Type of related branch") - :value-type (boolean :tag "Display")) - :options (mapcar (lambda (sym) - `(,sym (choice (const :tag "Hide" nil) - (const :tag "Show" t)))) - '(parents merged contained follows precedes))) - -(defcustom magit-revision-use-hash-sections 'quicker - "Whether to turn hashes inside the commit message into sections. - -If non-nil, then hashes inside the commit message are turned into -`commit' sections. There is a trade off to be made between -performance and reliability: - -- `slow' calls git for every word to be absolutely sure. -- `quick' skips words less than seven characters long. -- `quicker' additionally skips words that don't contain a number. -- `quickest' uses all words that are at least seven characters - long and which contain at least one number as well as at least - one letter. - -If nil, then no hashes are turned into sections, but you can -still visit the commit at point using \"RET\"." - :package-version '(magit . "2.12.0") - :group 'magit-revision - :type '(choice (const :tag "Use sections, quickest" quickest) - (const :tag "Use sections, quicker" quicker) - (const :tag "Use sections, quick" quick) - (const :tag "Use sections, slow" slow) - (const :tag "Don't use sections" nil))) - -(defcustom magit-revision-show-gravatars nil - "Whether to show gravatar images in revision buffers. - -If nil, then don't insert any gravatar images. If t, then insert -both images. If `author' or `committer', then insert only the -respective image. - -If you have customized the option `magit-revision-header-format' -and want to insert the images then you might also have to specify -where to do so. In that case the value has to be a cons-cell of -two regular expressions. The car specifies where to insert the -author's image. The top half of the image is inserted right -after the matched text, the bottom half on the next line in the -same column. The cdr specifies where to insert the committer's -image, accordingly. Either the car or the cdr may be nil." - :package-version '(magit . "2.3.0") - :group 'magit-revision - :type '(choice - (const :tag "Don't show gravatars" nil) - (const :tag "Show gravatars" t) - (const :tag "Show author gravatar" author) - (const :tag "Show committer gravatar" committer) - (cons :tag "Show gravatars using custom regexps" - (choice (const :tag "No author image" nil) - (regexp :tag "Author regexp" "^Author: ")) - (choice (const :tag "No committer image" nil) - (regexp :tag "Committer regexp" "^Commit: "))))) - -(defcustom magit-revision-fill-summary-line nil - "Whether to fill excessively long summary lines. - -If this is an integer, then the summary line is filled if it is -longer than either the limit specified here or `window-width'. - -You may want to only set this locally in \".dir-locals-2.el\" for -repositories known to contain bad commit messages. - -The body of the message is left alone because (a) most people who -write excessively long summary lines usually don't add a body and -\(b) even people who have the decency to wrap their lines may have -a good reason to include a long line in the body sometimes." - :package-version '(magit . "2.90.0") - :group 'magit-revision - :type '(choice (const :tag "Don't fill" nil) - (integer :tag "Fill if longer than"))) - -(defcustom magit-revision-filter-files-on-follow nil - "Whether to honor file filter if log arguments include --follow. - -When a commit is displayed from a log buffer, the resulting -revision buffer usually shares the log's file arguments, -restricting the diff to those files. However, there's a -complication when the log arguments include --follow: if the log -follows a file across a rename event, keeping the file -restriction would mean showing an empty diff in revision buffers -for commits before the rename event. - -When this option is nil, the revision buffer ignores the log's -filter if the log arguments include --follow. If non-nil, the -log's file filter is always honored." - :package-version '(magit . "3.0.0") - :group 'magit-revision - :type 'boolean) - -;;;; Visit Commands - -(defcustom magit-diff-visit-previous-blob t - "Whether `magit-diff-visit-file' may visit the previous blob. - -When this is t and point is on a removed line in a diff for a -committed change, then `magit-diff-visit-file' visits the blob -from the last revision which still had that line. - -Currently this is only supported for committed changes, for -staged and unstaged changes `magit-diff-visit-file' always -visits the file in the working tree." - :package-version '(magit . "2.9.0") - :group 'magit-diff - :type 'boolean) - -(defcustom magit-diff-visit-avoid-head-blob nil - "Whether `magit-diff-visit-file' avoids visiting a blob from `HEAD'. - -By default `magit-diff-visit-file' always visits the blob that -added the current line, while `magit-diff-visit-worktree-file' -visits the respective file in the working tree. For the `HEAD' -commit, the former command used to visit the worktree file too, -but that made it impossible to visit a blob from `HEAD'. - -When point is on a removed line and that change has not been -committed yet, then `magit-diff-visit-file' now visits the last -blob that still had that line, which is a blob from `HEAD'. -Previously this function used to visit the worktree file not -only for added lines but also for such removed lines. - -If you prefer the old behaviors, then set this to t." - :package-version '(magit . "3.0.0") - :group 'magit-diff - :type 'boolean) - -;;; Faces - -(defface magit-diff-file-heading - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :weight bold)) - "Face for diff file headings." - :group 'magit-faces) - -(defface magit-diff-file-heading-highlight - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :inherit magit-section-highlight)) - "Face for current diff file headings." - :group 'magit-faces) - -(defface magit-diff-file-heading-selection - `((((class color) (background light)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :inherit magit-diff-file-heading-highlight - :foreground "salmon4") - (((class color) (background dark)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :inherit magit-diff-file-heading-highlight - :foreground "LightSalmon3")) - "Face for selected diff file headings." - :group 'magit-faces) - -(defface magit-diff-hunk-heading - `((((class color) (background light)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :background "grey90" - :foreground "grey20") - (((class color) (background dark)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :background "grey25" - :foreground "grey95")) - "Face for diff hunk headings." - :group 'magit-faces) - -(defface magit-diff-hunk-heading-highlight - `((((class color) (background light)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :background "grey80" - :foreground "grey20") - (((class color) (background dark)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :background "grey35" - :foreground "grey95")) - "Face for current diff hunk headings." - :group 'magit-faces) - -(defface magit-diff-hunk-heading-selection - `((((class color) (background light)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :inherit magit-diff-hunk-heading-highlight - :foreground "salmon4") - (((class color) (background dark)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :inherit magit-diff-hunk-heading-highlight - :foreground "LightSalmon3")) - "Face for selected diff hunk headings." - :group 'magit-faces) - -(defface magit-diff-hunk-region - `((t :inherit bold - ,@(and (>= emacs-major-version 27) - (list :extend (ignore-errors (face-attribute 'region :extend)))))) - "Face used by `magit-diff-highlight-hunk-region-using-face'. - -This face is overlaid over text that uses other hunk faces, -and those normally set the foreground and background colors. -The `:foreground' and especially the `:background' properties -should be avoided here. Setting the latter would cause the -loss of information. Good properties to set here are `:weight' -and `:slant'." - :group 'magit-faces) - -(defface magit-diff-revision-summary - '((t :inherit magit-diff-hunk-heading)) - "Face for commit message summaries." - :group 'magit-faces) - -(defface magit-diff-revision-summary-highlight - '((t :inherit magit-diff-hunk-heading-highlight)) - "Face for highlighted commit message summaries." - :group 'magit-faces) - -(defface magit-diff-lines-heading - `((((class color) (background light)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :inherit magit-diff-hunk-heading-highlight - :background "LightSalmon3") - (((class color) (background dark)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :inherit magit-diff-hunk-heading-highlight - :foreground "grey80" - :background "salmon4")) - "Face for diff hunk heading when lines are marked." - :group 'magit-faces) - -(defface magit-diff-lines-boundary - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) ; !important - :inherit magit-diff-lines-heading)) - "Face for boundary of marked lines in diff hunk." - :group 'magit-faces) - -(defface magit-diff-conflict-heading - '((t :inherit magit-diff-hunk-heading)) - "Face for conflict markers." - :group 'magit-faces) - -(defface magit-diff-added - `((((class color) (background light)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :background "#ddffdd" - :foreground "#22aa22") - (((class color) (background dark)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :background "#335533" - :foreground "#ddffdd")) - "Face for lines in a diff that have been added." - :group 'magit-faces) - -(defface magit-diff-removed - `((((class color) (background light)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :background "#ffdddd" - :foreground "#aa2222") - (((class color) (background dark)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :background "#553333" - :foreground "#ffdddd")) - "Face for lines in a diff that have been removed." - :group 'magit-faces) - -(defface magit-diff-our - '((t :inherit magit-diff-removed)) - "Face for lines in a diff for our side in a conflict." - :group 'magit-faces) - -(defface magit-diff-base - `((((class color) (background light)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :background "#ffffcc" - :foreground "#aaaa11") - (((class color) (background dark)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :background "#555522" - :foreground "#ffffcc")) - "Face for lines in a diff for the base side in a conflict." - :group 'magit-faces) - -(defface magit-diff-their - '((t :inherit magit-diff-added)) - "Face for lines in a diff for their side in a conflict." - :group 'magit-faces) - -(defface magit-diff-context - `((((class color) (background light)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "grey50") - (((class color) (background dark)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "grey70")) - "Face for lines in a diff that are unchanged." - :group 'magit-faces) - -(defface magit-diff-added-highlight - `((((class color) (background light)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :background "#cceecc" - :foreground "#22aa22") - (((class color) (background dark)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :background "#336633" - :foreground "#cceecc")) - "Face for lines in a diff that have been added." - :group 'magit-faces) - -(defface magit-diff-removed-highlight - `((((class color) (background light)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :background "#eecccc" - :foreground "#aa2222") - (((class color) (background dark)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :background "#663333" - :foreground "#eecccc")) - "Face for lines in a diff that have been removed." - :group 'magit-faces) - -(defface magit-diff-our-highlight - '((t :inherit magit-diff-removed-highlight)) - "Face for lines in a diff for our side in a conflict." - :group 'magit-faces) - -(defface magit-diff-base-highlight - `((((class color) (background light)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :background "#eeeebb" - :foreground "#aaaa11") - (((class color) (background dark)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :background "#666622" - :foreground "#eeeebb")) - "Face for lines in a diff for the base side in a conflict." - :group 'magit-faces) - -(defface magit-diff-their-highlight - '((t :inherit magit-diff-added-highlight)) - "Face for lines in a diff for their side in a conflict." - :group 'magit-faces) - -(defface magit-diff-context-highlight - `((((class color) (background light)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :background "grey95" - :foreground "grey50") - (((class color) (background dark)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :background "grey20" - :foreground "grey70")) - "Face for lines in the current context in a diff." - :group 'magit-faces) - -(defface magit-diff-whitespace-warning - '((t :inherit trailing-whitespace)) - "Face for highlighting whitespace errors added lines." - :group 'magit-faces) - -(defface magit-diffstat-added - '((((class color) (background light)) :foreground "#22aa22") - (((class color) (background dark)) :foreground "#448844")) - "Face for plus sign in diffstat." - :group 'magit-faces) - -(defface magit-diffstat-removed - '((((class color) (background light)) :foreground "#aa2222") - (((class color) (background dark)) :foreground "#aa4444")) - "Face for minus sign in diffstat." - :group 'magit-faces) - -;;; Arguments -;;;; Prefix Classes - -(defclass magit-diff-prefix (transient-prefix) - ((history-key :initform 'magit-diff) - (major-mode :initform 'magit-diff-mode))) - -(defclass magit-diff-refresh-prefix (magit-diff-prefix) - ((history-key :initform 'magit-diff) - (major-mode :initform nil))) - -;;;; Prefix Methods - -(cl-defmethod transient-init-value ((obj magit-diff-prefix)) - (pcase-let ((`(,args ,files) - (magit-diff--get-value 'magit-diff-mode - magit-prefix-use-buffer-arguments))) - (unless (eq transient-current-command 'magit-dispatch) - (when-let ((file (magit-file-relative-name))) - (setq files (list file)))) - (oset obj value (if files `(("--" ,@files) ,args) args)))) - -(cl-defmethod transient-init-value ((obj magit-diff-refresh-prefix)) - (oset obj value (if magit-buffer-diff-files - `(("--" ,@magit-buffer-diff-files) - ,magit-buffer-diff-args) - magit-buffer-diff-args))) - -(cl-defmethod transient-set-value ((obj magit-diff-prefix)) - (magit-diff--set-value obj)) - -(cl-defmethod transient-save-value ((obj magit-diff-prefix)) - (magit-diff--set-value obj 'save)) - -;;;; Argument Access - -(defun magit-diff-arguments (&optional mode) - "Return the current diff arguments." - (if (memq transient-current-command '(magit-diff magit-diff-refresh)) - (magit--transient-args-and-files) - (magit-diff--get-value (or mode 'magit-diff-mode)))) - -(defun magit-diff--get-value (mode &optional use-buffer-args) - (unless use-buffer-args - (setq use-buffer-args magit-direct-use-buffer-arguments)) - (let (args files) - (cond - ((and (memq use-buffer-args '(always selected current)) - (eq major-mode mode)) - (setq args magit-buffer-diff-args) - (setq files magit-buffer-diff-files)) - ((and (memq use-buffer-args '(always selected)) - (when-let ((buffer (magit-get-mode-buffer - mode nil - (eq use-buffer-args 'selected)))) - (setq args (buffer-local-value 'magit-buffer-diff-args buffer)) - (setq files (buffer-local-value 'magit-buffer-diff-files buffer)) - t))) - ((plist-member (symbol-plist mode) 'magit-diff-current-arguments) - (setq args (get mode 'magit-diff-current-arguments))) - ((when-let ((elt (assq (intern (format "magit-diff:%s" mode)) - transient-values))) - (setq args (cdr elt)) - t)) - (t - (setq args (get mode 'magit-diff-default-arguments)))) - (list args files))) - -(defun magit-diff--set-value (obj &optional save) - (pcase-let* ((obj (oref obj prototype)) - (mode (or (oref obj major-mode) major-mode)) - (key (intern (format "magit-diff:%s" mode))) - (`(,args ,files) (magit--transient-args-and-files))) - (put mode 'magit-diff-current-arguments args) - (when save - (setf (alist-get key transient-values) args) - (transient-save-values)) - (transient--history-push obj) - (setq magit-buffer-diff-args args) - (setq magit-buffer-diff-files files) - (magit-refresh))) - -;;; Commands -;;;; Prefix Commands - -;;;###autoload (autoload 'magit-diff "magit-diff" nil t) -(transient-define-prefix magit-diff () - "Show changes between different versions." - :man-page "git-diff" - :class 'magit-diff-prefix - ["Limit arguments" - (magit:--) - (magit-diff:--ignore-submodules) - ("-b" "Ignore whitespace changes" ("-b" "--ignore-space-change")) - ("-w" "Ignore all whitespace" ("-w" "--ignore-all-space")) - (5 "-D" "Omit preimage for deletes" ("-D" "--irreversible-delete"))] - ["Context arguments" - (magit-diff:-U) - ("-W" "Show surrounding functions" ("-W" "--function-context"))] - ["Tune arguments" - (magit-diff:--diff-algorithm) - (magit-diff:--diff-merges) - (magit-diff:-M) - (magit-diff:-C) - (5 "-R" "Reverse sides" "-R") - (5 magit-diff:--color-moved) - (5 magit-diff:--color-moved-ws) - ("-x" "Disallow external diff drivers" "--no-ext-diff") - ("-s" "Show stats" "--stat") - ("=g" "Show signature" "--show-signature")] - ["Actions" - [("d" "Dwim" magit-diff-dwim) - ("r" "Diff range" magit-diff-range) - ("p" "Diff paths" magit-diff-paths)] - [("u" "Diff unstaged" magit-diff-unstaged) - ("s" "Diff staged" magit-diff-staged) - ("w" "Diff worktree" magit-diff-working-tree)] - [("c" "Show commit" magit-show-commit) - ("t" "Show stash" magit-stash-show)]]) - -;;;###autoload (autoload 'magit-diff-refresh "magit-diff" nil t) -(transient-define-prefix magit-diff-refresh () - "Change the arguments used for the diff(s) in the current buffer." - :man-page "git-diff" - :class 'magit-diff-refresh-prefix - ["Limit arguments" - (magit:--) - (magit-diff:--ignore-submodules) - ("-b" "Ignore whitespace changes" ("-b" "--ignore-space-change")) - ("-w" "Ignore all whitespace" ("-w" "--ignore-all-space")) - (5 "-D" "Omit preimage for deletes" ("-D" "--irreversible-delete"))] - ["Context arguments" - (magit-diff:-U) - ("-W" "Show surrounding functions" ("-W" "--function-context"))] - ["Tune arguments" - (magit-diff:--diff-algorithm) - (magit-diff:--diff-merges) - (magit-diff:-M) - (magit-diff:-C) - (5 "-R" "Reverse sides" "-R" - :if-derived magit-diff-mode) - (5 magit-diff:--color-moved) - (5 magit-diff:--color-moved-ws) - ("-x" "Disallow external diff drivers" "--no-ext-diff") - ("-s" "Show stats" "--stat" - :if-derived magit-diff-mode) - ("=g" "Show signature" "--show-signature" - :if-derived magit-diff-mode)] - [["Refresh" - ("g" "buffer" magit-diff-refresh) - ("s" "buffer and set defaults" transient-set-and-exit) - ("w" "buffer and save defaults" transient-save-and-exit)] - ["Toggle" - ("t" "hunk refinement" magit-diff-toggle-refine-hunk) - ("F" "file filter" magit-diff-toggle-file-filter) - ("b" "buffer lock" magit-toggle-buffer-lock - :if-mode (magit-diff-mode magit-revision-mode magit-stash-mode))] - [:if-mode magit-diff-mode - :description "Do" - ("r" "switch range type" magit-diff-switch-range-type) - ("f" "flip revisions" magit-diff-flip-revs)]] - (interactive) - (when (derived-mode-p 'magit-merge-preview-mode) - (user-error "Cannot use %s in %s" this-command major-mode)) - (if (not (eq transient-current-command 'magit-diff-refresh)) - (transient-setup 'magit-diff-refresh) - (pcase-let ((`(,args ,files) (magit-diff-arguments))) - (setq magit-buffer-diff-args args) - (setq magit-buffer-diff-files files)) - (magit-refresh))) - -;;;; Infix Commands - -(transient-define-argument magit:-- () - :description "Limit to files" - :class 'transient-files - :key "--" - :argument "--" - :prompt "Limit to file,s: " - :reader #'magit-read-files - :multi-value t) - -(defun magit-read-files (prompt initial-input history &optional list-fn) - (magit-with-toplevel - (magit-completing-read-multiple prompt - (funcall (or list-fn #'magit-list-files)) - nil nil - (or initial-input (magit-file-at-point)) - history))) - -(transient-define-argument magit-diff:-U () - :description "Context lines" - :class 'transient-option - :argument "-U" - :reader #'transient-read-number-N0) - -(transient-define-argument magit-diff:-M () - :description "Detect renames" - :class 'transient-option - :argument "-M" - :allow-empty t - :reader #'transient-read-number-N+) - -(transient-define-argument magit-diff:-C () - :description "Detect copies" - :class 'transient-option - :argument "-C" - :allow-empty t - :reader #'transient-read-number-N+) - -(transient-define-argument magit-diff:--diff-algorithm () - :description "Diff algorithm" - :class 'transient-option - :key "-A" - :argument "--diff-algorithm=" - :reader #'magit-diff-select-algorithm - :always-read t) - -(defun magit-diff-select-algorithm (&rest _ignore) - (magit-read-char-case nil t - (?u "[u]nspecified" nil) - (?d "[d]efault" "default") - (?m "[m]inimal" "minimal") - (?p "[p]atience" "patience") - (?h "[h]istogram" "histogram"))) - -(transient-define-argument magit-diff:--diff-merges () - :description "Diff merges" - :class 'transient-option - :key "-X" - :argument "--diff-merges=" - :reader #'magit-diff-select-merges - :always-read t) - -(defun magit-diff-select-merges (&rest _ignore) - (magit-read-char-case nil t - (?u "[u]nspecified" nil) - (?o "[o]ff" "off") - (?f "[f]irst-parent" "first-parent") - (?c "[c]ombined" "combined") - (?d "[d]ense-combined" "dense-combined"))) - -(transient-define-argument magit-diff:--ignore-submodules () - :description "Ignore submodules" - :class 'transient-option - :key "-i" - :argument "--ignore-submodules=" - :reader #'magit-diff-select-ignore-submodules) - -(defun magit-diff-select-ignore-submodules (&rest _ignored) - (magit-read-char-case "Ignore submodules " t - (?u "[u]ntracked" "untracked") - (?d "[d]irty" "dirty") - (?a "[a]ll" "all"))) - -(transient-define-argument magit-diff:--color-moved () - :description "Color moved lines" - :class 'transient-option - :key "-m" - :argument "--color-moved=" - :reader #'magit-diff-select-color-moved-mode) - -(defun magit-diff-select-color-moved-mode (&rest _ignore) - (magit-read-char-case "Color moved " t - (?d "[d]efault" "default") - (?p "[p]lain" "plain") - (?b "[b]locks" "blocks") - (?z "[z]ebra" "zebra") - (?Z "[Z] dimmed-zebra" "dimmed-zebra"))) - -(transient-define-argument magit-diff:--color-moved-ws () - :description "Whitespace treatment for --color-moved" - :class 'transient-option - :key "=w" - :argument "--color-moved-ws=" - :reader #'magit-diff-select-color-moved-ws-mode) - -(defun magit-diff-select-color-moved-ws-mode (&rest _ignore) - (magit-read-char-case "Ignore whitespace " t - (?i "[i]ndentation" "allow-indentation-change") - (?e "[e]nd of line" "ignore-space-at-eol") - (?s "[s]pace change" "ignore-space-change") - (?a "[a]ll space" "ignore-all-space") - (?n "[n]o" "no"))) - -;;;; Setup Commands - -;;;###autoload -(defun magit-diff-dwim (&optional args files) - "Show changes for the thing at point." - (interactive (magit-diff-arguments)) - (let ((default-directory default-directory) - (section (magit-current-section))) - (cond - ((magit-section-match 'module section) - (setq default-directory - (expand-file-name - (file-name-as-directory (oref section value)))) - (magit-diff-range (oref section range))) - (t - (when (magit-section-match 'module-commit section) - (setq args nil) - (setq files nil) - (setq default-directory - (expand-file-name - (file-name-as-directory (magit-section-parent-value section))))) - (pcase (magit-diff--dwim) - ('unmerged (magit-diff-unmerged args files)) - ('unstaged (magit-diff-unstaged args files)) - ('staged - (let ((file (magit-file-at-point))) - (if (and file (equal (cddr (car (magit-file-status file))) '(?D ?U))) - ;; File was deleted by us and modified by them. Show the latter. - (magit-diff-unmerged args (list file)) - (magit-diff-staged nil args files)))) - (`(stash . ,value) (magit-stash-show value args)) - (`(commit . ,value) - (magit-diff-range (format "%s^..%s" value value) args files)) - ((and range (pred stringp)) - (magit-diff-range range args files)) - (_ (call-interactively #'magit-diff-range))))))) - -(defun magit-diff--dwim () - "Return information for performing DWIM diff. - -The information can be in three forms: -1. TYPE - A symbol describing a type of diff where no additional information - is needed to generate the diff. Currently, this includes `staged', - `unstaged' and `unmerged'. -2. (TYPE . VALUE) - Like #1 but the diff requires additional information, which is - given by VALUE. Currently, this includes `commit' and `stash', - where VALUE is the given commit or stash, respectively. -3. RANGE - A string indicating a diff range. - -If no DWIM context is found, nil is returned." - (cond - ((and-let* ((commits (magit-region-values '(commit branch) t))) - (progn - (deactivate-mark) - (concat (car (last commits)) ".." (car commits))))) - (magit-buffer-refname - (cons 'commit magit-buffer-refname)) - ((derived-mode-p 'magit-stash-mode) - (cons 'commit - (magit-section-case - (commit (oref it value)) - (file (thread-first it - (oref parent) - (oref value))) - (hunk (thread-first it - (oref parent) - (oref parent) - (oref value)))))) - ((derived-mode-p 'magit-revision-mode) - (cons 'commit magit-buffer-revision)) - ((derived-mode-p 'magit-diff-mode) - magit-buffer-range) - (t - (magit-section-case - ([* unstaged] 'unstaged) - ([* staged] 'staged) - (unmerged 'unmerged) - (unpushed (magit-diff--range-to-endpoints (oref it value))) - (unpulled (magit-diff--range-to-endpoints (oref it value))) - (branch (let ((current (magit-get-current-branch)) - (atpoint (oref it value))) - (if (equal atpoint current) - (if-let ((upstream (magit-get-upstream-branch))) - (format "%s...%s" upstream current) - (if (magit-anything-modified-p) - current - (cons 'commit current))) - (format "%s...%s" - (or current "HEAD") - atpoint)))) - (commit (cons 'commit (oref it value))) - ([file commit] (cons 'commit (oref (oref it parent) value))) - ([hunk file commit] - (cons 'commit (oref (oref (oref it parent) parent) value))) - (stash (cons 'stash (oref it value))) - (pullreq (forge--pullreq-range (oref it value) t)))))) - -(defun magit-diff--range-to-endpoints (range) - (cond ((string-match "\\.\\.\\." range) (replace-match ".." nil nil range)) - ((string-match "\\.\\." range) (replace-match "..." nil nil range)) - (t range))) - -(defun magit-diff--region-range (&optional interactive mbase) - (and-let* ((commits (magit-region-values '(commit branch) t)) - (revA (car (last commits))) - (revB (car commits))) - (progn - (when interactive - (deactivate-mark)) - (if mbase - (let ((base (magit-git-string "merge-base" revA revB))) - (cond - ((string= (magit-rev-parse revA) base) - (format "%s..%s" revA revB)) - ((string= (magit-rev-parse revB) base) - (format "%s..%s" revB revA)) - (interactive - (let ((main (magit-completing-read "View changes along" - (list revA revB) - nil t nil nil revB))) - (format "%s...%s" - (if (string= main revB) revA revB) main))) - (t "%s...%s" revA revB))) - (format "%s..%s" revA revB))))) - -(defun magit-diff-read-range-or-commit (prompt &optional secondary-default mbase) - "Read range or revision with special diff range treatment. -If MBASE is non-nil, prompt for which rev to place at the end of -a \"revA...revB\" range. Otherwise, always construct -\"revA..revB\" range." - (or (magit-diff--region-range t mbase) - (magit-read-range prompt - (or (pcase (magit-diff--dwim) - (`(commit . ,value) - (format "%s^..%s" value value)) - ((and range (pred stringp)) - range)) - secondary-default - (magit-get-current-branch))))) - -;;;###autoload -(defun magit-diff-range (rev-or-range &optional args files) - "Show differences between two commits. - -REV-OR-RANGE should be a range or a single revision. If it is a -revision, then show changes in the working tree relative to that -revision. If it is a range, but one side is omitted, then show -changes relative to `HEAD'. - -If the region is active, use the revisions on the first and last -line of the region as the two sides of the range. With a prefix -argument, instead of diffing the revisions, choose a revision to -view changes along, starting at the common ancestor of both -revisions (i.e., use a \"...\" range)." - (interactive (cons (magit-diff-read-range-or-commit "Diff for range" - nil current-prefix-arg) - (magit-diff-arguments))) - (magit-diff-setup-buffer rev-or-range nil args files 'committed)) - -;;;###autoload -(defun magit-diff-working-tree (&optional rev args files) - "Show changes between the current working tree and the `HEAD' commit. -With a prefix argument show changes between the working tree and -a commit read from the minibuffer." - (interactive - (cons (and current-prefix-arg - (magit-read-branch-or-commit "Diff working tree and commit")) - (magit-diff-arguments))) - (magit-diff-setup-buffer (or rev "HEAD") nil args files 'unstaged)) - -;;;###autoload -(defun magit-diff-staged (&optional rev args files) - "Show changes between the index and the `HEAD' commit. -With a prefix argument show changes between the index and -a commit read from the minibuffer." - (interactive - (cons (and current-prefix-arg - (magit-read-branch-or-commit "Diff index and commit")) - (magit-diff-arguments))) - (magit-diff-setup-buffer rev "--cached" args files 'staged)) - -;;;###autoload -(defun magit-diff-unstaged (&optional args files) - "Show changes between the working tree and the index." - (interactive (magit-diff-arguments)) - (magit-diff-setup-buffer nil nil args files 'unstaged)) - -;;;###autoload -(defun magit-diff-unmerged (&optional args files) - "Show changes that are being merged." - (interactive (magit-diff-arguments)) - (unless (magit-merge-in-progress-p) - (user-error "No merge is in progress")) - (magit-diff-setup-buffer (magit--merge-range) nil args files 'committed)) - -;;;###autoload -(defun magit-diff-while-committing () - "While committing, show the changes that are about to be committed. -While amending, invoking the command again toggles between -showing just the new changes or all the changes that will -be committed." - (interactive) - (unless (magit-commit-message-buffer) - (user-error "No commit in progress")) - (magit-commit-diff-1)) - -(keymap-set git-commit-mode-map "C-c C-d" #'magit-diff-while-committing) - -;;;###autoload -(defun magit-diff-buffer-file () - "Show diff for the blob or file visited in the current buffer. - -When the buffer visits a blob, then show the respective commit. -When the buffer visits a file, then show the differences between -`HEAD' and the working tree. In both cases limit the diff to -the file or blob." - (interactive) - (require 'magit) - (if-let ((file (magit-file-relative-name))) - (if magit-buffer-refname - (magit-show-commit magit-buffer-refname - (car (magit-show-commit--arguments)) - (list file)) - (save-buffer) - (let ((line (line-number-at-pos)) - (col (current-column))) - (with-current-buffer - (magit-diff-setup-buffer (or (magit-get-current-branch) "HEAD") - nil - (car (magit-diff-arguments)) - (list file) - 'unstaged - magit-diff-buffer-file-locked) - (magit-diff--goto-position file line col)))) - (user-error "Buffer isn't visiting a file"))) - -;;;###autoload -(defun magit-diff-paths (a b) - "Show changes between any two files on disk." - (interactive (list (read-file-name "First file: " nil nil t) - (read-file-name "Second file: " nil nil t))) - (magit-diff-setup-buffer nil "--no-index" nil - (list (magit-convert-filename-for-git - (expand-file-name a)) - (magit-convert-filename-for-git - (expand-file-name b))) - 'undefined)) - -(defun magit-show-commit--arguments () - (pcase-let ((`(,args ,diff-files) - (magit-diff-arguments 'magit-revision-mode))) - (list args (if (derived-mode-p 'magit-log-mode) - (and (or magit-revision-filter-files-on-follow - (not (member "--follow" magit-buffer-log-args))) - magit-buffer-log-files) - diff-files)))) - -;;;###autoload -(defun magit-show-commit (rev &optional args files module) - "Visit the revision at point in another buffer. -If there is no revision at point or with a prefix argument prompt -for a revision." - (interactive - (pcase-let* ((mcommit (magit-section-value-if 'module-commit)) - (atpoint (or mcommit - (magit-thing-at-point 'git-revision t) - (magit-branch-or-commit-at-point))) - (`(,args ,files) (magit-show-commit--arguments))) - (list (or (and (not current-prefix-arg) atpoint) - (magit-read-branch-or-commit "Show commit" atpoint)) - args - files - (and mcommit - (magit-section-parent-value (magit-current-section)))))) - (require 'magit) - (let* ((file (magit-file-relative-name)) - (ln (and file (line-number-at-pos)))) - (magit-with-toplevel - (when module - (setq default-directory - (expand-file-name (file-name-as-directory module)))) - (unless (magit-commit-p rev) - (user-error "%s is not a commit" rev)) - (when file - (save-buffer)) - (let ((buf (magit-revision-setup-buffer rev args files))) - (when file - (let ((line (magit-diff-visit--offset file (list "-R" rev) ln)) - (col (current-column))) - (with-current-buffer buf - (magit-diff--goto-position file line col)))))))) - -(defun magit-diff--locate-hunk (file line &optional parent) - (and-let* ((diff (cl-find-if (lambda (section) - (and (cl-typep section 'magit-file-section) - (equal (oref section value) file))) - (oref (or parent magit-root-section) children)))) - (let ((hunks (oref diff children))) - (cl-block nil - (while-let ((hunk (pop hunks))) - (when-let ((range (oref hunk to-range))) - (pcase-let* ((`(,beg ,len) range) - (end (+ beg len))) - (cond ((> beg line) (cl-return (list diff nil))) - ((<= beg line end) (cl-return (list hunk t))) - ((null hunks) (cl-return (list hunk nil))))))))))) - -(defun magit-diff--goto-position (file line column &optional parent) - (when-let ((pos (magit-diff--locate-hunk file line parent))) - (pcase-let ((`(,section ,exact) pos)) - (cond ((cl-typep section 'magit-file-section) - (goto-char (oref section start))) - (exact - (goto-char (oref section content)) - (let ((pos (car (oref section to-range)))) - (while (or (< pos line) - (= (char-after) ?-)) - (unless (= (char-after) ?-) - (cl-incf pos)) - (forward-line))) - (forward-char (1+ column))) - (t - (goto-char (oref section start)) - (setq section (oref section parent)))) - (while section - (when (oref section hidden) - (magit-section-show section)) - (setq section (oref section parent)))) - (magit-section-update-highlight) - t)) - -;;;; Setting Commands - -(defun magit-diff-switch-range-type () - "Convert diff range type. -Change \"revA..revB\" to \"revA...revB\", or vice versa." - (interactive) - (if (and magit-buffer-range - (derived-mode-p 'magit-diff-mode) - (string-match magit-range-re magit-buffer-range)) - (setq magit-buffer-range - (replace-match (if (string= (match-string 2 magit-buffer-range) "..") - "..." - "..") - t t magit-buffer-range 2)) - (user-error "No range to change")) - (magit-refresh)) - -(defun magit-diff-flip-revs () - "Swap revisions in diff range. -Change \"revA..revB\" to \"revB..revA\"." - (interactive) - (if (and magit-buffer-range - (derived-mode-p 'magit-diff-mode) - (string-match magit-range-re magit-buffer-range)) - (progn - (setq magit-buffer-range - (concat (match-string 3 magit-buffer-range) - (match-string 2 magit-buffer-range) - (match-string 1 magit-buffer-range))) - (magit-refresh)) - (user-error "No range to swap"))) - -(defun magit-diff-toggle-file-filter () - "Toggle the file restriction of the current buffer's diffs. -If the current buffer's mode is derived from `magit-log-mode', -toggle the file restriction in the repository's revision buffer -instead." - (interactive) - (cl-flet ((toggle () - (if (or magit-buffer-diff-files - magit-buffer-diff-files-suspended) - (cl-rotatef magit-buffer-diff-files - magit-buffer-diff-files-suspended) - (setq magit-buffer-diff-files - (transient-infix-read 'magit:--))) - (magit-refresh))) - (cond - ((derived-mode-p 'magit-log-mode - 'magit-cherry-mode - 'magit-reflog-mode) - (if-let ((buffer (magit-get-mode-buffer 'magit-revision-mode))) - (with-current-buffer buffer (toggle)) - (message "No revision buffer"))) - ((local-variable-p 'magit-buffer-diff-files) - (toggle)) - (t - (user-error "Cannot toggle file filter in this buffer"))))) - -(defun magit-diff-less-context (&optional count) - "Decrease the context for diff hunks by COUNT lines." - (interactive "p") - (magit-diff-set-context (lambda (cur) (max 0 (- (or cur 0) count))))) - -(defun magit-diff-more-context (&optional count) - "Increase the context for diff hunks by COUNT lines." - (interactive "p") - (magit-diff-set-context (lambda (cur) (+ (or cur 0) count)))) - -(defun magit-diff-default-context () - "Reset context for diff hunks to the default height." - (interactive) - (magit-diff-set-context #'ignore)) - -(defun magit-diff-set-context (fn) - (when (derived-mode-p 'magit-merge-preview-mode) - (user-error "Cannot use %s in %s" this-command major-mode)) - (let* ((def (if-let ((context (magit-get "diff.context"))) - (string-to-number context) - 3)) - (val magit-buffer-diff-args) - (arg (--first (string-match "^-U\\([0-9]+\\)?$" it) val)) - (num (if-let ((str (and arg (match-string 1 arg)))) - (string-to-number str) - def)) - (val (delete arg val)) - (num (funcall fn num)) - (arg (and num (not (= num def)) (format "-U%d" num))) - (val (if arg (cons arg val) val))) - (setq magit-buffer-diff-args val)) - (magit-refresh)) - -(defun magit-diff-context-p () - (if-let ((arg (--first (string-match "^-U\\([0-9]+\\)$" it) - magit-buffer-diff-args))) - (not (equal arg "-U0")) - t)) - -(defun magit-diff-ignore-any-space-p () - (--any-p (member it magit-buffer-diff-args) - '("--ignore-cr-at-eol" - "--ignore-space-at-eol" - "--ignore-space-change" "-b" - "--ignore-all-space" "-w" - "--ignore-blank-space"))) - -(defun magit-diff-toggle-refine-hunk (&optional style) - "Turn diff-hunk refining on or off. - -If hunk refining is currently on, then hunk refining is turned off. -If hunk refining is off, then hunk refining is turned on, in -`selected' mode (only the currently selected hunk is refined). - -With a prefix argument, the \"third choice\" is used instead: -If hunk refining is currently on, then refining is kept on, but -the refining mode (`selected' or `all') is switched. -If hunk refining is off, then hunk refining is turned on, in -`all' mode (all hunks refined). - -Customize variable `magit-diff-refine-hunk' to change the default mode." - (interactive "P") - (setq-local magit-diff-refine-hunk - (if style - (if (eq magit-diff-refine-hunk 'all) t 'all) - (not magit-diff-refine-hunk))) - (magit-diff-update-hunk-refinement)) - -;;;; Visit Commands -;;;;; Dwim Variants - -(defun magit-diff-visit-file (file &optional other-window) - "From a diff visit the appropriate version of FILE. - -Display the buffer in the selected window. With a prefix -argument OTHER-WINDOW display the buffer in another window -instead. - -Visit the worktree version of the appropriate file. The location -of point inside the diff determines which file is being visited. -The visited version depends on what changes the diff is about. - -1. If the diff shows uncommitted changes (i.e., stage or unstaged - changes), then visit the file in the working tree (i.e., the - same \"real\" file that `find-file' would visit. In all other - cases visit a \"blob\" (i.e., the version of a file as stored - in some commit). - -2. If point is on a removed line, then visit the blob for the - first parent of the commit that removed that line, i.e., the - last commit where that line still exists. - -3. If point is on an added or context line, then visit the blob - that adds that line, or if the diff shows from more than a - single commit, then visit the blob from the last of these - commits. - -In the file-visiting buffer also go to the line that corresponds -to the line that point is on in the diff. - -Note that this command only works if point is inside a diff. -In other cases `magit-find-file' (which see) has to be used." - (interactive (list (magit-diff--file-at-point t t) current-prefix-arg)) - (magit-diff-visit-file--internal file nil - (if other-window - #'switch-to-buffer-other-window - #'pop-to-buffer-same-window))) - -(defun magit-diff-visit-file-other-window (file) - "From a diff visit the appropriate version of FILE in another window. -Like `magit-diff-visit-file' but use -`switch-to-buffer-other-window'." - (interactive (list (magit-diff--file-at-point t t))) - (magit-diff-visit-file--internal file nil #'switch-to-buffer-other-window)) - -(defun magit-diff-visit-file-other-frame (file) - "From a diff visit the appropriate version of FILE in another frame. -Like `magit-diff-visit-file' but use -`switch-to-buffer-other-frame'." - (interactive (list (magit-diff--file-at-point t t))) - (magit-diff-visit-file--internal file nil #'switch-to-buffer-other-frame)) - -;;;;; Worktree Variants - -(defun magit-diff-visit-worktree-file (file &optional other-window) - "From a diff visit the worktree version of FILE. - -Display the buffer in the selected window. With a prefix -argument OTHER-WINDOW display the buffer in another window -instead. - -Visit the worktree version of the appropriate file. The location -of point inside the diff determines which file is being visited. - -Unlike `magit-diff-visit-file' always visits the \"real\" file in -the working tree, i.e the \"current version\" of the file. - -In the file-visiting buffer also go to the line that corresponds -to the line that point is on in the diff. Lines that were added -or removed in the working tree, the index and other commits in -between are automatically accounted for." - (interactive (list (magit-file-at-point t t) current-prefix-arg)) - (magit-diff-visit-file--internal file t - (if other-window - #'switch-to-buffer-other-window - #'pop-to-buffer-same-window))) - -(defun magit-diff-visit-worktree-file-other-window (file) - "From a diff visit the worktree version of FILE in another window. -Like `magit-diff-visit-worktree-file' but use -`switch-to-buffer-other-window'." - (interactive (list (magit-file-at-point t t))) - (magit-diff-visit-file--internal file t #'switch-to-buffer-other-window)) - -(defun magit-diff-visit-worktree-file-other-frame (file) - "From a diff visit the worktree version of FILE in another frame. -Like `magit-diff-visit-worktree-file' but use -`switch-to-buffer-other-frame'." - (interactive (list (magit-file-at-point t t))) - (magit-diff-visit-file--internal file t #'switch-to-buffer-other-frame)) - -;;;;; Internal - -(defun magit-diff-visit-file--internal (file force-worktree fn) - "From a diff visit the appropriate version of FILE. -If FORCE-WORKTREE is non-nil, then visit the worktree version of -the file, even if the diff is about a committed change. Use FN -to display the buffer in some window." - (if (file-accessible-directory-p file) - (magit-diff-visit-directory file force-worktree) - (pcase-let ((`(,buf ,pos) - (magit-diff-visit-file--noselect file force-worktree))) - (funcall fn buf) - (magit-diff-visit-file--setup buf pos) - buf))) - -(defun magit-diff-visit-directory (directory &optional other-window) - "Visit DIRECTORY in some window. -Display the buffer in the selected window unless OTHER-WINDOW is -non-nil. If DIRECTORY is the top-level directory of the current -repository, then visit the containing directory using Dired and -in the Dired buffer put point on DIRECTORY. Otherwise display -the Magit-Status buffer for DIRECTORY." - (if (equal (magit-toplevel directory) - (magit-toplevel)) - (dired-jump other-window (concat directory "/.")) - (let ((display-buffer-overriding-action - (if other-window - '(nil (inhibit-same-window . t)) - '(display-buffer-same-window)))) - (magit-status-setup-buffer directory)))) - -(defun magit-diff-visit-file--setup (buf pos) - (if-let ((win (get-buffer-window buf 'visible))) - (with-selected-window win - (when pos - (unless (<= (point-min) pos (point-max)) - (widen)) - (goto-char pos)) - (when (and buffer-file-name - (magit-anything-unmerged-p buffer-file-name)) - (smerge-start-session)) - (run-hooks 'magit-diff-visit-file-hook)) - (error "File buffer is not visible"))) - -(defun magit-diff-visit-file--noselect (&optional file goto-worktree) - (unless file - (setq file (magit-diff--file-at-point t t))) - (let* ((hunk (magit-diff-visit--hunk)) - (goto-from (and hunk - (magit-diff-visit--goto-from-p hunk goto-worktree))) - (line (and hunk (magit-diff-hunk-line hunk goto-from))) - (col (and hunk (magit-diff-hunk-column hunk goto-from))) - (spec (magit-diff--dwim)) - (rev (if goto-from - (magit-diff-visit--range-from spec) - (magit-diff-visit--range-to spec))) - (buf (if (or goto-worktree - (and (not (stringp rev)) - (or magit-diff-visit-avoid-head-blob - (not goto-from)))) - (or (get-file-buffer file) - (find-file-noselect file)) - (magit-find-file-noselect (if (stringp rev) rev "HEAD") - file)))) - (if line - (with-current-buffer buf - (cond ((eq rev 'staged) - (setq line (magit-diff-visit--offset file nil line))) - ((and goto-worktree - (stringp rev)) - (setq line (magit-diff-visit--offset file rev line)))) - (list buf (save-restriction - (widen) - (goto-char (point-min)) - (forward-line (1- line)) - (move-to-column col) - (point)))) - (list buf nil)))) - -(defun magit-diff--file-at-point (&optional expand assert) - ;; This is a variation of magit-file-at-point. - (if-let* ((file-section (magit-section-case - (file it) - (hunk (oref it parent)))) - (file (or (and (magit-section-match 'hunk) - (magit-diff-visit--goto-from-p - (magit-current-section) nil) - (oref file-section source)) - (oref file-section value)))) - (if expand - (expand-file-name file (magit-toplevel)) - file) - (when assert - (user-error "No file at point")))) - -(defun magit-diff-visit--hunk () - (and-let* ((scope (magit-diff-scope)) - (section (magit-current-section))) - (progn - (cl-case scope - ((file files) - (setq section (car (oref section children)))) - (list - (setq section (car (oref section children))) - (when section - (setq section (car (oref section children)))))) - (and - ;; Unmerged files appear in the list of staged changes - ;; but unlike in the list of unstaged changes no diffs - ;; are shown here. In that case `section' is nil. - section - ;; Currently the `hunk' type is also abused for file - ;; mode changes, which we are not interested in here. - (not (equal (oref section value) '(chmod))) - section)))) - -(defun magit-diff-visit--goto-from-p (section in-worktree) - (and magit-diff-visit-previous-blob - (not in-worktree) - (not (oref section combined)) - (not (< (magit-point) (oref section content))) - (= (char-after (line-beginning-position)) ?-))) - -(defvar magit-diff-visit-jump-to-change t) - -(defun magit-diff-hunk-line (section goto-from) - (save-excursion - (goto-char (line-beginning-position)) - (with-slots (content combined from-ranges from-range to-range) section - (when (or from-range to-range) - (when (and magit-diff-visit-jump-to-change (< (point) content)) - (goto-char content) - (re-search-forward "^[-+]")) - (+ (car (if goto-from from-range to-range)) - (let ((prefix (if combined (length from-ranges) 1)) - (target (point)) - (offset 0)) - (goto-char content) - (while (< (point) target) - (unless (string-search - (if goto-from "+" "-") - (buffer-substring (point) (+ (point) prefix))) - (cl-incf offset)) - (forward-line)) - offset)))))) - -(defun magit-diff-hunk-column (section goto-from) - (if (or (< (magit-point) - (oref section content)) - (and (not goto-from) - (= (char-after (line-beginning-position)) ?-))) - 0 - (max 0 (- (+ (current-column) 2) - (length (oref section value)))))) - -(defun magit-diff-visit--range-from (spec) - (cond ((consp spec) - (concat (cdr spec) "^")) - ((stringp spec) - (car (magit-split-range spec))) - (t - spec))) - -(defun magit-diff-visit--range-to (spec) - (if (symbolp spec) - spec - (let ((rev (if (consp spec) - (cdr spec) - (cdr (magit-split-range spec))))) - (if (and magit-diff-visit-avoid-head-blob - (magit-rev-head-p rev)) - 'unstaged - rev)))) - -(defun magit-diff-visit--offset (file rev line) - (let ((offset 0)) - (with-temp-buffer - (save-excursion - (magit-with-toplevel - (magit-git-insert "diff" rev "--" file))) - (catch 'found - (while (re-search-forward - "^@@ -\\([0-9]+\\),\\([0-9]+\\) \\+\\([0-9]+\\),\\([0-9]+\\) @@.*\n" - nil t) - (let ((from-beg (string-to-number (match-string 1))) - (from-len (string-to-number (match-string 2))) - ( to-len (string-to-number (match-string 4)))) - (if (<= from-beg line) - (if (< (+ from-beg from-len) line) - (cl-incf offset (- to-len from-len)) - (let ((rest (- line from-beg))) - (while (> rest 0) - (pcase (char-after) - (?\s (cl-decf rest)) - (?- (cl-decf offset) (cl-decf rest)) - (?+ (cl-incf offset))) - (forward-line)))) - (throw 'found nil)))))) - (+ line offset))) - -;;;; Scroll Commands - -(defun magit-diff-show-or-scroll-up () - "Update the commit or diff buffer for the thing at point. - -Either show the commit or stash at point in the appropriate -buffer, or if that buffer is already being displayed in the -current frame and contains information about that commit or -stash, then instead scroll the buffer up. If there is no -commit or stash at point, then prompt for a commit." - (interactive) - (magit-diff-show-or-scroll #'scroll-up)) - -(defun magit-diff-show-or-scroll-down () - "Update the commit or diff buffer for the thing at point. - -Either show the commit or stash at point in the appropriate -buffer, or if that buffer is already being displayed in the -current frame and contains information about that commit or -stash, then instead scroll the buffer down. If there is no -commit or stash at point, then prompt for a commit." - (interactive) - (magit-diff-show-or-scroll #'scroll-down)) - -(defun magit-diff-show-or-scroll (fn) - (let (rev cmd buf win) - (cond - ((and (bound-and-true-p magit-blame-mode) - (fboundp 'magit-current-blame-chunk)) - (setq rev (oref (magit-current-blame-chunk) orig-rev)) - (setq cmd #'magit-show-commit) - (setq buf (magit-get-mode-buffer 'magit-revision-mode))) - ((derived-mode-p 'git-rebase-mode) - (with-slots (action-type target) - (git-rebase-current-line) - (if (not (eq action-type 'commit)) - (user-error "No commit on this line") - (setq rev target) - (setq cmd #'magit-show-commit) - (setq buf (magit-get-mode-buffer 'magit-revision-mode))))) - (t - (magit-section-case - (branch - (setq rev (magit-ref-maybe-qualify (oref it value))) - (setq cmd #'magit-show-commit) - (setq buf (magit-get-mode-buffer 'magit-revision-mode))) - (commit - (setq rev (oref it value)) - (setq cmd #'magit-show-commit) - (setq buf (magit-get-mode-buffer 'magit-revision-mode))) - (tag - (setq rev (magit-rev-hash (oref it value))) - (setq cmd #'magit-show-commit) - (setq buf (magit-get-mode-buffer 'magit-revision-mode))) - (stash - (setq rev (oref it value)) - (setq cmd #'magit-stash-show) - (setq buf (magit-get-mode-buffer 'magit-stash-mode)))))) - (if rev - (if (and buf - (setq win (get-buffer-window buf)) - (with-current-buffer buf - (and (equal rev magit-buffer-revision) - (equal (magit-rev-parse rev) - magit-buffer-revision-hash)))) - (with-selected-window win - (condition-case nil - (funcall fn) - (error - (goto-char (pcase fn - ('scroll-up (point-min)) - ('scroll-down (point-max))))))) - (let ((magit-display-buffer-noselect t)) - (if (eq cmd #'magit-show-commit) - (apply #'magit-show-commit rev (magit-show-commit--arguments)) - (funcall cmd rev)))) - (call-interactively #'magit-show-commit)))) - -;;;; Section Commands - -(defun magit-section-cycle-diffs () - "Cycle visibility of diff-related sections in the current buffer." - (interactive) - (when-let ((sections - (cond ((derived-mode-p 'magit-status-mode) - (--mapcat - (when it - (when (oref it hidden) - (magit-section-show it)) - (oref it children)) - (list (magit-get-section '((staged) (status))) - (magit-get-section '((unstaged) (status)))))) - ((derived-mode-p 'magit-diff-mode) - (seq-filter #'magit-file-section-p - (oref magit-root-section children)))))) - (if (--any-p (oref it hidden) sections) - (dolist (s sections) - (magit-section-show s) - (magit-section-hide-children s)) - (let ((children (--mapcat (oref it children) sections))) - (cond ((and (--any-p (oref it hidden) children) - (--any-p (oref it children) children)) - (mapc #'magit-section-show-headings sections)) - ((seq-some #'magit-section-hidden-body children) - (mapc #'magit-section-show-children sections)) - (t - (mapc #'magit-section-hide sections))))))) - -;;; Diff Mode - -(defvar-keymap magit-diff-mode-map - :doc "Keymap for `magit-diff-mode'." - :parent magit-mode-map - "C-c C-d" #'magit-diff-while-committing - "C-c C-b" #'magit-go-backward - "C-c C-f" #'magit-go-forward - "SPC" #'scroll-up - "DEL" #'scroll-down - "j" #'magit-jump-to-diffstat-or-diff - "<remap> <write-file>" #'magit-patch-save) - -(define-derived-mode magit-diff-mode magit-mode "Magit Diff" - "Mode for looking at a Git diff. - -This mode is documented in info node `(magit)Diff Buffer'. - -\\<magit-mode-map>\ -Type \\[magit-refresh] to refresh the current buffer. -Type \\[magit-section-toggle] to expand or hide the section at point. -Type \\[magit-visit-thing] to visit the hunk or file at point. - -Staging and applying changes is documented in info node -`(magit)Staging and Unstaging' and info node `(magit)Applying'. - -\\<magit-hunk-section-map>Type \ -\\[magit-apply] to apply the change at point, \ -\\[magit-stage] to stage, -\\[magit-unstage] to unstage, \ -\\[magit-discard] to discard, or \ -\\[magit-reverse] to reverse it. - -\\{magit-diff-mode-map}" - :group 'magit-diff - (hack-dir-local-variables-non-file-buffer) - (setq magit--imenu-item-types 'file)) - -(put 'magit-diff-mode 'magit-diff-default-arguments - '("--stat" "--no-ext-diff")) - -(defun magit-diff-setup-buffer ( range typearg args files - &optional type locked) - (require 'magit) - (magit-setup-buffer #'magit-diff-mode locked - (magit-buffer-range range) - (magit-buffer-typearg typearg) - (magit-buffer-diff-type type) - (magit-buffer-diff-args args) - (magit-buffer-diff-files files) - (magit-buffer-diff-files-suspended nil))) - -(defun magit-diff-refresh-buffer () - "Refresh the current `magit-diff-mode' buffer." - (magit-set-header-line-format - (if (equal magit-buffer-typearg "--no-index") - (apply #'format "Differences between %s and %s" magit-buffer-diff-files) - (concat (if magit-buffer-range - (if (string-match-p "\\(\\.\\.\\|\\^-\\)" - magit-buffer-range) - (format "Changes in %s" magit-buffer-range) - (let ((msg "Changes from %s to %s") - (end (if (equal magit-buffer-typearg "--cached") - "index" - "working tree"))) - (if (member "-R" magit-buffer-diff-args) - (format msg end magit-buffer-range) - (format msg magit-buffer-range end)))) - (cond ((equal magit-buffer-typearg "--cached") - "Staged changes") - ((and (magit-repository-local-get 'this-commit-command) - (not (magit-anything-staged-p))) - "Uncommitting changes") - (t "Unstaged changes"))) - (pcase (length magit-buffer-diff-files) - (0) - (1 (concat " in file " (car magit-buffer-diff-files))) - (_ (concat " in files " - (mapconcat #'identity magit-buffer-diff-files - ", "))))))) - (setq magit-buffer-range-hashed - (and magit-buffer-range (magit-hash-range magit-buffer-range))) - (magit-insert-section (diffbuf) - (magit-run-section-hook 'magit-diff-sections-hook))) - -(cl-defmethod magit-buffer-value (&context (major-mode magit-diff-mode)) - (nconc (cond (magit-buffer-range - (delq nil (list magit-buffer-range magit-buffer-typearg))) - ((equal magit-buffer-typearg "--cached") - (list 'staged)) - (t - (list 'unstaged magit-buffer-typearg))) - (and magit-buffer-diff-files (cons "--" magit-buffer-diff-files)))) - -(cl-defmethod magit-menu-common-value ((_section magit-diff-section)) - (magit-diff-scope)) - -(define-obsolete-variable-alias 'magit-diff-section-base-map - 'magit-diff-section-map "Magit-Section 4.0.0") - -(defvar-keymap magit-diff-section-map - :doc "Keymap for diff sections. -The classes `magit-file-section' and `magit-hunk-section' derive -from the abstract `magit-diff-section' class. Accordingly this -keymap is the parent of their keymaps." - "C-j" #'magit-diff-visit-worktree-file - "C-<return>" #'magit-diff-visit-worktree-file - "C-x 4 <return>" #'magit-diff-visit-file-other-window - "C-x 5 <return>" #'magit-diff-visit-file-other-frame - "&" #'magit-do-async-shell-command - "C" #'magit-commit-add-log - "C-x a" #'magit-add-change-log-entry - "C-x 4 a" #'magit-add-change-log-entry-other-window - "C-c C-t" #'magit-diff-trace-definition - "C-c C-e" #'magit-diff-edit-hunk-commit - "<remap> <magit-file-rename>" #'magit-file-rename - "<remap> <magit-file-untrack>" #'magit-file-untrack - "<remap> <magit-visit-thing>" #'magit-diff-visit-file - "<remap> <magit-revert-no-commit>" #'magit-reverse - "<remap> <magit-delete-thing>" #'magit-discard - "<remap> <magit-unstage-file>" #'magit-unstage - "<remap> <magit-stage-file>" #'magit-stage - "<remap> <magit-cherry-apply>" #'magit-apply - "<8>" (magit-menu-item "Rename file" #'magit-file-rename - '(:enable (eq (magit-diff-scope) 'file))) - "<7>" (magit-menu-item "Untrack %x" #'magit-file-untrack) - "<6>" (magit-menu-item "Visit file" #'magit-diff-visit-file - '(:enable (memq (magit-diff-scope) '(file files)))) - "<5>" (magit-menu-item "Reverse %x" #'magit-reverse - '(:enable (not (memq (magit-diff-type) - '(untracked unstaged))))) - "<4>" (magit-menu-item "Discard %x" #'magit-discard - '(:enable (not (memq (magit-diff-type) - '(committed undefined))))) - "<3>" (magit-menu-item "Unstage %x" #'magit-unstage - '(:enable (eq (magit-diff-type) 'staged))) - "<2>" (magit-menu-item "Stage %x" #'magit-stage - '(:enable (eq (magit-diff-type) 'unstaged))) - "<1>" (magit-menu-item "Apply %x" #'magit-apply - '(:enable (not (memq (magit-diff-type) - '(unstaged staged)))))) - -(defvar-keymap magit-file-section-map - ;; Even though this derived map doesn't add any bindings by default, - ;; it is quite possible that some users would want to add their own. - :doc "Keymap for `file' sections." - :parent magit-diff-section-base-map) - -(defvar-keymap magit-hunk-section-smerge-map - :doc "Keymap bound to `smerge-command-prefix' in `magit-hunk-section-map'." - "RET" #'magit-smerge-keep-current - "u" #'magit-smerge-keep-upper - "b" #'magit-smerge-keep-base - "l" #'magit-smerge-keep-lower) - -(defvar-keymap magit-hunk-section-map - :doc "Keymap for `hunk' sections." - :parent magit-diff-section-base-map - (key-description smerge-command-prefix) magit-hunk-section-smerge-map) - -(defconst magit-diff-conflict-headline-re - (concat "^" (regexp-opt - ;; Defined in merge-tree.c in this order. - '("merged" - "added in remote" - "added in both" - "added in local" - "removed in both" - "changed in both" - "removed in local" - "removed in remote")))) - -(defconst magit-diff-headline-re - (concat "^\\(@@@?\\|diff\\|Submodule\\|" - "\\* Unmerged path\\|" - (substring magit-diff-conflict-headline-re 1) - "\\)")) - -(defconst magit-diff-statline-re - (concat "^ ?" - "\\(.*\\)" ; file - "\\( +| +\\)" ; separator - "\\([0-9]+\\|Bin\\(?: +[0-9]+ -> [0-9]+ bytes\\)?$\\) ?" - "\\(\\+*\\)" ; add - "\\(-*\\)$")) ; del - -(defvar magit-diff--reset-non-color-moved - (list - "-c" "color.diff.context=normal" - "-c" "color.diff.plain=normal" ; historical synonym for context - "-c" "color.diff.meta=normal" - "-c" "color.diff.frag=normal" - "-c" "color.diff.func=normal" - "-c" "color.diff.old=normal" - "-c" "color.diff.new=normal" - "-c" "color.diff.commit=normal" - "-c" "color.diff.whitespace=normal" - ;; "git-range-diff" does not support "--color-moved", so we don't - ;; need to reset contextDimmed, oldDimmed, newDimmed, contextBold, - ;; oldBold, and newBold. - )) - -(defun magit-insert-diff () - "Insert the diff into this `magit-diff-mode' buffer." - (magit--insert-diff t - "diff" magit-buffer-range "-p" "--no-prefix" - (and (member "--stat" magit-buffer-diff-args) "--numstat") - magit-buffer-typearg - magit-buffer-diff-args "--" - magit-buffer-diff-files)) - -(defun magit--insert-diff (keep-error &rest args) - (declare (indent 1)) - (pcase-let ((`(,cmd . ,args) - (flatten-tree args)) - (magit-git-global-arguments - (remove "--literal-pathspecs" magit-git-global-arguments))) - ;; As of Git 2.19.0, we need to generate diffs with - ;; --ita-visible-in-index so that `magit-stage' can work with - ;; intent-to-add files (see #4026). - (when (and (not (equal cmd "merge-tree")) - (magit-git-version>= "2.19.0")) - (push "--ita-visible-in-index" args)) - (setq args (magit-diff--maybe-add-stat-arguments args)) - (when (cl-member-if (lambda (arg) (string-prefix-p "--color-moved" arg)) args) - (push "--color=always" args) - (setq magit-git-global-arguments - (append magit-diff--reset-non-color-moved - magit-git-global-arguments))) - (magit--git-wash #'magit-diff-wash-diffs - (if (member "--no-index" args) 'wash-anyway keep-error) - cmd args))) - -(defun magit-diff--maybe-add-stat-arguments (args) - (if (member "--stat" args) - (append (if (functionp magit-diff-extra-stat-arguments) - (funcall magit-diff-extra-stat-arguments) - magit-diff-extra-stat-arguments) - args) - args)) - -(defun magit-diff-use-window-width-as-stat-width () - "Use the `window-width' as the value of `--stat-width'." - (and-let* ((window (get-buffer-window (current-buffer) 'visible))) - (list (format "--stat-width=%d" (window-width window))))) - -(defun magit-diff-wash-diffs (args &optional limit) - (run-hooks 'magit-diff-wash-diffs-hook) - (when (member "--show-signature" args) - (magit-diff-wash-signature magit-buffer-revision-hash)) - (when (member "--stat" args) - (magit-diff-wash-diffstat)) - (when (re-search-forward magit-diff-headline-re limit t) - (goto-char (line-beginning-position)) - (magit-wash-sequence (apply-partially #'magit-diff-wash-diff args)) - (insert ?\n))) - -(defun magit-jump-to-diffstat-or-diff () - "Jump to the diffstat or diff. -When point is on a file inside the diffstat section, then jump -to the respective diff section, otherwise jump to the diffstat -section or a child thereof." - (interactive) - (if-let ((section (magit-get-section - (append (magit-section-case - ([file diffstat] `((file . ,(oref it value)))) - (file `((file . ,(oref it value)) (diffstat))) - (t '((diffstat)))) - (magit-section-ident magit-root-section))))) - (magit-section-goto section) - (user-error "No diffstat in this buffer"))) - -(defun magit-diff-wash-signature (object) - (cond - ((looking-at "^No signature") - (delete-line)) - ((looking-at "^gpg: ") - (let (title end) - (save-excursion - (while (looking-at "^gpg: ") - (cond - ((looking-at "^gpg: Good signature from") - (setq title (propertize - (buffer-substring (point) (line-end-position)) - 'face 'magit-signature-good))) - ((looking-at "^gpg: Can't check signature") - (setq title (propertize - (buffer-substring (point) (line-end-position)) - 'face '(italic bold))))) - (forward-line)) - (setq end (point-marker))) - (magit-insert-section (signature object title) - (when title - (magit-insert-heading title)) - (goto-char end) - (set-marker end nil) - (insert "\n")))))) - -(defun magit-diff-wash-diffstat () - (let (heading (beg (point))) - (when (re-search-forward "^ ?\\([0-9]+ +files? change[^\n]*\n\\)" nil t) - (setq heading (match-string 1)) - (magit-delete-match) - (goto-char beg) - (magit-insert-section (diffstat) - (insert (propertize heading 'font-lock-face 'magit-diff-file-heading)) - (magit-insert-heading) - (let (files) - (while (looking-at "^[-0-9]+\t[-0-9]+\t\\(.+\\)$") - (push (magit-decode-git-path - (let ((f (match-string 1))) - (cond - ((string-match "{.* => \\(.*\\)}" f) - (replace-match (match-string 1 f) nil t f)) - ((string-match " => " f) - (substring f (match-end 0))) - (t f)))) - files) - (magit-delete-line)) - (setq files (nreverse files)) - (while (looking-at magit-diff-statline-re) - (magit-bind-match-strings (file sep cnt add del) nil - (magit-delete-line) - (when (string-match " +$" file) - (setq sep (concat (match-string 0 file) sep)) - (setq file (substring file 0 (match-beginning 0)))) - (let ((le (length file)) ld) - (setq file (magit-decode-git-path file)) - (setq ld (length file)) - (when (> le ld) - (setq sep (concat (make-string (- le ld) ?\s) sep)))) - (magit-insert-section (file (pop files)) - (insert (propertize file 'font-lock-face 'magit-filename) - sep cnt " ") - (when add - (insert (propertize add 'font-lock-face - 'magit-diffstat-added))) - (when del - (insert (propertize del 'font-lock-face - 'magit-diffstat-removed))) - (insert "\n"))))) - (if (looking-at "^$") (forward-line) (insert "\n")))))) - -(defun magit-diff-wash-diff (args) - (when (cl-member-if (lambda (arg) (string-prefix-p "--color-moved" arg)) args) - (require 'ansi-color) - (ansi-color-apply-on-region (point-min) (point-max))) - (cond - ((looking-at "^Submodule") - (magit-diff-wash-submodule)) - ((looking-at "^\\* Unmerged path \\(.*\\)") - (let ((file (magit-decode-git-path (match-string 1)))) - (magit-delete-line) - (unless (and (derived-mode-p 'magit-status-mode) - (not (member "--cached" args))) - (magit-insert-section (file file) - (insert (propertize - (format "unmerged %s%s" file - (pcase (cddr (car (magit-file-status file))) - ('(?D ?D) " (both deleted)") - ('(?D ?U) " (deleted by us)") - ('(?U ?D) " (deleted by them)") - ('(?A ?A) " (both added)") - ('(?A ?U) " (added by us)") - ('(?U ?A) " (added by them)") - ('(?U ?U) ""))) - 'font-lock-face 'magit-diff-file-heading)) - (insert ?\n)))) - t) - ((looking-at magit-diff-conflict-headline-re) - (let ((long-status (match-string 0)) - (status "BUG") - file orig base) - (if (equal long-status "merged") - (progn (setq status long-status) - (setq long-status nil)) - (setq status (pcase-exhaustive long-status - ("added in remote" "new file") - ("added in both" "new file") - ("added in local" "new file") - ("removed in both" "removed") - ("changed in both" "changed") - ("removed in local" "removed") - ("removed in remote" "removed")))) - (magit-delete-line) - (while (looking-at - "^ \\([^ ]+\\) +[0-9]\\{6\\} \\([a-z0-9]\\{40,\\}\\) \\(.+\\)$") - (magit-bind-match-strings (side _blob name) nil - (pcase side - ("result" (setq file name)) - ("our" (setq orig name)) - ("their" (setq file name)) - ("base" (setq base name)))) - (magit-delete-line)) - (when orig (setq orig (magit-decode-git-path orig))) - (when file (setq file (magit-decode-git-path file))) - (magit-diff-insert-file-section - (or file base) orig status nil nil nil nil long-status))) - ;; The files on this line may be ambiguous due to whitespace. - ;; That's okay. We can get their names from subsequent headers. - ((looking-at "^diff --\ -\\(?:\\(?1:git\\) \\(?:\\(?2:.+?\\) \\2\\)?\ -\\|\\(?:cc\\|combined\\) \\(?3:.+\\)\\)") - (let ((status (cond ((equal (match-string 1) "git") "modified") - ((derived-mode-p 'magit-revision-mode) "resolved") - (t "unmerged"))) - (orig nil) - (file (or (match-string 2) (match-string 3))) - (header (list (buffer-substring-no-properties - (line-beginning-position) (1+ (line-end-position))))) - (modes nil) - (rename nil) - (binary nil)) - (magit-delete-line) - (while (not (or (eobp) (looking-at magit-diff-headline-re))) - (cond - ((looking-at "old mode \\(?:[^\n]+\\)\nnew mode \\(?:[^\n]+\\)\n") - (setq modes (match-string 0))) - ((looking-at "deleted file .+\n") - (setq status "deleted")) - ((looking-at "new file .+\n") - (setq status "new file")) - ((looking-at "rename from \\(.+\\)\nrename to \\(.+\\)\n") - (setq rename (match-string 0)) - (setq orig (match-string 1)) - (setq file (match-string 2)) - (setq status "renamed")) - ((looking-at "copy from \\(.+\\)\ncopy to \\(.+\\)\n") - (setq orig (match-string 1)) - (setq file (match-string 2)) - (setq status "new file")) - ((looking-at "similarity index .+\n")) - ((looking-at "dissimilarity index .+\n")) - ((looking-at "index .+\n")) - ((looking-at "--- \\(.+?\\)\t?\n") - (unless (equal (match-string 1) "/dev/null") - (setq orig (match-string 1)))) - ((looking-at "\\+\\+\\+ \\(.+?\\)\t?\n") - (unless (equal (match-string 1) "/dev/null") - (setq file (match-string 1)))) - ((looking-at "Binary files .+ and .+ differ\n") - (setq binary t)) - ((looking-at "Binary files differ\n") - (setq binary t)) - ;; TODO Use all combined diff extended headers. - ((looking-at "mode .+\n")) - ((error "BUG: Unknown extended header: %S" - (buffer-substring (point) (line-end-position))))) - ;; These headers are treated as some sort of special hunk. - (unless (or (string-prefix-p "old mode" (match-string 0)) - (string-prefix-p "rename" (match-string 0))) - (push (match-string 0) header)) - (magit-delete-match)) - (when orig - (setq orig (magit-decode-git-path orig))) - (setq file (magit-decode-git-path file)) - (setq header (nreverse header)) - ;; KLUDGE `git-log' ignores `--no-prefix' when `-L' is used. - (when (and (derived-mode-p 'magit-log-mode) - (seq-some (lambda (arg) (string-prefix-p "-L" arg)) - magit-buffer-log-args)) - (when orig - (setq orig (substring orig 2))) - (setq file (substring file 2)) - (setq header (list (save-excursion - (string-match "diff [^ ]+" (car header)) - (format "%s %s %s\n" - (match-string 0 (car header)) - (or orig file) - (or file orig))) - (format "--- %s\n" (or orig "/dev/null")) - (format "+++ %s\n" (or file "/dev/null"))))) - (setq header (mapconcat #'identity header "")) - (magit-diff-insert-file-section - file orig status modes rename header binary nil))))) - -(defun magit-diff-insert-file-section - (file orig status modes rename header binary long-status) - (magit-insert-section - ( file file - (or (equal status "deleted") (derived-mode-p 'magit-status-mode)) - :source (and (not (equal orig file)) orig) - :header header - :binary binary) - (insert (propertize (format "%-10s %s" status - (if (or (not orig) (equal orig file)) - file - (format "%s -> %s" orig file))) - 'font-lock-face 'magit-diff-file-heading)) - (cond ((and binary long-status) - (insert (format " (%s, binary)" long-status))) - ((or binary long-status) - (insert (format " (%s)" (if binary "binary" long-status))))) - (magit-insert-heading) - (when modes - (magit-insert-section (hunk '(chmod)) - (insert modes) - (magit-insert-heading))) - (when rename - (magit-insert-section (hunk '(rename)) - (insert rename) - (magit-insert-heading))) - (magit-wash-sequence #'magit-diff-wash-hunk))) - -(defun magit-diff-wash-submodule () - ;; See `show_submodule_summary' in submodule.c and "this" commit. - (when (looking-at "^Submodule \\([^ ]+\\)") - (let ((module (match-string 1)) - untracked modified) - (when (looking-at "^Submodule [^ ]+ contains untracked content$") - (magit-delete-line) - (setq untracked t)) - (when (looking-at "^Submodule [^ ]+ contains modified content$") - (magit-delete-line) - (setq modified t)) - (cond - ((and (looking-at "^Submodule \\([^ ]+\\) \\([^ :]+\\)\\( (rewind)\\)?:$") - (equal (match-string 1) module)) - (magit-bind-match-strings (_module range rewind) nil - (magit-delete-line) - (while (looking-at "^ \\([<>]\\) \\(.*\\)$") - (magit-delete-line)) - (when rewind - (setq range (replace-regexp-in-string "[^.]\\(\\.\\.\\)[^.]" - "..." range t t 1))) - (magit-insert-section (module module t) - (magit-insert-heading - (propertize (concat "modified " module) - 'font-lock-face 'magit-diff-file-heading) - " (" - (cond (rewind "rewind") - ((string-search "..." range) "non-ff") - (t "new commits")) - (and (or modified untracked) - (concat ", " - (and modified "modified") - (and modified untracked " and ") - (and untracked "untracked") - " content")) - ")") - (magit-insert-section-body - (let ((default-directory - (file-name-as-directory - (expand-file-name module (magit-toplevel))))) - (magit-git-wash (apply-partially #'magit-log-wash-log 'module) - "log" "--oneline" "--left-right" range) - (delete-char -1)))))) - ((and (looking-at "^Submodule \\([^ ]+\\) \\([^ ]+\\) (\\([^)]+\\))$") - (equal (match-string 1) module)) - (magit-bind-match-strings (_module _range msg) nil - (magit-delete-line) - (magit-insert-section (module module) - (magit-insert-heading - (propertize (concat "submodule " module) - 'font-lock-face 'magit-diff-file-heading) - " (" msg ")")))) - (t - (magit-insert-section (module module) - (magit-insert-heading - (propertize (concat "modified " module) - 'font-lock-face 'magit-diff-file-heading) - " (" - (and modified "modified") - (and modified untracked " and ") - (and untracked "untracked") - " content)"))))))) - -(defun magit-diff-wash-hunk () - (when (looking-at "^@\\{2,\\} \\(.+?\\) @\\{2,\\}\\(?: \\(.*\\)\\)?") - (let* ((heading (match-string 0)) - (ranges (mapcar - (lambda (str) - (let ((range - (mapcar #'string-to-number - (split-string (substring str 1) ",")))) - ;; A single line is +1 rather than +1,1. - (if (length= range 1) - (nconc range (list 1)) - range))) - (split-string (match-string 1)))) - (about (match-string 2)) - (combined (length= ranges 3)) - (value (cons about ranges))) - (magit-delete-line) - (magit-insert-section - ( hunk value nil - :washer #'magit-diff-paint-hunk - :combined combined - :from-range (if combined (butlast ranges) (car ranges)) - :to-range (car (last ranges)) - :about about) - (insert (propertize (concat heading "\n") - 'font-lock-face 'magit-diff-hunk-heading)) - (magit-insert-heading) - (while (not (or (eobp) (looking-at "^[^-+\s\\]"))) - (forward-line)))) - t)) - -(defun magit-diff-expansion-threshold (section) - "Keep new diff sections collapsed if washing takes too long." - (and (magit-file-section-p section) - (> (float-time (time-since magit-refresh-start-time)) - magit-diff-expansion-threshold) - 'hide)) - -(add-hook 'magit-section-set-visibility-hook #'magit-diff-expansion-threshold) - -;;; Revision Mode - -(define-derived-mode magit-revision-mode magit-diff-mode "Magit Rev" - "Mode for looking at a Git commit. - -This mode is documented in info node `(magit)Revision Buffer'. - -\\<magit-mode-map>\ -Type \\[magit-refresh] to refresh the current buffer. -Type \\[magit-section-toggle] to expand or hide the section at point. -Type \\[magit-visit-thing] to visit the hunk or file at point. - -Staging and applying changes is documented in info node -`(magit)Staging and Unstaging' and info node `(magit)Applying'. - -\\<magit-hunk-section-map>Type \ -\\[magit-apply] to apply the change at point, \ -\\[magit-stage] to stage, -\\[magit-unstage] to unstage, \ -\\[magit-discard] to discard, or \ -\\[magit-reverse] to reverse it. - -\\{magit-revision-mode-map}" - :group 'magit-revision - (hack-dir-local-variables-non-file-buffer)) - -(put 'magit-revision-mode 'magit-diff-default-arguments - '("--stat" "--no-ext-diff")) - -(defun magit-revision-setup-buffer (rev args files) - (magit-setup-buffer #'magit-revision-mode nil - (magit-buffer-revision rev) - (magit-buffer-range (format "%s^..%s" rev rev)) - (magit-buffer-diff-type 'committed) - (magit-buffer-diff-args args) - (magit-buffer-diff-files files) - (magit-buffer-diff-files-suspended nil))) - -(defun magit-revision-refresh-buffer () - (setq magit-buffer-revision-hash (magit-rev-hash magit-buffer-revision)) - (magit-set-header-line-format - (concat (magit-object-type magit-buffer-revision-hash) - " " magit-buffer-revision - (pcase (length magit-buffer-diff-files) - (0) - (1 (concat " limited to file " (car magit-buffer-diff-files))) - (_ (concat " limited to files " - (mapconcat #'identity magit-buffer-diff-files ", ")))))) - (magit-insert-section (commitbuf) - (magit-run-section-hook 'magit-revision-sections-hook))) - -(cl-defmethod magit-buffer-value (&context (major-mode magit-revision-mode)) - (cons magit-buffer-revision magit-buffer-diff-files)) - -(defun magit-insert-revision-diff () - "Insert the diff into this `magit-revision-mode' buffer." - (magit--insert-diff t - "show" "-p" "--format=" "--no-prefix" - (and (member "--stat" magit-buffer-diff-args) "--numstat") - magit-buffer-diff-args - (magit--rev-dereference magit-buffer-revision) - "--" magit-buffer-diff-files)) - -(defun magit-insert-revision-tag () - "Insert tag message and headers into a revision buffer. -This function only inserts anything when `magit-show-commit' is -called with a tag as argument, when that is called with a commit -or a ref which is not a branch, then it inserts nothing." - (when (equal (magit-object-type magit-buffer-revision) "tag") - (magit-insert-section (taginfo) - (let ((beg (point))) - ;; "git verify-tag -v" would output what we need, but the gpg - ;; output is send to stderr and we have no control over the - ;; order in which stdout and stderr are inserted, which would - ;; make parsing hard. We are forced to use "git cat-file tag" - ;; instead, which inserts the signature instead of verifying - ;; it. We remove that later and then insert the verification - ;; output using "git verify-tag" (without the "-v"). - (magit-git-insert "cat-file" "tag" magit-buffer-revision) - (goto-char beg) - (forward-line 3) - (delete-region beg (point))) - (looking-at "^tagger \\([^<]+\\) <\\([^>]+\\)") - (let ((heading (format "Tagger: %s <%s>" - (match-string 1) - (match-string 2)))) - (magit-delete-line) - (insert (propertize heading 'font-lock-face - 'magit-section-secondary-heading))) - (magit-insert-heading) - (forward-line) - (magit-insert-section - ( message nil nil - :heading-highlight-face 'magit-diff-revision-summary-highlight) - (let ((beg (point))) - (forward-line) - (magit--add-face-text-property - beg (point) 'magit-diff-revision-summary)) - (magit-insert-heading) - (if (re-search-forward "-----BEGIN PGP SIGNATURE-----" nil t) - (goto-char (match-beginning 0)) - (goto-char (point-max))) - (insert ?\n)) - (if (re-search-forward "-----BEGIN PGP SIGNATURE-----" nil t) - (progn - (let ((beg (match-beginning 0))) - (re-search-forward "-----END PGP SIGNATURE-----\n") - (delete-region beg (point))) - (save-excursion - (magit-process-git t "verify-tag" magit-buffer-revision)) - (magit-diff-wash-signature magit-buffer-revision)) - (goto-char (point-max))) - (insert ?\n)))) - -(defvar-keymap magit-commit-message-section-map - :doc "Keymap for `commit-message' sections." - "<remap> <magit-visit-thing>" #'magit-show-commit - "<1>" (magit-menu-item "Visit %t" #'magit-show-commit - '(:enable (magit-thing-at-point 'git-revision t)))) - -(defun magit-insert-revision-message () - "Insert the commit message into a revision buffer." - (magit-insert-section - ( commit-message nil nil - :heading-highlight-face 'magit-diff-revision-summary-highlight) - (let ((beg (point)) - (rev magit-buffer-revision)) - (insert (with-temp-buffer - (magit-rev-insert-format "%B" rev) - (magit-revision--wash-message))) - (if (= (point) (+ beg 2)) - (progn (delete-char -2) - (insert "(no message)\n")) - (goto-char beg) - (save-excursion - (while (search-forward "\r\n" nil t) ; Remove trailing CRs. - (delete-region (match-beginning 0) (1+ (match-beginning 0))))) - (when magit-revision-fill-summary-line - (let ((fill-column (min magit-revision-fill-summary-line - (window-width (get-buffer-window nil t))))) - (fill-region (point) (line-end-position)))) - (when magit-revision-use-hash-sections - (save-excursion - ;; Start after beg to prevent a (commit text) section from - ;; starting at the same point as the (commit-message) - ;; section. - (goto-char (1+ beg)) - (while (not (eobp)) - (re-search-forward "\\_<" nil 'move) - (let ((beg (point))) - (re-search-forward "\\_>" nil t) - (when (> (point) beg) - (let ((text (buffer-substring-no-properties beg (point)))) - (when (pcase magit-revision-use-hash-sections - ('quickest ; false negatives and positives - (and (>= (length text) 7) - (string-match-p "[0-9]" text) - (string-match-p "[a-z]" text))) - ('quicker ; false negatives (number-less hashes) - (and (>= (length text) 7) - (string-match-p "[0-9]" text) - (magit-commit-p text))) - ('quick ; false negatives (short hashes) - (and (>= (length text) 7) - (magit-commit-p text))) - ('slow - (magit-commit-p text))) - (put-text-property beg (point) - 'font-lock-face 'magit-hash) - (let ((end (point))) - (goto-char beg) - (magit-insert-section (commit text) - (goto-char end)))))))))) - (save-excursion - (forward-line) - (magit--add-face-text-property - beg (point) 'magit-diff-revision-summary) - (magit-insert-heading)) - (when magit-diff-highlight-keywords - (save-excursion - (while (re-search-forward "\\[[^[]*\\]" nil t) - (let ((beg (match-beginning 0)) - (end (match-end 0))) - (put-text-property - beg end 'font-lock-face - (if-let ((face (get-text-property beg 'font-lock-face))) - (list face 'magit-keyword) - 'magit-keyword)))))) - (goto-char (point-max)))))) - -(defun magit-insert-revision-notes () - "Insert commit notes into a revision buffer." - (let ((default (or (magit-get "core.notesRef") "refs/notes/commits"))) - (dolist (ref (magit-list-active-notes-refs)) - (when-let ((note (with-temp-buffer - (magit-git-insert "-c" (concat "core.notesRef=" ref) - "notes" "show" magit-buffer-revision) - (magit-revision--wash-message)))) - (magit-insert-section - ( notes ref (not (equal ref default)) - :heading-highlight-face 'magit-diff-hunk-heading-highlight) - (let ((beg (point))) - (insert note) - (goto-char beg) - (end-of-line) - (insert (format " (%s)" - (propertize (if (string-prefix-p "refs/notes/" ref) - (substring ref 11) - ref) - 'font-lock-face 'magit-refname))) - (forward-char) - (magit--add-face-text-property beg (point) 'magit-diff-hunk-heading) - (magit-insert-heading) - (goto-char (point-max)) - (insert ?\n))))))) - -(defun magit-revision--wash-message () - (let ((major-mode 'git-commit-mode)) - (hack-dir-local-variables) - (hack-local-variables-apply)) - (unless (memq git-commit-major-mode '(nil text-mode)) - (funcall git-commit-major-mode) - (font-lock-ensure)) - (buffer-string)) - -(defun magit-insert-revision-headers () - "Insert headers about the commit into a revision buffer." - (magit-insert-section (headers) - (when-let ((string (magit-rev-format "%D" magit-buffer-revision - "--decorate=full"))) - (insert (magit-format-ref-labels string) ?\s)) - (insert (propertize - (magit-rev-parse (magit--rev-dereference magit-buffer-revision)) - 'font-lock-face 'magit-hash)) - (magit-insert-heading) - (let ((beg (point))) - (magit-rev-insert-format magit-revision-headers-format - magit-buffer-revision) - (magit-insert-revision-gravatars magit-buffer-revision beg)) - (when magit-revision-insert-related-refs - (when (magit-revision-insert-related-refs-display-p 'parents) - (dolist (parent (magit-commit-parents magit-buffer-revision)) - (magit-insert-section (commit parent) - (let ((line (magit-rev-format "%h %s" parent))) - (string-match "^\\([^ ]+\\) \\(.*\\)" line) - (magit-bind-match-strings (hash msg) line - (insert "Parent: ") - (insert (propertize hash 'font-lock-face 'magit-hash)) - (insert " " msg "\n")))))) - (when (magit-revision-insert-related-refs-display-p 'merged) - (magit--insert-related-refs - magit-buffer-revision "--merged" "Merged" - (eq magit-revision-insert-related-refs 'all))) - (when (magit-revision-insert-related-refs-display-p 'contained) - (magit--insert-related-refs - magit-buffer-revision "--contains" "Contained" - (memq magit-revision-insert-related-refs '(all mixed)))) - (when (magit-revision-insert-related-refs-display-p 'follows) - (when-let ((follows (magit-get-current-tag magit-buffer-revision t))) - (let ((tag (car follows)) - (cnt (cadr follows))) - (magit-insert-section (tag tag) - (insert - (format "Follows: %s (%s)\n" - (propertize tag 'font-lock-face 'magit-tag) - (propertize (number-to-string cnt) - 'font-lock-face 'magit-branch-local))))))) - (when (magit-revision-insert-related-refs-display-p 'precedes) - (when-let ((precedes (magit-get-next-tag magit-buffer-revision t))) - (let ((tag (car precedes)) - (cnt (cadr precedes))) - (magit-insert-section (tag tag) - (insert (format "Precedes: %s (%s)\n" - (propertize tag 'font-lock-face 'magit-tag) - (propertize (number-to-string cnt) - 'font-lock-face 'magit-tag))))))) - (insert ?\n)))) - -(defun magit-revision-insert-related-refs-display-p (sym) - "Whether to display related branches of type SYM. -Refer to user option `magit-revision-insert-related-refs-display-alist'." - (if-let ((elt (assq sym magit-revision-insert-related-refs-display-alist))) - (cdr elt) - t)) - -(defun magit--insert-related-refs (rev arg title remote) - (when-let ((refs (magit-list-related-branches arg rev (and remote "-a")))) - (insert title ":" (make-string (- 10 (length title)) ?\s)) - (dolist (branch refs) - (if (<= (+ (current-column) 1 (length branch)) - (window-width)) - (insert ?\s) - (insert ?\n (make-string 12 ?\s))) - (magit-insert-section (branch branch) - (insert (propertize branch 'font-lock-face - (if (string-prefix-p "remotes/" branch) - 'magit-branch-remote - 'magit-branch-local))))) - (insert ?\n))) - -(defun magit-insert-revision-gravatars (rev beg) - (when (and magit-revision-show-gravatars - (window-system)) - (require 'gravatar) - (pcase-let ((`(,author . ,committer) - (pcase magit-revision-show-gravatars - ('t '("^Author: " . "^Commit: ")) - ('author '("^Author: " . nil)) - ('committer '(nil . "^Commit: ")) - (_ magit-revision-show-gravatars)))) - (when-let ((email (and author (magit-rev-format "%aE" rev)))) - (magit-insert-revision-gravatar beg rev email author)) - (when-let ((email (and committer (magit-rev-format "%cE" rev)))) - (magit-insert-revision-gravatar beg rev email committer))))) - -(defun magit-insert-revision-gravatar (beg rev email regexp) - (save-excursion - (goto-char beg) - (when (re-search-forward regexp nil t) - (when-let ((window (get-buffer-window))) - (let* ((column (length (match-string 0))) - (font-obj (query-font (font-at (point) window))) - (size (* 2 (+ (aref font-obj 4) - (aref font-obj 5)))) - (align-to (+ column - (ceiling (/ size (aref font-obj 7) 1.0)) - 1)) - (gravatar-size (- size 2))) - (ignore-errors ; service may be unreachable - (gravatar-retrieve email #'magit-insert-revision-gravatar-cb - (list gravatar-size rev - (point-marker) - align-to column)))))))) - -(defun magit-insert-revision-gravatar-cb (image size rev marker align-to column) - (unless (eq image 'error) - (when-let ((buffer (marker-buffer marker))) - (with-current-buffer buffer - (save-excursion - (goto-char marker) - ;; The buffer might display another revision by now or - ;; it might have been refreshed, in which case another - ;; process might already have inserted the image. - (when (and (equal rev magit-buffer-revision) - (not (eq (car-safe - (car-safe - (get-text-property (point) 'display))) - 'image))) - (setf (image-property image :ascent) 'center) - (setf (image-property image :relief) 1) - (setf (image-property image :scale) 1) - (setf (image-property image :height) size) - (let ((top (list image '(slice 0.0 0.0 1.0 0.5))) - (bot (list image '(slice 0.0 0.5 1.0 1.0))) - (align `((space :align-to ,align-to)))) - (let ((inhibit-read-only t)) - (insert (propertize " " 'display top)) - (insert (propertize " " 'display align)) - (forward-line) - (forward-char column) - (insert (propertize " " 'display bot)) - (insert (propertize " " 'display align)))))))))) - -;;; Merge-Preview Mode - -(define-derived-mode magit-merge-preview-mode magit-diff-mode "Magit Merge" - "Mode for previewing a merge." - :group 'magit-diff - (hack-dir-local-variables-non-file-buffer)) - -(put 'magit-merge-preview-mode 'magit-diff-default-arguments - '("--no-ext-diff")) - -(defun magit-merge-preview-setup-buffer (rev) - (magit-setup-buffer #'magit-merge-preview-mode nil - (magit-buffer-revision rev) - (magit-buffer-range (format "%s^..%s" rev rev)))) - -(defun magit-merge-preview-refresh-buffer () - (let* ((branch (magit-get-current-branch)) - (head (or branch (magit-rev-verify "HEAD")))) - (magit-set-header-line-format (format "Preview merge of %s into %s" - magit-buffer-revision - (or branch "HEAD"))) - (magit-insert-section (diffbuf) - (magit--insert-diff t - "merge-tree" (magit-git-string "merge-base" head magit-buffer-revision) - head magit-buffer-revision)))) - -(cl-defmethod magit-buffer-value (&context (major-mode magit-merge-preview-mode)) - magit-buffer-revision) - -;;; Hunk Section - -(defun magit-hunk-set-window-start (section) - "When SECTION is a `hunk', ensure that its beginning is visible. -It the SECTION has a different type, then do nothing." - (when (magit-hunk-section-p section) - (magit-section-set-window-start section))) - -(add-hook 'magit-section-movement-hook #'magit-hunk-set-window-start) - -(cl-defmethod magit-section-get-relative-position ((_section magit-hunk-section)) - (nconc (cl-call-next-method) - (and (region-active-p) - (progn - (goto-char (line-beginning-position)) - (when (looking-at "^[-+]") (forward-line)) - (while (looking-at "^[ @]") (forward-line)) - (let ((beg (magit-point))) - (list (cond - ((looking-at "^[-+]") - (forward-line) - (while (looking-at "^[-+]") (forward-line)) - (while (looking-at "^ ") (forward-line)) - (forward-line -1) - (regexp-quote (buffer-substring-no-properties - beg (line-end-position)))) - (t t)))))))) - -(cl-defmethod magit-section-goto-successor ((section magit-hunk-section) - line char &optional arg) - (or (magit-section-goto-successor--same section line char) - (and-let* ((parent (magit-get-section - (magit-section-ident - (oref section parent))))) - (let* ((children (oref parent children)) - (siblings (magit-section-siblings section 'prev)) - (previous (nth (length siblings) children))) - (if (not arg) - (when-let ((sibling (or previous (car (last children))))) - (magit-section-goto sibling) - t) - (when previous - (magit-section-goto previous)) - (if (and (stringp arg) - (re-search-forward arg (oref parent end) t)) - (goto-char (match-beginning 0)) - (goto-char (oref (car (last children)) end)) - (forward-line -1) - (while (looking-at "^ ") (forward-line -1)) - (while (looking-at "^[-+]") (forward-line -1)) - (forward-line))))) - (magit-section-goto-successor--related section))) - -;;; Diff Sections - -(defvar-keymap magit-unstaged-section-map - :doc "Keymap for the `unstaged' section." - "<remap> <magit-visit-thing>" #'magit-diff-unstaged - "<remap> <magit-stage-file>" #'magit-stage - "<remap> <magit-delete-thing>" #'magit-discard - "<3>" (magit-menu-item "Discard all" #'magit-discard) - "<2>" (magit-menu-item "Stage all" #'magit-stage) - "<1>" (magit-menu-item "Visit diff" #'magit-diff-unstaged)) - -(magit-define-section-jumper magit-jump-to-unstaged "Unstaged changes" unstaged) - -(defun magit-insert-unstaged-changes () - "Insert section showing unstaged changes." - (magit-insert-section (unstaged) - (magit-insert-heading "Unstaged changes:") - (magit--insert-diff nil - "diff" magit-buffer-diff-args "--no-prefix" - "--" magit-buffer-diff-files))) - -(defvar-keymap magit-staged-section-map - :doc "Keymap for the `staged' section." - "<remap> <magit-revert-no-commit>" #'magit-reverse - "<remap> <magit-delete-thing>" #'magit-discard - "<remap> <magit-unstage-file>" #'magit-unstage - "<remap> <magit-visit-thing>" #'magit-diff-staged - "<4>" (magit-menu-item "Reverse all" #'magit-reverse) - "<3>" (magit-menu-item "Discard all" #'magit-discard) - "<2>" (magit-menu-item "Unstage all" #'magit-unstage) - "<1>" (magit-menu-item "Visit diff" #'magit-diff-staged)) - -(magit-define-section-jumper magit-jump-to-staged "Staged changes" staged) - -(defun magit-insert-staged-changes () - "Insert section showing staged changes." - ;; Avoid listing all files as deleted when visiting a bare repo. - (unless (magit-bare-repo-p) - (magit-insert-section (staged) - (magit-insert-heading "Staged changes:") - (magit--insert-diff nil - "diff" "--cached" magit-buffer-diff-args "--no-prefix" - "--" magit-buffer-diff-files)))) - -;;; Diff Type - -(defvar magit--diff-use-recorded-type-p t) - -(defun magit-diff-type (&optional section) - "Return the diff type of SECTION. - -The returned type is one of the symbols `staged', `unstaged', -`committed', or `undefined'. This type serves a similar purpose -as the general type common to all sections (which is stored in -the `type' slot of the corresponding `magit-section' struct) but -takes additional information into account. When the SECTION -isn't related to diffs and the buffer containing it also isn't -a diff-only buffer, then return nil. - -Currently the type can also be one of `tracked' and `untracked' -but these values are not handled explicitly everywhere they -should be and a possible fix could be to just return nil here. - -The section has to be a `diff' or `hunk' section, or a section -whose children are of type `diff'. If optional SECTION is nil, -return the diff type for the current section. In buffers whose -major mode is `magit-diff-mode' SECTION is ignored and the type -is determined using other means. In `magit-revision-mode' -buffers the type is always `committed'. - -Do not confuse this with `magit-diff-scope' (which see)." - (when-let ((section (or section (magit-current-section)))) - (cond ((derived-mode-p 'magit-revision-mode 'magit-stash-mode) 'committed) - ((derived-mode-p 'magit-diff-mode) - (let ((range magit-buffer-range) - (const magit-buffer-typearg)) - (cond ((and magit--diff-use-recorded-type-p - magit-buffer-diff-type)) - ((equal const "--no-index") 'undefined) - ((or (not range) - (equal range "HEAD") - (magit-rev-eq range "HEAD")) - (if (equal const "--cached") - 'staged - 'unstaged)) - ((equal const "--cached") - (if (magit-rev-head-p range) - 'staged - 'undefined)) ; i.e., committed and staged - (t 'committed)))) - ((derived-mode-p 'magit-status-mode) - (let ((stype (oref section type))) - (if (memq stype '(staged unstaged tracked untracked)) - stype - (pcase stype - ((or 'file 'module) - (let* ((parent (oref section parent)) - (type (oref parent type))) - (if (memq type '(file module)) - (magit-diff-type parent) - type))) - ('hunk (thread-first section - (oref parent) - (oref parent) - (oref type))))))) - ((derived-mode-p 'magit-log-mode) - (if (or (and (magit-section-match 'commit section) - (oref section children)) - (magit-section-match [* file commit] section)) - 'committed - 'undefined)) - (t 'undefined)))) - -(cl-defun magit-diff-scope (&optional (section nil ssection) strict) - "Return the diff scope of SECTION or the selected section(s). - -A diff's \"scope\" describes what part of a diff is selected, it is -a symbol, one of `region', `hunk', `hunks', `file', `files', or -`list'. Do not confuse this with the diff \"type\", as returned by -`magit-diff-type'. - -If optional SECTION is non-nil, then return the scope of that, -ignoring the sections selected by the region. Otherwise return -the scope of the current section, or if the region is active and -selects a valid group of diff related sections, the type of these -sections, i.e., `hunks' or `files'. If SECTION, or if that is nil -the current section, is a `hunk' section; and the region region -starts and ends inside the body of a that section, then the type -is `region'. If the region is empty after a mouse click, then -`hunk' is returned instead of `region'. - -If optional STRICT is non-nil, then return nil if the diff type of -the section at point is `untracked' or the section at point is not -actually a `diff' but a `diffstat' section." - (let ((siblings (and (not ssection) (magit-region-sections nil t)))) - (setq section (or section (car siblings) (magit-current-section))) - (when (and section - (or (not strict) - (and (not (eq (magit-diff-type section) 'untracked)) - (not (eq (and-let* ((parent (oref section parent))) - (oref parent type)) - 'diffstat))))) - (pcase (list (oref section type) - (and siblings t) - (magit-diff-use-hunk-region-p) - ssection) - (`(hunk nil t ,_) - (if (magit-section-internal-region-p section) 'region 'hunk)) - ('(hunk t t nil) 'hunks) - (`(hunk ,_ ,_ ,_) 'hunk) - ('(file t t nil) 'files) - (`(file ,_ ,_ ,_) 'file) - ('(module t t nil) 'files) - (`(module ,_ ,_ ,_) 'file) - (`(,(or 'staged 'unstaged 'untracked) nil ,_ ,_) 'list))))) - -(defun magit-diff-use-hunk-region-p () - (and (region-active-p) - ;; TODO implement this from first principals - ;; currently it's trial-and-error - (not (and (or (eq this-command #'mouse-drag-region) - (eq last-command #'mouse-drag-region) - ;; When another window was previously - ;; selected then the last-command is - ;; some byte-code function. - (byte-code-function-p last-command)) - (eq (region-end) (region-beginning)))))) - -;;; Diff Highlight - -(add-hook 'magit-section-unhighlight-hook #'magit-diff-unhighlight) -(add-hook 'magit-section-highlight-hook #'magit-diff-highlight) - -(defun magit-diff-unhighlight (section selection) - "Remove the highlighting of the diff-related SECTION." - (when (magit-hunk-section-p section) - (magit-diff-paint-hunk section selection nil) - t)) - -(defun magit-diff-highlight (section selection) - "Highlight the diff-related SECTION. -If SECTION is not a diff-related section, then do nothing and -return nil. If SELECTION is non-nil, then it is a list of sections -selected by the region, including SECTION. All of these sections -are highlighted." - (if (and (magit-section-match 'commit section) - (oref section children)) - (progn (if selection - (dolist (section selection) - (magit-diff-highlight-list section selection)) - (magit-diff-highlight-list section)) - t) - (when-let ((scope (magit-diff-scope section t))) - (cond ((eq scope 'region) - (magit-diff-paint-hunk section selection t)) - (selection - (dolist (section selection) - (magit-diff-highlight-recursive section selection))) - (t - (magit-diff-highlight-recursive section))) - t))) - -(defun magit-diff-highlight-recursive (section &optional selection) - (pcase (magit-diff-scope section) - ('list (magit-diff-highlight-list section selection)) - ('file (magit-diff-highlight-file section selection)) - ('hunk (magit-diff-highlight-heading section selection) - (magit-diff-paint-hunk section selection t)) - (_ (magit-section-highlight section nil)))) - -(defun magit-diff-highlight-list (section &optional selection) - (let ((beg (oref section start)) - (cnt (oref section content)) - (end (oref section end))) - (when (or (eq this-command #'mouse-drag-region) - (not selection)) - (unless (and (region-active-p) - (<= (region-beginning) beg)) - (magit-section-make-overlay beg cnt 'magit-section-highlight)) - (if (oref section hidden) - (oset section washer #'ignore) - (dolist (child (oref section children)) - (when (or (eq this-command #'mouse-drag-region) - (not (and (region-active-p) - (<= (region-beginning) - (oref child start))))) - (magit-diff-highlight-recursive child selection))))) - (when magit-diff-highlight-hunk-body - (magit-section-make-overlay (1- end) end 'magit-section-highlight)))) - -(defun magit-diff-highlight-file (section &optional selection) - (magit-diff-highlight-heading section selection) - (when (or (not (oref section hidden)) - (cl-typep section 'magit-module-section)) - (dolist (child (oref section children)) - (magit-diff-highlight-recursive child selection)))) - -(defun magit-diff-highlight-heading (section &optional selection) - (magit-section-make-overlay - (oref section start) - (or (oref section content) - (oref section end)) - (pcase (list (oref section type) - (and (member section selection) - (not (eq this-command #'mouse-drag-region)))) - ('(file t) 'magit-diff-file-heading-selection) - ('(file nil) 'magit-diff-file-heading-highlight) - ('(module t) 'magit-diff-file-heading-selection) - ('(module nil) 'magit-diff-file-heading-highlight) - ('(hunk t) 'magit-diff-hunk-heading-selection) - ('(hunk nil) 'magit-diff-hunk-heading-highlight)))) - -;;; Hunk Paint - -(cl-defun magit-diff-paint-hunk - (section &optional selection - (highlight (magit-section-selected-p section selection))) - (let (paint) - (unless magit-diff-highlight-hunk-body - (setq highlight nil)) - (cond (highlight - (unless (oref section hidden) - (add-to-list 'magit-section-highlighted-sections section) - (cond ((memq section magit-section-unhighlight-sections) - (setq magit-section-unhighlight-sections - (delq section magit-section-unhighlight-sections))) - (magit-diff-highlight-hunk-body - (setq paint t))))) - (t - (cond ((and (oref section hidden) - (memq section magit-section-unhighlight-sections)) - (add-to-list 'magit-section-highlighted-sections section) - (setq magit-section-unhighlight-sections - (delq section magit-section-unhighlight-sections))) - (t - (setq paint t))))) - (when paint - (save-excursion - (goto-char (oref section start)) - (let ((end (oref section end)) - (merging (looking-at "@@@")) - (diff-type (magit-diff-type)) - (stage nil) - (tab-width (magit-diff-tab-width - (magit-section-parent-value section)))) - (forward-line) - (while (< (point) end) - (when (and magit-diff-hide-trailing-cr-characters - (char-equal ?\r (char-before (line-end-position)))) - (put-text-property (1- (line-end-position)) (line-end-position) - 'invisible t)) - (put-text-property - (point) (1+ (line-end-position)) 'font-lock-face - (cond - ((looking-at "^\\+\\+?\\([<=|>]\\)\\{7\\}") - (setq stage (pcase (list (match-string 1) highlight) - ('("<" nil) 'magit-diff-our) - ('("<" t) 'magit-diff-our-highlight) - ('("|" nil) 'magit-diff-base) - ('("|" t) 'magit-diff-base-highlight) - ('("=" nil) 'magit-diff-their) - ('("=" t) 'magit-diff-their-highlight) - ('(">" nil) nil))) - 'magit-diff-conflict-heading) - ((looking-at (if merging "^\\(\\+\\| \\+\\)" "^\\+")) - (magit-diff-paint-tab merging tab-width) - (magit-diff-paint-whitespace merging 'added diff-type) - (or stage - (if highlight 'magit-diff-added-highlight 'magit-diff-added))) - ((looking-at (if merging "^\\(-\\| -\\)" "^-")) - (magit-diff-paint-tab merging tab-width) - (magit-diff-paint-whitespace merging 'removed diff-type) - (if highlight 'magit-diff-removed-highlight 'magit-diff-removed)) - (t - (magit-diff-paint-tab merging tab-width) - (magit-diff-paint-whitespace merging 'context diff-type) - (if highlight 'magit-diff-context-highlight 'magit-diff-context)))) - (forward-line)))))) - (magit-diff-update-hunk-refinement section)) - -(defvar magit-diff--tab-width-cache nil) - -(defun magit-diff-tab-width (file) - (setq file (expand-file-name file)) - (cl-flet ((cache (value) - (let ((elt (assoc file magit-diff--tab-width-cache))) - (if elt - (setcdr elt value) - (setq magit-diff--tab-width-cache - (cons (cons file value) - magit-diff--tab-width-cache)))) - value)) - (cond - ((not magit-diff-adjust-tab-width) - tab-width) - ((and-let* ((buffer (find-buffer-visiting file))) - (cache (buffer-local-value 'tab-width buffer)))) - ((and-let* ((elt (assoc file magit-diff--tab-width-cache))) - (or (cdr elt) - tab-width))) - ((or (eq magit-diff-adjust-tab-width 'always) - (and (numberp magit-diff-adjust-tab-width) - (>= magit-diff-adjust-tab-width - (nth 7 (file-attributes file))))) - (cache (buffer-local-value 'tab-width (find-file-noselect file)))) - (t - (cache nil) - tab-width)))) - -(defun magit-diff-paint-tab (merging width) - (save-excursion - (forward-char (if merging 2 1)) - (while (= (char-after) ?\t) - (put-text-property (point) (1+ (point)) - 'display (list (list 'space :width width))) - (forward-char)))) - -(defun magit-diff-paint-whitespace (merging line-type diff-type) - (when (and magit-diff-paint-whitespace - (or (not (memq magit-diff-paint-whitespace '(uncommitted status))) - (memq diff-type '(staged unstaged))) - (cl-case line-type - (added t) - (removed (memq magit-diff-paint-whitespace-lines '(all both))) - (context (memq magit-diff-paint-whitespace-lines '(all))))) - (let ((prefix (if merging "^[-\\+\s]\\{2\\}" "^[-\\+\s]")) - (indent - (if (local-variable-p 'magit-diff-highlight-indentation) - magit-diff-highlight-indentation - (setq-local - magit-diff-highlight-indentation - (cdr (--first (string-match-p (car it) default-directory) - (nreverse - (default-value - 'magit-diff-highlight-indentation)))))))) - (when (and magit-diff-highlight-trailing - (looking-at (concat prefix ".*?\\([ \t]+\\)?$"))) - (let ((ov (make-overlay (match-beginning 1) (match-end 1) nil t))) - (overlay-put ov 'font-lock-face 'magit-diff-whitespace-warning) - (overlay-put ov 'priority 2) - (overlay-put ov 'evaporate t))) - (when (or (and (eq indent 'tabs) - (looking-at (concat prefix "\\( *\t[ \t]*\\)"))) - (and (integerp indent) - (looking-at (format "%s\\([ \t]* \\{%s,\\}[ \t]*\\)" - prefix indent)))) - (let ((ov (make-overlay (match-beginning 1) (match-end 1) nil t))) - (overlay-put ov 'font-lock-face 'magit-diff-whitespace-warning) - (overlay-put ov 'priority 2) - (overlay-put ov 'evaporate t)))))) - -(defun magit-diff-update-hunk-refinement (&optional section) - (if section - (unless (oref section hidden) - (pcase (list magit-diff-refine-hunk - (oref section refined) - (eq section (magit-current-section))) - ((or `(all nil ,_) '(t nil t)) - (oset section refined t) - (save-excursion - (goto-char (oref section start)) - ;; `diff-refine-hunk' does not handle combined diffs. - (unless (looking-at "@@@") - (let ((smerge-refine-ignore-whitespace - magit-diff-refine-ignore-whitespace) - ;; Avoid fsyncing many small temp files - (write-region-inhibit-fsync t)) - (diff-refine-hunk))))) - ((or `(nil t ,_) '(t t nil)) - (oset section refined nil) - (remove-overlays (oref section start) - (oref section end) - 'diff-mode 'fine)))) - (cl-labels ((recurse (section) - (if (magit-section-match 'hunk section) - (magit-diff-update-hunk-refinement section) - (dolist (child (oref section children)) - (recurse child))))) - (recurse magit-root-section)))) - - -;;; Hunk Region - -(defun magit-diff-hunk-region-beginning () - (save-excursion (goto-char (region-beginning)) - (line-beginning-position))) - -(defun magit-diff-hunk-region-end () - (save-excursion (goto-char (region-end)) - (line-end-position))) - -(defun magit-diff-update-hunk-region (section) - "Highlight the hunk-internal region if any." - (when (and (eq (oref section type) 'hunk) - (eq (magit-diff-scope section t) 'region)) - (magit-diff--make-hunk-overlay - (oref section start) - (1- (oref section content)) - 'font-lock-face 'magit-diff-lines-heading - 'display (magit-diff-hunk-region-header section) - 'after-string (magit-diff--hunk-after-string 'magit-diff-lines-heading)) - (run-hook-with-args 'magit-diff-highlight-hunk-region-functions section) - t)) - -(defun magit-diff-highlight-hunk-region-dim-outside (section) - "Dim the parts of the hunk that are outside the hunk-internal region. -This is done by using the same foreground and background color -for added and removed lines as for context lines." - (let ((face (if magit-diff-highlight-hunk-body - 'magit-diff-context-highlight - 'magit-diff-context))) - (when magit-diff-unmarked-lines-keep-foreground - (setq face `(,@(and (>= emacs-major-version 27) '(:extend t)) - :background ,(face-attribute face :background)))) - (magit-diff--make-hunk-overlay (oref section content) - (magit-diff-hunk-region-beginning) - 'font-lock-face face - 'priority 2) - (magit-diff--make-hunk-overlay (1+ (magit-diff-hunk-region-end)) - (oref section end) - 'font-lock-face face - 'priority 2))) - -(defun magit-diff-highlight-hunk-region-using-face (_section) - "Highlight the hunk-internal region by making it bold. -Or rather highlight using the face `magit-diff-hunk-region', though -changing only the `:weight' and/or `:slant' is recommended for that -face." - (magit-diff--make-hunk-overlay (magit-diff-hunk-region-beginning) - (1+ (magit-diff-hunk-region-end)) - 'font-lock-face 'magit-diff-hunk-region)) - -(defun magit-diff-highlight-hunk-region-using-overlays (section) - "Emphasize the hunk-internal region using delimiting horizontal lines. -This is implemented as single-pixel newlines places inside overlays." - (if (window-system) - (let ((beg (magit-diff-hunk-region-beginning)) - (end (magit-diff-hunk-region-end)) - (str (propertize - (concat (propertize "\s" 'display '(space :height (1))) - (propertize "\n" 'line-height t)) - 'font-lock-face 'magit-diff-lines-boundary))) - (magit-diff--make-hunk-overlay beg (1+ beg) 'before-string str) - (magit-diff--make-hunk-overlay end (1+ end) 'after-string str)) - (magit-diff-highlight-hunk-region-using-face section))) - -(defun magit-diff-highlight-hunk-region-using-underline (section) - "Emphasize the hunk-internal region using delimiting horizontal lines. -This is implemented by overlining and underlining the first and -last (visual) lines of the region." - (if (window-system) - (let* ((beg (magit-diff-hunk-region-beginning)) - (end (magit-diff-hunk-region-end)) - (beg-eol (save-excursion (goto-char beg) - (end-of-visual-line) - (point))) - (end-bol (save-excursion (goto-char end) - (beginning-of-visual-line) - (point))) - (color (face-background 'magit-diff-lines-boundary nil t))) - (cl-flet ((ln (b e &rest face) - (magit-diff--make-hunk-overlay - b e 'font-lock-face face 'after-string - (magit-diff--hunk-after-string face)))) - (if (= beg end-bol) - (ln beg beg-eol :overline color :underline color) - (ln beg beg-eol :overline color) - (ln end-bol end :underline color)))) - (magit-diff-highlight-hunk-region-using-face section))) - -(defun magit-diff--make-hunk-overlay (start end &rest args) - (let ((ov (make-overlay start end nil t))) - (overlay-put ov 'evaporate t) - (while args (overlay-put ov (pop args) (pop args))) - (push ov magit-section--region-overlays) - ov)) - -(defun magit-diff--hunk-after-string (face) - (propertize "\s" - 'font-lock-face face - 'display (list 'space :align-to - `(+ (0 . right) - ,(min (window-hscroll) - (- (line-end-position) - (line-beginning-position))))) - ;; This prevents the cursor from being rendered at the - ;; edge of the window. - 'cursor t)) - -;;; Utilities - -(defun magit-diff-inside-hunk-body-p () - "Return non-nil if point is inside the body of a hunk." - (and (magit-section-match 'hunk) - (and-let* ((content (oref (magit-current-section) content))) - (> (magit-point) content)))) - -(defun magit-diff--combined-p (section) - (cl-assert (cl-typep section 'magit-file-section)) - (string-match-p "\\`diff --\\(combined\\|cc\\)" (oref section value))) - -;;; Diff Extract - -(defun magit-diff-file-header (section &optional no-rename) - (when (magit-hunk-section-p section) - (setq section (oref section parent))) - (and (magit-file-section-p section) - (let ((header (oref section header))) - (if no-rename - (replace-regexp-in-string - "^--- \\(.+\\)" (oref section value) header t t 1) - header)))) - -(defun magit-diff-hunk-region-header (section) - (let ((patch (magit-diff-hunk-region-patch section))) - (string-match "\n" patch) - (substring patch 0 (1- (match-end 0))))) - -(defun magit-diff-hunk-region-patch (section &optional args) - (let ((op (if (member "--reverse" args) "+" "-")) - (sbeg (oref section start)) - (rbeg (magit-diff-hunk-region-beginning)) - (rend (region-end)) - (send (oref section end)) - (patch nil)) - (save-excursion - (goto-char sbeg) - (while (< (point) send) - (looking-at "\\(.\\)\\([^\n]*\n\\)") - (cond ((or (string-match-p "[@ ]" (match-string-no-properties 1)) - (and (>= (point) rbeg) - (<= (point) rend))) - (push (match-string-no-properties 0) patch)) - ((equal op (match-string-no-properties 1)) - (push (concat " " (match-string-no-properties 2)) patch))) - (forward-line))) - (let ((buffer-list-update-hook nil)) ; #3759 - (with-temp-buffer - (insert (mapconcat #'identity (reverse patch) "")) - (diff-fixup-modifs (point-min) (point-max)) - (setq patch (buffer-string)))) - patch)) - -;;; _ -(provide 'magit-diff) -;;; magit-diff.el ends here diff --git a/emacs/elpa/magit-20240622.1531/magit-diff.elc b/emacs/elpa/magit-20240622.1531/magit-diff.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/magit-ediff.elc b/emacs/elpa/magit-20240622.1531/magit-ediff.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/magit-git.el b/emacs/elpa/magit-20240622.1531/magit-git.el @@ -1,2903 +0,0 @@ -;;; magit-git.el --- Git functionality -*- lexical-binding:t -*- - -;; Copyright (C) 2008-2024 The Magit Project Contributors - -;; Author: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> -;; Maintainer: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> - -;; SPDX-License-Identifier: GPL-3.0-or-later - -;; 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. -;; -;; 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 Magit. If not, see <https://www.gnu.org/licenses/>. - -;;; Commentary: - -;; This library implements wrappers for various Git plumbing commands. - -;;; Code: - -(require 'magit-base) - -(require 'format-spec) - -;; From `magit-branch'. -(defvar magit-branch-prefer-remote-upstream) -(defvar magit-published-branches) - -;; From `magit-margin'. -(declare-function magit-maybe-make-margin-overlay "magit-margin" ()) - -;; From `magit-mode'. -(declare-function magit-get-mode-buffer "magit-mode" - (mode &optional value frame)) -(declare-function magit-refresh "magit-mode" ()) -(defvar magit-buffer-diff-type) -(defvar magit-buffer-diff-args) -(defvar magit-buffer-file-name) -(defvar magit-buffer-log-args) -(defvar magit-buffer-log-files) -(defvar magit-buffer-refname) -(defvar magit-buffer-revision) - -;; From `magit-process'. -(declare-function magit-call-git "magit-process" (&rest args)) -(declare-function magit-git "magit-process" (&rest args)) -(declare-function magit-process-buffer "magit-process" (&optional nodisplay)) -(declare-function magit-process-file "magit-process" - (process &optional infile buffer display &rest args)) -(declare-function magit-process-git "magit-process" (destination &rest args)) -(declare-function magit-process-insert-section "magit-process" - (pwd program args &optional errcode errlog)) -(defvar magit-this-error) -(defvar magit-process-error-message-regexps) - -(eval-when-compile - (cl-pushnew 'orig-rev eieio--known-slot-names) - (cl-pushnew 'number eieio--known-slot-names)) - -;;; Git implementations - -(defvar magit-inhibit-libgit t - "Whether to inhibit the use of libgit. -Use of libgit is inhibited by default because support for libgit -in magit is only a stub for now. There is no benefit in using -it.") - -(defvar magit--libgit-available-p 'unknown - "Whether libgit is available. -Use the function by the same name instead of this variable.") - -(defun magit--libgit-available-p () - (if (eq magit--libgit-available-p 'unknown) - (setq magit--libgit-available-p - (and module-file-suffix - (let ((libgit (locate-library "libgit"))) - (and libgit - (or (locate-library "libegit2") - (let ((load-path - (cons (expand-file-name - (convert-standard-filename "build") - (file-name-directory libgit)) - load-path))) - (locate-library "libegit2"))))))) - magit--libgit-available-p)) - -(defun magit-gitimpl () - "Return the Git implementation used in this repository." - (if (and (not magit-inhibit-libgit) - (not (file-remote-p default-directory)) - (magit--libgit-available-p)) - 'libgit - 'git)) - -;;; Options - -;; For now this is shared between `magit-process' and `magit-git'. -(defgroup magit-process nil - "Git and other external processes used by Magit." - :group 'magit) - -(defvar magit-git-environment - (list (format "INSIDE_EMACS=%s,magit" emacs-version)) - "Prepended to `process-environment' while running git.") - -(defcustom magit-git-output-coding-system - (and (eq system-type 'windows-nt) 'utf-8) - "Coding system for receiving output from Git. - -If non-nil, the Git config value `i18n.logOutputEncoding' should -be set via `magit-git-global-arguments' to value consistent with -this." - :package-version '(magit . "2.9.0") - :group 'magit-process - :type '(choice (coding-system :tag "Coding system to decode Git output") - (const :tag "Use system default" nil))) - -(defvar magit-git-w32-path-hack nil - "Alist of (EXE . (PATHENTRY)). -This specifies what additional PATH setting needs to be added to -the environment in order to run the non-wrapper git executables -successfully.") - -(defcustom magit-git-executable - (or (and (eq system-type 'windows-nt) - ;; Avoid the wrappers "cmd/git.exe" and "cmd/git.cmd", - ;; which are much slower than using "bin/git.exe" directly. - (and-let* ((exec (executable-find "git"))) - (ignore-errors - ;; Git for Windows 2.x provides cygpath so we can - ;; ask it for native paths. - (let* ((core-exe - (car - (process-lines - exec "-c" - "alias.X=!x() { which \"$1\" | cygpath -mf -; }; x" - "X" "git"))) - (hack-entry (assoc core-exe magit-git-w32-path-hack)) - ;; Running the libexec/git-core executable - ;; requires some extra PATH entries. - (path-hack - (list (concat "PATH=" - (car (process-lines - exec "-c" - "alias.P=!cygpath -wp \"$PATH\"" - "P")))))) - ;; The defcustom STANDARD expression can be - ;; evaluated many times, so make sure it is - ;; idempotent. - (if hack-entry - (setcdr hack-entry path-hack) - (push (cons core-exe path-hack) magit-git-w32-path-hack)) - core-exe)))) - (and (eq system-type 'darwin) - (executable-find "git")) - "git") - "The Git executable used by Magit on the local host. -On remote machines `magit-remote-git-executable' is used instead." - :package-version '(magit . "3.2.0") - :group 'magit-process - :type 'string) - -(defcustom magit-remote-git-executable "git" - "The Git executable used by Magit on remote machines. -On the local host `magit-git-executable' is used instead. -Consider customizing `tramp-remote-path' instead of this -option." - :package-version '(magit . "3.2.0") - :group 'magit-process - :type 'string) - -(defcustom magit-git-global-arguments - `("--no-pager" "--literal-pathspecs" - "-c" "core.preloadindex=true" - "-c" "log.showSignature=false" - "-c" "color.ui=false" - "-c" "color.diff=false" - ,@(and (eq system-type 'windows-nt) - (list "-c" "i18n.logOutputEncoding=UTF-8"))) - "Global Git arguments. - -The arguments set here are used every time the git executable is -run as a subprocess. They are placed right after the executable -itself and before the git command - as in `git HERE... COMMAND -REST'. See the manpage `git(1)' for valid arguments. - -Be careful what you add here, especially if you are using Tramp -to connect to servers with ancient Git versions. Never remove -anything that is part of the default value, unless you really -know what you are doing. And think very hard before adding -something; it will be used every time Magit runs Git for any -purpose." - :package-version '(magit . "2.9.0") - :group 'magit-commands - :group 'magit-process - :type '(repeat string)) - -(defcustom magit-prefer-remote-upstream nil - "Whether to favor remote branches when reading the upstream branch. - -This controls whether commands that read a branch from the user -and then set it as the upstream branch, offer a local or a remote -branch as default completion candidate, when they have the choice. - -This affects all commands that use `magit-read-upstream-branch' -or `magit-read-starting-point', which includes most commands -that change the upstream and many that create new branches." - :package-version '(magit . "2.4.2") - :group 'magit-commands - :type 'boolean) - -(defcustom magit-list-refs-namespaces - '("refs/heads" - "refs/remotes" - "refs/tags" - "refs/pullreqs") - "List of ref namespaces considered when reading a ref. - -This controls the order of refs returned by `magit-list-refs', -which is called by functions like `magit-list-branch-names' to -generate the collection of refs." - :package-version '(magit . "3.1.0") - :group 'magit-commands - :type '(repeat string)) - -(defcustom magit-list-refs-sortby nil - "How to sort the ref collection in the prompt. - -This affects commands that read a ref. More specifically, it -controls the order of refs returned by `magit-list-refs', which -is called by functions like `magit-list-branch-names' to generate -the collection of refs. By default, refs are sorted according to -their full refname (i.e., \"refs/...\"). - -Any value accepted by the `--sort' flag of \"git for-each-ref\" can -be used. For example, \"-creatordate\" places refs with more -recent committer or tagger dates earlier in the list. A list of -strings can also be given in order to pass multiple sort keys to -\"git for-each-ref\". - -Note that, depending on the completion framework you use, this -may not be sufficient to change the order in which the refs are -displayed. It only controls the order of the collection passed -to `magit-completing-read' or, for commands that support reading -multiple strings, `read-from-minibuffer'. The completion -framework ultimately determines how the collection is displayed." - :package-version '(magit . "2.11.0") - :group 'magit-miscellaneous - :type '(choice string (repeat string))) - -;;; Git - -(defvar magit-git-debug nil - "Whether to enable additional reporting of git errors. - -Magit basically calls git for one of these two reasons: for -side-effects or to do something with its standard output. - -When git is run for side-effects then its output, including error -messages, go into the process buffer which is shown when using \ -\\<magit-status-mode-map>\\[magit-process-buffer]. - -When git's output is consumed in some way, then it would be too -expensive to also insert it into this buffer, but when this -option is non-nil and git returns with a non-zero exit status, -then at least its standard error is inserted into this buffer. - -This is only intended for debugging purposes. Do not enable this -permanently, that would negatively affect performance. Also note -that just because git exits with a non-zero exit status and prints -an error message that usually doesn't mean that it is an error as -far as Magit is concerned, which is another reason we usually hide -these error messages. Whether some error message is relevant in -the context of some unexpected behavior has to be judged on a case -by case basis. - -The command `magit-toggle-git-debug' changes the value of this -variable. - -Also see `magit-process-extreme-logging'.") - -(defun magit-toggle-git-debug () - "Toggle whether additional git errors are reported. -See info node `(magit)Debugging Tools' for more information." - (interactive) - (setq magit-git-debug (not magit-git-debug)) - (message "Additional reporting of Git errors %s" - (if magit-git-debug "enabled" "disabled"))) - -(defvar magit--refresh-cache nil) - -(defmacro magit--with-refresh-cache (key &rest body) - (declare (indent 1) (debug (form body))) - (let ((k (cl-gensym)) - (hit (cl-gensym))) - `(if magit--refresh-cache - (let ((,k ,key)) - (if-let ((,hit (assoc ,k (cdr magit--refresh-cache)))) - (progn (cl-incf (caar magit--refresh-cache)) - (cdr ,hit)) - (cl-incf (cdar magit--refresh-cache)) - (let ((value ,(macroexp-progn body))) - (push (cons ,k value) - (cdr magit--refresh-cache)) - value))) - ,@body))) - -(defvar magit-with-editor-envvar "GIT_EDITOR" - "The environment variable exported by `magit-with-editor'. -Set this to \"GIT_SEQUENCE_EDITOR\" if you do not want to use -Emacs to edit commit messages but would like to do so to edit -rebase sequences.") - -(defmacro magit-with-editor (&rest body) - "Like `with-editor*' but let-bind some more variables. -Also respect the value of `magit-with-editor-envvar'." - (declare (indent 0) (debug (body))) - `(let ((magit-process-popup-time -1) - ;; The user may have customized `shell-file-name' to - ;; something which results in `w32-shell-dos-semantics' nil - ;; (which changes the quoting style used by - ;; `shell-quote-argument'), but Git for Windows expects shell - ;; quoting in the dos style. - (shell-file-name (if (and (eq system-type 'windows-nt) - ;; If we have Cygwin mount points, - ;; the git flavor is cygwin, so dos - ;; shell quoting is probably wrong. - (not magit-cygwin-mount-points)) - "cmdproxy" - shell-file-name))) - (with-editor* magit-with-editor-envvar - ,@body))) - -(defmacro magit--with-temp-process-buffer (&rest body) - "Like `with-temp-buffer', but always propagate `process-environment'. -When that var is buffer-local in the calling buffer, it is not -propagated by `with-temp-buffer', so we explicitly ensure that -happens, so that processes will be invoked consistently. BODY is -as for that macro." - (declare (indent 0) (debug (body))) - (let ((p (cl-gensym))) - `(let ((,p process-environment)) - (with-temp-buffer - (setq-local process-environment ,p) - ,@body)))) - -(defsubst magit-git-executable () - "Return value of `magit-git-executable' or `magit-remote-git-executable'. -The variable is chosen depending on whether `default-directory' -is remote." - (if (file-remote-p default-directory) - magit-remote-git-executable - magit-git-executable)) - -(defun magit-process-git-arguments (args) - "Prepare ARGS for a function that invokes Git. - -Magit has many specialized functions for running Git; they all -pass arguments through this function before handing them to Git, -to do the following. - -* Flatten ARGS, removing nil arguments. -* Prepend `magit-git-global-arguments' to ARGS. -* On w32 systems, encode to `w32-ansi-code-page'." - (setq args (append magit-git-global-arguments (flatten-tree args))) - (if (and (eq system-type 'windows-nt) (boundp 'w32-ansi-code-page)) - ;; On w32, the process arguments *must* be encoded in the - ;; current code-page (see #3250). - (mapcar (lambda (arg) - (encode-coding-string - arg (intern (format "cp%d" w32-ansi-code-page)))) - args) - args)) - -(defun magit-git-exit-code (&rest args) - "Execute Git with ARGS, returning its exit code." - (magit-process-git nil args)) - -(defun magit-git-success (&rest args) - "Execute Git with ARGS, returning t if its exit code is 0." - (= (magit-git-exit-code args) 0)) - -(defun magit-git-failure (&rest args) - "Execute Git with ARGS, returning t if its exit code is 1." - (= (magit-git-exit-code args) 1)) - -(defun magit-git-string-p (&rest args) - "Execute Git with ARGS, returning the first line of its output. -If the exit code isn't zero or if there is no output, then return -nil. Neither of these results is considered an error; if that is -what you want, then use `magit-git-string-ng' instead. - -This is an experimental replacement for `magit-git-string', and -still subject to major changes." - (magit--with-refresh-cache (cons default-directory args) - (magit--with-temp-process-buffer - (and (zerop (magit-process-git t args)) - (not (bobp)) - (progn - (goto-char (point-min)) - (buffer-substring-no-properties (point) (line-end-position))))))) - -(defun magit-git-string-ng (&rest args) - "Execute Git with ARGS, returning the first line of its output. -If the exit code isn't zero or if there is no output, then that -is considered an error, but instead of actually signaling an -error, return nil. Additionally the output is put in the process -buffer (creating it if necessary) and the error message is shown -in the status buffer (provided it exists). - -This is an experimental replacement for `magit-git-string', and -still subject to major changes. Also see `magit-git-string-p'." - (magit--with-refresh-cache - (list default-directory 'magit-git-string-ng args) - (magit--with-temp-process-buffer - (let* ((args (magit-process-git-arguments args)) - (status (magit-process-git t args))) - (if (zerop status) - (and (not (bobp)) - (progn - (goto-char (point-min)) - (buffer-substring-no-properties - (point) (line-end-position)))) - (let ((buf (current-buffer))) - (with-current-buffer (magit-process-buffer t) - (magit-process-insert-section default-directory - magit-git-executable args - status buf))) - (when-let ((status-buf (magit-get-mode-buffer 'magit-status-mode))) - (let ((msg (magit--locate-error-message))) - (with-current-buffer status-buf - (setq magit-this-error msg)))) - nil))))) - -(defun magit-git-str (&rest args) - "Execute Git with ARGS, returning the first line of its output. -If there is no output, return nil. If the output begins with a -newline, return an empty string. Like `magit-git-string' but -ignore `magit-git-debug'." - (setq args (flatten-tree args)) - (magit--with-refresh-cache (cons default-directory args) - (magit--with-temp-process-buffer - (magit-process-git (list t nil) args) - (unless (bobp) - (goto-char (point-min)) - (buffer-substring-no-properties (point) (line-end-position)))))) - -(defun magit-git-output (&rest args) - "Execute Git with ARGS, returning its output." - (setq args (flatten-tree args)) - (magit--with-refresh-cache (cons default-directory args) - (magit--with-temp-process-buffer - (magit-process-git (list t nil) args) - (buffer-substring-no-properties (point-min) (point-max))))) - -(define-error 'magit-invalid-git-boolean "Not a Git boolean") - -(defun magit-git-true (&rest args) - "Execute Git with ARGS, returning t if it prints \"true\". -If it prints \"false\", then return nil. For any other output -signal `magit-invalid-git-boolean'." - (pcase (magit-git-output args) - ((or "true" "true\n") t) - ((or "false" "false\n") nil) - (output (signal 'magit-invalid-git-boolean (list output))))) - -(defun magit-git-false (&rest args) - "Execute Git with ARGS, returning t if it prints \"false\". -If it prints \"true\", then return nil. For any other output -signal `magit-invalid-git-boolean'." - (pcase (magit-git-output args) - ((or "true" "true\n") nil) - ((or "false" "false\n") t) - (output (signal 'magit-invalid-git-boolean (list output))))) - -(defun magit-git-config-p (variable &optional default) - "Return the boolean value of the Git variable VARIABLE. -VARIABLE has to be specified as a string. Return DEFAULT (which -defaults to nil) if VARIABLE is unset. If VARIABLE's value isn't -a boolean, then raise an error." - (let ((args (list "config" "--bool" "--default" (if default "true" "false") - variable))) - (magit--with-refresh-cache (cons default-directory args) - (magit--with-temp-process-buffer - (let ((status (magit-process-git t args)) - (output (buffer-substring (point-min) (1- (point-max))))) - (if (zerop status) - (equal output "true") - (signal 'magit-invalid-git-boolean (list output)))))))) - -(defun magit-git-insert (&rest args) - "Execute Git with ARGS, inserting its output at point. -If Git exits with a non-zero exit status, then show a message and -add a section in the respective process buffer." - (apply #'magit--git-insert nil args)) - -(defun magit--git-insert (return-error &rest args) - (setq args (magit-process-git-arguments args)) - (if (or return-error magit-git-debug) - (let (log) - (unwind-protect - (let (exit errmsg) - (setq log (make-temp-file "magit-stderr")) - (delete-file log) - (setq exit (magit-process-git (list t log) args)) - (when (> exit 0) - (when (file-exists-p log) - (with-temp-buffer - (insert-file-contents log) - (goto-char (point-max)) - (setq errmsg - (if (functionp magit-git-debug) - (funcall magit-git-debug (buffer-string)) - (magit--locate-error-message)))) - (unless return-error - (let ((magit-git-debug nil)) - (with-current-buffer (magit-process-buffer t) - (magit-process-insert-section default-directory - magit-git-executable - args exit log))))) - (unless return-error - (if errmsg - (message "%s" errmsg) - (message "Git returned with exit-code %s" exit)))) - (or errmsg exit)) - (ignore-errors (delete-file log)))) - (magit-process-git (list t nil) args))) - -(defun magit--locate-error-message () - (goto-char (point-max)) - (and (run-hook-wrapped 'magit-process-error-message-regexps - (lambda (re) (re-search-backward re nil t))) - (match-string-no-properties 1))) - -(defun magit-git-string (&rest args) - "Execute Git with ARGS, returning the first line of its output. -If there is no output, return nil. If the output begins with a -newline, return an empty string." - (setq args (flatten-tree args)) - (magit--with-refresh-cache (cons default-directory args) - (magit--with-temp-process-buffer - (apply #'magit-git-insert args) - (unless (bobp) - (goto-char (point-min)) - (buffer-substring-no-properties (point) (line-end-position)))))) - -(defun magit-git-lines (&rest args) - "Execute Git with ARGS, returning its output as a list of lines. -Empty lines anywhere in the output are omitted. - -If Git exits with a non-zero exit status, then report show a -message and add a section in the respective process buffer." - (magit--with-temp-process-buffer - (apply #'magit-git-insert args) - (split-string (buffer-string) "\n" t))) - -(defun magit-git-items (&rest args) - "Execute Git with ARGS, returning its null-separated output as a list. -Empty items anywhere in the output are omitted. - -If Git exits with a non-zero exit status, then report show a -message and add a section in the respective process buffer." - (magit--with-temp-process-buffer - (apply #'magit-git-insert args) - (split-string (buffer-string) "\0" t))) - -(defvar magit--git-wash-keep-error nil) ; experimental - -(defun magit-git-wash (washer &rest args) - "Execute Git with ARGS, inserting washed output at point. -Actually first insert the raw output at point. If there is no -output, call `magit-cancel-section'. Otherwise temporarily narrow -the buffer to the inserted text, move to its beginning, and then -call function WASHER with ARGS as its sole argument." - (declare (indent 1)) - (apply #'magit--git-wash washer magit--git-wash-keep-error args)) - -(defun magit--git-wash (washer keep-error &rest args) - (declare (indent 2)) - (setq args (flatten-tree args)) - (let ((beg (point)) - (exit (magit--git-insert keep-error args))) - (when (stringp exit) - (goto-char beg) - (insert (propertize exit 'face 'error)) - (unless (bolp) - (insert "\n"))) - (if (= (point) beg) - (magit-cancel-section) - (unless (bolp) - (insert "\n")) - (when (or (equal exit 0) - (eq keep-error 'wash-anyway)) - (save-restriction - (narrow-to-region beg (point)) - (goto-char beg) - (funcall washer args)) - (when (or (= (point) beg) - (= (point) (1+ beg))) - (magit-cancel-section)) - (magit-maybe-make-margin-overlay))) - exit)) - -(defun magit-git-executable-find (command) - "Search for COMMAND in Git's exec path, falling back to `exec-path'. -Like `executable-find', return the absolute file name of the -executable." - (or (locate-file command - (list (concat - (file-remote-p default-directory) - (or (magit-git-string "--exec-path") - (error "`git --exec-path' failed")))) - exec-suffixes - #'file-executable-p) - (compat-call executable-find command t))) - -;;; Git Version - -(defconst magit--git-version-regexp - "\\`git version \\([0-9]+\\(\\.[0-9]+\\)\\{1,2\\}\\)") - -(defvar magit--host-git-version-cache nil) - -(defun magit-git-version>= (n) - "Return t if `magit-git-version's value is greater than or equal to N." - (magit--version>= (magit-git-version) n)) - -(defun magit-git-version< (n) - "Return t if `magit-git-version's value is smaller than N." - (version< (magit-git-version) n)) - -(defun magit-git-version () - "Return the Git version used for `default-directory'. -Raise an error if Git cannot be found, if it exits with a -non-zero status, or the output does not have the expected -format." - (magit--with-refresh-cache default-directory - (let ((host (file-remote-p default-directory))) - (or (cdr (assoc host magit--host-git-version-cache)) - (magit--with-temp-process-buffer - ;; Unset global arguments for ancient Git versions. - (let* ((magit-git-global-arguments nil) - (status (magit-process-git t "version")) - (output (buffer-string))) - (cond - ((not (zerop status)) - (display-warning - 'magit - (format "%S\n\nRunning \"%s --version\" failed with output:\n\n%s" - (if host - (format "Magit cannot find Git on host %S.\n -Check the value of `magit-remote-git-executable' using -`magit-debug-git-executable' and consult the info node -`(tramp)Remote programs'." host) - "Magit cannot find Git.\n -Check the values of `magit-git-executable' and `exec-path' -using `magit-debug-git-executable'.") - (magit-git-executable) - output))) - ((save-match-data - (and (string-match magit--git-version-regexp output) - (let ((version (match-string 1 output))) - (push (cons host version) - magit--host-git-version-cache) - version)))) - ((error "Unexpected \"%s --version\" output: %S" - (magit-git-executable) - output))))))))) - -(defun magit-git-version-assert (&optional minimal who) - "Assert that the used Git version is greater than or equal to MINIMAL. -If optional MINIMAL is nil, compare with `magit--minimal-git' -instead. Optional WHO if non-nil specifies what functionality -needs at least MINIMAL, otherwise it defaults to \"Magit\"." - (when (magit-git-version< (or minimal magit--minimal-git)) - (let* ((host (file-remote-p default-directory)) - (msg (format-spec - (cond (host "\ -%w requires Git %m or greater, but on %h the version is %v. - -If multiple Git versions are installed on the host, then the -problem might be that TRAMP uses the wrong executable. - -Check the value of `magit-remote-git-executable' and consult -the info node `(tramp)Remote programs'.\n") - (t "\ -%w requires Git %m or greater, but you are using %v. - -If you have multiple Git versions installed, then check the -values of `magit-remote-git-executable' and `exec-path'.\n")) - `((?w . ,(or who "Magit")) - (?m . ,(or minimal magit--minimal-git)) - (?v . ,(magit-git-version)) - (?h . ,host))))) - (display-warning 'magit msg :error)))) - -(defun magit--safe-git-version () - "Return the Git version used for `default-directory' or an error message." - (magit--with-temp-process-buffer - (let* ((magit-git-global-arguments nil) - (status (magit-process-git t "version")) - (output (buffer-string))) - (cond ((not (zerop status)) output) - ((save-match-data - (and (string-match magit--git-version-regexp output) - (match-string 1 output)))) - (t output))))) - -(defun magit-debug-git-executable () - "Display a buffer with information about `magit-git-executable'. -Also include information about `magit-remote-git-executable'. -See info node `(magit)Debugging Tools' for more information." - (interactive) - (with-current-buffer (get-buffer-create "*magit-git-debug*") - (pop-to-buffer (current-buffer)) - (erase-buffer) - (insert (format "magit-remote-git-executable: %S\n" - magit-remote-git-executable)) - (insert (concat - (format "magit-git-executable: %S" magit-git-executable) - (and (not (file-name-absolute-p magit-git-executable)) - (format " [%S]" (executable-find magit-git-executable))) - (format " (%s)\n" (magit--safe-git-version)))) - (insert (format "exec-path: %S\n" exec-path)) - (when-let ((diff (cl-set-difference - (seq-filter #'file-exists-p (remq nil (parse-colon-path - (getenv "PATH")))) - (seq-filter #'file-exists-p (remq nil exec-path)) - :test #'file-equal-p))) - (insert (format " entries in PATH, but not in exec-path: %S\n" diff))) - (dolist (execdir exec-path) - (insert (format " %s (%s)\n" execdir (car (file-attributes execdir)))) - (when (file-directory-p execdir) - (dolist (exec (directory-files - execdir t (concat - "\\`git" (regexp-opt exec-suffixes) "\\'"))) - (insert (format " %s (%s)\n" exec - (magit--safe-git-version)))))))) - -;;; Variables - -(defun magit-config-get-from-cached-list (key) - (gethash - ;; `git config --list' downcases first and last components of the key. - (let* ((key (replace-regexp-in-string "\\`[^.]+" #'downcase key t t)) - (key (replace-regexp-in-string "[^.]+\\'" #'downcase key t t))) - key) - (magit--with-refresh-cache (cons (magit-toplevel) 'config) - (let ((configs (make-hash-table :test #'equal))) - (dolist (conf (magit-git-items "config" "--list" "-z")) - (let* ((nl-pos (cl-position ?\n conf)) - (key (substring conf 0 nl-pos)) - (val (if nl-pos (substring conf (1+ nl-pos)) ""))) - (puthash key (nconc (gethash key configs) (list val)) configs))) - configs)))) - -(defun magit-get (&rest keys) - "Return the value of the Git variable specified by KEYS." - (car (last (apply #'magit-get-all keys)))) - -(defun magit-get-all (&rest keys) - "Return all values of the Git variable specified by KEYS." - (let ((magit-git-debug nil) - (arg (and (or (null (car keys)) - (string-prefix-p "--" (car keys))) - (pop keys))) - (key (mapconcat #'identity keys "."))) - (if (and magit--refresh-cache (not arg)) - (magit-config-get-from-cached-list key) - (magit-git-items "config" arg "-z" "--get-all" key)))) - -(defun magit-get-boolean (&rest keys) - "Return the boolean value of the Git variable specified by KEYS. -Also see `magit-git-config-p'." - (let ((arg (and (or (null (car keys)) - (string-prefix-p "--" (car keys))) - (pop keys))) - (key (mapconcat #'identity keys "."))) - (equal (if magit--refresh-cache - (car (last (magit-config-get-from-cached-list key))) - (magit-git-str "config" arg "--bool" key)) - "true"))) - -(defun magit-set (value &rest keys) - "Set the value of the Git variable specified by KEYS to VALUE." - (let ((arg (and (or (null (car keys)) - (string-prefix-p "--" (car keys))) - (pop keys))) - (key (mapconcat #'identity keys "."))) - (if value - (magit-git-success "config" arg key value) - (magit-git-success "config" arg "--unset" key)) - value)) - -(gv-define-setter magit-get (val &rest keys) - `(magit-set ,val ,@keys)) - -(defun magit-set-all (values &rest keys) - "Set all values of the Git variable specified by KEYS to VALUES." - (let ((arg (and (or (null (car keys)) - (string-prefix-p "--" (car keys))) - (pop keys))) - (var (mapconcat #'identity keys "."))) - (when (magit-get var) - (magit-call-git "config" arg "--unset-all" var)) - (dolist (v values) - (magit-call-git "config" arg "--add" var v)))) - -;;; Files - -(defun magit--safe-default-directory (&optional file) - (catch 'unsafe-default-dir - (let ((dir (file-name-as-directory - (expand-file-name (or file default-directory)))) - (previous nil)) - (while (not (file-accessible-directory-p dir)) - (setq dir (file-name-directory (directory-file-name dir))) - (when (equal dir previous) - (throw 'unsafe-default-dir nil)) - (setq previous dir)) - dir))) - -(defmacro magit--with-safe-default-directory (file &rest body) - (declare (indent 1) (debug (form body))) - `(when-let ((default-directory (magit--safe-default-directory ,file))) - ,@body)) - -(defun magit-git-dir (&optional path) - "Like (expand-file-name PATH (magit-gitdir)) or just (magit-gitdir)." - (declare (obsolete 'magit-gitdir "Magit 4.0.0")) - (and-let* ((dir (magit-gitdir))) - (if path - (expand-file-name (convert-standard-filename path) dir) - dir))) - -(defun magit-gitdir (&optional directory) - "Return the absolute and resolved path of the .git directory. - -If the `GIT_DIR' environment variable is defined, return that. -Otherwise return the .git directory for DIRECTORY, or if that is -nil, then for `default-directory' instead. If the directory is -not located inside a Git repository, then return nil." - (let ((default-directory (or directory default-directory))) - (magit--with-refresh-cache (list default-directory 'magit-gitdir) - (magit--with-safe-default-directory nil - (and-let* - ((dir (magit-rev-parse-safe "--git-dir")) - (dir (file-name-as-directory (magit-expand-git-file-name dir)))) - (if (file-remote-p dir) - dir - (concat (file-remote-p default-directory) dir))))))) - -(defvar magit--separated-gitdirs nil) - -(defun magit--record-separated-gitdir () - (let ((topdir (magit-toplevel)) - (gitdir (magit-gitdir))) - ;; Kludge: git-annex converts submodule gitdirs to symlinks. See #3599. - (when (file-symlink-p (directory-file-name gitdir)) - (setq gitdir (file-truename gitdir))) - ;; We want to delete the entry for `topdir' here, rather than within - ;; (unless ...), in case a `--separate-git-dir' repository was switched to - ;; the standard structure (i.e., "topdir/.git/"). - (setq magit--separated-gitdirs (cl-delete topdir - magit--separated-gitdirs - :key #'car :test #'equal)) - (unless (equal (file-name-as-directory (expand-file-name ".git" topdir)) - gitdir) - (push (cons topdir gitdir) magit--separated-gitdirs)))) - -(defun magit-toplevel (&optional directory) - "Return the absolute path to the toplevel of the current repository. - -From within the working tree or control directory of a repository -return the absolute path to the toplevel directory of the working -tree. As a special case, from within a bare repository return -the control directory instead. When called outside a repository -then return nil. - -When optional DIRECTORY is non-nil then return the toplevel for -that directory instead of the one for `default-directory'. - -Try to respect the option `find-file-visit-truename', i.e., when -the value of that option is nil, then avoid needlessly returning -the truename. When a symlink to a sub-directory of the working -tree is involved, or when called from within a sub-directory of -the gitdir or from the toplevel of a gitdir, which itself is not -located within the working tree, then it is not possible to avoid -returning the truename." - (or - (magit--with-refresh-cache - (cons (or directory default-directory) 'magit-toplevel) - (magit--with-safe-default-directory directory - (if-let ((topdir (magit-rev-parse-safe "--show-toplevel"))) - (let (updir) - (setq topdir (magit-expand-git-file-name topdir)) - (cond - ((and - ;; Always honor these settings. - (not find-file-visit-truename) - (not (getenv "GIT_WORK_TREE")) - ;; `--show-cdup' is the relative path to the toplevel - ;; from `(file-truename default-directory)'. Here we - ;; pretend it is relative to `default-directory', and - ;; go to that directory. Then we check whether - ;; `--show-toplevel' still returns the same value and - ;; whether `--show-cdup' now is the empty string. If - ;; both is the case, then we are at the toplevel of - ;; the same working tree, but also avoided needlessly - ;; following any symlinks. - (progn - (setq updir (file-name-as-directory - (magit-rev-parse-safe "--show-cdup"))) - (setq updir (if (file-name-absolute-p updir) - (concat (file-remote-p default-directory) - updir) - (expand-file-name updir))) - (and-let* - ((default-directory updir) - (top (and (string-equal - (magit-rev-parse-safe "--show-cdup") "") - (magit-rev-parse-safe "--show-toplevel")))) - (string-equal (magit-expand-git-file-name top) topdir)))) - updir) - ((concat (file-remote-p default-directory) - (file-name-as-directory topdir))))) - (and-let* ((gitdir (magit-rev-parse-safe "--git-dir")) - (gitdir (file-name-as-directory - (if (file-name-absolute-p gitdir) - ;; We might have followed a symlink. - (concat (file-remote-p default-directory) - (magit-expand-git-file-name gitdir)) - (expand-file-name gitdir))))) - (if (magit-bare-repo-p) - gitdir - (let* ((link (expand-file-name "gitdir" gitdir)) - (wtree (and (file-exists-p link) - (magit-file-line link)))) - (cond - ((and wtree - ;; Ignore .git/gitdir files that result from a - ;; Git bug. See #2364. - (not (equal wtree ".git"))) - ;; Return the linked working tree. - (concat (file-remote-p default-directory) - (file-name-directory wtree))) - ;; The working directory may not be the parent - ;; directory of .git if it was set up with - ;; "git init --separate-git-dir". See #2955. - ((car (rassoc gitdir magit--separated-gitdirs))) - (;; Step outside the control directory to enter the - ;; working tree. - (file-name-directory (directory-file-name gitdir)))))))))))) - -(defun magit--toplevel-safe () - (or (magit-toplevel) - (magit--not-inside-repository-error))) - -(defmacro magit-with-toplevel (&rest body) - (declare (indent defun) (debug (body))) - `(let ((default-directory (magit--toplevel-safe))) - ,@body)) - -(define-error 'magit-outside-git-repo "Not inside Git repository") -(define-error 'magit-corrupt-git-config "Corrupt Git configuration") -(define-error 'magit-git-executable-not-found - "Git executable cannot be found (see https://magit.vc/goto/e6a78ed2)") - -(defun magit--assert-usable-git () - (if (not (compat-call executable-find (magit-git-executable) t)) - (signal 'magit-git-executable-not-found (magit-git-executable)) - (let ((magit-git-debug - (lambda (err) - (signal 'magit-corrupt-git-config - (format "%s: %s" default-directory err))))) - ;; This should always succeed unless there's a corrupt config - ;; (or at least a similarly severe failing state). Note that - ;; git-config's --default is avoided because it's not available - ;; until Git 2.18. - (magit-git-string "config" "--get-color" "" "reset")) - nil)) - -(defun magit--not-inside-repository-error () - (magit--assert-usable-git) - (signal 'magit-outside-git-repo default-directory)) - -(defun magit-inside-gitdir-p (&optional noerror) - "Return t if `default-directory' is below the repository directory. -If it is below the working directory, then return nil. -If it isn't below either, then signal an error unless NOERROR -is non-nil, in which case return nil." - (and (magit--assert-default-directory noerror) - ;; Below a repository directory that is not located below the - ;; working directory "git rev-parse --is-inside-git-dir" prints - ;; "false", which is wrong. - (let ((gitdir (magit-gitdir))) - (cond (gitdir (file-in-directory-p default-directory gitdir)) - (noerror nil) - ((signal 'magit-outside-git-repo default-directory)))))) - -(defun magit-inside-worktree-p (&optional noerror) - "Return t if `default-directory' is below the working directory. -If it is below the repository directory, then return nil. -If it isn't below either, then signal an error unless NOERROR -is non-nil, in which case return nil." - (and (magit--assert-default-directory noerror) - (condition-case nil - (magit-rev-parse-true "--is-inside-work-tree") - (magit-invalid-git-boolean - (and (not noerror) - (signal 'magit-outside-git-repo default-directory)))))) - -(cl-defgeneric magit-bare-repo-p (&optional noerror) - "Return t if the current repository is bare. -If it is non-bare, then return nil. If `default-directory' -isn't below a Git repository, then signal an error unless -NOERROR is non-nil, in which case return nil." - (and (magit--assert-default-directory noerror) - (condition-case nil - (magit-rev-parse-true "--is-bare-repository") - (magit-invalid-git-boolean - (and (not noerror) - (signal 'magit-outside-git-repo default-directory)))))) - -(defun magit--assert-default-directory (&optional noerror) - (or (file-directory-p default-directory) - (and (not noerror) - (let ((exists (file-exists-p default-directory))) - (signal (if exists 'file-error 'file-missing) - (list "Running git in directory" - (if exists - "Not a directory" - "No such file or directory") - default-directory)))))) - -(defun magit-git-repo-p (directory &optional non-bare) - "Return t if DIRECTORY is a Git repository. -When optional NON-BARE is non-nil also return nil if DIRECTORY is -a bare repository." - (and (file-directory-p directory) ; Avoid archives, see #3397. - (or (file-regular-p (expand-file-name ".git" directory)) - (file-directory-p (expand-file-name ".git" directory)) - (and (not non-bare) - (file-regular-p (expand-file-name "HEAD" directory)) - (file-directory-p (expand-file-name "refs" directory)) - (file-directory-p (expand-file-name "objects" directory)))))) - -(defun magit-file-relative-name (&optional file tracked) - "Return the path of FILE relative to the repository root. - -If optional FILE is nil or omitted, return the relative path of -the file being visited in the current buffer, if any, else nil. -If the file is not inside a Git repository, then return nil. - -If TRACKED is non-nil, return the path only if it matches a -tracked file." - (unless file - (with-current-buffer (or (buffer-base-buffer) - (current-buffer)) - (setq file (or magit-buffer-file-name buffer-file-name - (and (derived-mode-p 'dired-mode) default-directory))))) - (when (and file (or (not tracked) - (magit-file-tracked-p (file-relative-name file)))) - (and-let* ((dir (magit-toplevel - (magit--safe-default-directory - (directory-file-name (file-name-directory file)))))) - (file-relative-name file dir)))) - -(defun magit-file-ignored-p (file) - (magit-git-string-p "ls-files" "--others" "--ignored" "--exclude-standard" - "--" (magit-convert-filename-for-git file))) - -(defun magit-file-tracked-p (file) - (magit-git-success "ls-files" "--error-unmatch" - "--" (magit-convert-filename-for-git file))) - -(defun magit-list-files (&rest args) - (apply #'magit-git-items "ls-files" "-z" "--full-name" args)) - -(defun magit-tracked-files () - (magit-list-files "--cached")) - -(defun magit-untracked-files (&optional all files) - (magit-list-files "--other" - (and (not all) "--exclude-standard") - "--" files)) - -(defun magit-modified-files (&optional nomodules files) - (magit-git-items "diff-index" "-z" "--name-only" - (and nomodules "--ignore-submodules") - (magit-headish) "--" files)) - -(defun magit-unstaged-files (&optional nomodules files) - (magit-git-items "diff-files" "-z" "--name-only" "--diff-filter=u" - (and nomodules "--ignore-submodules") - "--" files)) - -(defun magit-staged-files (&optional nomodules files) - (magit-git-items "diff-index" "-z" "--name-only" "--cached" - (and nomodules "--ignore-submodules") - (magit-headish) "--" files)) - -(defun magit-binary-files (&rest args) - (--mapcat (and (string-match "^-\t-\t\\(.+\\)" it) - (list (match-string 1 it))) - (apply #'magit-git-items - "diff" "-z" "--numstat" "--ignore-submodules" - args))) - -(defun magit-unmerged-files () - (magit-git-items "diff-files" "-z" "--name-only" "--diff-filter=U")) - -(defun magit-ignored-files () - (magit-git-items "ls-files" "-z" "--others" "--ignored" - "--exclude-standard" "--directory")) - -(defun magit-stashed-files (stash) - (magit-git-items "stash" "show" "-z" "--name-only" stash)) - -(defun magit-skip-worktree-files () - (--keep (and (= (aref it 0) ?S) - (substring it 2)) - (magit-list-files "-t"))) - -(defun magit-assume-unchanged-files () - (--keep (and (memq (aref it 0) '(?h ?s ?m ?r ?c ?k)) - (substring it 2)) - (magit-list-files "-v"))) - -(defun magit-revision-files (rev) - (magit-with-toplevel - (magit-git-items "ls-tree" "-z" "-r" "--name-only" rev))) - -(defun magit-revision-directories (rev) - "List directories that contain a tracked file in revision REV." - (magit-with-toplevel - (mapcar #'file-name-as-directory - (magit-git-items "ls-tree" "-z" "-r" "-d" "--name-only" rev)))) - -(defun magit-changed-files (rev-or-range &optional other-rev) - "Return list of files the have changed between two revisions. -If OTHER-REV is non-nil, REV-OR-RANGE should be a revision, not a -range. Otherwise, it can be any revision or range accepted by -\"git diff\" (i.e., <rev>, <revA>..<revB>, or <revA>...<revB>)." - (magit-with-toplevel - (magit-git-items "diff" "-z" "--name-only" rev-or-range other-rev))) - -(defun magit-renamed-files (revA revB) - (mapcar (pcase-lambda (`(,_status ,fileA ,fileB)) - (cons fileA fileB)) - (seq-partition (magit-git-items "diff" "-z" "--name-status" - "--find-renames" - "--diff-filter=R" revA revB) - 3))) - -(defun magit--rev-file-name (file rev other-rev) - "For FILE, potentially renamed between REV and OTHER-REV, return name in REV. -Return nil, if FILE appears neither in REV nor OTHER-REV, -or if no rename is detected." - (or (car (member file (magit-revision-files rev))) - (and-let* ((renamed (magit-renamed-files rev other-rev))) - (car (rassoc file renamed))))) - -(defun magit-file-status (&rest args) - (magit--with-temp-process-buffer - (save-excursion (magit-git-insert "status" "-z" args)) - (let ((pos (point)) status) - (while (> (skip-chars-forward "[:print:]") 0) - (let ((x (char-after pos)) - (y (char-after (1+ pos))) - (file (buffer-substring (+ pos 3) (point)))) - (forward-char) - (if (memq x '(?R ?C)) - (progn - (setq pos (point)) - (skip-chars-forward "[:print:]") - (push (list file (buffer-substring pos (point)) x y) status) - (forward-char)) - (push (list file nil x y) status))) - (setq pos (point))) - status))) - -(defcustom magit-cygwin-mount-points - (and (eq system-type 'windows-nt) - (cl-sort (--map (if (string-match "^\\(.*\\) on \\(.*\\) type" it) - (cons (file-name-as-directory (match-string 2 it)) - (file-name-as-directory (match-string 1 it))) - (lwarn '(magit) :error - "Failed to parse Cygwin mount: %S" it)) - ;; If --exec-path is not a native Windows path, - ;; then we probably have a cygwin git. - (let ((process-environment - (append magit-git-environment - process-environment))) - (and (not (string-match-p - "\\`[a-zA-Z]:" - (car (process-lines - magit-git-executable "--exec-path")))) - (ignore-errors (process-lines "mount"))))) - #'> :key (pcase-lambda (`(,cyg . ,_win)) (length cyg)))) - "Alist of (CYGWIN . WIN32) directory names. -Sorted from longest to shortest CYGWIN name." - :package-version '(magit . "2.3.0") - :group 'magit-process - :type '(alist :key-type string :value-type directory)) - -(defun magit-expand-git-file-name (filename) - (unless (file-name-absolute-p filename) - (setq filename (expand-file-name filename))) - (if-let ((cyg:win (and (not (file-remote-p default-directory)) ; see #4976 - (cl-assoc filename magit-cygwin-mount-points - :test (lambda (f cyg) (string-prefix-p cyg f)))))) - (concat (cdr cyg:win) - (substring filename (length (car cyg:win)))) - filename)) - -(defun magit-convert-filename-for-git (filename) - "Convert FILENAME so that it can be passed to git. -1. If it is a absolute filename, then pass it through - `expand-file-name' to replace things such as \"~/\" that - Git does not understand. -2. If it is a remote filename, then remove the remote part. -3. Deal with an `windows-nt' Emacs vs. Cygwin Git incompatibility." - (if (file-name-absolute-p filename) - (if-let ((cyg:win (cl-rassoc filename magit-cygwin-mount-points - :test (lambda (f win) (string-prefix-p win f))))) - (concat (car cyg:win) - (substring filename (length (cdr cyg:win)))) - (let ((expanded (expand-file-name filename))) - (or (file-remote-p expanded 'localname) - expanded))) - filename)) - -(defun magit-decode-git-path (path) - (if (eq (aref path 0) ?\") - (decode-coding-string (read path) - (or magit-git-output-coding-system - (car default-process-coding-system)) - t) - path)) - -(defun magit-file-at-point (&optional expand assert) - (if-let ((file (magit-section-case - (file (oref it value)) - (hunk (magit-section-parent-value it))))) - (if expand - (expand-file-name file (magit-toplevel)) - file) - (when assert - (user-error "No file at point")))) - -(defun magit-current-file () - (or (magit-file-relative-name) - (magit-file-at-point) - (and (derived-mode-p 'magit-log-mode) - (car magit-buffer-log-files)))) - -;;; Predicates - -(defun magit-no-commit-p () - "Return t if there is no commit in the current Git repository." - (not (magit-rev-verify "HEAD"))) - -(defun magit-merge-commit-p (commit) - "Return t if COMMIT is a merge commit." - (length> (magit-commit-parents commit) 1)) - -(defun magit-anything-staged-p (&optional ignore-submodules &rest files) - "Return t if there are any staged changes. -If optional FILES is non-nil, then only changes to those files -are considered." - (magit-git-failure "diff" "--quiet" "--cached" - (and ignore-submodules "--ignore-submodules") - "--" files)) - -(defun magit-anything-unstaged-p (&optional ignore-submodules &rest files) - "Return t if there are any unstaged changes. -If optional FILES is non-nil, then only changes to those files -are considered." - (magit-git-failure "diff" "--quiet" - (and ignore-submodules "--ignore-submodules") - "--" files)) - -(defun magit-anything-modified-p (&optional ignore-submodules &rest files) - "Return t if there are any staged or unstaged changes. -If optional FILES is non-nil, then only changes to those files -are considered." - (or (apply #'magit-anything-staged-p ignore-submodules files) - (apply #'magit-anything-unstaged-p ignore-submodules files))) - -(defun magit-anything-unmerged-p (&rest files) - "Return t if there are any merge conflicts. -If optional FILES is non-nil, then only conflicts in those files -are considered." - (and (magit-git-string "ls-files" "--unmerged" files) t)) - -(defun magit-module-worktree-p (module) - (magit-with-toplevel - (file-exists-p (expand-file-name ".git" module)))) - -(defun magit-module-no-worktree-p (module) - (not (magit-module-worktree-p module))) - -(defun magit-ignore-submodules-p (&optional return-argument) - (or (cl-find-if (lambda (arg) - (string-prefix-p "--ignore-submodules" arg)) - magit-buffer-diff-args) - (and-let* ((value (magit-get "diff.ignoreSubmodules"))) - (if return-argument - (concat "--ignore-submodules=" value) - (concat "diff.ignoreSubmodules=" value))))) - -;;; Revisions and References - -(defun magit-rev-parse (&rest args) - "Execute `git rev-parse ARGS', returning first line of output. -If there is no output, return nil." - (apply #'magit-git-string "rev-parse" args)) - -(defun magit-rev-parse-safe (&rest args) - "Execute `git rev-parse ARGS', returning first line of output. -If there is no output, return nil. Like `magit-rev-parse' but -ignore `magit-git-debug'." - (apply #'magit-git-str "rev-parse" args)) - -(defun magit-rev-parse-true (&rest args) - "Execute `git rev-parse ARGS', returning t if it prints \"true\". -If it prints \"false\", then return nil. For any other output -signal an error." - (magit-git-true "rev-parse" args)) - -(defun magit-rev-parse-false (&rest args) - "Execute `git rev-parse ARGS', returning t if it prints \"false\". -If it prints \"true\", then return nil. For any other output -signal an error." - (magit-git-false "rev-parse" args)) - -(defun magit-rev-parse-p (&rest args) - "Execute `git rev-parse ARGS', returning t if it prints \"true\". -Return t if the first (and usually only) output line is the -string \"true\", otherwise return nil." - (equal (magit-git-str "rev-parse" args) "true")) - -(defun magit-rev-verify (rev) - (magit-git-string-p "rev-parse" "--verify" rev)) - -(defun magit-commit-p (rev) - "Return full hash for REV if it names an existing commit." - (magit-rev-verify (magit--rev-dereference rev))) - -(defalias 'magit-rev-verify-commit #'magit-commit-p) - -(defalias 'magit-rev-hash #'magit-commit-p) - -(defun magit--rev-dereference (rev) - "Return a rev that forces Git to interpret REV as a commit. -If REV is nil or has the form \":/TEXT\", return REV itself." - (cond ((not rev) nil) - ((string-match-p "^:/" rev) rev) - ((concat rev "^{commit}")))) - -(defun magit-rev-equal (a b) - "Return t if there are no differences between the commits A and B." - (magit-git-success "diff" "--quiet" a b)) - -(defun magit-rev-eq (a b) - "Return t if A and B refer to the same commit." - (let ((a (magit-commit-p a)) - (b (magit-commit-p b))) - (and a b (equal a b)))) - -(defun magit-rev-ancestor-p (a b) - "Return non-nil if commit A is an ancestor of commit B." - (magit-git-success "merge-base" "--is-ancestor" a b)) - -(defun magit-rev-head-p (rev) - (or (equal rev "HEAD") - (and rev - (not (string-search ".." rev)) - (equal (magit-rev-parse rev) - (magit-rev-parse "HEAD"))))) - -(defun magit-rev-author-p (rev) - "Return t if the user is the author of REV. -More precisely return t if `user.name' is equal to the author -name of REV and/or `user.email' is equal to the author email -of REV." - (or (equal (magit-get "user.name") (magit-rev-format "%an" rev)) - (equal (magit-get "user.email") (magit-rev-format "%ae" rev)))) - -(defun magit-rev-name (rev &optional pattern not-anchored) - "Return a symbolic name for REV using `git-name-rev'. - -PATTERN can be used to limit the result to a matching ref. -Unless NOT-ANCHORED is non-nil, the beginning of the ref must -match PATTERN. - -An anchored lookup is done using the arguments -\"--exclude=*/<PATTERN> --exclude=*/HEAD\" in addition to -\"--refs=<PATTERN>\", provided at least version v2.13 of Git is -used. Older versions did not support the \"--exclude\" argument. -When \"--exclude\" cannot be used and `git-name-rev' returns a -ref that should have been excluded, then that is discarded and -this function returns nil instead. This is unfortunate because -there might be other refs that do match. To fix that, update -Git." - (if (magit-git-version< "2.13") - (and-let* - ((ref (magit-git-string "name-rev" "--name-only" "--no-undefined" - (and pattern (concat "--refs=" pattern)) - rev))) - (if (and pattern - (string-match-p "\\`refs/[^/]+/\\*\\'" pattern)) - (let ((namespace (substring pattern 0 -1))) - (and (not (or (string-suffix-p "HEAD" ref) - (and (string-match-p namespace ref) - (not (magit-rev-verify - (concat namespace ref)))))) - ref)) - ref)) - (magit-git-string "name-rev" "--name-only" "--no-undefined" - (and pattern (concat "--refs=" pattern)) - (and pattern - (not not-anchored) - (list "--exclude=*/HEAD" - (concat "--exclude=*/" pattern))) - rev))) - -(defun magit-rev-branch (rev) - (and-let* ((name (magit-rev-name rev "refs/heads/*"))) - (and (not (string-match-p "[~^]" name)) name))) - -(defun magit-rev-fixup-target (rev) - (let ((msg (magit-rev-format "%s" rev))) - (save-match-data - (and (string-match "\\`\\(fixup\\|squash\\)! \\(.+\\)" msg) - (magit-rev-format - "%h" (format "%s^{/^%s}" rev - (magit--ext-regexp-quote (match-string 2 msg)))))))) - -(defun magit-get-shortname (rev) - (let* ((fn (apply-partially #'magit-rev-name rev)) - (name (or (funcall fn "refs/tags/*") - (funcall fn "refs/heads/*") - (funcall fn "refs/remotes/*")))) - (cond ((not name) - (magit-rev-parse "--short" rev)) - ((string-match "^\\(?:tags\\|remotes\\)/\\(.+\\)" name) - (if (magit-ref-ambiguous-p (match-string 1 name)) - name - (match-string 1 name))) - ((magit-ref-maybe-qualify name))))) - -(defun magit-name-branch (rev &optional lax) - (or (magit-name-local-branch rev) - (magit-name-remote-branch rev) - (and lax (or (magit-name-local-branch rev t) - (magit-name-remote-branch rev t))))) - -(defun magit-name-local-branch (rev &optional lax) - (and-let* ((name (magit-rev-name rev "refs/heads/*"))) - (and (or lax (not (string-match-p "[~^]" name))) name))) - -(defun magit-name-remote-branch (rev &optional lax) - (and-let* ((name (magit-rev-name rev "refs/remotes/*"))) - (and (or lax (not (string-match-p "[~^]" name))) - (substring name 8)))) - -(defun magit-name-tag (rev &optional lax) - (and-let* ((name (magit-rev-name rev "refs/tags/*"))) - ;; The progn is necessary to work around debbugs#31840. This, and all - ;; the other instances, can be removed once we require at least Emacs 27. - (progn - (when (string-suffix-p "^0" name) - (setq name (substring name 0 -2))) - (and (or lax (not (string-match-p "[~^]" name))) - (substring name 5))))) - -(defun magit-ref-abbrev (refname) - "Return an unambiguous abbreviation of REFNAME." - (magit-rev-parse "--verify" "--abbrev-ref" refname)) - -(defun magit-ref-fullname (refname) - "Return fully qualified refname for REFNAME. -If REFNAME is ambiguous, return nil." - (magit-rev-parse "--verify" "--symbolic-full-name" refname)) - -(defun magit-ref-ambiguous-p (refname) - (save-match-data - (if (string-match "\\`\\([^^~]+\\)\\(.*\\)" refname) - (not (magit-ref-fullname (match-string 1 refname))) - (error "%S has an unrecognized format" refname)))) - -(defun magit-ref-maybe-qualify (refname &optional prefix) - "If REFNAME is ambiguous, try to disambiguate it by prepend PREFIX to it. -Return an unambiguous refname, either REFNAME or that prefixed -with PREFIX, nil otherwise. If REFNAME has an offset suffix -such as \"~1\", then that is preserved. If optional PREFIX is -nil, then use \"heads/\". " - (if (magit-ref-ambiguous-p refname) - (let ((refname (concat (or prefix "heads/") refname))) - (and (not (magit-ref-ambiguous-p refname)) refname)) - refname)) - -(defun magit-ref-exists-p (ref) - (magit-git-success "show-ref" "--verify" ref)) - -(defun magit-ref-equal (a b) - "Return t if the refnames A and B are `equal'. -A symbolic-ref pointing to some ref, is `equal' to that ref, -as are two symbolic-refs pointing to the same ref. Refnames -may be abbreviated." - (let ((a (magit-ref-fullname a)) - (b (magit-ref-fullname b))) - (and a b (equal a b)))) - -(defun magit-ref-eq (a b) - "Return t if the refnames A and B are `eq'. -A symbolic-ref is `eq' to itself, but not to the ref it points -to, or to some other symbolic-ref that points to the same ref." - (let ((symbolic-a (magit-symbolic-ref-p a)) - (symbolic-b (magit-symbolic-ref-p b))) - (or (and symbolic-a - symbolic-b - (equal a b)) - (and (not symbolic-a) - (not symbolic-b) - (magit-ref-equal a b))))) - -(defun magit-headish () - "Return the `HEAD' or if that doesn't exist the hash of the empty tree." - (if (magit-no-commit-p) - (magit-git-string "mktree") - "HEAD")) - -(defun magit-branch-at-point () - (magit-section-case - (branch (oref it value)) - (commit (or (magit--painted-branch-at-point) - (magit-name-branch (oref it value)))))) - -(defun magit--painted-branch-at-point (&optional type) - (or (and (not (eq type 'remote)) - (memq (get-text-property (magit-point) 'font-lock-face) - (list 'magit-branch-local - 'magit-branch-current)) - (and-let* ((branch (magit-thing-at-point 'git-revision t))) - (cdr (magit-split-branch-name branch)))) - (and (not (eq type 'local)) - (memq (get-text-property (magit-point) 'font-lock-face) - (list 'magit-branch-remote - 'magit-branch-remote-head)) - (thing-at-point 'git-revision t)))) - -(defun magit-local-branch-at-point () - (magit-section-case - (branch (let ((branch (magit-ref-maybe-qualify (oref it value)))) - (when (member branch (magit-list-local-branch-names)) - branch))) - (commit (or (magit--painted-branch-at-point 'local) - (magit-name-local-branch (oref it value)))))) - -(defun magit-remote-branch-at-point () - (magit-section-case - (branch (let ((branch (oref it value))) - (when (member branch (magit-list-remote-branch-names)) - branch))) - (commit (or (magit--painted-branch-at-point 'remote) - (magit-name-remote-branch (oref it value)))))) - -(defun magit-commit-at-point () - (or (magit-section-value-if 'commit) - (magit-thing-at-point 'git-revision t) - (and-let* ((chunk (and (bound-and-true-p magit-blame-mode) - (fboundp 'magit-current-blame-chunk) - (magit-current-blame-chunk)))) - (oref chunk orig-rev)) - (and (derived-mode-p 'magit-stash-mode - 'magit-merge-preview-mode - 'magit-revision-mode) - magit-buffer-revision))) - -(defun magit-branch-or-commit-at-point () - (or (magit-section-case - (branch (magit-ref-maybe-qualify (oref it value))) - (commit (or (magit--painted-branch-at-point) - (let ((rev (oref it value))) - (or (magit-name-branch rev) rev)))) - (tag (magit-ref-maybe-qualify (oref it value) "tags/")) - (pullreq (or (and (fboundp 'forge--pullreq-branch) - (magit-branch-p - (forge--pullreq-branch (oref it value)))) - (magit-ref-p (format "refs/pullreqs/%s" - (oref (oref it value) number))))) - ((unpulled unpushed) - (magit-ref-abbrev - (replace-regexp-in-string "\\.\\.\\.?" "" (oref it value))))) - (magit-thing-at-point 'git-revision t) - (and-let* ((chunk (and (bound-and-true-p magit-blame-mode) - (fboundp 'magit-current-blame-chunk) - (magit-current-blame-chunk)))) - (oref chunk orig-rev)) - (and magit-buffer-file-name - magit-buffer-refname) - (and (derived-mode-p 'magit-stash-mode - 'magit-merge-preview-mode - 'magit-revision-mode) - magit-buffer-revision))) - -(defun magit-tag-at-point () - (magit-section-case - (tag (oref it value)) - (commit (magit-name-tag (oref it value))))) - -(defun magit-stash-at-point () - (magit-section-value-if 'stash)) - -(defun magit-remote-at-point () - (magit-section-case - (remote (oref it value)) - ([branch remote] (magit-section-parent-value it)))) - -(defun magit-module-at-point (&optional predicate) - (when (magit-section-match 'module) - (let ((module (oref (magit-current-section) value))) - (and (or (not predicate) - (funcall predicate module)) - module)))) - -(defun magit-get-current-branch () - "Return the refname of the currently checked out branch. -Return nil if no branch is currently checked out." - (magit-git-string "symbolic-ref" "--short" "HEAD")) - -(defvar magit-get-previous-branch-timeout 0.5 - "Maximum time to spend in `magit-get-previous-branch'. -Given as a number of seconds.") - -(defun magit-get-previous-branch () - "Return the refname of the previously checked out branch. -Return nil if no branch can be found in the `HEAD' reflog -which is different from the current branch and still exists. -The amount of time spent searching is limited by -`magit-get-previous-branch-timeout'." - (let ((t0 (float-time)) - (current (magit-get-current-branch)) - (i 1) prev) - (while (if (> (- (float-time) t0) magit-get-previous-branch-timeout) - (setq prev nil) ;; Timed out. - (and (setq prev (magit-rev-verify (format "@{-%d}" i))) - (or (not (setq prev (magit-rev-branch prev))) - (equal prev current)))) - (cl-incf i)) - prev)) - -(defun magit--set-default-branch (newname oldname) - (let ((remote (or (magit-primary-remote) - (user-error "Cannot determine primary remote"))) - (branches (mapcar (lambda (line) (split-string line "\t")) - (magit-git-lines - "for-each-ref" "refs/heads" - "--format=%(refname:short)\t%(upstream:short)")))) - (when-let ((old (assoc oldname branches))) - (unless (assoc newname branches) - (magit-call-git "branch" "-m" oldname newname) - (setcar old newname))) - (let ((new (if (magit-branch-p newname) - newname - (concat remote "/" newname)))) - (pcase-dolist (`(,branch ,upstream) branches) - (cond - ((equal upstream oldname) - (magit-set-upstream-branch branch new)) - ((equal upstream (concat remote "/" oldname)) - (magit-set-upstream-branch branch (concat remote "/" newname)))))))) - -(defun magit--get-default-branch (&optional update) - (let ((remote (magit-primary-remote))) - (when update - (if (not remote) - (user-error "Cannot determine primary remote") - (message "Determining default branch...") - (magit-git "fetch" "--prune") - (magit-git "remote" "set-head" "--auto" remote) - (message "Determining default branch...done"))) - (let ((branch (magit-git-string "symbolic-ref" "--short" - (format "refs/remotes/%s/HEAD" remote)))) - (when (and update (not branch)) - (error "Cannot determine new default branch")) - (list remote (and branch (cdr (magit-split-branch-name branch))))))) - -(defun magit-set-upstream-branch (branch upstream) - "Set UPSTREAM as the upstream of BRANCH. -If UPSTREAM is nil, then unset BRANCH's upstream. -Otherwise UPSTREAM has to be an existing branch." - (if upstream - (magit-call-git "branch" "--set-upstream-to" upstream branch) - (magit-call-git "branch" "--unset-upstream" branch))) - -(defun magit-get-upstream-ref (&optional branch) - "Return the upstream branch of BRANCH as a fully qualified ref. -It BRANCH is nil, then return the upstream of the current branch, -if any, nil otherwise. If the upstream is not configured, the -configured remote is an url, or the named branch does not exist, -then return nil. I.e., return an existing local or -remote-tracking branch ref." - (and-let* ((branch (or branch (magit-get-current-branch)))) - (magit-ref-fullname (concat branch "@{upstream}")))) - -(defun magit-get-upstream-branch (&optional branch) - "Return the name of the upstream branch of BRANCH. -It BRANCH is nil, then return the upstream of the current branch -if any, nil otherwise. If the upstream is not configured, the -configured remote is an url, or the named branch does not exist, -then return nil. I.e., return the name of an existing local or -remote-tracking branch. The returned string is colorized -according to the branch type." - (magit--with-refresh-cache - (list default-directory 'magit-get-upstream-branch branch) - (and-let* ((branch (or branch (magit-get-current-branch))) - (upstream (magit-ref-abbrev (concat branch "@{upstream}")))) - (magit--propertize-face - upstream (if (equal (magit-get "branch" branch "remote") ".") - 'magit-branch-local - 'magit-branch-remote))))) - -(defun magit-get-indirect-upstream-branch (branch &optional force) - (let ((remote (magit-get "branch" branch "remote"))) - (and remote (not (equal remote ".")) - ;; The user has opted in... - (or force - (--some (if (magit-git-success "check-ref-format" "--branch" it) - (equal it branch) - (string-match-p it branch)) - magit-branch-prefer-remote-upstream)) - ;; and local BRANCH tracks a remote branch... - (let ((upstream (magit-get-upstream-branch branch))) - ;; whose upstream... - (and upstream - ;; has the same name as BRANCH... - (equal (substring upstream (1+ (length remote))) branch) - ;; and can be fast-forwarded to BRANCH. - (magit-rev-ancestor-p upstream branch) - upstream))))) - -(defun magit-get-upstream-remote (&optional branch allow-unnamed) - (and-let* ((branch (or branch (magit-get-current-branch))) - (remote (magit-get "branch" branch "remote"))) - (and (not (equal remote ".")) - (cond ((member remote (magit-list-remotes)) - (magit--propertize-face remote 'magit-branch-remote)) - ((and allow-unnamed - (string-match-p "\\(\\`.\\{0,2\\}/\\|[:@]\\)" remote)) - (magit--propertize-face remote 'bold)))))) - -(defun magit-get-unnamed-upstream (&optional branch) - (and-let* ((branch (or branch (magit-get-current-branch))) - (remote (magit-get "branch" branch "remote")) - (merge (magit-get "branch" branch "merge"))) - (and (magit--unnamed-upstream-p remote merge) - (list (magit--propertize-face remote 'bold) - (magit--propertize-face merge 'magit-branch-remote))))) - -(defun magit--unnamed-upstream-p (remote merge) - (and remote (string-match-p "\\(\\`\\.\\{0,2\\}/\\|[:@]\\)" remote) - merge (string-prefix-p "refs/" merge))) - -(defun magit--valid-upstream-p (remote merge) - (and (or (equal remote ".") - (member remote (magit-list-remotes))) - (string-prefix-p "refs/" merge))) - -(defun magit-get-current-remote (&optional allow-unnamed) - (or (magit-get-upstream-remote nil allow-unnamed) - (and-let* ((remotes (magit-list-remotes)) - (remote (if (length= remotes 1) - (car remotes) - (magit-primary-remote)))) - (magit--propertize-face remote 'magit-branch-remote)))) - -(defun magit-get-push-remote (&optional branch) - (and-let* ((remote - (or (and (or branch (setq branch (magit-get-current-branch))) - (magit-get "branch" branch "pushRemote")) - (magit-get "remote.pushDefault")))) - (magit--propertize-face remote 'magit-branch-remote))) - -(defun magit-get-push-branch (&optional branch verify) - (magit--with-refresh-cache - (list default-directory 'magit-get-push-branch branch verify) - (and-let* ((branch (or branch (setq branch (magit-get-current-branch)))) - (remote (magit-get-push-remote branch)) - (target (concat remote "/" branch))) - (and (or (not verify) - (magit-rev-verify target)) - (magit--propertize-face target 'magit-branch-remote))))) - -(defun magit-get-@{push}-branch (&optional branch) - (let ((ref (magit-rev-parse "--symbolic-full-name" - (concat branch "@{push}")))) - (and ref - (string-prefix-p "refs/remotes/" ref) - (substring ref 13)))) - -(defun magit-get-remote (&optional branch) - (and (or branch (setq branch (magit-get-current-branch))) - (let ((remote (magit-get "branch" branch "remote"))) - (and (not (equal remote ".")) - remote)))) - -(defun magit-get-some-remote (&optional branch) - (or (magit-get-remote branch) - (and-let* ((main (magit-main-branch))) - (magit-get-remote main)) - (magit-primary-remote) - (car (magit-list-remotes)))) - -(defvar magit-primary-remote-names - '("upstream" "origin")) - -(defun magit-primary-remote () - "Return the primary remote. - -The primary remote is the remote that tracks the repository that -other repositories are forked from. It often is called \"origin\" -but because many people name their own fork \"origin\", using that -term would be ambiguous. Likewise we avoid the term \"upstream\" -because a branch's @{upstream} branch may be a local branch or a -branch from a remote other than the primary remote. - -If a remote exists whose name matches `magit.primaryRemote', then -that is considered the primary remote. If no remote by that name -exists, then remotes in `magit-primary-remote-names' are tried in -order and the first remote from that list that actually exists in -the current repository is considered its primary remote." - (let ((remotes (magit-list-remotes))) - (seq-find (lambda (name) - (member name remotes)) - (delete-dups - (delq nil - (cons (magit-get "magit.primaryRemote") - magit-primary-remote-names)))))) - -(defun magit-branch-merged-p (branch &optional target) - "Return non-nil if BRANCH is merged into its upstream and TARGET. - -TARGET defaults to the current branch. If `HEAD' is detached and -TARGET is nil, then always return nil. As a special case, if -TARGET is t, then return non-nil if BRANCH is merged into any one -of the other local branches. - -If, and only if, BRANCH has an upstream, then only return non-nil -if BRANCH is merged into both TARGET (as described above) as well -as into its upstream." - (and (if-let ((upstream (and (magit-branch-p branch) - (magit-get-upstream-branch branch)))) - (magit-rev-ancestor-p branch upstream) - t) - (if (eq target t) - (delete (magit-name-local-branch branch) - (magit-list-containing-branches branch)) - (and-let* ((target (or target (magit-get-current-branch)))) - (magit-rev-ancestor-p branch target))))) - -(defun magit-get-tracked (refname) - "Return the remote branch tracked by the remote-tracking branch REFNAME. -The returned value has the form (REMOTE . REF), where REMOTE is -the name of a remote and REF is the ref local to the remote." - (and-let* ((ref (magit-ref-fullname refname))) - (save-match-data - (seq-some (lambda (line) - (and (string-match "\ -\\`remote\\.\\([^.]+\\)\\.fetch=\\+?\\([^:]+\\):\\(.+\\)" line) - (let ((rmt (match-string 1 line)) - (src (match-string 2 line)) - (dst (match-string 3 line))) - (and (string-match (format "\\`%s\\'" - (string-replace - "*" "\\(.+\\)" dst)) - ref) - (cons rmt (string-replace - "*" (match-string 1 ref) src)))))) - (magit-git-lines "config" "--local" "--list"))))) - -(defun magit-split-branch-name (branch) - (cond ((member branch (magit-list-local-branch-names)) - (cons "." branch)) - ((string-match "/" branch) - (or (seq-some (lambda (remote) - (and (string-match - (format "\\`\\(%s\\)/\\(.+\\)\\'" remote) - branch) - (cons (match-string 1 branch) - (match-string 2 branch)))) - (magit-list-remotes)) - (error "Invalid branch name %s" branch))))) - -(defun magit-get-current-tag (&optional rev with-distance) - "Return the closest tag reachable from REV. - -If optional REV is nil, then default to `HEAD'. -If optional WITH-DISTANCE is non-nil then return (TAG COMMITS), -if it is `dirty' return (TAG COMMIT DIRTY). COMMITS is the number -of commits in `HEAD' but not in TAG and DIRTY is t if there are -uncommitted changes, nil otherwise." - (and-let* ((str (magit-git-str "describe" "--long" "--tags" - (and (eq with-distance 'dirty) "--dirty") - rev))) - (save-match-data - (string-match - "\\(.+\\)-\\(?:0[0-9]*\\|\\([0-9]+\\)\\)-g[0-9a-z]+\\(-dirty\\)?$" str) - (if with-distance - `(,(match-string 1 str) - ,(string-to-number (or (match-string 2 str) "0")) - ,@(and (match-string 3 str) (list t))) - (match-string 1 str))))) - -(defun magit-get-next-tag (&optional rev with-distance) - "Return the closest tag from which REV is reachable. - -If optional REV is nil, then default to `HEAD'. -If no such tag can be found or if the distance is 0 (in which -case it is the current tag, not the next), return nil instead. -If optional WITH-DISTANCE is non-nil, then return (TAG COMMITS) -where COMMITS is the number of commits in TAG but not in REV." - (and-let* ((str (magit-git-str "describe" "--contains" (or rev "HEAD")))) - (save-match-data - (when (string-match "^[^^~]+" str) - (setq str (match-string 0 str)) - (unless (equal str (magit-get-current-tag rev)) - (if with-distance - (list str (car (magit-rev-diff-count str rev))) - str)))))) - -(defun magit-list-refs (&optional namespaces format sortby) - "Return list of references, excluding symbolic references. - -When NAMESPACES is non-nil, list refs from these namespaces -rather than those from `magit-list-refs-namespaces'. - -FORMAT is passed to the `--format' flag of `git for-each-ref' -and defaults to \"%(refname)\". - -SORTBY is a key or list of keys to pass to the `--sort' flag of -`git for-each-ref'. When nil, use `magit-list-refs-sortby'" - (unless format - (setq format "%(refname)")) - (seq-keep (lambda (line) - (pcase-let* ((`(,symrefp ,value) - (split-string line " ")) - (symrefp (not (equal symrefp "")))) - (and (not symrefp) value))) - (magit-git-lines "for-each-ref" - (concat "--format=%(symref) " format) - (--map (concat "--sort=" it) - (pcase (or sortby magit-list-refs-sortby) - ((and val (pred stringp)) (list val)) - ((and val (pred listp)) val))) - (or namespaces magit-list-refs-namespaces)))) - -(defun magit-list-branches () - (magit-list-refs (list "refs/heads" "refs/remotes"))) - -(defun magit-list-local-branches () - (magit-list-refs "refs/heads")) - -(defun magit-list-remote-branches (&optional remote) - (magit-list-refs (concat "refs/remotes/" remote))) - -(defun magit-list-related-branches (relation &optional commit &rest args) - (--remove (string-match-p "\\(\\`(HEAD\\|HEAD -> \\)" it) - (--map (substring it 2) - (magit-git-lines "branch" args relation commit)))) - -(defun magit-list-containing-branches (&optional commit &rest args) - (magit-list-related-branches "--contains" commit args)) - -(defun magit-list-publishing-branches (&optional commit) - (--filter (magit-rev-ancestor-p (or commit "HEAD") it) - magit-published-branches)) - -(defun magit-list-merged-branches (&optional commit &rest args) - (magit-list-related-branches "--merged" commit args)) - -(defun magit-list-unmerged-branches (&optional commit &rest args) - (magit-list-related-branches "--no-merged" commit args)) - -(defun magit-list-unmerged-to-upstream-branches () - (--filter (and-let* ((upstream (magit-get-upstream-branch it))) - (member it (magit-list-unmerged-branches upstream))) - (magit-list-local-branch-names))) - -(defun magit-list-branches-pointing-at (commit) - (let ((re (format "\\`%s refs/\\(heads\\|remotes\\)/\\(.*\\)\\'" - (magit-rev-verify commit)))) - (--keep (and (string-match re it) - (let ((name (match-string 2 it))) - (and (not (string-suffix-p "HEAD" name)) - name))) - (magit-git-lines "show-ref")))) - -(defun magit-list-refnames (&optional namespaces include-special) - (nconc (magit-list-refs namespaces "%(refname:short)") - (and include-special - (magit-list-special-refnames)))) - -(defvar magit-special-refnames - '("HEAD" "ORIG_HEAD" "FETCH_HEAD" "MERGE_HEAD" "CHERRY_PICK_HEAD")) - -(defun magit-list-special-refnames () - (let ((gitdir (magit-gitdir))) - (cl-mapcan (lambda (name) - (and (file-exists-p (expand-file-name name gitdir)) - (list name))) - magit-special-refnames))) - -(defun magit-list-branch-names () - (magit-list-refnames (list "refs/heads" "refs/remotes"))) - -(defun magit-list-local-branch-names () - (magit-list-refnames "refs/heads")) - -(defun magit-list-remote-branch-names (&optional remote relative) - (if (and remote relative) - (let ((regexp (format "^refs/remotes/%s/\\(.+\\)" remote))) - (--mapcat (when (string-match regexp it) - (list (match-string 1 it))) - (magit-list-remote-branches remote))) - (magit-list-refnames (concat "refs/remotes/" remote)))) - -(defun magit-format-refs (format &rest args) - (let ((lines (magit-git-lines - "for-each-ref" (concat "--format=" format) - (or args (list "refs/heads" "refs/remotes" "refs/tags"))))) - (if (string-search "\f" format) - (--map (split-string it "\f") lines) - lines))) - -(defun magit-list-remotes () - (magit-git-lines "remote")) - -(defun magit-list-tags () - (magit-git-lines "tag")) - -(defun magit-list-stashes (&optional format) - (magit-git-lines "stash" "list" (concat "--format=" (or format "%gd")))) - -(defun magit-list-active-notes-refs () - "Return notes refs according to `core.notesRef' and `notes.displayRef'." - (magit-git-lines "for-each-ref" "--format=%(refname)" - (or (magit-get "core.notesRef") "refs/notes/commits") - (magit-get-all "notes.displayRef"))) - -(defun magit-list-notes-refnames () - (--map (substring it 6) (magit-list-refnames "refs/notes"))) - -(defun magit-remote-list-tags (remote) - (--keep (and (not (string-suffix-p "^{}" it)) - (substring it 51)) - (magit-git-lines "ls-remote" "--tags" remote))) - -(defun magit-remote-list-branches (remote) - (--keep (and (not (string-suffix-p "^{}" it)) - (substring it 52)) - (magit-git-lines "ls-remote" "--heads" remote))) - -(defun magit-remote-list-refs (remote) - (--keep (and (not (string-suffix-p "^{}" it)) - (substring it 41)) - (magit-git-lines "ls-remote" remote))) - -(defun magit-remote-head (remote) - (and-let* ((line (cl-find-if - (lambda (line) - (string-match - "\\`ref: refs/heads/\\([^\s\t]+\\)[\s\t]HEAD\\'" line)) - (magit-git-lines "ls-remote" "--symref" remote "HEAD")))) - (match-string 1 line))) - -(defun magit-list-modified-modules () - (--keep (and (string-match "\\`\\+\\([^ ]+\\) \\(.+\\) (.+)\\'" it) - (match-string 2 it)) - (magit-git-lines "submodule" "status"))) - -(defun magit-list-module-paths () - (magit-with-toplevel - (--mapcat (and (string-match "^160000 [0-9a-z]\\{40,\\} 0\t\\(.+\\)$" it) - (list (match-string 1 it))) - (magit-git-items "ls-files" "-z" "--stage")))) - -(defun magit-list-module-names () - (mapcar #'magit-get-submodule-name (magit-list-module-paths))) - -(defun magit-get-submodule-name (path) - "Return the name of the submodule at PATH. -PATH has to be relative to the super-repository." - (if (magit-git-version>= "2.38.0") - ;; "git submodule--helper name" was removed, - ;; but might still come back in another form. - (substring - (car (split-string - (car (or (magit-git-items - "config" "-z" - "-f" (expand-file-name ".gitmodules" (magit-toplevel)) - "--get-regexp" "^submodule\\..*\\.path$" - (concat "^" (regexp-quote (directory-file-name path)) "$")) - (error "No such submodule `%s'" path))) - "\n")) - 10 -5) - (magit-git-string "submodule--helper" "name" path))) - -(defun magit-list-worktrees () - "Return list of the worktrees of this repository. - -The returned list has the form (PATH COMMIT BRANCH BARE DETACHED -LOCKED PRUNABLE). The last four elements are booleans, with the -exception of LOCKED and PRUNABLE, which may also be strings. -See git-worktree(1) manpage for the meaning of the various parts. - -This function corrects a situation where \"git worktree list\" -would claim a worktree is bare, even though the working tree is -specified using `core.worktree'." - (let ((remote (file-remote-p default-directory)) - worktrees worktree) - (dolist (line (let ((magit-git-global-arguments - ;; KLUDGE At least in Git v2.8.3 this argument - ;; would trigger a segfault. - (remove "--no-pager" magit-git-global-arguments))) - (if (magit-git-version>= "2.36") - (magit-git-items "worktree" "list" "--porcelain" "-z") - (magit-git-lines "worktree" "list" "--porcelain")))) - (cond ((string-prefix-p "worktree" line) - (let ((path (substring line 9))) - (when remote - (setq path (concat remote path))) - ;; If the git directory is separate from the main - ;; worktree, then "git worktree" returns the git - ;; directory instead of the worktree, which isn't - ;; what it is supposed to do and not what we want. - ;; However, if the worktree has been removed, then - ;; we want to return it anyway; instead of nil. - (setq path (or (magit-toplevel path) path)) - (setq worktree (list path nil nil nil nil nil nil)) - (push worktree worktrees))) - ((string-prefix-p "HEAD" line) - (setf (nth 1 worktree) (substring line 5))) - ((string-prefix-p "branch" line) - (setf (nth 2 worktree) (substring line 18))) - ((string-equal line "bare") - (let* ((default-directory (car worktree)) - (wt (and (not (magit-get-boolean "core.bare")) - (magit-get "core.worktree")))) - (if (and wt (file-exists-p (expand-file-name wt))) - (progn (setf (nth 0 worktree) (expand-file-name wt)) - (setf (nth 2 worktree) (magit-rev-parse "HEAD")) - (setf (nth 3 worktree) (magit-get-current-branch))) - (setf (nth 3 worktree) t)))) - ((string-equal line "detached") - (setf (nth 4 worktree) t)) - ((string-prefix-p line "locked") - (setf (nth 5 worktree) - (if (> (length line) 6) (substring line 7) t))) - ((string-prefix-p line "prunable") - (setf (nth 6 worktree) - (if (> (length line) 8) (substring line 9) t))))) - (nreverse worktrees))) - -(defun magit-symbolic-ref-p (name) - (magit-git-success "symbolic-ref" "--quiet" name)) - -(defun magit-ref-p (rev) - (or (car (member rev (magit-list-refs "refs/"))) - (car (member rev (magit-list-refnames "refs/"))))) - -(defun magit-branch-p (rev) - (or (car (member rev (magit-list-branches))) - (car (member rev (magit-list-branch-names))))) - -(defun magit-local-branch-p (rev) - (or (car (member rev (magit-list-local-branches))) - (car (member rev (magit-list-local-branch-names))))) - -(defun magit-remote-branch-p (rev) - (or (car (member rev (magit-list-remote-branches))) - (car (member rev (magit-list-remote-branch-names))))) - -(defun magit-branch-set-face (branch) - (magit--propertize-face branch (if (magit-local-branch-p branch) - 'magit-branch-local - 'magit-branch-remote))) - -(defun magit-tag-p (rev) - (car (member rev (magit-list-tags)))) - -(defun magit-remote-p (string) - (car (member string (magit-list-remotes)))) - -(defvar magit-main-branch-names - '("main" "master" "trunk" "development") - "Branch names reserved for use by the primary branch. -Use function `magit-main-branch' to get the name actually used in -the current repository.") - -(defvar magit-long-lived-branches - (append magit-main-branch-names (list "maint" "next")) - "Branch names reserved for use by long lived branches.") - -(defun magit-main-branch () - "Return the main branch. - -If a branch exists whose name matches `init.defaultBranch', then -that is considered the main branch. If no branch by that name -exists, then the branch names in `magit-main-branch-names' are -tried in order. The first branch from that list that actually -exists in the current repository is considered its main branch." - (let ((branches (magit-list-local-branch-names))) - (seq-find (lambda (name) - (member name branches)) - (delete-dups - (delq nil - (cons (magit-get "init.defaultBranch") - magit-main-branch-names)))))) - -(defun magit-rev-diff-count (a b &optional first-parent) - "Return the commits in A but not B and vice versa. -Return a list of two integers: (A>B B>A). - -If `first-parent' is set, traverse only first parents." - (mapcar #'string-to-number - (split-string (magit-git-string "rev-list" - "--count" "--left-right" - (and first-parent "--first-parent") - (concat a "..." b)) - "\t"))) - -(defun magit-abbrev-length () - (let ((abbrev (magit-get "core.abbrev"))) - (if (and abbrev (not (equal abbrev "auto"))) - (string-to-number abbrev) - ;; Guess the length git will be using based on an example - ;; abbreviation. Actually HEAD's abbreviation might be an - ;; outlier, so use the shorter of the abbreviations for two - ;; commits. See #3034. - (if-let ((head (magit-rev-parse "--short" "HEAD")) - (head-len (length head))) - (min head-len - (if-let ((rev (magit-rev-parse "--short" "HEAD~"))) - (length rev) - head-len)) - ;; We're on an unborn branch, but perhaps the repository has - ;; other commits. See #4123. - (if-let ((commits (magit-git-lines "rev-list" "-n2" "--all" - "--abbrev-commit"))) - (apply #'min (mapcar #'length commits)) - ;; A commit does not exist. Fall back to the default of 7. - 7))))) - -(defun magit-abbrev-arg (&optional arg) - (format "--%s=%d" (or arg "abbrev") (magit-abbrev-length))) - -(defun magit-rev-abbrev (rev) - (magit-rev-parse (magit-abbrev-arg "short") rev)) - -(defun magit-commit-children (commit &optional args) - (mapcar #'car - (--filter (member commit (cdr it)) - (--map (split-string it " ") - (magit-git-lines - "log" "--format=%H %P" - (or args (list "--branches" "--tags" "--remotes")) - "--not" commit))))) - -(defun magit-commit-parents (commit) - (and-let* ((str (magit-git-string "rev-list" "-1" "--parents" commit))) - (cdr (split-string str)))) - -(defun magit-patch-id (rev) - (magit--with-connection-local-variables - (magit--with-temp-process-buffer - (magit-process-file - shell-file-name nil '(t nil) nil shell-command-switch - (let ((exec (shell-quote-argument (magit-git-executable)))) - (format "%s diff-tree -u %s | %s patch-id" exec rev exec))) - (car (split-string (buffer-string)))))) - -(defun magit-rev-format (format &optional rev args) - ;; Prefer `git log --no-walk' to `git show --no-patch' because it - ;; performs better in some scenarios. - (let ((str (magit-git-string "log" "--no-walk" - (concat "--format=" format) args - (if rev (magit--rev-dereference rev) "HEAD") - "--"))) - (and (not (string-equal str "")) - str))) - -(defun magit-rev-insert-format (format &optional rev args) - ;; Prefer `git log --no-walk' to `git show --no-patch' because it - ;; performs better in some scenarios. - (magit-git-insert "log" "--no-walk" - (concat "--format=" format) args - (if rev (magit--rev-dereference rev) "HEAD") - "--")) - -(defun magit-format-rev-summary (rev) - (and-let* ((str (magit-rev-format "%h %s" rev))) - (progn - (magit--put-face 0 (string-match " " str) 'magit-hash str) - str))) - -(defvar magit-ref-namespaces - '(("\\`HEAD\\'" . magit-head) - ("\\`refs/tags/\\(.+\\)" . magit-tag) - ("\\`refs/heads/\\(.+\\)" . magit-branch-local) - ("\\`refs/remotes/\\(.+\\)" . magit-branch-remote) - ("\\`refs/bisect/\\(bad\\)" . magit-bisect-bad) - ("\\`refs/bisect/\\(skip.*\\)" . magit-bisect-skip) - ("\\`refs/bisect/\\(good.*\\)" . magit-bisect-good) - ("\\`refs/stash$" . magit-refname-stash) - ("\\`refs/wip/\\(.+\\)" . magit-refname-wip) - ("\\`refs/pullreqs/\\(.+\\)" . magit-refname-pullreq) - ("\\`\\(bad\\):" . magit-bisect-bad) - ("\\`\\(skip\\):" . magit-bisect-skip) - ("\\`\\(good\\):" . magit-bisect-good) - ("\\`\\(.+\\)" . magit-refname)) - "How refs are formatted for display. - -Each entry controls how a certain type of ref is displayed, and -has the form (REGEXP . FACE). REGEXP is a regular expression -used to match full refs. The first entry whose REGEXP matches -the reference is used. - -In log and revision buffers the first regexp submatch becomes the -\"label\" that represents the ref and is propertized with FONT. -In refs buffers the displayed text is controlled by other means -and this option only controls what face is used.") - -(defun magit-format-ref-labels (string) - (save-match-data - (let ((regexp "\\(, \\|tag: \\|HEAD -> \\)") - names) - (if (and (derived-mode-p 'magit-log-mode) - (member "--simplify-by-decoration" magit-buffer-log-args)) - (let ((branches (magit-list-local-branch-names)) - (re (format "^%s/.+" (regexp-opt (magit-list-remotes))))) - (setq names - (--map (cond ((string-equal it "HEAD") it) - ((string-prefix-p "refs/" it) it) - ((member it branches) (concat "refs/heads/" it)) - ((string-match re it) (concat "refs/remotes/" it)) - (t (concat "refs/" it))) - (split-string - (string-replace "tag: " "refs/tags/" string) - regexp t)))) - (setq names (split-string string regexp t))) - (let (state head upstream tags branches remotes other combined) - (dolist (ref names) - (let* ((face (cdr (--first (string-match (car it) ref) - magit-ref-namespaces))) - (name (magit--propertize-face - (or (match-string 1 ref) ref) face))) - (cl-case face - ((magit-bisect-bad magit-bisect-skip magit-bisect-good) - (setq state name)) - (magit-head - (setq head (magit--propertize-face "@" 'magit-head))) - (magit-tag (push name tags)) - (magit-branch-local (push name branches)) - (magit-branch-remote (push name remotes)) - (t (push name other))))) - (setq remotes - (seq-keep - (lambda (name) - (if (string-match "\\`\\([^/]*\\)/\\(.*\\)\\'" name) - (let ((r (match-string 1 name)) - (b (match-string 2 name))) - (and (not (equal b "HEAD")) - (if (equal (concat "refs/remotes/" name) - (magit-git-string - "symbolic-ref" - (format "refs/remotes/%s/HEAD" r))) - (magit--propertize-face - name 'magit-branch-remote-head) - name))) - name)) - remotes)) - (let* ((current (magit-get-current-branch)) - (target (magit-get-upstream-branch current))) - (dolist (name branches) - (let ((push (car (member (magit-get-push-branch name) remotes)))) - (when push - (setq remotes (delete push remotes)) - (string-match "^[^/]*/" push) - (setq push (substring push 0 (match-end 0)))) - (cond - ((equal name current) - (setq head - (concat push - (magit--propertize-face - name 'magit-branch-current)))) - ((equal name target) - (setq upstream - (concat push - (magit--propertize-face - name '(magit-branch-upstream - magit-branch-local))))) - (t - (push (concat push name) combined))))) - (when (and target (not upstream)) - (if (member target remotes) - (progn - (magit--add-face-text-property - 0 (length target) 'magit-branch-upstream nil target) - (setq upstream target) - (setq remotes (delete target remotes))) - (when-let ((target (car (member target combined)))) - (magit--add-face-text-property - 0 (length target) 'magit-branch-upstream nil target) - (setq upstream target) - (setq combined (delete target combined)))))) - (mapconcat #'identity - (flatten-tree `(,state - ,head - ,upstream - ,@(nreverse tags) - ,@(nreverse combined) - ,@(nreverse remotes) - ,@other)) - " "))))) - -(defun magit-object-type (object) - (magit-git-string "cat-file" "-t" object)) - -(defmacro magit-with-blob (commit file &rest body) - (declare (indent 2) - (debug (form form body))) - `(magit--with-temp-process-buffer - (let ((buffer-file-name ,file)) - (save-excursion - (magit-git-insert "cat-file" "-p" - (concat ,commit ":" buffer-file-name))) - (decode-coding-inserted-region - (point-min) (point-max) buffer-file-name t nil nil t) - ,@body))) - -(defvar magit-tramp-process-environment nil) - -(defmacro magit-with-temp-index (tree arg &rest body) - (declare (indent 2) (debug (form form body))) - (let ((file (cl-gensym "file"))) - `(let ((magit--refresh-cache nil) - (,file (magit-convert-filename-for-git - (make-temp-name - (expand-file-name "index.magit." (magit-gitdir)))))) - (unwind-protect - (magit-with-toplevel - (when-let ((tree ,tree)) - (unless (magit-git-success "read-tree" ,arg tree - (concat "--index-output=" ,file)) - (error "Cannot read tree %s" tree))) - (if (file-remote-p default-directory) - (let ((magit-tramp-process-environment - (cons (concat "GIT_INDEX_FILE=" ,file) - magit-tramp-process-environment))) - ,@body) - (with-environment-variables (("GIT_INDEX_FILE" ,file)) - ,@body))) - (ignore-errors - (delete-file (concat (file-remote-p default-directory) ,file))))))) - -(defun magit-commit-tree (message &optional tree &rest parents) - (magit-git-string "commit-tree" "--no-gpg-sign" "-m" message - (--mapcat (list "-p" it) (delq nil parents)) - (or tree - (magit-git-string "write-tree") - (error "Cannot write tree")))) - -(defun magit-commit-worktree (message &optional arg &rest other-parents) - (magit-with-temp-index "HEAD" arg - (and (magit-update-files (magit-unstaged-files)) - (apply #'magit-commit-tree message nil "HEAD" other-parents)))) - -(defun magit-update-files (files) - (magit-git-success "update-index" "--add" "--remove" "--" files)) - -(defun magit-update-ref (ref message rev &optional stashish) - (let ((magit--refresh-cache nil)) - (or (if (magit-git-version>= "2.6.0") - (zerop (magit-call-git "update-ref" "--create-reflog" - "-m" message ref rev - (or (magit-rev-verify ref) ""))) - ;; `--create-reflog' didn't exist before v2.6.0 - (let ((oldrev (magit-rev-verify ref)) - (logfile (expand-file-name (concat "logs/" ref) - (magit-gitdir)))) - (unless (file-exists-p logfile) - (when oldrev - (magit-git-success "update-ref" "-d" ref oldrev)) - (make-directory (file-name-directory logfile) t) - (with-temp-file logfile) - (when (and oldrev (not stashish)) - (magit-git-success "update-ref" "-m" "enable reflog" - ref oldrev "")))) - (magit-git-success "update-ref" "-m" message ref rev - (or (magit-rev-verify ref) ""))) - (error "Cannot update %s with %s" ref rev)))) - -(defconst magit-range-re - (concat "\\`\\([^ \t]*[^.]\\)?" ; revA - "\\(\\.\\.\\.?\\)" ; range marker - "\\([^.][^ \t]*\\)?\\'")) ; revB - -(defun magit-split-range (range) - (pcase-let ((`(,beg ,end ,sep) (magit--split-range-raw range))) - (and sep - (let ((beg (or beg "HEAD")) - (end (or end "HEAD"))) - (if (string-equal (match-string 2 range) "...") - (and-let* ((base (magit-git-string "merge-base" beg end))) - (cons base end)) - (cons beg end)))))) - -(defun magit--split-range-raw (range) - (and (string-match magit-range-re range) - (let ((beg (match-string 1 range)) - (end (match-string 3 range))) - (and (or beg end) - (list beg end (match-string 2 range)))))) - -(defun magit-hash-range (range) - (if (string-match magit-range-re range) - (let ((beg (match-string 1 range)) - (end (match-string 3 range))) - (and (or beg end) - (let ((beg-hash (and beg (magit-rev-hash (match-string 1 range)))) - (end-hash (and end (magit-rev-hash (match-string 3 range))))) - (and (or (not beg) beg-hash) - (or (not end) end-hash) - (concat beg-hash (match-string 2 range) end-hash))))) - (magit-rev-hash range))) - -(defvar magit-revision-faces - '(magit-hash - magit-tag - magit-branch-remote - magit-branch-remote-head - magit-branch-local - magit-branch-current - magit-branch-upstream - magit-branch-warning - magit-head - magit-refname - magit-refname-stash - magit-refname-wip - magit-refname-pullreq)) - -(put 'git-revision 'thing-at-point #'magit-thingatpt--git-revision) -(defun magit-thingatpt--git-revision (&optional disallow) - ;; Support hashes and references. - (and-let* ((bounds - (let ((c (concat "\s\n\t~^:?*[\\" disallow))) - (cl-letf - (((get 'git-revision 'beginning-op) - (lambda () - (if (re-search-backward (format "[%s]" c) nil t) - (forward-char) - (goto-char (point-min))))) - ((get 'git-revision 'end-op) - (lambda () - (re-search-forward (format "\\=[^%s]*" c) nil t)))) - (bounds-of-thing-at-point 'git-revision)))) - (string (buffer-substring-no-properties (car bounds) (cdr bounds))) - ;; References are allowed to contain most parentheses and - ;; most punctuation, but if those characters appear at the - ;; edges of a possible reference in arbitrary text, then - ;; they are much more likely to be intended as just that: - ;; punctuation and delimiters. - (string (thread-first string - (string-trim-left "[(</]") - (string-trim-right "[])>/.,;!]")))) - (let (disallow) - (when (or (string-match-p "\\.\\." string) - (string-match-p "/\\." string)) - (setq disallow (concat disallow "."))) - (when (string-match-p "@{" string) - (setq disallow (concat disallow "@{"))) - (if disallow - ;; These additional restrictions overcompensate, - ;; but that only matters in rare cases. - (magit-thingatpt--git-revision disallow) - (and (not (equal string "@")) - (or (and (>= (length string) 7) - (string-match-p "[a-z]" string) - (magit-commit-p string)) - (and (magit-ref-p string) - (let ((face (get-text-property (point) 'face))) - (or (not face) - (member face magit-revision-faces))))) - string))))) - -(put 'git-revision-range 'thing-at-point #'magit-thingatpt--git-revision-range) -(defun magit-thingatpt--git-revision-range () - ;; Support hashes but no references. - (and-let* ((bounds - (cl-letf (((get 'git-revision 'beginning-op) - (lambda () - (if (re-search-backward "[^a-z0-9.]" nil t) - (forward-char) - (goto-char (point-min))))) - ((get 'git-revision 'end-op) - (lambda () - (and (re-search-forward "[^a-z0-9.]" nil t) - (backward-char))))) - (bounds-of-thing-at-point 'git-revision))) - (range (buffer-substring-no-properties (car bounds) (cdr bounds)))) - ;; Validate but return as-is. - (and (magit-hash-range range) range))) - -;;; Completion - -(defvar magit-revision-history nil) - -(defun magit--minibuf-default-add-commit () - (let ((fn minibuffer-default-add-function)) - (lambda () - (if-let ((commit (with-selected-window (minibuffer-selected-window) - (or (magit-thing-at-point 'git-revision-range t) - (magit-commit-at-point))))) - (let ((rest (cons commit (delete commit (funcall fn)))) - (def minibuffer-default)) - (if (listp def) - (append def rest) - (cons def (delete def rest)))) - (funcall fn))))) - -(defun magit-read-branch (prompt &optional secondary-default) - (magit-completing-read prompt (magit-list-branch-names) - nil t nil 'magit-revision-history - (or (magit-branch-at-point) - secondary-default - (magit-get-current-branch)))) - -(defun magit-read-branch-or-commit (prompt &optional secondary-default) - (let ((minibuffer-default-add-function (magit--minibuf-default-add-commit))) - (or (magit-completing-read prompt (magit-list-refnames nil t) - nil nil nil 'magit-revision-history - (or (magit-branch-or-commit-at-point) - secondary-default - (magit-get-current-branch))) - (user-error "Nothing selected")))) - -(defun magit-read-range-or-commit (prompt &optional secondary-default) - (magit-read-range - prompt - (or (and-let* ((revs (magit-region-values '(commit branch) t))) - (progn - (deactivate-mark) - (concat (car (last revs)) ".." (car revs)))) - (magit-branch-or-commit-at-point) - secondary-default - (magit-get-current-branch)))) - -(defun magit-read-range (prompt &optional default) - (let ((minibuffer-default-add-function (magit--minibuf-default-add-commit)) - (crm-separator "\\.\\.\\.?")) - (magit-completing-read-multiple - (concat prompt ": ") - (magit-list-refnames) - nil nil nil 'magit-revision-history default nil t))) - -(defun magit-read-remote-branch - (prompt &optional remote default local-branch require-match) - (let ((choice (magit-completing-read - prompt - (cl-union (and local-branch - (if remote - (concat remote "/" local-branch) - (--map (concat it "/" local-branch) - (magit-list-remotes)))) - (magit-list-remote-branch-names remote t) - :test #'equal) - nil require-match nil 'magit-revision-history default))) - (if (or remote (string-match "\\`\\([^/]+\\)/\\(.+\\)" choice)) - choice - (user-error "`%s' doesn't have the form REMOTE/BRANCH" choice)))) - -(defun magit-read-refspec (prompt remote) - (magit-completing-read prompt - (prog2 (message "Determining available refs...") - (magit-remote-list-refs remote) - (message "Determining available refs...done")))) - -(defun magit-read-local-branch (prompt &optional secondary-default) - (magit-completing-read prompt (magit-list-local-branch-names) - nil t nil 'magit-revision-history - (or (magit-local-branch-at-point) - secondary-default - (magit-get-current-branch)))) - -(defun magit-read-local-branch-or-commit (prompt) - (let ((minibuffer-default-add-function (magit--minibuf-default-add-commit)) - (choices (nconc (magit-list-local-branch-names) - (magit-list-special-refnames))) - (commit (magit-commit-at-point))) - (when commit - (push commit choices)) - (or (magit-completing-read prompt choices - nil nil nil 'magit-revision-history - (or (magit-local-branch-at-point) commit)) - (user-error "Nothing selected")))) - -(defun magit-read-local-branch-or-ref (prompt &optional secondary-default) - (magit-completing-read prompt (nconc (magit-list-local-branch-names) - (magit-list-refs "refs/")) - nil t nil 'magit-revision-history - (or (magit-local-branch-at-point) - secondary-default - (magit-get-current-branch)))) - -(defun magit-read-other-branch - (prompt &optional exclude secondary-default no-require-match) - (let* ((current (magit-get-current-branch)) - (atpoint (magit-branch-at-point)) - (exclude (or exclude current)) - (default (or (and (not (equal atpoint exclude)) atpoint) - (and (not (equal current exclude)) current) - secondary-default - (magit-get-previous-branch)))) - (magit-completing-read prompt (delete exclude (magit-list-branch-names)) - nil (not no-require-match) - nil 'magit-revision-history default))) - -(defun magit-read-other-branch-or-commit - (prompt &optional exclude secondary-default) - (let* ((minibuffer-default-add-function (magit--minibuf-default-add-commit)) - (current (magit-get-current-branch)) - (atpoint (magit-branch-or-commit-at-point)) - (exclude (or exclude current)) - (default (or (and (not (equal atpoint exclude)) - (not (and (not current) - (magit-rev-equal atpoint "HEAD"))) - atpoint) - (and (not (equal current exclude)) current) - secondary-default - (magit-get-previous-branch)))) - (or (magit-completing-read prompt (delete exclude (magit-list-refnames)) - nil nil nil 'magit-revision-history default) - (user-error "Nothing selected")))) - -(defun magit-read-other-local-branch - (prompt &optional exclude secondary-default no-require-match) - (let* ((current (magit-get-current-branch)) - (atpoint (magit-local-branch-at-point)) - (exclude (or exclude current)) - (default (or (and (not (equal atpoint exclude)) atpoint) - (and (not (equal current exclude)) current) - secondary-default - (magit-get-previous-branch)))) - (magit-completing-read prompt - (delete exclude (magit-list-local-branch-names)) - nil (not no-require-match) - nil 'magit-revision-history default))) - -(defun magit-read-branch-prefer-other (prompt) - (let* ((current (magit-get-current-branch)) - (commit (magit-commit-at-point)) - (atrev (and commit (magit-list-branches-pointing-at commit))) - (atpoint (magit--painted-branch-at-point))) - (magit-completing-read prompt (magit-list-branch-names) - nil t nil 'magit-revision-history - (or (magit-section-value-if 'branch) - atpoint - (and (not (cdr atrev)) (car atrev)) - (--first (not (equal it current)) atrev) - (magit-get-previous-branch) - (car atrev))))) - -(defun magit-read-upstream-branch (&optional branch prompt) - "Read the upstream for BRANCH using PROMPT. -If optional BRANCH is nil, then read the upstream for the -current branch, or raise an error if no branch is checked -out. Only existing branches can be selected." - (unless branch - (setq branch (or (magit-get-current-branch) - (error "Need a branch to set its upstream")))) - (let ((branches (delete branch (magit-list-branch-names)))) - (magit-completing-read - (or prompt (format "Change upstream of %s to" branch)) - branches nil t nil 'magit-revision-history - (or (let ((r (car (member (magit-remote-branch-at-point) branches))) - (l (car (member (magit-local-branch-at-point) branches)))) - (if magit-prefer-remote-upstream (or r l) (or l r))) - (and-let* ((main (magit-main-branch))) - (let ((r (car (member (concat "origin/" main) branches))) - (l (car (member main branches)))) - (if magit-prefer-remote-upstream (or r l) (or l r)))) - (car (member (magit-get-previous-branch) branches)))))) - -(defun magit-read-starting-point (prompt &optional branch default) - (or (magit-completing-read - (concat prompt - (and branch - (if (bound-and-true-p ivy-mode) - ;; Ivy-mode strips faces from prompt. - (format " `%s'" branch) - (concat " " (magit--propertize-face - branch 'magit-branch-local)))) - " starting at") - (nconc (list "HEAD") - (magit-list-refnames) - (directory-files (magit-gitdir) nil "_HEAD\\'")) - nil nil nil 'magit-revision-history - (or default (magit--default-starting-point))) - (user-error "Nothing selected"))) - -(defun magit--default-starting-point () - (or (let ((r (magit-remote-branch-at-point)) - (l (magit-local-branch-at-point))) - (if magit-prefer-remote-upstream (or r l) (or l r))) - (magit-commit-at-point) - (magit-stash-at-point) - (magit-get-current-branch))) - -(defun magit-read-tag (prompt &optional require-match) - (magit-completing-read prompt (magit-list-tags) nil - require-match nil 'magit-revision-history - (magit-tag-at-point))) - -(defun magit-read-stash (prompt) - (let* ((atpoint (magit-stash-at-point)) - (default (and atpoint - (concat atpoint (magit-rev-format " %s" atpoint)))) - (choices (mapcar (lambda (c) - (pcase-let ((`(,rev ,msg) (split-string c "\0"))) - (concat (propertize rev 'face 'magit-hash) - " " msg))) - (magit-list-stashes "%gd%x00%s"))) - (choice (magit-completing-read prompt choices - nil t nil nil - default - (car choices)))) - (and choice - (string-match "^\\([^ ]+\\) \\(.+\\)" choice) - (substring-no-properties (match-string 1 choice))))) - -(defun magit-read-remote (prompt &optional default use-only) - (let ((remotes (magit-list-remotes))) - (if (and use-only (length= remotes 1)) - (car remotes) - (magit-completing-read prompt remotes - nil t nil nil - (or default - (magit-remote-at-point) - (magit-get-remote)))))) - -(defun magit-read-remote-or-url (prompt &optional default) - (magit-completing-read prompt - (nconc (magit-list-remotes) - (list "https://" "git://" "git@")) - nil nil nil nil - (or default - (magit-remote-at-point) - (magit-get-remote)))) - -(defun magit-read-module-path (prompt &optional predicate) - (magit-completing-read prompt (magit-list-module-paths) - predicate t nil nil - (magit-module-at-point predicate))) - -(defun magit-module-confirm (verb &optional predicate) - ;; Some predicates use the inefficient `magit-toplevel' - ;; and some repositories have thousands of submodules. - (let ((magit--refresh-cache (list (cons 0 0))) - (modules nil)) - (if current-prefix-arg - (progn - (setq modules (magit-list-module-paths)) - (when predicate - (setq modules (seq-filter predicate modules))) - (unless modules - (if predicate - (user-error "No modules satisfying %s available" predicate) - (user-error "No modules available")))) - (setq modules (magit-region-values 'module)) - (when modules - (when predicate - (setq modules (seq-filter predicate modules))) - (unless modules - (user-error "No modules satisfying %s selected" predicate)))) - (if (or (length> modules 1) current-prefix-arg) - (magit-confirm t nil (format "%s %%d modules" verb) nil modules) - (list (magit-read-module-path (format "%s module" verb) predicate))))) - -;;; _ -(provide 'magit-git) -;;; magit-git.el ends here diff --git a/emacs/elpa/magit-20240622.1531/magit-git.elc b/emacs/elpa/magit-20240622.1531/magit-git.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/magit-log.el b/emacs/elpa/magit-20240622.1531/magit-log.el @@ -1,2008 +0,0 @@ -;;; magit-log.el --- Inspect Git history -*- lexical-binding:t; coding:utf-8 -*- - -;; Copyright (C) 2008-2024 The Magit Project Contributors - -;; Author: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> -;; Maintainer: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> - -;; SPDX-License-Identifier: GPL-3.0-or-later - -;; 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. -;; -;; 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 Magit. If not, see <https://www.gnu.org/licenses/>. - -;;; Commentary: - -;; This library implements support for looking at Git logs, including -;; special logs like cherry-logs, as well as for selecting a commit -;; from a log. - -;;; Code: - -(require 'magit-core) -(require 'magit-diff) - -(declare-function magit-blob-visit "magit-files" (blob-or-file)) -(declare-function magit-cherry-apply "magit-sequence" (commit &optional args)) -(declare-function magit-insert-head-branch-header "magit-status" - (&optional branch)) -(declare-function magit-insert-upstream-branch-header "magit-status" - (&optional branch pull keyword)) -(declare-function magit-read-file-from-rev "magit-files" - (rev prompt &optional default)) -(declare-function magit-rebase--get-state-lines "magit-sequence" - (file)) -(declare-function magit-show-commit "magit-diff" - (arg1 &optional arg2 arg3 arg4)) -(declare-function magit-reflog-format-subject "magit-reflog" (subject)) -(defvar magit-refs-focus-column-width) -(defvar magit-refs-margin) -(defvar magit-refs-show-commit-count) -(defvar magit-buffer-margin) -(defvar magit-status-margin) -(defvar magit-status-sections-hook) - -(require 'ansi-color) -(require 'crm) -(require 'which-func) - -;;; Options -;;;; Log Mode - -(defgroup magit-log nil - "Inspect and manipulate Git history." - :link '(info-link "(magit)Logging") - :group 'magit-commands - :group 'magit-modes) - -(defcustom magit-log-mode-hook nil - "Hook run after entering Magit-Log mode." - :group 'magit-log - :type 'hook) - -(defcustom magit-log-remove-graph-args '("--follow" "--grep" "-G" "-S" "-L") - "The log arguments that cause the `--graph' argument to be dropped. - -The default value lists the arguments that are incompatible with -`--graph' and therefore must be dropped when that is used. You -can add additional arguments that are available in `magit-log', -but I recommend that you don't do that. Nowadays I would define -this as a constant, but I am preserving it as an option, in case -someone actually customized it." - :package-version '(magit . "2.3.0") - :group 'magit-log - :type '(repeat (string :tag "Argument")) - :options '("--follow" "--grep" "-G" "-S" "-L")) - -(defcustom magit-log-revision-headers-format "\ -%+b%+N -Author: %aN <%aE> -Committer: %cN <%cE>" - "Additional format string used with the `++header' argument." - :package-version '(magit . "3.2.0") - :group 'magit-log - :type 'string) - -(defcustom magit-log-auto-more nil - "Insert more log entries automatically when moving past the last entry. -Only considered when moving past the last entry with -`magit-goto-*-section' commands." - :group 'magit-log - :type 'boolean) - -(defcustom magit-log-margin '(t age magit-log-margin-width t 18) - "Format of the margin in `magit-log-mode' buffers. - -The value has the form (INIT STYLE WIDTH AUTHOR AUTHOR-WIDTH). - -If INIT is non-nil, then the margin is shown initially. -STYLE controls how to format the author or committer date. - It can be one of `age' (to show the age of the commit), - `age-abbreviated' (to abbreviate the time unit to a character), - or a string (suitable for `format-time-string') to show the - actual date. Option `magit-log-margin-show-committer-date' - controls which date is being displayed. -WIDTH controls the width of the margin. This exists for forward - compatibility and currently the value should not be changed. -AUTHOR controls whether the name of the author is also shown by - default. -AUTHOR-WIDTH has to be an integer. When the name of the author - is shown, then this specifies how much space is used to do so." - :package-version '(magit . "2.9.0") - :group 'magit-log - :group 'magit-margin - :type magit-log-margin--custom-type - :initialize #'magit-custom-initialize-reset - :set (apply-partially #'magit-margin-set-variable 'magit-log-mode)) - -(defcustom magit-log-margin-show-committer-date nil - "Whether to show the committer date in the margin. - -This option only controls whether the committer date is displayed -instead of the author date. Whether some date is displayed in -the margin and whether the margin is displayed at all is -controlled by other options." - :package-version '(magit . "3.0.0") - :group 'magit-log - :group 'magit-margin - :type 'boolean) - -(defcustom magit-log-show-refname-after-summary nil - "Whether to show refnames after commit summaries. -This is useful if you use really long branch names." - :package-version '(magit . "2.2.0") - :group 'magit-log - :type 'boolean) - -(defcustom magit-log-highlight-keywords t - "Whether to highlight bracketed keywords in commit summaries." - :package-version '(magit . "2.12.0") - :group 'magit-log - :type 'boolean) - -(defcustom magit-log-header-line-function #'magit-log-header-line-sentence - "Function used to generate text shown in header line of log buffers." - :package-version '(magit . "2.12.0") - :group 'magit-log - :type '(choice (function-item magit-log-header-line-arguments) - (function-item magit-log-header-line-sentence) - function)) - -(defcustom magit-log-trace-definition-function #'magit-which-function - "Function used to determine the function at point. -This is used by the command `magit-log-trace-definition'. -You should prefer `magit-which-function' over `which-function' -because the latter may make use of Imenu's outdated cache." - :package-version '(magit . "3.0.0") - :group 'magit-log - :type '(choice (function-item magit-which-function) - (function-item which-function) - (function-item add-log-current-defun) - function)) - -(defcustom magit-log-color-graph-limit 256 - "Number of commits over which log graphs are not colored. -When showing more commits than specified, then the `--color' -argument is silently dropped. This is necessary because the -`ansi-color' library, which is used to turn control sequences -into faces, is just too slow." - :package-version '(magit . "4.0.0") - :group 'magit-log - :type 'number) - -(defcustom magit-log-show-signatures-limit 256 - "Number of commits over which signatures are not verified. -When showing more commits than specified by this option, then the -`--show-signature' argument, if specified, is silently dropped. -This is necessary because checking the signature of a large -number of commits is just too slow." - :package-version '(magit . "4.0.0") - :group 'magit-log - :type 'number) - -(defface magit-log-graph - '((((class color) (background light)) :foreground "grey30") - (((class color) (background dark)) :foreground "grey80")) - "Face for the graph part of the log output." - :group 'magit-faces) - -(defface magit-log-author - '((((class color) (background light)) - :foreground "firebrick" - :slant normal - :weight normal) - (((class color) (background dark)) - :foreground "tomato" - :slant normal - :weight normal)) - "Face for the author part of the log output." - :group 'magit-faces) - -(defface magit-log-date - '((((class color) (background light)) - :foreground "grey30" - :slant normal - :weight normal) - (((class color) (background dark)) - :foreground "grey80" - :slant normal - :weight normal)) - "Face for the date part of the log output." - :group 'magit-faces) - -(defface magit-header-line-log-select - '((t :inherit bold)) - "Face for the `header-line' in `magit-log-select-mode'." - :group 'magit-faces) - -;;;; File Log - -(defcustom magit-log-buffer-file-locked t - "Whether `magit-log-buffer-file-quick' uses a dedicated buffer." - :package-version '(magit . "2.7.0") - :group 'magit-commands - :group 'magit-log - :type 'boolean) - -;;;; Select Mode - -(defcustom magit-log-select-show-usage 'both - "Whether to show usage information when selecting a commit from a log. -The message can be shown in the `echo-area' or the `header-line', or in -`both' places. If the value isn't one of these symbols, then it should -be nil, in which case no usage information is shown." - :package-version '(magit . "2.1.0") - :group 'magit-log - :type '(choice (const :tag "in echo-area" echo-area) - (const :tag "in header-line" header-line) - (const :tag "in both places" both) - (const :tag "nowhere"))) - -(defcustom magit-log-select-margin - (list (nth 0 magit-log-margin) - (nth 1 magit-log-margin) - 'magit-log-margin-width t - (nth 4 magit-log-margin)) - "Format of the margin in `magit-log-select-mode' buffers. - -The value has the form (INIT STYLE WIDTH AUTHOR AUTHOR-WIDTH). - -If INIT is non-nil, then the margin is shown initially. -STYLE controls how to format the author or committer date. - It can be one of `age' (to show the age of the commit), - `age-abbreviated' (to abbreviate the time unit to a character), - or a string (suitable for `format-time-string') to show the - actual date. Option `magit-log-margin-show-committer-date' - controls which date is being displayed. -WIDTH controls the width of the margin. This exists for forward - compatibility and currently the value should not be changed. -AUTHOR controls whether the name of the author is also shown by - default. -AUTHOR-WIDTH has to be an integer. When the name of the author - is shown, then this specifies how much space is used to do so." - :package-version '(magit . "2.9.0") - :group 'magit-log - :group 'magit-margin - :type magit-log-margin--custom-type - :initialize #'magit-custom-initialize-reset - :set-after '(magit-log-margin) - :set (apply-partially #'magit-margin-set-variable 'magit-log-select-mode)) - -;;;; Cherry Mode - -(defcustom magit-cherry-sections-hook - '(magit-insert-cherry-headers - magit-insert-cherry-commits) - "Hook run to insert sections into the cherry buffer." - :package-version '(magit . "2.1.0") - :group 'magit-log - :type 'hook) - -(defcustom magit-cherry-margin - (list (nth 0 magit-log-margin) - (nth 1 magit-log-margin) - 'magit-log-margin-width t - (nth 4 magit-log-margin)) - "Format of the margin in `magit-cherry-mode' buffers. - -The value has the form (INIT STYLE WIDTH AUTHOR AUTHOR-WIDTH). - -If INIT is non-nil, then the margin is shown initially. -STYLE controls how to format the author or committer date. - It can be one of `age' (to show the age of the commit), - `age-abbreviated' (to abbreviate the time unit to a character), - or a string (suitable for `format-time-string') to show the - actual date. Option `magit-log-margin-show-committer-date' - controls which date is being displayed. -WIDTH controls the width of the margin. This exists for forward - compatibility and currently the value should not be changed. -AUTHOR controls whether the name of the author is also shown by - default. -AUTHOR-WIDTH has to be an integer. When the name of the author - is shown, then this specifies how much space is used to do so." - :package-version '(magit . "2.9.0") - :group 'magit-log - :group 'magit-margin - :type magit-log-margin--custom-type - :initialize #'magit-custom-initialize-reset - :set-after '(magit-log-margin) - :set (apply-partially #'magit-margin-set-variable 'magit-cherry-mode)) - -;;;; Log Sections - -(defcustom magit-log-section-commit-count 10 - "How many recent commits to show in certain log sections. -How many recent commits `magit-insert-recent-commits' and -`magit-insert-unpulled-from-upstream-or-recent' (provided -the upstream isn't ahead of the current branch) show." - :package-version '(magit . "2.1.0") - :group 'magit-status - :type 'number) - -(defcustom magit-log-merged-commit-count 20 - "How many surrounding commits to show for `magit-log-merged'. -`magit-log-merged' will shows approximately half of this number -commits before and half after." - :package-version '(magit . "3.3.0") - :group 'magit-log - :type 'integer) - -;;; Arguments -;;;; Prefix Classes - -(defclass magit-log-prefix (transient-prefix) - ((history-key :initform 'magit-log) - (major-mode :initform 'magit-log-mode))) - -(defclass magit-log-refresh-prefix (magit-log-prefix) - ((history-key :initform 'magit-log) - (major-mode :initform nil))) - -;;;; Prefix Methods - -(cl-defmethod transient-init-value ((obj magit-log-prefix)) - (pcase-let ((`(,args ,files) - (magit-log--get-value 'magit-log-mode - magit-prefix-use-buffer-arguments))) - (unless (eq transient-current-command 'magit-dispatch) - (when-let ((file (magit-file-relative-name))) - (setq files (list file)))) - (oset obj value (if files `(("--" ,@files) ,args) args)))) - -(cl-defmethod transient-init-value ((obj magit-log-refresh-prefix)) - (oset obj value (if magit-buffer-log-files - `(("--" ,@magit-buffer-log-files) - ,magit-buffer-log-args) - magit-buffer-log-args))) - -(cl-defmethod transient-set-value ((obj magit-log-prefix)) - (magit-log--set-value obj)) - -(cl-defmethod transient-save-value ((obj magit-log-prefix)) - (magit-log--set-value obj 'save)) - -;;;; Argument Access - -(defun magit-log-arguments (&optional mode) - "Return the current log arguments." - (if (memq transient-current-command '(magit-log magit-log-refresh)) - (magit--transient-args-and-files) - (magit-log--get-value (or mode 'magit-log-mode)))) - -(defun magit-log--get-value (mode &optional use-buffer-args) - (unless use-buffer-args - (setq use-buffer-args magit-direct-use-buffer-arguments)) - (let (args files) - (cond - ((and (memq use-buffer-args '(always selected current)) - (eq major-mode mode)) - (setq args magit-buffer-log-args) - (setq files magit-buffer-log-files)) - ((and (memq use-buffer-args '(always selected)) - (when-let ((buffer (magit-get-mode-buffer - mode nil - (eq use-buffer-args 'selected)))) - (setq args (buffer-local-value 'magit-buffer-log-args buffer)) - (setq files (buffer-local-value 'magit-buffer-log-files buffer)) - t))) - ((plist-member (symbol-plist mode) 'magit-log-current-arguments) - (setq args (get mode 'magit-log-current-arguments))) - ((when-let ((elt (assq (intern (format "magit-log:%s" mode)) - transient-values))) - (setq args (cdr elt)) - t)) - (t - (setq args (get mode 'magit-log-default-arguments)))) - (list args files))) - -(defun magit-log--set-value (obj &optional save) - (pcase-let* ((obj (oref obj prototype)) - (mode (or (oref obj major-mode) major-mode)) - (key (intern (format "magit-log:%s" mode))) - (`(,args ,files) (magit--transient-args-and-files))) - (put mode 'magit-log-current-arguments args) - (when save - (setf (alist-get key transient-values) args) - (transient-save-values)) - (transient--history-push obj) - (setq magit-buffer-log-args args) - (unless (derived-mode-p 'magit-log-select-mode) - (setq magit-buffer-log-files files)) - (magit-refresh))) - -;;; Commands -;;;; Prefix Commands - -;;;###autoload (autoload 'magit-log "magit-log" nil t) -(transient-define-prefix magit-log () - "Show a commit or reference log." - :man-page "git-log" - :class 'magit-log-prefix - ;; The grouping in git-log(1) appears to be guided by implementation - ;; details, so our logical grouping only follows it to an extend. - ;; Arguments that are "misplaced" here: - ;; 1. From "Commit Formatting". - ;; 2. From "Common Diff Options". - ;; 3. From unnamed first group. - ;; 4. Implemented by Magit. - ["Commit limiting" - (magit-log:-n) - (magit:--author) - (7 magit-log:--since) - (7 magit-log:--until) - (magit-log:--grep) - (7 "-i" "Search case-insensitive" ("-i" "--regexp-ignore-case")) - (7 "-I" "Invert search pattern" "--invert-grep") - (magit-log:-G) ;2 - (magit-log:-S) ;2 - (magit-log:-L) ;2 - (7 "=m" "Omit merges" "--no-merges") - (7 "=p" "First parent" "--first-parent")] - ["History simplification" - ( "-D" "Simplify by decoration" "--simplify-by-decoration") - (magit:--) - ( "-f" "Follow renames when showing single-file log" "--follow") ;3 - (6 "/s" "Only commits changing given paths" "--sparse") - (7 "/d" "Only selected commits plus meaningful history" "--dense") - (7 "/a" "Only commits existing directly on ancestry path" "--ancestry-path") - (6 "/f" "Do not prune history" "--full-history") - (7 "/m" "Prune some history" "--simplify-merges")] - ["Commit ordering" - (magit-log:--*-order) - ("-r" "Reverse order" "--reverse")] - ["Formatting" - ("-g" "Show graph" "--graph") ;1 - ("-c" "Show graph in color" "--color") ;2 - ("-d" "Show refnames" "--decorate") ;3 - ("=S" "Show signatures" "--show-signature") ;1 - ("-h" "Show header" "++header") ;4 - ("-p" "Show diffs" ("-p" "--patch")) ;2 - ("-s" "Show diffstats" "--stat")] ;2 - [["Log" - ("l" "current" magit-log-current) - ("h" "HEAD" magit-log-head) - ("u" "related" magit-log-related) - ("o" "other" magit-log-other)] - ["" - ("L" "local branches" magit-log-branches) - ("b" "all branches" magit-log-all-branches) - ("a" "all references" magit-log-all) - (7 "B" "matching branches" magit-log-matching-branches) - (7 "T" "matching tags" magit-log-matching-tags) - (7 "m" "merged" magit-log-merged)] - ["Reflog" - ("r" "current" magit-reflog-current) - ("H" "HEAD" magit-reflog-head) - ("O" "other" magit-reflog-other)] - [:if (lambda () - (and (fboundp 'magit--any-wip-mode-enabled-p) - (magit--any-wip-mode-enabled-p))) - :description "Wiplog" - ("i" "index" magit-wip-log-index) - ("w" "worktree" magit-wip-log-worktree)] - ["Other" - (5 "s" "shortlog" magit-shortlog)]]) - -;;;###autoload (autoload 'magit-log-refresh "magit-log" nil t) -(transient-define-prefix magit-log-refresh () - "Change the arguments used for the log(s) in the current buffer." - :man-page "git-log" - :class 'magit-log-refresh-prefix - [:if-mode magit-log-mode - :class transient-subgroups - ["Commit limiting" - (magit-log:-n) - (magit:--author) - (magit-log:--grep) - (7 "-i" "Search case-insensitive" ("-i" "--regexp-ignore-case")) - (7 "-I" "Invert search pattern" "--invert-grep") - (magit-log:-G) - (magit-log:-S) - (magit-log:-L)] - ["History simplification" - ( "-D" "Simplify by decoration" "--simplify-by-decoration") - (magit:--) - ( "-f" "Follow renames when showing single-file log" "--follow") ;3 - (6 "/s" "Only commits changing given paths" "--sparse") - (7 "/d" "Only selected commits plus meaningful history" "--dense") - (7 "/a" "Only commits existing directly on ancestry path" "--ancestry-path") - (6 "/f" "Do not prune history" "--full-history") - (7 "/m" "Prune some history" "--simplify-merges")] - ["Commit ordering" - (magit-log:--*-order) - ("-r" "Reverse order" "--reverse")] - ["Formatting" - ("-g" "Show graph" "--graph") - ("-c" "Show graph in color" "--color") - ("-d" "Show refnames" "--decorate") - ("=S" "Show signatures" "--show-signature") - ("-h" "Show header" "++header") - ("-p" "Show diffs" ("-p" "--patch")) - ("-s" "Show diffstats" "--stat")]] - [:if-not-mode magit-log-mode - :description "Arguments" - (magit-log:-n) - (magit-log:--*-order) - ("-g" "Show graph" "--graph") - ("-c" "Show graph in color" "--color") - ("-d" "Show refnames" "--decorate")] - [["Refresh" - ("g" "buffer" magit-log-refresh) - ("s" "buffer and set defaults" transient-set-and-exit) - ("w" "buffer and save defaults" transient-save-and-exit)] - ["Margin" - (magit-toggle-margin) - (magit-cycle-margin-style) - (magit-toggle-margin-details) - (magit-toggle-log-margin-style)] - [:if-mode magit-log-mode - :description "Toggle" - ("b" "buffer lock" magit-toggle-buffer-lock)]] - (interactive) - (cond - ((not (eq transient-current-command 'magit-log-refresh)) - (pcase major-mode - ('magit-reflog-mode - (user-error "Cannot change log arguments in reflog buffers")) - ('magit-cherry-mode - (user-error "Cannot change log arguments in cherry buffers"))) - (transient-setup 'magit-log-refresh)) - (t - (pcase-let ((`(,args ,files) (magit-log-arguments))) - (setq magit-buffer-log-args args) - (unless (derived-mode-p 'magit-log-select-mode) - (setq magit-buffer-log-files files))) - (magit-refresh)))) - -;;;; Infix Commands - -(transient-define-argument magit-log:-n () - :description "Limit number of commits" - :class 'transient-option - ;; For historic reasons (and because it easy to guess what "-n" - ;; stands for) this is the only argument where we do not use the - ;; long argument ("--max-count"). - :shortarg "-n" - :argument "-n" - :reader #'transient-read-number-N+) - -(transient-define-argument magit:--author () - :description "Limit to author" - :class 'transient-option - :key "-A" - :argument "--author=" - :reader #'magit-transient-read-person) - -(transient-define-argument magit-log:--since () - :description "Limit to commits since" - :class 'transient-option - :key "=s" - :argument "--since=" - :reader #'transient-read-date) - -(transient-define-argument magit-log:--until () - :description "Limit to commits until" - :class 'transient-option - :key "=u" - :argument "--until=" - :reader #'transient-read-date) - -(transient-define-argument magit-log:--*-order () - :description "Order commits by" - :class 'transient-switches - :key "-o" - :argument-format "--%s-order" - :argument-regexp "\\(--\\(topo\\|author-date\\|date\\)-order\\)" - :choices '("topo" "author-date" "date")) - -(transient-define-argument magit-log:--grep () - :description "Search messages" - :class 'transient-option - :key "-F" - :argument "--grep=") - -(transient-define-argument magit-log:-G () - :description "Search changes" - :class 'transient-option - :argument "-G") - -(transient-define-argument magit-log:-S () - :description "Search occurrences" - :class 'transient-option - :argument "-S") - -(transient-define-argument magit-log:-L () - :description "Trace line evolution" - :class 'transient-option - :argument "-L" - :reader #'magit-read-file-trace) - -(defun magit-read-file-trace (&rest _ignored) - (let ((file (magit-read-file-from-rev "HEAD" "File")) - (trace (magit-read-string "Trace"))) - (concat trace ":" file))) - -;;;; Setup Commands - -(defvar-keymap magit-log-read-revs-map - :parent crm-local-completion-map - "SPC" #'self-insert-command) - -(defun magit-log-read-revs (&optional use-current) - (or (and use-current (and-let* ((buf (magit-get-current-branch))) (list buf))) - (let ((crm-separator "\\(\\.\\.\\.?\\|[, ]\\)") - (crm-local-completion-map magit-log-read-revs-map)) - (split-string (magit-completing-read-multiple - "Log rev,s: " - (magit-list-refnames nil t) - nil nil nil 'magit-revision-history - (or (magit-branch-or-commit-at-point) - (and (not use-current) - (magit-get-previous-branch))) - nil t) - "[, ]" t)))) - -(defun magit-log-read-pattern (option) - "Read a string from the user to pass as parameter to OPTION." - (magit-read-string (format "Type a pattern to pass to %s" option))) - -;;;###autoload -(defun magit-log-current (revs &optional args files) - "Show log for the current branch. -When `HEAD' is detached or with a prefix argument show log for -one or more revs read from the minibuffer." - (interactive (cons (magit-log-read-revs t) - (magit-log-arguments))) - (magit-log-setup-buffer revs args files)) - -;;;###autoload -(defun magit-log-head (&optional args files) - "Show log for `HEAD'." - (interactive (magit-log-arguments)) - (magit-log-setup-buffer (list "HEAD") args files)) - -;;;###autoload -(defun magit-log-related (revs &optional args files) - "Show log for the current branch, its upstream and its push target. -When the upstream is a local branch, then also show its own -upstream. When `HEAD' is detached, then show log for that, the -previously checked out branch and its upstream and push-target." - (interactive - (cons (let ((current (magit-get-current-branch)) - head rebase target upstream upup) - (unless current - (setq rebase (magit-rebase--get-state-lines "head-name")) - (cond (rebase - (setq rebase (magit-ref-abbrev rebase)) - (setq current rebase) - (setq head "HEAD")) - ((setq current (magit-get-previous-branch))))) - (cond (current - (setq current - (magit--propertize-face current 'magit-branch-local)) - (setq target (magit-get-push-branch current t)) - (setq upstream (magit-get-upstream-branch current)) - (when upstream - (setq upup (and (magit-local-branch-p upstream) - (magit-get-upstream-branch upstream))))) - ((setq head "HEAD"))) - (delq nil (list current head target upstream upup))) - (magit-log-arguments))) - (magit-log-setup-buffer revs args files)) - -;;;###autoload -(defun magit-log-other (revs &optional args files) - "Show log for one or more revs read from the minibuffer. -The user can input any revision or revisions separated by a -space, or even ranges, but only branches and tags, and a -representation of the commit at point, are available as -completion candidates." - (interactive (cons (magit-log-read-revs) - (magit-log-arguments))) - (magit-log-setup-buffer revs args files)) - -;;;###autoload -(defun magit-log-branches (&optional args files) - "Show log for all local branches and `HEAD'." - (interactive (magit-log-arguments)) - (magit-log-setup-buffer (if (magit-get-current-branch) - (list "--branches") - (list "HEAD" "--branches")) - args files)) - -;;;###autoload -(defun magit-log-matching-branches (pattern &optional args files) - "Show log for all branches matching PATTERN and `HEAD'." - (interactive (cons (magit-log-read-pattern "--branches") (magit-log-arguments))) - (magit-log-setup-buffer - (list "HEAD" (format "--branches=%s" pattern)) - args files)) - -;;;###autoload -(defun magit-log-matching-tags (pattern &optional args files) - "Show log for all tags matching PATTERN and `HEAD'." - (interactive (cons (magit-log-read-pattern "--tags") (magit-log-arguments))) - (magit-log-setup-buffer - (list "HEAD" (format "--tags=%s" pattern)) - args files)) - -;;;###autoload -(defun magit-log-all-branches (&optional args files) - "Show log for all local and remote branches and `HEAD'." - (interactive (magit-log-arguments)) - (magit-log-setup-buffer (if (magit-get-current-branch) - (list "--branches" "--remotes") - (list "HEAD" "--branches" "--remotes")) - args files)) - -;;;###autoload -(defun magit-log-all (&optional args files) - "Show log for all references and `HEAD'." - (interactive (magit-log-arguments)) - (magit-log-setup-buffer (if (magit-get-current-branch) - (list "--all") - (list "HEAD" "--all")) - args files)) - -;;;###autoload -(defun magit-log-buffer-file (&optional follow beg end) - "Show log for the blob or file visited in the current buffer. -With a prefix argument or when `--follow' is an active log -argument, then follow renames. When the region is active, -restrict the log to the lines that the region touches." - (interactive - (cons current-prefix-arg - (and (region-active-p) - (magit-file-relative-name) - (not (derived-mode-p 'dired-mode)) - (save-restriction - (widen) - (list (line-number-at-pos (region-beginning)) - (line-number-at-pos - (let ((end (region-end))) - (if (char-after end) - end - ;; Ensure that we don't get the line number - ;; of a trailing newline. - (1- end))))))))) - (require 'magit) - (if-let ((file (magit-file-relative-name))) - (magit-log-setup-buffer - (list (or magit-buffer-refname - (magit-get-current-branch) - "HEAD")) - (let ((args (car (magit-log-arguments)))) - (when (and follow (not (member "--follow" args))) - (push "--follow" args)) - (when (and beg end) - (setq args (cons (format "-L%s,%s:%s" beg end file) - (cl-delete "-L" args :test - #'string-prefix-p))) - (setq file nil)) - args) - (and file (list file)) - magit-log-buffer-file-locked) - (user-error "Buffer isn't visiting a file"))) - -;;;###autoload -(defun magit-log-trace-definition (file fn rev) - "Show log for the definition at point." - (interactive (list (or (magit-file-relative-name) - (user-error "Buffer isn't visiting a file")) - (or (funcall magit-log-trace-definition-function) - (user-error "No function at point found")) - (or magit-buffer-refname - (magit-get-current-branch) - "HEAD"))) - (require 'magit) - (magit-log-setup-buffer - (list rev) - (cons (format "-L:%s%s:%s" - (string-replace ":" "\\:" (regexp-quote fn)) - (if (derived-mode-p 'lisp-mode 'emacs-lisp-mode) - ;; Git doesn't treat "-" the same way as - ;; "_", leading to false-positives such as - ;; "foo-suffix" being considered a match - ;; for "foo". Wing it. - "\\( \\|$\\)" - ;; We could use "\\b" here, but since Git - ;; already does something equivalent, that - ;; isn't necessary. - "") - file) - (cl-delete "-L" (car (magit-log-arguments)) - :test #'string-prefix-p)) - nil magit-log-buffer-file-locked)) - -(defun magit-diff-trace-definition () - "Show log for the definition at point in a diff." - (interactive) - (pcase-let ((`(,buf ,pos) (magit-diff-visit-file--noselect))) - (magit--with-temp-position buf pos - (call-interactively #'magit-log-trace-definition)))) - -;;;###autoload -(defun magit-log-merged (commit branch &optional args files) - "Show log for the merge of COMMIT into BRANCH. - -More precisely, find merge commit M that brought COMMIT into -BRANCH, and show the log of the range \"M^1..M\". If COMMIT is -directly on BRANCH, then show approximately -`magit-log-merged-commit-count' surrounding commits instead. - -This command requires git-when-merged, which is available from -https://github.com/mhagger/git-when-merged." - (interactive - (append (let ((commit (magit-read-branch-or-commit "Log merge of commit"))) - (list commit - (magit-read-other-branch "Merged into" commit))) - (magit-log-arguments))) - (unless (magit-git-executable-find "git-when-merged") - (user-error "This command requires git-when-merged (%s)" - "https://github.com/mhagger/git-when-merged")) - (let (exit m) - (with-temp-buffer - (save-excursion - (setq exit (magit-process-git t "when-merged" "-c" - (magit-abbrev-arg) - commit branch))) - (setq m (buffer-substring-no-properties (point) (line-end-position)))) - (if (zerop exit) - (magit-log-setup-buffer (list (format "%s^1..%s" m m)) - args files nil commit) - ;; Output: "<ref><lots of spaces><message>". - ;; This is not the same as `string-trim'. - (setq m (string-trim-left (substring m (string-match " " m)))) - (if (equal m "Commit is directly on this branch.") - (let* ((from (format "%s~%d" commit - (/ magit-log-merged-commit-count 2))) - (to (- (car (magit-rev-diff-count branch commit t)) - (/ magit-log-merged-commit-count 2))) - (to (if (<= to 0) - branch - (format "%s~%s" branch to)))) - (unless (magit-rev-verify-commit from) - (setq from (magit-git-string "rev-list" "--max-parents=0" - commit))) - (magit-log-setup-buffer (list (concat from ".." to)) - (cons "--first-parent" args) - files nil commit)) - (user-error "Could not find when %s was merged into %s: %s" - commit branch m))))) - -;;;; Limit Commands - -(defun magit-log-toggle-commit-limit () - "Toggle the number of commits the current log buffer is limited to. -If the number of commits is currently limited, then remove that -limit. Otherwise set it to 256." - (interactive) - (magit-log-set-commit-limit (lambda (&rest _) nil))) - -(defun magit-log-double-commit-limit () - "Double the number of commits the current log buffer is limited to." - (interactive) - (magit-log-set-commit-limit '*)) - -(defun magit-log-half-commit-limit () - "Half the number of commits the current log buffer is limited to." - (interactive) - (magit-log-set-commit-limit '/)) - -(defun magit-log-set-commit-limit (fn) - (let* ((val magit-buffer-log-args) - (arg (--first (string-match "^-n\\([0-9]+\\)?$" it) val)) - (num (and arg (string-to-number (match-string 1 arg)))) - (num (if num (funcall fn num 2) 256))) - (setq val (remove arg val)) - (setq magit-buffer-log-args - (if (and num (> num 0)) - (cons (format "-n%d" num) val) - val))) - (magit-refresh)) - -(defun magit-log-get-commit-limit (&optional args) - (and-let* ((str (--first (string-match "^-n\\([0-9]+\\)?$" it) - (or args magit-buffer-log-args)))) - (string-to-number (match-string 1 str)))) - -;;;; Mode Commands - -(defun magit-log-bury-buffer (&optional arg) - "Bury the current buffer or the revision buffer in the same frame. -Like `magit-mode-bury-buffer' (which see) but with a negative -prefix argument instead bury the revision buffer, provided it -is displayed in the current frame." - (interactive "p") - (if (< arg 0) - (let* ((buf (magit-get-mode-buffer 'magit-revision-mode)) - (win (and buf (get-buffer-window buf (selected-frame))))) - (if win - (with-selected-window win - (with-current-buffer buf - (magit-mode-bury-buffer (> (abs arg) 1)))) - (user-error "No revision buffer in this frame"))) - (magit-mode-bury-buffer (> arg 1)))) - -;;;###autoload -(defun magit-log-move-to-parent (&optional n) - "Move to the Nth parent of the current commit." - (interactive "p") - (when (derived-mode-p 'magit-log-mode) - (when (magit-section-match 'commit) - (let* ((section (magit-current-section)) - (parent-rev (format "%s^%s" (oref section value) (or n 1)))) - (if-let ((parent-hash (magit-rev-parse "--short" parent-rev))) - (if-let ((parent (--first (equal (oref it value) - parent-hash) - (magit-section-siblings section 'next)))) - (magit-section-goto parent) - (user-error - (substitute-command-keys - (concat "Parent " parent-hash " not found. Try typing " - "\\[magit-log-double-commit-limit] first")))) - (user-error "Parent %s does not exist" parent-rev)))))) - -(defun magit-log-move-to-revision (rev) - "Read a revision and move to it in current log buffer. - -If the chosen reference or revision isn't being displayed in -the current log buffer, then inform the user about that and do -nothing else. - -If invoked outside any log buffer, then display the log buffer -of the current repository first; creating it if necessary." - (interactive - (list (or (magit-completing-read - "In log, jump to" - (magit-list-refnames nil t) - nil nil nil 'magit-revision-history - (or (and-let* ((rev (magit-commit-at-point))) - (magit-rev-fixup-target rev)) - (magit-get-current-branch))) - (user-error "Nothing selected")))) - (with-current-buffer - (cond ((derived-mode-p 'magit-log-mode) - (current-buffer)) - ((and-let* ((buf (magit-get-mode-buffer 'magit-log-mode))) - (pop-to-buffer-same-window buf))) - (t - (apply #'magit-log-all-branches (magit-log-arguments)))) - (unless (magit-log-goto-commit-section (magit-rev-abbrev rev)) - (user-error "%s isn't visible in the current log buffer" rev)))) - -;;;; Shortlog Commands - -;;;###autoload (autoload 'magit-shortlog "magit-log" nil t) -(transient-define-prefix magit-shortlog () - "Show a history summary." - :man-page "git-shortlog" - :value '("--numbered" "--summary") - ["Arguments" - ("-n" "Sort by number of commits" ("-n" "--numbered")) - ("-s" "Show commit count summary only" ("-s" "--summary")) - ("-e" "Show email addresses" ("-e" "--email")) - ("-g" "Group commits by" "--group=" - :choices ("author" "committer" "trailer:")) - (7 "-f" "Format string" "--format=") - (7 "-w" "Linewrap" "-w" :class transient-option)] - ["Shortlog" - ("s" "since" magit-shortlog-since) - ("r" "range" magit-shortlog-range)]) - -(defun magit-git-shortlog (rev args) - (let ((dir default-directory)) - (with-current-buffer (get-buffer-create "*magit-shortlog*") - (setq default-directory dir) - (setq buffer-read-only t) - (let ((inhibit-read-only t)) - (erase-buffer) - (save-excursion - (magit-git-insert "shortlog" args rev)) - (switch-to-buffer-other-window (current-buffer)))))) - -;;;###autoload -(defun magit-shortlog-since (rev args) - "Show a history summary for commits since REV." - (interactive - (list (magit-read-branch-or-commit "Shortlog since" (magit-get-current-tag)) - (transient-args 'magit-shortlog))) - (magit-git-shortlog (concat rev "..") args)) - -;;;###autoload -(defun magit-shortlog-range (rev-or-range args) - "Show a history summary for commit or range REV-OR-RANGE." - (interactive - (list (magit-read-range-or-commit "Shortlog for revision or range") - (transient-args 'magit-shortlog))) - (magit-git-shortlog rev-or-range args)) - -;;; Log Mode - -(defvar magit-log-disable-graph-hack-args - '("-G" "--grep" "--author") - "Arguments which disable the graph speedup hack.") - -(defvar-keymap magit-log-mode-map - :doc "Keymap for `magit-log-mode'." - :parent magit-mode-map - "C-c C-b" #'magit-go-backward - "C-c C-f" #'magit-go-forward - "C-c C-n" #'magit-log-move-to-parent - "j" #'magit-log-move-to-revision - "=" #'magit-log-toggle-commit-limit - "+" #'magit-log-double-commit-limit - "-" #'magit-log-half-commit-limit - "q" #'magit-log-bury-buffer) - -(define-derived-mode magit-log-mode magit-mode "Magit Log" - "Mode for looking at Git log. - -This mode is documented in info node `(magit)Log Buffer'. - -\\<magit-mode-map>\ -Type \\[magit-refresh] to refresh the current buffer. -Type \\[magit-visit-thing] or \\[magit-diff-show-or-scroll-up] \ -to visit the commit at point. - -Type \\[magit-branch] to see available branch commands. -Type \\[magit-merge] to merge the branch or commit at point. -Type \\[magit-cherry-pick] to apply the commit at point. -Type \\[magit-reset] to reset `HEAD' to the commit at point. - -\\{magit-log-mode-map}" - :group 'magit-log - (hack-dir-local-variables-non-file-buffer) - (setq magit--imenu-item-types 'commit)) - -(put 'magit-log-mode 'magit-log-default-arguments - '("--graph" "-n256" "--decorate")) - -(defun magit-log-setup-buffer (revs args files &optional locked focus) - (require 'magit) - (with-current-buffer - (magit-setup-buffer #'magit-log-mode locked - (magit-buffer-revisions revs) - (magit-buffer-log-args args) - (magit-buffer-log-files files)) - (when (if focus - (magit-log-goto-commit-section focus) - (magit-log-goto-same-commit)) - (magit-section-update-highlight)) - (current-buffer))) - -(defun magit-log-refresh-buffer () - (let ((revs magit-buffer-revisions) - (args magit-buffer-log-args) - (files magit-buffer-log-files) - (limit (magit-log-get-commit-limit))) - (magit-set-header-line-format - (funcall magit-log-header-line-function revs args files)) - (unless (length= files 1) - (setq args (remove "--follow" args))) - (when (and (car magit-log-remove-graph-args) - (--any-p (string-match-p - (concat "^" (regexp-opt magit-log-remove-graph-args)) it) - args)) - (setq args (remove "--graph" args))) - (setq args (magit-log--maybe-drop-color-graph args limit)) - (when-let* ((limit limit) - (limit (* 2 limit)) ; increase odds for complete graph - (count (and (length= revs 1) - (> limit 1024) ; otherwise it's fast enough - (setq revs (car revs)) - (not (string-search ".." revs)) - (not (member revs '("--all" "--branches"))) - (not (seq-some - (lambda (arg) - (--any-p (string-prefix-p it arg) - magit-log-disable-graph-hack-args)) - args)) - (magit-git-string "rev-list" "--count" - "--first-parent" args revs)))) - (setq revs (if (< (string-to-number count) limit) - revs - (format "%s~%s..%s" revs limit revs)))) - (let ((delay (cl-find-if (lambda (arg) - (member arg '("++header" "--patch" "--stat"))) - args))) - (setq magit-section-inhibit-markers (if delay 'delay t)) - (setq magit-section-insert-in-reverse (not delay))) - (magit-insert-section (logbuf) - (magit--insert-log t revs args files)))) - -(defvar-local magit-log--color-graph nil) - -(defun magit-log--maybe-drop-color-graph (args limit) - (if (member "--color" args) - (if (cond ((not (member "--graph" args))) - ((not magit-log-color-graph-limit) nil) - ((not limit) - (message "Dropping --color because -n isn't set (see %s)" - 'magit-log-color-graph-limit)) - ((> limit magit-log-color-graph-limit) - (message "Dropping --color because -n is larger than %s" - 'magit-log-color-graph-limit))) - (progn (setq args (remove "--color" args)) - (setq magit-log--color-graph nil)) - (setq magit-log--color-graph t)) - (setq magit-log--color-graph nil)) - args) - -(cl-defmethod magit-buffer-value (&context (major-mode magit-log-mode)) - (append magit-buffer-revisions - (if (and magit-buffer-revisions magit-buffer-log-files) - (cons "--" magit-buffer-log-files) - magit-buffer-log-files))) - -(defun magit-log-header-line-arguments (revs args files) - "Return string describing some of the used arguments." - (mapconcat (lambda (arg) - (if (string-search " " arg) - (prin1 arg) - arg)) - `("git" "log" ,@args ,@revs "--" ,@files) - " ")) - -(defun magit-log-header-line-sentence (revs args files) - "Return string containing all arguments." - (concat "Commits in " - (mapconcat #'identity revs " ") - (and (member "--reverse" args) - " in reverse") - (and files (concat " touching " - (mapconcat #'identity files " "))) - (--some (and (string-prefix-p "-L" it) - (concat " " it)) - args))) - -(defun magit-insert-log (revs &optional args files) - (declare (obsolete magit--insert-log "Magit 4.0.0")) - (magit--insert-log nil revs args files)) - -(defun magit--insert-log (keep-error revs &optional args files) - "Insert a log section. -Do not add this to a hook variable." - (declare (indent defun)) - (setq magit-section-preserve-visibility t) ; TODO do it here? - (let ((magit-git-global-arguments - (remove "--literal-pathspecs" magit-git-global-arguments))) - (magit--git-wash (apply-partially #'magit-log-wash-log 'log) keep-error - "log" - (format "--format=%s%%h%%x0c%s%%x0c%s%%x0c%%aN%%x0c%s%%x0c%%s%s" - (if (and (member "--left-right" args) - (not (member "--graph" args))) - "%m " - "") - (if (member "--decorate" args) "%D" "") - (if (not (member "--show-signature" args)) - "" - (setq args (remove "--show-signature" args)) - (let ((limit (magit-log-get-commit-limit args))) - (cond - ((not limit) - (message - "Dropping --show-signature because -n isn't set (see %s)" - 'magit-log-show-signatures-limit) - "") - ((> limit magit-log-show-signatures-limit) - (message - "Dropping --show-signature because -n is larger than %s" - 'magit-log-show-signatures-limit) - "") - ("%G?")))) - (if magit-log-margin-show-committer-date "%ct" "%at") - (if (member "++header" args) - (if (member "--graph" (setq args (remove "++header" args))) - (concat "\n" magit-log-revision-headers-format "\n") - (concat "\n" magit-log-revision-headers-format "\n")) - "")) - (progn - (when-let ((order (--first (string-match "^\\+\\+order=\\(.+\\)$" it) - args))) - (setq args (cons (format "--%s-order" (match-string 1 order)) - (remove order args)))) - (when (member "--decorate" args) - (setq args (cons "--decorate=full" (remove "--decorate" args)))) - (when (member "--reverse" args) - (setq args (remove "--graph" args))) - (setq args (magit-diff--maybe-add-stat-arguments args)) - args) - "--use-mailmap" "--no-prefix" revs "--" files))) - -(cl-defmethod magit-menu-common-value ((_section magit-commit-section)) - (or (magit-diff--region-range) - (oref (magit-current-section) value))) - -(defvar-keymap magit-commit-section-map - :doc "Keymap for `commit' sections." - "<remap> <magit-visit-thing>" #'magit-show-commit - "<3>" (magit-menu-item "Apply %x" #'magit-cherry-apply) - "<2>" (magit-menu-item "Show commit %x" #'magit-show-commit - '(:visible (not (region-active-p)))) - "<1>" (magit-menu-item "Diff %x" #'magit-diff-range - '(:visible (region-active-p)))) - -(defvar-keymap magit-module-commit-section-map - :doc "Keymap for `module-commit' sections." - :parent magit-commit-section-map) - -(defconst magit-log-heading-re - ;; Note: A form feed instead of a null byte is used as the delimiter - ;; because using the latter interferes with the graph prefix when - ;; ++header is used. - (concat "^" - "\\(?4:[-_/|\\*o<>. ]*\\)" ; graph - "\\(?1:[0-9a-fA-F]+\\)? " ; hash - "\\(?3:[^ \n]+\\)? " ; refs - "\\(?7:[BGUXYREN]\\)? " ; gpg - "\\(?5:[^ \n]*\\) " ; author - ;; Note: Date is optional because, prior to Git v2.19.0, - ;; `git rebase -i --root` corrupts the root's author date. - "\\(?6:[^ \n]*\\) " ; date - "\\(?2:.*\\)$")) ; msg - -(defconst magit-log-cherry-re - (concat "^" - "\\(?8:[-+]\\) " ; cherry - "\\(?1:[0-9a-fA-F]+\\) " ; hash - "\\(?2:.*\\)$")) ; msg - -(defconst magit-log-module-re - (concat "^" - "\\(?:\\(?11:[<>]\\) \\)?" ; side - "\\(?1:[0-9a-fA-F]+\\) " ; hash - "\\(?2:.*\\)$")) ; msg - -(defconst magit-log-bisect-vis-re - (concat "^" - "\\(?4:[-_/|\\*o<>. ]*\\)" ; graph - "\\(?1:[0-9a-fA-F]+\\)?\0" ; hash - "\\(?3:[^\0\n]+\\)?\0" ; refs - "\\(?2:.*\\)$")) ; msg - -(defconst magit-log-bisect-log-re - (concat "^# " - "\\(?3:[^: \n]+:\\) " ; "refs" - "\\[\\(?1:[^]\n]+\\)\\] " ; hash - "\\(?2:.*\\)$")) ; msg - -(defconst magit-log-reflog-re - (concat "^" - "\\(?1:[^\0\n]+\\)\0" ; hash - "\\(?5:[^\0\n]*\\)\0" ; author - "\\(?:\\(?:[^@\n]+@{\\(?6:[^}\n]+\\)}\0" ; date - ;;; refsub - "\\(?10:merge \\|autosave \\|restart \\|rewritten \\|[^:\n]+: \\)?" - "\\(?2:.*\\)\\)\\|\0\\)$")) ; msg - -(defconst magit-reflog-subject-re - (concat "\\(?1:[^ ]+\\) ?" ; command - "\\(?2:\\(?: ?-[^ ]+\\)+\\)?" ; option - "\\(?: ?(\\(?3:[^)]+\\))\\)?")) ; type - -(defconst magit-log-stash-re - (concat "^" - "\\(?1:[^\0\n]+\\)\0" ; "hash" - "\\(?5:[^\0\n]*\\)\0" ; author - "\\(?6:[^\0\n]+\\)\0" ; date - "\\(?2:.*\\)$")) ; msg - -(defvar magit-log-count nil) - -(defvar magit-log-format-message-function #'magit-log-propertize-keywords) - -(defun magit-log-wash-log (style args) - (setq args (flatten-tree args)) - (when (if (derived-mode-p 'magit-log-mode) - magit-log--color-graph - (and (member "--graph" args) - (member "--color" args))) - (let ((ansi-color-apply-face-function - (lambda (beg end face) - (put-text-property beg end 'font-lock-face - (or face 'magit-log-graph))))) - (ansi-color-apply-on-region (point-min) (point-max)))) - (when (eq style 'cherry) - (reverse-region (point-min) (point-max))) - (let ((magit-log-count 0)) - (when (looking-at "^\\.\\.\\.") - (magit-delete-line)) - (magit-wash-sequence (apply-partially #'magit-log-wash-rev style - (magit-abbrev-length))) - (if (derived-mode-p 'magit-log-mode 'magit-reflog-mode) - (when (eq magit-log-count (magit-log-get-commit-limit)) - (magit-insert-section (longer) - (insert-text-button - (substitute-command-keys - (format "Type \\<%s>\\[%s] to show more history" - 'magit-log-mode-map - 'magit-log-double-commit-limit)) - 'action (lambda (_button) - (magit-log-double-commit-limit)) - 'follow-link t - 'mouse-face 'magit-section-highlight))) - (insert ?\n)))) - -(cl-defun magit-log-wash-rev (style abbrev) - (when (derived-mode-p 'magit-log-mode 'magit-reflog-mode) - (cl-incf magit-log-count)) - (looking-at (pcase style - ('log magit-log-heading-re) - ('cherry magit-log-cherry-re) - ('module magit-log-module-re) - ('reflog magit-log-reflog-re) - ('stash magit-log-stash-re) - ('bisect-vis magit-log-bisect-vis-re) - ('bisect-log magit-log-bisect-log-re))) - (magit-bind-match-strings - (hash msg refs graph author date gpg cherry _ refsub side) nil - (setq msg (substring-no-properties msg)) - (when refs - (setq refs (substring-no-properties refs))) - (let ((align (or (eq style 'cherry) - (not (member "--stat" magit-buffer-log-args)))) - (non-graph-re (if (eq style 'bisect-vis) - magit-log-bisect-vis-re - magit-log-heading-re))) - (magit-delete-line) - ;; If the reflog entries have been pruned, the output of `git - ;; reflog show' includes a partial line that refers to the hash - ;; of the youngest expired reflog entry. - (when (and (eq style 'reflog) (not date)) - (cl-return-from magit-log-wash-rev t)) - (magit-insert-section - ((eval (pcase style - ('stash 'stash) - ('module 'module-commit) - (_ 'commit))) - hash) - (setq hash (propertize (if (eq style 'bisect-log) - (magit-rev-parse "--short" hash) - hash) - 'font-lock-face - (pcase (and gpg (aref gpg 0)) - (?G 'magit-signature-good) - (?B 'magit-signature-bad) - (?U 'magit-signature-untrusted) - (?X 'magit-signature-expired) - (?Y 'magit-signature-expired-key) - (?R 'magit-signature-revoked) - (?E 'magit-signature-error) - (?N 'magit-hash) - (_ 'magit-hash)))) - (when cherry - (when (and (derived-mode-p 'magit-refs-mode) - magit-refs-show-commit-count) - (insert (make-string (1- magit-refs-focus-column-width) ?\s))) - (insert (propertize cherry 'font-lock-face - (if (string= cherry "-") - 'magit-cherry-equivalent - 'magit-cherry-unmatched))) - (insert ?\s)) - (when side - (insert (propertize side 'font-lock-face - (if (string= side "<") - 'magit-cherry-equivalent - 'magit-cherry-unmatched))) - (insert ?\s)) - (when align - (insert hash ?\s)) - (when graph - (insert graph)) - (unless align - (insert hash ?\s)) - (when (and refs (not magit-log-show-refname-after-summary)) - (insert (magit-format-ref-labels refs) ?\s)) - (when (eq style 'reflog) - (insert (format "%-2s " (1- magit-log-count))) - (when refsub - (insert (magit-reflog-format-subject - (substring refsub 0 - (if (string-search ":" refsub) -2 -1)))))) - (insert (funcall magit-log-format-message-function hash msg)) - (when (and refs magit-log-show-refname-after-summary) - (insert ?\s) - (insert (magit-format-ref-labels refs))) - (insert ?\n) - (when (memq style '(log reflog stash)) - (goto-char (line-beginning-position)) - (when (and refsub - (string-match "\\`\\([^ ]\\) \\+\\(..\\)\\(..\\)" date)) - (setq date (+ (string-to-number (match-string 1 date)) - (* (string-to-number (match-string 2 date)) 60 60) - (* (string-to-number (match-string 3 date)) 60)))) - (save-excursion - (backward-char) - (magit-log-format-margin hash author date))) - (when (and (eq style 'cherry) - (magit-buffer-margin-p)) - (save-excursion - (backward-char) - (apply #'magit-log-format-margin hash - (split-string (magit-rev-format "%aN%x00%ct" hash) "\0")))) - (when (and graph - (not (eobp)) - (not (looking-at non-graph-re))) - (when (looking-at "") - (magit-insert-heading) - (delete-char 1) - (magit-insert-section (commit-header) - (forward-line) - (magit-insert-heading) - (re-search-forward "") - (delete-char -1) - (forward-char) - (insert ?\n)) - (delete-char 1)) - (if (looking-at "^\\(---\\|\n\s\\|\ndiff\\)") - (let ((limit (save-excursion - (and (re-search-forward non-graph-re nil t) - (match-beginning 0))))) - (unless (oref magit-insert-section--current content) - (magit-insert-heading)) - (delete-char (if (looking-at "\n") 1 4)) - (magit-diff-wash-diffs (list "--stat") limit)) - (when align - (setq align (make-string (1+ abbrev) ? ))) - (when (and (not (eobp)) (not (looking-at non-graph-re))) - (when align - (setq align (make-string (1+ abbrev) ? ))) - (while (and (not (eobp)) (not (looking-at non-graph-re))) - (when align - (save-excursion (insert align))) - (magit-make-margin-overlay) - (forward-line)) - ;; When `--format' is used and its value isn't one of the - ;; predefined formats, then `git-log' does not insert a - ;; separator line. - (save-excursion - (forward-line -1) - (looking-at "[-_/|\\*o<>. ]*")) - (setq graph (match-string 0)) - (unless (string-match-p "[/\\.]" graph) - (insert graph ?\n)))))))) - t) - -(defun magit-log-propertize-keywords (_rev msg) - (let ((boundary 0)) - (when (string-match "^\\(?:squash\\|fixup\\)! " msg boundary) - (setq boundary (match-end 0)) - (magit--put-face (match-beginning 0) (1- boundary) - 'magit-keyword-squash msg)) - (when magit-log-highlight-keywords - (while (string-match "\\[[^][]*]" msg boundary) - (setq boundary (match-end 0)) - (magit--put-face (match-beginning 0) boundary - 'magit-keyword msg)))) - msg) - -(defun magit-log-maybe-show-more-commits (section) - "When point is at the end of a log buffer, insert more commits. - -Log buffers end with a button \"Type + to show more history\". -When the use of a section movement command puts point on that -button, then automatically show more commits, without the user -having to press \"+\". - -This function is called by `magit-section-movement-hook' and -exists mostly for backward compatibility reasons." - (when (and (eq (oref section type) 'longer) - magit-log-auto-more) - (magit-log-double-commit-limit) - (forward-line -1) - (magit-section-forward))) - -(add-hook 'magit-section-movement-hook #'magit-log-maybe-show-more-commits) - -(defvar magit--update-revision-buffer nil) - -(defun magit-log-maybe-update-revision-buffer (&optional _) - "When moving in a log or cherry buffer, update the revision buffer. -If there is no revision buffer in the same frame, then do nothing." - (when (derived-mode-p 'magit-log-mode 'magit-cherry-mode 'magit-reflog-mode) - (magit--maybe-update-revision-buffer))) - -(add-hook 'magit-section-movement-hook #'magit-log-maybe-update-revision-buffer) - -(defun magit--maybe-update-revision-buffer () - (when-let* ((commit (magit-section-value-if 'commit)) - (buffer (magit-get-mode-buffer 'magit-revision-mode nil t))) - (if magit--update-revision-buffer - (setq magit--update-revision-buffer (list commit buffer)) - (setq magit--update-revision-buffer (list commit buffer)) - (run-with-idle-timer - magit-update-other-window-delay nil - (let ((args (let ((magit-direct-use-buffer-arguments 'selected)) - (magit-show-commit--arguments)))) - (lambda () - (pcase-let ((`(,rev ,buf) magit--update-revision-buffer)) - (setq magit--update-revision-buffer nil) - (when (buffer-live-p buf) - (let ((magit-display-buffer-noselect t)) - (apply #'magit-show-commit rev args)))) - (setq magit--update-revision-buffer nil))))))) - -(defvar magit--update-blob-buffer nil) - -(defun magit-log-maybe-update-blob-buffer (&optional _) - "When moving in a log or cherry buffer, update the blob buffer. -If there is no blob buffer in the same frame, then do nothing." - (when (derived-mode-p 'magit-log-mode 'magit-cherry-mode 'magit-reflog-mode) - (magit--maybe-update-blob-buffer))) - -(defun magit--maybe-update-blob-buffer () - (when-let* ((commit (magit-section-value-if 'commit)) - (buffer (--first (with-current-buffer it - (eq revert-buffer-function - 'magit-revert-rev-file-buffer)) - (mapcar #'window-buffer (window-list))))) - (if magit--update-blob-buffer - (setq magit--update-blob-buffer (list commit buffer)) - (setq magit--update-blob-buffer (list commit buffer)) - (run-with-idle-timer - magit-update-other-window-delay nil - (lambda () - (pcase-let ((`(,rev ,buf) magit--update-blob-buffer)) - (setq magit--update-blob-buffer nil) - (when (buffer-live-p buf) - (with-selected-window (get-buffer-window buf) - (with-current-buffer buf - (save-excursion - (magit-blob-visit (list (magit-rev-parse rev) - (magit-file-relative-name - magit-buffer-file-name))))))))))))) - -(defun magit-log-goto-commit-section (rev) - (let ((abbrev (magit-rev-format "%h" rev))) - (when-let ((section (--first (equal (oref it value) abbrev) - (oref magit-root-section children)))) - (goto-char (oref section start))))) - -(defun magit-log-goto-same-commit () - (when (and magit-previous-section - (magit-section-match '(commit branch) - magit-previous-section)) - (magit-log-goto-commit-section (oref magit-previous-section value)))) - -;;; Log Margin - -(defvar-local magit-log-margin-show-shortstat nil) - -(transient-define-suffix magit-toggle-log-margin-style () - "Toggle between the regular and the shortstat margin style. -The shortstat style is experimental and rather slow." - :description "Toggle shortstat" - :key "x" - :transient t - (interactive) - (setq magit-log-margin-show-shortstat - (not magit-log-margin-show-shortstat)) - (magit-set-buffer-margin nil t)) - -(defun magit-log-format-margin (rev author date) - (when (magit-margin-option) - (if magit-log-margin-show-shortstat - (magit-log-format-shortstat-margin rev) - (magit-log-format-author-margin author date)))) - -(defun magit-log-format-author-margin (author date &optional previous-line) - (pcase-let ((`(,_ ,style ,width ,details ,details-width) - (or magit-buffer-margin - (symbol-value (magit-margin-option)) - (error "No margin format specified for %s" major-mode)))) - (magit-make-margin-overlay - (concat (and details - (concat (magit--propertize-face - (truncate-string-to-width - (or author "") - details-width - nil ?\s - (magit--ellipsis 'margin)) - 'magit-log-author) - " ")) - (magit--propertize-face - (if (stringp style) - (format-time-string - style - (seconds-to-time (string-to-number date))) - (pcase-let* ((abbr (eq style 'age-abbreviated)) - (`(,cnt ,unit) (magit--age date abbr))) - (format (format (if abbr "%%2d%%-%dc" "%%2d %%-%ds") - (- width (if details (1+ details-width) 0))) - cnt unit))) - 'magit-log-date)) - previous-line))) - -(defun magit-log-format-shortstat-margin (rev) - (magit-make-margin-overlay - (if-let ((line (and rev (magit-git-string - "show" "--format=" "--shortstat" rev)))) - (if (string-match "\ -\\([0-9]+\\) files? changed, \ -\\(?:\\([0-9]+\\) insertions?(\\+)\\)?\ -\\(?:\\(?:, \\)?\\([0-9]+\\) deletions?(-)\\)?\\'" line) - (magit-bind-match-strings (files add del) line - (format - "%5s %5s%4s" - (if add - (magit--propertize-face (format "%s+" add) - 'magit-diffstat-added) - "") - (if del - (magit--propertize-face (format "%s-" del) - 'magit-diffstat-removed) - "") - files)) - "") - ""))) - -(defun magit-log-margin-width (style details details-width) - (if magit-log-margin-show-shortstat - 16 - (+ (if details (1+ details-width) 0) - (if (stringp style) - (length (format-time-string style)) - (+ 2 ; two digits - 1 ; trailing space - (if (eq style 'age-abbreviated) - 1 ; single character - (+ 1 ; gap after digits - (apply #'max (--map (max (length (nth 1 it)) - (length (nth 2 it))) - magit--age-spec))))))))) - -;;; Select Mode - -(defvar-keymap magit-log-select-mode-map - :doc "Keymap for `magit-log-select-mode'." - :parent magit-log-mode-map - "C-c C-b" #'undefined - "C-c C-f" #'undefined - "." #'magit-log-select-pick - "e" #'magit-log-select-pick - "C-c C-c" #'magit-log-select-pick - "q" #'magit-log-select-quit - "C-c C-k" #'magit-log-select-quit) -(put 'magit-log-select-pick :advertised-binding [?\C-c ?\C-c]) -(put 'magit-log-select-quit :advertised-binding [?\C-c ?\C-k]) - -(define-derived-mode magit-log-select-mode magit-log-mode "Magit Select" - "Mode for selecting a commit from history. - -This mode is documented in info node `(magit)Select from Log'. - -\\<magit-mode-map>\ -Type \\[magit-refresh] to refresh the current buffer. -Type \\[magit-visit-thing] or \\[magit-diff-show-or-scroll-up] \ -to visit the commit at point. - -\\<magit-log-select-mode-map>\ -Type \\[magit-log-select-pick] to select the commit at point. -Type \\[magit-log-select-quit] to abort without selecting a commit." - :group 'magit-log - (hack-dir-local-variables-non-file-buffer)) - -(put 'magit-log-select-mode 'magit-log-default-arguments - '("--graph" "-n256" "--decorate")) - -(defun magit-log-select-setup-buffer (revs args) - (magit-setup-buffer #'magit-log-select-mode nil - (magit-buffer-revisions revs) - (magit-buffer-log-args args))) - -(defun magit-log-select-refresh-buffer () - (setq magit-section-inhibit-markers t) - (setq magit-section-insert-in-reverse t) - (magit-insert-section (logbuf) - (magit--insert-log t magit-buffer-revisions - (magit-log--maybe-drop-color-graph - magit-buffer-log-args - (magit-log-get-commit-limit))))) - -(cl-defmethod magit-buffer-value (&context (major-mode magit-log-select-mode)) - magit-buffer-revisions) - -(defvar-local magit-log-select-pick-function nil) -(defvar-local magit-log-select-quit-function nil) - -(defun magit-log-select (pick &optional msg quit branch args initial) - (declare (indent defun)) - (unless initial - (setq initial (magit-commit-at-point))) - (magit-log-select-setup-buffer - (or branch (magit-get-current-branch) "HEAD") - (append args - (car (magit-log--get-value 'magit-log-select-mode - magit-direct-use-buffer-arguments)))) - (when initial - (magit-log-goto-commit-section initial)) - (setq magit-log-select-pick-function pick) - (setq magit-log-select-quit-function quit) - (when magit-log-select-show-usage - (let ((pick (propertize (substitute-command-keys - "\\[magit-log-select-pick]") - 'font-lock-face - 'magit-header-line-key)) - (quit (propertize (substitute-command-keys - "\\[magit-log-select-quit]") - 'font-lock-face - 'magit-header-line-key))) - (setq msg (format-spec - (if msg - (if (string-suffix-p "," msg) - (concat msg " or %q to abort") - msg) - "Type %p to select commit at point, or %q to abort") - `((?p . ,pick) - (?q . ,quit))))) - (magit--add-face-text-property - 0 (length msg) 'magit-header-line-log-select t msg) - (when (memq magit-log-select-show-usage '(both header-line)) - (magit-set-header-line-format msg)) - (when (memq magit-log-select-show-usage '(both echo-area)) - (message "%s" (substring-no-properties msg))))) - -(defun magit-log-select-pick () - "Select the commit at point and act on it. -Call `magit-log-select-pick-function' with the selected -commit as argument." - (interactive) - (let ((fun magit-log-select-pick-function) - (rev (magit-commit-at-point))) - (magit-mode-bury-buffer 'kill) - (funcall fun rev))) - -(defun magit-log-select-quit () - "Abort selecting a commit, don't act on any commit. -Call `magit-log-select-quit-function' if set." - (interactive) - (let ((fun magit-log-select-quit-function)) - (magit-mode-bury-buffer 'kill) - (when fun (funcall fun)))) - -;;; Cherry Mode - -(defvar-keymap magit-cherry-mode-map - :doc "Keymap for `magit-cherry-mode'." - :parent magit-mode-map - "q" #'magit-log-bury-buffer - "L" #'magit-margin-settings) - -(define-derived-mode magit-cherry-mode magit-mode "Magit Cherry" - "Mode for looking at commits not merged upstream. - -\\<magit-mode-map>\ -Type \\[magit-refresh] to refresh the current buffer. -Type \\[magit-visit-thing] or \\[magit-diff-show-or-scroll-up] \ -to visit the commit at point. - -Type \\[magit-cherry-pick] to apply the commit at point. - -\\{magit-cherry-mode-map}" - :group 'magit-log - (hack-dir-local-variables-non-file-buffer) - (setq magit--imenu-group-types 'cherries)) - -(defun magit-cherry-setup-buffer (head upstream) - (magit-setup-buffer #'magit-cherry-mode nil - (magit-buffer-refname head) - (magit-buffer-upstream upstream) - (magit-buffer-range (concat upstream ".." head)))) - -(defun magit-cherry-refresh-buffer () - (setq magit-section-insert-in-reverse t) - (magit-insert-section (cherry) - (magit-run-section-hook 'magit-cherry-sections-hook))) - -(cl-defmethod magit-buffer-value (&context (major-mode magit-cherry-mode)) - magit-buffer-range) - -;;;###autoload -(defun magit-cherry (head upstream) - "Show commits in a branch that are not merged in the upstream branch." - (interactive - (let ((head (magit-read-branch "Cherry head"))) - (list head (magit-read-other-branch "Cherry upstream" head - (magit-get-upstream-branch head))))) - (require 'magit) - (magit-cherry-setup-buffer head upstream)) - -(defun magit-insert-cherry-headers () - "Insert headers appropriate for `magit-cherry-mode' buffers." - (let ((branch (propertize magit-buffer-refname - 'font-lock-face 'magit-branch-local)) - (upstream (propertize magit-buffer-upstream 'font-lock-face - (if (magit-local-branch-p magit-buffer-upstream) - 'magit-branch-local - 'magit-branch-remote)))) - (magit-insert-head-branch-header branch) - (magit-insert-upstream-branch-header branch upstream "Upstream: ") - (insert ?\n))) - -(defun magit-insert-cherry-commits () - "Insert commit sections into a `magit-cherry-mode' buffer." - (magit-insert-section (cherries) - (magit-insert-heading "Cherry commits:") - (magit-git-wash (apply-partially #'magit-log-wash-log 'cherry) - "cherry" "-v" "--abbrev" - magit-buffer-upstream - magit-buffer-refname))) - -;;; Log Sections -;;;; Standard Log Sections - -(defvar-keymap magit-log-section-map - :doc "Keymap for log sections. -The classes `magit-{unpulled,unpushed,unmerged}-section' derive -from the abstract `magit-log-section' class. Accordingly this -keymap is the parent of their keymaps." - "<remap> <magit-visit-thing>" #'magit-diff-dwim - "<1>" (magit-menu-item "Visit diff" #'magit-diff-dwim)) - -(cl-defmethod magit-section-ident-value ((section magit-unpulled-section)) - "\"..@{push}\" cannot be used as the value because that is -ambiguous if `push.default' does not allow a 1:1 mapping, and -many commands would fail because of that. But here that does -not matter and we need an unique value so we use that string -in the pushremote case." - (let ((value (oref section value))) - (if (equal value "..@{upstream}") value "..@{push}"))) - -(magit-define-section-jumper magit-jump-to-unpulled-from-upstream - "Unpulled from @{upstream}" unpulled "..@{upstream}") - -(defun magit-insert-unpulled-from-upstream () - "Insert commits that haven't been pulled from the upstream yet." - (when-let ((upstream (magit-get-upstream-branch))) - (magit-insert-section (unpulled "..@{upstream}" t) - (magit-insert-heading - (format (propertize "Unpulled from %s." - 'font-lock-face 'magit-section-heading) - upstream)) - (magit--insert-log nil "..@{upstream}" magit-buffer-log-args) - (magit-log-insert-child-count)))) - -(magit-define-section-jumper magit-jump-to-unpulled-from-pushremote - "Unpulled from <push-remote>" unpulled "..@{push}") - -(defun magit-insert-unpulled-from-pushremote () - "Insert commits that haven't been pulled from the push-remote yet." - (when-let* ((target (magit-get-push-branch)) - (range (concat ".." target))) - (when (magit--insert-pushremote-log-p) - (magit-insert-section (unpulled range t) - (magit-insert-heading - (format (propertize "Unpulled from %s." - 'font-lock-face 'magit-section-heading) - (propertize target 'font-lock-face 'magit-branch-remote))) - (magit--insert-log nil range magit-buffer-log-args) - (magit-log-insert-child-count))))) - -(cl-defmethod magit-section-ident-value ((section magit-unpushed-section)) - "\"..@{push}\" cannot be used as the value because that is -ambiguous if `push.default' does not allow a 1:1 mapping, and -many commands would fail because of that. But here that does -not matter and we need an unique value so we use that string -in the pushremote case." - (let ((value (oref section value))) - (if (equal value "@{upstream}..") value "@{push}.."))) - -(magit-define-section-jumper magit-jump-to-unpushed-to-upstream - "Unpushed to @{upstream}" unpushed "@{upstream}..") - -(defun magit-insert-unpushed-to-upstream-or-recent () - "Insert section showing unpushed or other recent commits. -If an upstream is configured for the current branch and it is -behind of the current branch, then show the commits that have -not yet been pushed into the upstream branch. If no upstream is -configured or if the upstream is not behind of the current branch, -then show the last `magit-log-section-commit-count' commits." - (let ((upstream (magit-get-upstream-branch))) - (if (or (not upstream) - (magit-rev-ancestor-p "HEAD" upstream)) - (magit-insert-recent-commits 'unpushed "@{upstream}..") - (magit-insert-unpushed-to-upstream)))) - -(defun magit-insert-unpushed-to-upstream () - "Insert commits that haven't been pushed to the upstream yet." - (when (magit-git-success "rev-parse" "@{upstream}") - (magit-insert-section (unpushed "@{upstream}..") - (magit-insert-heading - (format (propertize "Unmerged into %s." - 'font-lock-face 'magit-section-heading) - (magit-get-upstream-branch))) - (magit--insert-log nil "@{upstream}.." magit-buffer-log-args) - (magit-log-insert-child-count)))) - -(defun magit-insert-recent-commits (&optional type value) - "Insert section showing recent commits. -Show the last `magit-log-section-commit-count' commits." - (let* ((start (format "HEAD~%s" magit-log-section-commit-count)) - (range (and (magit-rev-verify start) - (concat start "..HEAD")))) - (magit-insert-section ((eval (or type 'recent)) - (or value range) - t) - (magit-insert-heading "Recent commits") - (magit--insert-log nil range - (cons (format "-n%d" magit-log-section-commit-count) - (--remove (string-prefix-p "-n" it) - magit-buffer-log-args)))))) - -(magit-define-section-jumper magit-jump-to-unpushed-to-pushremote - "Unpushed to <push-remote>" unpushed "@{push}..") - -(defun magit-insert-unpushed-to-pushremote () - "Insert commits that haven't been pushed to the push-remote yet." - (when-let* ((target (magit-get-push-branch)) - (range (concat target ".."))) - (when (magit--insert-pushremote-log-p) - (magit-insert-section (unpushed range t) - (magit-insert-heading - (format (propertize "Unpushed to %s." - 'font-lock-face 'magit-section-heading) - (propertize target 'font-lock-face 'magit-branch-remote))) - (magit--insert-log nil range magit-buffer-log-args) - (magit-log-insert-child-count))))) - -(defun magit--insert-pushremote-log-p () - (magit--with-refresh-cache - (cons default-directory 'magit--insert-pushremote-log-p) - (not (and (equal (magit-get-push-branch) - (magit-get-upstream-branch)) - (or (memq 'magit-insert-unpulled-from-upstream - magit-status-sections-hook) - (memq 'magit-insert-unpulled-from-upstream-or-recent - magit-status-sections-hook)))))) - -(defun magit-log-insert-child-count () - (when magit-section-show-child-count - (let ((count (length (oref magit-insert-section--current children)))) - (when (> count 0) - (when (eq count (magit-log-get-commit-limit)) - (setq count (format "%s+" count))) - (save-excursion - (goto-char (- (oref magit-insert-section--current content) 2)) - (insert (format " (%s)" count)) - (delete-char 1)))))) - -;;;; Auxiliary Log Sections - -(defun magit-insert-unpulled-cherries () - "Insert section showing unpulled commits. -Like `magit-insert-unpulled-from-upstream' but prefix each commit -which has not been applied yet (i.e., a commit with a patch-id -not shared with any local commit) with \"+\", and all others with -\"-\"." - (when (magit-git-success "rev-parse" "@{upstream}") - (magit-insert-section (unpulled "..@{upstream}") - (magit-insert-heading "Unpulled commits:") - (magit-git-wash (apply-partially #'magit-log-wash-log 'cherry) - "cherry" "-v" (magit-abbrev-arg) - (magit-get-current-branch) "@{upstream}")))) - -(defun magit-insert-unpushed-cherries () - "Insert section showing unpushed commits. -Like `magit-insert-unpushed-to-upstream' but prefix each commit -which has not been applied to upstream yet (i.e., a commit with -a patch-id not shared with any upstream commit) with \"+\", and -all others with \"-\"." - (when (magit-git-success "rev-parse" "@{upstream}") - (magit-insert-section (unpushed "@{upstream}..") - (magit-insert-heading "Unpushed commits:") - (magit-git-wash (apply-partially #'magit-log-wash-log 'cherry) - "cherry" "-v" (magit-abbrev-arg) "@{upstream}")))) - -;;; _ -(provide 'magit-log) -;;; magit-log.el ends here diff --git a/emacs/elpa/magit-20240622.1531/magit-log.elc b/emacs/elpa/magit-20240622.1531/magit-log.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/magit-merge.el b/emacs/elpa/magit-20240622.1531/magit-merge.el @@ -1,315 +0,0 @@ -;;; magit-merge.el --- Merge functionality -*- lexical-binding:t -*- - -;; Copyright (C) 2008-2024 The Magit Project Contributors - -;; Author: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> -;; Maintainer: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> - -;; SPDX-License-Identifier: GPL-3.0-or-later - -;; 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. -;; -;; 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 Magit. If not, see <https://www.gnu.org/licenses/>. - -;;; Commentary: - -;; This library implements merge commands. - -;;; Code: - -(require 'magit) -(require 'magit-diff) - -(declare-function magit-git-push "magit-push" (branch target args)) - -;;; Commands - -;;;###autoload (autoload 'magit-merge "magit" nil t) -(transient-define-prefix magit-merge () - "Merge branches." - :man-page "git-merge" - :incompatible '(("--ff-only" "--no-ff")) - ["Arguments" - :if-not magit-merge-in-progress-p - ("-f" "Fast-forward only" "--ff-only") - ("-n" "No fast-forward" "--no-ff") - (magit-merge:--strategy) - (5 magit-merge:--strategy-option) - (5 "-b" "Ignore changes in amount of whitespace" "-Xignore-space-change") - (5 "-w" "Ignore whitespace when comparing lines" "-Xignore-all-space") - (5 magit-diff:--diff-algorithm :argument "-Xdiff-algorithm=") - (5 magit:--gpg-sign)] - ["Actions" - :if-not magit-merge-in-progress-p - [("m" "Merge" magit-merge-plain) - ("e" "Merge and edit message" magit-merge-editmsg) - ("n" "Merge but don't commit" magit-merge-nocommit) - ("a" "Absorb" magit-merge-absorb)] - [("p" "Preview merge" magit-merge-preview) - "" - ("s" "Squash merge" magit-merge-squash) - ("i" "Dissolve" magit-merge-into)]] - ["Actions" - :if magit-merge-in-progress-p - ("m" "Commit merge" magit-commit-create) - ("a" "Abort merge" magit-merge-abort)]) - -(defun magit-merge-arguments () - (transient-args 'magit-merge)) - -(transient-define-argument magit-merge:--strategy () - :description "Strategy" - :class 'transient-option - ;; key for merge and rebase: "-s" - ;; key for cherry-pick and revert: "=s" - ;; shortarg for merge and rebase: "-s" - ;; shortarg for cherry-pick and revert: none - :key "-s" - :argument "--strategy=" - :choices '("resolve" "recursive" "octopus" "ours" "subtree")) - -(transient-define-argument magit-merge:--strategy-option () - :description "Strategy Option" - :class 'transient-option - :key "-X" - :argument "--strategy-option=" - :choices '("ours" "theirs" "patience")) - -;;;###autoload -(defun magit-merge-plain (rev &optional args nocommit) - "Merge commit REV into the current branch; using default message. - -Unless there are conflicts or a prefix argument is used create a -merge commit using a generic commit message and without letting -the user inspect the result. With a prefix argument pretend the -merge failed to give the user the opportunity to inspect the -merge. - -\(git merge --no-edit|--no-commit [ARGS] REV)" - (interactive (list (magit-read-other-branch-or-commit "Merge") - (magit-merge-arguments) - current-prefix-arg)) - (magit-merge-assert) - (magit-run-git-async "merge" (if nocommit "--no-commit" "--no-edit") args rev)) - -;;;###autoload -(defun magit-merge-editmsg (rev &optional args) - "Merge commit REV into the current branch; and edit message. -Perform the merge and prepare a commit message but let the user -edit it. -\n(git merge --edit --no-ff [ARGS] REV)" - (interactive (list (magit-read-other-branch-or-commit "Merge") - (magit-merge-arguments))) - (magit-merge-assert) - (cl-pushnew "--no-ff" args :test #'equal) - (apply #'magit-run-git-with-editor "merge" "--edit" - (append (delete "--ff-only" args) - (list rev)))) - -;;;###autoload -(defun magit-merge-nocommit (rev &optional args) - "Merge commit REV into the current branch; pretending it failed. -Pretend the merge failed to give the user the opportunity to -inspect the merge and change the commit message. -\n(git merge --no-commit --no-ff [ARGS] REV)" - (interactive (list (magit-read-other-branch-or-commit "Merge") - (magit-merge-arguments))) - (magit-merge-assert) - (cl-pushnew "--no-ff" args :test #'equal) - (magit-run-git-async "merge" "--no-commit" args rev)) - -;;;###autoload -(defun magit-merge-into (branch &optional args) - "Merge the current branch into BRANCH and remove the former. - -Before merging, force push the source branch to its push-remote, -provided the respective remote branch already exists, ensuring -that the respective pull-request (if any) won't get stuck on some -obsolete version of the commits that are being merged. Finally -if `forge-branch-pullreq' was used to create the merged branch, -then also remove the respective remote branch." - (interactive - (list (magit-read-other-local-branch - (format "Merge `%s' into" - (or (magit-get-current-branch) - (magit-rev-parse "HEAD"))) - nil - (and-let* ((upstream (magit-get-upstream-branch)) - (upstream (cdr (magit-split-branch-name upstream)))) - (and (magit-branch-p upstream) upstream))) - (magit-merge-arguments))) - (let ((current (magit-get-current-branch)) - (head (magit-rev-parse "HEAD"))) - (when (zerop (magit-call-git "checkout" branch)) - (if current - (magit--merge-absorb current args) - (magit-run-git-with-editor "merge" args head))))) - -;;;###autoload -(defun magit-merge-absorb (branch &optional args) - "Merge BRANCH into the current branch and remove the former. - -Before merging, force push the source branch to its push-remote, -provided the respective remote branch already exists, ensuring -that the respective pull-request (if any) won't get stuck on some -obsolete version of the commits that are being merged. Finally -if `forge-branch-pullreq' was used to create the merged branch, -then also remove the respective remote branch." - (interactive (list (magit-read-other-local-branch "Absorb branch") - (magit-merge-arguments))) - (magit--merge-absorb branch args)) - -(defun magit--merge-absorb (branch args) - (when (equal branch (magit-main-branch)) - (unless (yes-or-no-p - (format "Do you really want to merge `%s' into another branch? " - branch)) - (user-error "Abort"))) - (if-let ((target (magit-get-push-branch branch t))) - (progn - (magit-git-push branch target (list "--force-with-lease")) - (set-process-sentinel - magit-this-process - (lambda (process event) - (when (memq (process-status process) '(exit signal)) - (if (not (zerop (process-exit-status process))) - (magit-process-sentinel process event) - (process-put process 'inhibit-refresh t) - (magit-process-sentinel process event) - (magit--merge-absorb-1 branch args)))))) - (magit--merge-absorb-1 branch args))) - -(defun magit--merge-absorb-1 (branch args) - (if-let ((pr (magit-get "branch" branch "pullRequest"))) - (magit-run-git-async - "merge" args "-m" - (format "Merge branch '%s'%s [#%s]" - branch - (let ((current (magit-get-current-branch))) - (if (equal current (magit-main-branch)) - "" - (format " into %s" current))) - pr) - branch) - (magit-run-git-async "merge" args "--no-edit" branch)) - (set-process-sentinel - magit-this-process - (lambda (process event) - (when (memq (process-status process) '(exit signal)) - (if (> (process-exit-status process) 0) - (magit-process-sentinel process event) - (process-put process 'inhibit-refresh t) - (magit-process-sentinel process event) - (magit-branch-maybe-delete-pr-remote branch) - (magit-branch-unset-pushRemote branch) - (magit-run-git "branch" "-D" branch)))))) - -;;;###autoload -(defun magit-merge-squash (rev) - "Squash commit REV into the current branch; don't create a commit. -\n(git merge --squash REV)" - (interactive (list (magit-read-other-branch-or-commit "Squash"))) - (magit-merge-assert) - (magit-run-git-async "merge" "--squash" rev)) - -;;;###autoload -(defun magit-merge-preview (rev) - "Preview result of merging REV into the current branch." - (interactive (list (magit-read-other-branch-or-commit "Preview merge"))) - (magit-merge-preview-setup-buffer rev)) - -;;;###autoload -(defun magit-merge-abort () - "Abort the current merge operation. -\n(git merge --abort)" - (interactive) - (unless (file-exists-p (expand-file-name "MERGE_HEAD" (magit-gitdir))) - (user-error "No merge in progress")) - (magit-confirm 'abort-merge) - (magit-run-git-async "merge" "--abort")) - -(defun magit-checkout-stage (file arg) - "During a conflict checkout and stage side, or restore conflict." - (interactive - (let ((file (magit-completing-read "Checkout file" - (magit-tracked-files) nil nil nil - 'magit-read-file-hist - (magit-current-file)))) - (cond ((member file (magit-unmerged-files)) - (list file (magit-checkout-read-stage file))) - ((yes-or-no-p (format "Restore conflicts in %s? " file)) - (list file "--merge")) - (t - (user-error "Quit"))))) - (pcase (cons arg (cddr (car (magit-file-status file)))) - ((or `("--ours" ?D ,_) - '("--ours" ?U ?A) - `("--theirs" ,_ ?D) - '("--theirs" ?A ?U)) - (magit-run-git "rm" "--" file)) - (_ (if (equal arg "--merge") - ;; This fails if the file was deleted on one - ;; side. And we cannot do anything about it. - (magit-run-git "checkout" "--merge" "--" file) - (magit-call-git "checkout" arg "--" file) - (magit-run-git "add" "-u" "--" file))))) - -;;; Utilities - -(defun magit-merge-in-progress-p () - (file-exists-p (expand-file-name "MERGE_HEAD" (magit-gitdir)))) - -(defun magit--merge-range (&optional head) - (unless head - (setq head (magit-get-shortname - (car (magit-file-lines - (expand-file-name "MERGE_HEAD" (magit-gitdir))))))) - (and head - (concat (magit-git-string "merge-base" "--octopus" "HEAD" head) - ".." head))) - -(defun magit-merge-assert () - (or (not (magit-anything-modified-p t)) - (magit-confirm 'merge-dirty - "Merging with dirty worktree is risky. Continue"))) - -(defun magit-checkout-read-stage (file) - (magit-read-char-case (format "For %s checkout: " file) t - (?o "[o]ur stage" "--ours") - (?t "[t]heir stage" "--theirs") - (?c (if magit-verbose-messages "restore [c]onflict" "[c]onflict") - "--merge"))) - -;;; Sections - -(defun magit-insert-merge-log () - "Insert section for the on-going merge. -Display the heads that are being merged. -If no merge is in progress, do nothing." - (when (magit-merge-in-progress-p) - (let* ((heads (mapcar #'magit-get-shortname - (magit-file-lines - (expand-file-name "MERGE_HEAD" (magit-gitdir))))) - (range (magit--merge-range (car heads)))) - (magit-insert-section (unmerged range) - (magit-insert-heading - (format "Merging %s:" (mapconcat #'identity heads ", "))) - (magit--insert-log nil - range - (let ((args magit-buffer-log-args)) - (unless (member "--decorate=full" magit-buffer-log-args) - (push "--decorate=full" args)) - args)))))) - -;;; _ -(provide 'magit-merge) -;;; magit-merge.el ends here diff --git a/emacs/elpa/magit-20240622.1531/magit-merge.elc b/emacs/elpa/magit-20240622.1531/magit-merge.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/magit-mode.el b/emacs/elpa/magit-20240622.1531/magit-mode.el @@ -1,1470 +0,0 @@ -;;; magit-mode.el --- Create and refresh Magit buffers -*- lexical-binding:t -*- - -;; Copyright (C) 2008-2024 The Magit Project Contributors - -;; Author: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> -;; Maintainer: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> - -;; SPDX-License-Identifier: GPL-3.0-or-later - -;; 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. -;; -;; 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 Magit. If not, see <https://www.gnu.org/licenses/>. - -;;; Commentary: - -;; This library implements the abstract major-mode `magit-mode' from -;; which almost all other Magit major-modes derive. The code in here -;; is mostly concerned with creating and refreshing Magit buffers. - -;;; Code: - -(require 'magit-base) -(require 'magit-git) - -(require 'benchmark) -(require 'browse-url) -(require 'format-spec) -(require 'help-mode) - -(require 'transient) - -(defvar bookmark-make-record-function) -(defvar magit--wip-inhibit-autosave) -(defvar magit-wip-after-save-local-mode) -(declare-function magit-wip-get-ref "magit-wip" ()) -(declare-function magit-wip-commit-worktree "magit-wip" (ref files msg)) - -;;; Options - -(defcustom magit-mode-hook - '(magit-load-config-extensions) - "Hook run when entering a mode derived from Magit mode." - :package-version '(magit . "3.0.0") - :group 'magit-modes - :type 'hook - :options '(magit-load-config-extensions - bug-reference-mode)) - -(defcustom magit-setup-buffer-hook - '(magit-maybe-save-repository-buffers - magit-set-buffer-margin) - "Hook run by `magit-setup-buffer'. - -This is run right after displaying the buffer and right before -generating or updating its content. `magit-mode-hook' and other, -more specific, `magit-mode-*-hook's on the other hand are run -right before displaying the buffer. Usually one of these hooks -should be used instead of this one." - :package-version '(magit . "2.3.0") - :group 'magit-modes - :type 'hook - :options '(magit-maybe-save-repository-buffers - magit-set-buffer-margin)) - -(defcustom magit-pre-refresh-hook '(magit-maybe-save-repository-buffers) - "Hook run before refreshing in `magit-refresh'. - -This hook, or `magit-post-refresh-hook', should be used -for functions that are not tied to a particular buffer. - -To run a function with a particular buffer current, use -`magit-refresh-buffer-hook' and use `derived-mode-p' -inside your function." - :package-version '(magit . "2.4.0") - :group 'magit-refresh - :type 'hook - :options '(magit-maybe-save-repository-buffers)) - -(defcustom magit-post-refresh-hook - '(magit-auto-revert-buffers - magit-run-post-commit-hook - magit-run-post-stage-hook - magit-run-post-unstage-hook) - "Hook run after refreshing in `magit-refresh'. - -This hook, or `magit-pre-refresh-hook', should be used -for functions that are not tied to a particular buffer. - -To run a function with a particular buffer current, use -`magit-refresh-buffer-hook' and use `derived-mode-p' -inside your function." - :package-version '(magit . "2.4.0") - :group 'magit-refresh - :type 'hook - :options '(magit-auto-revert-buffers - magit-run-post-commit-hook - magit-run-post-stage-hook - magit-run-post-unstage-hook)) - -(defcustom magit-display-buffer-function #'magit-display-buffer-traditional - "The function used to display a Magit buffer. - -All Magit buffers (buffers whose major-modes derive from -`magit-mode') are displayed using `magit-display-buffer', -which in turn uses the function specified here." - :package-version '(magit . "2.3.0") - :group 'magit-buffers - :type '(radio (function-item magit-display-buffer-traditional) - (function-item magit-display-buffer-same-window-except-diff-v1) - (function-item magit-display-buffer-fullframe-status-v1) - (function-item magit-display-buffer-fullframe-status-topleft-v1) - (function-item magit-display-buffer-fullcolumn-most-v1) - (function-item display-buffer) - (function :tag "Function"))) - -(defcustom magit-pre-display-buffer-hook '(magit-save-window-configuration) - "Hook run by `magit-display-buffer' before displaying the buffer." - :package-version '(magit . "2.3.0") - :group 'magit-buffers - :type 'hook - :get #'magit-hook-custom-get - :options '(magit-save-window-configuration)) - -(defcustom magit-post-display-buffer-hook '(magit-maybe-set-dedicated) - "Hook run by `magit-display-buffer' after displaying the buffer." - :package-version '(magit . "2.3.0") - :group 'magit-buffers - :type 'hook - :get #'magit-hook-custom-get - :options '(magit-maybe-set-dedicated)) - -(defcustom magit-generate-buffer-name-function - #'magit-generate-buffer-name-default-function - "The function used to generate the name for a Magit buffer." - :package-version '(magit . "2.3.0") - :group 'magit-buffers - :type '(radio (function-item magit-generate-buffer-name-default-function) - (function :tag "Function"))) - -(defcustom magit-buffer-name-format "%x%M%v: %t%x" - "The format string used to name Magit buffers. - -The following %-sequences are supported: - -`%m' The name of the major-mode, but with the `-mode' suffix - removed. - -`%M' Like \"%m\" but abbreviate `magit-status-mode' as `magit'. - -`%v' The value the buffer is locked to, in parentheses, or an - empty string if the buffer is not locked to a value. - -`%V' Like \"%v\", but the string is prefixed with a space, unless - it is an empty string. - -`%t' The top-level directory of the working tree of the - repository, or if `magit-uniquify-buffer-names' is non-nil - an abbreviation of that. - -`%x' If `magit-uniquify-buffer-names' is nil \"*\", otherwise the - empty string. Due to limitations of the `uniquify' package, - buffer names must end with the path. - -The value should always contain \"%m\" or \"%M\", \"%v\" or \"%V\", and -\"%t\". If `magit-uniquify-buffer-names' is non-nil, then the -value must end with \"%t\" or \"%t%x\". See issue #2841. - -This is used by `magit-generate-buffer-name-default-function'. -If another `magit-generate-buffer-name-function' is used, then -it may not respect this option, or on the contrary it may -support additional %-sequences." - :package-version '(magit . "2.12.0") - :group 'magit-buffers - :type 'string) - -(defcustom magit-uniquify-buffer-names t - "Whether to uniquify the names of Magit buffers." - :package-version '(magit . "2.3.0") - :group 'magit-buffers - :type 'boolean) - -(defcustom magit-bury-buffer-function #'magit-mode-quit-window - "The function used to bury or kill the current Magit buffer." - :package-version '(magit . "3.2.0") - :group 'magit-buffers - :type '(radio (function-item quit-window) - (function-item magit-mode-quit-window) - (function-item magit-restore-window-configuration) - (function :tag "Function"))) - -(defcustom magit-prefix-use-buffer-arguments 'selected - "Whether certain prefix commands reuse arguments active in relevant buffer. - -This affects the transient prefix commands `magit-diff', -`magit-log' and `magit-show-refs'. - -Valid values are: - -`always': Always use the set of arguments that is currently - active in the respective buffer, provided that buffer exists - of course. -`selected': Use the set of arguments from the respective - buffer, but only if it is displayed in a window of the current - frame. This is the default. -`current': Use the set of arguments from the respective buffer, - but only if it is the current buffer. -`never': Never use the set of arguments from the respective - buffer. - -For more information see info node `(magit)Transient Arguments -and Buffer Variables'." - :package-version '(magit . "3.0.0") - :group 'magit-buffers - :group 'magit-commands - :group 'magit-diff - :group 'magit-log - :type '(choice - (const :tag "always use args from buffer" always) - (const :tag "use args from buffer if displayed in frame" selected) - (const :tag "use args from buffer if it is current" current) - (const :tag "never use args from buffer" never))) - -(defcustom magit-direct-use-buffer-arguments 'selected - "Whether certain commands reuse arguments active in relevant buffer. - -This affects certain commands such as `magit-show-commit' that -are suffixes of the diff or log transient prefix commands, but -only if they are invoked directly, i.e., *not* as a suffix. - -Valid values are: - -`always': Always use the set of arguments that is currently - active in the respective buffer, provided that buffer exists - of course. -`selected': Use the set of arguments from the respective - buffer, but only if it is displayed in a window of the current - frame. This is the default. -`current': Use the set of arguments from the respective buffer, - but only if it is the current buffer. -`never': Never use the set of arguments from the respective - buffer. - -For more information see info node `(magit)Transient Arguments -and Buffer Variables'." - :package-version '(magit . "3.0.0") - :group 'magit-buffers - :group 'magit-commands - :group 'magit-diff - :group 'magit-log - :type '(choice - (const :tag "always use args from buffer" always) - (const :tag "use args from buffer if displayed in frame" selected) - (const :tag "use args from buffer if it is current" current) - (const :tag "never use args from buffer" never))) - -(defcustom magit-region-highlight-hook '(magit-diff-update-hunk-region) - "Functions used to highlight the region. - -Each function is run with the current section as only argument -until one of them returns non-nil. If all functions return nil, -then fall back to regular region highlighting." - :package-version '(magit . "2.1.0") - :group 'magit-refresh - :type 'hook - :options '(magit-diff-update-hunk-region)) - -(defcustom magit-create-buffer-hook nil - "Normal hook run while creating a new `magit-mode' buffer. -Runs before the buffer is populated with sections. Also see -`magit-post-create-buffer-hook'." - :package-version '(magit . "2.90.0") - :group 'magit-refresh - :type 'hook) - -(defcustom magit-post-create-buffer-hook nil - "Normal hook run after creating a new `magit-mode' buffer. -Runs after the buffer is populated with sections for the first -time. Also see `magit-create-buffer-hook' (which runs earlier) -and `magit-refresh-buffer-hook' (which runs on every refresh)." - :package-version '(magit . "4.0.0") - :group 'magit-refresh - :type 'hook) - -(defcustom magit-refresh-buffer-hook nil - "Normal hook for `magit-refresh-buffer' to run after refreshing." - :package-version '(magit . "2.1.0") - :group 'magit-refresh - :type 'hook) - -(defcustom magit-refresh-status-buffer t - "Whether the status buffer is refreshed after running git. - -When this is non-nil, then the status buffer is automatically -refreshed after running git for side-effects, in addition to the -current Magit buffer, which is always refreshed automatically. - -Only set this to nil after exhausting all other options to -improve performance." - :package-version '(magit . "2.4.0") - :group 'magit-refresh - :group 'magit-status - :type 'boolean) - -(defcustom magit-refresh-verbose nil - "Whether to revert Magit buffers verbosely." - :package-version '(magit . "2.1.0") - :group 'magit-refresh - :type 'boolean) - -(defcustom magit-save-repository-buffers t - "Whether to save file-visiting buffers when appropriate. - -If non-nil, then all modified file-visiting buffers belonging -to the current repository may be saved before running Magit -commands and before creating or refreshing Magit buffers. -If `dontask', then this is done without user intervention, for -any other non-nil value the user has to confirm each save. - -The default is t to avoid surprises, but `dontask' is the -recommended value." - :group 'magit-essentials - :group 'magit-buffers - :type '(choice (const :tag "Never" nil) - (const :tag "Ask" t) - (const :tag "Save without asking" dontask))) - -;;; Key Bindings - -(defvar-keymap magit-mode-map - :doc "Parent keymap for all keymaps of modes derived from `magit-mode'." - :parent magit-section-mode-map - ;; Don't function-quote but make sure all commands are autoloaded. - "C-<return>" 'magit-visit-thing - "RET" 'magit-visit-thing - "M-TAB" 'magit-dired-jump - "M-<tab>" 'magit-section-cycle-diffs - "SPC" 'magit-diff-show-or-scroll-up - "S-SPC" 'magit-diff-show-or-scroll-down - "DEL" 'magit-diff-show-or-scroll-down - "+" 'magit-diff-more-context - "-" 'magit-diff-less-context - "0" 'magit-diff-default-context - "a" 'magit-cherry-apply - "A" 'magit-cherry-pick - "b" 'magit-branch - "B" 'magit-bisect - "c" 'magit-commit - "C" 'magit-clone - "d" 'magit-diff - "D" 'magit-diff-refresh - "e" 'magit-ediff-dwim - "E" 'magit-ediff - "f" 'magit-fetch - "F" 'magit-pull - "g" 'magit-refresh - "G" 'magit-refresh-all - "h" 'magit-dispatch - "?" 'magit-dispatch - "H" 'magit-describe-section - "i" 'magit-gitignore - "I" 'magit-init - "j" 'magit-status-quick - "J" 'magit-display-repository-buffer - "k" 'magit-delete-thing - "K" 'magit-file-untrack - "l" 'magit-log - "L" 'magit-log-refresh - "m" 'magit-merge - "M" 'magit-remote - ;; "n" magit-section-forward in magit-section-mode-map - ;; "N" forge-dispatch, added by forge package - "o" 'magit-submodule - "O" 'magit-subtree - ;; "p" magit-section-backward in magit-section-mode-map - "P" 'magit-push - "q" 'magit-mode-bury-buffer - "Q" 'magit-git-command - ":" 'magit-git-command - "r" 'magit-rebase - "R" 'magit-file-rename - "s" 'magit-stage-file - "S" 'magit-stage-modified - "t" 'magit-tag - "T" 'magit-notes - "u" 'magit-unstage-file - "U" 'magit-unstage-all - "v" 'magit-revert-no-commit - "V" 'magit-revert - "w" 'magit-am - "W" 'magit-patch - "x" 'magit-reset-quickly - "X" 'magit-reset - "y" 'magit-show-refs - "Y" 'magit-cherry - "z" 'magit-stash - "Z" 'magit-worktree - "%" 'magit-worktree - "$" 'magit-process-buffer - "!" 'magit-run - ">" 'magit-sparse-checkout - "C-c C-c" 'magit-dispatch - "C-c C-e" 'magit-edit-thing - "C-c C-o" 'magit-browse-thing - "C-c C-w" 'magit-copy-thing - "C-w" 'magit-copy-section-value - "M-w" 'magit-copy-buffer-revision - "<remap> <previous-line>" 'magit-previous-line - "<remap> <next-line>" 'magit-next-line - "<remap> <evil-previous-line>" 'evil-previous-visual-line - "<remap> <evil-next-line>" 'evil-next-visual-line) - -(defun magit-delete-thing () - "This is a placeholder command, which signals an error if called. -Where applicable, other keymaps remap this command to another, -which actually deletes the thing at point." - (interactive) - (user-error "There is no thing at point that could be deleted")) -;; Starting with Emacs 28.1 we could use (declare (completion ignore)). -(put 'magit-delete-thing 'completion-predicate #'ignore) - -(defun magit-visit-thing () - "This is a placeholder command, which may signal an error if called. -Where applicable, other keymaps remap this command to another, -which actually visits the thing at point." - (interactive) - (if (eq transient-current-command 'magit-dispatch) - (call-interactively (key-binding (this-command-keys))) - (if-let ((url (browse-url-url-at-point))) - (browse-url url) - (user-error "There is no thing at point that could be visited")))) -(put 'magit-visit-thing 'completion-predicate #'ignore) - -(defun magit-edit-thing () - "This is a placeholder command, which may signal an error if called. -Where applicable, other keymaps remap this command to another, -which actually lets you edit the thing at point, likely in another -buffer." - (interactive) - (if (eq transient-current-command 'magit-dispatch) - (call-interactively (key-binding (this-command-keys))) - (user-error "There is no thing at point that could be edited"))) -(put 'magit-edit-thing 'completion-predicate #'ignore) - -(defun magit-browse-thing () - "This is a placeholder command, which may signal an error if called. -Where applicable, other keymaps remap this command to another, -which actually visits thing at point using `browse-url'." - (interactive) - (if-let ((url (browse-url-url-at-point))) - (browse-url url) - (user-error "There is no thing at point that could be browsed"))) -(put 'magit-browse-thing 'completion-predicate #'ignore) - -(defun magit-copy-thing () - "This is a placeholder command, which signals an error if called. -Where applicable, other keymaps remap this command to another, -which actually copies some representation of the thing at point -to the kill ring." - (interactive) - (user-error "There is no thing at point that we know how to copy")) -(put 'magit-copy-thing 'completion-predicate #'ignore) - -;;;###autoload -(defun magit-info () - "Visit the Magit manual." - (interactive) - (info "magit")) - -(defvar bug-reference-map) -(with-eval-after-load 'bug-reference - (keymap-set bug-reference-map "<remap> <magit-visit-thing>" - 'bug-reference-push-button)) - -(easy-menu-define magit-mode-menu magit-mode-map - "Magit menu" - ;; Similar to `magit-dispatch' but exclude: - ;; - commands that are available from context menus: - ;; apply, reverse, discard, stage, unstage, - ;; cherry-pick, revert, reset, - ;; describe-section - ;; - commands that are available from submenus: - ;; git-command, ediff-dwim - ;; - and: refresh-all, status-jump, status-quick. - '("Magit" - "---" "Inspect" - [" Bisect..." magit-bisect t] - [" Cherries..." magit-cherry t] - [" Diff..." magit-diff t] - [" Ediff..." magit-ediff t] - [" Log..." magit-log t] - [" References..." magit-show-refs t] - "---" "Manipulate" - [" Commit..." magit-commit t] - [" Stash..." magit-stash t] - [" Tag..." magit-tag t] - "---" - [" Branch..." magit-branch t] - [" Remote..." magit-remote t] - "---" - [" Merge..." magit-merge t] - [" Rebase..." magit-rebase t] - "---" "Transfer" - [" Fetch..." magit-fetch t] - [" Pull..." magit-pull t] - [" Push..." magit-push t] - "---" "Setup" - [" Clone..." magit-clone t] - [" Ignore..." magit-gitignore t] - [" Init..." magit-init t] - "---" - ("Advanced" - ["Run..." magit-run t] - "---" - ["Apply patches..." magit-am t] - ["Format patches..." magit-patch t] - "---" - ["Note..." magit-notes t] - "---" - ["Submodule..." magit-submodule t] - ["Subtree..." magit-subtree t] - ["Worktree..." magit-worktree t]) - "---" - ["Show command dispatcher..." magit-dispatch t] - ["Show manual" magit-info t] - ["Show another buffer" magit-display-repository-buffer t] - "---" - ("Change buffer arguments" - ["Diff arguments" magit-diff-refresh t] - ["Log arguments" magit-log-refresh t]) - ["Refresh buffer" magit-refresh t] - ["Bury buffer" magit-mode-bury-buffer t])) - -;;; Mode - -(defun magit-load-config-extensions () - "Load Magit extensions that are defined at the Git config layer." - (dolist (ext (magit-get-all "magit.extension")) - (let ((sym (intern (format "magit-%s-mode" ext)))) - (when (fboundp sym) - (funcall sym 1))))) - -(define-derived-mode magit-mode magit-section-mode "Magit" - "Parent major mode from which Magit major modes inherit. - -Magit is documented in info node `(magit)'." - :group 'magit - (hack-dir-local-variables-non-file-buffer) - (face-remap-add-relative 'header-line 'magit-header-line) - (setq mode-line-process (magit-repository-local-get 'mode-line-process)) - (setq-local revert-buffer-function #'magit-refresh-buffer) - (setq-local bookmark-make-record-function #'magit--make-bookmark) - (setq-local imenu-create-index-function #'magit--imenu-create-index) - (setq-local imenu-default-goto-function #'magit--imenu-goto-function) - (setq-local isearch-filter-predicate #'magit-section--open-temporarily)) - -;;; Local Variables - -(defvar-local magit-buffer-arguments nil) -(defvar-local magit-buffer-diff-type nil) -(defvar-local magit-buffer-diff-args nil) -(defvar-local magit-buffer-diff-files nil) -(defvar-local magit-buffer-diff-files-suspended nil) -(defvar-local magit-buffer-file-name nil) -(defvar-local magit-buffer-files nil) -(defvar-local magit-buffer-log-args nil) -(defvar-local magit-buffer-log-files nil) -(defvar-local magit-buffer-range nil) -(defvar-local magit-buffer-range-hashed nil) -(defvar-local magit-buffer-refname nil) -(defvar-local magit-buffer-revision nil) -(defvar-local magit-buffer-revision-hash nil) -(defvar-local magit-buffer-revisions nil) -(defvar-local magit-buffer-typearg nil) -(defvar-local magit-buffer-upstream nil) - -;; These variables are also used in file-visiting buffers. -;; Because the user may change the major-mode, they have -;; to be permanent buffer-local. -(put 'magit-buffer-file-name 'permanent-local t) -(put 'magit-buffer-refname 'permanent-local t) -(put 'magit-buffer-revision 'permanent-local t) -(put 'magit-buffer-revision-hash 'permanent-local t) - -;; `magit-status' re-enables mode function but its refresher -;; function does not reinstate this. -(put 'magit-buffer-diff-files-suspended 'permanent-local t) - -(cl-defgeneric magit-buffer-value () - "Return the value of the current buffer. -The \"value\" identifies what is being displayed in the buffer. -The buffer's major-mode should derive from `magit-section-mode'." - nil) - -(defvar-local magit-previous-section nil) -(put 'magit-previous-section 'permanent-local t) - -;;; Setup Buffer - -(defmacro magit-setup-buffer (mode &optional locked &rest bindings) - (declare (indent 2)) - `(magit-setup-buffer-internal - ,mode ,locked - ,(cons 'list (mapcar (pcase-lambda (`(,var ,form)) - `(list ',var ,form)) - bindings)))) - -(defun magit-setup-buffer-internal ( mode locked bindings - &optional buffer-or-name) - (let* ((value (and locked - (with-temp-buffer - (pcase-dolist (`(,var ,val) bindings) - (set (make-local-variable var) val)) - (let ((major-mode mode)) - (magit-buffer-value))))) - (buffer (if buffer-or-name - (get-buffer-create buffer-or-name) - (magit-get-mode-buffer mode value))) - (section (and buffer (magit-current-section))) - (created (not buffer))) - (unless buffer - (setq buffer (magit-generate-new-buffer mode value))) - (with-current-buffer buffer - (setq magit-previous-section section) - (funcall mode) - (magit-xref-setup #'magit-setup-buffer-internal bindings) - (pcase-dolist (`(,var ,val) bindings) - (set (make-local-variable var) val)) - (when created - (run-hooks 'magit-create-buffer-hook))) - (magit-display-buffer buffer) - (with-current-buffer buffer - (run-hooks 'magit-setup-buffer-hook) - (magit-refresh-buffer) - (when created - (run-hooks 'magit-post-create-buffer-hook))) - buffer)) - -;;; Display Buffer - -(defvar magit-display-buffer-noselect nil - "If non-nil, then `magit-display-buffer' doesn't call `select-window'.") - -(defun magit-display-buffer (buffer &optional display-function) - "Display BUFFER in some window and maybe select it. - -If optional DISPLAY-FUNCTION is non-nil, then use that to display -the buffer. Otherwise use `magit-display-buffer-function', which -is the normal case. - -Then, unless `magit-display-buffer-noselect' is non-nil, select -the window which was used to display the buffer. - -Also run the hooks `magit-pre-display-buffer-hook' -and `magit-post-display-buffer-hook'." - (with-current-buffer buffer - (run-hooks 'magit-pre-display-buffer-hook)) - (let ((window (funcall (or display-function magit-display-buffer-function) - buffer))) - (unless magit-display-buffer-noselect - (let* ((old-frame (selected-frame)) - (new-frame (window-frame window))) - (select-window window) - (unless (eq old-frame new-frame) - (select-frame-set-input-focus new-frame))))) - (with-current-buffer buffer - (run-hooks 'magit-post-display-buffer-hook))) - -(defun magit-display-buffer-traditional (buffer) - "Display BUFFER the way this has traditionally been done." - (display-buffer - buffer (if (and (derived-mode-p 'magit-mode) - (not (memq (with-current-buffer buffer major-mode) - '(magit-process-mode - magit-revision-mode - magit-diff-mode - magit-stash-mode - magit-status-mode)))) - '(display-buffer-same-window) - nil))) ; display in another window - -(defun magit-display-buffer-same-window-except-diff-v1 (buffer) - "Display BUFFER in the selected window except for some modes. -If a buffer's `major-mode' derives from `magit-diff-mode' or -`magit-process-mode', display it in another window. Display all -other buffers in the selected window." - (display-buffer - buffer (if (with-current-buffer buffer - (derived-mode-p 'magit-diff-mode 'magit-process-mode)) - '(nil (inhibit-same-window . t)) - '(display-buffer-same-window)))) - -(defun magit--display-buffer-fullframe (buffer alist) - (when-let ((window (or (display-buffer-reuse-window buffer alist) - (display-buffer-same-window buffer alist) - (display-buffer-pop-up-window buffer alist) - (display-buffer-use-some-window buffer alist)))) - (delete-other-windows window) - window)) - -(defun magit-display-buffer-fullframe-status-v1 (buffer) - "Display BUFFER, filling entire frame if BUFFER is a status buffer. -Otherwise, behave like `magit-display-buffer-traditional'." - (if (eq (with-current-buffer buffer major-mode) - 'magit-status-mode) - (display-buffer buffer '(magit--display-buffer-fullframe)) - (magit-display-buffer-traditional buffer))) - -(defun magit--display-buffer-topleft (buffer alist) - (or (display-buffer-reuse-window buffer alist) - (when-let ((window2 (display-buffer-pop-up-window buffer alist))) - (let ((window1 (get-buffer-window)) - (buffer1 (current-buffer)) - (buffer2 (window-buffer window2)) - (w2-quit-restore (window-parameter window2 'quit-restore))) - (set-window-buffer window1 buffer2) - (set-window-buffer window2 buffer1) - (select-window window2) - ;; Swap some window state that `magit-mode-quit-window' and - ;; `quit-restore-window' inspect. - (set-window-prev-buffers window2 (cdr (window-prev-buffers window1))) - (set-window-prev-buffers window1 nil) - (set-window-parameter window2 'magit-dedicated - (window-parameter window1 'magit-dedicated)) - (set-window-parameter window1 'magit-dedicated t) - (set-window-parameter window1 'quit-restore - (list 'window 'window - (nth 2 w2-quit-restore) - (nth 3 w2-quit-restore))) - (set-window-parameter window2 'quit-restore nil) - window1)))) - -(defun magit-display-buffer-fullframe-status-topleft-v1 (buffer) - "Display BUFFER, filling entire frame if BUFFER is a status buffer. -When BUFFER derives from `magit-diff-mode' or -`magit-process-mode', try to display BUFFER to the top or left of -the current buffer rather than to the bottom or right, as -`magit-display-buffer-fullframe-status-v1' would. Whether the -split is made vertically or horizontally is determined by -`split-window-preferred-function'." - (display-buffer - buffer - (cond ((eq (with-current-buffer buffer major-mode) - 'magit-status-mode) - '(magit--display-buffer-fullframe)) - ((with-current-buffer buffer - (derived-mode-p 'magit-diff-mode 'magit-process-mode)) - '(magit--display-buffer-topleft)) - (t - '(display-buffer-same-window))))) - -(defun magit--display-buffer-fullcolumn (buffer alist) - (when-let ((window (or (display-buffer-reuse-window buffer alist) - (display-buffer-same-window buffer alist) - (display-buffer-below-selected buffer alist)))) - (delete-other-windows-vertically window) - window)) - -(defun magit-display-buffer-fullcolumn-most-v1 (buffer) - "Display BUFFER using the full column except in some cases. -For most cases where BUFFER's `major-mode' derives from -`magit-mode', display it in the selected window and grow that -window to the full height of the frame, deleting other windows in -that column as necessary. However, display BUFFER in another -window if 1) BUFFER's mode derives from `magit-process-mode', or -2) BUFFER's mode derives from `magit-diff-mode', provided that -the mode of the current buffer derives from `magit-log-mode' or -`magit-cherry-mode'." - (display-buffer - buffer - (cond ((and (or (bound-and-true-p git-commit-mode) - (derived-mode-p 'magit-log-mode - 'magit-cherry-mode - 'magit-reflog-mode)) - (with-current-buffer buffer - (derived-mode-p 'magit-diff-mode))) - nil) - ((with-current-buffer buffer - (derived-mode-p 'magit-process-mode)) - nil) - (t - '(magit--display-buffer-fullcolumn))))) - -(defun magit-maybe-set-dedicated () - "Mark the selected window as dedicated if appropriate. - -If a new window was created to display the buffer, then remember -that fact. That information is used by `magit-mode-quit-window', -to determine whether the window should be deleted when its last -Magit buffer is buried." - (let ((window (get-buffer-window (current-buffer)))) - (when (and (window-live-p window) - (not (window-prev-buffers window))) - (set-window-parameter window 'magit-dedicated t)))) - -;;; Get Buffer - -(defvar-local magit--default-directory nil - "Value of `default-directory' when buffer is generated. -This exists to prevent a let-bound `default-directory' from -tricking `magit-get-mode-buffer' or `magit-mode-get-buffers' -into thinking a buffer belongs to a repo that it doesn't.") -(put 'magit--default-directory 'permanent-local t) - -(defun magit-mode-get-buffers () - (let ((topdir (magit-toplevel))) - (--filter (with-current-buffer it - (and (derived-mode-p 'magit-mode) - (equal magit--default-directory topdir))) - (buffer-list)))) - -(defvar-local magit-buffer-locked-p nil) -(put 'magit-buffer-locked-p 'permanent-local t) - -(defun magit-get-mode-buffer (mode &optional value frame) - "Return buffer belonging to the current repository whose major-mode is MODE. - -If no such buffer exists then return nil. Multiple buffers with -the same major-mode may exist for a repository but only one can -exist that hasn't been locked to its value. Return that buffer -\(or nil if there is no such buffer) unless VALUE is non-nil, in -which case return the buffer that has been locked to that value. - -If FRAME is nil or omitted, then consider all buffers. Otherwise - only consider buffers that are displayed in some live window - on some frame. -If `all', then consider all buffers on all frames. -If `visible', then only consider buffers on all visible frames. -If `selected' or t, then only consider buffers on the selected - frame. -If a frame, then only consider buffers on that frame." - (let ((topdir (magit--toplevel-safe))) - (cl-flet* ((b (buffer) - (with-current-buffer buffer - (and (eq major-mode mode) - (equal magit--default-directory topdir) - (if value - (and magit-buffer-locked-p - (equal (magit-buffer-value) value)) - (not magit-buffer-locked-p)) - buffer))) - (w (window) - (b (window-buffer window))) - (f (frame) - (seq-some #'w (window-list frame 'no-minibuf)))) - (pcase-exhaustive frame - ('nil (seq-some #'b (buffer-list))) - ('all (seq-some #'f (frame-list))) - ('visible (seq-some #'f (visible-frame-list))) - ((or 'selected 't) (seq-some #'w (window-list (selected-frame)))) - ((guard (framep frame)) (seq-some #'w (window-list frame))))))) - -(defun magit-generate-new-buffer (mode &optional value directory) - (let* ((default-directory (or directory (magit--toplevel-safe))) - (name (funcall magit-generate-buffer-name-function mode value)) - (buffer (generate-new-buffer name))) - (with-current-buffer buffer - (setq magit--default-directory default-directory) - (setq magit-buffer-locked-p (and value t)) - (magit-restore-section-visibility-cache mode)) - (when magit-uniquify-buffer-names - (add-to-list 'uniquify-list-buffers-directory-modes mode) - (with-current-buffer buffer - (setq list-buffers-directory (abbreviate-file-name default-directory))) - (let ((uniquify-buffer-name-style - (if (memq uniquify-buffer-name-style '(nil forward)) - 'post-forward-angle-brackets - uniquify-buffer-name-style))) - (uniquify-rationalize-file-buffer-names - name (file-name-directory (directory-file-name default-directory)) - buffer))) - buffer)) - -(defun magit-generate-buffer-name-default-function (mode &optional value) - "Generate buffer name for a MODE buffer in the current repository. -The returned name is based on `magit-buffer-name-format' and -takes `magit-uniquify-buffer-names' and VALUE, if non-nil, into -account." - (let ((m (substring (symbol-name mode) 0 -5)) - (v (and value (format "%s" (if (listp value) value (list value))))) - (n (if magit-uniquify-buffer-names - (file-name-nondirectory - (directory-file-name default-directory)) - (abbreviate-file-name default-directory)))) - (format-spec - magit-buffer-name-format - `((?m . ,m) - (?M . ,(if (eq mode 'magit-status-mode) "magit" m)) - (?v . ,(or v "")) - (?V . ,(if v (concat " " v) "")) - (?t . ,n) - (?x . ,(if magit-uniquify-buffer-names "" "*")))))) - -;;; Buffer Lock - -(defun magit-toggle-buffer-lock () - "Lock the current buffer to its value or unlock it. - -Locking a buffer to its value prevents it from being reused to -display another value. The name of a locked buffer contains its -value, which allows telling it apart from other locked buffers -and the unlocked buffer. - -Not all Magit buffers can be locked to their values, for example -it wouldn't make sense to lock a status buffer. - -There can only be a single unlocked buffer using a certain -major-mode per repository. So when a buffer is being unlocked -and another unlocked buffer already exists for that mode and -repository, then the former buffer is instead deleted and the -latter is displayed in its place." - (interactive) - (if magit-buffer-locked-p - (if-let ((unlocked (magit-get-mode-buffer major-mode))) - (let ((locked (current-buffer))) - (switch-to-buffer unlocked nil t) - (kill-buffer locked)) - (setq magit-buffer-locked-p nil) - (rename-buffer (funcall magit-generate-buffer-name-function - major-mode))) - (if-let ((value (magit-buffer-value))) - (if-let ((locked (magit-get-mode-buffer major-mode value))) - (let ((unlocked (current-buffer))) - (switch-to-buffer locked nil t) - (kill-buffer unlocked)) - (setq magit-buffer-locked-p t) - (rename-buffer (funcall magit-generate-buffer-name-function - major-mode value))) - (user-error "Buffer has no value it could be locked to")))) - -;;; Bury Buffer - -(defun magit-mode-bury-buffer (&optional kill-buffer) - "Bury or kill the current buffer. - -Use `magit-bury-buffer-function' to bury the buffer when called -without a prefix argument or to kill it when called with a single -prefix argument. - -With two prefix arguments, always kill the current and all other -Magit buffers, associated with this repository." - (interactive "P") - (if (>= (prefix-numeric-value kill-buffer) 16) - (mapc #'kill-buffer (magit-mode-get-buffers)) - (funcall magit-bury-buffer-function kill-buffer))) - -(defun magit-mode-quit-window (kill-buffer) - "Quit the selected window and bury its buffer. - -This behaves similar to `quit-window', but when the window -was originally created to display a Magit buffer and the -current buffer is the last remaining Magit buffer that was -ever displayed in the selected window, then delete that -window." - (if (or (one-window-p) - (--first (let ((buffer (car it))) - (and (not (eq buffer (current-buffer))) - (buffer-live-p buffer) - (or (not (window-parameter nil 'magit-dedicated)) - (with-current-buffer buffer - (derived-mode-p 'magit-mode - 'magit-process-mode))))) - (window-prev-buffers))) - (quit-window kill-buffer) - (let ((window (selected-window))) - (quit-window kill-buffer) - (when (window-live-p window) - (delete-window window))))) - -;;; Refresh Buffers - -(defvar magit-inhibit-refresh nil) - -(defun magit-refresh () - "Refresh some buffers belonging to the current repository. - -Refresh the current buffer if its major mode derives from -`magit-mode', and refresh the corresponding status buffer. - -Run hooks `magit-pre-refresh-hook' and `magit-post-refresh-hook'." - (interactive) - (unless magit-inhibit-refresh - (unwind-protect - (let ((start (current-time)) - (magit--refresh-cache (or magit--refresh-cache - (list (cons 0 0))))) - (when magit-refresh-verbose - (message "Refreshing magit...")) - (magit-run-hook-with-benchmark 'magit-pre-refresh-hook) - (cond ((derived-mode-p 'magit-mode) - (magit-refresh-buffer)) - ((derived-mode-p 'tabulated-list-mode) - (revert-buffer))) - (when-let ((buffer (and magit-refresh-status-buffer - (not (derived-mode-p 'magit-status-mode)) - (magit-get-mode-buffer 'magit-status-mode)))) - (with-current-buffer buffer - (magit-refresh-buffer))) - (magit-run-hook-with-benchmark 'magit-post-refresh-hook) - (when magit-refresh-verbose - (let* ((c (caar magit--refresh-cache)) - (a (+ c (cdar magit--refresh-cache)))) - (message "Refreshing magit...done (%.3fs, cached %s/%s (%.0f%%))" - (float-time (time-since start)) - c a (* (/ c (* a 1.0)) 100))))) - (run-hooks 'magit-unwind-refresh-hook)))) - -(defun magit-refresh-all () - "Refresh all buffers belonging to the current repository. - -Refresh all Magit buffers belonging to the current repository, -and revert buffers that visit files located inside the current -repository. - -Run hooks `magit-pre-refresh-hook' and `magit-post-refresh-hook'." - (interactive) - (magit-run-hook-with-benchmark 'magit-pre-refresh-hook) - (dolist (buffer (magit-mode-get-buffers)) - (with-current-buffer buffer (magit-refresh-buffer))) - (magit-run-hook-with-benchmark 'magit-post-refresh-hook)) - -(defvar-local magit-refresh-start-time nil) - -(defun magit-refresh-buffer (&rest _ignore) - "Refresh the current Magit buffer." - (interactive) - (setq magit-refresh-start-time (current-time)) - (let ((refresh (intern (format "%s-refresh-buffer" - (substring (symbol-name major-mode) 0 -5)))) - (magit--refresh-cache (or magit--refresh-cache (list (cons 0 0))))) - (when (functionp refresh) - (when magit-refresh-verbose - (message "Refreshing buffer `%s'..." (buffer-name))) - (let* ((buffer (current-buffer)) - (windows (cl-mapcan - (lambda (window) - (with-selected-window window - (with-current-buffer buffer - (and-let* ((section (magit-section-at))) - `(( ,window - ,section - ,@(magit-section-get-relative-position - section))))))) - ;; If it qualifies, then the selected window - ;; comes first, but we want to handle it last - ;; so that its `magit-section-movement-hook' - ;; run can override the effects of other runs. - (or (nreverse (get-buffer-window-list buffer nil t)) - (list (selected-window)))))) - (deactivate-mark) - (setq magit-section-pre-command-section nil) - (setq magit-section-highlight-overlays nil) - (setq magit-section-highlighted-sections nil) - (setq magit-section-unhighlight-sections nil) - (let ((inhibit-read-only t)) - (erase-buffer) - (save-excursion - (funcall refresh))) - (pcase-dolist (`(,window . ,args) windows) - (if (eq buffer (window-buffer window)) - (with-selected-window window - (apply #'magit-section-goto-successor args)) - (with-current-buffer buffer - (let ((magit-section-movement-hook nil)) - (apply #'magit-section-goto-successor args))))) - (run-hooks 'magit-refresh-buffer-hook) - (magit-section-update-highlight) - (set-buffer-modified-p nil)) - (when magit-refresh-verbose - (message "Refreshing buffer `%s'...done (%.3fs)" (buffer-name) - (float-time (time-since magit-refresh-start-time))))))) - -(defun magit-profile-refresh-buffer () - "Profile refreshing the current Magit buffer." - (interactive) - (require (quote elp)) - (when (fboundp 'elp-reset-all) - (elp-reset-all) - (elp-instrument-package "magit-") - (elp-instrument-package "forge-") - (magit-refresh-buffer) - (elp-results) - (elp-reset-all))) - -;;; Save File-Visiting Buffers - -(defvar magit--disable-save-buffers nil) - -(defun magit-pre-command-hook () - (setq magit--disable-save-buffers nil)) -(add-hook 'pre-command-hook #'magit-pre-command-hook) - -(defvar magit-after-save-refresh-buffers nil) - -(defun magit-after-save-refresh-buffers () - (dolist (buffer magit-after-save-refresh-buffers) - (when (buffer-live-p buffer) - (with-current-buffer buffer - (magit-refresh-buffer)))) - (setq magit-after-save-refresh-buffers nil) - (remove-hook 'post-command-hook #'magit-after-save-refresh-buffers)) - -(defun magit-after-save-refresh-status () - "Refresh the status buffer of the current repository. - -This function is intended to be added to `after-save-hook'. - -If the status buffer does not exist or the file being visited in -the current buffer isn't inside the working tree of a repository, -then do nothing. - -Note that refreshing a Magit buffer is done by re-creating its -contents from scratch, which can be slow in large repositories. -If you are not satisfied with Magit's performance, then you -should obviously not add this function to that hook." - (when (and (not magit--disable-save-buffers) - (magit-inside-worktree-p t)) - (when-let ((buffer (ignore-errors - (magit-get-mode-buffer 'magit-status-mode)))) - (add-to-list 'magit-after-save-refresh-buffers buffer) - (add-hook 'post-command-hook #'magit-after-save-refresh-buffers)))) - -(defun magit-maybe-save-repository-buffers () - "Maybe save file-visiting buffers belonging to the current repository. -Do so if `magit-save-repository-buffers' is non-nil. You should -not remove this from any hooks, instead set that variable to nil -if you so desire." - (when (and magit-save-repository-buffers - (not magit--disable-save-buffers)) - (setq magit--disable-save-buffers t) - (let ((msg (current-message))) - (magit-save-repository-buffers - (eq magit-save-repository-buffers 'dontask)) - (when (and msg - (current-message) - (not (equal msg (current-message)))) - (message "%s" msg))))) - -(add-hook 'magit-pre-refresh-hook #'magit-maybe-save-repository-buffers) -(add-hook 'magit-pre-call-git-hook #'magit-maybe-save-repository-buffers) -(add-hook 'magit-pre-start-git-hook #'magit-maybe-save-repository-buffers) - -(defvar-local magit-inhibit-refresh-save nil) - -(defun magit-save-repository-buffers (&optional arg) - "Save file-visiting buffers belonging to the current repository. -After any buffer where `buffer-save-without-query' is non-nil -is saved without asking, the user is asked about each modified -buffer which visits a file in the current repository. Optional -argument (the prefix) non-nil means save all with no questions." - (interactive "P") - (when-let ((topdir (magit-rev-parse-safe "--show-toplevel"))) - (let ((remote (file-remote-p default-directory)) - (save-some-buffers-action-alist - `((?Y (lambda (buffer) - (with-current-buffer buffer - (setq buffer-save-without-query t) - (save-buffer))) - "to save the current buffer and remember choice") - (?N (lambda (buffer) - (with-current-buffer buffer - (setq magit-inhibit-refresh-save t))) - "to skip the current buffer and remember choice") - ,@save-some-buffers-action-alist)) - (topdirs nil) - (unwiped nil) - (magit--wip-inhibit-autosave t)) - (unwind-protect - (save-some-buffers - arg - (lambda () - ;; If the current file is modified and resides inside - ;; a repository, and a let-binding is in effect, which - ;; places us in another repository, then this binding - ;; is needed to prevent that file from being saved. - (and-let* ((default-directory - (and buffer-file-name - (file-name-directory buffer-file-name)))) - (and - ;; Check whether the repository still exists. - (file-exists-p default-directory) - ;; Check whether refreshing is disabled. - (not magit-inhibit-refresh-save) - ;; Check whether the visited file is either on the - ;; same remote as the repository, or both are on - ;; the local system. - (equal (file-remote-p buffer-file-name) remote) - ;; Delayed checks that are more expensive for remote - ;; repositories, due to the required network access. - ;; - ;; Check whether the file is inside the repository. - (equal (or (cdr (assoc default-directory topdirs)) - (let ((top (magit-rev-parse-safe "--show-toplevel"))) - (push (cons default-directory top) topdirs) - top)) - topdir) - ;; Check whether the file is actually writable. - (file-writable-p buffer-file-name) - (prog1 t - ;; Schedule for wip commit, if appropriate. - (when magit-wip-after-save-local-mode - (push (expand-file-name buffer-file-name) unwiped))))))) - (when unwiped - (let ((default-directory topdir)) - (magit-wip-commit-worktree - (magit-wip-get-ref) - unwiped - (if (cdr unwiped) - (format "autosave %s files after save" (length unwiped)) - (format "autosave %s after save" - (file-relative-name (car unwiped))))))))))) - -;;; Restore Window Configuration - -(defvar magit-inhibit-save-previous-winconf nil) - -(defvar-local magit-previous-window-configuration nil) -(put 'magit-previous-window-configuration 'permanent-local t) - -(defun magit-save-window-configuration () - "Save the current window configuration. - -Later, when the buffer is buried, it may be restored by -`magit-restore-window-configuration'." - (if magit-inhibit-save-previous-winconf - (when (eq magit-inhibit-save-previous-winconf 'unset) - (setq magit-previous-window-configuration nil)) - (unless (get-buffer-window (current-buffer) (selected-frame)) - (setq magit-previous-window-configuration - (current-window-configuration))))) - -(defun magit-restore-window-configuration (&optional kill-buffer) - "Bury or kill the current buffer and restore previous window configuration." - (let ((winconf magit-previous-window-configuration) - (buffer (current-buffer)) - (frame (selected-frame))) - (quit-window kill-buffer (selected-window)) - (when (and winconf (equal frame (window-configuration-frame winconf))) - (set-window-configuration winconf) - (when (buffer-live-p buffer) - (with-current-buffer buffer - (setq magit-previous-window-configuration nil))) - (set-buffer (with-selected-window (selected-window) - (current-buffer)))))) - -;;; Buffer History - -(defun magit-go-backward () - "Move backward in current buffer's history." - (interactive) - (if help-xref-stack - (help-xref-go-back (current-buffer)) - (user-error "No previous entry in buffer's history"))) - -(defun magit-go-forward () - "Move forward in current buffer's history." - (interactive) - (if help-xref-forward-stack - (help-xref-go-forward (current-buffer)) - (user-error "No next entry in buffer's history"))) - -(defun magit-insert-xref-buttons () - "Insert xref buttons." - (when (and (not magit-buffer-locked-p) - (or help-xref-stack help-xref-forward-stack)) - (when help-xref-stack - (magit-xref-insert-button help-back-label 'magit-xref-backward)) - (when help-xref-forward-stack - (when help-xref-stack - (insert " ")) - (magit-xref-insert-button help-forward-label 'magit-xref-forward)))) - -(defun magit-xref-insert-button (label type) - (magit-insert-section (button label) - (insert-text-button label 'type type - 'help-args (list (current-buffer))))) - -(define-button-type 'magit-xref-backward - :supertype 'help-back - 'mouse-face 'magit-section-highlight - 'help-echo (purecopy "mouse-2, RET: go back to previous history entry")) - -(define-button-type 'magit-xref-forward - :supertype 'help-forward - 'mouse-face 'magit-section-highlight - 'help-echo (purecopy "mouse-2, RET: go back to next history entry")) - -(defvar magit-xref-modes - '(magit-log-mode - magit-reflog-mode - magit-diff-mode - magit-revision-mode) - "List of modes for which to insert navigation buttons.") - -(defun magit-xref-setup (fn args) - (when (memq major-mode magit-xref-modes) - (when help-xref-stack-item - (push (cons (point) help-xref-stack-item) help-xref-stack) - (setq help-xref-forward-stack nil)) - (when-let ((tail (nthcdr 30 help-xref-stack))) - (setcdr tail nil)) - (setq help-xref-stack-item - (list 'magit-xref-restore fn default-directory args)))) - -(defun magit-xref-restore (fn dir args) - (setq default-directory dir) - (funcall fn major-mode nil args) - (magit-refresh-buffer)) - -;;; Repository-Local Cache - -(defvar magit-repository-local-cache nil - "Alist mapping `magit-toplevel' paths to alists of key/value pairs.") - -(defun magit-repository-local-repository () - "Return the key for the current repository." - (or (bound-and-true-p magit--default-directory) - (magit-toplevel))) - -(defun magit-repository-local-set (key value &optional repository) - "Set the repository-local VALUE for KEY. - -Unless specified, REPOSITORY is the current buffer's repository. - -If REPOSITORY is nil (meaning there is no current repository), -then the value is not cached, and we return nil." - (let* ((repokey (or repository (magit-repository-local-repository))) - (cache (assoc repokey magit-repository-local-cache))) - ;; Don't cache values for a nil REPOSITORY, as the 'set' and 'get' - ;; calls for some KEY may happen in unrelated contexts. - (when repokey - (if cache - (let ((keyvalue (assoc key (cdr cache)))) - (if keyvalue - ;; Update pre-existing value for key. - (setcdr keyvalue value) - ;; No such key in repository-local cache. - (push (cons key value) (cdr cache)))) - ;; No cache for this repository. - (push (cons repokey (list (cons key value))) - magit-repository-local-cache))))) - -(defun magit-repository-local-exists-p (key &optional repository) - "Non-nil when a repository-local value exists for KEY. - -Return a (KEY . VALUE) cons cell. - -The KEY is matched using `equal'. - -Unless specified, REPOSITORY is the current buffer's repository." - (and-let* ((cache (assoc (or repository - (magit-repository-local-repository)) - magit-repository-local-cache))) - (assoc key (cdr cache)))) - -(defun magit-repository-local-get (key &optional default repository) - "Return the repository-local value for KEY. - -Return DEFAULT if no value for KEY exists. - -The KEY is matched using `equal'. - -Unless specified, REPOSITORY is the current buffer's repository." - (if-let ((keyvalue (magit-repository-local-exists-p key repository))) - (cdr keyvalue) - default)) - -(defun magit-repository-local-delete (key &optional repository) - "Delete the repository-local value for KEY. - -Unless specified, REPOSITORY is the current buffer's repository. -If REPOSITORY is `all', then delete the value for KEY for all -repositories." - (if (eq repository 'all) - (dolist (cache magit-repository-local-cache) - (setf cache (compat-call assoc-delete-all key cache))) - (when-let ((cache (assoc (or repository - (magit-repository-local-repository)) - magit-repository-local-cache))) - (setf cache (compat-call assoc-delete-all key cache))))) - -(defmacro magit--with-repository-local-cache (key &rest body) - (declare (indent 1) (debug (form body))) - (let ((k (cl-gensym))) - `(let ((,k ,key)) - (if-let ((kv (magit-repository-local-exists-p ,k))) - (cdr kv) - (let ((v ,(macroexp-progn body))) - (magit-repository-local-set ,k v) - v))))) - -(defun magit-preserve-section-visibility-cache () - (when (derived-mode-p 'magit-status-mode 'magit-refs-mode) - (magit-repository-local-set - (cons major-mode 'magit-section-visibility-cache) - magit-section-visibility-cache))) - -(defun magit-restore-section-visibility-cache (mode) - (setq magit-section-visibility-cache - (magit-repository-local-get - (cons mode 'magit-section-visibility-cache)))) - -(defun magit-zap-caches (&optional all) - "Zap caches for the current repository. - -Remove the repository's entry from `magit-repository-local-cache', -remove the host's entry from `magit--host-git-version-cache', set -`magit-section-visibility-cache' to nil for all Magit buffers of -the repository and set `magit--libgit-available-p' to `unknown'. - -With a prefix argument or if optional ALL is non-nil, discard the -mentioned caches completely." - (interactive) - (cond (all - (setq magit-repository-local-cache nil) - (setq magit--host-git-version-cache nil) - (dolist (buffer (buffer-list)) - (with-current-buffer buffer - (when (derived-mode-p 'magit-mode) - (setq magit-section-visibility-cache nil))))) - (t - (magit-with-toplevel - (setq magit-repository-local-cache - (cl-delete default-directory - magit-repository-local-cache - :key #'car :test #'equal)) - (setq magit--host-git-version-cache - (cl-delete (file-remote-p default-directory) - magit--host-git-version-cache - :key #'car :test #'equal))) - (dolist (buffer (magit-mode-get-buffers)) - (with-current-buffer buffer - (setq magit-section-visibility-cache nil))))) - (setq magit--libgit-available-p 'unknown)) - -;;; Utilities - -(defun magit-toggle-verbose-refresh () - "Toggle whether Magit refreshes buffers verbosely. -Enabling this helps figuring out which sections are bottlenecks. -The additional output can be found in the *Messages* buffer." - (interactive) - (setq magit-refresh-verbose (not magit-refresh-verbose)) - (message "%s verbose refreshing" - (if magit-refresh-verbose "Enabled" "Disabled"))) - -(defun magit-run-hook-with-benchmark (hook) - (cond - ((not hook)) - (magit-refresh-verbose - (message "Running %s..." hook) - (message "Running %s...done (%.3fs)" hook - (benchmark-elapse - (run-hook-wrapped - hook - (lambda (fn) - (message " %-50s %f" fn (benchmark-elapse (funcall fn)))))))) - ((run-hooks hook)))) - -;;; _ -(provide 'magit-mode) -;;; magit-mode.el ends here diff --git a/emacs/elpa/magit-20240622.1531/magit-mode.elc b/emacs/elpa/magit-20240622.1531/magit-mode.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/magit-patch.elc b/emacs/elpa/magit-20240622.1531/magit-patch.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/magit-pkg.el b/emacs/elpa/magit-20240622.1531/magit-pkg.el @@ -1,20 +0,0 @@ -(define-package "magit" "20240622.1531" "A Git porcelain inside Emacs." - '((emacs "26.1") - (compat "29.1.4.5") - (dash "20240405") - (git-commit "20240429") - (magit-section "20240429") - (seq "2.24") - (transient "20240421") - (with-editor "20240415")) - :commit "71630e4db1ff69a8e2c13f112c21b26d8bddf1e6" :authors - '(("Marius Vollmer" . "marius.vollmer@gmail.com") - ("Jonas Bernoulli" . "emacs.magit@jonas.bernoulli.dev")) - :maintainer - '("Jonas Bernoulli" . "emacs.magit@jonas.bernoulli.dev") - :keywords - '("git" "tools" "vc") - :url "https://github.com/magit/magit") -;; Local Variables: -;; no-byte-compile: t -;; End: diff --git a/emacs/elpa/magit-20240622.1531/magit-process.el b/emacs/elpa/magit-20240622.1531/magit-process.el @@ -1,1291 +0,0 @@ -;;; magit-process.el --- Process functionality -*- lexical-binding:t -*- - -;; Copyright (C) 2008-2024 The Magit Project Contributors - -;; Author: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> -;; Maintainer: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> - -;; SPDX-License-Identifier: GPL-3.0-or-later - -;; 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. -;; -;; 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 Magit. If not, see <https://www.gnu.org/licenses/>. - -;;; Commentary: - -;; This library implements the tools used to run Git for side-effects. - -;; Note that the functions used to run Git and then consume its -;; output, are defined in `magit-git.el'. There's a bit of overlap -;; though. - -;;; Code: - -(require 'magit-base) -(require 'magit-git) -(require 'magit-mode) - -(require 'ansi-color) -(require 'auth-source) -(require 'with-editor) - -(defvar y-or-n-p-map) - -;;; Options - -(defcustom magit-process-connection-type (not (eq system-type 'cygwin)) - "Connection type used for the Git process. - -If nil, use pipes: this is usually more efficient, and works on Cygwin. -If t, use ptys: this enables Magit to prompt for passphrases when needed." - :group 'magit-process - :type '(choice (const :tag "pipe" nil) - (const :tag "pty" t))) - -(defcustom magit-need-cygwin-noglob - (and (eq system-type 'windows-nt) - (with-temp-buffer - (let ((process-environment - (append magit-git-environment process-environment))) - (condition-case e - (process-file magit-git-executable - nil (current-buffer) nil - "-c" "alias.echo=!echo" "echo" "x{0}") - (file-error - (lwarn 'magit-process :warning - "Could not run Git: %S" e)))) - (equal "x0\n" (buffer-string)))) - "Whether to use a workaround for Cygwin's globbing behavior. - -If non-nil, add environment variables to `process-environment' to -prevent the git.exe distributed by Cygwin and MSYS2 from -attempting to perform glob expansion when called from a native -Windows build of Emacs. See #2246." - :package-version '(magit . "2.3.0") - :group 'magit-process - :type '(choice (const :tag "Yes" t) - (const :tag "No" nil))) - -(defcustom magit-process-popup-time -1 - "Popup the process buffer if a command takes longer than this many seconds." - :group 'magit-process - :type '(choice (const :tag "Never" -1) - (const :tag "Immediately" 0) - (integer :tag "After this many seconds"))) - -(defcustom magit-process-log-max 32 - "Maximum number of sections to keep in a process log buffer. -When adding a new section would go beyond the limit set here, -then the older half of the sections are remove. Sections that -belong to processes that are still running are never removed. -When this is nil, no sections are ever removed." - :package-version '(magit . "2.1.0") - :group 'magit-process - :type '(choice (const :tag "Never remove old sections" nil) integer)) - -(defvar magit-process-extreme-logging nil - "Whether `magit-process-file' logs to the *Messages* buffer. - -Only intended for temporary use when you try to figure out how -Magit uses Git behind the scene. Output that normally goes to -the magit-process buffer continues to go there. Not all output -goes to either of these two buffers. - -Also see `magit-git-debug'.") - -(defcustom magit-process-error-tooltip-max-lines 20 - "The number of lines for `magit-process-error-lines' to return. - -These are displayed in a tooltip for `mode-line-process' errors. - -If `magit-process-error-tooltip-max-lines' is nil, the tooltip -displays the text of `magit-process-error-summary' instead." - :package-version '(magit . "2.12.0") - :group 'magit-process - :type '(choice (const :tag "Use summary line" nil) - integer)) - -(defcustom magit-credential-cache-daemon-socket - (--some (pcase-let ((`(,prog . ,args) (split-string it))) - (if (and prog - (string-match-p - "\\`\\(?:\\(?:/.*/\\)?git-credential-\\)?cache\\'" prog)) - (or (cl-loop for (opt val) on args - if (string= opt "--socket") - return val) - (expand-file-name "~/.git-credential-cache/socket")))) - ;; Note: `magit-process-file' is not yet defined when - ;; evaluating this form, so we use `process-lines'. - (ignore-errors - (let ((process-environment - (append magit-git-environment process-environment))) - (process-lines magit-git-executable - "config" "--get-all" "credential.helper")))) - "If non-nil, start a credential cache daemon using this socket. - -When using Git's cache credential helper in the normal way, Emacs -sends a SIGHUP to the credential daemon after the git subprocess -has exited, causing the daemon to also quit. This can be avoided -by starting the `git-credential-cache--daemon' process directly -from Emacs. - -The function `magit-maybe-start-credential-cache-daemon' takes -care of starting the daemon if necessary, using the value of this -option as the socket. If this option is nil, then it does not -start any daemon. Likewise if another daemon is already running, -then it starts no new daemon. This function has to be a member -of the hook variable `magit-credential-hook' for this to work. -If an error occurs while starting the daemon, most likely because -the necessary executable is missing, then the function removes -itself from the hook, to avoid further futile attempts." - :package-version '(magit . "2.3.0") - :group 'magit-process - :type '(choice (file :tag "Socket") - (const :tag "Don't start a cache daemon" nil))) - -(defcustom magit-process-yes-or-no-prompt-regexp - (concat " [([]" - "\\([Yy]\\(?:es\\)?\\)" - "[/|]" - "\\([Nn]o?\\)" - ;; OpenSSH v8 prints this. See #3969. - "\\(?:/\\[fingerprint\\]\\)?" - "[])] ?[?:]? ?$") - "Regexp matching Yes-or-No prompts of Git and its subprocesses." - :package-version '(magit . "2.1.0") - :group 'magit-process - :type 'regexp) - -(defcustom magit-process-password-prompt-regexps - '("^\\(Enter \\)?[Pp]assphrase\\( for \\(RSA \\)?key '.*'\\)?: ?$" - ;; Match-group 99 is used to identify the "user@host" part. - "^\\(Enter \\|([^) ]+) \\)?\ -[Pp]assword\\( for '?\\(https?://\\)?\\(?99:[^']*\\)'?\\)?: ?$" - "Please enter the passphrase for the ssh key" - "Please enter the passphrase to unlock the OpenPGP secret key" - "^.*'s password: ?$" - "^Token: $" ; For git-credential-manager-core (#4318). - "^Yubikey for .*: ?$" - "^Enter PIN for .*: ?$") - "List of regexps matching password prompts of Git and its subprocesses. -Also see `magit-process-find-password-functions'." - :package-version '(magit . "3.0.0") - :group 'magit-process - :type '(repeat (regexp))) - -(defcustom magit-process-find-password-functions nil - "List of functions to try in sequence to get a password. - -These functions may be called when git asks for a password, which -is detected using `magit-process-password-prompt-regexps'. They -are called if and only if matching the prompt resulted in the -value of the 99th submatch to be non-nil. Therefore users can -control for which prompts these functions should be called by -putting the host name in the 99th submatch, or not. - -If the functions are called, then they are called in the order -given, with the host name as only argument, until one of them -returns non-nil. If they are not called or none of them returns -non-nil, then the password is read from the user instead." - :package-version '(magit . "2.3.0") - :group 'magit-process - :type 'hook - :options '(magit-process-password-auth-source)) - -(defcustom magit-process-username-prompt-regexps - '("^Username for '.*': ?$") - "List of regexps matching username prompts of Git and its subprocesses." - :package-version '(magit . "2.1.0") - :group 'magit-process - :type '(repeat (regexp))) - -(defcustom magit-process-prompt-functions nil - "List of functions used to forward arbitrary questions to the user. - -Magit has dedicated support for forwarding username and password -prompts and Yes-or-No questions asked by Git and its subprocesses -to the user. This can be customized using other options in the -`magit-process' customization group. - -If you encounter a new question that isn't handled by default, -then those options should be used instead of this hook. - -However subprocesses may also ask questions that differ too much -from what the code related to the above options assume, and this -hook allows users to deal with such questions explicitly. - -Each function is called with the process and the output string -as arguments until one of the functions returns non-nil. The -function is responsible for asking the user the appropriate -question using, e.g., `read-char-choice' and then forwarding the -answer to the process using `process-send-string'. - -While functions such as `magit-process-yes-or-no-prompt' may not -be sufficient to handle some prompt, it may still be of benefit -to look at the implementations to gain some insights on how to -implement such functions." - :package-version '(magit . "3.0.0") - :group 'magit-process - :type 'hook) - -(defcustom magit-process-ensure-unix-line-ending t - "Whether Magit should ensure a unix coding system when talking to Git." - :package-version '(magit . "2.6.0") - :group 'magit-process - :type 'boolean) - -(defcustom magit-process-display-mode-line-error t - "Whether Magit should retain and highlight process errors in the mode line." - :package-version '(magit . "2.12.0") - :group 'magit-process - :type 'boolean) - -(defcustom magit-process-timestamp-format nil - "Format of timestamp for each process in the process buffer. -If non-nil, pass this to `format-time-string' when creating a -process section in the process buffer, and insert the returned -string in the heading of its section." - :package-version '(magit . "4.0.0") - :group 'magit-process - :type '(choice (const :tag "none" nil) string)) - -(defvar tramp-pipe-stty-settings) -(defvar magit-tramp-pipe-stty-settings "" - "Override `tramp-pipe-stty-settings' in `magit-start-process'. - -The default for that Tramp variable is \"-icanon min 1 time 0\", -which causes staging of individual hunks to hang. Using \"\" -prevents that, but apparently has other issues, which is why it -isn't the default. - -This variable defaults to \"\" and is used to override the Tramp -variable in `magit-start-process'. This only has an effect when -using Tramp 2.6.2 or greater. This can also be set to `pty', in -which case a pty is used instead of a pipe. That also prevents -the hanging, but comes with its own problems (see #20). To fall -back to the value of `tramp-pipe-stty-settings', set this -variable to nil. - -Also see https://github.com/magit/magit/issues/4720 -and https://debbugs.gnu.org/cgi/bugreport.cgi?bug=62093.") - -(defface magit-process-ok - '((t :inherit magit-section-heading :foreground "green")) - "Face for zero exit-status." - :group 'magit-faces) - -(defface magit-process-ng - '((t :inherit magit-section-heading :foreground "red")) - "Face for non-zero exit-status." - :group 'magit-faces) - -(defface magit-mode-line-process - '((t :inherit mode-line-emphasis)) - "Face for `mode-line-process' status when Git is running for side-effects." - :group 'magit-faces) - -(defface magit-mode-line-process-error - '((t :inherit error)) - "Face for `mode-line-process' error status. - -Used when `magit-process-display-mode-line-error' is non-nil." - :group 'magit-faces) - -;;; Process Mode - -(defvar-keymap magit-process-mode-map - :doc "Keymap for `magit-process-mode'." - :parent magit-mode-map - "<remap> <magit-delete-thing>" #'magit-process-kill) - -(define-derived-mode magit-process-mode magit-mode "Magit Process" - "Mode for looking at Git process output." - :group 'magit-process - (hack-dir-local-variables-non-file-buffer) - (setq magit--imenu-item-types 'process)) - -(defun magit-process-buffer (&optional nodisplay) - "Display the current repository's process buffer. - -If that buffer doesn't exist yet, then create it. -Non-interactively return the buffer and unless -optional NODISPLAY is non-nil also display it." - (interactive) - (let ((topdir (magit-toplevel))) - (unless topdir - (magit--with-safe-default-directory nil - (setq topdir default-directory) - (let (prev) - (while (not (equal topdir prev)) - (setq prev topdir) - (setq topdir (file-name-directory (directory-file-name topdir))))))) - (let ((buffer (or (--first (with-current-buffer it - (and (eq major-mode 'magit-process-mode) - (equal default-directory topdir))) - (buffer-list)) - (magit-generate-new-buffer 'magit-process-mode - nil topdir)))) - (with-current-buffer buffer - (if magit-root-section - (when magit-process-log-max - (magit-process-truncate-log)) - (magit-process-mode) - (let ((inhibit-read-only t) - (magit-insert-section--parent nil) - (magit-insert-section--oldroot nil)) - (make-local-variable 'text-property-default-nonsticky) - (magit-insert-section (processbuf) - (insert "\n"))))) - (unless nodisplay - (magit-display-buffer buffer)) - buffer))) - -(defun magit-process-kill () - "Kill the process at point." - (interactive) - (when-let ((process (magit-section-value-if 'process))) - (unless (eq (process-status process) 'run) - (user-error "Process isn't running")) - (magit-confirm 'kill-process) - (kill-process process))) - -;;; Synchronous Processes - -(defvar magit-process-raise-error nil) - -(defun magit-git (&rest args) - "Call Git synchronously in a separate process, for side-effects. - -Option `magit-git-executable' specifies the Git executable. -The arguments ARGS specify arguments to Git, they are flattened -before use. - -Process output goes into a new section in the buffer returned by -`magit-process-buffer'. If Git exits with a non-zero status, -then raise an error." - (let ((magit-process-raise-error t)) - (magit-call-git args))) - -(defun magit-run-git (&rest args) - "Call Git synchronously in a separate process, and refresh. - -Function `magit-git-executable' specifies the Git executable and -option `magit-git-global-arguments' specifies constant arguments. -The arguments ARGS specify arguments to Git, they are flattened -before use. - -After Git returns, the current buffer (if it is a Magit buffer) -as well as the current repository's status buffer are refreshed. - -Process output goes into a new section in the buffer returned by -`magit-process-buffer'." - (let ((magit--refresh-cache (list (cons 0 0)))) - (magit-call-git args) - (when (member (car args) '("init" "clone")) - ;; Creating a new repository invalidates the cache. - (setq magit--refresh-cache nil)) - (magit-refresh))) - -(defvar magit-pre-call-git-hook nil) - -(defun magit-call-git (&rest args) - "Call Git synchronously in a separate process. - -Function `magit-git-executable' specifies the Git executable and -option `magit-git-global-arguments' specifies constant arguments. -The arguments ARGS specify arguments to Git, they are flattened -before use. - -Process output goes into a new section in the buffer returned by -`magit-process-buffer'." - (run-hooks 'magit-pre-call-git-hook) - (let ((default-process-coding-system (magit--process-coding-system))) - (apply #'magit-call-process - (magit-git-executable) - (magit-process-git-arguments args)))) - -(defun magit-call-process (program &rest args) - "Call PROGRAM synchronously in a separate process. -Process output goes into a new section in the buffer returned by -`magit-process-buffer'." - (pcase-let ((`(,process-buf . ,section) - (magit-process-setup program args))) - (magit-process-finish - (let ((inhibit-read-only t)) - (apply #'magit-process-file program nil process-buf nil args)) - process-buf (current-buffer) default-directory section))) - -(defun magit-process-git (destination &rest args) - "Call Git synchronously in a separate process, returning its exit code. -DESTINATION specifies how to handle the output, like for -`call-process', except that file handlers are supported. -Enable Cygwin's \"noglob\" option during the call and -ensure unix eol conversion." - (apply #'magit-process-file - (magit-git-executable) - nil destination nil - (magit-process-git-arguments args))) - -(defun magit-process-file (process &optional infile buffer display &rest args) - "Process files synchronously in a separate process. -Identical to `process-file' but temporarily enable Cygwin's -\"noglob\" option during the call and ensure unix eol -conversion." - (when magit-process-extreme-logging - (let ((inhibit-message t)) - (message "$ %s" (magit-process--format-arguments process args)))) - (let ((process-environment (magit-process-environment)) - (default-process-coding-system (magit--process-coding-system))) - (apply #'process-file process infile buffer display args))) - -(defun magit-process-environment () - ;; The various w32 hacks are only applicable when running on the local - ;; machine. A local binding of process-environment different from the - ;; top-level value affects the environment used in - ;; tramp-sh-handle-{start-file-process,process-file}. - (let ((local (not (file-remote-p default-directory)))) - (append magit-git-environment - (and local - (cdr (assoc magit-git-executable magit-git-w32-path-hack))) - (and local magit-need-cygwin-noglob - (mapcar (lambda (var) - (concat var "=" (if-let ((val (getenv var))) - (concat val " noglob") - "noglob"))) - '("CYGWIN" "MSYS"))) - process-environment))) - -(defvar magit-this-process nil) - -(defun magit-run-git-with-input (&rest args) - "Call Git in a separate process. -ARGS is flattened and then used as arguments to Git. - -The current buffer's content is used as the process's standard -input. The buffer is assumed to be temporary and thus OK to -modify. - -Function `magit-git-executable' specifies the Git executable and -option `magit-git-global-arguments' specifies constant arguments. -The remaining arguments ARGS specify arguments to Git, they are -flattened before use." - (when (eq system-type 'windows-nt) - ;; On w32, git expects UTF-8 encoded input, ignore any user - ;; configuration telling us otherwise (see #3250). - (encode-coding-region (point-min) (point-max) 'utf-8-unix)) - (if (file-remote-p default-directory) - ;; We lack `process-file-region', so fall back to asynch + - ;; waiting in remote case. - (progn - (magit-start-git (current-buffer) args) - (while (and magit-this-process - (eq (process-status magit-this-process) 'run)) - (sleep-for 0.005))) - (run-hooks 'magit-pre-call-git-hook) - (pcase-let* ((process-environment (magit-process-environment)) - (default-process-coding-system (magit--process-coding-system)) - (flat-args (magit-process-git-arguments args)) - (`(,process-buf . ,section) - (magit-process-setup (magit-git-executable) flat-args)) - (inhibit-read-only t)) - (magit-process-finish - (apply #'call-process-region (point-min) (point-max) - (magit-git-executable) nil process-buf nil flat-args) - process-buf nil default-directory section)))) - -;;; Asynchronous Processes - -(defun magit-run-git-async (&rest args) - "Start Git, prepare for refresh, and return the process object. -ARGS is flattened and then used as arguments to Git. - -Display the command line arguments in the echo area. - -After Git returns some buffers are refreshed: the buffer that was -current when this function was called (if it is a Magit buffer -and still alive), as well as the respective Magit status buffer. - -See `magit-start-process' for more information." - (message "Running %s %s" (magit-git-executable) - (let ((m (mapconcat #'identity (flatten-tree args) " "))) - (remove-list-of-text-properties 0 (length m) '(face) m) - m)) - (magit-start-git nil args)) - -(defun magit-run-git-with-editor (&rest args) - "Export GIT_EDITOR and start Git. -Also prepare for refresh and return the process object. -ARGS is flattened and then used as arguments to Git. - -Display the command line arguments in the echo area. - -After Git returns some buffers are refreshed: the buffer that was -current when this function was called (if it is a Magit buffer -and still alive), as well as the respective Magit status buffer. - -See `magit-start-process' and `with-editor' for more information." - (magit--record-separated-gitdir) - (magit-with-editor (magit-run-git-async args))) - -(defun magit-run-git-sequencer (&rest args) - "Export GIT_EDITOR and start Git. -Also prepare for refresh and return the process object. -ARGS is flattened and then used as arguments to Git. - -Display the command line arguments in the echo area. - -After Git returns some buffers are refreshed: the buffer that was -current when this function was called (if it is a Magit buffer -and still alive), as well as the respective Magit status buffer. -If the sequence stops at a commit, make the section representing -that commit the current section by moving `point' there. - -See `magit-start-process' and `with-editor' for more information." - (apply #'magit-run-git-with-editor args) - (set-process-sentinel magit-this-process #'magit-sequencer-process-sentinel) - magit-this-process) - -(defvar magit-pre-start-git-hook nil) - -(defun magit-start-git (input &rest args) - "Start Git, prepare for refresh, and return the process object. - -If INPUT is non-nil, it has to be a buffer or the name of an -existing buffer. The buffer content becomes the processes -standard input. - -Function `magit-git-executable' specifies the Git executable and -option `magit-git-global-arguments' specifies constant arguments. -The remaining arguments ARGS specify arguments to Git, they are -flattened before use. - -After Git returns some buffers are refreshed: the buffer that was -current when this function was called (if it is a Magit buffer -and still alive), as well as the respective Magit status buffer. - -See `magit-start-process' for more information." - (run-hooks 'magit-pre-start-git-hook) - (let ((default-process-coding-system (magit--process-coding-system))) - (apply #'magit-start-process (magit-git-executable) input - (magit-process-git-arguments args)))) - -(defun magit-start-process (program &optional input &rest args) - "Start PROGRAM, prepare for refresh, and return the process object. - -If optional argument INPUT is non-nil, it has to be a buffer or -the name of an existing buffer. The buffer content becomes the -processes standard input. - -The process is started using `start-file-process' and then setup -to use the sentinel `magit-process-sentinel' and the filter -`magit-process-filter'. Information required by these functions -is stored in the process object. When this function returns the -process has not started to run yet so it is possible to override -the sentinel and filter. - -After the process returns, `magit-process-sentinel' refreshes the -buffer that was current when `magit-start-process' was called (if -it is a Magit buffer and still alive), as well as the respective -Magit status buffer." - (pcase-let* - ((`(,process-buf . ,section) - (magit-process-setup program args)) - (process - (let ((process-connection-type ;t=pty nil=pipe - (or - ;; With Tramp, maybe force use a pty. #4720 - (and (file-remote-p default-directory) - (eq magit-tramp-pipe-stty-settings 'pty)) - ;; Without input, don't use a pty, because it would - ;; set icrnl, which would modify the input. #20 - (and (not input) magit-process-connection-type))) - (tramp-pipe-stty-settings - (or (and (not (eq magit-tramp-pipe-stty-settings 'pty)) - ;; Defaults to "", to allow staging hunks over - ;; Tramp again. #4720 - magit-tramp-pipe-stty-settings) - tramp-pipe-stty-settings)) - (process-environment (magit-process-environment)) - (default-process-coding-system (magit--process-coding-system))) - (apply #'start-file-process - (file-name-nondirectory program) - process-buf program args)))) - (with-editor-set-process-filter process #'magit-process-filter) - (set-process-sentinel process #'magit-process-sentinel) - (set-process-buffer process process-buf) - (when (eq system-type 'windows-nt) - ;; On w32, git expects UTF-8 encoded input, ignore any user - ;; configuration telling us otherwise. - (set-process-coding-system process nil 'utf-8-unix)) - (process-put process 'section section) - (process-put process 'command-buf (current-buffer)) - (process-put process 'default-dir default-directory) - (when magit-inhibit-refresh - (process-put process 'inhibit-refresh t)) - (oset section process process) - (with-current-buffer process-buf - (set-marker (process-mark process) (point))) - (when input - (with-current-buffer input - (process-send-region process (point-min) (point-max)) - ;; `process-send-eof' appears to be broken over - ;; Tramp from Windows. See #3624 and bug#43226. - (if (and (eq system-type 'windows-nt) - (file-remote-p (process-get process 'default-dir) nil t)) - (process-send-string process "") - (process-send-eof process)))) - (setq magit-this-process process) - (oset section value process) - (magit-process-display-buffer process) - process)) - -(defun magit-parse-git-async (&rest args) - (setq args (magit-process-git-arguments args)) - (let ((command-buf (current-buffer)) - (process-buf (generate-new-buffer " *temp*")) - (toplevel (magit-toplevel))) - (with-current-buffer process-buf - (setq default-directory toplevel) - (let ((process - (let ((process-connection-type nil) - (process-environment (magit-process-environment)) - (default-process-coding-system - (magit--process-coding-system))) - (apply #'start-file-process "git" process-buf - (magit-git-executable) args)))) - (process-put process 'command-buf command-buf) - (process-put process 'parsed (point)) - (setq magit-this-process process) - process)))) - -;;; Process Internals - -(defclass magit-process-section (magit-section) - ((process :initform nil))) - -(setf (alist-get 'process magit--section-type-alist) 'magit-process-section) - -(defun magit-process-setup (program args) - (magit-process-set-mode-line program args) - (let ((pwd default-directory) - (buf (magit-process-buffer t))) - (cons buf (with-current-buffer buf - (prog1 (magit-process-insert-section pwd program args nil nil) - (backward-char 1)))))) - -(defun magit-process-insert-section (pwd program args &optional errcode errlog) - (let ((inhibit-read-only t) - (magit-insert-section--parent magit-root-section) - (magit-insert-section--oldroot nil)) - (goto-char (1- (point-max))) - (magit-insert-section (process) - (insert (if errcode - (format "%3s " (propertize (number-to-string errcode) - 'font-lock-face 'magit-process-ng)) - "run ")) - (when magit-process-timestamp-format - (insert (format-time-string magit-process-timestamp-format) " ")) - (unless (equal (expand-file-name pwd) - (expand-file-name default-directory)) - (insert (file-relative-name pwd default-directory) ?\s)) - (insert (magit-process--format-arguments program args)) - (magit-insert-heading) - (when errlog - (if (bufferp errlog) - (insert (with-current-buffer errlog - (buffer-substring-no-properties (point-min) (point-max)))) - (insert-file-contents errlog) - (goto-char (1- (point-max))))) - (insert "\n")))) - -(defun magit-process--format-arguments (program args) - (cond - ((and args (equal program (magit-git-executable))) - (let ((global (length magit-git-global-arguments))) - (concat - (propertize (file-name-nondirectory program) - 'font-lock-face 'magit-section-heading) - " " - (propertize (magit--ellipsis) - 'font-lock-face 'magit-section-heading - 'help-echo (mapconcat #'identity (seq-take args global) " ")) - " " - (propertize (mapconcat #'shell-quote-argument (seq-drop args global) " ") - 'font-lock-face 'magit-section-heading)))) - ((and args (equal program shell-file-name)) - (propertize (cadr args) - 'font-lock-face 'magit-section-heading)) - (t - (concat (propertize (file-name-nondirectory program) - 'font-lock-face 'magit-section-heading) - " " - (propertize (mapconcat #'shell-quote-argument args " ") - 'font-lock-face 'magit-section-heading))))) - -(defun magit-process-truncate-log () - (let* ((head nil) - (tail (oref magit-root-section children)) - (count (length tail))) - (when (> (1+ count) magit-process-log-max) - (while (and (cdr tail) - (> count (/ magit-process-log-max 2))) - (let* ((inhibit-read-only t) - (section (car tail)) - (process (oref section process))) - (cond ((not process)) - ((memq (process-status process) '(exit signal)) - (delete-region (oref section start) - (1+ (oref section end))) - (cl-decf count)) - (t - (push section head)))) - (pop tail)) - (oset magit-root-section children - (nconc (reverse head) tail))))) - -(defun magit-process-sentinel (process event) - "Default sentinel used by `magit-start-process'." - (when (memq (process-status process) '(exit signal)) - (setq event (substring event 0 -1)) - (when (string-match "^finished" event) - (message (concat (capitalize (process-name process)) " finished"))) - (magit-process-finish process) - (when (eq process magit-this-process) - (setq magit-this-process nil)) - (unless (process-get process 'inhibit-refresh) - (let ((command-buf (process-get process 'command-buf))) - (if (buffer-live-p command-buf) - (with-current-buffer command-buf - (magit-refresh)) - (with-temp-buffer - (setq default-directory (process-get process 'default-dir)) - (magit-refresh))))))) - -(defun magit-sequencer-process-sentinel (process event) - "Special sentinel used by `magit-run-git-sequencer'." - (when (memq (process-status process) '(exit signal)) - (magit-process-sentinel process event) - (when-let* ((process-buf (process-buffer process)) - ((buffer-live-p process-buf)) - (status-buf (with-current-buffer process-buf - (magit-get-mode-buffer 'magit-status-mode)))) - (with-current-buffer status-buf - (when-let ((section - (magit-get-section - `((commit . ,(magit-rev-parse "HEAD")) - (,(pcase (car (seq-drop - (process-command process) - (1+ (length magit-git-global-arguments)))) - ((or "rebase" "am") 'rebase-sequence) - ((or "cherry-pick" "revert") 'sequence))) - (status))))) - (goto-char (oref section start)) - (magit-section-update-highlight)))))) - -(defun magit-process-filter (proc string) - "Default filter used by `magit-start-process'." - (with-current-buffer (process-buffer proc) - (let ((inhibit-read-only t)) - (goto-char (process-mark proc)) - ;; Find last ^M in string. If one was found, ignore - ;; everything before it and delete the current line. - (when-let ((ret-pos (cl-position ?\r string :from-end t))) - (cl-callf substring string (1+ ret-pos)) - (delete-region (line-beginning-position) (point))) - (setq string (magit-process-remove-bogus-errors string)) - (insert (propertize string 'magit-section - (process-get proc 'section))) - (set-marker (process-mark proc) (point)) - ;; Make sure prompts are matched after removing ^M. - (magit-process-yes-or-no-prompt proc string) - (magit-process-username-prompt proc string) - (magit-process-password-prompt proc string) - (run-hook-with-args-until-success 'magit-process-prompt-functions - proc string)))) - -(defun magit-process-make-keymap (process parent) - "Remap `abort-minibuffers' to a command that also kills PROCESS. -PARENT is used as the parent of the returned keymap." - (let ((cmd (lambda () - (interactive) - (ignore-errors (kill-process process)) - (if (fboundp 'abort-minibuffers) - (abort-minibuffers) - (abort-recursive-edit))))) - (define-keymap :parent parent - "C-g" cmd - "<remap> <abort-minibuffers>" cmd - "<remap> <abort-recursive-edit>" cmd))) - -(defmacro magit-process-kill-on-abort (process &rest body) - (declare (indent 1) - (debug (form body)) - (obsolete magit-process-make-keymap "Magit 4.0.0")) - `(let ((minibuffer-local-map - (magit-process-make-keymap ,process minibuffer-local-map))) - ,@body)) - -(defun magit-process-remove-bogus-errors (str) - (save-match-data - (when (string-match "^\\(\\*ERROR\\*: \\)Canceled by user" str) - (setq str (replace-match "" nil nil str 1))) - (when (string-match "^error: There was a problem with the editor.*\n" str) - (setq str (replace-match "" nil nil str))) - (when (string-match - "^Please supply the message using either -m or -F option\\.\n" str) - (setq str (replace-match "" nil nil str)))) - str) - -(defun magit-process-yes-or-no-prompt (process string) - "Forward Yes-or-No prompts to the user." - (when-let ((beg (string-match magit-process-yes-or-no-prompt-regexp string))) - (process-send-string - process - (if (save-match-data - (let ((max-mini-window-height 30) - (minibuffer-local-map - (magit-process-make-keymap process minibuffer-local-map)) - ;; In case yes-or-no-p is fset to that, but does - ;; not cover use-dialog-box-p and y-or-n-p-read-key. - (y-or-n-p-map - (magit-process-make-keymap process y-or-n-p-map))) - (yes-or-no-p (substring string 0 beg)))) - (concat (downcase (match-string 1 string)) "\n") - (concat (downcase (match-string 2 string)) "\n"))))) - -(defun magit-process-password-auth-source (key) - "Use `auth-source-search' to get a password. -If found, return the password. Otherwise, return nil. - -To use this function add it to the appropriate hook - (add-hook \\='magit-process-find-password-functions - \\='magit-process-password-auth-source) - -KEY typically derives from a prompt such as: - Password for \\='https://yourname@github.com\\=' -in which case it would be the string - yourname@github.com -which matches the ~/.authinfo.gpg entry - machine github.com login yourname password 12345 -or iff that is undefined, for backward compatibility - machine yourname@github.com password 12345 - -On github.com you should not use your password but a -personal access token, see [1]. For information about -the peculiarities of other forges, please consult the -respective documentation. - -After manually editing ~/.authinfo.gpg you must reset -the cache using - M-x auth-source-forget-all-cached RET - -The above will save you from having to repeatedly type -your token or password, but you might still repeatedly -be asked for your username. To prevent that, change an -URL like - https://github.com/foo/bar.git -to - https://yourname@github.com/foo/bar.git - -Instead of changing all such URLs manually, they can -be translated on the fly by doing this once - git config --global \ - url.https://yourname@github.com.insteadOf \ - https://github.com - -[1]: https://docs.github.com/en/github/authenticating-to-github/creating-a-personal-access-token." - (require 'auth-source) - (and (fboundp 'auth-source-search) - (string-match "\\`\\(.+\\)@\\([^@]+\\)\\'" key) - (let* ((user (match-string 1 key)) - (host (match-string 2 key)) - (secret - (plist-get - (car (or (auth-source-search :max 1 :host host :user user) - (auth-source-search :max 1 :host key))) - :secret))) - (if (functionp secret) - (funcall secret) - secret)))) - -(defun magit-process-git-credential-manager-core (process string) - "Authenticate using `git-credential-manager-core'. - -To use this function add it to the appropriate hook - (add-hook \\='magit-process-prompt-functions - \\='magit-process-git-credential-manager-core)" - (and (string-match "^option (enter for default): $" string) - (progn - (magit-process-buffer) - (let ((option (format "%c\n" - (read-char-choice "Option: " '(?\r ?\j ?1 ?2))))) - (insert-before-markers-and-inherit option) - (process-send-string process option))))) - -(defun magit-process-password-prompt (process string) - "Find a password based on prompt STRING and send it to git. -Use `magit-process-password-prompt-regexps' to find a known -prompt. If and only if one is found, then call functions in -`magit-process-find-password-functions' until one of them returns -the password. If all functions return nil, then read the password -from the user." - (when-let ((prompt (magit-process-match-prompt - magit-process-password-prompt-regexps string))) - (process-send-string - process - (concat (or (and-let* ((key (match-string 99 string))) - (run-hook-with-args-until-success - 'magit-process-find-password-functions key)) - (let ((read-passwd-map - (magit-process-make-keymap process read-passwd-map))) - (read-passwd prompt))) - "\n")))) - -(defun magit-process-username-prompt (process string) - "Forward username prompts to the user." - (when-let ((prompt (magit-process-match-prompt - magit-process-username-prompt-regexps string))) - (process-send-string - process - (let ((minibuffer-local-map - (magit-process-make-keymap process minibuffer-local-map))) - (concat (read-string prompt nil nil (user-login-name)) "\n"))))) - -(defun magit-process-match-prompt (prompts string) - "Match STRING against PROMPTS and set match data. -Return the matched string suffixed with \": \", if needed." - (when (--any-p (string-match it string) prompts) - (let ((prompt (match-string 0 string))) - (cond ((string-suffix-p ": " prompt) prompt) - ((string-suffix-p ":" prompt) (concat prompt " ")) - (t (concat prompt ": ")))))) - -(defun magit--process-coding-system () - (let ((fro (or magit-git-output-coding-system - (car default-process-coding-system))) - (to (cdr default-process-coding-system))) - (if magit-process-ensure-unix-line-ending - (cons (coding-system-change-eol-conversion fro 'unix) - (coding-system-change-eol-conversion to 'unix)) - (cons fro to)))) - -(defvar magit-credential-hook nil - "Hook run before Git needs credentials.") - -(defvar magit-credential-cache-daemon-process nil) - -(defun magit-maybe-start-credential-cache-daemon () - "Maybe start a `git-credential-cache--daemon' process. - -If such a process is already running or if the value of option -`magit-credential-cache-daemon-socket' is nil, then do nothing. -Otherwise start the process passing the value of that options -as argument." - (unless (or (not magit-credential-cache-daemon-socket) - (process-live-p magit-credential-cache-daemon-process) - (memq magit-credential-cache-daemon-process - (list-system-processes))) - (setq magit-credential-cache-daemon-process - (or (--first (let* ((attr (process-attributes it)) - (comm (cdr (assq 'comm attr))) - (user (cdr (assq 'user attr)))) - (and (string= comm "git-credential-cache--daemon") - (string= user user-login-name))) - (list-system-processes)) - (condition-case nil - (start-process "git-credential-cache--daemon" - " *git-credential-cache--daemon*" - (magit-git-executable) - "credential-cache--daemon" - magit-credential-cache-daemon-socket) - ;; Some Git implementations (e.g., Windows) won't have - ;; this program; if we fail the first time, stop trying. - ((debug error) - (remove-hook 'magit-credential-hook - #'magit-maybe-start-credential-cache-daemon))))))) - -(add-hook 'magit-credential-hook #'magit-maybe-start-credential-cache-daemon) - -(define-advice tramp-sh-handle-start-file-process - (:around (fn name buffer program &rest args) - magit-tramp-process-environment) - (if magit-tramp-process-environment - (apply fn name buffer - (car magit-tramp-process-environment) - (append (cdr magit-tramp-process-environment) - (cons program args))) - (apply fn name buffer program args))) - -(define-advice tramp-sh-handle-process-file - (:around (fn program &optional infile destination display &rest args) - magit-tramp-process-environment) - (if magit-tramp-process-environment - (apply fn "env" infile destination display - (append magit-tramp-process-environment - (cons program args))) - (apply fn program infile destination display args))) - -(defvar-keymap magit-mode-line-process-map - :doc "Keymap for `mode-line-process'." - "<mode-line> <mouse-1>" ''magit-process-buffer) - -(defun magit-process-set-mode-line (program args) - "Display the git command (sans arguments) in the mode line." - (when (equal program (magit-git-executable)) - (setq args (nthcdr (length magit-git-global-arguments) args))) - (let ((str (concat " " (propertize - (concat (file-name-nondirectory program) - (and args (concat " " (car args)))) - 'mouse-face 'highlight - 'keymap magit-mode-line-process-map - 'help-echo "mouse-1: Show process buffer" - 'font-lock-face 'magit-mode-line-process)))) - (magit-repository-local-set 'mode-line-process str) - (dolist (buf (magit-mode-get-buffers)) - (with-current-buffer buf - (setq mode-line-process str))) - (force-mode-line-update t))) - -(defun magit-process-set-mode-line-error-status (&optional error str) - "Apply an error face to the string set by `magit-process-set-mode-line'. - -If ERROR is supplied, include it in the `mode-line-process' tooltip. - -If STR is supplied, it replaces the `mode-line-process' text." - (setq str (or str (magit-repository-local-get 'mode-line-process))) - (when str - (setq error (format "%smouse-1: Show process buffer" - (if (stringp error) - (concat error "\n\n") - ""))) - (setq str (concat " " (propertize - (substring-no-properties str 1) - 'mouse-face 'highlight - 'keymap magit-mode-line-process-map - 'help-echo error - 'font-lock-face 'magit-mode-line-process-error))) - (magit-repository-local-set 'mode-line-process str) - (dolist (buf (magit-mode-get-buffers)) - (with-current-buffer buf - (setq mode-line-process str))) - (force-mode-line-update t) - ;; We remove any error status from the mode line when a magit - ;; buffer is refreshed (see `magit-refresh-buffer'), but we must - ;; ensure that we ignore any refreshes during the remainder of the - ;; current command -- otherwise a newly-set error status would be - ;; removed before it was seen. We set a flag which prevents the - ;; status from being removed prior to the next command, so that - ;; the error status is guaranteed to remain visible until then. - (let ((repokey (magit-repository-local-repository))) - ;; The following closure captures the repokey value, and is - ;; added to `pre-command-hook'. - (cl-labels ((enable-magit-process-unset-mode-line () - ;; Remove ourself from the hook variable, so - ;; that we only run once. - (remove-hook 'pre-command-hook - #'enable-magit-process-unset-mode-line) - ;; Clear the inhibit flag for the repository in - ;; which we set it. - (magit-repository-local-set - 'inhibit-magit-process-unset-mode-line nil repokey))) - ;; Set the inhibit flag until the next command is invoked. - (magit-repository-local-set - 'inhibit-magit-process-unset-mode-line t repokey) - (add-hook 'pre-command-hook - #'enable-magit-process-unset-mode-line))))) - -(defun magit-process-unset-mode-line-error-status () - "Remove any current error status from the mode line." - (let ((status (or mode-line-process - (magit-repository-local-get 'mode-line-process)))) - (when (and status - (eq (get-text-property 1 'font-lock-face status) - 'magit-mode-line-process-error)) - (magit-process-unset-mode-line)))) - -(add-hook 'magit-refresh-buffer-hook - #'magit-process-unset-mode-line-error-status) - -(defun magit-process-unset-mode-line (&optional directory) - "Remove the git command from the mode line." - (let ((default-directory (or directory default-directory))) - (unless (magit-repository-local-get 'inhibit-magit-process-unset-mode-line) - (magit-repository-local-set 'mode-line-process nil) - (dolist (buf (magit-mode-get-buffers)) - (with-current-buffer buf (setq mode-line-process nil))) - (force-mode-line-update t)))) - -(defvar magit-process-error-message-regexps - (list "^\\*ERROR\\*: Canceled by user$" - "^\\(?:error\\|fatal\\|git\\): \\(.*\\)$" - "^\\(Cannot rebase:.*\\)$")) - -(define-error 'magit-git-error "Git error") - -(defun magit-process-error-summary (process-buf section) - "A one-line error summary from the given SECTION." - (or (and (buffer-live-p process-buf) - (with-current-buffer process-buf - (and (oref section content) - (save-excursion - (goto-char (oref section end)) - (run-hook-wrapped - 'magit-process-error-message-regexps - (lambda (re) - (save-excursion - (and (re-search-backward - re (oref section start) t) - (or (match-string-no-properties 1) - (and (not magit-process-raise-error) - 'suppressed)))))))))) - "Git failed")) - -(defun magit-process-error-tooltip (process-buf section) - "Returns the text from SECTION of the PROCESS-BUF buffer. - -Limited by `magit-process-error-tooltip-max-lines'." - (and (integerp magit-process-error-tooltip-max-lines) - (> magit-process-error-tooltip-max-lines 0) - (buffer-live-p process-buf) - (with-current-buffer process-buf - (save-excursion - (goto-char (or (oref section content) - (oref section start))) - (buffer-substring-no-properties - (point) - (save-excursion - (forward-line magit-process-error-tooltip-max-lines) - (goto-char - (if (> (point) (oref section end)) - (oref section end) - (point))) - ;; Remove any trailing whitespace. - (when (re-search-backward "[^[:space:]\n]" - (oref section start) t) - (forward-char 1)) - (point))))))) - -(defvar-local magit-this-error nil) - -(defvar magit-process-finish-apply-ansi-colors nil) - -(defun magit-process-finish (arg &optional process-buf command-buf - default-dir section) - (unless (integerp arg) - (setq process-buf (process-buffer arg)) - (setq command-buf (process-get arg 'command-buf)) - (setq default-dir (process-get arg 'default-dir)) - (setq section (process-get arg 'section)) - (setq arg (process-exit-status arg))) - (when (fboundp 'dired-uncache) - (dired-uncache default-dir)) - (when (buffer-live-p process-buf) - (with-current-buffer process-buf - (let ((inhibit-read-only t) - (marker (oref section start))) - (goto-char marker) - (save-excursion - (delete-char 3) - (set-marker-insertion-type marker nil) - (insert (propertize (format "%3s" arg) - 'magit-section section - 'font-lock-face (if (= arg 0) - 'magit-process-ok - 'magit-process-ng))) - (set-marker-insertion-type marker t)) - (when magit-process-finish-apply-ansi-colors - (ansi-color-apply-on-region (oref section content) - (oref section end))) - (if (= (oref section end) - (+ (line-end-position) 2)) - (save-excursion - (goto-char (1+ (line-end-position))) - (delete-char -1) - (oset section content nil)) - (when (and (= arg 0) - (not (--any-p (eq (window-buffer it) process-buf) - (window-list)))) - (magit-section-hide section)))))) - (if (= arg 0) - ;; Unset the `mode-line-process' value upon success. - (magit-process-unset-mode-line default-dir) - ;; Otherwise process the error. - (let ((msg (magit-process-error-summary process-buf section))) - ;; Change `mode-line-process' to an error face upon failure. - (if magit-process-display-mode-line-error - (magit-process-set-mode-line-error-status - (or (magit-process-error-tooltip process-buf section) - msg)) - (magit-process-unset-mode-line default-dir)) - ;; Either signal the error, or else display the error summary in - ;; the status buffer and with a message in the echo area. - (cond - (magit-process-raise-error - (signal 'magit-git-error (list (format "%s (in %s)" msg default-dir)))) - ((not (eq msg 'suppressed)) - (when (buffer-live-p process-buf) - (with-current-buffer process-buf - (when-let ((status-buf (magit-get-mode-buffer 'magit-status-mode))) - (with-current-buffer status-buf - (setq magit-this-error msg))))) - (message "%s ... [%s buffer %s for details]" msg - (if-let ((key (and (buffer-live-p command-buf) - (with-current-buffer command-buf - (car (where-is-internal - 'magit-process-buffer)))))) - (format "Hit %s to see" (key-description key)) - "See") - (buffer-name process-buf)))))) - arg) - -(defun magit-process-display-buffer (process) - (when (process-live-p process) - (let ((buf (process-buffer process))) - (cond ((not (buffer-live-p buf))) - ((= magit-process-popup-time 0) - (if (minibufferp) - (switch-to-buffer-other-window buf) - (pop-to-buffer buf))) - ((> magit-process-popup-time 0) - (run-with-timer magit-process-popup-time nil - (lambda (p) - (when (eq (process-status p) 'run) - (let ((buf (process-buffer p))) - (when (buffer-live-p buf) - (if (minibufferp) - (switch-to-buffer-other-window buf) - (pop-to-buffer buf)))))) - process)))))) - -(defun magit--log-action (summary line list) - (let (heading lines) - (if (cdr list) - (progn (setq heading (funcall summary list)) - (setq lines (mapcar line list))) - (setq heading (funcall line (car list)))) - (with-current-buffer (magit-process-buffer t) - (goto-char (1- (point-max))) - (let ((inhibit-read-only t)) - (magit-insert-section (message) - (magit-insert-heading (concat " * " heading)) - (when lines - (dolist (line lines) - (insert line "\n")) - (insert "\n")))) - (let ((inhibit-message t)) - (when heading - (setq lines (cons heading lines))) - (message (mapconcat #'identity lines "\n")))))) - -;;; _ -(provide 'magit-process) -;;; magit-process.el ends here diff --git a/emacs/elpa/magit-20240622.1531/magit-process.elc b/emacs/elpa/magit-20240622.1531/magit-process.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/magit-reflog.el b/emacs/elpa/magit-20240622.1531/magit-reflog.el @@ -1,209 +0,0 @@ -;;; magit-reflog.el --- Inspect ref history -*- lexical-binding:t -*- - -;; Copyright (C) 2008-2024 The Magit Project Contributors - -;; Author: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> -;; Maintainer: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> - -;; SPDX-License-Identifier: GPL-3.0-or-later - -;; 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. -;; -;; 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 Magit. If not, see <https://www.gnu.org/licenses/>. - -;;; Commentary: - -;; This library implements support for looking at Git reflogs. - -;;; Code: - -(require 'magit-core) -(require 'magit-log) - -;;; Options - -(defcustom magit-reflog-limit 256 - "Maximal number of entries initially shown in reflog buffers. -The limit in the current buffer can be changed using \"+\" -and \"-\"." - :package-version '(magit . "3.0.0") - :group 'magit-commands - :type 'number) - -(defcustom magit-reflog-margin - (list (nth 0 magit-log-margin) - (nth 1 magit-log-margin) - 'magit-log-margin-width nil - (nth 4 magit-log-margin)) - "Format of the margin in `magit-reflog-mode' buffers. - -The value has the form (INIT STYLE WIDTH AUTHOR AUTHOR-WIDTH). - -If INIT is non-nil, then the margin is shown initially. -STYLE controls how to format the author or committer date. - It can be one of `age' (to show the age of the commit), - `age-abbreviated' (to abbreviate the time unit to a character), - or a string (suitable for `format-time-string') to show the - actual date. Option `magit-log-margin-show-committer-date' - controls which date is being displayed. -WIDTH controls the width of the margin. This exists for forward - compatibility and currently the value should not be changed. -AUTHOR controls whether the name of the author is also shown by - default. -AUTHOR-WIDTH has to be an integer. When the name of the author - is shown, then this specifies how much space is used to do so." - :package-version '(magit . "2.9.0") - :group 'magit-log - :group 'magit-margin - :type magit-log-margin--custom-type - :initialize #'magit-custom-initialize-reset - :set-after '(magit-log-margin) - :set (apply-partially #'magit-margin-set-variable 'magit-reflog-mode)) - -;;; Faces - -(defface magit-reflog-commit '((t :foreground "green")) - "Face for commit commands in reflogs." - :group 'magit-faces) - -(defface magit-reflog-amend '((t :foreground "magenta")) - "Face for amend commands in reflogs." - :group 'magit-faces) - -(defface magit-reflog-merge '((t :foreground "green")) - "Face for merge, checkout and branch commands in reflogs." - :group 'magit-faces) - -(defface magit-reflog-checkout '((t :foreground "blue")) - "Face for checkout commands in reflogs." - :group 'magit-faces) - -(defface magit-reflog-reset '((t :foreground "red")) - "Face for reset commands in reflogs." - :group 'magit-faces) - -(defface magit-reflog-rebase '((t :foreground "magenta")) - "Face for rebase commands in reflogs." - :group 'magit-faces) - -(defface magit-reflog-cherry-pick '((t :foreground "green")) - "Face for cherry-pick commands in reflogs." - :group 'magit-faces) - -(defface magit-reflog-remote '((t :foreground "cyan")) - "Face for pull and clone commands in reflogs." - :group 'magit-faces) - -(defface magit-reflog-other '((t :foreground "cyan")) - "Face for other commands in reflogs." - :group 'magit-faces) - -;;; Commands - -;;;###autoload -(defun magit-reflog-current () - "Display the reflog of the current branch. -If `HEAD' is detached, then show the reflog for that instead." - (interactive) - (magit-reflog-setup-buffer (or (magit-get-current-branch) "HEAD"))) - -;;;###autoload -(defun magit-reflog-other (ref) - "Display the reflog of a branch or another ref." - (interactive (list (magit-read-local-branch-or-ref "Show reflog for"))) - (magit-reflog-setup-buffer ref)) - -;;;###autoload -(defun magit-reflog-head () - "Display the `HEAD' reflog." - (interactive) - (magit-reflog-setup-buffer "HEAD")) - -;;; Mode - -(defvar-keymap magit-reflog-mode-map - :doc "Keymap for `magit-reflog-mode'." - :parent magit-log-mode-map - "C-c C-n" #'undefined - "L" #'magit-margin-settings) - -(define-derived-mode magit-reflog-mode magit-mode "Magit Reflog" - "Mode for looking at Git reflog. - -This mode is documented in info node `(magit)Reflog'. - -\\<magit-mode-map>\ -Type \\[magit-refresh] to refresh the current buffer. -Type \\[magit-visit-thing] or \\[magit-diff-show-or-scroll-up] \ -to visit the commit at point. - -Type \\[magit-cherry-pick] to apply the commit at point. -Type \\[magit-reset] to reset `HEAD' to the commit at point. - -\\{magit-reflog-mode-map}" - :group 'magit-log - (hack-dir-local-variables-non-file-buffer) - (setq magit--imenu-item-types 'commit)) - -(defun magit-reflog-setup-buffer (ref) - (require 'magit) - (magit-setup-buffer #'magit-reflog-mode nil - (magit-buffer-refname ref) - (magit-buffer-log-args (list (format "-n%s" magit-reflog-limit))))) - -(defun magit-reflog-refresh-buffer () - (magit-set-header-line-format (concat "Reflog for " magit-buffer-refname)) - (magit-insert-section (reflogbuf) - (magit-git-wash (apply-partially #'magit-log-wash-log 'reflog) - "reflog" "show" "--format=%h%x00%aN%x00%gd%x00%gs" "--date=raw" - magit-buffer-log-args magit-buffer-refname "--"))) - -(cl-defmethod magit-buffer-value (&context (major-mode magit-reflog-mode)) - magit-buffer-refname) - -(defvar magit-reflog-labels - '(("commit" . magit-reflog-commit) - ("amend" . magit-reflog-amend) - ("merge" . magit-reflog-merge) - ("checkout" . magit-reflog-checkout) - ("branch" . magit-reflog-checkout) - ("reset" . magit-reflog-reset) - ("rebase" . magit-reflog-rebase) - ("rewritten" . magit-reflog-rebase) - ("cherry-pick" . magit-reflog-cherry-pick) - ("initial" . magit-reflog-commit) - ("pull" . magit-reflog-remote) - ("clone" . magit-reflog-remote) - ("autosave" . magit-reflog-commit) - ("restart" . magit-reflog-reset))) - -(defun magit-reflog-format-subject (subject) - (let* ((match (string-match magit-reflog-subject-re subject)) - (command (and match (match-string 1 subject))) - (option (and match (match-string 2 subject))) - (type (and match (match-string 3 subject))) - (label (if (string= command "commit") - (or type command) - command)) - (text (if (string= command "commit") - label - (mapconcat #'identity - (delq nil (list command option type)) - " ")))) - (format "%-16s " - (magit--propertize-face - text (or (cdr (assoc label magit-reflog-labels)) - 'magit-reflog-other))))) - -;;; _ -(provide 'magit-reflog) -;;; magit-reflog.el ends here diff --git a/emacs/elpa/magit-20240622.1531/magit-reflog.elc b/emacs/elpa/magit-20240622.1531/magit-reflog.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/magit-refs.el b/emacs/elpa/magit-20240622.1531/magit-refs.el @@ -1,789 +0,0 @@ -;;; magit-refs.el --- Listing references -*- lexical-binding:t -*- - -;; Copyright (C) 2008-2024 The Magit Project Contributors - -;; Author: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> -;; Maintainer: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> - -;; SPDX-License-Identifier: GPL-3.0-or-later - -;; 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. -;; -;; 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 Magit. If not, see <https://www.gnu.org/licenses/>. - -;;; Commentary: - -;; This library implements support for listing references in a buffer. - -;;; Code: - -(require 'magit) - -;;; Options - -(defgroup magit-refs nil - "Inspect and manipulate Git branches and tags." - :link '(info-link "(magit)References Buffer") - :group 'magit-modes) - -(defcustom magit-refs-mode-hook nil - "Hook run after entering Magit-Refs mode." - :package-version '(magit . "2.1.0") - :group 'magit-refs - :type 'hook) - -(defcustom magit-refs-sections-hook - '(magit-insert-error-header - magit-insert-branch-description - magit-insert-local-branches - magit-insert-remote-branches - magit-insert-tags) - "Hook run to insert sections into a references buffer." - :package-version '(magit . "2.1.0") - :group 'magit-refs - :type 'hook) - -(defcustom magit-refs-show-commit-count nil - "Whether to show commit counts in Magit-Refs mode buffers. - -all Show counts for branches and tags. -branch Show counts for branches only. -nil Never show counts. - -To change the value in an existing buffer use the command -`magit-refs-set-show-commit-count'." - :package-version '(magit . "2.1.0") - :group 'magit-refs - :safe (lambda (val) (memq val '(all branch nil))) - :type '(choice (const :tag "For branches and tags" all) - (const :tag "For branches only" branch) - (const :tag "Never" nil))) -(put 'magit-refs-show-commit-count 'safe-local-variable 'symbolp) -(put 'magit-refs-show-commit-count 'permanent-local t) - -(defcustom magit-refs-pad-commit-counts nil - "Whether to pad all counts on all sides in `magit-refs-mode' buffers. - -If this is nil, then some commit counts are displayed right next -to one of the branches that appear next to the count, without any -space in between. This might look bad if the branch name faces -look too similar to `magit-dimmed'. - -If this is non-nil, then spaces are placed on both sides of all -commit counts." - :package-version '(magit . "2.12.0") - :group 'magit-refs - :type 'boolean) - -(defvar magit-refs-show-push-remote nil - "Whether to show the push-remotes of local branches. -Also show the commits that the local branch is ahead and behind -the push-target. Unfortunately there is a bug in Git that makes -this useless (the commits ahead and behind the upstream are -shown), so this isn't enabled yet.") - -(defcustom magit-refs-show-remote-prefix nil - "Whether to show the remote prefix in lists of remote branches. - -This is redundant because the name of the remote is already shown -in the heading preceding the list of its branches." - :package-version '(magit . "2.12.0") - :group 'magit-refs - :type 'boolean) - -(defcustom magit-refs-margin - (list nil - (nth 1 magit-log-margin) - 'magit-log-margin-width nil - (nth 4 magit-log-margin)) - "Format of the margin in `magit-refs-mode' buffers. - -The value has the form (INIT STYLE WIDTH AUTHOR AUTHOR-WIDTH). - -If INIT is non-nil, then the margin is shown initially. -STYLE controls how to format the author or committer date. - It can be one of `age' (to show the age of the commit), - `age-abbreviated' (to abbreviate the time unit to a character), - or a string (suitable for `format-time-string') to show the - actual date. Option `magit-log-margin-show-committer-date' - controls which date is being displayed. -WIDTH controls the width of the margin. This exists for forward - compatibility and currently the value should not be changed. -AUTHOR controls whether the name of the author is also shown by - default. -AUTHOR-WIDTH has to be an integer. When the name of the author - is shown, then this specifies how much space is used to do so." - :package-version '(magit . "2.9.0") - :group 'magit-refs - :group 'magit-margin - :safe (lambda (val) (memq val '(all branch nil))) - :type magit-log-margin--custom-type - :initialize #'magit-custom-initialize-reset - :set-after '(magit-log-margin) - :set (apply-partially #'magit-margin-set-variable 'magit-refs-mode)) - -(defcustom magit-refs-margin-for-tags nil - "Whether to show information about tags in the margin. - -This is disabled by default because it is slow if there are many -tags." - :package-version '(magit . "2.9.0") - :group 'magit-refs - :group 'magit-margin - :type 'boolean) - -(defcustom magit-refs-primary-column-width (cons 16 32) - "Width of the focus column in `magit-refs-mode' buffers. - -The primary column is the column that contains the name of the -branch that the current row is about. - -If this is an integer, then the column is that many columns wide. -Otherwise it has to be a cons-cell of two integers. The first -specifies the minimal width, the second the maximal width. In that -case the actual width is determined using the length of the names -of the shown local branches. (Remote branches and tags are not -taken into account when calculating to optimal width.)" - :package-version '(magit . "2.12.0") - :group 'magit-refs - :type '(choice (integer :tag "Constant wide") - (cons :tag "Wide constrains" - (integer :tag "Minimum") - (integer :tag "Maximum")))) - -(defcustom magit-refs-focus-column-width 5 - "Width of the focus column in `magit-refs-mode' buffers. - -The focus column is the first column, which marks one -branch (usually the current branch) as the focused branch using -\"*\" or \"@\". For each other reference, this column optionally -shows how many commits it is ahead of the focused branch and \"<\", or -if it isn't ahead then the commits it is behind and \">\", or if it -isn't behind either, then a \"=\". - -This column may also display only \"*\" or \"@\" for the focused -branch, in which case this option is ignored. Use \"L v\" to -change the verbosity of this column." - :package-version '(magit . "2.12.0") - :group 'magit-refs - :type 'integer) - -(defcustom magit-refs-filter-alist nil - "Alist controlling which refs are omitted from `magit-refs-mode' buffers. - -The purpose of this option is to forgo displaying certain refs -based on their name. If you want to not display any refs of a -certain type, then you should remove the appropriate function -from `magit-refs-sections-hook' instead. - -All keys are tried in order until one matches. Then its value -is used and subsequent elements are ignored. If the value is -non-nil, then the reference is displayed, otherwise it is not. -If no element matches, then the reference is displayed. - -A key can either be a regular expression that the refname has to -match, or a function that takes the refname as only argument and -returns a boolean. A remote branch such as \"origin/master\" is -displayed as just \"master\", however for this comparison the -former is used." - :package-version '(magit . "2.12.0") - :group 'magit-refs - :type '(alist :key-type (choice :tag "Key" regexp function) - :value-type (boolean :tag "Value" - :on "show (non-nil)" - :off "omit (nil)"))) - -(defcustom magit-visit-ref-behavior nil - "Control how `magit-visit-ref' behaves in `magit-refs-mode' buffers. - -By default `magit-visit-ref' behaves like `magit-show-commit', -in all buffers, including `magit-refs-mode' buffers. When the -type of the section at point is `commit' then \"RET\" is bound to -`magit-show-commit', and when the type is either `branch' or -`tag' then it is bound to `magit-visit-ref'. - -\"RET\" is one of Magit's most essential keys and at least by -default it should behave consistently across all of Magit, -especially because users quickly learn that it does something -very harmless; it shows more information about the thing at point -in another buffer. - -However \"RET\" used to behave differently in `magit-refs-mode' -buffers, doing surprising things, some of which cannot really be -described as \"visit this thing\". If you have grown accustomed -to such inconsistent, but to you useful, behavior, then you can -restore that by adding one or more of the below symbols to the -value of this option. But keep in mind that by doing so you -don't only introduce inconsistencies, you also lose some -functionality and might have to resort to `M-x magit-show-commit' -to get it back. - -`magit-visit-ref' looks for these symbols in the order in which -they are described here. If the presence of a symbol applies to -the current situation, then the symbols that follow do not affect -the outcome. - -`focus-on-ref' - - With a prefix argument update the buffer to show commit counts - and lists of cherry commits relative to the reference at point - instead of relative to the current buffer or `HEAD'. - - Instead of adding this symbol, consider pressing \"C-u y o RET\". - -`create-branch' - - If point is on a remote branch, then create a new local branch - with the same name, use the remote branch as its upstream, and - then check out the local branch. - - Instead of adding this symbol, consider pressing \"b c RET RET\", - like you would do in other buffers. - -`checkout-any' - - Check out the reference at point. If that reference is a tag - or a remote branch, then this results in a detached `HEAD'. - - Instead of adding this symbol, consider pressing \"b b RET\", - like you would do in other buffers. - -`checkout-branch' - - Check out the local branch at point. - - Instead of adding this symbol, consider pressing \"b b RET\", - like you would do in other buffers." - :package-version '(magit . "2.9.0") - :group 'magit-refs - :group 'magit-commands - :options '(focus-on-ref create-branch checkout-any checkout-branch) - :type '(list :convert-widget custom-hook-convert-widget)) - -;;; Mode - -(defvar-keymap magit-refs-mode-map - :doc "Keymap for `magit-refs-mode'." - :parent magit-mode-map - "C-y" #'magit-refs-set-show-commit-count - "L" #'magit-margin-settings) - -(define-derived-mode magit-refs-mode magit-mode "Magit Refs" - "Mode which lists and compares references. - -This mode is documented in info node `(magit)References Buffer'. - -\\<magit-mode-map>\ -Type \\[magit-refresh] to refresh the current buffer. -Type \\[magit-section-toggle] to expand or hide the section at point. -Type \\[magit-visit-thing] or \\[magit-diff-show-or-scroll-up] \ -to visit the commit or branch at point. - -Type \\[magit-branch] to see available branch commands. -Type \\[magit-merge] to merge the branch or commit at point. -Type \\[magit-cherry-pick] to apply the commit at point. -Type \\[magit-reset] to reset `HEAD' to the commit at point. - -\\{magit-refs-mode-map}" - :group 'magit-refs - (hack-dir-local-variables-non-file-buffer) - (setq magit--imenu-group-types '(local remote tags))) - -(defun magit-refs-setup-buffer (ref args) - (magit-setup-buffer #'magit-refs-mode nil - (magit-buffer-upstream ref) - (magit-buffer-arguments args))) - -(defun magit-refs-refresh-buffer () - (setq magit-set-buffer-margin-refresh (not (magit-buffer-margin-p))) - (unless (magit-rev-verify magit-buffer-upstream) - (setq magit-refs-show-commit-count nil)) - (magit-set-header-line-format - (format "%s %s" magit-buffer-upstream - (mapconcat #'identity magit-buffer-arguments " "))) - (magit-insert-section (branchbuf) - (magit-run-section-hook 'magit-refs-sections-hook)) - (add-hook 'kill-buffer-hook #'magit-preserve-section-visibility-cache)) - -(cl-defmethod magit-buffer-value (&context (major-mode magit-refs-mode)) - (cons magit-buffer-upstream magit-buffer-arguments)) - -;;; Commands - -;;;###autoload (autoload 'magit-show-refs "magit-refs" nil t) -(transient-define-prefix magit-show-refs (&optional transient) - "List and compare references in a dedicated buffer." - :man-page "git-branch" - :value (lambda () - (magit-show-refs-arguments magit-prefix-use-buffer-arguments)) - ["Arguments" - (magit-for-each-ref:--contains) - ("-M" "Merged" "--merged=" magit-transient-read-revision) - ("-m" "Merged to HEAD" "--merged") - ("-N" "Not merged" "--no-merged=" magit-transient-read-revision) - ("-n" "Not merged to HEAD" "--no-merged") - (magit-for-each-ref:--sort)] - ["Actions" - ("y" "Show refs, comparing them with HEAD" magit-show-refs-head) - ("c" "Show refs, comparing them with current branch" magit-show-refs-current) - ("o" "Show refs, comparing them with other branch" magit-show-refs-other) - ("r" "Show refs, changing commit count display" - magit-refs-set-show-commit-count)] - (interactive (list (or (derived-mode-p 'magit-refs-mode) - current-prefix-arg))) - (if transient - (transient-setup 'magit-show-refs) - (magit-refs-setup-buffer "HEAD" (magit-show-refs-arguments)))) - -(defun magit-show-refs-arguments (&optional use-buffer-args) - (unless use-buffer-args - (setq use-buffer-args magit-direct-use-buffer-arguments)) - (let (args) - (cond - ((eq transient-current-command 'magit-show-refs) - (setq args (transient-args 'magit-show-refs))) - ((eq major-mode 'magit-refs-mode) - (setq args magit-buffer-arguments)) - ((and (memq use-buffer-args '(always selected)) - (and-let* ((buffer (magit-get-mode-buffer - 'magit-refs-mode nil - (eq use-buffer-args 'selected)))) - (progn - (setq args (buffer-local-value 'magit-buffer-arguments buffer)) - t)))) - (t - (setq args (alist-get 'magit-show-refs transient-values)))) - args)) - -(transient-define-argument magit-for-each-ref:--contains () - :description "Contains" - :class 'transient-option - :key "-c" - :argument "--contains=" - :reader #'magit-transient-read-revision) - -(transient-define-argument magit-for-each-ref:--sort () - :description "Sort" - :class 'transient-option - :key "-s" - :argument "--sort=" - :reader #'magit-read-ref-sort) - -(defun magit-read-ref-sort (prompt initial-input _history) - (magit-completing-read prompt - '("-committerdate" "-authordate" - "committerdate" "authordate") - nil nil initial-input)) - -;;;###autoload -(defun magit-show-refs-head (&optional args) - "List and compare references in a dedicated buffer. -Compared with `HEAD'." - (interactive (list (magit-show-refs-arguments))) - (magit-refs-setup-buffer "HEAD" args)) - -;;;###autoload -(defun magit-show-refs-current (&optional args) - "List and compare references in a dedicated buffer. -Compare with the current branch or `HEAD' if it is detached." - (interactive (list (magit-show-refs-arguments))) - (magit-refs-setup-buffer (magit-get-current-branch) args)) - -;;;###autoload -(defun magit-show-refs-other (&optional ref args) - "List and compare references in a dedicated buffer. -Compared with a branch read from the user." - (interactive (list (magit-read-other-branch "Compare with") - (magit-show-refs-arguments))) - (magit-refs-setup-buffer ref args)) - -(transient-define-suffix magit-refs-set-show-commit-count () - "Change for which refs the commit count is shown." - :description "Change verbosity" - :key "v" - :transient nil - :if-derived 'magit-refs-mode - (interactive) - (setq-local magit-refs-show-commit-count - (magit-read-char-case "Show commit counts for " nil - (?a "[a]ll refs" 'all) - (?b "[b]ranches only" t) - (?n "[n]othing" nil))) - (magit-refresh)) - -(defun magit-visit-ref () - "Visit the reference or revision at point in another buffer. -If there is no revision at point or with a prefix argument prompt -for a revision. - -This command behaves just like `magit-show-commit', except if -point is on a reference in a `magit-refs-mode' buffer (a buffer -listing branches and tags), in which case the behavior may be -different, but only if you have customized the option -`magit-visit-ref-behavior' (which see). When invoked from a -menu this command always behaves like `magit-show-commit'." - (interactive) - (if (and (derived-mode-p 'magit-refs-mode) - (magit-section-match '(branch tag)) - (not (magit-menu-position))) - (let ((ref (oref (magit-current-section) value))) - (cond (current-prefix-arg - (cond ((memq 'focus-on-ref magit-visit-ref-behavior) - (magit-refs-setup-buffer ref (magit-show-refs-arguments))) - (magit-visit-ref-behavior - ;; Don't prompt for commit to visit. - (let ((current-prefix-arg nil)) - (call-interactively #'magit-show-commit))))) - ((and (memq 'create-branch magit-visit-ref-behavior) - (magit-section-match [branch remote])) - (let ((branch (cdr (magit-split-branch-name ref)))) - (if (magit-branch-p branch) - (if (magit-rev-eq branch ref) - (magit-call-git "checkout" branch) - (setq branch (propertize branch 'face 'magit-branch-local)) - (setq ref (propertize ref 'face 'magit-branch-remote)) - (pcase (prog1 (read-char-choice (format (propertize "\ -Branch %s already exists. - [c]heckout %s as-is - [r]reset %s to %s and checkout %s - [a]bort " 'face 'minibuffer-prompt) branch branch branch ref branch) - '(?c ?r ?a)) - (message "")) ; otherwise prompt sticks - (?c (magit-call-git "checkout" branch)) - (?r (magit-call-git "checkout" "-B" branch ref)) - (?a (user-error "Abort")))) - (magit-call-git "checkout" "-b" branch ref)) - (setq magit-buffer-upstream branch) - (magit-refresh))) - ((or (memq 'checkout-any magit-visit-ref-behavior) - (and (memq 'checkout-branch magit-visit-ref-behavior) - (magit-section-match [branch local]))) - (magit-call-git "checkout" ref) - (setq magit-buffer-upstream ref) - (magit-refresh)) - (t - (call-interactively #'magit-show-commit)))) - (call-interactively #'magit-show-commit))) - -;;; Sections - -(defvar-keymap magit-remote-section-map - :doc "Keymap for `remote' sections." - "<remap> <magit-file-rename>" #'magit-remote-rename - "<remap> <magit-delete-thing>" #'magit-remote-remove - "<2>" (magit-menu-item "Rename %s" #'magit-remote-rename) - "<1>" (magit-menu-item "Remove %m" #'magit-remote-remove)) - -(defvar-keymap magit-branch-section-map - :doc "Keymap for `branch' sections." - "<remap> <magit-file-rename>" #'magit-branch-rename - "<remap> <magit-delete-thing>" #'magit-branch-delete - "<remap> <magit-visit-thing>" #'magit-visit-ref - "<3>" (magit-menu-item "Rename %s" #'magit-branch-rename) - "<2>" (magit-menu-item "Delete %m" #'magit-branch-delete) - "<1>" (magit-menu-item "Visit commit" #'magit-visit-ref)) - -(defvar-keymap magit-tag-section-map - :doc "Keymap for `tag' sections." - "<remap> <magit-delete-thing>" #'magit-tag-delete - "<remap> <magit-visit-thing>" #'magit-visit-ref - "<2>" (magit-menu-item "Delete %m" #'magit-tag-delete) - "<1>" (magit-menu-item "Visit %s" #'magit-visit-ref)) - -(defun magit--painted-branch-as-menu-section (section) - (and-let* ((branch (and (magit-section-match 'commit) - (magit--painted-branch-at-point)))) - (let ((dummy (magit-section :type 'branch :value branch))) - (oset dummy keymap magit-branch-section-map) - (dolist (slot '(start content hidden parent children)) - (when (slot-boundp section slot) - (setf (eieio-oref dummy slot) - (eieio-oref section slot)))) - dummy))) - -(add-hook 'magit-menu-alternative-section-hook - #'magit--painted-branch-as-menu-section) - -(defun magit-insert-branch-description () - "Insert header containing the description of the current branch. -Insert a header line with the name and description of the -current branch. The description is taken from the Git variable -`branch.<NAME>.description'; if that is undefined then no header -line is inserted at all." - (when-let* ((branch (magit-get-current-branch)) - (desc (magit-get "branch" branch "description")) - (desc (split-string desc "\n"))) - (when (equal (car (last desc)) "") - (setq desc (butlast desc))) - (magit-insert-section (branchdesc branch t) - (magit-insert-heading branch ": " (car desc)) - (when (cdr desc) - (insert (mapconcat #'identity (cdr desc) "\n")) - (insert "\n\n"))))) - -(defun magit-insert-tags () - "Insert sections showing all tags." - (when-let ((tags (magit-git-lines "tag" "--list" "-n" magit-buffer-arguments))) - (let ((_head (magit-rev-parse "HEAD"))) - (magit-insert-section (tags) - (magit-insert-heading "Tags:") - (dolist (tag tags) - (string-match "^\\([^ \t]+\\)[ \t]+\\([^ \t\n].*\\)?" tag) - (let ((tag (match-string 1 tag)) - (msg (match-string 2 tag))) - (when (magit-refs--insert-refname-p tag) - (magit-insert-section (tag tag t) - (magit-insert-heading - (magit-refs--format-focus-column tag 'tag) - (propertize tag 'font-lock-face 'magit-tag) - (make-string - (max 1 (- (if (consp magit-refs-primary-column-width) - (car magit-refs-primary-column-width) - magit-refs-primary-column-width) - (length tag))) - ?\s) - (and msg (magit-log-propertize-keywords nil msg))) - (when (and magit-refs-margin-for-tags (magit-buffer-margin-p)) - (magit-refs--format-margin tag)) - (magit-refs--insert-cherry-commits tag))))) - (insert ?\n) - (magit-make-margin-overlay nil t))))) - -(defun magit-insert-remote-branches () - "Insert sections showing all remote-tracking branches." - (dolist (remote (magit-list-remotes)) - (magit-insert-section (remote remote) - (magit-insert-heading - (let ((pull (magit-get "remote" remote "url")) - (push (magit-get "remote" remote "pushurl"))) - (format (propertize "Remote %s (%s):" - 'font-lock-face 'magit-section-heading) - (propertize remote 'font-lock-face 'magit-branch-remote) - (concat pull (and pull push ", ") push)))) - (let (head) - (dolist (line (magit-git-lines "for-each-ref" "--format=\ -%(symref:short)%00%(refname:short)%00%(refname)%00%(subject)" - (concat "refs/remotes/" remote) - magit-buffer-arguments)) - (pcase-let ((`(,head-branch ,branch ,ref ,msg) - (cl-substitute nil "" - (split-string line "\0") - :test #'equal))) - (cond - (head-branch - ;; Note: Use `ref' instead of `branch' for the check - ;; below because 'refname:short' shortens the remote - ;; HEAD to '<remote>' instead of '<remote>/HEAD' as of - ;; Git v2.40.0. - (cl-assert - (equal ref (concat "refs/remotes/" remote "/HEAD"))) - (setq head head-branch)) - ((not (equal ref (concat "refs/remotes/" remote "/HEAD"))) - ;; ^ Skip mis-configured remotes where HEAD is not a - ;; symref. See #5092. - (when (magit-refs--insert-refname-p branch) - (magit-insert-section (branch branch t) - (let ((headp (equal branch head)) - (abbrev (if magit-refs-show-remote-prefix - branch - (substring branch (1+ (length remote)))))) - (magit-insert-heading - (magit-refs--format-focus-column branch) - (magit-refs--propertize-branch - abbrev ref (and headp 'magit-branch-remote-head)) - (make-string - (max 1 (- (if (consp magit-refs-primary-column-width) - (car magit-refs-primary-column-width) - magit-refs-primary-column-width) - (length abbrev))) - ?\s) - (and msg (magit-log-propertize-keywords nil msg)))) - (when (magit-buffer-margin-p) - (magit-refs--format-margin branch)) - (magit-refs--insert-cherry-commits branch)))))))) - (insert ?\n) - (magit-make-margin-overlay nil t)))) - -(defun magit-insert-local-branches () - "Insert sections showing all local branches." - (magit-insert-section (local nil) - (magit-insert-heading "Branches:") - (dolist (line (magit-refs--format-local-branches)) - (pcase-let ((`(,branch . ,strings) line)) - (magit-insert-section - ((eval (if branch 'branch 'commit)) - (or branch (magit-rev-parse "HEAD")) - t) - (apply #'magit-insert-heading strings) - (when (magit-buffer-margin-p) - (magit-refs--format-margin branch)) - (magit-refs--insert-cherry-commits branch)))) - (insert ?\n) - (magit-make-margin-overlay nil t))) - -(defun magit-refs--format-local-branches () - (let ((lines (seq-keep #'magit-refs--format-local-branch - (magit-git-lines - "for-each-ref" - (concat "--format=\ -%(HEAD)%00%(refname:short)%00%(refname)%00\ -%(upstream:short)%00%(upstream)%00%(upstream:track)%00" - (if magit-refs-show-push-remote "\ -%(push:remotename)%00%(push)%00%(push:track)%00%(subject)" - "%00%00%00%(subject)")) - "refs/heads" - magit-buffer-arguments)))) - (unless (magit-get-current-branch) - (push (magit-refs--format-local-branch - (concat "*\0\0\0\0\0\0\0\0" (magit-rev-format "%s"))) - lines)) - (setq-local magit-refs-primary-column-width - (let ((def (default-value 'magit-refs-primary-column-width))) - (if (atom def) - def - (pcase-let ((`(,min . ,max) def)) - (min max (apply #'max min (mapcar #'car lines))))))) - (mapcar (pcase-lambda (`(,_ ,branch ,focus ,branch-desc ,u:ahead ,p:ahead - ,u:behind ,upstream ,p:behind ,push ,msg)) - (list branch focus branch-desc u:ahead p:ahead - (make-string (max 1 (- magit-refs-primary-column-width - (length (concat branch-desc - u:ahead - p:ahead - u:behind)))) - ?\s) - u:behind upstream p:behind push - msg)) - lines))) - -(defun magit-refs--format-local-branch (line) - (pcase-let ((`(,head ,branch ,ref ,upstream ,u:ref ,u:track - ,push ,p:ref ,p:track ,msg) - (cl-substitute nil "" (split-string line "\0") :test #'equal))) - (when (or (not branch) - (magit-refs--insert-refname-p branch)) - (let* ((headp (equal head "*")) - (pushp (and push - magit-refs-show-push-remote - (magit-rev-verify p:ref) - (not (equal p:ref u:ref)))) - (branch-desc - (if branch - (magit-refs--propertize-branch - branch ref (and headp 'magit-branch-current)) - (magit--propertize-face "(detached)" 'magit-branch-warning))) - (u:ahead (and u:track - (string-match "ahead \\([0-9]+\\)" u:track) - (magit--propertize-face - (concat (and magit-refs-pad-commit-counts " ") - (match-string 1 u:track) - ">") - 'magit-dimmed))) - (u:behind (and u:track - (string-match "behind \\([0-9]+\\)" u:track) - (magit--propertize-face - (concat "<" - (match-string 1 u:track) - (and magit-refs-pad-commit-counts " ")) - 'magit-dimmed))) - (p:ahead (and pushp p:track - (string-match "ahead \\([0-9]+\\)" p:track) - (magit--propertize-face - (concat (match-string 1 p:track) - ">" - (and magit-refs-pad-commit-counts " ")) - 'magit-branch-remote))) - (p:behind (and pushp p:track - (string-match "behind \\([0-9]+\\)" p:track) - (magit--propertize-face - (concat "<" - (match-string 1 p:track) - (and magit-refs-pad-commit-counts " ")) - 'magit-dimmed)))) - (list (1+ (length (concat branch-desc u:ahead p:ahead u:behind))) - branch - (magit-refs--format-focus-column branch headp) - branch-desc u:ahead p:ahead u:behind - (and upstream - (concat (if (equal u:track "[gone]") - (magit--propertize-face upstream 'error) - (magit-refs--propertize-branch upstream u:ref)) - " ")) - (and pushp - (concat p:behind - (magit--propertize-face - push 'magit-branch-remote) - " ")) - (and msg (magit-log-propertize-keywords nil msg))))))) - -(defun magit-refs--format-focus-column (ref &optional type) - (let ((focus magit-buffer-upstream) - (width (if magit-refs-show-commit-count - magit-refs-focus-column-width - 1))) - (format - (format "%%%ss " width) - (cond ((or (equal ref focus) - (and (eq type t) - (equal focus "HEAD"))) - (magit--propertize-face (concat (if (equal focus "HEAD") "@" "*") - (make-string (1- width) ?\s)) - 'magit-section-heading)) - ((if (eq type 'tag) - (eq magit-refs-show-commit-count 'all) - magit-refs-show-commit-count) - (pcase-let ((`(,behind ,ahead) - (magit-rev-diff-count magit-buffer-upstream ref))) - (magit--propertize-face - (cond ((> ahead 0) (concat "<" (number-to-string ahead))) - ((> behind 0) (concat (number-to-string behind) ">")) - (t "=")) - 'magit-dimmed))) - (t ""))))) - -(defun magit-refs--propertize-branch (branch ref &optional head-face) - (let ((face (cdr (cl-find-if (pcase-lambda (`(,re . ,_)) - (string-match-p re ref)) - magit-ref-namespaces)))) - (magit--propertize-face - branch (if head-face (list face head-face) face)))) - -(defun magit-refs--insert-refname-p (refname) - (if-let ((entry (seq-find (pcase-lambda (`(,key . ,_)) - (if (functionp key) - (funcall key refname) - (string-match-p key refname))) - magit-refs-filter-alist))) - (cdr entry) - t)) - -(defun magit-refs--insert-cherry-commits (ref) - (magit-insert-section-body - (let ((start (point)) - (magit-insert-section--current nil)) - (magit-git-wash (apply-partially #'magit-log-wash-log 'cherry) - "cherry" "-v" (magit-abbrev-arg) magit-buffer-upstream ref) - (if (= (point) start) - (message "No cherries for %s" ref) - (magit-make-margin-overlay nil t))))) - -(defun magit-refs--format-margin (commit) - (save-excursion - (goto-char (line-beginning-position 0)) - (let ((line (magit-rev-format "%ct%cN" commit))) - (magit-log-format-margin commit - (substring line 10) - (substring line 0 10))))) - -;;; _ -(provide 'magit-refs) -;;; magit-refs.el ends here diff --git a/emacs/elpa/magit-20240622.1531/magit-refs.elc b/emacs/elpa/magit-20240622.1531/magit-refs.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/magit-remote.elc b/emacs/elpa/magit-20240622.1531/magit-remote.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/magit-sequence.elc b/emacs/elpa/magit-20240622.1531/magit-sequence.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/magit-stash.el b/emacs/elpa/magit-20240622.1531/magit-stash.el @@ -1,643 +0,0 @@ -;;; magit-stash.el --- Stash support for Magit -*- lexical-binding:t -*- - -;; Copyright (C) 2008-2024 The Magit Project Contributors - -;; Author: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> -;; Maintainer: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> - -;; SPDX-License-Identifier: GPL-3.0-or-later - -;; 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. -;; -;; 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 Magit. If not, see <https://www.gnu.org/licenses/>. - -;;; Commentary: - -;; Support for Git stashes. - -;;; Code: - -(require 'magit) -(require 'magit-reflog) -(require 'magit-sequence) - -;;; Options - -(defgroup magit-stash nil - "List stashes and show stash diffs." - :group 'magit-modes) - -;;;; Diff options - -(defcustom magit-stash-sections-hook - '(magit-insert-stash-notes - magit-insert-stash-worktree - magit-insert-stash-index - magit-insert-stash-untracked) - "Hook run to insert sections into stash diff buffers." - :package-version '(magit . "2.1.0") - :group 'magit-stash - :type 'hook) - -;;;; Log options - -(defcustom magit-stashes-margin - (list (nth 0 magit-log-margin) - (nth 1 magit-log-margin) - 'magit-log-margin-width nil - (nth 4 magit-log-margin)) - "Format of the margin in `magit-stashes-mode' buffers. - -The value has the form (INIT STYLE WIDTH AUTHOR AUTHOR-WIDTH). - -If INIT is non-nil, then the margin is shown initially. -STYLE controls how to format the author or committer date. - It can be one of `age' (to show the age of the commit), - `age-abbreviated' (to abbreviate the time unit to a character), - or a string (suitable for `format-time-string') to show the - actual date. Option `magit-log-margin-show-committer-date' - controls which date is being displayed. -WIDTH controls the width of the margin. This exists for forward - compatibility and currently the value should not be changed. -AUTHOR controls whether the name of the author is also shown by - default. -AUTHOR-WIDTH has to be an integer. When the name of the author - is shown, then this specifies how much space is used to do so." - :package-version '(magit . "2.9.0") - :group 'magit-stash - :group 'magit-margin - :type magit-log-margin--custom-type - :initialize #'magit-custom-initialize-reset - :set-after '(magit-log-margin) - :set (apply-partially #'magit-margin-set-variable 'magit-stashes-mode)) - -;;;; Variables - -(defvar magit-stash-read-message-function #'magit-stash-read-message - "Function used to read the message when creating a stash.") - -;;; Commands - -;;;###autoload (autoload 'magit-stash "magit-stash" nil t) -(transient-define-prefix magit-stash () - "Stash uncommitted changes." - :man-page "git-stash" - ["Arguments" - ("-u" "Also save untracked files" ("-u" "--include-untracked")) - ("-a" "Also save untracked and ignored files" ("-a" "--all"))] - [["Stash" - ("z" "both" magit-stash-both) - ("i" "index" magit-stash-index) - ("w" "worktree" magit-stash-worktree) - ("x" "keeping index" magit-stash-keep-index) - ("P" "push" magit-stash-push :level 5)] - ["Snapshot" - ("Z" "both" magit-snapshot-both) - ("I" "index" magit-snapshot-index) - ("W" "worktree" magit-snapshot-worktree) - ("r" "to wip ref" magit-wip-commit)] - ["Use" - ("a" "Apply" magit-stash-apply) - ("p" "Pop" magit-stash-pop) - ("k" "Drop" magit-stash-drop)] - ["Inspect" - ("l" "List" magit-stash-list) - ("v" "Show" magit-stash-show)] - ["Transform" - ("b" "Branch" magit-stash-branch) - ("B" "Branch here" magit-stash-branch-here) - ("f" "Format patch" magit-stash-format-patch)]]) - -(defun magit-stash-arguments () - (transient-args 'magit-stash)) - -;;;###autoload -(defun magit-stash-both (message &optional include-untracked) - "Create a stash of the index and working tree. -Untracked files are included according to infix arguments. -One prefix argument is equivalent to `--include-untracked' -while two prefix arguments are equivalent to `--all'." - (interactive - (progn (when (and (magit-merge-in-progress-p) - (not (magit-y-or-n-p "\ -Stashing and resetting during a merge conflict. \ -Applying the resulting stash won't restore the merge state. \ -Proceed anyway? "))) - (user-error "Abort")) - (magit-stash-read-args))) - (magit-stash-save message t t include-untracked t)) - -;;;###autoload -(defun magit-stash-index (message) - "Create a stash of the index only. -Unstaged and untracked changes are not stashed. The stashed -changes are applied in reverse to both the index and the -worktree. This command can fail when the worktree is not clean. -Applying the resulting stash has the inverse effect." - (interactive (list (magit-stash-read-message))) - (magit-stash-save message t nil nil t 'worktree)) - -;;;###autoload -(defun magit-stash-worktree (message &optional include-untracked) - "Create a stash of unstaged changes in the working tree. -Untracked files are included according to infix arguments. -One prefix argument is equivalent to `--include-untracked' -while two prefix arguments are equivalent to `--all'." - (interactive (magit-stash-read-args)) - (magit-stash-save message nil t include-untracked t 'index)) - -;;;###autoload -(defun magit-stash-keep-index (message &optional include-untracked) - "Create a stash of the index and working tree, keeping index intact. -Untracked files are included according to infix arguments. -One prefix argument is equivalent to `--include-untracked' -while two prefix arguments are equivalent to `--all'." - (interactive (magit-stash-read-args)) - (magit-stash-save message t t include-untracked t 'index)) - -(defun magit-stash-read-args () - (list (funcall magit-stash-read-message-function) - (magit-stash-read-untracked))) - -(defun magit-stash-read-message () - "Read a message from the minibuffer, to be used for a stash. - -The message that Git would have picked, is available as the -default (used when the user enters the empty string) and as -the next history element (which can be accessed with \ -\\<minibuffer-local-map>\\[next-history-element])." - (read-string (format "Stash message (default: On%s:%s): " - (magit--ellipsis) (magit--ellipsis)) - nil nil - (format "On %s: %s" - (or (magit-get-current-branch) "(no branch)") - (magit-rev-format "%h %s")))) - -(defun magit-stash-read-message-traditional () - "Read a message from the minibuffer, to be used for a stash. - -If the user confirms the initial-input unmodified, then the -abbreviated commit hash and commit summary are appended. -The resulting message is what Git would have used." - (let* ((default (format "On %s: " - (or (magit-get-current-branch) "(no branch)"))) - (input (magit-read-string "Stash message" default))) - (if (equal input default) - (concat default (magit-rev-format "%h %s")) - input))) - -(defun magit-stash-read-untracked () - (let ((prefix (prefix-numeric-value current-prefix-arg)) - (args (magit-stash-arguments))) - (cond ((or (= prefix 16) (member "--all" args)) 'all) - ((or (= prefix 4) (member "--include-untracked" args)) t)))) - -;;;###autoload -(defun magit-snapshot-both (&optional include-untracked) - "Create a snapshot of the index and working tree. -Untracked files are included according to infix arguments. -One prefix argument is equivalent to `--include-untracked' -while two prefix arguments are equivalent to `--all'." - (interactive (magit-snapshot-read-args)) - (magit-snapshot-save t t include-untracked t)) - -;;;###autoload -(defun magit-snapshot-index () - "Create a snapshot of the index only. -Unstaged and untracked changes are not stashed." - (interactive) - (magit-snapshot-save t nil nil t)) - -;;;###autoload -(defun magit-snapshot-worktree (&optional include-untracked) - "Create a snapshot of unstaged changes in the working tree. -Untracked files are included according to infix arguments. -One prefix argument is equivalent to `--include-untracked' -while two prefix arguments are equivalent to `--all'." - (interactive (magit-snapshot-read-args)) - (magit-snapshot-save nil t include-untracked t)) - -(defun magit-snapshot-read-args () - (list (magit-stash-read-untracked))) - -(defun magit-snapshot-save (index worktree untracked &optional refresh) - (magit-stash-save (concat "WIP on " (magit-stash-summary)) - index worktree untracked refresh t)) - -;;;###autoload (autoload 'magit-stash-push "magit-stash" nil t) -(transient-define-prefix magit-stash-push (&optional transient args) - "Create stash using \"git stash push\". - -This differs from Magit's other stashing commands, which don't -use \"git stash\" and are generally more flexible but don't allow -specifying a list of files to be stashed." - :man-page "git-stash" - ["Arguments" - (magit:-- :reader (lambda (prompt initial-input history) - (magit-read-files prompt initial-input history - #'magit-modified-files))) - ("-u" "Also save untracked files" ("-u" "--include-untracked")) - ("-a" "Also save untracked and ignored files" ("-a" "--all")) - ("-k" "Keep index" ("-k" "--keep-index")) - ("-K" "Don't keep index" "--no-keep-index")] - ["Actions" - ("P" "push" magit-stash-push)] - (interactive (if (eq transient-current-command 'magit-stash-push) - (list nil (transient-args 'magit-stash-push)) - (list t))) - (if transient - (transient-setup 'magit-stash-push) - (magit-run-git "stash" "push" args))) - -;;;###autoload -(defun magit-stash-apply (stash) - "Apply a stash to the working tree. - -First try \"git stash apply --index\", which tries to preserve -the index stored in the stash, if any. This may fail because -applying the stash could result in conflicts and those have to -be stored in the index, making it impossible to also store the -stash's index there as well. - -If the above failed, then try \"git stash apply\". This fails -\(with or without \"--index\") if there are any uncommitted -changes to files that are also modified in the stash. - -If both of the above failed, then apply using \"git apply\". -If there are no conflicting files, use \"--3way\". If there are -conflicting files, then using \"--3way\" requires that those -files are staged first, which may be undesirable, so prompt -the user whether to use \"--3way\" or \"--reject\"." - (interactive (list (magit-read-stash "Apply stash"))) - (magit-stash--apply "apply" stash)) - -;;;###autoload -(defun magit-stash-pop (stash) - "Apply a stash to the working tree, on success remove it from stash list. - -First try \"git stash pop --index\", which tries to preserve -the index stored in the stash, if any. This may fail because -applying the stash could result in conflicts and those have to -be stored in the index, making it impossible to also store the -stash's index there as well. - -If the above failed, then try \"git stash apply\". This fails -\(with or without \"--index\") if there are any uncommitted -changes to files that are also modified in the stash. - -If both of the above failed, then apply using \"git apply\". -If there are no conflicting files, use \"--3way\". If there are -conflicting files, then using \"--3way\" requires that those -files are staged first, which may be undesirable, so prompt -the user whether to use \"--3way\" or \"--reject\"." - (interactive (list (magit-read-stash "Pop stash"))) - (magit-stash--apply "pop" stash)) - -(defun magit-stash--apply (action stash) - (or (= (magit-call-git "stash" action "--index" stash) 0) - ;; The stash's index could not be applied, so always keep the stash. - (= (magit-call-git "stash" "apply" stash) 0) - (let* ((range (format "%s^..%s" stash stash)) - (stashed (magit-git-items "diff" "-z" "--name-only" range "--")) - (conflicts (cl-sort (cl-union (magit-unstaged-files t stashed) - (magit-untracked-files t stashed) - :test #'equal) - #'string<)) - (arg (cond - ((not conflicts) "--3way") - ((magit-confirm-files - 'stash-apply-3way conflicts - "Apply stash using `--3way', which requires first staging" - "(else use `--reject')" - t) - (magit-stage-1 nil conflicts) - "--3way") - ("--reject")))) - (with-temp-buffer - (magit-git-insert "diff" range) - (magit-run-git-with-input "apply" arg "-")))) - (magit-refresh)) - -;;;###autoload -(defun magit-stash-drop (stash) - "Remove a stash from the stash list. -When the region is active offer to drop all contained stashes." - (interactive - (list (if-let ((values (magit-region-values 'stash))) - (magit-confirm 'drop-stashes nil "Drop %d stashes" nil values) - (magit-read-stash "Drop stash")))) - (dolist (stash (if (listp stash) - (nreverse (prog1 stash (setq stash (car stash)))) - (list stash))) - (message "Deleted refs/%s (was %s)" stash - (magit-rev-parse "--short" stash)) - (magit-call-git "rev-parse" stash) - (magit-call-git "stash" "drop" stash)) - (magit-refresh)) - -;;;###autoload -(defun magit-stash-clear (ref) - "Remove all stashes saved in REF's reflog by deleting REF." - (interactive (let ((ref (or (magit-section-value-if 'stashes) "refs/stash"))) - (magit-confirm t (format "Drop all stashes in %s" ref)) - (list ref))) - (magit-run-git "update-ref" "-d" ref)) - -;;;###autoload -(defun magit-stash-branch (stash branch) - "Create and checkout a new BRANCH from an existing STASH. -The new branch starts at the commit that was current when the -stash was created. If the stash applies cleanly, then drop it." - (interactive (list (magit-read-stash "Branch stash") - (magit-read-string-ns "Branch name"))) - (magit-run-git "stash" "branch" branch stash)) - -;;;###autoload -(defun magit-stash-branch-here (stash branch) - "Create and checkout a new BRANCH from an existing STASH. -Use the current branch or `HEAD' as the starting-point of BRANCH. -Then apply STASH, dropping it if it applies cleanly." - (interactive (list (magit-read-stash "Branch stash") - (magit-read-string-ns "Branch name"))) - (let ((start-point (or (magit-get-current-branch) "HEAD"))) - (magit-call-git "checkout" "-b" branch start-point) - (magit-branch-maybe-adjust-upstream branch start-point)) - (magit-stash-apply stash)) - -;;;###autoload -(defun magit-stash-format-patch (stash) - "Create a patch from STASH" - (interactive (list (magit-read-stash "Create patch from stash"))) - (with-temp-file (magit-rev-format "0001-%f.patch" stash) - (magit-git-insert "stash" "show" "-p" stash)) - (magit-refresh)) - -;;; Plumbing - -(defun magit-stash-save (message index worktree untracked - &optional refresh keep noerror ref) - (if (or (and index (magit-staged-files t)) - (and worktree (magit-unstaged-files t)) - (and untracked (magit-untracked-files (eq untracked 'all)))) - (magit-with-toplevel - (magit-stash-store message (or ref "refs/stash") - (magit-stash-create message index worktree untracked)) - (if (eq keep 'worktree) - (with-temp-buffer - (magit-git-insert "diff" "--cached" "--no-ext-diff") - (magit-run-git-with-input - "apply" "--reverse" "--cached" "--ignore-space-change" "-") - (magit-run-git-with-input - "apply" "--reverse" "--ignore-space-change" "-")) - (unless (eq keep t) - (if (eq keep 'index) - (magit-call-git "checkout" "--" ".") - (magit-call-git "reset" "--hard" "HEAD" "--")) - (when untracked - (magit-call-git "clean" "--force" "-d" - (and (eq untracked 'all) "-x"))))) - (when refresh - (magit-refresh))) - (unless noerror - (user-error "No %s changes to save" (cond ((not index) "unstaged") - ((not worktree) "staged") - (t "local")))))) - -(defun magit-stash-store (message ref commit) - (magit-update-ref ref message commit t)) - -(defun magit-stash-create (message index worktree untracked) - (unless (magit-rev-parse "--verify" "HEAD") - (error "You do not have the initial commit yet")) - (let ((magit-git-global-arguments (nconc (list "-c" "commit.gpgsign=false") - magit-git-global-arguments)) - (default-directory (magit-toplevel)) - (summary (magit-stash-summary)) - (head "HEAD")) - (when (and worktree (not index)) - (setq head (or (magit-commit-tree "pre-stash index" nil "HEAD") - (error "Cannot save the current index state")))) - (or (setq index (magit-commit-tree (concat "index on " summary) nil head)) - (error "Cannot save the current index state")) - (and untracked - (setq untracked (magit-untracked-files (eq untracked 'all))) - (setq untracked (magit-with-temp-index nil nil - (or (and (magit-update-files untracked) - (magit-commit-tree - (concat "untracked files on " summary))) - (error "Cannot save the untracked files"))))) - (magit-with-temp-index index "-m" - (when worktree - (or (magit-update-files (magit-git-items "diff" "-z" "--name-only" head)) - (error "Cannot save the current worktree state"))) - (or (magit-commit-tree message nil head index untracked) - (error "Cannot save the current worktree state"))))) - -(defun magit-stash-summary () - (concat (or (magit-get-current-branch) "(no branch)") - ": " (magit-rev-format "%h %s"))) - -;;; Sections - -(defvar-keymap magit-stashes-section-map - :doc "Keymap for `stashes' section." - "<remap> <magit-delete-thing>" #'magit-stash-clear - "<remap> <magit-visit-thing>" #'magit-stash-list - "<2>" (magit-menu-item "Clear %t" #'magit-stash-clear) - "<1>" (magit-menu-item "List %t" #'magit-stash-list)) - -(defvar-keymap magit-stash-section-map - :doc "Keymap for `stash' sections." - "<remap> <magit-cherry-pick>" #'magit-stash-pop - "<remap> <magit-cherry-apply>" #'magit-stash-apply - "<remap> <magit-delete-thing>" #'magit-stash-drop - "<remap> <magit-visit-thing>" #'magit-stash-show - "<4>" (magit-menu-item "Pop %M" #'magit-stash-pop) - "<3>" (magit-menu-item "Apply %M" #'magit-stash-apply) - "<2>" (magit-menu-item "Delete %M" #'magit-stash-drop) - "<1>" (magit-menu-item "Visit %v" #'magit-stash-show)) - -(magit-define-section-jumper magit-jump-to-stashes - "Stashes" stashes "refs/stash") - -(cl-defun magit-insert-stashes (&optional (ref "refs/stash") - (heading "Stashes:")) - "Insert `stashes' section showing reflog for \"refs/stash\". -If optional REF is non-nil, show reflog for that instead. -If optional HEADING is non-nil, use that as section heading -instead of \"Stashes:\"." - (let ((verified (magit-rev-verify ref)) - (autostash (magit-rebase--get-state-lines "autostash"))) - (when (or autostash verified) - (magit-insert-section (stashes ref) - (magit-insert-heading heading) - (when autostash - (pcase-let ((`(,author ,date ,msg) - (split-string - (car (magit-git-lines - "show" "-q" "--format=%aN%x00%at%x00%s" - autostash)) - "\0"))) - (magit-insert-section (stash autostash) - (insert (propertize "AUTOSTASH" 'font-lock-face 'magit-hash)) - (insert " " msg "\n") - (save-excursion - (backward-char) - (magit-log-format-margin autostash author date))))) - (if verified - (magit-git-wash (apply-partially #'magit-log-wash-log 'stash) - "reflog" "--format=%gd%x00%aN%x00%at%x00%gs" ref) - (insert ?\n) - (save-excursion - (backward-char) - (magit-make-margin-overlay))))))) - -;;; List Stashes - -;;;###autoload -(defun magit-stash-list () - "List all stashes in a buffer." - (interactive) - (magit-stashes-setup-buffer)) - -(define-derived-mode magit-stashes-mode magit-reflog-mode "Magit Stashes" - "Mode for looking at lists of stashes." - :group 'magit-log - (hack-dir-local-variables-non-file-buffer)) - -(defun magit-stashes-setup-buffer () - (magit-setup-buffer #'magit-stashes-mode nil - (magit-buffer-refname "refs/stash"))) - -(defun magit-stashes-refresh-buffer () - (magit-insert-section (stashesbuf) - (magit-insert-heading (if (equal magit-buffer-refname "refs/stash") - "Stashes:" - (format "Stashes [%s]:" magit-buffer-refname))) - (magit-git-wash (apply-partially #'magit-log-wash-log 'stash) - "reflog" "--format=%gd%x00%aN%x00%at%x00%gs" magit-buffer-refname))) - -(cl-defmethod magit-buffer-value (&context (major-mode magit-stashes-mode)) - magit-buffer-refname) - -(defvar magit--update-stash-buffer nil) - -(defun magit-stashes-maybe-update-stash-buffer (&optional _) - "When moving in the stashes buffer, update the stash buffer. -If there is no stash buffer in the same frame, then do nothing." - (when (derived-mode-p 'magit-stashes-mode) - (magit--maybe-update-stash-buffer))) - -(defun magit--maybe-update-stash-buffer () - (when-let* ((stash (magit-section-value-if 'stash)) - (buffer (magit-get-mode-buffer 'magit-stash-mode nil t))) - (if magit--update-stash-buffer - (setq magit--update-stash-buffer (list stash buffer)) - (setq magit--update-stash-buffer (list stash buffer)) - (run-with-idle-timer - magit-update-other-window-delay nil - (let ((args (with-current-buffer buffer - (let ((magit-direct-use-buffer-arguments 'selected)) - (magit-show-commit--arguments))))) - (lambda () - (pcase-let ((`(,stash ,buf) magit--update-stash-buffer)) - (setq magit--update-stash-buffer nil) - (when (buffer-live-p buf) - (let ((magit-display-buffer-noselect t)) - (apply #'magit-stash-show stash args)))) - (setq magit--update-stash-buffer nil))))))) - -;;; Show Stash - -;;;###autoload -(defun magit-stash-show (stash &optional args files) - "Show all diffs of a stash in a buffer." - (interactive (cons (or (and (not current-prefix-arg) - (magit-stash-at-point)) - (magit-read-stash "Show stash")) - (pcase-let ((`(,args ,files) - (magit-diff-arguments 'magit-stash-mode))) - (list (delete "--stat" args) files)))) - (magit-stash-setup-buffer stash args files)) - -(define-derived-mode magit-stash-mode magit-diff-mode "Magit Stash" - "Mode for looking at individual stashes." - :group 'magit-diff - (hack-dir-local-variables-non-file-buffer) - (setq magit--imenu-group-types '(commit))) - -(defun magit-stash-setup-buffer (stash args files) - (magit-setup-buffer #'magit-stash-mode nil - (magit-buffer-revision stash) - (magit-buffer-range (format "%s^..%s" stash stash)) - (magit-buffer-diff-args args) - (magit-buffer-diff-files files))) - -(defun magit-stash-refresh-buffer () - (magit-set-header-line-format - (concat (capitalize magit-buffer-revision) " " - (propertize (magit-rev-format "%s" magit-buffer-revision) - 'font-lock-face - (list :weight 'normal :foreground - (face-attribute 'default :foreground))))) - (setq magit-buffer-revision-hash (magit-rev-parse magit-buffer-revision)) - (magit-insert-section (stash) - (magit-run-section-hook 'magit-stash-sections-hook))) - -(cl-defmethod magit-buffer-value (&context (major-mode magit-stash-mode)) - magit-buffer-revision) - -(defun magit-stash-insert-section (commit range message &optional files) - (magit-insert-section (commit commit) - (magit-insert-heading message) - (magit--insert-diff nil - "diff" range "-p" "--no-prefix" magit-buffer-diff-args - "--" (or files magit-buffer-diff-files)))) - -(defun magit-insert-stash-notes () - "Insert section showing notes for a stash. -This shows the notes for stash@{N} but not for the other commits -that make up the stash." - (magit-insert-section (note) - (magit-insert-heading "Notes") - (magit-git-insert "notes" "show" magit-buffer-revision) - (magit-cancel-section 'if-empty) - (insert "\n"))) - -(defun magit-insert-stash-index () - "Insert section showing staged changes of the stash." - (magit-stash-insert-section - (format "%s^2" magit-buffer-revision) - (format "%s^..%s^2" magit-buffer-revision magit-buffer-revision) - "Staged")) - -(defun magit-insert-stash-worktree () - "Insert section showing unstaged changes of the stash." - (magit-stash-insert-section - magit-buffer-revision - (format "%s^2..%s" magit-buffer-revision magit-buffer-revision) - "Unstaged")) - -(defun magit-insert-stash-untracked () - "Insert section showing the untracked files commit of the stash." - (let ((stash magit-buffer-revision) - (rev (concat magit-buffer-revision "^3"))) - (when (magit-rev-verify rev) - (magit-stash-insert-section (format "%s^3" stash) - (format "%s^..%s^3" stash stash) - "Untracked files" - (magit-git-items "ls-tree" "-z" "--name-only" - "-r" "--full-tree" rev))))) - -;;; _ -(provide 'magit-stash) -;;; magit-stash.el ends here diff --git a/emacs/elpa/magit-20240622.1531/magit-stash.elc b/emacs/elpa/magit-20240622.1531/magit-stash.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/magit-status.el b/emacs/elpa/magit-20240622.1531/magit-status.el @@ -1,823 +0,0 @@ -;;; magit-status.el --- The grand overview -*- lexical-binding:t -*- - -;; Copyright (C) 2008-2024 The Magit Project Contributors - -;; Author: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> -;; Maintainer: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> - -;; SPDX-License-Identifier: GPL-3.0-or-later - -;; 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. -;; -;; 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 Magit. If not, see <https://www.gnu.org/licenses/>. - -;;; Commentary: - -;; This library implements the status buffer. - -;;; Code: - -(require 'magit) - -;;; Options - -(defgroup magit-status nil - "Inspect and manipulate Git repositories." - :link '(info-link "(magit)Status Buffer") - :group 'magit-modes) - -(defcustom magit-status-mode-hook nil - "Hook run after entering Magit-Status mode." - :group 'magit-status - :type 'hook) - -(defcustom magit-status-headers-hook - '(magit-insert-error-header - magit-insert-diff-filter-header - magit-insert-head-branch-header - magit-insert-upstream-branch-header - magit-insert-push-branch-header - magit-insert-tags-header) - "Hook run to insert headers into the status buffer. - -This hook is run by `magit-insert-status-headers', which in turn -has to be a member of `magit-status-sections-hook' to be used at -all." - :package-version '(magit . "2.1.0") - :group 'magit-status - :type 'hook - :options '(magit-insert-error-header - magit-insert-diff-filter-header - magit-insert-repo-header - magit-insert-remote-header - magit-insert-head-branch-header - magit-insert-upstream-branch-header - magit-insert-push-branch-header - magit-insert-tags-header)) - -(defcustom magit-status-sections-hook - '(magit-insert-status-headers - magit-insert-merge-log - magit-insert-rebase-sequence - magit-insert-am-sequence - magit-insert-sequencer-sequence - magit-insert-bisect-output - magit-insert-bisect-rest - magit-insert-bisect-log - magit-insert-untracked-files - magit-insert-unstaged-changes - magit-insert-staged-changes - magit-insert-stashes - magit-insert-unpushed-to-pushremote - magit-insert-unpushed-to-upstream-or-recent - magit-insert-unpulled-from-pushremote - magit-insert-unpulled-from-upstream) - "Hook run to insert sections into a status buffer." - :package-version '(magit . "2.12.0") - :group 'magit-status - :type 'hook) - -(defcustom magit-status-initial-section '(1) - "The section point is placed on when a status buffer is created. - -When such a buffer is merely being refreshed or being shown again -after it was merely buried, then this option has no effect. - -If this is nil, then point remains on the very first section as -usual. Otherwise it has to be a list of integers and section -identity lists. The members of that list are tried in order -until a matching section is found. - -An integer means to jump to the nth section, 1 for example -jumps over the headings. To get a section's \"identity list\" -use \\[universal-argument] \\[magit-describe-section-briefly]. - -If, for example, you want to jump to the commits that haven't -been pulled from the upstream, or else the second section, then -use: (((unpulled . \"..@{upstream}\") (status)) 1). - -See option `magit-section-initial-visibility-alist' for how to -control the initial visibility of the jumped to section." - :package-version '(magit . "2.90.0") - :group 'magit-status - :type '(choice (const :tag "as usual" nil) - (repeat (choice (number :tag "nth top-level section") - (sexp :tag "section identity"))))) - -(defcustom magit-status-goto-file-position nil - "Whether to go to position corresponding to file position. - -If this is non-nil and the current buffer is visiting a file, -then `magit-status' tries to go to the position in the status -buffer that corresponds to the position in the file-visiting -buffer. This jumps into either the diff of unstaged changes -or the diff of staged changes. - -If the previously current buffer does not visit a file, or if -the file has neither unstaged nor staged changes then this has -no effect. - -The command `magit-status-here' tries to go to that position, -regardless of the value of this option." - :package-version '(magit . "3.0.0") - :group 'magit-status - :type 'boolean) - -(defcustom magit-status-show-hashes-in-headers nil - "Whether headers in the status buffer show hashes. -The functions which respect this option are -`magit-insert-head-branch-header', -`magit-insert-upstream-branch-header', and -`magit-insert-push-branch-header'." - :package-version '(magit . "2.4.0") - :group 'magit-status - :type 'boolean) - -(defcustom magit-status-margin - (list nil - (nth 1 magit-log-margin) - 'magit-log-margin-width nil - (nth 4 magit-log-margin)) - "Format of the margin in `magit-status-mode' buffers. - -The value has the form (INIT STYLE WIDTH AUTHOR AUTHOR-WIDTH). - -If INIT is non-nil, then the margin is shown initially. -STYLE controls how to format the author or committer date. - It can be one of `age' (to show the age of the commit), - `age-abbreviated' (to abbreviate the time unit to a character), - or a string (suitable for `format-time-string') to show the - actual date. Option `magit-log-margin-show-committer-date' - controls which date is being displayed. -WIDTH controls the width of the margin. This exists for forward - compatibility and currently the value should not be changed. -AUTHOR controls whether the name of the author is also shown by - default. -AUTHOR-WIDTH has to be an integer. When the name of the author - is shown, then this specifies how much space is used to do so." - :package-version '(magit . "2.9.0") - :group 'magit-status - :group 'magit-margin - :type magit-log-margin--custom-type - :initialize #'magit-custom-initialize-reset - :set-after '(magit-log-margin) - :set (apply-partially #'magit-margin-set-variable 'magit-status-mode)) - -(defcustom magit-status-use-buffer-arguments 'selected - "Whether `magit-status' reuses arguments when the buffer already exists. - -This option has no effect when merely refreshing the status -buffer using `magit-refresh'. - -Valid values are: - -`always': Always use the set of arguments that is currently - active in the status buffer, provided that buffer exists - of course. -`selected': Use the set of arguments from the status - buffer, but only if it is displayed in a window of the - current frame. This is the default. -`current': Use the set of arguments from the status buffer, - but only if it is the current buffer. -`never': Never use the set of arguments from the status - buffer." - :package-version '(magit . "3.0.0") - :group 'magit-buffers - :group 'magit-commands - :type '(choice - (const :tag "always use args from buffer" always) - (const :tag "use args from buffer if displayed in frame" selected) - (const :tag "use args from buffer if it is current" current) - (const :tag "never use args from buffer" never))) - -;;; Commands - -;;;###autoload -(defun magit-init (directory) - "Initialize a Git repository, then show its status. - -If the directory is below an existing repository, then the user -has to confirm that a new one should be created inside. If the -directory is the root of the existing repository, then the user -has to confirm that it should be reinitialized. - -Non-interactively DIRECTORY is (re-)initialized unconditionally." - (interactive - (let ((directory (file-name-as-directory - (expand-file-name - (read-directory-name "Create repository in: "))))) - (when-let ((toplevel (magit-toplevel directory))) - (setq toplevel (expand-file-name toplevel)) - (unless (y-or-n-p (if (file-equal-p toplevel directory) - (format "Reinitialize existing repository %s? " - directory) - (format "%s is a repository. Create another in %s? " - toplevel directory))) - (user-error "Abort"))) - (list directory))) - ;; `git init' does not understand the meaning of "~"! - (magit-call-git "init" (magit-convert-filename-for-git - (expand-file-name directory))) - (magit-status-setup-buffer directory)) - -;;;###autoload -(defun magit-status (&optional directory cache) - "Show the status of the current Git repository in a buffer. - -If the current directory isn't located within a Git repository, -then prompt for an existing repository or an arbitrary directory, -depending on option `magit-repository-directories', and show the -status of the selected repository instead. - -* If that option specifies any existing repositories, then offer - those for completion and show the status buffer for the - selected one. - -* Otherwise read an arbitrary directory using regular file-name - completion. If the selected directory is the top-level of an - existing working tree, then show the status buffer for that. - -* Otherwise offer to initialize the selected directory as a new - repository. After creating the repository show its status - buffer. - -These fallback behaviors can also be forced using one or more -prefix arguments: - -* With two prefix arguments (or more precisely a numeric prefix - value of 16 or greater) read an arbitrary directory and act on - it as described above. The same could be accomplished using - the command `magit-init'. - -* With a single prefix argument read an existing repository, or - if none can be found based on `magit-repository-directories', - then fall back to the same behavior as with two prefix - arguments." - (interactive - (let ((magit--refresh-cache (list (cons 0 0)))) - (list (and (or current-prefix-arg (not (magit-toplevel))) - (progn (magit--assert-usable-git) - (magit-read-repository - (>= (prefix-numeric-value current-prefix-arg) 16)))) - magit--refresh-cache))) - (let ((magit--refresh-cache (or cache (list (cons 0 0))))) - (if directory - (let ((toplevel (magit-toplevel directory))) - (setq directory (file-name-as-directory - (expand-file-name directory))) - (if (and toplevel (file-equal-p directory toplevel)) - (magit-status-setup-buffer directory) - (when (y-or-n-p - (if toplevel - (format "%s is a repository. Create another in %s? " - toplevel directory) - (format "Create repository in %s? " directory))) - ;; Creating a new repository invalidates cached values. - (setq magit--refresh-cache nil) - (magit-init directory)))) - (magit-status-setup-buffer default-directory)))) - -(put 'magit-status 'interactive-only 'magit-status-setup-buffer) - -;;;###autoload -(defalias 'magit #'magit-status - "Begin using Magit. - -This alias for `magit-status' exists for better discoverability. - -Instead of invoking this alias for `magit-status' using -\"M-x magit RET\", you should bind a key to `magit-status' -and read the info node `(magit)Getting Started', which -also contains other useful hints.") - -;;;###autoload -(defun magit-status-here () - "Like `magit-status' but with non-nil `magit-status-goto-file-position'." - (interactive) - (let ((magit-status-goto-file-position t)) - (call-interactively #'magit-status))) - -(put 'magit-status-here 'interactive-only 'magit-status-setup-buffer) - -;;;###autoload -(defun magit-status-quick () - "Show the status of the current Git repository, maybe without refreshing. - -If the status buffer of the current Git repository exists but -isn't being displayed in the selected frame, then display it -without refreshing it. - -If the status buffer is being displayed in the selected frame, -then also refresh it. - -Prefix arguments have the same meaning as for `magit-status', -and additionally cause the buffer to be refresh. - -To use this function instead of `magit-status', add this to your -init file: (global-set-key (kbd \"C-x g\") \\='magit-status-quick)." - (interactive) - (if-let ((buffer - (and (not current-prefix-arg) - (not (magit-get-mode-buffer 'magit-status-mode nil 'selected)) - (magit-get-mode-buffer 'magit-status-mode)))) - (magit-display-buffer buffer) - (call-interactively #'magit-status))) - -;;; Mode - -(defvar-keymap magit-status-mode-map - :doc "Keymap for `magit-status-mode'." - :parent magit-mode-map - "j" #'magit-status-jump - "<remap> <dired-jump>" #'magit-dired-jump) - -(transient-define-prefix magit-status-jump () - "In a Magit-Status buffer, jump to a section." - ["Jump to" - [("z " "Stashes" magit-jump-to-stashes - :if (lambda () (memq 'magit-insert-stashes magit-status-sections-hook))) - ("t " "Tracked" magit-jump-to-tracked - :if (lambda () (memq 'magit-insert-tracked-files magit-status-sections-hook))) - ("n " "Untracked" magit-jump-to-untracked - :if (lambda () (memq 'magit-insert-untracked-files magit-status-sections-hook))) - ("u " "Unstaged" magit-jump-to-unstaged - :if (lambda () (memq 'magit-insert-unstaged-changes magit-status-sections-hook))) - ("s " "Staged" magit-jump-to-staged - :if (lambda () (memq 'magit-insert-staged-changes magit-status-sections-hook)))] - [("fu" "Unpulled from upstream" magit-jump-to-unpulled-from-upstream - :if (lambda () (memq 'magit-insert-unpulled-from-upstream magit-status-sections-hook))) - ("fp" "Unpulled from pushremote" magit-jump-to-unpulled-from-pushremote - :if (lambda () (memq 'magit-insert-unpulled-from-pushremote magit-status-sections-hook))) - ("pu" magit-jump-to-unpushed-to-upstream - :if (lambda () - (or (memq 'magit-insert-unpushed-to-upstream-or-recent magit-status-sections-hook) - (memq 'magit-insert-unpushed-to-upstream magit-status-sections-hook))) - :description (lambda () - (let ((upstream (magit-get-upstream-branch))) - (if (or (not upstream) - (magit-rev-ancestor-p "HEAD" upstream)) - "Recent commits" - "Unmerged into upstream")))) - ("pp" "Unpushed to pushremote" magit-jump-to-unpushed-to-pushremote - :if (lambda () (memq 'magit-insert-unpushed-to-pushremote magit-status-sections-hook))) - ("a " "Assumed unstaged" magit-jump-to-assume-unchanged - :if (lambda () (memq 'magit-insert-assume-unchanged-files magit-status-sections-hook))) - ("w " "Skip worktree" magit-jump-to-skip-worktree - :if (lambda () (memq 'magit-insert-skip-worktree-files magit-status-sections-hook)))] - [("i" "Using Imenu" imenu)]]) - -(define-derived-mode magit-status-mode magit-mode "Magit" - "Mode for looking at Git status. - -This mode is documented in info node `(magit)Status Buffer'. - -\\<magit-mode-map>\ -Type \\[magit-refresh] to refresh the current buffer. -Type \\[magit-section-toggle] to expand or hide the section at point. -Type \\[magit-visit-thing] to visit the change or commit at point. - -Type \\[magit-dispatch] to invoke major commands. - -Staging and applying changes is documented in info node -`(magit)Staging and Unstaging' and info node `(magit)Applying'. - -\\<magit-hunk-section-map>Type \ -\\[magit-apply] to apply the change at point, \ -\\[magit-stage] to stage, -\\[magit-unstage] to unstage, \ -\\[magit-discard] to discard, or \ -\\[magit-reverse] to reverse it. - -\\<magit-status-mode-map>\ -Type \\[magit-commit] to create a commit. - -\\{magit-status-mode-map}" - :group 'magit-status - (hack-dir-local-variables-non-file-buffer) - (when magit-status-initial-section - (add-hook 'magit-post-create-buffer-hook - #'magit-status-goto-initial-section nil t)) - (setq magit--imenu-group-types '(not branch commit))) - -(put 'magit-status-mode 'magit-diff-default-arguments - '("--no-ext-diff")) -(put 'magit-status-mode 'magit-log-default-arguments - '("-n256" "--decorate")) - -;;;###autoload -(defun magit-status-setup-buffer (&optional directory) - (unless directory - (setq directory default-directory)) - (when (file-remote-p directory) - (magit-git-version-assert)) - (let* ((default-directory directory) - (d (magit-diff--get-value 'magit-status-mode - magit-status-use-buffer-arguments)) - (l (magit-log--get-value 'magit-status-mode - magit-status-use-buffer-arguments)) - (file (and magit-status-goto-file-position - (magit-file-relative-name))) - (line (and file (save-restriction (widen) (line-number-at-pos)))) - (col (and file (save-restriction (widen) (current-column)))) - (buf (magit-setup-buffer #'magit-status-mode nil - (magit-buffer-diff-args (nth 0 d)) - (magit-buffer-diff-files (nth 1 d)) - (magit-buffer-log-args (nth 0 l)) - (magit-buffer-log-files (nth 1 l))))) - (when file - (with-current-buffer buf - (let ((staged (magit-get-section '((staged) (status))))) - (if (and staged - (cadr (magit-diff--locate-hunk file line staged))) - (magit-diff--goto-position file line col staged) - (let ((unstaged (magit-get-section '((unstaged) (status))))) - (unless (and unstaged - (magit-diff--goto-position file line col unstaged)) - (when staged - (magit-diff--goto-position file line col staged)))))))) - buf)) - -(defun magit-status-refresh-buffer () - (magit-git-exit-code "update-index" "--refresh") - (magit-insert-section (status) - (magit-run-section-hook 'magit-status-sections-hook))) - -(defun magit-status-goto-initial-section () - "Jump to the section specified by `magit-status-initial-section'." - (when-let ((section - (--some (if (integerp it) - (nth (1- it) - (magit-section-siblings (magit-current-section) - 'next)) - (magit-get-section it)) - magit-status-initial-section))) - (goto-char (oref section start)) - (when-let ((vis (cdr (assq 'magit-status-initial-section - magit-section-initial-visibility-alist)))) - (if (eq vis 'hide) - (magit-section-hide section) - (magit-section-show section))))) - -(defun magit-status-maybe-update-revision-buffer (&optional _) - "When moving in the status buffer, update the revision buffer. -If there is no revision buffer in the same frame, then do nothing." - (when (derived-mode-p 'magit-status-mode) - (magit--maybe-update-revision-buffer))) - -(defun magit-status-maybe-update-stash-buffer (&optional _) - "When moving in the status buffer, update the stash buffer. -If there is no stash buffer in the same frame, then do nothing." - (when (derived-mode-p 'magit-status-mode) - (magit--maybe-update-stash-buffer))) - -(defun magit-status-maybe-update-blob-buffer (&optional _) - "When moving in the status buffer, update the blob buffer. -If there is no blob buffer in the same frame, then do nothing." - (when (derived-mode-p 'magit-status-mode) - (magit--maybe-update-blob-buffer))) - -;;; Sections -;;;; Special Headers - -(defun magit-insert-status-headers () - "Insert header sections appropriate for `magit-status-mode' buffers. -The sections are inserted by running the functions on the hook -`magit-status-headers-hook'." - (if (magit-rev-verify "HEAD") - (magit-insert-headers 'magit-status-headers-hook) - (insert "In the beginning there was darkness\n\n"))) - -(defvar-keymap magit-error-section-map - :doc "Keymap for `error' sections." - "<remap> <magit-visit-thing>" #'magit-process-buffer - "<1>" (magit-menu-item "Visit process output" #'magit-process-buffer)) - -(defun magit-insert-error-header () - "Insert the message about the Git error that just occurred. - -This function is only aware of the last error that occur when Git -was run for side-effects. If, for example, an error occurs while -generating a diff, then that error won't be inserted. Refreshing -the status buffer causes this section to disappear again." - (when magit-this-error - (magit-insert-section (error 'git) - (insert (propertize (format "%-10s" "GitError! ") - 'font-lock-face 'magit-section-heading)) - (insert (propertize magit-this-error 'font-lock-face 'error)) - (when-let ((key (car (where-is-internal 'magit-process-buffer)))) - (insert (format " [Type `%s' for details]" (key-description key)))) - (insert ?\n)) - (setq magit-this-error nil))) - -(defun magit-insert-diff-filter-header () - "Insert a header line showing the effective diff filters." - (let ((ignore-modules (magit-ignore-submodules-p))) - (when (or ignore-modules - magit-buffer-diff-files) - (insert (propertize (format "%-10s" "Filter! ") - 'font-lock-face 'magit-section-heading)) - (when ignore-modules - (insert ignore-modules) - (when magit-buffer-diff-files - (insert " -- "))) - (when magit-buffer-diff-files - (insert (mapconcat #'identity magit-buffer-diff-files " "))) - (insert ?\n)))) - -;;;; Reference Headers - -(defun magit-insert-head-branch-header (&optional branch) - "Insert a header line about the current branch. -If `HEAD' is detached, then insert information about that commit -instead. The optional BRANCH argument is for internal use only." - (let ((branch (or branch (magit-get-current-branch))) - (output (magit-rev-format "%h %s" (or branch "HEAD")))) - (string-match "^\\([^ ]+\\) \\(.*\\)" output) - (magit-bind-match-strings (commit summary) output - (when (equal summary "") - (setq summary "(no commit message)")) - (if branch - (magit-insert-section (branch branch) - (insert (format "%-10s" "Head: ")) - (when magit-status-show-hashes-in-headers - (insert (propertize commit 'font-lock-face 'magit-hash) ?\s)) - (insert (propertize branch 'font-lock-face 'magit-branch-local)) - (insert ?\s) - (insert (funcall magit-log-format-message-function branch summary)) - (insert ?\n)) - (magit-insert-section (commit commit) - (insert (format "%-10s" "Head: ")) - (insert (propertize commit 'font-lock-face 'magit-hash)) - (insert ?\s) - (insert (funcall magit-log-format-message-function nil summary)) - (insert ?\n)))))) - -(defun magit-insert-upstream-branch-header (&optional branch upstream keyword) - "Insert a header line about the upstream of the current branch. -If no branch is checked out, then insert nothing. The optional -arguments are for internal use only." - (when-let ((branch (or branch (magit-get-current-branch)))) - (let ((remote (magit-get "branch" branch "remote")) - (merge (magit-get "branch" branch "merge")) - (rebase (magit-get "branch" branch "rebase"))) - (when (or remote merge) - (unless upstream - (setq upstream (magit-get-upstream-branch branch))) - (magit-insert-section (branch upstream) - (pcase rebase - ("true") - ("false" (setq rebase nil)) - (_ (setq rebase (magit-get-boolean "pull.rebase")))) - (insert (format "%-10s" (or keyword (if rebase "Rebase: " "Merge: ")))) - (insert - (if upstream - (concat (and magit-status-show-hashes-in-headers - (concat (propertize (magit-rev-format "%h" upstream) - 'font-lock-face 'magit-hash) - " ")) - upstream " " - (funcall magit-log-format-message-function upstream - (funcall magit-log-format-message-function nil - (or (magit-rev-format "%s" upstream) - "(no commit message)")))) - (cond - ((magit--unnamed-upstream-p remote merge) - (concat (propertize merge 'font-lock-face 'magit-branch-remote) - " from " - (propertize remote 'font-lock-face 'bold))) - ((magit--valid-upstream-p remote merge) - (if (equal remote ".") - (concat - (propertize merge 'font-lock-face 'magit-branch-local) " " - (propertize "does not exist" - 'font-lock-face 'magit-branch-warning)) - (format - "%s %s %s" - (propertize merge 'font-lock-face 'magit-branch-remote) - (propertize "does not exist on" - 'font-lock-face 'magit-branch-warning) - (propertize remote 'font-lock-face 'magit-branch-remote)))) - (t - (propertize "invalid upstream configuration" - 'font-lock-face 'magit-branch-warning))))) - (insert ?\n)))))) - -(defun magit-insert-push-branch-header () - "Insert a header line about the branch the current branch is pushed to." - (when-let* ((branch (magit-get-current-branch)) - (target (magit-get-push-branch branch))) - (magit-insert-section (branch target) - (insert (format "%-10s" "Push: ")) - (insert - (if (magit-rev-verify target) - (concat (and magit-status-show-hashes-in-headers - (concat (propertize (magit-rev-format "%h" target) - 'font-lock-face 'magit-hash) - " ")) - target " " - (funcall magit-log-format-message-function target - (funcall magit-log-format-message-function nil - (or (magit-rev-format "%s" target) - "(no commit message)")))) - (let ((remote (magit-get-push-remote branch))) - (if (magit-remote-p remote) - (concat target " " - (propertize "does not exist" - 'font-lock-face 'magit-branch-warning)) - (concat remote " " - (propertize "remote does not exist" - 'font-lock-face 'magit-branch-warning)))))) - (insert ?\n)))) - -(defun magit-insert-tags-header () - "Insert a header line about the current and/or next tag." - (let* ((this-tag (magit-get-current-tag nil t)) - (next-tag (magit-get-next-tag nil t)) - (this-cnt (cadr this-tag)) - (next-cnt (cadr next-tag)) - (this-tag (car this-tag)) - (next-tag (car next-tag)) - (both-tags (and this-tag next-tag t))) - (when (or this-tag next-tag) - (magit-insert-section (tag (or this-tag next-tag)) - (insert (format "%-10s" (if both-tags "Tags: " "Tag: "))) - (cl-flet ((insert-count (tag count face) - (insert (concat (propertize tag 'font-lock-face 'magit-tag) - (and (> count 0) - (format " (%s)" - (propertize - (format "%s" count) - 'font-lock-face face))))))) - (when this-tag (insert-count this-tag this-cnt 'magit-branch-local)) - (when both-tags (insert ", ")) - (when next-tag (insert-count next-tag next-cnt 'magit-tag))) - (insert ?\n))))) - -;;;; Auxiliary Headers - -(defun magit-insert-user-header () - "Insert a header line about the current user." - (let ((name (magit-get "user.name")) - (email (magit-get "user.email"))) - (when (and name email) - (magit-insert-section (user name) - (insert (format "%-10s" "User: ")) - (insert (propertize name 'font-lock-face 'magit-log-author)) - (insert " <" email ">\n"))))) - -(defun magit-insert-repo-header () - "Insert a header line showing the path to the repository top-level." - (let ((topdir (magit-toplevel))) - (magit-insert-section (repo topdir) - (insert (format "%-10s%s\n" "Repo: " (abbreviate-file-name topdir)))))) - -(defun magit-insert-remote-header () - "Insert a header line about the remote of the current branch. - -If no remote is configured for the current branch, then fall back -showing the \"origin\" remote, or if that does not exist the first -remote in alphabetic order." - (when-let* ((name (magit-get-some-remote)) - ;; Under certain configurations it's possible for - ;; url to be nil, when name is not, see #2858. - (url (magit-get "remote" name "url"))) - (magit-insert-section (remote name) - (insert (format "%-10s" "Remote: ")) - (insert (propertize name 'font-lock-face 'magit-branch-remote) ?\s) - (insert url ?\n)))) - -;;;; File Sections - -(defvar-keymap magit-untracked-section-map - :doc "Keymap for the `untracked' section." - "<remap> <magit-delete-thing>" #'magit-discard - "<remap> <magit-stage-file>" #'magit-stage - "<2>" (magit-menu-item "Discard files" #'magit-discard) - "<1>" (magit-menu-item "Stage files" #'magit-stage)) - -(magit-define-section-jumper magit-jump-to-untracked - "Untracked files" untracked) - -(defun magit-insert-untracked-files () - "Maybe insert a list or tree of untracked files. - -Do so depending on the value of `status.showUntrackedFiles'. -Note that even if the value is `all', Magit still initially -only shows directories. But the directory sections can then -be expanded using \"TAB\". - -If the first element of `magit-buffer-diff-files' is a -directory, then limit the list to files below that. The value -value of that variable can be set using \"D -- DIRECTORY RET g\"." - (let* ((show (or (magit-get "status.showUntrackedFiles") "normal")) - (base (car magit-buffer-diff-files)) - (base (and base (file-directory-p base) base))) - (unless (equal show "no") - (if (equal show "all") - (when-let ((files (magit-untracked-files nil base))) - (magit-insert-section (untracked) - (magit-insert-heading "Untracked files:") - (magit-insert-files files base) - (insert ?\n))) - (when-let ((files - (--mapcat (and (eq (aref it 0) ??) - (list (substring it 3))) - (magit-git-items "status" "-z" "--porcelain" - (magit-ignore-submodules-p t) - "--" base)))) - (magit-insert-section (untracked) - (magit-insert-heading "Untracked files:") - (dolist (file files) - (magit-insert-section (file file) - (insert (propertize file 'font-lock-face 'magit-filename) ?\n))) - (insert ?\n))))))) - -(magit-define-section-jumper magit-jump-to-tracked "Tracked files" tracked) - -(defun magit-insert-tracked-files () - "Insert a tree of tracked files. - -If the first element of `magit-buffer-diff-files' is a -directory, then limit the list to files below that. The value -value of that variable can be set using \"D -- DIRECTORY RET g\"." - (when-let ((files (magit-list-files))) - (let* ((base (car magit-buffer-diff-files)) - (base (and base (file-directory-p base) base))) - (magit-insert-section (tracked nil t) - (magit-insert-heading "Tracked files:") - (magit-insert-files files base) - (insert ?\n))))) - -(defun magit-insert-ignored-files () - "Insert a tree of ignored files. - -If the first element of `magit-buffer-diff-files' is a -directory, then limit the list to files below that. The value -of that variable can be set using \"D -- DIRECTORY RET g\"." - (when-let ((files (magit-ignored-files))) - (let* ((base (car magit-buffer-diff-files)) - (base (and base (file-directory-p base) base))) - (magit-insert-section (tracked nil t) - (magit-insert-heading "Ignored files:") - (magit-insert-files files base) - (insert ?\n))))) - -(magit-define-section-jumper magit-jump-to-skip-worktree - "Skip-worktree files" skip-worktree) - -(defun magit-insert-skip-worktree-files () - "Insert a tree of skip-worktree files. - -If the first element of `magit-buffer-diff-files' is a -directory, then limit the list to files below that. The value -of that variable can be set using \"D -- DIRECTORY RET g\"." - (when-let ((files (magit-skip-worktree-files))) - (let* ((base (car magit-buffer-diff-files)) - (base (and base (file-directory-p base) base))) - (magit-insert-section (skip-worktree nil t) - (magit-insert-heading "Skip-worktree files:") - (magit-insert-files files base) - (insert ?\n))))) - -(magit-define-section-jumper magit-jump-to-assume-unchanged - "Assume-unchanged files" assume-unchanged) - -(defun magit-insert-assume-unchanged-files () - "Insert a tree of files that are assumed to be unchanged. - -If the first element of `magit-buffer-diff-files' is a -directory, then limit the list to files below that. The value -of that variable can be set using \"D -- DIRECTORY RET g\"." - (when-let ((files (magit-assume-unchanged-files))) - (let* ((base (car magit-buffer-diff-files)) - (base (and base (file-directory-p base) base))) - (magit-insert-section (assume-unchanged nil t) - (magit-insert-heading "Assume-unchanged files:") - (magit-insert-files files base) - (insert ?\n))))) - -(defun magit-insert-files (files directory) - (while (and files (string-prefix-p (or directory "") (car files))) - (let ((dir (file-name-directory (car files)))) - (if (equal dir directory) - (let ((file (pop files))) - (magit-insert-section (file file) - (insert (propertize file 'font-lock-face 'magit-filename) ?\n))) - (magit-insert-section (file dir t) - (insert (propertize dir 'file 'magit-filename) ?\n) - (magit-insert-heading) - (setq files (magit-insert-files files dir)))))) - files) - -;;; _ -(provide 'magit-status) -;;; magit-status.el ends here diff --git a/emacs/elpa/magit-20240622.1531/magit-status.elc b/emacs/elpa/magit-20240622.1531/magit-status.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/magit-submodule.el b/emacs/elpa/magit-20240622.1531/magit-submodule.el @@ -1,720 +0,0 @@ -;;; magit-submodule.el --- Submodule support for Magit -*- lexical-binding:t -*- - -;; Copyright (C) 2008-2024 The Magit Project Contributors - -;; Author: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> -;; Maintainer: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> - -;; SPDX-License-Identifier: GPL-3.0-or-later - -;; 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. -;; -;; 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 Magit. If not, see <https://www.gnu.org/licenses/>. - -;;; Code: - -(require 'magit) - -(defvar x-stretch-cursor) - -;;; Options - -(defcustom magit-module-sections-hook - '(magit-insert-modules-overview - magit-insert-modules-unpulled-from-upstream - magit-insert-modules-unpulled-from-pushremote - magit-insert-modules-unpushed-to-upstream - magit-insert-modules-unpushed-to-pushremote) - "Hook run by `magit-insert-modules'. - -That function isn't part of `magit-status-sections-hook's default -value, so you have to add it yourself for this hook to have any -effect." - :package-version '(magit . "2.11.0") - :group 'magit-status - :type 'hook) - -(defcustom magit-module-sections-nested t - "Whether `magit-insert-modules' wraps inserted sections. - -If this is non-nil, then only a single top-level section -is inserted. If it is nil, then all sections listed in -`magit-module-sections-hook' become top-level sections." - :package-version '(magit . "2.11.0") - :group 'magit-status - :type 'boolean) - -(defcustom magit-submodule-list-mode-hook '(hl-line-mode) - "Hook run after entering Magit-Submodule-List mode." - :package-version '(magit . "2.9.0") - :group 'magit-repolist - :type 'hook - :get 'magit-hook-custom-get - :options '(hl-line-mode)) - -(defcustom magit-submodule-list-columns - '(("Path" 25 magit-modulelist-column-path nil) - ("Version" 25 magit-repolist-column-version - ((:sort magit-repolist-version<))) - ("Branch" 20 magit-repolist-column-branch nil) - ("B<U" 3 magit-repolist-column-unpulled-from-upstream - ((:right-align t) - (:sort <))) - ("B>U" 3 magit-repolist-column-unpushed-to-upstream - ((:right-align t) - (:sort <))) - ("B<P" 3 magit-repolist-column-unpulled-from-pushremote - ((:right-align t) - (:sort <))) - ("B>P" 3 magit-repolist-column-unpushed-to-pushremote - ((:right-align t) - (:sort <))) - ("B" 3 magit-repolist-column-branches - ((:right-align t) - (:sort <))) - ("S" 3 magit-repolist-column-stashes - ((:right-align t) - (:sort <)))) - "List of columns displayed by `magit-list-submodules'. - -Each element has the form (HEADER WIDTH FORMAT PROPS). - -HEADER is the string displayed in the header. WIDTH is the width -of the column. FORMAT is a function that is called with one -argument, the repository identification (usually its basename), -and with `default-directory' bound to the toplevel of its working -tree. It has to return a string to be inserted or nil. PROPS is -an alist that supports the keys `:right-align', `:pad-right' and -`:sort'. - -The `:sort' function has a weird interface described in the -docstring of `tabulated-list--get-sort'. Alternatively `<' and -`magit-repolist-version<' can be used as those functions are -automatically replaced with functions that satisfy the interface. -Set `:sort' to nil to inhibit sorting; if unspecified, then the -column is sortable using the default sorter. - -You may wish to display a range of numeric columns using just one -character per column and without any padding between columns, in -which case you should use an appropriate HEADER, set WIDTH to 1, -and set `:pad-right' to 0. \"+\" is substituted for numbers higher -than 9." - :package-version '(magit . "2.8.0") - :group 'magit-repolist - :type `(repeat (list :tag "Column" - (string :tag "Header Label") - (integer :tag "Column Width") - (function :tag "Inserter Function") - (repeat :tag "Properties" - (list (choice :tag "Property" - (const :right-align) - (const :pad-right) - (const :sort) - (symbol)) - (sexp :tag "Value")))))) - -(defcustom magit-submodule-list-sort-key '("Path" . nil) - "Initial sort key for buffer created by `magit-list-submodules'. -If nil, no additional sorting is performed. Otherwise, this -should be a cons cell (NAME . FLIP). NAME is a string matching -one of the column names in `magit-submodule-list-columns'. FLIP, -if non-nil, means to invert the resulting sort." - :package-version '(magit . "3.2.0") - :group 'magit-repolist - :type '(choice (const nil) - (cons (string :tag "Column name") - (boolean :tag "Flip order")))) - -(defvar magit-submodule-list-format-path-functions nil) - -(defcustom magit-submodule-remove-trash-gitdirs nil - "Whether `magit-submodule-remove' offers to trash module gitdirs. - -If this is nil, then that command does not offer to do so unless -a prefix argument is used. When this is t, then it does offer to -do so even without a prefix argument. - -In both cases the action still has to be confirmed unless that is -disabled using the option `magit-no-confirm'. Doing the latter -and also setting this variable to t will lead to tears." - :package-version '(magit . "2.90.0") - :group 'magit-commands - :type 'boolean) - -;;; Popup - -;;;###autoload (autoload 'magit-submodule "magit-submodule" nil t) -(transient-define-prefix magit-submodule () - "Act on a submodule." - :man-page "git-submodule" - ["Arguments" - ("-f" "Force" ("-f" "--force")) - ("-r" "Recursive" "--recursive") - ("-N" "Do not fetch" ("-N" "--no-fetch")) - ("-C" "Checkout tip" "--checkout") - ("-R" "Rebase onto tip" "--rebase") - ("-M" "Merge tip" "--merge") - ("-U" "Use upstream tip" "--remote")] - ["One module actions" - ("a" magit-submodule-add) - ("r" magit-submodule-register) - ("p" magit-submodule-populate) - ("u" magit-submodule-update) - ("s" magit-submodule-synchronize) - ("d" magit-submodule-unpopulate) - ("k" "Remove" magit-submodule-remove)] - ["Populated modules actions" - ("l" "List modules" magit-list-submodules) - ("f" "Fetch modules" magit-fetch-modules)]) - -(defun magit-submodule-arguments (&rest filters) - (--filter (and (member it filters) it) - (transient-args 'magit-submodule))) - -(defclass magit--git-submodule-suffix (transient-suffix) - ()) - -(cl-defmethod transient-format-description ((obj magit--git-submodule-suffix)) - (let ((value (delq nil (mapcar #'transient-infix-value transient--suffixes)))) - (replace-regexp-in-string - "\\[--[^]]+\\]" - (lambda (match) - (format (propertize "[%s]" 'face 'transient-inactive-argument) - (mapconcat (lambda (arg) - (propertize arg 'face - (if (member arg value) - 'transient-argument - 'transient-inactive-argument))) - (save-match-data - (split-string (substring match 1 -1) "|")) - (propertize "|" 'face 'transient-inactive-argument)))) - (cl-call-next-method obj)))) - -;;;###autoload (autoload 'magit-submodule-add "magit-submodule" nil t) -(transient-define-suffix magit-submodule-add (url &optional path name args) - "Add the repository at URL as a module. - -Optional PATH is the path to the module relative to the root of -the superproject. If it is nil, then the path is determined -based on the URL. Optional NAME is the name of the module. If -it is nil, then PATH also becomes the name." - :class 'magit--git-submodule-suffix - :description "Add git submodule add [--force]" - (interactive - (magit-with-toplevel - (let* ((url (magit-read-string-ns "Add submodule (remote url)")) - (path (let ((read-file-name-function - (if (or (eq read-file-name-function 'ido-read-file-name) - (advice-function-member-p - 'ido-read-file-name - read-file-name-function)) - ;; The Ido variant doesn't work properly here. - #'read-file-name-default - read-file-name-function))) - (directory-file-name - (file-relative-name - (read-directory-name - "Add submodules at path: " nil nil nil - (and (string-match "\\([^./]+\\)\\(\\.git\\)?$" url) - (match-string 1 url)))))))) - (list url - (directory-file-name path) - (magit-submodule-read-name-for-path path) - (magit-submodule-arguments "--force"))))) - (magit-submodule-add-1 url path name args)) - -(defun magit-submodule-add-1 (url &optional path name args) - (magit-with-toplevel - (magit-submodule--maybe-reuse-gitdir name path) - (magit-run-git-async "submodule" "add" - (and name (list "--name" name)) - args "--" url path) - (set-process-sentinel - magit-this-process - (lambda (process event) - (when (memq (process-status process) '(exit signal)) - (if (> (process-exit-status process) 0) - (magit-process-sentinel process event) - (process-put process 'inhibit-refresh t) - (magit-process-sentinel process event) - (when (magit-git-version>= "2.12.0") - (magit-call-git "submodule" "absorbgitdirs" path)) - (magit-refresh))))))) - -;;;###autoload -(defun magit-submodule-read-name-for-path (path &optional prefer-short) - (let* ((path (directory-file-name (file-relative-name path))) - (name (file-name-nondirectory path))) - (push (if prefer-short path name) minibuffer-history) - (magit-read-string-ns - "Submodule name" nil (cons 'minibuffer-history 2) - (or (--keep (pcase-let ((`(,var ,val) (split-string it "="))) - (and (equal val path) - (cadr (split-string var "\\.")))) - (magit-git-lines "config" "--list" "-f" ".gitmodules")) - (if prefer-short name path))))) - -;;;###autoload (autoload 'magit-submodule-register "magit-submodule" nil t) -(transient-define-suffix magit-submodule-register (modules) - "Register MODULES. - -With a prefix argument act on all suitable modules. Otherwise, -if the region selects modules, then act on those. Otherwise, if -there is a module at point, then act on that. Otherwise read a -single module from the user." - ;; This command and the underlying "git submodule init" do NOT - ;; "initialize" modules. They merely "register" modules in the - ;; super-projects $GIT_DIR/config file, the purpose of which is to - ;; allow users to change such values before actually initializing - ;; the modules. - :description "Register git submodule init" - (interactive - (list (magit-module-confirm "Register" 'magit-module-no-worktree-p))) - (magit-with-toplevel - (magit-run-git-async "submodule" "init" "--" modules))) - -;;;###autoload (autoload 'magit-submodule-populate "magit-submodule" nil t) -(transient-define-suffix magit-submodule-populate (modules) - "Create MODULES working directories, checking out the recorded commits. - -With a prefix argument act on all suitable modules. Otherwise, -if the region selects modules, then act on those. Otherwise, if -there is a module at point, then act on that. Otherwise read a -single module from the user." - ;; This is the command that actually "initializes" modules. - ;; A module is initialized when it has a working directory, - ;; a gitlink, and a .gitmodules entry. - :description "Populate git submodule update --init" - (interactive - (list (magit-module-confirm "Populate" 'magit-module-no-worktree-p))) - (magit-with-toplevel - (magit-run-git-async "submodule" "update" "--init" "--" modules))) - -;;;###autoload (autoload 'magit-submodule-update "magit-submodule" nil t) -(transient-define-suffix magit-submodule-update (modules args) - "Update MODULES by checking out the recorded commits. - -With a prefix argument act on all suitable modules. Otherwise, -if the region selects modules, then act on those. Otherwise, if -there is a module at point, then act on that. Otherwise read a -single module from the user." - ;; Unlike `git-submodule's `update' command ours can only update - ;; "initialized" modules by checking out other commits but not - ;; "initialize" modules by creating the working directories. - ;; To do the latter we provide the "setup" command. - :class 'magit--git-submodule-suffix - :description "Update git submodule update [--force] [--no-fetch] - [--remote] [--recursive] [--checkout|--rebase|--merge]" - (interactive - (list (magit-module-confirm "Update" 'magit-module-worktree-p) - (magit-submodule-arguments - "--force" "--remote" "--recursive" "--checkout" "--rebase" "--merge" - "--no-fetch"))) - (magit-with-toplevel - (magit-run-git-async "submodule" "update" args "--" modules))) - -;;;###autoload (autoload 'magit-submodule-synchronize "magit-submodule" nil t) -(transient-define-suffix magit-submodule-synchronize (modules args) - "Synchronize url configuration of MODULES. - -With a prefix argument act on all suitable modules. Otherwise, -if the region selects modules, then act on those. Otherwise, if -there is a module at point, then act on that. Otherwise read a -single module from the user." - :class 'magit--git-submodule-suffix - :description "Synchronize git submodule sync [--recursive]" - (interactive - (list (magit-module-confirm "Synchronize" 'magit-module-worktree-p) - (magit-submodule-arguments "--recursive"))) - (magit-with-toplevel - (magit-run-git-async "submodule" "sync" args "--" modules))) - -;;;###autoload (autoload 'magit-submodule-unpopulate "magit-submodule" nil t) -(transient-define-suffix magit-submodule-unpopulate (modules args) - "Remove working directories of MODULES. - -With a prefix argument act on all suitable modules. Otherwise, -if the region selects modules, then act on those. Otherwise, if -there is a module at point, then act on that. Otherwise read a -single module from the user." - ;; Even when a submodule is "uninitialized" (it has no worktree) - ;; the super-project's $GIT_DIR/config may never-the-less set the - ;; module's url. This may happen if you `deinit' and then `init' - ;; to register (NOT initialize). Because the purpose of `deinit' - ;; is to remove the working directory AND to remove the url, this - ;; command does not limit itself to modules that have no working - ;; directory. - :class 'magit--git-submodule-suffix - :description "Unpopulate git submodule deinit [--force]" - (interactive - (list (magit-module-confirm "Unpopulate") - (magit-submodule-arguments "--force"))) - (magit-with-toplevel - (magit-run-git-async "submodule" "deinit" args "--" modules))) - -;;;###autoload -(defun magit-submodule-remove (modules args trash-gitdirs) - "Unregister MODULES and remove their working directories. - -For safety reasons, do not remove the gitdirs and if a module has -uncommitted changes, then do not remove it at all. If a module's -gitdir is located inside the working directory, then move it into -the gitdir of the superproject first. - -With the \"--force\" argument offer to remove dirty working -directories and with a prefix argument offer to delete gitdirs. -Both actions are very dangerous and have to be confirmed. There -are additional safety precautions in place, so you might be able -to recover from making a mistake here, but don't count on it." - (interactive - (list (if-let ((modules (magit-region-values 'magit-module-section t))) - (magit-confirm 'remove-modules nil "Remove %d modules" nil modules) - (list (magit-read-module-path "Remove module"))) - (magit-submodule-arguments "--force") - current-prefix-arg)) - (when (magit-git-version< "2.12.0") - (error "This command requires Git v2.12.0")) - (when magit-submodule-remove-trash-gitdirs - (setq trash-gitdirs t)) - (magit-with-toplevel - (when-let - ((modified - (seq-filter (lambda (module) - (let ((default-directory (file-name-as-directory - (expand-file-name module)))) - (and (cddr (directory-files default-directory)) - (magit-anything-modified-p)))) - modules))) - (if (member "--force" args) - (if (magit-confirm 'remove-dirty-modules - "Remove dirty module %s" - "Remove %d dirty modules" - t modified) - (dolist (module modified) - (let ((default-directory (file-name-as-directory - (expand-file-name module)))) - (magit-git "stash" "push" - "-m" "backup before removal of this module"))) - (setq modules (cl-set-difference modules modified :test #'equal))) - (if (cdr modified) - (message "Omitting %s modules with uncommitted changes: %s" - (length modified) - (mapconcat #'identity modified ", ")) - (message "Omitting module %s, it has uncommitted changes" - (car modified))) - (setq modules (cl-set-difference modules modified :test #'equal)))) - (when modules - (let ((alist - (and trash-gitdirs - (--map (split-string it "\0") - (magit-git-lines "submodule" "foreach" "-q" - "printf \"$sm_path\\0$name\n\""))))) - (magit-git "submodule" "absorbgitdirs" "--" modules) - (magit-git "submodule" "deinit" args "--" modules) - (magit-git "rm" args "--" modules) - (when (and trash-gitdirs - (magit-confirm 'trash-module-gitdirs - "Trash gitdir of module %s" - "Trash gitdirs of %d modules" - t modules)) - (dolist (module modules) - (if-let ((name (cadr (assoc module alist)))) - ;; Disregard if `magit-delete-by-moving-to-trash' - ;; is nil. Not doing so would be too dangerous. - (delete-directory (convert-standard-filename - (expand-file-name - (concat "modules/" name) - (magit-gitdir))) - t t) - (error "BUG: Weird module name and/or path for %s" module))))) - (magit-refresh)))) - -;;; Sections - -;;;###autoload -(defun magit-insert-modules () - "Insert submodule sections. -Hook `magit-module-sections-hook' controls which module sections -are inserted, and option `magit-module-sections-nested' controls -whether they are wrapped in an additional section." - (when-let ((modules (magit-list-module-paths))) - (if magit-module-sections-nested - (magit-insert-section (modules nil t) - (magit-insert-heading - (format "%s (%s)" - (propertize "Modules" - 'font-lock-face 'magit-section-heading) - (length modules))) - (magit-insert-section-body - (magit--insert-modules))) - (magit--insert-modules)))) - -(defun magit--insert-modules (&optional _section) - (magit-run-section-hook 'magit-module-sections-hook)) - -;;;###autoload -(defun magit-insert-modules-overview () - "Insert sections for all modules. -For each section insert the path and the output of `git describe --tags', -or, failing that, the abbreviated HEAD commit hash." - (when-let ((modules (magit-list-module-paths))) - (magit-insert-section (modules nil t) - (magit-insert-heading - (format "%s (%s)" - (propertize "Modules overview" - 'font-lock-face 'magit-section-heading) - (length modules))) - (magit-insert-section-body - (magit--insert-modules-overview))))) - -(defvar magit-modules-overview-align-numbers t) - -(defun magit--insert-modules-overview (&optional _section) - (magit-with-toplevel - (let* ((modules (magit-list-module-paths)) - (path-format (format "%%-%ds " - (min (apply #'max (mapcar #'length modules)) - (/ (window-width) 2)))) - (branch-format (format "%%-%ds " (min 25 (/ (window-width) 3))))) - (dolist (module modules) - (let ((default-directory - (expand-file-name (file-name-as-directory module)))) - (magit-insert-section (module module t) - (insert (propertize (format path-format module) - 'font-lock-face 'magit-diff-file-heading)) - (if (not (file-exists-p ".git")) - (insert "(unpopulated)") - (insert - (format - branch-format - (if-let ((branch (magit-get-current-branch))) - (propertize branch 'font-lock-face 'magit-branch-local) - (propertize "(detached)" 'font-lock-face 'warning)))) - (if-let ((desc (magit-git-string "describe" "--tags"))) - (progn (when (and magit-modules-overview-align-numbers - (string-match-p "\\`[0-9]" desc)) - (insert ?\s)) - (insert (propertize desc 'font-lock-face 'magit-tag))) - (when-let ((abbrev (magit-rev-format "%h"))) - (insert (propertize abbrev 'font-lock-face 'magit-hash))))) - (insert ?\n)))))) - (insert ?\n)) - -(defvar-keymap magit-modules-section-map - :doc "Keymap for `modules' sections." - "<remap> <magit-visit-thing>" #'magit-list-submodules - "<1>" (magit-menu-item "List %t" #'magit-list-submodules)) - -(defvar-keymap magit-module-section-map - :doc "Keymap for `module' sections." - "C-j" #'magit-submodule-visit - "C-<return>" #'magit-submodule-visit - "<remap> <magit-unstage-file>" #'magit-unstage - "<remap> <magit-stage-file>" #'magit-stage - "<remap> <magit-visit-thing>" #'magit-submodule-visit - "<5>" (magit-menu-item "Module commands..." #'magit-submodule) - "<4>" '(menu-item "--") - "<3>" (magit-menu-item "Unstage %T" #'magit-unstage - '(:visible (eq (magit-diff-type) 'staged))) - "<2>" (magit-menu-item "Stage %T" #'magit-stage - '(:visible (eq (magit-diff-type) 'unstaged))) - "<1>" (magit-menu-item "Visit %s" #'magit-submodule-visit)) - -(defun magit-submodule-visit (module &optional other-window) - "Visit MODULE by calling `magit-status' on it. -Offer to initialize MODULE if it's not checked out yet. -With a prefix argument, visit in another window." - (interactive (list (or (magit-section-value-if 'module) - (magit-read-module-path "Visit module")) - current-prefix-arg)) - (magit-with-toplevel - (let ((path (expand-file-name module))) - (cond - ((file-exists-p (expand-file-name ".git" module)) - (magit-diff-visit-directory path other-window)) - ((y-or-n-p (format "Initialize submodule '%s' first?" module)) - (magit-run-git-async "submodule" "update" "--init" "--" module) - (set-process-sentinel - magit-this-process - (lambda (process event) - (let ((magit-process-raise-error t)) - (magit-process-sentinel process event)) - (when (and (eq (process-status process) 'exit) - (= (process-exit-status process) 0)) - (magit-diff-visit-directory path other-window))))) - ((file-exists-p path) - (dired-jump other-window (concat path "/."))))))) - -;;;###autoload -(defun magit-insert-modules-unpulled-from-upstream () - "Insert sections for modules that haven't been pulled from the upstream. -These sections can be expanded to show the respective commits." - (magit--insert-modules-logs "Modules unpulled from @{upstream}" - 'modules-unpulled-from-upstream - "HEAD..@{upstream}")) - -;;;###autoload -(defun magit-insert-modules-unpulled-from-pushremote () - "Insert sections for modules that haven't been pulled from the push-remote. -These sections can be expanded to show the respective commits." - (magit--insert-modules-logs "Modules unpulled from @{push}" - 'modules-unpulled-from-pushremote - "HEAD..@{push}")) - -;;;###autoload -(defun magit-insert-modules-unpushed-to-upstream () - "Insert sections for modules that haven't been pushed to the upstream. -These sections can be expanded to show the respective commits." - (magit--insert-modules-logs "Modules unmerged into @{upstream}" - 'modules-unpushed-to-upstream - "@{upstream}..HEAD")) - -;;;###autoload -(defun magit-insert-modules-unpushed-to-pushremote () - "Insert sections for modules that haven't been pushed to the push-remote. -These sections can be expanded to show the respective commits." - (magit--insert-modules-logs "Modules unpushed to @{push}" - 'modules-unpushed-to-pushremote - "@{push}..HEAD")) - -(defun magit--insert-modules-logs (heading type range) - "For internal use, don't add to a hook." - (unless (magit-ignore-submodules-p) - (when-let ((modules (magit-list-module-paths))) - (magit-insert-section ((eval type) nil t) - (string-match "\\`\\(.+\\) \\([^ ]+\\)\\'" heading) - (magit-insert-heading - (propertize (match-string 1 heading) - 'font-lock-face 'magit-section-heading) - " " - (propertize (match-string 2 heading) - 'font-lock-face 'magit-branch-remote) - ":") - (magit-with-toplevel - (dolist (module modules) - (when (magit-module-worktree-p module) - (let ((default-directory - (expand-file-name (file-name-as-directory module)))) - (when (file-accessible-directory-p default-directory) - (magit-insert-section - ( module module t - :range range) - (magit-insert-heading - (propertize module - 'font-lock-face 'magit-diff-file-heading) - ":") - (let ((pos (point))) - (magit-git-wash - (apply-partially #'magit-log-wash-log 'module) - "-c" "push.default=current" "log" "--oneline" range) - (when (> (point) pos) - (delete-char -1))))))))) - (magit-cancel-section 'if-empty) - (insert ?\n))))) - -;;; List - -;;;###autoload -(defun magit-list-submodules () - "Display a list of the current repository's populated submodules." - (interactive) - (magit-submodule-list-setup magit-submodule-list-columns)) - -(defvar-keymap magit-submodule-list-mode-map - :doc "Local keymap for Magit-Submodule-List mode buffers." - :parent magit-repolist-mode-map) - -(define-derived-mode magit-submodule-list-mode tabulated-list-mode "Modules" - "Major mode for browsing a list of Git submodules." - :group 'magit-repolist-mode - (setq-local x-stretch-cursor nil) - (setq tabulated-list-padding 0) - (add-hook 'tabulated-list-revert-hook #'magit-submodule-list-refresh nil t) - (setq imenu-prev-index-position-function - #'magit-repolist--imenu-prev-index-position) - (setq imenu-extract-index-name-function #'tabulated-list-get-id)) - -(defvar-local magit-submodule-list-predicate nil) - -(defun magit-submodule-list-setup (columns &optional predicate) - (magit-display-buffer - (or (magit-get-mode-buffer 'magit-submodule-list-mode) - (magit-generate-new-buffer 'magit-submodule-list-mode))) - (magit-submodule-list-mode) - (setq-local magit-repolist-columns columns) - (setq-local magit-repolist-sort-key magit-submodule-list-sort-key) - (setq-local magit-submodule-list-predicate predicate) - (magit-repolist-setup-1) - (magit-submodule-list-refresh)) - -(defun magit-submodule-list-refresh () - (setq tabulated-list-entries - (seq-keep - (lambda (module) - (let ((default-directory - (expand-file-name (file-name-as-directory module)))) - (and (file-exists-p ".git") - (or (not magit-submodule-list-predicate) - (funcall magit-submodule-list-predicate module)) - (list module - (vconcat - (mapcar (pcase-lambda (`(,title ,width ,fn ,props)) - (or (funcall fn `((:path ,module) - (:title ,title) - (:width ,width) - ,@props)) - "")) - magit-repolist-columns)))))) - (magit-list-module-paths))) - (message "Listing submodules...") - (tabulated-list-init-header) - (tabulated-list-print t) - (message "Listing submodules...done")) - -(defun magit-modulelist-column-path (spec) - "Insert the relative path of the submodule." - (let ((path (cadr (assq :path spec)))) - (or (run-hook-with-args-until-success - 'magit-submodule-list-format-path-functions path) - path))) - -;;; Utilities - -(defun magit-submodule--maybe-reuse-gitdir (name path) - (let ((gitdir (convert-standard-filename - (expand-file-name (concat "modules/" name) - (magit-gitdir))))) - (when (and (file-exists-p gitdir) - (not (file-exists-p path))) - (pcase (read-char-choice - (concat - gitdir " already exists.\n" - "Type [u] to use the existing gitdir and create the working tree\n" - " [r] to rename the existing gitdir and clone again\n" - " [t] to trash the existing gitdir and clone again\n" - " [C-g] to abort ") - '(?u ?r ?t)) - (?u (magit-submodule--restore-worktree (expand-file-name path) gitdir)) - (?r (rename-file gitdir (concat gitdir "-" - (format-time-string "%F-%T")))) - (?t (delete-directory gitdir t t)))))) - -(defun magit-submodule--restore-worktree (worktree gitdir) - (make-directory worktree t) - (with-temp-file (expand-file-name ".git" worktree) - (insert "gitdir: " (file-relative-name gitdir worktree) "\n")) - (let ((default-directory worktree)) - (magit-call-git "reset" "--hard" "HEAD" "--"))) - -;;; _ -(provide 'magit-submodule) -;;; magit-submodule.el ends here diff --git a/emacs/elpa/magit-20240622.1531/magit-submodule.elc b/emacs/elpa/magit-20240622.1531/magit-submodule.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/magit-worktree.el b/emacs/elpa/magit-20240622.1531/magit-worktree.el @@ -1,207 +0,0 @@ -;;; magit-worktree.el --- Worktree support -*- lexical-binding:t -*- - -;; Copyright (C) 2008-2024 The Magit Project Contributors - -;; Author: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> -;; Maintainer: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> - -;; SPDX-License-Identifier: GPL-3.0-or-later - -;; 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. -;; -;; 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 Magit. If not, see <https://www.gnu.org/licenses/>. - -;;; Commentary: - -;; This library implements support for `git-worktree'. - -;;; Code: - -(require 'magit) - -;;; Options - -(defcustom magit-worktree-read-directory-name-function #'read-directory-name - "Function used to read a directory for worktree commands. -This is called with one argument, the prompt, and can be used -to, e.g., use a base directory other than `default-directory'. -Used by `magit-worktree-checkout' and `magit-worktree-branch'." - :package-version '(magit . "3.0.0") - :group 'magit-commands - :type 'function) - -;;; Commands - -;;;###autoload (autoload 'magit-worktree "magit-worktree" nil t) -(transient-define-prefix magit-worktree () - "Act on a worktree." - :man-page "git-worktree" - [["Create new" - ("b" "worktree" magit-worktree-checkout) - ("c" "branch and worktree" magit-worktree-branch)] - ["Commands" - ("m" "Move worktree" magit-worktree-move) - ("k" "Delete worktree" magit-worktree-delete) - ("g" "Visit worktree" magit-worktree-status)]]) - -;;;###autoload -(defun magit-worktree-checkout (path branch) - "Checkout BRANCH in a new worktree at PATH." - (interactive - (let ((branch (magit-read-branch-or-commit "Checkout"))) - (list (funcall magit-worktree-read-directory-name-function - (format "Checkout %s in new worktree: " branch)) - branch))) - (magit-run-git "worktree" "add" (magit--expand-worktree path) branch) - (magit-diff-visit-directory path)) - -;;;###autoload -(defun magit-worktree-branch (path branch start-point &optional force) - "Create a new BRANCH and check it out in a new worktree at PATH." - (interactive - `(,(funcall magit-worktree-read-directory-name-function - "Create worktree: ") - ,@(magit-branch-read-args "Create and checkout branch") - ,current-prefix-arg)) - (magit-run-git "worktree" "add" (if force "-B" "-b") - branch (magit--expand-worktree path) start-point) - (magit-diff-visit-directory path)) - -;;;###autoload -(defun magit-worktree-move (worktree path) - "Move WORKTREE to PATH." - (interactive - (list (magit-completing-read "Move worktree" - (cdr (magit-list-worktrees)) - nil t nil nil - (magit-section-value-if 'worktree)) - (funcall magit-worktree-read-directory-name-function - "Move worktree to: "))) - (if (file-directory-p (expand-file-name ".git" worktree)) - (user-error "You may not move the main working tree") - (let ((preexisting-directory (file-directory-p path))) - (when (and (zerop (magit-call-git "worktree" "move" worktree - (magit--expand-worktree path))) - (not (file-exists-p default-directory)) - (derived-mode-p 'magit-status-mode)) - (kill-buffer) - (magit-diff-visit-directory - (if preexisting-directory - (concat (file-name-as-directory path) - (file-name-nondirectory worktree)) - path))) - (magit-refresh)))) - -(defun magit-worktree-delete (worktree) - "Delete a worktree, defaulting to the worktree at point. -The primary worktree cannot be deleted." - (interactive - (list (magit-completing-read "Delete worktree" - (cdr (magit-list-worktrees)) - nil t nil nil - (magit-section-value-if 'worktree)))) - (if (file-directory-p (expand-file-name ".git" worktree)) - (user-error "Deleting %s would delete the shared .git directory" worktree) - (let ((primary (file-name-as-directory (caar (magit-list-worktrees))))) - (magit-confirm-files (if magit-delete-by-moving-to-trash 'trash 'delete) - (list "worktree")) - (when (file-exists-p worktree) - (let ((delete-by-moving-to-trash magit-delete-by-moving-to-trash)) - (delete-directory worktree t magit-delete-by-moving-to-trash))) - (if (file-exists-p default-directory) - (magit-run-git "worktree" "prune") - (let ((default-directory primary)) - (magit-run-git "worktree" "prune")) - (when (derived-mode-p 'magit-status-mode) - (kill-buffer) - (magit-status-setup-buffer primary)))))) - -(defun magit-worktree-status (worktree) - "Show the status for the worktree at point. -If there is no worktree at point, then read one in the -minibuffer. If the worktree at point is the one whose -status is already being displayed in the current buffer, -then show it in Dired instead." - (interactive - (list (or (magit-section-value-if 'worktree) - (magit-completing-read - "Show status for worktree" - (cl-delete (directory-file-name (magit-toplevel)) - (magit-list-worktrees) - :test #'equal :key #'car))))) - (magit-diff-visit-directory worktree)) - -(defun magit--expand-worktree (path) - (magit-convert-filename-for-git (expand-file-name path))) - -;;; Sections - -(defvar-keymap magit-worktree-section-map - :doc "Keymap for `worktree' sections." - "<remap> <magit-delete-thing>" #'magit-worktree-delete - "<remap> <magit-visit-thing>" #'magit-worktree-status - "<4>" (magit-menu-item "Worktree commands..." #'magit-worktree) - "<3>" '(menu-item "--") - "<2>" (magit-menu-item "Delete %m" #'magit-worktree-delete) - "<1>" (magit-menu-item "Visit %s" #'magit-worktree-status)) - -(defun magit-insert-worktrees () - "Insert sections for all worktrees. -If there is only one worktree, then insert nothing." - (let ((worktrees (magit-list-worktrees))) - (when (length> worktrees 1) - (magit-insert-section (worktrees) - (magit-insert-heading "Worktrees:") - (let* ((cols - (mapcar - (lambda (config) - (pcase-let ((`(,_ ,commit ,branch ,bare) config)) - (cons (cond - (branch - (propertize - branch 'font-lock-face - (if (equal branch (magit-get-current-branch)) - 'magit-branch-current - 'magit-branch-local))) - (commit - (propertize (magit-rev-abbrev commit) - 'font-lock-face 'magit-hash)) - (bare "(bare)")) - config))) - worktrees)) - (align (1+ (apply #'max (--map (string-width (car it)) cols))))) - (pcase-dolist (`(,head . ,config) cols) - (magit--insert-worktree - config - (concat head (make-string (- align (length head)) ?\s))))) - (insert ?\n))))) - -(defun magit--insert-worktree (config head) - "Insert worktree section for CONFIG. -See `magit-list-worktrees' for the format of CONFIG. HEAD is -a prettified reference or revision representing the worktree, -with padding for alignment." - ;; #4926 Before changing the signature, inform @vermiculus. - (let ((path (car config))) - (magit-insert-section (worktree path) - (insert head) - (insert (let ((relative (file-relative-name path)) - (absolute (abbreviate-file-name path))) - (if (or (> (string-width relative) (string-width absolute)) - (equal relative "./")) - absolute - relative))) - (insert ?\n)))) - -;;; _ -(provide 'magit-worktree) -;;; magit-worktree.el ends here diff --git a/emacs/elpa/magit-20240622.1531/magit-worktree.elc b/emacs/elpa/magit-20240622.1531/magit-worktree.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/AUTHORS.md b/emacs/elpa/magit-20240625.2109/AUTHORS.md diff --git a/emacs/elpa/magit-20240622.1531/LICENSE b/emacs/elpa/magit-20240625.2109/LICENSE diff --git a/emacs/elpa/magit-20240622.1531/dir b/emacs/elpa/magit-20240625.2109/dir diff --git a/emacs/elpa/magit-20240622.1531/git-rebase.el b/emacs/elpa/magit-20240625.2109/git-rebase.el diff --git a/emacs/elpa/magit-20240622.1531/git-rebase.elc b/emacs/elpa/magit-20240625.2109/git-rebase.elc Binary files differ. diff --git a/emacs/elpa/magit-20240625.2109/magit-apply.el b/emacs/elpa/magit-20240625.2109/magit-apply.el @@ -0,0 +1,854 @@ +;;; magit-apply.el --- Apply Git diffs -*- lexical-binding:t -*- + +;; Copyright (C) 2008-2024 The Magit Project Contributors + +;; Author: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> +;; Maintainer: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; 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. +;; +;; 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 Magit. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This library implements commands for applying Git diffs or parts +;; of such a diff. The supported "apply variants" are apply, stage, +;; unstage, discard, and reverse - more than Git itself knows about, +;; at least at the porcelain level. + +;;; Code: + +(require 'magit-core) +(require 'magit-diff) +(require 'magit-wip) + +(require 'transient) ; See #3732. + +;; For `magit-apply' +(declare-function magit-am "magit-sequence" () t) +(declare-function magit-patch-apply "magit-patch" () t) +;; For `magit-discard-files' +(declare-function magit-checkout-stage "magit-merge" (file arg)) +(declare-function magit-checkout-read-stage "magit-merge" (file)) +(defvar auto-revert-verbose) +;; For `magit-stage-untracked' +(declare-function magit-submodule-add-1 "magit-submodule" + (url &optional path name args)) +(declare-function magit-submodule-read-name-for-path "magit-submodule" + (path &optional prefer-short)) +(defvar borg-user-emacs-directory) + +;;; Options + +(defcustom magit-delete-by-moving-to-trash t + "Whether Magit uses the system's trash can. + +You should absolutely not disable this and also remove `discard' +from `magit-no-confirm'. You shouldn't do that even if you have +all of the Magit-Wip modes enabled, because those modes do not +track any files that are not tracked in the proper branch." + :package-version '(magit . "2.1.0") + :group 'magit-essentials + :type 'boolean) + +(defcustom magit-unstage-committed t + "Whether unstaging a committed change reverts it instead. + +A committed change cannot be unstaged, because staging and +unstaging are actions that are concerned with the differences +between the index and the working tree, not with committed +changes. + +If this option is non-nil (the default), then typing \"u\" +\(`magit-unstage') on a committed change, causes it to be +reversed in the index but not the working tree. For more +information see command `magit-reverse-in-index'." + :package-version '(magit . "2.4.1") + :group 'magit-commands + :type 'boolean) + +(defcustom magit-reverse-atomically nil + "Whether to reverse changes atomically. + +If some changes can be reversed while others cannot, then nothing +is reversed if the value of this option is non-nil. But when it +is nil, then the changes that can be reversed are reversed and +for the other changes diff files are created that contain the +rejected reversals." + :package-version '(magit . "2.7.0") + :group 'magit-commands + :type 'boolean) + +(defcustom magit-post-stage-hook nil + "Hook run after staging changes. +This hook is run by `magit-refresh' if `this-command' +is a member of `magit-post-stage-hook-commands'." + :package-version '(magit . "2.90.0") + :group 'magit-commands + :type 'hook) + +(defcustom magit-post-unstage-hook nil + "Hook run after unstaging changes. +This hook is run by `magit-refresh' if `this-command' +is a member of `magit-post-unstage-hook-commands'." + :package-version '(magit . "2.90.0") + :group 'magit-commands + :type 'hook) + +;;; Commands +;;;; Apply + +(defun magit-apply (&rest args) + "Apply the change at point to the working tree. +With a prefix argument fallback to a 3-way merge. Doing +so causes the change to be applied to the index as well." + (interactive (and current-prefix-arg (list "--3way"))) + (when-let ((s (magit-apply--get-selection))) + (pcase (list (magit-diff-type) (magit-diff-scope)) + (`(,(or 'unstaged 'staged) ,_) + (user-error "Change is already in the working tree")) + (`(untracked ,(or 'file 'files)) + (call-interactively #'magit-am)) + (`(,_ region) (magit-apply-region s args)) + (`(,_ hunk) (magit-apply-hunk s args)) + (`(,_ hunks) (magit-apply-hunks s args)) + (`(rebase-sequence file) + (call-interactively #'magit-patch-apply)) + (`(,_ file) (magit-apply-diff s args)) + (`(,_ files) (magit-apply-diffs s args))))) + +(defun magit-apply--section-content (section) + (buffer-substring-no-properties (if (magit-hunk-section-p section) + (oref section start) + (oref section content)) + (oref section end))) + +(defun magit-apply-diffs (sections &rest args) + (setq sections (magit-apply--get-diffs sections)) + (magit-apply-patch sections args + (mapconcat + (lambda (s) + (concat (magit-diff-file-header s) + (magit-apply--section-content s))) + sections ""))) + +(defun magit-apply-diff (section &rest args) + (setq section (car (magit-apply--get-diffs (list section)))) + (magit-apply-patch section args + (concat (magit-diff-file-header section) + (magit-apply--section-content section)))) + +(defun magit-apply--adjust-hunk-new-starts (hunks) + "Adjust new line numbers in headers of HUNKS for partial application. +HUNKS should be a list of ordered, contiguous hunks to be applied +from a file. For example, if there is a sequence of hunks with +the headers + + @@ -2,6 +2,7 @@ + @@ -10,6 +11,7 @@ + @@ -18,6 +20,7 @@ + +and only the second and third are to be applied, they would be +adjusted as \"@@ -10,6 +10,7 @@\" and \"@@ -18,6 +19,7 @@\"." + (let* ((first-hunk (car hunks)) + (offset (if (string-match diff-hunk-header-re-unified first-hunk) + (- (string-to-number (match-string 3 first-hunk)) + (string-to-number (match-string 1 first-hunk))) + (error "Header hunks have to be applied individually")))) + (if (= offset 0) + hunks + (mapcar (lambda (hunk) + (if (string-match diff-hunk-header-re-unified hunk) + (replace-match (number-to-string + (- (string-to-number (match-string 3 hunk)) + offset)) + t t hunk 3) + (error "Hunk does not have expected header"))) + hunks)))) + +(defun magit-apply--adjust-hunk-new-start (hunk) + (car (magit-apply--adjust-hunk-new-starts (list hunk)))) + +(defun magit-apply-hunks (hunks &rest args) + (let ((file (oref (car hunks) parent))) + (when (magit-diff--combined-p file) + (user-error "Cannot un-/stage resolution hunks. Stage the whole file")) + (magit-apply-patch + file args + (concat (oref file header) + (string-join (magit-apply--adjust-hunk-new-starts + (mapcar #'magit-apply--section-content hunks))))))) + +(defun magit-apply-hunk (hunk &rest args) + (let ((file (oref hunk parent))) + (when (magit-diff--combined-p file) + (user-error "Cannot un-/stage resolution hunks. Stage the whole file")) + (let* ((header (car (oref hunk value))) + (header (and (symbolp header) header)) + (content (magit-apply--section-content hunk))) + (magit-apply-patch + file args + (concat (magit-diff-file-header hunk (not (eq header 'rename))) + (if header + content + (magit-apply--adjust-hunk-new-start content))))))) + +(defun magit-apply-region (hunk &rest args) + (let ((file (oref hunk parent))) + (when (magit-diff--combined-p file) + (user-error "Cannot un-/stage resolution hunks. Stage the whole file")) + (magit-apply-patch + file args + (concat (magit-diff-file-header hunk) + (magit-apply--adjust-hunk-new-start + (magit-diff-hunk-region-patch hunk args)))))) + +(defun magit-apply-patch (section:s args patch) + (let* ((files (if (atom section:s) + (list (oref section:s value)) + (--map (oref it value) section:s))) + (command (symbol-name this-command)) + (command (if (and command (string-match "^magit-\\([^-]+\\)" command)) + (match-string 1 command) + "apply")) + (ignore-context (magit-diff-ignore-any-space-p))) + (unless (magit-diff-context-p) + (user-error "Not enough context to apply patch. Increase the context")) + (when (and magit-wip-before-change-mode (not magit-inhibit-refresh)) + (magit-wip-commit-before-change files (concat " before " command))) + (with-temp-buffer + (insert patch) + (magit-run-git-with-input + "apply" args "-p0" + (and ignore-context "-C0") + "--ignore-space-change" "-")) + (unless magit-inhibit-refresh + (when magit-wip-after-apply-mode + (magit-wip-commit-after-apply files (concat " after " command))) + (magit-refresh)))) + +(defun magit-apply--get-selection () + (or (magit-region-sections '(hunk file module) t) + (let ((section (magit-current-section))) + (pcase (oref section type) + ((or 'hunk 'file 'module) section) + ((or 'staged 'unstaged 'untracked + 'stashed-index 'stashed-worktree 'stashed-untracked) + (oref section children)) + (_ (user-error "Cannot apply this, it's not a change")))))) + +(defun magit-apply--get-diffs (sections) + (magit-section-case + ([file diffstat] + (--map (or (magit-get-section + (append `((file . ,(oref it value))) + (magit-section-ident magit-root-section))) + (error "Cannot get required diff headers")) + sections)) + (t sections))) + +(defun magit-apply--ignore-whitespace-p (selection type scope) + "Return t if it is necessary and possible to ignore whitespace. +It is necessary to do so when the diff ignores whitespace changes +and whole files are being applied. It is possible when no binary +files are involved. If it is both necessary and impossible, then +return nil, possibly causing whitespace changes to be applied." + (and (memq type '(unstaged staged)) + (memq scope '(file files list)) + (cl-find-if (lambda (arg) + (member arg '("--ignore-space-at-eol" + "--ignore-space-change" + "--ignore-all-space" + "--ignore-blank-lines"))) + magit-buffer-diff-args) + (not (cl-find-if (lambda (section) + (oref section binary)) + (ensure-list selection))))) + +;;;; Stage + +(defun magit-stage (&optional intent) + "Add the change at point to the staging area. +With a prefix argument, INTENT, and an untracked file (or files) +at point, stage the file but not its content." + (interactive "P") + (if-let ((s (and (derived-mode-p 'magit-mode) + (magit-apply--get-selection))) + (type (magit-diff-type)) + (scope (magit-diff-scope))) + (pcase (list type scope + (magit-apply--ignore-whitespace-p s type scope)) + (`(untracked ,_ ,_) (magit-stage-untracked intent)) + (`(unstaged region ,_) (magit-apply-region s "--cached")) + (`(unstaged hunk ,_) (magit-apply-hunk s "--cached")) + (`(unstaged hunks ,_) (magit-apply-hunks s "--cached")) + ('(unstaged file t) (magit-apply-diff s "--cached")) + ('(unstaged files t) (magit-apply-diffs s "--cached")) + ('(unstaged list t) (magit-apply-diffs s "--cached")) + ('(unstaged file nil) (magit-stage-1 "-u" (list (oref s value)))) + ('(unstaged files nil) (magit-stage-1 "-u" (magit-region-values nil t))) + ('(unstaged list nil) (magit-stage-modified)) + (`(staged ,_ ,_) (user-error "Already staged")) + (`(committed ,_ ,_) (user-error "Cannot stage committed changes")) + (`(undefined ,_ ,_) (user-error "Cannot stage this change"))) + (call-interactively #'magit-stage-file))) + +;;;###autoload +(defun magit-stage-buffer-file () + "Stage all changes to the file being visited in the current buffer." + (interactive) + (unless buffer-file-name + (user-error "Not visiting a file")) + (magit-with-toplevel + (magit-stage-1 (and (magit-file-ignored-p buffer-file-name) + (if (y-or-n-p "Visited file is ignored; stage anyway?") + "--force" + (user-error "Abort"))) + (list (magit-file-relative-name))))) + +;;;###autoload +(defun magit-stage-file (files &optional force) + "Read one or more files and stage all changes in those files. +With prefix argument FORCE, offer ignored files for completion." + (interactive + (let* ((choices (if current-prefix-arg + (magit-ignored-files) + (nconc (magit-unstaged-files) + (magit-untracked-files)))) + (default (or (magit-section-value-if 'file) + (magit-file-relative-name))) + (default (car (member default choices)))) + (list (magit-completing-read-multiple + (if current-prefix-arg "Stage ignored file,s: " "Stage file,s: ") + choices nil t nil nil default) + current-prefix-arg))) + (magit-with-toplevel + ;; For backward compatibility, and because of + ;; the function's name, don't require a list. + (magit-stage-1 (and force "--force") + (if (listp files) files (list files))))) + +;;;###autoload +(defun magit-stage-modified (&optional all) + "Stage all changes to files modified in the worktree. +Stage all new content of tracked files and remove tracked files +that no longer exist in the working tree from the index also. +With a prefix argument also stage previously untracked (but not +ignored) files." + (interactive "P") + (when (magit-anything-staged-p) + (magit-confirm 'stage-all-changes)) + (magit-with-toplevel + (magit-stage-1 (if all "--all" "-u") magit-buffer-diff-files))) + +(defun magit-stage-1 (arg &optional files) + (magit-wip-commit-before-change files " before stage") + (magit-run-git "add" arg (if files (cons "--" files) ".")) + (when magit-auto-revert-mode + (mapc #'magit-turn-on-auto-revert-mode-if-desired files)) + (magit-wip-commit-after-apply files " after stage")) + +(defun magit-stage-untracked (&optional intent) + (let* ((section (magit-current-section)) + (files (pcase (magit-diff-scope) + ('file (list (oref section value))) + ('files (magit-region-values nil t)) + ('list (magit-untracked-files)))) + plain repos) + (dolist (file files) + (if (and (not (file-symlink-p file)) + (magit-git-repo-p file t)) + (push file repos) + (push file plain))) + (magit-wip-commit-before-change files " before stage") + (when plain + (magit-run-git "add" (and intent "--intent-to-add") + "--" plain) + (when magit-auto-revert-mode + (mapc #'magit-turn-on-auto-revert-mode-if-desired plain))) + (dolist (repo repos) + (save-excursion + (goto-char (oref (magit-get-section + `((file . ,repo) (untracked) (status))) + start)) + (when (and (fboundp 'borg-assimilate) + (fboundp 'borg--maybe-absorb-gitdir) + (fboundp 'borg--sort-submodule-sections)) + (let* ((topdir (magit-toplevel)) + (url (let ((default-directory + (file-name-as-directory (expand-file-name repo)))) + (or (magit-get "remote" (magit-get-some-remote) "url") + (concat (file-name-as-directory ".") repo)))) + (package + (and (equal borg-user-emacs-directory topdir) + (file-name-nondirectory (directory-file-name repo))))) + (if (and package + (y-or-n-p (format "Also assimilate `%s' drone?" package))) + (borg-assimilate package url) + (magit-submodule-add-1 + url repo (magit-submodule-read-name-for-path repo package)) + (when package + (borg--sort-submodule-sections + (expand-file-name ".gitmodules" topdir)) + (let ((default-directory borg-user-emacs-directory)) + (borg--maybe-absorb-gitdir package)))))))) + (magit-wip-commit-after-apply files " after stage"))) + +(defvar magit-post-stage-hook-commands + '(magit-stage + magit-stage-buffer-file + magit-stage-file + magit-stage-modified)) + +(defun magit-run-post-stage-hook () + (when (memq this-command magit-post-stage-hook-commands) + (magit-run-hook-with-benchmark 'magit-post-stage-hook))) + +;;;; Unstage + +(defun magit-unstage () + "Remove the change at point from the staging area." + (interactive) + (when-let ((s (magit-apply--get-selection)) + (type (magit-diff-type)) + (scope (magit-diff-scope))) + (pcase (list type scope + (magit-apply--ignore-whitespace-p s type scope)) + (`(untracked ,_ ,_) (user-error "Cannot unstage untracked changes")) + (`(unstaged file ,_) (magit-unstage-intent (list (oref s value)))) + (`(unstaged files ,_) (magit-unstage-intent (magit-region-values nil t))) + (`(unstaged ,_ ,_) (user-error "Already unstaged")) + (`(staged region ,_) (magit-apply-region s "--reverse" "--cached")) + (`(staged hunk ,_) (magit-apply-hunk s "--reverse" "--cached")) + (`(staged hunks ,_) (magit-apply-hunks s "--reverse" "--cached")) + ('(staged file t) (magit-apply-diff s "--reverse" "--cached")) + ('(staged files t) (magit-apply-diffs s "--reverse" "--cached")) + ('(staged list t) (magit-apply-diffs s "--reverse" "--cached")) + ('(staged file nil) (magit-unstage-1 (list (oref s value)))) + ('(staged files nil) (magit-unstage-1 (magit-region-values nil t))) + ('(staged list nil) (magit-unstage-all)) + (`(committed ,_ ,_) (if magit-unstage-committed + (magit-reverse-in-index) + (user-error "Cannot unstage committed changes"))) + (`(undefined ,_ ,_) (user-error "Cannot unstage this change"))))) + +;;;###autoload +(defun magit-unstage-buffer-file () + "Unstage all changes to the file being visited in the current buffer." + (interactive) + (unless buffer-file-name + (user-error "Not visiting a file")) + (magit-with-toplevel + (magit-unstage-1 (list (magit-file-relative-name))))) + +;;;###autoload +(defun magit-unstage-file (files) + "Read one or more files and unstage all changes to those files." + (interactive + (let* ((choices (magit-staged-files)) + (default (or (magit-section-value-if 'file) + (magit-file-relative-name))) + (default (car (member default choices)))) + (list (magit-completing-read-multiple "Unstage file,s: " choices + nil t nil nil default)))) + (magit-with-toplevel + ;; For backward compatibility, and because of + ;; the function's name, don't require a list. + (magit-unstage-1 (if (listp files) files (list files))))) + +(defun magit-unstage-1 (files) + (magit-wip-commit-before-change files " before unstage") + (if (magit-no-commit-p) + (magit-run-git "rm" "--cached" "--" files) + (magit-run-git "reset" "HEAD" "--" files)) + (magit-wip-commit-after-apply files " after unstage")) + +(defun magit-unstage-intent (files) + (if-let ((staged (magit-staged-files)) + (intent (--filter (member it staged) files))) + (magit-unstage-1 intent) + (user-error "Already unstaged"))) + +;;;###autoload +(defun magit-unstage-all () + "Remove all changes from the staging area." + (interactive) + (unless (magit-anything-staged-p) + (user-error "Nothing to unstage")) + (when (or (magit-anything-unstaged-p) + (magit-untracked-files)) + (magit-confirm 'unstage-all-changes)) + (magit-wip-commit-before-change nil " before unstage") + (magit-run-git "reset" "HEAD" "--" magit-buffer-diff-files) + (magit-wip-commit-after-apply nil " after unstage")) + +(defvar magit-post-unstage-hook-commands + '(magit-unstage + magit-unstage-buffer-file + magit-unstage-file + magit-unstage-all)) + +(defun magit-run-post-unstage-hook () + (when (memq this-command magit-post-unstage-hook-commands) + (magit-run-hook-with-benchmark 'magit-post-unstage-hook))) + +;;;; Discard + +(defun magit-discard () + "Remove the change at point. + +On a hunk or file with unresolved conflicts prompt which side to +keep (while discarding the other). If point is within the text +of a side, then keep that side without prompting." + (interactive) + (when-let ((s (magit-apply--get-selection))) + (pcase (list (magit-diff-type) (magit-diff-scope)) + (`(committed ,_) (user-error "Cannot discard committed changes")) + (`(undefined ,_) (user-error "Cannot discard this change")) + (`(,_ region) (magit-discard-region s)) + (`(,_ hunk) (magit-discard-hunk s)) + (`(,_ hunks) (magit-discard-hunks s)) + (`(,_ file) (magit-discard-file s)) + (`(,_ files) (magit-discard-files s)) + (`(,_ list) (magit-discard-files s))))) + +(defun magit-discard-region (section) + (magit-confirm 'discard "Discard region") + (magit-discard-apply section 'magit-apply-region)) + +(defun magit-discard-hunk (section) + (magit-confirm 'discard "Discard hunk") + (let ((file (magit-section-parent-value section))) + (pcase (cddr (car (magit-file-status file))) + ('(?U ?U) (magit-smerge-keep-current)) + (_ (magit-discard-apply section #'magit-apply-hunk))))) + +(defun magit-discard-apply (section apply) + (if (eq (magit-diff-type section) 'unstaged) + (funcall apply section "--reverse") + (if (magit-anything-unstaged-p + nil (if (magit-file-section-p section) + (oref section value) + (magit-section-parent-value section))) + (progn (let ((magit-inhibit-refresh t)) + (funcall apply section "--reverse" "--cached") + (funcall apply section "--reverse" "--reject")) + (magit-refresh)) + (funcall apply section "--reverse" "--index")))) + +(defun magit-discard-hunks (sections) + (magit-confirm 'discard (format "Discard %s hunks from %s" + (length sections) + (magit-section-parent-value (car sections)))) + (magit-discard-apply-n sections #'magit-apply-hunks)) + +(defun magit-discard-apply-n (sections apply) + (let ((section (car sections))) + (if (eq (magit-diff-type section) 'unstaged) + (funcall apply sections "--reverse") + (if (magit-anything-unstaged-p + nil (if (magit-file-section-p section) + (oref section value) + (magit-section-parent-value section))) + (progn (let ((magit-inhibit-refresh t)) + (funcall apply sections "--reverse" "--cached") + (funcall apply sections "--reverse" "--reject")) + (magit-refresh)) + (funcall apply sections "--reverse" "--index"))))) + +(defun magit-discard-file (section) + (magit-discard-files (list section))) + +(defun magit-discard-files (sections) + (let ((auto-revert-verbose nil) + (type (magit-diff-type (car sections))) + (status (magit-file-status)) + files delete resurrect rename discard discard-new resolve) + (dolist (section sections) + (let ((file (oref section value))) + (push file files) + (pcase (cons (pcase type + (`staged ?X) + (`unstaged ?Y) + (`untracked ?Z)) + (cddr (assoc file status))) + ('(?Z) (dolist (f (magit-untracked-files nil file)) + (push f delete))) + ((or '(?Z ?? ??) '(?Z ?! ?!)) (push file delete)) + ('(?Z ?D ? ) (push file delete)) + (`(,_ ?D ?D) (push file resolve)) + ((or `(,_ ?U ,_) `(,_ ,_ ?U)) (push file resolve)) + (`(,_ ?A ?A) (push file resolve)) + (`(?X ?M ,(or ? ?M ?D)) (push section discard)) + (`(?Y ,_ ?M ) (push section discard)) + ('(?X ?A ?M ) (push file discard-new)) + ('(?X ?C ?M ) (push file discard-new)) + (`(?X ?A ,(or ? ?D)) (push file delete)) + (`(?X ?C ,(or ? ?D)) (push file delete)) + (`(?X ?D ,(or ? ?M )) (push file resurrect)) + (`(?Y ,_ ?D ) (push file resurrect)) + (`(?X ?R ,(or ? ?M ?D)) (push file rename))))) + (unwind-protect + (let ((magit-inhibit-refresh t)) + (magit-wip-commit-before-change files " before discard") + (when resolve + (magit-discard-files--resolve (nreverse resolve))) + (when resurrect + (magit-discard-files--resurrect (nreverse resurrect))) + (when delete + (magit-discard-files--delete (nreverse delete) status)) + (when rename + (magit-discard-files--rename (nreverse rename) status)) + (when (or discard discard-new) + (magit-discard-files--discard (nreverse discard) + (nreverse discard-new))) + (magit-wip-commit-after-apply files " after discard")) + (magit-refresh)))) + +(defun magit-discard-files--resolve (files) + (if-let ((arg (and (cdr files) + (magit-read-char-case + (format "For these %d files\n%s\ncheckout:\n" + (length files) + (mapconcat (lambda (file) + (concat " " file)) + files "\n")) + t + (?o "[o]ur stage" "--ours") + (?t "[t]heir stage" "--theirs") + (?c "[c]onflict" "--merge") + (?i "decide [i]ndividually" nil))))) + (dolist (file files) + (magit-checkout-stage file arg)) + (dolist (file files) + (magit-checkout-stage file (magit-checkout-read-stage file))))) + +(defun magit-discard-files--resurrect (files) + (magit-confirm-files 'resurrect files) + (if (eq (magit-diff-type) 'staged) + (magit-call-git "reset" "--" files) + (magit-call-git "checkout" "--" files))) + +(defun magit-discard-files--delete (files status) + (magit-confirm-files (if magit-delete-by-moving-to-trash 'trash 'delete) + files) + (let ((delete-by-moving-to-trash magit-delete-by-moving-to-trash)) + (dolist (file files) + (when (string-match-p "\\`\\\\?~" file) + (error "Refusing to delete %S, too dangerous" file)) + (pcase (nth 3 (assoc file status)) + ((guard (memq (magit-diff-type) '(unstaged untracked))) + (dired-delete-file file dired-recursive-deletes + magit-delete-by-moving-to-trash) + (dired-clean-up-after-deletion file)) + (?\s (delete-file file t) + (magit-call-git "rm" "--cached" "--" file)) + (?M (let ((temp (magit-git-string "checkout-index" "--temp" file))) + (string-match + (format "\\(.+?\\)\t%s" (regexp-quote file)) temp) + (rename-file (match-string 1 temp) + (setq temp (concat file ".~{index}~"))) + (delete-file temp t)) + (magit-call-git "rm" "--cached" "--force" "--" file)) + (?D (magit-call-git "checkout" "--" file) + (delete-file file t) + (magit-call-git "rm" "--cached" "--force" "--" file)))))) + +(defun magit-discard-files--rename (files status) + (magit-confirm 'rename "Undo rename %s" "Undo %d renames" nil + (mapcar (lambda (file) + (setq file (assoc file status)) + (format "%s -> %s" (cadr file) (car file))) + files)) + (dolist (file files) + (let ((orig (cadr (assoc file status)))) + (if (file-exists-p file) + (progn + (when-let ((path (file-name-directory orig))) + (make-directory path t)) + (magit-call-git "mv" file orig)) + (magit-call-git "rm" "--cached" "--" file) + (magit-call-git "reset" "--" orig))))) + +(defun magit-discard-files--discard (sections new-files) + (let ((files (--map (oref it value) sections))) + (magit-confirm-files 'discard (append files new-files) + (format "Discard %s changes in" (magit-diff-type))) + (if (eq (magit-diff-type (car sections)) 'unstaged) + (magit-call-git "checkout" "--" files) + (when new-files + (magit-call-git "add" "--" new-files) + (magit-call-git "reset" "--" new-files)) + (let ((binaries (magit-binary-files "--cached"))) + (when binaries + (setq sections + (--remove (member (oref it value) binaries) + sections))) + (cond ((length= sections 1) + (magit-discard-apply (car sections) 'magit-apply-diff)) + (sections + (magit-discard-apply-n sections #'magit-apply-diffs))) + (when binaries + (let ((modified (magit-unstaged-files t))) + (setq binaries (--separate (member it modified) binaries))) + (when (cadr binaries) + (magit-call-git "reset" "--" (cadr binaries))) + (when (car binaries) + (user-error + (concat + "Cannot discard staged changes to binary files, " + "which also have unstaged changes. Unstage instead.")))))))) + +;;;; Reverse + +(defun magit-reverse (&rest args) + "Reverse the change at point in the working tree. +With a prefix argument fallback to a 3-way merge. Doing +so causes the change to be applied to the index as well." + (interactive (and current-prefix-arg (list "--3way"))) + (when-let ((s (magit-apply--get-selection))) + (pcase (list (magit-diff-type) (magit-diff-scope)) + (`(untracked ,_) (user-error "Cannot reverse untracked changes")) + (`(unstaged ,_) (user-error "Cannot reverse unstaged changes")) + (`(,_ region) (magit-reverse-region s args)) + (`(,_ hunk) (magit-reverse-hunk s args)) + (`(,_ hunks) (magit-reverse-hunks s args)) + (`(,_ file) (magit-reverse-file s args)) + (`(,_ files) (magit-reverse-files s args)) + (`(,_ list) (magit-reverse-files s args))))) + +(defun magit-reverse-region (section args) + (magit-confirm 'reverse "Reverse region") + (magit-reverse-apply section #'magit-apply-region args)) + +(defun magit-reverse-hunk (section args) + (magit-confirm 'reverse "Reverse hunk") + (magit-reverse-apply section #'magit-apply-hunk args)) + +(defun magit-reverse-hunks (sections args) + (magit-confirm 'reverse + (format "Reverse %s hunks from %s" + (length sections) + (magit-section-parent-value (car sections)))) + (magit-reverse-apply sections #'magit-apply-hunks args)) + +(defun magit-reverse-file (section args) + (magit-reverse-files (list section) args)) + +(defun magit-reverse-files (sections args) + (pcase-let ((`(,binaries ,sections) + (let ((bs (magit-binary-files + (cond ((derived-mode-p 'magit-revision-mode) + magit-buffer-range) + ((derived-mode-p 'magit-diff-mode) + magit-buffer-range) + (t + "--cached"))))) + (--separate (member (oref it value) bs) + sections)))) + (magit-confirm-files 'reverse (--map (oref it value) sections)) + (cond ((length= sections 1) + (magit-reverse-apply (car sections) #'magit-apply-diff args)) + (sections + (magit-reverse-apply sections #'magit-apply-diffs args))) + (when binaries + (user-error "Cannot reverse binary files")))) + +(defun magit-reverse-apply (section:s apply args) + (funcall apply section:s "--reverse" args + (and (not magit-reverse-atomically) + (not (member "--3way" args)) + "--reject"))) + +(defun magit-reverse-in-index (&rest args) + "Reverse the change at point in the index but not the working tree. + +Use this command to extract a change from `HEAD', while leaving +it in the working tree, so that it can later be committed using +a separate commit. A typical workflow would be: + +0. Optionally make sure that there are no uncommitted changes. +1. Visit the `HEAD' commit and navigate to the change that should + not have been included in that commit. +2. Type \"u\" (`magit-unstage') to reverse it in the index. + This assumes that `magit-unstage-committed-changes' is non-nil. +3. Type \"c e\" to extend `HEAD' with the staged changes, + including those that were already staged before. +4. Optionally stage the remaining changes using \"s\" or \"S\" + and then type \"c c\" to create a new commit." + (interactive) + (magit-reverse (cons "--cached" args))) + +;;; Smerge Support + +(defun magit-smerge-keep-current () + "Keep the current version of the conflict at point." + (interactive) + (magit-call-smerge #'smerge-keep-current)) + +(defun magit-smerge-keep-upper () + "Keep the upper/our version of the conflict at point." + (interactive) + (magit-call-smerge #'smerge-keep-upper)) + +(defun magit-smerge-keep-base () + "Keep the base version of the conflict at point." + (interactive) + (magit-call-smerge #'smerge-keep-base)) + +(defun magit-smerge-keep-lower () + "Keep the lower/their version of the conflict at point." + (interactive) + (magit-call-smerge #'smerge-keep-lower)) + +(defun magit-smerge-keep-all () + "Keep all versions of the conflict at point." + (interactive) + (magit-call-smerge #'smerge-keep-all)) + +(defun magit-call-smerge (fn) + (pcase-let* ((file (magit-file-at-point t t)) + (keep (get-file-buffer file)) + (`(,buf ,pos) + (let ((magit-diff-visit-jump-to-change nil)) + (magit-diff-visit-file--noselect file)))) + (with-current-buffer buf + (save-excursion + (save-restriction + (unless (<= (point-min) pos (point-max)) + (widen)) + (goto-char pos) + (condition-case nil + (smerge-match-conflict) + (error + (if (eq fn #'smerge-keep-current) + (when (eq this-command #'magit-discard) + (re-search-forward smerge-begin-re nil t) + (setq fn + (magit-read-char-case "Keep side: " t + (?o "[o]urs/upper" #'smerge-keep-upper) + (?b "[b]ase" #'smerge-keep-base) + (?t "[t]heirs/lower" #'smerge-keep-lower)))) + (re-search-forward smerge-begin-re nil t)))) + (funcall fn))) + (when (and keep (magit-anything-unmerged-p file)) + (smerge-start-session)) + (save-buffer)) + (unless keep + (kill-buffer buf)) + (magit-refresh))) + +;;; _ +(provide 'magit-apply) +;;; magit-apply.el ends here diff --git a/emacs/elpa/magit-20240625.2109/magit-apply.elc b/emacs/elpa/magit-20240625.2109/magit-apply.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/magit-autoloads.el b/emacs/elpa/magit-20240625.2109/magit-autoloads.el diff --git a/emacs/elpa/magit-20240622.1531/magit-autorevert.el b/emacs/elpa/magit-20240625.2109/magit-autorevert.el diff --git a/emacs/elpa/magit-20240622.1531/magit-autorevert.elc b/emacs/elpa/magit-20240625.2109/magit-autorevert.elc Binary files differ. diff --git a/emacs/elpa/magit-20240625.2109/magit-base.el b/emacs/elpa/magit-20240625.2109/magit-base.el @@ -0,0 +1,1252 @@ +;;; magit-base.el --- Early birds -*- lexical-binding:t; coding:utf-8 -*- + +;; Copyright (C) 2008-2024 The Magit Project Contributors + +;; Author: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> +;; Maintainer: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; 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. +;; +;; 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 Magit. If not, see <https://www.gnu.org/licenses/>. + +;; This file contains code taken from GNU Emacs, which is +;; Copyright (C) 1976-2023 Free Software Foundation, Inc. + +;;; Commentary: + +;; This library defines utility functions, options and other things that +;; have to be available early on because they are used by several other +;; libraries, which cannot depend on one another, because that would lead +;; to circular dependencies. + +;;; Code: + +(defconst magit--minimal-git "2.2.0") +(defconst magit--minimal-emacs "26.1") + +(require 'cl-lib) +(require 'compat) +(require 'dash) +(require 'eieio) +(require 'subr-x) + +;; For older Emacs releases we depend on an updated `seq' release from +;; GNU ELPA, for `seq-keep'. Unfortunately something else may already +;; have required `seq', before `package' had a chance to put the more +;; recent version earlier on the `load-path'. +(when (and (featurep 'seq) + (not (fboundp 'seq-keep))) + (unload-feature 'seq 'force)) +(require 'seq) + +(require 'crm) + +(require 'magit-section) + +(eval-when-compile (require 'info)) +(declare-function Info-get-token "info" (pos start all &optional errorstring)) + +(eval-when-compile (require 'vc-git)) +(declare-function vc-git--run-command-string "vc-git" (file &rest args)) + +(eval-when-compile (require 'which-func)) +(declare-function which-function "which-func" ()) + +;;; Options + +(defcustom magit-completing-read-function #'magit-builtin-completing-read + "Function to be called when requesting input from the user. + +If you have enabled `ivy-mode' or `helm-mode', then you don't +have to customize this option; `magit-builtin-completing-read' +will work just fine. However, if you use Ido completion, then +you do have to use `magit-ido-completing-read', because Ido is +less well behaved than the former, more modern alternatives. + +If you would like to use Ivy or Helm completion with Magit but +not enable the respective modes globally, then customize this +option to use `ivy-completing-read' or +`helm--completing-read-default'. If you choose to use +`ivy-completing-read', note that the items may always be shown in +alphabetical order, depending on your version of Ivy." + :group 'magit-essentials + :type '(radio (function-item magit-builtin-completing-read) + (function-item magit-ido-completing-read) + (function-item ivy-completing-read) + (function-item helm--completing-read-default) + (function :tag "Other function"))) + +(defcustom magit-dwim-selection + '((magit-stash-apply nil t) + (magit-ediff-resolve-all nil t) + (magit-ediff-resolve-rest nil t) + (magit-stash-branch nil t) + (magit-stash-branch-here nil t) + (magit-stash-format-patch nil t) + (magit-stash-drop nil ask) + (magit-stash-pop nil ask)) + "When not to offer alternatives and ask for confirmation. + +Many commands by default ask the user to select from a list of +possible candidates. They do so even when there is a thing at +point that they can act on, which is then offered as the default. + +This option can be used to tell certain commands to use the thing +at point instead of asking the user to select a candidate to act +on, with or without confirmation. + +The value has the form ((COMMAND nil|PROMPT DEFAULT)...). + +- COMMAND is the command that should not prompt for a choice. + To have an effect, the command has to use the function + `magit-completing-read' or a utility function which in turn uses + that function. + +- If the command uses `magit-completing-read' multiple times, then + PROMPT can be used to only affect one of these uses. PROMPT, if + non-nil, is a regular expression that is used to match against + the PROMPT argument passed to `magit-completing-read'. + +- DEFAULT specifies how to use the default. If it is t, then + the DEFAULT argument passed to `magit-completing-read' is used + without confirmation. If it is `ask', then the user is given + a chance to abort. DEFAULT can also be nil, in which case the + entry has no effect." + :package-version '(magit . "2.12.0") + :group 'magit-commands + :type '(repeat + (list (symbol :tag "Command") ; It might not be fboundp yet. + (choice (const :tag "for all prompts" nil) + (regexp :tag "for prompts matching regexp")) + (choice (const :tag "offer other choices" nil) + (const :tag "require confirmation" ask) + (const :tag "use default without confirmation" t))))) + +(defconst magit--confirm-actions + '((const discard) + (const reverse) + (const stage-all-changes) + (const unstage-all-changes) + (const delete) + (const trash) + (const resurrect) + (const untrack) + (const rename) + (const reset-bisect) + (const abort-cherry-pick) + (const abort-revert) + (const abort-rebase) + (const abort-merge) + (const merge-dirty) + (const delete-unmerged-branch) + (const delete-branch-on-remote) + (const delete-pr-remote) + (const drop-stashes) + (const set-and-push) + (const amend-published) + (const rebase-published) + (const edit-published) + (const remove-modules) + (const remove-dirty-modules) + (const trash-module-gitdirs) + (const stash-apply-3way) + (const kill-process) + (const safe-with-wip))) + +(defcustom magit-no-confirm '(set-and-push) + "A list of symbols for actions Magit should not confirm, or t. + +Many potentially dangerous commands by default ask the user for +confirmation. Each of the below symbols stands for an action +which, when invoked unintentionally or without being fully aware +of the consequences, could lead to tears. In many cases there +are several commands that perform variations of a certain action, +so we don't use the command names but more generic symbols. + +Applying changes: + + `discard' Discarding one or more changes (i.e., hunks or the + complete diff for a file) loses that change, obviously. + + `reverse' Reverting one or more changes can usually be undone + by reverting the reversion. + + `stage-all-changes', `unstage-all-changes' When there are both + staged and unstaged changes, then un-/staging everything would + destroy that distinction. Of course that also applies when + un-/staging a single change, but then less is lost and one does + that so often that having to confirm every time would be + unacceptable. + +Files: + + `delete' When a file that isn't yet tracked by Git is deleted + then it is completely lost, not just the last changes. Very + dangerous. + + `trash' Instead of deleting a file it can also be move to the + system trash. Obviously much less dangerous than deleting it. + + Also see option `magit-delete-by-moving-to-trash'. + + `resurrect' A deleted file can easily be resurrected by + \"deleting\" the deletion, which is done using the same command + that was used to delete the same file in the first place. + + `untrack' Untracking a file can be undone by tracking it again. + + `rename' Renaming a file can easily be undone. + +Sequences: + + `reset-bisect' Aborting (known to Git as \"resetting\") a + bisect operation loses all information collected so far. + + `abort-cherry-pick' Aborting a cherry-pick throws away all + conflict resolutions which has already been carried out by the + user. + + `abort-revert' Aborting a revert throws away all conflict + resolutions which has already been carried out by the user. + + `abort-rebase' Aborting a rebase throws away all already + modified commits, but it's possible to restore those from the + reflog. + + `abort-merge' Aborting a merge throws away all conflict + resolutions which has already been carried out by the user. + + `merge-dirty' Merging with a dirty worktree can make it hard to + go back to the state before the merge was initiated. + +References: + + `delete-unmerged-branch' Once a branch has been deleted it can + only be restored using low-level recovery tools provided by + Git. And even then the reflog is gone. The user always has + to confirm the deletion of a branch by accepting the default + choice (or selecting another branch), but when a branch has + not been merged yet, also make sure the user is aware of that. + + `delete-branch-on-remote' Deleting a \"remote branch\" may mean + deleting the (local) \"remote-tracking\" branch only, or also + removing it from the remote itself. The latter often makes more + sense because otherwise simply fetching from the remote would + restore the remote-tracking branch, but doing that can be + surprising and hard to recover from, so we ask. + + `delete-pr-remote' When deleting a branch that was created from + a pull-request and if no other branches still exist on that + remote, then `magit-branch-delete' offers to delete the remote + as well. This should be safe because it only happens if no + other refs exist in the remotes namespace, and you can recreate + the remote if necessary. + + `drop-stashes' Dropping a stash is dangerous because Git stores + stashes in the reflog. Once a stash is removed, there is no + going back without using low-level recovery tools provided by + Git. When a single stash is dropped, then the user always has + to confirm by accepting the default (or selecting another). + This action only concerns the deletion of multiple stashes at + once. + +Publishing: + + `set-and-push' When pushing to the upstream or the push-remote + and that isn't actually configured yet, then the user can first + set the target. If s/he confirms the default too quickly, then + s/he might end up pushing to the wrong branch and if the remote + repository is configured to disallow fixing such mistakes, then + that can be quite embarrassing and annoying. + +Edit published history: + + Without adding these symbols here, you will be warned before + editing commits that have already been pushed to one of the + branches listed in `magit-published-branches'. + + `amend-published' Affects most commands that amend to `HEAD'. + + `rebase-published' Affects commands that perform interactive + rebases. This includes commands from the commit popup that + modify a commit other than `HEAD', namely the various fixup + and squash variants. + + `edit-published' Affects the commands `magit-edit-line-commit' + and `magit-diff-edit-hunk-commit'. These two commands make + it quite easy to accidentally edit a published commit, so you + should think twice before configuring them not to ask for + confirmation. + + To disable confirmation completely, add all three symbols here + or set `magit-published-branches' to nil. + +Removing modules: + + `remove-modules' When you remove the working directory of a + module that does not contain uncommitted changes, then that is + safer than doing so when there are uncommitted changes and/or + when you also remove the gitdir. Still, you don't want to do + that by accident. + + `remove-dirty-modules' When you remove the working directory of + a module that contains uncommitted changes, then those changes + are gone for good. It is better to go to the module, inspect + these changes and only if appropriate discard them manually. + + `trash-module-gitdirs' When you remove the gitdir of a module, + then all unpushed changes are gone for good. It is very easy + to forget that you have some unfinished work on an unpublished + feature branch or even in a stash. + + Actually there are some safety precautions in place, that might + help you out if you make an unwise choice here, but don't count + on it. In case of emergency, stay calm and check the stash and + the `trash-directory' for traces of lost work. + +Various: + + `stash-apply-3way' When a stash cannot be applied using \"git + stash apply\", then Magit uses \"git apply\" instead, possibly + using the \"--3way\" argument, which isn't always perfectly + safe. See also `magit-stash-apply'. + + `kill-process' There seldom is a reason to kill a process. + +Global settings: + + Instead of adding all of the above symbols to the value of this + option you can also set it to the atom `t', which has the same + effect as adding all of the above symbols. Doing that most + certainly is a bad idea, especially because other symbols might + be added in the future. So even if you don't want to be asked + for confirmation for any of these actions, you are still better + of adding all of the respective symbols individually. + + When `magit-wip-before-change-mode' is enabled then these actions + can fairly easily be undone: `discard', `reverse', + `stage-all-changes', and `unstage-all-changes'. If and only if + this mode is enabled, then `safe-with-wip' has the same effect + as adding all of these symbols individually." + :package-version '(magit . "2.1.0") + :group 'magit-essentials + :group 'magit-commands + :type `(choice (const :tag "Always require confirmation" nil) + (const :tag "Never require confirmation" t) + (set :tag "Require confirmation except for" + ;; `remove-dirty-modules' and + ;; `trash-module-gitdirs' intentionally + ;; omitted. + ,@magit--confirm-actions))) + +(defcustom magit-slow-confirm '(drop-stashes) + "Whether to ask user \"y or n\" or \"yes or no\" questions. + +When this is nil, then `y-or-n-p' is used when the user has to +confirm a potentially destructive action. When this is t, then +`yes-or-no-p' is used instead. If this is a list of symbols +identifying actions, then `yes-or-no-p' is used for those, +`y-or-no-p' for all others. The list of actions is the same as +for `magit-no-confirm' (which see)." + :package-version '(magit . "2.9.0") + :group 'magit-miscellaneous + :type `(choice (const :tag "Always ask \"yes or no\" questions" t) + (const :tag "Always ask \"y or n\" questions" nil) + (set :tag "Ask \"yes or no\" questions only for" + ,@magit--confirm-actions))) + +(defcustom magit-no-message nil + "A list of messages Magit should not display. + +Magit displays most echo area messages using `message', but a few +are displayed using `magit-message' instead, which takes the same +arguments as the former, FORMAT-STRING and ARGS. `magit-message' +forgoes printing a message if any member of this list is a prefix +of the respective FORMAT-STRING. + +If Magit prints a message which causes you grief, then please +first investigate whether there is another option which can be +used to suppress it. If that is not the case, then ask the Magit +maintainers to start using `magit-message' instead of `message' +in that case. We are not proactively replacing all uses of +`message' with `magit-message', just in case someone *might* find +some of these messages useless. + +Messages which can currently be suppressed using this option are: +* \"Turning on magit-auto-revert-mode...\"" + :package-version '(magit . "2.8.0") + :group 'magit-miscellaneous + :type '(repeat string)) + +(defcustom magit-verbose-messages nil + "Whether to make certain prompts and messages more verbose. + +Occasionally a user suggests that a certain prompt or message +should be more verbose, but I would prefer to keep it as-is +because I don't think that the fact that that one user did not +understand the existing prompt/message means that a large number +of users would have the same difficulty, and that making it more +verbose would actually do a disservice to users who understand +the shorter prompt well enough. + +Going forward I will start offering both messages when I feel the +suggested longer message is reasonable enough, and the value of +this option decides which will be used. Note that changing the +value of this option affects all such messages and that I do not +intend to add an option per prompt." + :package-version '(magit . "4.0.0") + :group 'magit-miscellaneous + :type 'boolean) + +(defcustom magit-ellipsis + '((margin (?… . ">")) + (t (?… . "..."))) + "Characters or strings used to abbreviate text in some buffers. + +Each element has the form (WHERE (FANCY . UNIVERSAL)). + +FANCY is a single character or nil whereas UNIVERSAL is a string +of any length. The ellipsis produced by `magit--ellipsis' will +be FANCY if it's a non-nil character that can be displayed with +the available fonts, otherwise UNIVERSAL will be used. FANCY is +meant to be a rich character like a horizontal ellipsis symbol or +an emoji whereas UNIVERSAL something simpler available in a less +rich environment like the CLI. WHERE determines the use-case for +the ellipsis definition. Currently the only acceptable values +for WHERE are `margin' or t (representing the default). + +Whether collapsed sections are indicated using ellipsis is +controlled by `magit-section-visibility-indicator'." + :package-version '(magit . "4.0.0") + :group 'magit-miscellaneous + :type '(repeat (list (symbol :tag "Where") + (cons (choice :tag "Fancy" character (const nil)) + (string :tag "Universal"))))) + +(defcustom magit-update-other-window-delay 0.2 + "Delay before automatically updating the other window. + +When moving around in certain buffers, then certain other +buffers, which are being displayed in another window, may +optionally be updated to display information about the +section at point. + +When holding down a key to move by more than just one section, +then that would update that buffer for each section on the way. +To prevent that, updating the revision buffer is delayed, and +this option controls for how long. For optimal experience you +might have to adjust this delay and/or the keyboard repeat rate +and delay of your graphical environment or operating system." + :package-version '(magit . "2.3.0") + :group 'magit-miscellaneous + :type 'number) + +(defcustom magit-view-git-manual-method 'info + "How links to Git documentation are followed from Magit's Info manuals. + +`info' Follow the link to the node in the `gitman' Info manual + as usual. Unfortunately that manual is not installed by + default on some platforms, and when it is then the nodes + look worse than the actual manpages. + +`man' View the respective man-page using the `man' package. + +`woman' View the respective man-page using the `woman' package." + :package-version '(magit . "2.9.0") + :group 'magit-miscellaneous + :type '(choice (const :tag "view info manual" info) + (const :tag "view manpage using `man'" man) + (const :tag "view manpage using `woman'" woman))) + +;;; Section Classes + +(defclass magit-commit-section (magit-section) + ((keymap :initform 'magit-commit-section-map))) + +(setf (alist-get 'commit magit--section-type-alist) 'magit-commit-section) + +(defclass magit-diff-section (magit-section) + ((keymap :initform 'magit-diff-section-map)) + :abstract t) + +(defclass magit-file-section (magit-diff-section) + ((keymap :initform 'magit-file-section-map) + (source :initform nil :initarg :source) + (header :initform nil :initarg :header) + (binary :initform nil :initarg :binary))) + +(defclass magit-module-section (magit-file-section) + ((keymap :initform 'magit-module-section-map) + (range :initform nil :initarg :range))) + +(defclass magit-hunk-section (magit-diff-section) + ((keymap :initform 'magit-hunk-section-map) + (refined :initform nil) + (combined :initform nil :initarg :combined) + (from-range :initform nil :initarg :from-range) + (from-ranges :initform nil) + (to-range :initform nil :initarg :to-range) + (about :initform nil :initarg :about))) + +(setf (alist-get 'file magit--section-type-alist) 'magit-file-section) +(setf (alist-get 'module magit--section-type-alist) 'magit-module-section) +(setf (alist-get 'hunk magit--section-type-alist) 'magit-hunk-section) + +(defclass magit-log-section (magit-section) + ((keymap :initform 'magit-log-section-map)) + :abstract t) +(defclass magit-unpulled-section (magit-log-section) ()) +(defclass magit-unpushed-section (magit-log-section) ()) +(defclass magit-unmerged-section (magit-log-section) ()) + +(setf (alist-get 'unpulled magit--section-type-alist) 'magit-unpulled-section) +(setf (alist-get 'unpushed magit--section-type-alist) 'magit-unpushed-section) +(setf (alist-get 'unmerged magit--section-type-alist) 'magit-unmerged-section) + +;;; User Input + +(defvar helm-completion-in-region-default-sort-fn) +(defvar helm-crm-default-separator) +(defvar ivy-sort-functions-alist) +(defvar ivy-sort-matches-functions-alist) +(defvar vertico-sort-function) + +(defvar magit-completing-read--silent-default nil) + +(defvar magit-completing-read-default-prompt-predicate + (lambda () + (and (eq magit-completing-read-function + 'magit-builtin-completing-read) + (not (or (bound-and-true-p helm-mode) + (bound-and-true-p ivy-mode) + (bound-and-true-p selectrum-mode) + (bound-and-true-p vertico-mode))))) + "Function used to determine whether to add default to prompt. + +This is used by `magit-completing-read' (which see). + +The default function returns nil, when a completion frameworks is used +for which this is undesirable. More precisely, it returns nil, when +`magit-completing-read-function' is not `magit-builtin-completing-read', +or one of `helm-mode', `ivy-mode', `selectrum-mode' or `vertico-mode' +is enabled. When this function returns nil, then nil is passed to +`format-prompt' (which see), instead of the default (DEF or FALLBACK).") + +(defun magit-completing-read ( prompt collection &optional + predicate require-match initial-input + hist def fallback) + "Read a choice in the minibuffer, or use the default choice. + +This is the function that Magit commands use when they need the +user to select a single thing to act on. The arguments have the +same meaning as for `completing-read', except for FALLBACK, which +is unique to this function and is described below. + +Instead of asking the user to choose from a list of possible +candidates, this function may instead just return the default +specified by DEF, with or without requiring user confirmation. +Whether that is the case depends on PROMPT, `this-command' and +`magit-dwim-selection'. See the documentation of the latter for +more information. + +If it does use the default without the user even having to +confirm that, then `magit-completing-read--silent-default' is set +to t, otherwise nil. + +If it does read a value in the minibuffer, then this function +acts similarly to `completing-read', except for the following: + +- COLLECTION must be a list of choices. A function is not + supported. + +- If REQUIRE-MATCH is nil and the user exits without a choice, + then nil is returned instead of an empty string. + +- If REQUIRE-MATCH is non-nil and the user exits without a + choice, `user-error' is raised. + +- FALLBACK specifies a secondary default that is only used if + the primary default DEF is nil. The secondary default is not + subject to `magit-dwim-selection' — if DEF is nil but FALLBACK + is not, then this function always asks the user to choose a + candidate, just as if both defaults were nil. + +- `format-prompt' is called on PROMPT and DEF (or FALLBACK if + DEF is nil). This appends \": \" to the prompt and may also + add the default to the prompt, using the format specified by + `minibuffer-default-prompt-format' and depending on + `magit-completing-read-default-prompt-predicate'." + (setq magit-completing-read--silent-default nil) + (if-let ((dwim (and def + (nth 2 (seq-find (pcase-lambda (`(,cmd ,re ,_)) + (and (eq this-command cmd) + (or (not re) + (string-match-p re prompt)))) + magit-dwim-selection))))) + (if (eq dwim 'ask) + (if (y-or-n-p (format "%s %s? " prompt def)) + def + (user-error "Abort")) + (setq magit-completing-read--silent-default t) + def) + (unless def + (setq def fallback)) + (let ((command this-command) + (reply (funcall + magit-completing-read-function + (format-prompt + prompt + (and (funcall magit-completing-read-default-prompt-predicate) + def)) + (if (and (not (functionp collection)) + def + (not (member def collection))) + (cons def collection) + collection) + predicate + require-match initial-input hist def))) + (setq this-command command) + ;; Note: Avoid `string=' to support `helm-comp-read-use-marked'. + (if (equal reply "") + (if require-match + (user-error "Nothing selected") + nil) + reply)))) + +(defun magit--completion-table (collection) + (lambda (string pred action) + (if (eq action 'metadata) + '(metadata (display-sort-function . identity)) + (complete-with-action action collection string pred)))) + +(defun magit-builtin-completing-read + (prompt choices &optional predicate require-match initial-input hist def) + "Magit wrapper for standard `completing-read' function." + (unless (or (bound-and-true-p helm-mode) + (bound-and-true-p ivy-mode)) + (setq choices (magit--completion-table choices))) + (let ((ivy-sort-functions-alist nil) + (vertico-sort-function nil)) + (completing-read prompt choices + predicate require-match + initial-input hist def))) + +(define-obsolete-function-alias 'magit-completing-read-multiple* + 'magit-completing-read-multiple "Magit-Section 4.0.0") + +(defun magit-completing-read-multiple + ( prompt table &optional predicate require-match initial-input + hist def inherit-input-method + no-split) + "Read multiple strings in the minibuffer, with completion. +Like `completing-read-multiple' but don't mess with order of +TABLE and take an additional argument NO-SPLIT, which causes +the user input to be returned as a single unmodified string. +Also work around various incompatible features of various +third-party completion frameworks." + (cl-letf* + (;; To implement NO-SPLIT we have to manipulate the respective + ;; `split-string' invocation. We cannot simply advice it to + ;; return the input string because `SELECTRUM' would choke on + ;; that string. Use a variable to pass along the raw user + ;; input string. aa5f098ab + (input nil) + (split-string (symbol-function #'split-string)) + ((symbol-function #'split-string) + (lambda (string &optional separators omit-nulls trim) + (when (and no-split + (equal separators crm-separator) + (equal omit-nulls t)) + (setq input string)) + (funcall split-string string separators omit-nulls trim))) + ;; Prevent `BUILT-IN' completion from messing up our existing + ;; order of the completion candidates. aa5f098ab + (table (magit--completion-table table)) + ;; Prevent `IVY' from messing up our existing order. c7af78726 + (ivy-sort-matches-functions-alist nil) + ;; Prevent `HELM' from messing up our existing order. 6fcf994bd + (helm-completion-in-region-default-sort-fn nil) + ;; Prevent `HELM' from automatically appending the separator, + ;; which is counterproductive when NO-SPLIT is non-nil and/or + ;; when reading commit ranges. 798aff564 + (helm-crm-default-separator + (if no-split nil (bound-and-true-p helm-crm-default-separator))) + ;; And now, the moment we have all been waiting for... + (values (completing-read-multiple + prompt table predicate require-match initial-input + hist def inherit-input-method))) + (if no-split input values))) + +(defun magit-ido-completing-read + (prompt choices &optional predicate require-match initial-input hist def) + "Ido-based `completing-read' almost-replacement. + +Unfortunately `ido-completing-read' is not suitable as a +drop-in replacement for `completing-read', instead we use +`ido-completing-read+' from the third-party package by the +same name." + (if (and (require 'ido-completing-read+ nil t) + (fboundp 'ido-completing-read+)) + (ido-completing-read+ prompt choices predicate require-match + initial-input hist + (or def (and require-match (car choices)))) + (display-warning 'magit "ido-completing-read+ is not installed + +To use Ido completion with Magit you need to install the +third-party `ido-completing-read+' packages. Falling +back to built-in `completing-read' for now." :error) + (magit-builtin-completing-read prompt choices predicate require-match + initial-input hist def))) + +(defvar-keymap magit-minibuffer-local-ns-map + :parent minibuffer-local-map + "SPC" #'magit-whitespace-disallowed + "TAB" #'magit-whitespace-disallowed) + +(defun magit-whitespace-disallowed () + "Beep to tell the user that whitespace is not allowed." + (interactive) + (ding) + (message "Whitespace isn't allowed here") + (setq defining-kbd-macro nil) + (force-mode-line-update)) + +(defun magit-read-string ( prompt &optional initial-input history default-value + inherit-input-method no-whitespace) + "Read a string from the minibuffer, prompting with string PROMPT. + +This is similar to `read-string', but +* empty input is only allowed if DEFAULT-VALUE is non-nil in + which case that is returned, +* whitespace is not allowed and leading and trailing whitespace is + removed automatically if NO-WHITESPACE is non-nil, +* `format-prompt' is used internally. +* an invalid DEFAULT-VALUE is silently ignored." + (when default-value + (when (consp default-value) + (setq default-value (car default-value))) + (unless (stringp default-value) + (setq default-value nil))) + (let* ((minibuffer-completion-table nil) + (val (read-from-minibuffer + (format-prompt prompt default-value) + initial-input (and no-whitespace magit-minibuffer-local-ns-map) + nil history default-value inherit-input-method)) + (trim (lambda (regexp string) + (save-match-data + (if (string-match regexp string) + (replace-match "" t t string) + string))))) + (when (and (string= val "") default-value) + (setq val default-value)) + (when no-whitespace + (setq val (funcall trim "\\`\\(?:[ \t\n\r]+\\)" + (funcall trim "\\(?:[ \t\n\r]+\\)\\'" val)))) + (cond ((string= val "") + (user-error "Need non-empty input")) + ((and no-whitespace (string-match-p "[\s\t\n]" val)) + (user-error "Input contains whitespace")) + (t val)))) + +(defun magit-read-string-ns ( prompt &optional initial-input history + default-value inherit-input-method) + "Call `magit-read-string' with non-nil NO-WHITESPACE." + (magit-read-string prompt initial-input history default-value + inherit-input-method t)) + +(defmacro magit-read-char-case (prompt verbose &rest clauses) + (declare (indent 2) + (debug (form form &rest (characterp form body)))) + `(prog1 (pcase (read-char-choice + (let ((parts (nconc (list ,@(mapcar #'cadr clauses)) + ,(and verbose '(list "[C-g] to abort"))))) + (concat ,prompt + (string-join (butlast parts) ", ") + ", or " (car (last parts)) " ")) + ',(mapcar #'car clauses)) + ,@(--map `(,(car it) ,@(cddr it)) clauses)) + (message ""))) + +(defun magit-y-or-n-p (prompt &optional action) + "Ask user a \"y or n\" or a \"yes or no\" question using PROMPT. +Which kind of question is used depends on whether +ACTION is a member of option `magit-slow-confirm'." + (if (or (eq magit-slow-confirm t) + (and action (member action magit-slow-confirm))) + (yes-or-no-p prompt) + (y-or-n-p prompt))) + +(defvar magit--no-confirm-alist + '((safe-with-wip magit-wip-before-change-mode + discard reverse stage-all-changes unstage-all-changes))) + +(cl-defun magit-confirm ( action &optional prompt prompt-n noabort + (items nil sitems) prompt-suffix) + (declare (indent defun)) + (setq prompt-n (format (concat (or prompt-n prompt) "? ") (length items))) + (setq prompt (format (concat (or prompt (magit-confirm-make-prompt action)) + "? ") + (car items))) + (when prompt-suffix + (setq prompt (concat prompt prompt-suffix))) + (or (cond ((and (not (eq action t)) + (or (eq magit-no-confirm t) + (memq action magit-no-confirm) + (cl-member-if (pcase-lambda (`(,key ,var . ,sub)) + (and (memq key magit-no-confirm) + (memq action sub) + (or (not var) + (and (boundp var) + (symbol-value var))))) + magit--no-confirm-alist))) + (or (not sitems) items)) + ((not sitems) + (magit-y-or-n-p prompt action)) + ((length= items 1) + (and (magit-y-or-n-p prompt action) items)) + ((length> items 1) + (and (magit-y-or-n-p (concat (string-join items "\n") + "\n\n" prompt-n) + action) + items))) + (if noabort nil (user-error "Abort")))) + +(defun magit-confirm-files (action files &optional prompt prompt-suffix noabort) + (when files + (unless prompt + (setq prompt (magit-confirm-make-prompt action))) + (magit-confirm action + (concat prompt " \"%s\"") + (concat prompt " %d files") + noabort files prompt-suffix))) + +(defun magit-confirm-make-prompt (action) + (let ((prompt (symbol-name action))) + (string-replace "-" " " + (concat (upcase (substring prompt 0 1)) + (substring prompt 1))))) + +(defun magit-read-number-string (prompt &optional default _history) + "Like `read-number' but return value is a string. +DEFAULT may be a number or a numeric string." + (number-to-string + (read-number prompt (if (stringp default) + (string-to-number default) + default)))) + +;;; Debug Utilities + +;;;###autoload +(defun magit-emacs-Q-command () + "Show a shell command that runs an uncustomized Emacs with only Magit loaded. +See info node `(magit)Debugging Tools' for more information." + (interactive) + (let ((cmd (mapconcat + #'shell-quote-argument + `(,(concat invocation-directory invocation-name) + "-Q" "--eval" "(setq debug-on-error t)" + ,@(cl-mapcan + (lambda (dir) (list "-L" dir)) + (delete-dups + (cl-mapcan + (lambda (lib) + (if-let ((path (locate-library lib))) + (list (file-name-directory path)) + (error "Cannot find mandatory dependency %s" lib))) + '(;; Like `LOAD_PATH' in `default.mk'. + "compat" + "dash" + "transient" + "with-editor" + ;; Obviously `magit' itself is needed too. + "magit" + ;; While these are part of the Magit repository, + ;; they are distributed as separate packages. + "magit-section" + "git-commit" + )))) + ;; Avoid Emacs bug#16406 by using full path. + "-l" ,(file-name-sans-extension (locate-library "magit"))) + " "))) + (message "Uncustomized Magit command saved to kill-ring, %s" + "please run it in a terminal.") + (kill-new cmd))) + +;;; Text Utilities + +(defmacro magit-bind-match-strings (varlist string &rest body) + "Bind variables to submatches according to VARLIST then evaluate BODY. +Bind the symbols in VARLIST to submatches of the current match +data, starting with 1 and incrementing by 1 for each symbol. If +the last match was against a string, then that has to be provided +as STRING." + (declare (indent 2) (debug (listp form body))) + (let ((s (cl-gensym "string")) + (i 0)) + `(let ((,s ,string)) + (let ,(save-match-data + (cl-mapcan (lambda (sym) + (cl-incf i) + (and (not (eq (aref (symbol-name sym) 0) ?_)) + (list (list sym (list 'match-string i s))))) + varlist)) + ,@body)))) + +(defun magit-delete-line () + "Delete the rest of the current line." + (delete-region (point) (1+ (line-end-position)))) + +(defun magit-delete-match (&optional num) + "Delete text matched by last search. +If optional NUM is specified, only delete that subexpression." + (delete-region (match-beginning (or num 0)) + (match-end (or num 0)))) + +(defun magit-file-line (file) + "Return the first line of FILE as a string." + (when (file-regular-p file) + (with-temp-buffer + (insert-file-contents file) + (buffer-substring-no-properties (point-min) + (line-end-position))))) + +(defun magit-file-lines (file &optional keep-empty-lines) + "Return a list of strings containing one element per line in FILE. +Unless optional argument KEEP-EMPTY-LINES is t, trim all empty lines." + (when (file-regular-p file) + (with-temp-buffer + (insert-file-contents file) + (split-string (buffer-string) "\n" (not keep-empty-lines))))) + +(defun magit-set-header-line-format (string) + "Set `header-line-format' in the current buffer based on STRING. +Pad the left side of STRING so that it aligns with the text area." + (setq header-line-format + (concat (propertize " " 'display '(space :align-to 0)) + string))) + +(defun magit--format-spec (format specification) + "Like `format-spec' but preserve text properties in SPECIFICATION." + (with-temp-buffer + (insert format) + (goto-char (point-min)) + (while (search-forward "%" nil t) + (cond + ;; Quoted percent sign. + ((eq (char-after) ?%) + (delete-char 1)) + ;; Valid format spec. + ((looking-at "\\([-0-9.]*\\)\\([a-zA-Z]\\)") + (let* ((num (match-string 1)) + (spec (string-to-char (match-string 2))) + (val (assq spec specification))) + (unless val + (error "Invalid format character: `%%%c'" spec)) + (setq val (cdr val)) + ;; Pad result to desired length. + (let ((text (format (concat "%" num "s") val))) + ;; Insert first, to preserve text properties. + (if (next-property-change 0 (concat " " text)) + ;; If the inserted text has properties, then preserve those. + (insert text) + ;; Otherwise preserve FORMAT's properties, like `format-spec'. + (insert-and-inherit text)) + ;; Delete the specifier body. + (delete-region (+ (match-beginning 0) (length text)) + (+ (match-end 0) (length text))) + ;; Delete the percent sign. + (delete-region (1- (match-beginning 0)) (match-beginning 0))))) + ;; Signal an error on bogus format strings. + (t + (error "Invalid format string")))) + (buffer-string))) + +;;; Missing from Emacs + +(defun magit-kill-this-buffer () + "Kill the current buffer." + (interactive) + (kill-buffer (current-buffer))) + +(defun magit--buffer-string (&optional min max trim) + "Like `buffer-substring-no-properties' but the arguments are optional. + +This combines the benefits of `buffer-string', `buffer-substring' +and `buffer-substring-no-properties' into one function that is +not as painful to use as the latter. I.e., you can write + (magit--buffer-string) +instead of + (buffer-substring-no-properties (point-min) + (point-max)) + +Optional MIN defaults to the value of `point-min'. +Optional MAX defaults to the value of `point-max'. + +If optional TRIM is non-nil, then all leading and trailing +whitespace is remove. If it is the newline character, then +one trailing newline is added." + ;; Lets write that one last time and be done with it: + (let ((str (buffer-substring-no-properties (or min (point-min)) + (or max (point-max))))) + (if trim + (concat (string-trim str) + (and (eq trim ?\n) "\n")) + str))) + +(defun magit--version> (v1 v2) + "Return t if version V1 is higher (younger) than V2. +This function should be named `version>' and be part of Emacs." + (version-list-< (version-to-list v2) (version-to-list v1))) + +(defun magit--version>= (v1 v2) + "Return t if version V1 is higher (younger) than or equal to V2. +This function should be named `version>=' and be part of Emacs." + (version-list-<= (version-to-list v2) (version-to-list v1))) + +;;; Kludges for Emacs Bugs + +(when (< emacs-major-version 27) + ;; Work around https://debbugs.gnu.org/cgi/bugreport.cgi?bug=21559. + ;; Fixed by cb55ccae8be946f1562d74718086a4c8c8308ee5 in Emacs 27.1. + (with-eval-after-load 'vc-git + (defun vc-git-conflicted-files (directory) + "Return the list of files with conflicts in DIRECTORY." + (let* ((status + (vc-git--run-command-string directory "diff-files" + "--name-status")) + (lines (when status (split-string status "\n" 'omit-nulls))) + files) + (dolist (line lines files) + (when (string-match "\\([ MADRCU?!]\\)[ \t]+\\(.+\\)" line) + (let ((state (match-string 1 line)) + (file (match-string 2 line))) + (when (equal state "U") + (push (expand-file-name file directory) files))))))))) + +(when (< emacs-major-version 27) + (defun vc-git--call@bug21559 (fn buffer command &rest args) + "Backport https://debbugs.gnu.org/cgi/bugreport.cgi?bug=21559." + (let ((process-environment process-environment)) + (when revert-buffer-in-progress-p + (push "GIT_OPTIONAL_LOCKS=0" process-environment)) + (apply fn buffer command args))) + (advice-add 'vc-git--call :around 'vc-git--call@bug21559) + + (defun vc-git-command@bug21559 + (fn buffer okstatus file-or-list &rest flags) + "Backport https://debbugs.gnu.org/cgi/bugreport.cgi?bug=21559." + (let ((process-environment process-environment)) + (when revert-buffer-in-progress-p + (push "GIT_OPTIONAL_LOCKS=0" process-environment)) + (apply fn buffer okstatus file-or-list flags))) + (advice-add 'vc-git-command :around 'vc-git-command@bug21559) + + (defun auto-revert-handler@bug21559 (fn) + "Backport https://debbugs.gnu.org/cgi/bugreport.cgi?bug=21559." + (let ((revert-buffer-in-progress-p t)) + (funcall fn))) + (advice-add 'auto-revert-handler :around 'auto-revert-handler@bug21559) + ) + +(defun magit-which-function () + "Return current function name based on point. + +This is a simple wrapper around `which-function', that resets +Imenu's potentially outdated and therefore unreliable cache by +setting `imenu--index-alist' to nil before calling that function." + (setq imenu--index-alist nil) + (which-function)) + +;;; Kludges for Custom + +(defun magit-custom-initialize-reset (symbol exp) + "Initialize SYMBOL based on EXP. +Set the value of the variable SYMBOL, using `set-default' +\(unlike `custom-initialize-reset', which uses the `:set' +function if any). The value is either the symbol's current +value (as obtained using the `:get' function), if any, or +the value in the symbol's `saved-value' property if any, or +\(last of all) the value of EXP." + (set-default-toplevel-value + symbol + (condition-case nil + (let ((def (default-toplevel-value symbol)) + (getter (get symbol 'custom-get))) + (if getter (funcall getter symbol) def)) + (error + (eval (let ((sv (get symbol 'saved-value))) + (if sv (car sv) exp))))))) + +(defun magit-hook-custom-get (symbol) + (if (symbol-file symbol 'defvar) + (default-toplevel-value symbol) + ;; + ;; Called by `custom-initialize-reset' on behalf of `symbol's + ;; `defcustom', which is being evaluated for the first time to + ;; set the initial value, but there's already a default value, + ;; which most likely was established by one or more `add-hook' + ;; calls. + ;; + ;; We combine the `standard-value' and the current value, while + ;; preserving the order established by `:options', and return + ;; the result of that to be used as the "initial" default value. + ;; + (let ((standard (eval (car (get symbol 'standard-value)))) + (current (default-toplevel-value symbol)) + (value nil)) + (dolist (fn (get symbol 'custom-options)) + (when (or (memq fn standard) + (memq fn current)) + (push fn value))) + (dolist (fn current) + (unless (memq fn value) + (push fn value))) + (nreverse value)))) + +;;; Kludges for Info Manuals + +;;;###autoload +(define-advice Info-follow-nearest-node (:around (fn &optional fork) gitman) + (let ((node (Info-get-token + (point) "\\*note[ \n\t]+" + "\\*note[ \n\t]+\\([^:]*\\):\\(:\\|[ \n\t]*(\\)?"))) + (if (and node (string-match "^(gitman)\\(.+\\)" node)) + (pcase magit-view-git-manual-method + ('info (funcall fn fork)) + ('man (require 'man) + (man (match-string 1 node))) + ('woman (require 'woman) + (woman (match-string 1 node))) + (_ (user-error "Invalid value for `magit-view-git-manual-method'"))) + (funcall fn fork)))) + +;; When making changes here, then also adjust the copy in docs/Makefile. +;;;###autoload +(define-advice org-man-export (:around (fn link description format) gitman) + (if (and (eq format 'texinfo) + (string-prefix-p "git" link)) + (string-replace "%s" link " +@ifinfo +@ref{%s,,,gitman,}. +@end ifinfo +@ifhtml +@html +the <a href=\"http://git-scm.com/docs/%s\">%s(1)</a> manpage. +@end html +@end ifhtml +@iftex +the %s(1) manpage. +@end iftex +") + (funcall fn link description format))) + +;;; Kludges for Package Managers + +(defun magit--straight-chase-links (filename) + "Chase links in FILENAME until a name that is not a link. + +This is the same as `file-chase-links', except that it also +handles fake symlinks that are created by the package manager +straight.el on Windows. + +See <https://github.com/raxod502/straight.el/issues/520>." + (when (and (bound-and-true-p straight-symlink-emulation-mode) + (fboundp 'straight-chase-emulated-symlink)) + (when-let ((target (straight-chase-emulated-symlink filename))) + (unless (eq target 'broken) + (setq filename target)))) + (file-chase-links filename)) + +;;; Kludges for older Emacs versions + +(if (fboundp 'with-connection-local-variables) + (defalias 'magit--with-connection-local-variables + #'with-connection-local-variables) + (defmacro magit--with-connection-local-variables (&rest body) + "Abridged `with-connection-local-variables' for pre Emacs 27 compatibility. +Bind shell file name and switch for remote execution. +`with-connection-local-variables' isn't available until Emacs 27. +This kludge provides the minimal functionality required by +Magit." + `(if (file-remote-p default-directory) + (pcase-let ((`(,shell-file-name ,shell-command-switch) + (with-no-warnings ; about unknown tramp functions + (require 'tramp) + (let ((vec (tramp-dissect-file-name + default-directory))) + (list (tramp-get-method-parameter + vec 'tramp-remote-shell) + (string-join (tramp-get-method-parameter + vec 'tramp-remote-shell-args) + " ")))))) + ,@body) + ,@body))) + +(put 'magit--with-connection-local-variables 'lisp-indent-function 'defun) + +;;; Miscellaneous + +(defun magit-message (format-string &rest args) + "Display a message at the bottom of the screen, or not. +Like `message', except that if the users configured option +`magit-no-message' to prevent the message corresponding to +FORMAT-STRING to be displayed, then don't." + (unless (--first (string-prefix-p it format-string) magit-no-message) + (apply #'message format-string args))) + +(defun magit-msg (format-string &rest args) + "Display a message at the bottom of the screen, but don't log it. +Like `message', except that `message-log-max' is bound to nil." + (let ((message-log-max nil)) + (apply #'message format-string args))) + +(defmacro magit--with-temp-position (buf pos &rest body) + (declare (indent 2)) + `(with-current-buffer ,buf + (save-excursion + (save-restriction + (widen) + (goto-char (or ,pos 1)) + ,@body)))) + +(defun magit--ellipsis (&optional where) + "Build an ellipsis always as string, depending on WHERE." + (if (stringp magit-ellipsis) + magit-ellipsis + (if-let ((pair (car (or + (alist-get (or where t) magit-ellipsis) + (alist-get t magit-ellipsis))))) + (pcase-let ((`(,fancy . ,universal) pair)) + (let ((ellipsis (if (and fancy (char-displayable-p fancy)) + fancy + universal))) + (if (characterp ellipsis) + (char-to-string ellipsis) + ellipsis))) + (user-error "Variable magit-ellipsis is invalid")))) + +(defun magit--ext-regexp-quote (str) + "Like `reqexp-quote', but for Extended Regular Expressions." + (let ((special (string-to-list "[*.\\?+^$({")) + (quoted nil)) + (mapc (lambda (c) + (when (memq c special) + (push ?\\ quoted)) + (push c quoted)) + str) + (concat (nreverse quoted)))) + +;;; _ +(provide 'magit-base) +;;; magit-base.el ends here diff --git a/emacs/elpa/magit-20240625.2109/magit-base.elc b/emacs/elpa/magit-20240625.2109/magit-base.elc Binary files differ. diff --git a/emacs/elpa/magit-20240625.2109/magit-bisect.el b/emacs/elpa/magit-20240625.2109/magit-bisect.el @@ -0,0 +1,322 @@ +;;; magit-bisect.el --- Bisect support for Magit -*- lexical-binding:t -*- + +;; Copyright (C) 2008-2024 The Magit Project Contributors + +;; Author: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> +;; Maintainer: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; 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. +;; +;; 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 Magit. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Use a binary search to find the commit that introduced a bug. + +;;; Code: + +(require 'magit) + +;;; Options + +(defcustom magit-bisect-show-graph t + "Whether to use `--graph' in the log showing commits yet to be bisected." + :package-version '(magit . "2.8.0") + :group 'magit-status + :type 'boolean) + +(defface magit-bisect-good + '((t :foreground "DarkOliveGreen")) + "Face for good bisect revisions." + :group 'magit-faces) + +(defface magit-bisect-skip + '((t :foreground "DarkGoldenrod")) + "Face for skipped bisect revisions." + :group 'magit-faces) + +(defface magit-bisect-bad + '((t :foreground "IndianRed4")) + "Face for bad bisect revisions." + :group 'magit-faces) + +;;; Commands + +;;;###autoload (autoload 'magit-bisect "magit-bisect" nil t) +(transient-define-prefix magit-bisect () + "Narrow in on the commit that introduced a bug." + :man-page "git-bisect" + [:class transient-subgroups + :if-not magit-bisect-in-progress-p + ["Arguments" + ("-n" "Don't checkout commits" "--no-checkout") + ("-p" "Follow only first parent of a merge" "--first-parent" + :if (lambda () (magit-git-version>= "2.29"))) + (6 magit-bisect:--term-old + :if (lambda () (magit-git-version>= "2.7"))) + (6 magit-bisect:--term-new + :if (lambda () (magit-git-version>= "2.7")))] + ["Actions" + ("B" "Start" magit-bisect-start) + ("s" "Start script" magit-bisect-run)]] + ["Actions" + :if magit-bisect-in-progress-p + ("B" "Bad" magit-bisect-bad) + ("g" "Good" magit-bisect-good) + (6 "m" "Mark" magit-bisect-mark + :if (lambda () (magit-git-version>= "2.7"))) + ("k" "Skip" magit-bisect-skip) + ("r" "Reset" magit-bisect-reset) + ("s" "Run script" magit-bisect-run)]) + +(transient-define-argument magit-bisect:--term-old () + :description "Old/good term" + :class 'transient-option + :key "=o" + :argument "--term-old=") + +(transient-define-argument magit-bisect:--term-new () + :description "New/bad term" + :class 'transient-option + :key "=n" + :argument "--term-new=") + +;;;###autoload +(defun magit-bisect-start (bad good args) + "Start a bisect session. + +Bisecting a bug means to find the commit that introduced it. +This command starts such a bisect session by asking for a known +good and a known bad commit. To move the session forward use the +other actions from the bisect transient command (\ +\\<magit-status-mode-map>\\[magit-bisect])." + (interactive (if (magit-bisect-in-progress-p) + (user-error "Already bisecting") + (magit-bisect-start-read-args))) + (magit-bisect-start--assert bad good args) + (magit-repository-local-set 'bisect--first-parent + (transient-arg-value "--first-parent" args)) + (magit-git-bisect "start" (list args bad good) t)) + +(defun magit-bisect-start-read-args () + (let* ((args (transient-args 'magit-bisect)) + (bad (magit-read-branch-or-commit + (format "Start bisect with %s revision" + (or (transient-arg-value "--term-new=" args) + "bad"))))) + (list bad + (magit-read-other-branch-or-commit + (format "%s revision" (or (transient-arg-value "--term-old=" args) + "Good")) + bad) + args))) + +(defun magit-bisect-start--assert (bad good args) + (unless (magit-rev-ancestor-p good bad) + (user-error + "The %s revision (%s) has to be an ancestor of the %s one (%s)" + (or (transient-arg-value "--term-old=" args) "good") + good + (or (transient-arg-value "--term-new=" args) "bad") + bad)) + (when (magit-anything-modified-p) + (user-error "Cannot bisect with uncommitted changes"))) + +;;;###autoload +(defun magit-bisect-reset () + "After bisecting, cleanup bisection state and return to original `HEAD'." + (interactive) + (magit-confirm 'reset-bisect) + (magit-run-git "bisect" "reset") + (magit-repository-local-delete 'bisect--first-parent) + (ignore-errors + (delete-file (expand-file-name "BISECT_CMD_OUTPUT" (magit-gitdir))))) + +;;;###autoload +(defun magit-bisect-good () + "While bisecting, mark the current commit as good. +Use this after you have asserted that the commit does not contain +the bug in question." + (interactive) + (magit-git-bisect (or (cadr (magit-bisect-terms)) + (user-error "Not bisecting")))) + +;;;###autoload +(defun magit-bisect-bad () + "While bisecting, mark the current commit as bad. +Use this after you have asserted that the commit does contain the +bug in question." + (interactive) + (magit-git-bisect (or (car (magit-bisect-terms)) + (user-error "Not bisecting")))) + +;;;###autoload +(defun magit-bisect-mark () + "While bisecting, mark the current commit with a bisect term. +During a bisect using alternate terms, commits can still be +marked with `magit-bisect-good' and `magit-bisect-bad', as those +commands map to the correct term (\"good\" to --term-old's value +and \"bad\" to --term-new's). However, in some cases, it can be +difficult to keep that mapping straight in your head; this +command provides an interface that exposes the underlying terms." + (interactive) + (magit-git-bisect + (pcase-let ((`(,term-new ,term-old) (or (magit-bisect-terms) + (user-error "Not bisecting")))) + (pcase (read-char-choice + (format "Mark HEAD as %s ([n]ew) or %s ([o]ld)" + term-new term-old) + (list ?n ?o)) + (?n term-new) + (?o term-old))))) + +;;;###autoload +(defun magit-bisect-skip () + "While bisecting, skip the current commit. +Use this if for some reason the current commit is not a good one +to test. This command lets Git choose a different one." + (interactive) + (magit-git-bisect "skip")) + +;;;###autoload +(defun magit-bisect-run (cmdline &optional bad good args) + "Bisect automatically by running commands after each step. + +Unlike `git bisect run' this can be used before bisecting has +begun. In that case it behaves like `git bisect start; git +bisect run'." + (interactive (let ((args (and (not (magit-bisect-in-progress-p)) + (magit-bisect-start-read-args)))) + (cons (read-shell-command "Bisect shell command: ") args))) + (when (and bad good) + (magit-bisect-start--assert bad good args) + ;; Avoid `magit-git-bisect' because it's asynchronous, but the + ;; next `git bisect run' call requires the bisect to be started. + (magit-with-toplevel + (magit-process-git + (list :file (expand-file-name "BISECT_CMD_OUTPUT" (magit-gitdir))) + (magit-process-git-arguments + (list "bisect" "start" bad good args))) + (magit-refresh))) + (magit--with-connection-local-variables + (magit-git-bisect "run" (list shell-file-name + shell-command-switch cmdline)))) + +(defun magit-git-bisect (subcommand &optional args no-assert) + (unless (or no-assert (magit-bisect-in-progress-p)) + (user-error "Not bisecting")) + (message "Bisecting...") + (magit-with-toplevel + (magit-run-git-async "bisect" subcommand args)) + (set-process-sentinel + magit-this-process + (lambda (process event) + (when (memq (process-status process) '(exit signal)) + (if (> (process-exit-status process) 0) + (magit-process-sentinel process event) + (process-put process 'inhibit-refresh t) + (magit-process-sentinel process event) + (when (buffer-live-p (process-buffer process)) + (with-current-buffer (process-buffer process) + (when-let* ((section (magit-section-at)) + (output (buffer-substring-no-properties + (oref section content) + (oref section end)))) + (with-temp-file + (expand-file-name "BISECT_CMD_OUTPUT" (magit-gitdir)) + (insert output))))) + (magit-refresh)) + (message "Bisecting...done"))))) + +;;; Sections + +(defun magit-bisect-in-progress-p () + (file-exists-p (expand-file-name "BISECT_LOG" (magit-gitdir)))) + +(defun magit-bisect-terms () + (magit-file-lines (expand-file-name "BISECT_TERMS" (magit-gitdir)))) + +(defun magit-insert-bisect-output () + "While bisecting, insert section with output from `git bisect'." + (when (magit-bisect-in-progress-p) + (let* ((lines + (or (magit-file-lines + (expand-file-name "BISECT_CMD_OUTPUT" (magit-gitdir))) + (list "Bisecting: (no saved bisect output)" + "It appears you have invoked `git bisect' from a shell." + "There is nothing wrong with that, we just cannot display" + "anything useful here. Consult the shell output instead."))) + (done-re "^\\([a-z0-9]\\{40,\\}\\) is the first bad commit$") + (bad-line (or (and (string-match done-re (car lines)) + (pop lines)) + (--first (string-match done-re it) lines)))) + (magit-insert-section ((eval (if bad-line 'commit 'bisect-output)) + (and bad-line (match-string 1 bad-line))) + (magit-insert-heading + (propertize (or bad-line (pop lines)) + 'font-lock-face 'magit-section-heading)) + (dolist (line lines) + (insert line "\n")))) + (insert "\n"))) + +(defun magit-insert-bisect-rest () + "While bisecting, insert section visualizing the bisect state." + (when (magit-bisect-in-progress-p) + (magit-insert-section (bisect-view) + (magit-insert-heading t "Bisect Rest") + (magit-git-wash (apply-partially #'magit-log-wash-log 'bisect-vis) + "bisect" "visualize" "git" "log" + "--format=%h%x00%D%x00%s" "--decorate=full" + (and magit-bisect-show-graph "--graph") + (and (magit-repository-local-get 'bisect--first-parent) + "--first-parent"))))) + +(defun magit-insert-bisect-log () + "While bisecting, insert section logging bisect progress." + (when (magit-bisect-in-progress-p) + (magit-insert-section (bisect-log) + (magit-insert-heading t "Bisect Log") + (magit-git-wash #'magit-wash-bisect-log "bisect" "log") + (insert ?\n)))) + +(defun magit-wash-bisect-log (_args) + (let (beg) + (while (progn (setq beg (point-marker)) + (re-search-forward + "^\\(\\(?:git bisect\\|# status:\\) [^\n]+\n\\)" nil t)) + (if (string-prefix-p "# status:" (match-string 1)) + (magit-delete-match) + (magit-bind-match-strings (heading) nil + (magit-delete-match) + (save-restriction + (narrow-to-region beg (point)) + (goto-char (point-min)) + (magit-insert-section (bisect-item heading t) + (insert (propertize heading 'font-lock-face + 'magit-section-secondary-heading)) + (magit-insert-heading) + (magit-wash-sequence + (apply-partially #'magit-log-wash-rev 'bisect-log + (magit-abbrev-length))) + (insert ?\n)))))) + (when (re-search-forward + "# first bad commit: \\[\\([a-z0-9]\\{40,\\}\\)\\] [^\n]+\n" nil t) + (magit-bind-match-strings (hash) nil + (magit-delete-match) + (magit-insert-section (bisect-item) + (insert hash " is the first bad commit\n")))))) + +;;; _ +(provide 'magit-bisect) +;;; magit-bisect.el ends here diff --git a/emacs/elpa/magit-20240625.2109/magit-bisect.elc b/emacs/elpa/magit-20240625.2109/magit-bisect.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/magit-blame.el b/emacs/elpa/magit-20240625.2109/magit-blame.el diff --git a/emacs/elpa/magit-20240622.1531/magit-blame.elc b/emacs/elpa/magit-20240625.2109/magit-blame.elc Binary files differ. diff --git a/emacs/elpa/magit-20240625.2109/magit-bookmark.el b/emacs/elpa/magit-20240625.2109/magit-bookmark.el @@ -0,0 +1,154 @@ +;;; magit-bookmark.el --- Bookmarks for Magit buffers -*- lexical-binding:t -*- + +;; Copyright (C) 2008-2024 The Magit Project Contributors + +;; Inspired by an earlier implementation by Yuri Khan. + +;; Author: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> +;; Maintainer: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; 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. +;; +;; 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 Magit. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Support for bookmarks for most Magit buffers. + +;;; Code: + +(require 'magit) + +(require 'bookmark) + +;;; Common + +(cl-defmethod magit-bookmark-get-filename (&context (major-mode magit-mode)) + (magit-toplevel)) + +(cl-defmethod magit-bookmark-get-buffer-create + (bookmark (mode (derived-mode magit-mode))) + (let ((default-directory (bookmark-get-filename bookmark)) + (magit-display-buffer-function #'identity) + (magit-display-buffer-noselect t)) + (apply (intern (format "%s-setup-buffer" + (substring (symbol-name mode) 0 -5))) + (--map (bookmark-prop-get bookmark it) + (get mode 'magit-bookmark-variables))))) + +;;; Diff +;;;; Diff + +(put 'magit-diff-mode 'magit-bookmark-variables + '(magit-buffer-range-hashed + magit-buffer-typearg + magit-buffer-diff-args + magit-buffer-diff-files)) + +(cl-defmethod magit-bookmark-name (&context (major-mode magit-diff-mode)) + (format "magit-diff(%s%s)" + (pcase (magit-diff-type) + ('staged "staged") + ('unstaged "unstaged") + ('committed magit-buffer-range) + ('undefined + (delq nil (list magit-buffer-typearg magit-buffer-range-hashed)))) + (if magit-buffer-diff-files + (concat " -- " (string-join magit-buffer-diff-files " ")) + ""))) + +;;;; Revision + +(put 'magit-revision-mode 'magit-bookmark-variables + '(magit-buffer-revision-hash + magit-buffer-diff-args + magit-buffer-diff-files)) + +(cl-defmethod magit-bookmark-name (&context (major-mode magit-revision-mode)) + (format "magit-revision(%s %s)" + (magit-rev-abbrev magit-buffer-revision) + (if magit-buffer-diff-files + (string-join magit-buffer-diff-files " ") + (magit-rev-format "%s" magit-buffer-revision)))) + +;;;; Stash + +(put 'magit-stash-mode 'magit-bookmark-variables + '(magit-buffer-revision-hash + magit-buffer-diff-args + magit-buffer-diff-files)) + +(cl-defmethod magit-bookmark-name (&context (major-mode magit-stash-mode)) + (format "magit-stash(%s %s)" + (magit-rev-abbrev magit-buffer-revision) + (if magit-buffer-diff-files + (string-join magit-buffer-diff-files " ") + (magit-rev-format "%s" magit-buffer-revision)))) + +(cl-defmethod magit-bookmark--get-child-value + (section &context (major-mode magit-stash-mode)) + (string-replace magit-buffer-revision + magit-buffer-revision-hash + (oref section value))) + +;;; Log +;;;; Log + +(put 'magit-log-mode 'magit-bookmark-variables + '(magit-buffer-revisions + magit-buffer-log-args + magit-buffer-log-files)) + +(cl-defmethod magit-bookmark-name (&context (major-mode magit-log-mode)) + (format "magit-log(%s%s)" + (string-join magit-buffer-revisions " ") + (if magit-buffer-log-files + (concat " -- " (string-join magit-buffer-log-files " ")) + ""))) + +;;;; Cherry + +(put 'magit-cherry-mode 'magit-bookmark-variables + '(magit-buffer-refname + magit-buffer-upstream)) + +(cl-defmethod magit-bookmark-name (&context (major-mode magit-cherry-mode)) + (format "magit-cherry(%s > %s)" + magit-buffer-refname + magit-buffer-upstream)) + +;;;; Reflog + +(put 'magit-reflog-mode 'magit-bookmark-variables + '(magit-buffer-refname)) + +(cl-defmethod magit-bookmark-name (&context (major-mode magit-reflog-mode)) + (format "magit-reflog(%s)" magit-buffer-refname)) + +;;; Misc + +(put 'magit-status-mode 'magit-bookmark-variables nil) + +(put 'magit-refs-mode 'magit-bookmark-variables + '(magit-buffer-upstream + magit-buffer-arguments)) + +(put 'magit-stashes-mode 'magit-bookmark-variables nil) + +(cl-defmethod magit-bookmark-name (&context (major-mode magit-stashes-mode)) + (format "magit-states(%s)" magit-buffer-refname)) + +;;; _ +(provide 'magit-bookmark) +;;; magit-bookmark.el ends here diff --git a/emacs/elpa/magit-20240625.2109/magit-bookmark.elc b/emacs/elpa/magit-20240625.2109/magit-bookmark.elc Binary files differ. diff --git a/emacs/elpa/magit-20240625.2109/magit-branch.el b/emacs/elpa/magit-20240625.2109/magit-branch.el @@ -0,0 +1,985 @@ +;;; magit-branch.el --- Branch support -*- lexical-binding:t -*- + +;; Copyright (C) 2008-2024 The Magit Project Contributors + +;; Author: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> +;; Maintainer: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; 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. +;; +;; 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 Magit. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This library implements support for branches. It defines commands +;; for creating, checking out, manipulating, and configuring branches. +;; Commands defined here are mainly concerned with branches as +;; pointers, commands that deal with what a branch points at, are +;; defined elsewhere. + +;;; Code: + +(require 'magit) +(require 'magit-reset) + +;;; Options + +(defcustom magit-branch-read-upstream-first t + "Whether to read upstream before name of new branch when creating a branch. + +`nil' Read the branch name first. +`t' Read the upstream first. +`fallback' Read the upstream first, but if it turns out that the chosen + value is not a valid upstream (because it cannot be resolved + as an existing revision), then treat it as the name of the + new branch and continue by reading the upstream next." + :package-version '(magit . "2.2.0") + :group 'magit-commands + :type '(choice (const :tag "read branch name first" nil) + (const :tag "read upstream first" t) + (const :tag "read upstream first, with fallback" fallback))) + +(defcustom magit-branch-prefer-remote-upstream nil + "Whether to favor remote upstreams when creating new branches. + +When a new branch is created, then the branch, commit, or stash +at point is suggested as the default starting point of the new +branch, or if there is no such revision at point the current +branch. In either case the user may choose another starting +point. + +If the chosen starting point is a branch, then it may also be set +as the upstream of the new branch, depending on the value of the +Git variable `branch.autoSetupMerge'. By default this is done +for remote branches, but not for local branches. + +You might prefer to always use some remote branch as upstream. +If the chosen starting point is (1) a local branch, (2) whose +name matches a member of the value of this option, (3) the +upstream of that local branch is a remote branch with the same +name, and (4) that remote branch can be fast-forwarded to the +local branch, then the chosen branch is used as starting point, +but its own upstream is used as the upstream of the new branch. + +Members of this option's value are treated as branch names that +have to match exactly unless they contain a character that makes +them invalid as a branch name. Recommended characters to use +to trigger interpretation as a regexp are \"*\" and \"^\". Some +other characters which you might expect to be invalid, actually +are not, e.g., \".+$\" are all perfectly valid. More precisely, +if `git check-ref-format --branch STRING' exits with a non-zero +status, then treat STRING as a regexp. + +Assuming the chosen branch matches these conditions you would end +up with with e.g.: + + feature --upstream--> origin/master + +instead of + + feature --upstream--> master --upstream--> origin/master + +Which you prefer is a matter of personal preference. If you do +prefer the former, then you should add branches such as \"master\", +\"next\", and \"maint\" to the value of this options." + :package-version '(magit . "2.4.0") + :group 'magit-commands + :type '(repeat string)) + +(defcustom magit-branch-adjust-remote-upstream-alist nil + "Alist of upstreams to be used when branching from remote branches. + +When creating a local branch from an ephemeral branch located +on a remote, e.g., a feature or hotfix branch, then that remote +branch should usually not be used as the upstream branch, since +the push-remote already allows accessing it and having both the +upstream and the push-remote reference the same related branch +would be wasteful. Instead a branch like \"maint\" or \"master\" +should be used as the upstream. + +This option allows specifying the branch that should be used as +the upstream when branching certain remote branches. The value +is an alist of the form ((UPSTREAM . RULE)...). The first +element is used whose UPSTREAM exists and whose RULE matches +the name of the new branch. Subsequent elements are ignored. + +UPSTREAM is the branch to be used as the upstream for branches +specified by RULE. It can be a local or a remote branch. + +RULE can either be a regular expression, matching branches whose +upstream should be the one specified by UPSTREAM. Or it can be +a list of the only branches that should *not* use UPSTREAM; all +other branches will. Matching is done after stripping the remote +part of the name of the branch that is being branched from. + +If you use a finite set of non-ephemeral branches across all your +repositories, then you might use something like: + + ((\"origin/master\" . (\"master\" \"next\" \"maint\"))) + +Or if the names of all your ephemeral branches contain a slash, +at least in some repositories, then a good value could be: + + ((\"origin/master\" . \"/\")) + +Of course you can also fine-tune: + + ((\"origin/maint\" . \"\\\\\\=`hotfix/\") + (\"origin/master\" . \"\\\\\\=`feature/\")) + +UPSTREAM can be a local branch: + + ((\"master\" . (\"master\" \"next\" \"maint\"))) + +Because the main branch is no longer almost always named \"master\" +you should also account for other common names: + + ((\"main\" . (\"main\" \"master\" \"next\" \"maint\")) + (\"master\" . (\"main\" \"master\" \"next\" \"maint\"))) + +If you use remote branches as UPSTREAM, then you might also want +to set `magit-branch-prefer-remote-upstream' to a non-nil value. +However, I recommend that you use local branches as UPSTREAM." + :package-version '(magit . "2.9.0") + :group 'magit-commands + :type '(repeat (cons (string :tag "Use upstream") + (choice :tag "for branches" + (regexp :tag "matching") + (repeat :tag "except" + (string :tag "branch")))))) + +(defcustom magit-branch-rename-push-target t + "Whether the push-remote setup is preserved when renaming a branch. + +The command `magit-branch-rename' renames a branch named OLD to +NEW. This option controls how much of the push-remote setup is +preserved when doing so. + +When nil, then preserve nothing and unset `branch.OLD.pushRemote'. + +When `local-only', then first set `branch.NEW.pushRemote' to the + same value as `branch.OLD.pushRemote', provided the latter is + actually set and unless the former already has another value. + +When t, then rename the branch named OLD on the remote specified + by `branch.OLD.pushRemote' to NEW, provided OLD exists on that + remote and unless NEW already exists on the remote. + +When `forge-only' and the `forge' package is available, then + behave like `t' if the remote points to a repository on a forge + (currently Github or Gitlab), otherwise like `local-only'." + :package-version '(magit . "2.90.0") + :group 'magit-commands + :type '(choice + (const :tag "Don't preserve push-remote setup" nil) + (const :tag "Preserve push-remote setup" local-only) + (const :tag "... and rename corresponding branch on remote" t) + (const :tag "... but only if remote is on a forge" forge-only))) + +(defcustom magit-branch-direct-configure t + "Whether the command `magit-branch' shows Git variables. +When set to nil, no variables are displayed by this transient +command, instead the sub-transient `magit-branch-configure' +has to be used to view and change branch related variables." + :package-version '(magit . "2.7.0") + :group 'magit-commands + :type 'boolean) + +(defcustom magit-published-branches '("origin/master") + "List of branches that are considered to be published." + :package-version '(magit . "2.13.0") + :group 'magit-commands + :type '(repeat string)) + +;;; Commands + +;;;###autoload (autoload 'magit-branch "magit" nil t) +(transient-define-prefix magit-branch (branch) + "Add, configure or remove a branch." + :man-page "git-branch" + [:if (lambda () + (and magit-branch-direct-configure + (oref (transient-prefix-object) scope))) + :description + (lambda () + (concat (propertize "Configure " 'face 'transient-heading) + (propertize (oref (transient-prefix-object) scope) + 'face 'magit-branch-local))) + ("d" magit-branch.<branch>.description) + ("u" magit-branch.<branch>.merge/remote) + ("r" magit-branch.<branch>.rebase) + ("p" magit-branch.<branch>.pushRemote)] + [:if-non-nil magit-branch-direct-configure + :description "Configure repository defaults" + ("R" magit-pull.rebase) + ("P" magit-remote.pushDefault) + ("B" "Update default branch" magit-update-default-branch + :inapt-if-not magit-get-some-remote)] + ["Arguments" + (7 "-r" "Recurse submodules when checking out an existing branch" + "--recurse-submodules" + :if (lambda () (magit-git-version>= "2.13")))] + [["Checkout" + ("b" "branch/revision" magit-checkout) + ("l" "local branch" magit-branch-checkout) + (6 "o" "new orphan" magit-branch-orphan)] + ["" + ("c" "new branch" magit-branch-and-checkout) + ("s" "new spin-off" magit-branch-spinoff) + (5 "w" "new worktree" magit-worktree-checkout)] + ["Create" + ("n" "new branch" magit-branch-create) + ("S" "new spin-out" magit-branch-spinout) + (5 "W" "new worktree" magit-worktree-branch)] + ["Do" + ("C" "configure..." magit-branch-configure) + ("m" "rename" magit-branch-rename) + ("x" "reset" magit-branch-reset) + ("k" "delete" magit-branch-delete)] + ["" + (7 "h" "shelve" magit-branch-shelve) + (7 "H" "unshelve" magit-branch-unshelve)]] + (interactive (list (magit-get-current-branch))) + (transient-setup 'magit-branch nil nil :scope branch)) + +(defun magit-branch-arguments () + (transient-args 'magit-branch)) + +;;;###autoload +(defun magit-checkout (revision &optional args) + "Checkout REVISION, updating the index and the working tree. +If REVISION is a local branch, then that becomes the current +branch. If it is something else, then `HEAD' becomes detached. +Checkout fails if the working tree or the staging area contain +changes. +\n(git checkout REVISION)." + (declare (interactive-only magit--checkout)) + (interactive (list (magit-read-other-branch-or-commit "Checkout") + (magit-branch-arguments))) + (when (string-match "\\`heads/\\(.+\\)" revision) + (setq revision (match-string 1 revision))) + (magit-run-git-async "checkout" args revision)) + +(defun magit--checkout (revision &optional args) + (when (string-match "\\`heads/\\(.+\\)" revision) + (setq revision (match-string 1 revision))) + (magit-call-git "checkout" args revision)) + +;;;###autoload +(defun magit-branch-create (branch start-point) + "Create BRANCH at branch or revision START-POINT." + (declare (interactive-only magit-call-git)) + (interactive (magit-branch-read-args "Create branch")) + (magit-run-git-async "branch" branch start-point) + (set-process-sentinel + magit-this-process + (lambda (process event) + (when (memq (process-status process) '(exit signal)) + (magit-branch-maybe-adjust-upstream branch start-point) + (magit-process-sentinel process event))))) + +;;;###autoload +(defun magit-branch-and-checkout (branch start-point &optional args) + "Create and checkout BRANCH at branch or revision START-POINT." + (declare (interactive-only magit-call-git)) + (interactive (append (magit-branch-read-args "Create and checkout branch") + (list (magit-branch-arguments)))) + (if (string-match-p "^stash@{[0-9]+}$" start-point) + (magit-run-git "stash" "branch" branch start-point) + (magit-run-git-async "checkout" args "-b" branch start-point) + (set-process-sentinel + magit-this-process + (lambda (process event) + (when (memq (process-status process) '(exit signal)) + (magit-branch-maybe-adjust-upstream branch start-point) + (magit-process-sentinel process event)))))) + +;;;###autoload +(defun magit-branch-or-checkout (arg &optional start-point) + "Hybrid between `magit-checkout' and `magit-branch-and-checkout'. + +Ask the user for an existing branch or revision. If the user +input actually can be resolved as a branch or revision, then +check that out, just like `magit-checkout' would. + +Otherwise create and checkout a new branch using the input as +its name. Before doing so read the starting-point for the new +branch. This is similar to what `magit-branch-and-checkout' +does." + (declare (interactive-only magit-call-git)) + (interactive + (let ((arg (magit-read-other-branch-or-commit "Checkout"))) + (list arg + (and (not (magit-commit-p arg)) + (magit-read-starting-point "Create and checkout branch" arg))))) + (when (string-match "\\`heads/\\(.+\\)" arg) + (setq arg (match-string 1 arg))) + (if start-point + (with-suppressed-warnings ((interactive-only magit-branch-and-checkout)) + (magit-branch-and-checkout arg start-point)) + (magit--checkout arg) + (magit-refresh))) + +;;;###autoload +(defun magit-branch-checkout (branch &optional start-point) + "Checkout an existing or new local branch. + +Read a branch name from the user offering all local branches and +a subset of remote branches as candidates. Omit remote branches +for which a local branch by the same name exists from the list +of candidates. The user can also enter a completely new branch +name. + +- If the user selects an existing local branch, then check that + out. + +- If the user selects a remote branch, then create and checkout + a new local branch with the same name. Configure the selected + remote branch as push target. + +- If the user enters a new branch name, then create and check + that out, after also reading the starting-point from the user. + +In the latter two cases the upstream is also set. Whether it is +set to the chosen START-POINT or something else depends on the +value of `magit-branch-adjust-remote-upstream-alist', just like +when using `magit-branch-and-checkout'." + (declare (interactive-only magit-call-git)) + (interactive + (let* ((current (magit-get-current-branch)) + (local (magit-list-local-branch-names)) + (remote (--filter (and (string-match "[^/]+/" it) + (not (member (substring it (match-end 0)) + (cons "HEAD" local)))) + (magit-list-remote-branch-names))) + (choices (nconc (delete current local) remote)) + (atpoint (magit-branch-at-point)) + (choice (magit-completing-read + "Checkout branch" choices + nil nil nil 'magit-revision-history + (or (car (member atpoint choices)) + (and atpoint + (car (member (and (string-match "[^/]+/" atpoint) + (substring atpoint (match-end 0))) + choices))))))) + (cond ((member choice remote) + (list (and (string-match "[^/]+/" choice) + (substring choice (match-end 0))) + choice)) + ((member choice local) + (list choice)) + (t + (list choice (magit-read-starting-point "Create" choice)))))) + (cond + ((not start-point) + (magit--checkout branch (magit-branch-arguments)) + (magit-refresh)) + (t + (when (magit-anything-modified-p t) + (user-error "Cannot checkout when there are uncommitted changes")) + (magit-run-git-async "checkout" (magit-branch-arguments) + "-b" branch start-point) + (set-process-sentinel + magit-this-process + (lambda (process event) + (when (memq (process-status process) '(exit signal)) + (magit-branch-maybe-adjust-upstream branch start-point) + (when (magit-remote-branch-p start-point) + (pcase-let ((`(,remote . ,remote-branch) + (magit-split-branch-name start-point))) + (when (and (equal branch remote-branch) + (not (equal remote (magit-get "remote.pushDefault")))) + (magit-set remote "branch" branch "pushRemote")))) + (magit-process-sentinel process event))))))) + +(defun magit-branch-maybe-adjust-upstream (branch start-point) + (when-let ((upstream + (or (and (magit-get-upstream-branch branch) + (magit-get-indirect-upstream-branch start-point)) + (and (magit-remote-branch-p start-point) + (let ((name (cdr (magit-split-branch-name start-point)))) + (seq-some + (pcase-lambda (`(,upstream . ,rule)) + (and (magit-branch-p upstream) + (if (listp rule) + (not (member name rule)) + (string-match-p rule name)) + upstream)) + magit-branch-adjust-remote-upstream-alist)))))) + (magit-call-git "branch" (concat "--set-upstream-to=" upstream) branch))) + +;;;###autoload +(defun magit-branch-orphan (branch start-point) + "Create and checkout an orphan BRANCH with contents from revision START-POINT." + (interactive (magit-branch-read-args "Create and checkout orphan branch")) + (magit-run-git "checkout" "--orphan" branch start-point)) + +(defun magit-branch-read-args (prompt &optional default-start) + (if magit-branch-read-upstream-first + (let ((choice (magit-read-starting-point prompt nil default-start))) + (cond + ((magit-rev-verify choice) + (list (magit-read-string-ns + (if magit-completing-read--silent-default + (format "%s (starting at `%s')" prompt choice) + "Name for new branch") + (let ((def (string-join (cdr (split-string choice "/")) "/"))) + (and (member choice (magit-list-remote-branch-names)) + (not (member def (magit-list-local-branch-names))) + def))) + choice)) + ((eq magit-branch-read-upstream-first 'fallback) + (list choice + (magit-read-starting-point prompt choice default-start))) + ((user-error "Not a valid starting-point: %s" choice)))) + (let ((branch (magit-read-string-ns (concat prompt " named")))) + (if (magit-branch-p branch) + (magit-branch-read-args + (format "Branch `%s' already exists; pick another name" branch) + default-start) + (list branch (magit-read-starting-point prompt branch default-start)))))) + +;;;###autoload +(defun magit-branch-spinout (branch &optional from) + "Create new branch from the unpushed commits. +Like `magit-branch-spinoff' but remain on the current branch. +If there are any uncommitted changes, then behave exactly like +`magit-branch-spinoff'." + (interactive (list (magit-read-string-ns "Spin out branch") + (car (last (magit-region-values 'commit))))) + (magit--branch-spinoff branch from nil)) + +;;;###autoload +(defun magit-branch-spinoff (branch &optional from) + "Create new branch from the unpushed commits. + +Create and checkout a new branch starting at and tracking the +current branch. That branch in turn is reset to the last commit +it shares with its upstream. If the current branch has no +upstream or no unpushed commits, then the new branch is created +anyway and the previously current branch is not touched. + +This is useful to create a feature branch after work has already +began on the old branch (likely but not necessarily \"master\"). + +If the current branch is a member of the value of option +`magit-branch-prefer-remote-upstream' (which see), then the +current branch will be used as the starting point as usual, but +the upstream of the starting-point may be used as the upstream +of the new branch, instead of the starting-point itself. + +If optional FROM is non-nil, then the source branch is reset +to `FROM~', instead of to the last commit it shares with its +upstream. Interactively, FROM is only ever non-nil, if the +region selects some commits, and among those commits, FROM is +the commit that is the fewest commits ahead of the source +branch. + +The commit at the other end of the selection actually does not +matter, all commits between FROM and `HEAD' are moved to the new +branch. If FROM is not reachable from `HEAD' or is reachable +from the source branch's upstream, then an error is raised." + (interactive (list (magit-read-string-ns "Spin off branch") + (car (last (magit-region-values 'commit))))) + (magit--branch-spinoff branch from t)) + +(defun magit--branch-spinoff (branch from checkout) + (when (magit-branch-p branch) + (user-error "Cannot spin off %s. It already exists" branch)) + (when (and (not checkout) + (magit-anything-modified-p)) + (message "Staying on HEAD due to uncommitted changes") + (setq checkout t)) + (if-let ((current (magit-get-current-branch))) + (let ((tracked (magit-get-upstream-branch current)) + base) + (when from + (unless (magit-rev-ancestor-p from current) + (user-error "Cannot spin off %s. %s is not reachable from %s" + branch from current)) + (when (and tracked + (magit-rev-ancestor-p from tracked)) + (user-error "Cannot spin off %s. %s is ancestor of upstream %s" + branch from tracked))) + (let ((magit-process-raise-error t)) + (if checkout + (magit-call-git "checkout" "-b" branch current) + (magit-call-git "branch" branch current))) + (when-let ((upstream (magit-get-indirect-upstream-branch current))) + (magit-call-git "branch" "--set-upstream-to" upstream branch)) + (when (and tracked + (setq base + (if from + (concat from "^") + (magit-git-string "merge-base" current tracked))) + (not (magit-rev-eq base current))) + (if checkout + (magit-call-git "update-ref" "-m" + (format "reset: moving to %s" base) + (concat "refs/heads/" current) base) + (magit-call-git "reset" "--hard" base)))) + (if checkout + (magit-call-git "checkout" "-b" branch) + (magit-call-git "branch" branch))) + (magit-refresh)) + +;;;###autoload +(defun magit-branch-reset (branch to &optional set-upstream) + "Reset a branch to the tip of another branch or any other commit. + +When the branch being reset is the current branch, then do a +hard reset. If there are any uncommitted changes, then the user +has to confirm the reset because those changes would be lost. + +This is useful when you have started work on a feature branch but +realize it's all crap and want to start over. + +When resetting to another branch and a prefix argument is used, +then also set the target branch as the upstream of the branch +that is being reset." + (interactive + (let* ((atpoint (magit-local-branch-at-point)) + (branch (magit-read-local-branch "Reset branch" atpoint)) + (minibuffer-default-add-function (magit--minibuf-default-add-commit))) + (list branch + (magit-completing-read (format "Reset %s to" branch) + (delete branch (magit-list-branch-names)) + nil nil nil 'magit-revision-history + (or (and (not (equal branch atpoint)) atpoint) + (magit-get-upstream-branch branch))) + current-prefix-arg))) + (let ((magit-inhibit-refresh t)) + (if (equal branch (magit-get-current-branch)) + (if (and (magit-anything-modified-p) + (not (yes-or-no-p + "Uncommitted changes will be lost. Proceed? "))) + (user-error "Abort") + (magit-reset-hard to)) + (magit-call-git "update-ref" + "-m" (format "reset: moving to %s" to) + (magit-git-string "rev-parse" "--symbolic-full-name" + branch) + to)) + (when (and set-upstream (magit-branch-p to)) + (magit-set-upstream-branch branch to) + (magit-branch-maybe-adjust-upstream branch to))) + (magit-refresh)) + +(defvar magit-branch-delete-never-verify nil + "Whether `magit-branch-delete' always pushes with \"--no-verify\".") + +;;;###autoload +(defun magit-branch-delete (branches &optional force) + "Delete one or multiple branches. + +If the region marks multiple branches, then offer to delete +those, otherwise prompt for a single branch to be deleted, +defaulting to the branch at point. + +Require confirmation when deleting branches is dangerous in some +way. Option `magit-no-confirm' can be customized to not require +confirmation in certain cases. See its docstring to learn why +confirmation is required by default in certain cases or if a +prompt is confusing." + ;; One would expect this to be a command as simple as, for example, + ;; `magit-branch-rename'; but it turns out everyone wants to squeeze + ;; a bit of extra functionality into this one, including myself. + (interactive + (let ((branches (magit-region-values 'branch t)) + (force current-prefix-arg)) + (if (length> branches 1) + (magit-confirm t nil "Delete %d branches" nil branches) + (setq branches + (list (magit-read-branch-prefer-other + (if force "Force delete branch" "Delete branch"))))) + (unless force + (when-let ((unmerged (seq-remove #'magit-branch-merged-p branches))) + (if (magit-confirm 'delete-unmerged-branch + "Delete unmerged branch %s" + "Delete %d unmerged branches" + 'noabort unmerged) + (setq force branches) + (or (setq branches + (cl-set-difference branches unmerged :test #'equal)) + (user-error "Abort"))))) + (list branches force))) + (let* ((refs (mapcar #'magit-ref-fullname branches)) + (ambiguous (--remove it refs))) + (when ambiguous + (user-error + "%s ambiguous. Please cleanup using git directly." + (let ((len (length ambiguous))) + (cond + ((= len 1) + (format "%s is" (seq-find #'magit-ref-ambiguous-p branches))) + ((= len (length refs)) + (format "These %s names are" len)) + (t + (format "%s of these names are" len)))))) + (cond + ((string-match "^refs/remotes/\\([^/]+\\)" (car refs)) + (let* ((remote (match-string 1 (car refs))) + (offset (1+ (length remote)))) + (cond + ((magit-confirm 'delete-branch-on-remote + (format "Deleting local %s. Also delete on %s" + (magit-ref-fullname (car branches)) + remote) + (format "Deleting %d local refs. Also delete on %s" + (length refs) + remote) + 'noabort refs) + ;; The ref may actually point at another rev on the remote, + ;; but this is better than nothing. + (dolist (ref refs) + (message "Delete %s (was %s)" ref + (magit-rev-parse "--short" ref))) + ;; Assume the branches actually still exist on the remote. + (magit-run-git-async + "push" + (and (or force magit-branch-delete-never-verify) "--no-verify") + remote + (--map (concat ":" (substring it offset)) branches)) + ;; If that is not the case, then this deletes the tracking branches. + (set-process-sentinel + magit-this-process + (apply-partially #'magit-delete-remote-branch-sentinel remote refs))) + (t + (dolist (ref refs) + (message "Delete %s (was %s)" ref + (magit-rev-parse "--short" ref)) + (magit-call-git "update-ref" "-d" ref)) + (magit-refresh))))) + ((length> branches 1) + (setq branches (delete (magit-get-current-branch) branches)) + (mapc #'magit-branch-maybe-delete-pr-remote branches) + (mapc #'magit-branch-unset-pushRemote branches) + (magit-run-git "branch" (if force "-D" "-d") branches)) + (t ; And now for something completely different. + (let* ((branch (car branches)) + (prompt (format "Branch %s is checked out. " branch)) + (target (magit-get-indirect-upstream-branch branch t))) + (when (equal branch (magit-get-current-branch)) + (when (or (equal branch target) + (not target)) + (setq target (magit-main-branch))) + (pcase (if (or (equal branch target) + (not target)) + (magit-read-char-case prompt nil + (?d "[d]etach HEAD & delete" 'detach) + (?a "[a]bort" 'abort)) + (magit-read-char-case prompt nil + (?d "[d]etach HEAD & delete" 'detach) + (?c (format "[c]heckout %s & delete" target) 'target) + (?a "[a]bort" 'abort))) + (`detach (unless (or (equal force '(4)) + (member branch force) + (magit-branch-merged-p branch t)) + (magit-confirm 'delete-unmerged-branch + "Delete unmerged branch %s" "" + nil (list branch))) + (magit-call-git "checkout" "--detach")) + (`target (unless (or (equal force '(4)) + (member branch force) + (magit-branch-merged-p branch target)) + (magit-confirm 'delete-unmerged-branch + "Delete unmerged branch %s" "" + nil (list branch))) + (magit-call-git "checkout" target)) + (`abort (user-error "Abort"))) + (setq force t)) + (magit-branch-maybe-delete-pr-remote branch) + (magit-branch-unset-pushRemote branch) + (magit-run-git "branch" (if force "-D" "-d") branch)))))) + +(put 'magit-branch-delete 'interactive-only t) + +(defun magit-branch-maybe-delete-pr-remote (branch) + (when-let ((remote (magit-get "branch" branch "pullRequestRemote"))) + (let* ((variable (format "remote.%s.fetch" remote)) + (refspecs (magit-get-all variable))) + (unless (member (format "+refs/heads/*:refs/remotes/%s/*" remote) + refspecs) + (let ((refspec + (if (equal (magit-get "branch" branch "pushRemote") remote) + (format "+refs/heads/%s:refs/remotes/%s/%s" + branch remote branch) + (let ((merge (magit-get "branch" branch "merge"))) + (and merge + (string-prefix-p "refs/heads/" merge) + (setq merge (substring merge 11)) + (format "+refs/heads/%s:refs/remotes/%s/%s" + merge remote merge)))))) + (when (member refspec refspecs) + (if (and (length= refspecs 1) + (magit-confirm 'delete-pr-remote + (format "Also delete remote %s (%s)" remote + "no pull-request branch remains") + nil t)) + (magit-call-git "remote" "rm" remote) + (magit-call-git "config" "--unset-all" variable + (format "^%s$" (regexp-quote refspec)))))))))) + +(defun magit-branch-unset-pushRemote (branch) + (magit-set nil "branch" branch "pushRemote")) + +(defun magit-delete-remote-branch-sentinel (remote refs process event) + (when (memq (process-status process) '(exit signal)) + (if (= (process-exit-status process) 1) + (if-let ((on-remote (--map (concat "refs/remotes/" remote "/" it) + (magit-remote-list-branches remote))) + (rest (--filter (and (not (member it on-remote)) + (magit-ref-exists-p it)) + refs))) + (progn + (process-put process 'inhibit-refresh t) + (magit-process-sentinel process event) + (setq magit-this-error nil) + (message "Some remote branches no longer exist. %s" + "Deleting just the local tracking refs instead...") + (dolist (ref rest) + (magit-call-git "update-ref" "-d" ref)) + (magit-refresh) + (message "Deleting local remote-tracking refs...done")) + (magit-process-sentinel process event)) + (magit-process-sentinel process event)))) + +;;;###autoload +(defun magit-branch-rename (old new &optional force) + "Rename the branch named OLD to NEW. + +With a prefix argument FORCE, rename even if a branch named NEW +already exists. + +If `branch.OLD.pushRemote' is set, then unset it. Depending on +the value of `magit-branch-rename-push-target' (which see) maybe +set `branch.NEW.pushRemote' and maybe rename the push-target on +the remote." + (interactive + (let ((branch (magit-read-local-branch "Rename branch"))) + (list branch + (magit-read-string-ns (format "Rename branch '%s' to" branch) + nil 'magit-revision-history) + current-prefix-arg))) + (when (string-match "\\`heads/\\(.+\\)" old) + (setq old (match-string 1 old))) + (when (equal old new) + (user-error "Old and new branch names are the same")) + (magit-call-git "branch" (if force "-M" "-m") old new) + (when magit-branch-rename-push-target + (let ((remote (magit-get-push-remote old)) + (old-specified (magit-get "branch" old "pushRemote")) + (new-specified (magit-get "branch" new "pushRemote"))) + (when (and old-specified (or force (not new-specified))) + ;; Keep the target setting branch specified, even if that is + ;; redundant. But if a branch by the same name existed before + ;; and the rename isn't forced, then do not change a leftover + ;; setting. Such a leftover setting may or may not conform to + ;; what we expect here... + (magit-set old-specified "branch" new "pushRemote")) + (when (and (equal (magit-get-push-remote new) remote) + ;; ...and if it does not, then we must abort. + (not (eq magit-branch-rename-push-target 'local-only)) + (or (not (eq magit-branch-rename-push-target 'forge-only)) + (and (require (quote forge) nil t) + (fboundp 'forge--split-forge-url) + (and-let* ((url (magit-git-string + "remote" "get-url" remote))) + (forge--split-forge-url url))))) + (let ((old-target (magit-get-push-branch old t)) + (new-target (magit-get-push-branch new t)) + (remote (magit-get-push-remote new))) + (when (and old-target + (not new-target) + (magit-y-or-n-p (format "Also rename %S to %S on \"%s\"" + old new remote))) + ;; Rename on (i.e., within) the remote, but only if the + ;; destination ref doesn't exist yet. If that ref already + ;; exists, then it probably is of some value and we better + ;; not touch it. Ignore what the local ref points at, + ;; i.e., if the local and the remote ref didn't point at + ;; the same commit before the rename then keep it that way. + (magit-call-git "push" "-v" remote + (format "%s:refs/heads/%s" old-target new) + (format ":refs/heads/%s" old))))))) + (magit-branch-unset-pushRemote old) + (magit-refresh)) + +;;;###autoload +(defun magit-branch-shelve (branch) + "Shelve a BRANCH. +Rename \"refs/heads/BRANCH\" to \"refs/shelved/BRANCH\", +and also rename the respective reflog file." + (interactive (list (magit-read-other-local-branch "Shelve branch"))) + (let ((old (concat "refs/heads/" branch)) + (new (concat "refs/shelved/" branch))) + (magit-git "update-ref" new old "") + (magit--rename-reflog-file old new) + (magit-branch-unset-pushRemote branch) + (magit-run-git "branch" "-D" branch))) + +;;;###autoload +(defun magit-branch-unshelve (branch) + "Unshelve a BRANCH +Rename \"refs/shelved/BRANCH\" to \"refs/heads/BRANCH\", +and also rename the respective reflog file." + (interactive + (list (magit-completing-read + "Unshelve branch" + (--map (substring it 8) + (magit-list-refnames "refs/shelved")) + nil t))) + (let ((old (concat "refs/shelved/" branch)) + (new (concat "refs/heads/" branch))) + (magit-git "update-ref" new old "") + (magit--rename-reflog-file old new) + (magit-run-git "update-ref" "-d" old))) + +(defun magit--rename-reflog-file (old new) + (let* ((dir (magit-gitdir)) + (old (expand-file-name (concat "logs/" old) dir)) + (new (expand-file-name (concat "logs/" new) dir))) + (when (file-exists-p old) + (make-directory (file-name-directory new) t) + (rename-file old new t)))) + +;;; Configure + +;;;###autoload (autoload 'magit-branch-configure "magit-branch" nil t) +(transient-define-prefix magit-branch-configure (branch) + "Configure a branch." + :man-page "git-branch" + [:description + (lambda () + (concat (propertize "Configure " 'face 'transient-heading) + (propertize (oref (transient-prefix-object) scope) + 'face 'magit-branch-local))) + ("d" magit-branch.<branch>.description) + ("u" magit-branch.<branch>.merge/remote) + ("r" magit-branch.<branch>.rebase) + ("p" magit-branch.<branch>.pushRemote)] + ["Configure repository defaults" + ("R" magit-pull.rebase) + ("P" magit-remote.pushDefault) + ("B" "Update default branch" magit-update-default-branch + :inapt-if-not magit-get-some-remote)] + ["Configure branch creation" + ("a m" magit-branch.autoSetupMerge) + ("a r" magit-branch.autoSetupRebase)] + (interactive + (list (or (and (not current-prefix-arg) + (not (and magit-branch-direct-configure + (eq transient-current-command 'magit-branch))) + (magit-get-current-branch)) + (magit--read-branch-scope)))) + (transient-setup 'magit-branch-configure nil nil :scope branch)) + +(defun magit--read-branch-scope (&optional obj) + (magit-read-local-branch + (if obj + (format "Set %s for branch" + (format (oref obj variable) "<name>")) + "Configure branch"))) + +(transient-define-suffix magit-branch.<branch>.description (branch) + "Edit the description of BRANCH." + :class 'magit--git-variable + :transient nil + :variable "branch.%s.description" + (interactive (list (oref transient-current-prefix scope))) + (magit-run-git-with-editor "branch" "--edit-description" branch)) + +(defclass magit--git-branch:upstream (magit--git-variable) + ((format :initform " %k %m %M\n %r %R"))) + +(transient-define-infix magit-branch.<branch>.merge/remote () + :class 'magit--git-branch:upstream) + +(cl-defmethod transient-init-value ((obj magit--git-branch:upstream)) + (when-let* ((branch (oref (transient-prefix-object) scope)) + (remote (magit-get "branch" branch "remote")) + (merge (magit-get "branch" branch "merge"))) + (oset obj value (list remote merge)))) + +(cl-defmethod transient-infix-read ((obj magit--git-branch:upstream)) + (if (oref obj value) + (oset obj value nil) + (magit-read-upstream-branch (oref (transient-prefix-object) scope) + "Upstream"))) + +(cl-defmethod transient-infix-set ((obj magit--git-branch:upstream) refname) + (magit-set-upstream-branch (oref (transient-prefix-object) scope) refname) + (oset obj value + (and-let* ((branch (oref (transient-prefix-object) scope)) + (r (magit-get "branch" branch "remote")) + (m (magit-get "branch" branch "merge"))) + (list r m))) + (magit-refresh)) + +(cl-defmethod transient-format ((obj magit--git-branch:upstream)) + (let ((branch (oref (transient-prefix-object) scope))) + (format-spec + (oref obj format) + `((?k . ,(transient-format-key obj)) + (?r . ,(format "branch.%s.remote" branch)) + (?m . ,(format "branch.%s.merge" branch)) + (?R . ,(transient-format-value obj #'car)) + (?M . ,(transient-format-value obj #'cadr)))))) + +(cl-defmethod transient-format-value ((obj magit--git-branch:upstream) key) + (if-let ((value (funcall key (oref obj value)))) + (propertize value 'face 'transient-argument) + (propertize "unset" 'face 'transient-inactive-argument))) + +(transient-define-infix magit-branch.<branch>.rebase () + :class 'magit--git-variable:choices + :scope #'magit--read-branch-scope + :variable "branch.%s.rebase" + :fallback "pull.rebase" + :choices '("true" "false") + :default "false") + +(transient-define-infix magit-branch.<branch>.pushRemote () + :class 'magit--git-variable:choices + :scope #'magit--read-branch-scope + :variable "branch.%s.pushRemote" + :fallback "remote.pushDefault" + :choices #'magit-list-remotes) + +(transient-define-infix magit-pull.rebase () + :class 'magit--git-variable:choices + :variable "pull.rebase" + :choices '("true" "false") + :default "false") + +(transient-define-infix magit-remote.pushDefault () + :class 'magit--git-variable:choices + :variable "remote.pushDefault" + :choices #'magit-list-remotes) + +(transient-define-infix magit-branch.autoSetupMerge () + :class 'magit--git-variable:choices + :variable "branch.autoSetupMerge" + :choices '("always" "true" "false") + :default "true") + +(transient-define-infix magit-branch.autoSetupRebase () + :class 'magit--git-variable:choices + :variable "branch.autoSetupRebase" + :choices '("always" "local" "remote" "never") + :default "never") + +;;; _ +(provide 'magit-branch) +;;; magit-branch.el ends here diff --git a/emacs/elpa/magit-20240625.2109/magit-branch.elc b/emacs/elpa/magit-20240625.2109/magit-branch.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/magit-bundle.el b/emacs/elpa/magit-20240625.2109/magit-bundle.el diff --git a/emacs/elpa/magit-20240622.1531/magit-bundle.elc b/emacs/elpa/magit-20240625.2109/magit-bundle.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/magit-clone.el b/emacs/elpa/magit-20240625.2109/magit-clone.el diff --git a/emacs/elpa/magit-20240625.2109/magit-clone.elc b/emacs/elpa/magit-20240625.2109/magit-clone.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/magit-commit.el b/emacs/elpa/magit-20240625.2109/magit-commit.el diff --git a/emacs/elpa/magit-20240625.2109/magit-commit.elc b/emacs/elpa/magit-20240625.2109/magit-commit.elc Binary files differ. diff --git a/emacs/elpa/magit-20240625.2109/magit-core.el b/emacs/elpa/magit-20240625.2109/magit-core.el @@ -0,0 +1,123 @@ +;;; magit-core.el --- Core functionality -*- lexical-binding:t -*- + +;; Copyright (C) 2008-2024 The Magit Project Contributors + +;; Author: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> +;; Maintainer: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; 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. +;; +;; 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 Magit. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This library requires several other libraries, so that yet other +;; libraries can just require this one, instead of having to require +;; all the other ones. In other words this separates the low-level +;; stuff from the rest. It also defines some Custom groups. + +;;; Code: + +(require 'magit-base) +(require 'magit-git) +(require 'magit-mode) +(require 'magit-margin) +(require 'magit-process) +(require 'magit-transient) +(require 'magit-autorevert) + +;;; Options + +(defgroup magit nil + "Controlling Git from Emacs." + :link '(url-link "https://magit.vc") + :link '(info-link "(magit)FAQ") + :link '(info-link "(magit)") + :group 'tools) + +(defgroup magit-essentials nil + "Options that every Magit user should briefly think about. + +Each of these options falls into one or more of these categories: + +* Options that affect Magit's behavior in fundamental ways. +* Options that affect safety. +* Options that affect performance. +* Options that are of a personal nature." + :link '(info-link "(magit)Essential Settings") + :group 'magit) + +(defgroup magit-miscellaneous nil + "Miscellaneous Magit options." + :group 'magit) + +(defgroup magit-commands nil + "Options controlling behavior of certain commands." + :group 'magit) + +(defgroup magit-modes nil + "Modes used or provided by Magit." + :group 'magit) + +(defgroup magit-buffers nil + "Options concerning Magit buffers." + :link '(info-link "(magit)Modes and Buffers") + :group 'magit) + +(defgroup magit-refresh nil + "Options controlling how Magit buffers are refreshed." + :link '(info-link "(magit)Automatic Refreshing of Magit Buffers") + :group 'magit + :group 'magit-buffers) + +(defgroup magit-faces nil + "Faces used by Magit." + :group 'magit + :group 'faces) + +(custom-add-to-group 'magit-faces 'diff-refine-added 'custom-face) +(custom-add-to-group 'magit-faces 'diff-refine-removed 'custom-face) + +(defgroup magit-extensions nil + "Extensions to Magit." + :group 'magit) + +(custom-add-to-group 'magit-modes 'git-commit 'custom-group) +(custom-add-to-group 'magit-faces 'git-commit-faces 'custom-group) +(custom-add-to-group 'magit-modes 'git-rebase 'custom-group) +(custom-add-to-group 'magit-faces 'git-rebase-faces 'custom-group) +(custom-add-to-group 'magit 'magit-section 'custom-group) +(custom-add-to-group 'magit-faces 'magit-section-faces 'custom-group) +(custom-add-to-group 'magit-process 'with-editor 'custom-group) + +(defgroup magit-related nil + "Options that are relevant to Magit but that are defined elsewhere." + :link '(custom-group-link vc) + :link '(custom-group-link smerge) + :link '(custom-group-link ediff) + :link '(custom-group-link auto-revert) + :group 'magit + :group 'magit-extensions + :group 'magit-essentials) + +(custom-add-to-group 'magit-related 'auto-revert-check-vc-info 'custom-variable) +(custom-add-to-group 'magit-auto-revert 'auto-revert-check-vc-info 'custom-variable) + +(custom-add-to-group 'magit-related 'ediff-window-setup-function 'custom-variable) +(custom-add-to-group 'magit-related 'smerge-refine-ignore-whitespace 'custom-variable) +(custom-add-to-group 'magit-related 'vc-follow-symlinks 'custom-variable) + +;;; _ +(provide 'magit-core) +;;; magit-core.el ends here diff --git a/emacs/elpa/magit-20240625.2109/magit-core.elc b/emacs/elpa/magit-20240625.2109/magit-core.elc Binary files differ. diff --git a/emacs/elpa/magit-20240625.2109/magit-diff.el b/emacs/elpa/magit-20240625.2109/magit-diff.el @@ -0,0 +1,3567 @@ +;;; magit-diff.el --- Inspect Git diffs -*- lexical-binding:t -*- + +;; Copyright (C) 2008-2024 The Magit Project Contributors + +;; Author: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> +;; Maintainer: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; 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. +;; +;; 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 Magit. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This library implements support for looking at Git diffs and +;; commits. + +;;; Code: + +(require 'magit-core) +(require 'git-commit) + +(eval-when-compile (require 'ansi-color)) +(require 'diff-mode) +(require 'image) +(require 'smerge-mode) + +;; For `magit-diff-popup' +(declare-function magit-stash-show "magit-stash" (stash &optional args files)) +;; For `magit-diff-visit-file' +(declare-function magit-find-file-noselect "magit-files" (rev file)) +(declare-function magit-status-setup-buffer "magit-status" (&optional directory)) +;; For `magit-diff-while-committing' +(declare-function magit-commit-diff-1 "magit-commit" ()) +(declare-function magit-commit-message-buffer "magit-commit" ()) +;; For `magit-insert-revision-gravatar' +(defvar gravatar-size) +;; For `magit-show-commit' and `magit-diff-show-or-scroll' +(declare-function magit-current-blame-chunk "magit-blame" (&optional type noerror)) +(declare-function magit-blame-mode "magit-blame" (&optional arg)) +(defvar magit-blame-mode) +;; For `magit-diff-show-or-scroll' +(declare-function git-rebase-current-line "git-rebase" ()) +;; For `magit-diff-unmerged' +(declare-function magit-merge-in-progress-p "magit-merge" ()) +(declare-function magit--merge-range "magit-merge" (&optional head)) +;; For `magit-diff--dwim' +(declare-function forge--pullreq-range "forge-pullreq" + (pullreq &optional endpoints)) +(declare-function forge--pullreq-ref "forge-pullreq" (pullreq)) +;; For `magit-diff-wash-diff' +(declare-function ansi-color-apply-on-region "ansi-color") +;; For `magit-diff-wash-submodule' +(declare-function magit-log-wash-log "magit-log" (style args)) +;; For keymaps and menus +(declare-function magit-apply "magit-apply" (&rest args)) +(declare-function magit-stage "magit-apply" (&optional indent)) +(declare-function magit-unstage "magit-apply" ()) +(declare-function magit-discard "magit-apply" ()) +(declare-function magit-reverse "magit-apply" (&rest args)) +(declare-function magit-file-rename "magit-files" (file newname)) +(declare-function magit-file-untrack "magit-files" (files &optional force)) +(declare-function magit-commit-add-log "magit-commit" ()) +(declare-function magit-diff-trace-definition "magit-log" ()) +(declare-function magit-patch-save "magit-patch" (files &optional arg)) +(declare-function magit-do-async-shell-command "magit-extras" (file)) +(declare-function magit-add-change-log-entry "magit-extras" + (&optional whoami file-name other-window)) +(declare-function magit-add-change-log-entry-other-window "magit-extras" + (&optional whoami file-name)) +(declare-function magit-diff-edit-hunk-commit "magit-extras" (file)) +(declare-function magit-smerge-keep-current "magit-apply" ()) +(declare-function magit-smerge-keep-upper "magit-apply" ()) +(declare-function magit-smerge-keep-base "magit-apply" ()) +(declare-function magit-smerge-keep-lower "magit-apply" ()) + +(eval-when-compile + (cl-pushnew 'orig-rev eieio--known-slot-names) + (cl-pushnew 'action-type eieio--known-slot-names) + (cl-pushnew 'target eieio--known-slot-names)) + +;;; Options +;;;; Diff Mode + +(defgroup magit-diff nil + "Inspect and manipulate Git diffs." + :link '(info-link "(magit)Diffing") + :group 'magit-commands + :group 'magit-modes) + +(defcustom magit-diff-mode-hook nil + "Hook run after entering Magit-Diff mode." + :group 'magit-diff + :type 'hook) + +(defcustom magit-diff-sections-hook + '(magit-insert-diff + magit-insert-xref-buttons) + "Hook run to insert sections into a `magit-diff-mode' buffer." + :package-version '(magit . "2.3.0") + :group 'magit-diff + :type 'hook) + +(defcustom magit-diff-expansion-threshold 60 + "After how many seconds not to expand anymore diffs. + +Except in status buffers, diffs usually start out fully expanded. +Because that can take a long time, all diffs that haven't been +fontified during a refresh before the threshold defined here are +instead displayed with their bodies collapsed. + +Note that this can cause sections that were previously expanded +to be collapsed. So you should not pick a very low value here. + +The hook function `magit-diff-expansion-threshold' has to be a +member of `magit-section-set-visibility-hook' for this option +to have any effect." + :package-version '(magit . "2.9.0") + :group 'magit-diff + :type 'float) + +(defcustom magit-diff-highlight-hunk-body t + "Whether to highlight bodies of selected hunk sections. +This only has an effect if `magit-diff-highlight' is a +member of `magit-section-highlight-hook', which see." + :package-version '(magit . "2.1.0") + :group 'magit-diff + :type 'boolean) + +(defcustom magit-diff-highlight-hunk-region-functions + '(magit-diff-highlight-hunk-region-dim-outside + magit-diff-highlight-hunk-region-using-overlays) + "The functions used to highlight the hunk-internal region. + +`magit-diff-highlight-hunk-region-dim-outside' overlays the outside +of the hunk internal selection with a face that causes the added and +removed lines to have the same background color as context lines. +This function should not be removed from the value of this option. + +`magit-diff-highlight-hunk-region-using-overlays' and +`magit-diff-highlight-hunk-region-using-underline' emphasize the +region by placing delimiting horizontal lines before and after it. +The underline variant was implemented because Eli said that is +how we should do it. However the overlay variant actually works +better. Also see https://github.com/magit/magit/issues/2758. + +Instead of, or in addition to, using delimiting horizontal lines, +to emphasize the boundaries, you may wish to emphasize the text +itself, using `magit-diff-highlight-hunk-region-using-face'. + +In terminal frames it's not possible to draw lines as the overlay +and underline variants normally do, so there they fall back to +calling the face function instead." + :package-version '(magit . "2.9.0") + :set-after '(magit-diff-show-lines-boundaries) + :group 'magit-diff + :type 'hook + :options '(magit-diff-highlight-hunk-region-dim-outside + magit-diff-highlight-hunk-region-using-underline + magit-diff-highlight-hunk-region-using-overlays + magit-diff-highlight-hunk-region-using-face)) + +(defcustom magit-diff-unmarked-lines-keep-foreground t + "Whether `magit-diff-highlight-hunk-region-dim-outside' preserves foreground. +When this is set to nil, then that function only adjusts the +foreground color but added and removed lines outside the region +keep their distinct foreground colors." + :package-version '(magit . "2.9.0") + :group 'magit-diff + :type 'boolean) + +(defcustom magit-diff-refine-hunk nil + "Whether to show word-granularity differences within diff hunks. + +nil Never show fine differences. +t Show fine differences for the current diff hunk only. +`all' Show fine differences for all displayed diff hunks." + :group 'magit-diff + :safe (lambda (val) (memq val '(nil t all))) + :type '(choice (const :tag "Never" nil) + (const :tag "Current" t) + (const :tag "All" all))) + +(defcustom magit-diff-refine-ignore-whitespace smerge-refine-ignore-whitespace + "Whether to ignore whitespace changes in word-granularity differences." + :package-version '(magit . "3.0.0") + :set-after '(smerge-refine-ignore-whitespace) + :group 'magit-diff + :safe 'booleanp + :type 'boolean) + +(put 'magit-diff-refine-hunk 'permanent-local t) + +(defcustom magit-diff-adjust-tab-width nil + "Whether to adjust the width of tabs in diffs. + +Determining the correct width can be expensive if it requires +opening large and/or many files, so the widths are cached in +the variable `magit-diff--tab-width-cache'. Set that to nil +to invalidate the cache. + +nil Never adjust tab width. Use `tab-width's value from + the Magit buffer itself instead. + +t If the corresponding file-visiting buffer exits, then + use `tab-width's value from that buffer. Doing this is + cheap, so this value is used even if a corresponding + cache entry exists. + +`always' If there is no such buffer, then temporarily visit the + file to determine the value. + +NUMBER Like `always', but don't visit files larger than NUMBER + bytes." + :package-version '(magit . "2.12.0") + :group 'magit-diff + :type '(choice (const :tag "Never" nil) + (const :tag "If file-visiting buffer exists" t) + (integer :tag "If file isn't larger than N bytes") + (const :tag "Always" always))) + +(defcustom magit-diff-paint-whitespace t + "Specify where to highlight whitespace errors. + +nil Never highlight whitespace errors. +t Highlight whitespace errors everywhere. +`uncommitted' Only highlight whitespace errors in diffs + showing uncommitted changes. + +For backward compatibility `status' is treated as a synonym +for `uncommitted'. + +The option `magit-diff-paint-whitespace-lines' controls for +what lines (added/remove/context) errors are highlighted. + +The options `magit-diff-highlight-trailing' and +`magit-diff-highlight-indentation' control what kind of +whitespace errors are highlighted." + :group 'magit-diff + :safe (lambda (val) (memq val '(t nil uncommitted status))) + :type '(choice (const :tag "In all diffs" t) + (const :tag "Only in uncommitted changes" uncommitted) + (const :tag "Never" nil))) + +(defcustom magit-diff-paint-whitespace-lines t + "Specify in what kind of lines to highlight whitespace errors. + +t Highlight only in added lines. +`both' Highlight in added and removed lines. +`all' Highlight in added, removed and context lines." + :package-version '(magit . "3.0.0") + :group 'magit-diff + :safe (lambda (val) (memq val '(t both all))) + :type '(choice (const :tag "in added lines" t) + (const :tag "in added and removed lines" both) + (const :tag "in added, removed and context lines" all))) + +(defcustom magit-diff-highlight-trailing t + "Whether to highlight whitespace at the end of a line in diffs. +Used only when `magit-diff-paint-whitespace' is non-nil." + :group 'magit-diff + :safe 'booleanp + :type 'boolean) + +(defcustom magit-diff-highlight-indentation nil + "Highlight the \"wrong\" indentation style. +Used only when `magit-diff-paint-whitespace' is non-nil. + +The value is an alist of the form ((REGEXP . INDENT)...). The +path to the current repository is matched against each element +in reverse order. Therefore if a REGEXP matches, then earlier +elements are not tried. + +If the used INDENT is `tabs', highlight indentation with tabs. +If INDENT is an integer, highlight indentation with at least +that many spaces. Otherwise, highlight neither." + :group 'magit-diff + :type `(repeat (cons (string :tag "Directory regexp") + (choice (const :tag "Tabs" tabs) + (integer :tag "Spaces" :value ,tab-width) + (const :tag "Neither" nil))))) + +(defcustom magit-diff-hide-trailing-cr-characters + (and (memq system-type '(ms-dos windows-nt)) t) + "Whether to hide ^M characters at the end of a line in diffs." + :package-version '(magit . "2.6.0") + :group 'magit-diff + :type 'boolean) + +(defcustom magit-diff-highlight-keywords t + "Whether to highlight bracketed keywords in commit messages." + :package-version '(magit . "2.12.0") + :group 'magit-diff + :type 'boolean) + +(defcustom magit-diff-extra-stat-arguments nil + "Additional arguments to be used alongside `--stat'. + +A list of zero or more arguments or a function that takes no +argument and returns such a list. These arguments are allowed +here: `--stat-width', `--stat-name-width', `--stat-graph-width' +and `--compact-summary'. See the git-diff(1) manpage." + :package-version '(magit . "3.0.0") + :group 'magit-diff + :type '(radio (function-item magit-diff-use-window-width-as-stat-width) + function + (list string) + (const :tag "None" nil))) + +;;;; File Diff + +(defcustom magit-diff-buffer-file-locked t + "Whether `magit-diff-buffer-file' uses a dedicated buffer." + :package-version '(magit . "2.7.0") + :group 'magit-commands + :group 'magit-diff + :type 'boolean) + +;;;; Revision Mode + +(defgroup magit-revision nil + "Inspect and manipulate Git commits." + :link '(info-link "(magit)Revision Buffer") + :group 'magit-modes) + +(defcustom magit-revision-mode-hook + '(bug-reference-mode + goto-address-mode) + "Hook run after entering Magit-Revision mode." + :group 'magit-revision + :type 'hook + :options '(bug-reference-mode + goto-address-mode)) + +(defcustom magit-revision-sections-hook + '(magit-insert-revision-tag + magit-insert-revision-headers + magit-insert-revision-message + magit-insert-revision-notes + magit-insert-revision-diff + magit-insert-xref-buttons) + "Hook run to insert sections into a `magit-revision-mode' buffer." + :package-version '(magit . "2.3.0") + :group 'magit-revision + :type 'hook) + +(defcustom magit-revision-headers-format "\ +Author: %aN <%aE> +AuthorDate: %ad +Commit: %cN <%cE> +CommitDate: %cd +" + "Format string used to insert headers in revision buffers. + +All headers in revision buffers are inserted by the section +inserter `magit-insert-revision-headers'. Some of the headers +are created by calling `git show --format=FORMAT' where FORMAT +is the format specified here. Other headers are hard coded or +subject to option `magit-revision-insert-related-refs'." + :package-version '(magit . "2.3.0") + :group 'magit-revision + :type 'string) + +(defcustom magit-revision-insert-related-refs t + "Whether to show related branches in revision buffers + +`nil' Don't show any related branches. +`t' Show related local branches. +`all' Show related local and remote branches. +`mixed' Show all containing branches and local merged branches. + +See user option `magit-revision-insert-related-refs-display-alist' +to hide specific sets of related branches." + :package-version '(magit . "2.1.0") + :group 'magit-revision + :type '(choice (const :tag "don't" nil) + (const :tag "local only" t) + (const :tag "all related" all) + (const :tag "all containing, local merged" mixed))) + +(defcustom magit-revision-insert-related-refs-display-alist nil + "How `magit-insert-revision-headers' displays related branch types. + +This is an alist, with recognised keys being the symbols +`parents', `merged', `contained', `follows', and `precedes'; +and the supported values for each key being: + +`nil' Hide these related branches. +`t' Show these related branches. + +Keys which are not present in the alist have an implicit value `t' +\(so the default alist value of nil means all related branch types +will be shown.) + +The types to be shown are additionally subject to user option +`magit-revision-insert-related-refs'." + :package-version '(magit . "3.3.1") + :group 'magit-revision + :type '(alist :key-type (symbol :tag "Type of related branch") + :value-type (boolean :tag "Display")) + :options (mapcar (lambda (sym) + `(,sym (choice (const :tag "Hide" nil) + (const :tag "Show" t)))) + '(parents merged contained follows precedes))) + +(defcustom magit-revision-use-hash-sections 'quicker + "Whether to turn hashes inside the commit message into sections. + +If non-nil, then hashes inside the commit message are turned into +`commit' sections. There is a trade off to be made between +performance and reliability: + +- `slow' calls git for every word to be absolutely sure. +- `quick' skips words less than seven characters long. +- `quicker' additionally skips words that don't contain a number. +- `quickest' uses all words that are at least seven characters + long and which contain at least one number as well as at least + one letter. + +If nil, then no hashes are turned into sections, but you can +still visit the commit at point using \"RET\"." + :package-version '(magit . "2.12.0") + :group 'magit-revision + :type '(choice (const :tag "Use sections, quickest" quickest) + (const :tag "Use sections, quicker" quicker) + (const :tag "Use sections, quick" quick) + (const :tag "Use sections, slow" slow) + (const :tag "Don't use sections" nil))) + +(defcustom magit-revision-show-gravatars nil + "Whether to show gravatar images in revision buffers. + +If nil, then don't insert any gravatar images. If t, then insert +both images. If `author' or `committer', then insert only the +respective image. + +If you have customized the option `magit-revision-header-format' +and want to insert the images then you might also have to specify +where to do so. In that case the value has to be a cons-cell of +two regular expressions. The car specifies where to insert the +author's image. The top half of the image is inserted right +after the matched text, the bottom half on the next line in the +same column. The cdr specifies where to insert the committer's +image, accordingly. Either the car or the cdr may be nil." + :package-version '(magit . "2.3.0") + :group 'magit-revision + :type '(choice + (const :tag "Don't show gravatars" nil) + (const :tag "Show gravatars" t) + (const :tag "Show author gravatar" author) + (const :tag "Show committer gravatar" committer) + (cons :tag "Show gravatars using custom regexps" + (choice (const :tag "No author image" nil) + (regexp :tag "Author regexp" "^Author: ")) + (choice (const :tag "No committer image" nil) + (regexp :tag "Committer regexp" "^Commit: "))))) + +(defcustom magit-revision-fill-summary-line nil + "Whether to fill excessively long summary lines. + +If this is an integer, then the summary line is filled if it is +longer than either the limit specified here or `window-width'. + +You may want to only set this locally in \".dir-locals-2.el\" for +repositories known to contain bad commit messages. + +The body of the message is left alone because (a) most people who +write excessively long summary lines usually don't add a body and +\(b) even people who have the decency to wrap their lines may have +a good reason to include a long line in the body sometimes." + :package-version '(magit . "2.90.0") + :group 'magit-revision + :type '(choice (const :tag "Don't fill" nil) + (integer :tag "Fill if longer than"))) + +(defcustom magit-revision-filter-files-on-follow nil + "Whether to honor file filter if log arguments include --follow. + +When a commit is displayed from a log buffer, the resulting +revision buffer usually shares the log's file arguments, +restricting the diff to those files. However, there's a +complication when the log arguments include --follow: if the log +follows a file across a rename event, keeping the file +restriction would mean showing an empty diff in revision buffers +for commits before the rename event. + +When this option is nil, the revision buffer ignores the log's +filter if the log arguments include --follow. If non-nil, the +log's file filter is always honored." + :package-version '(magit . "3.0.0") + :group 'magit-revision + :type 'boolean) + +;;;; Visit Commands + +(defcustom magit-diff-visit-previous-blob t + "Whether `magit-diff-visit-file' may visit the previous blob. + +When this is t and point is on a removed line in a diff for a +committed change, then `magit-diff-visit-file' visits the blob +from the last revision which still had that line. + +Currently this is only supported for committed changes, for +staged and unstaged changes `magit-diff-visit-file' always +visits the file in the working tree." + :package-version '(magit . "2.9.0") + :group 'magit-diff + :type 'boolean) + +(defcustom magit-diff-visit-avoid-head-blob nil + "Whether `magit-diff-visit-file' avoids visiting a blob from `HEAD'. + +By default `magit-diff-visit-file' always visits the blob that +added the current line, while `magit-diff-visit-worktree-file' +visits the respective file in the working tree. For the `HEAD' +commit, the former command used to visit the worktree file too, +but that made it impossible to visit a blob from `HEAD'. + +When point is on a removed line and that change has not been +committed yet, then `magit-diff-visit-file' now visits the last +blob that still had that line, which is a blob from `HEAD'. +Previously this function used to visit the worktree file not +only for added lines but also for such removed lines. + +If you prefer the old behaviors, then set this to t." + :package-version '(magit . "3.0.0") + :group 'magit-diff + :type 'boolean) + +;;; Faces + +(defface magit-diff-file-heading + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :weight bold)) + "Face for diff file headings." + :group 'magit-faces) + +(defface magit-diff-file-heading-highlight + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :inherit magit-section-highlight)) + "Face for current diff file headings." + :group 'magit-faces) + +(defface magit-diff-file-heading-selection + `((((class color) (background light)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :inherit magit-diff-file-heading-highlight + :foreground "salmon4") + (((class color) (background dark)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :inherit magit-diff-file-heading-highlight + :foreground "LightSalmon3")) + "Face for selected diff file headings." + :group 'magit-faces) + +(defface magit-diff-hunk-heading + `((((class color) (background light)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :background "grey90" + :foreground "grey20") + (((class color) (background dark)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :background "grey25" + :foreground "grey95")) + "Face for diff hunk headings." + :group 'magit-faces) + +(defface magit-diff-hunk-heading-highlight + `((((class color) (background light)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :background "grey80" + :foreground "grey20") + (((class color) (background dark)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :background "grey35" + :foreground "grey95")) + "Face for current diff hunk headings." + :group 'magit-faces) + +(defface magit-diff-hunk-heading-selection + `((((class color) (background light)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :inherit magit-diff-hunk-heading-highlight + :foreground "salmon4") + (((class color) (background dark)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :inherit magit-diff-hunk-heading-highlight + :foreground "LightSalmon3")) + "Face for selected diff hunk headings." + :group 'magit-faces) + +(defface magit-diff-hunk-region + `((t :inherit bold + ,@(and (>= emacs-major-version 27) + (list :extend (ignore-errors (face-attribute 'region :extend)))))) + "Face used by `magit-diff-highlight-hunk-region-using-face'. + +This face is overlaid over text that uses other hunk faces, +and those normally set the foreground and background colors. +The `:foreground' and especially the `:background' properties +should be avoided here. Setting the latter would cause the +loss of information. Good properties to set here are `:weight' +and `:slant'." + :group 'magit-faces) + +(defface magit-diff-revision-summary + '((t :inherit magit-diff-hunk-heading)) + "Face for commit message summaries." + :group 'magit-faces) + +(defface magit-diff-revision-summary-highlight + '((t :inherit magit-diff-hunk-heading-highlight)) + "Face for highlighted commit message summaries." + :group 'magit-faces) + +(defface magit-diff-lines-heading + `((((class color) (background light)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :inherit magit-diff-hunk-heading-highlight + :background "LightSalmon3") + (((class color) (background dark)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :inherit magit-diff-hunk-heading-highlight + :foreground "grey80" + :background "salmon4")) + "Face for diff hunk heading when lines are marked." + :group 'magit-faces) + +(defface magit-diff-lines-boundary + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) ; !important + :inherit magit-diff-lines-heading)) + "Face for boundary of marked lines in diff hunk." + :group 'magit-faces) + +(defface magit-diff-conflict-heading + '((t :inherit magit-diff-hunk-heading)) + "Face for conflict markers." + :group 'magit-faces) + +(defface magit-diff-added + `((((class color) (background light)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :background "#ddffdd" + :foreground "#22aa22") + (((class color) (background dark)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :background "#335533" + :foreground "#ddffdd")) + "Face for lines in a diff that have been added." + :group 'magit-faces) + +(defface magit-diff-removed + `((((class color) (background light)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :background "#ffdddd" + :foreground "#aa2222") + (((class color) (background dark)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :background "#553333" + :foreground "#ffdddd")) + "Face for lines in a diff that have been removed." + :group 'magit-faces) + +(defface magit-diff-our + '((t :inherit magit-diff-removed)) + "Face for lines in a diff for our side in a conflict." + :group 'magit-faces) + +(defface magit-diff-base + `((((class color) (background light)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :background "#ffffcc" + :foreground "#aaaa11") + (((class color) (background dark)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :background "#555522" + :foreground "#ffffcc")) + "Face for lines in a diff for the base side in a conflict." + :group 'magit-faces) + +(defface magit-diff-their + '((t :inherit magit-diff-added)) + "Face for lines in a diff for their side in a conflict." + :group 'magit-faces) + +(defface magit-diff-context + `((((class color) (background light)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "grey50") + (((class color) (background dark)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "grey70")) + "Face for lines in a diff that are unchanged." + :group 'magit-faces) + +(defface magit-diff-added-highlight + `((((class color) (background light)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :background "#cceecc" + :foreground "#22aa22") + (((class color) (background dark)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :background "#336633" + :foreground "#cceecc")) + "Face for lines in a diff that have been added." + :group 'magit-faces) + +(defface magit-diff-removed-highlight + `((((class color) (background light)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :background "#eecccc" + :foreground "#aa2222") + (((class color) (background dark)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :background "#663333" + :foreground "#eecccc")) + "Face for lines in a diff that have been removed." + :group 'magit-faces) + +(defface magit-diff-our-highlight + '((t :inherit magit-diff-removed-highlight)) + "Face for lines in a diff for our side in a conflict." + :group 'magit-faces) + +(defface magit-diff-base-highlight + `((((class color) (background light)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :background "#eeeebb" + :foreground "#aaaa11") + (((class color) (background dark)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :background "#666622" + :foreground "#eeeebb")) + "Face for lines in a diff for the base side in a conflict." + :group 'magit-faces) + +(defface magit-diff-their-highlight + '((t :inherit magit-diff-added-highlight)) + "Face for lines in a diff for their side in a conflict." + :group 'magit-faces) + +(defface magit-diff-context-highlight + `((((class color) (background light)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :background "grey95" + :foreground "grey50") + (((class color) (background dark)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :background "grey20" + :foreground "grey70")) + "Face for lines in the current context in a diff." + :group 'magit-faces) + +(defface magit-diff-whitespace-warning + '((t :inherit trailing-whitespace)) + "Face for highlighting whitespace errors added lines." + :group 'magit-faces) + +(defface magit-diffstat-added + '((((class color) (background light)) :foreground "#22aa22") + (((class color) (background dark)) :foreground "#448844")) + "Face for plus sign in diffstat." + :group 'magit-faces) + +(defface magit-diffstat-removed + '((((class color) (background light)) :foreground "#aa2222") + (((class color) (background dark)) :foreground "#aa4444")) + "Face for minus sign in diffstat." + :group 'magit-faces) + +;;; Arguments +;;;; Prefix Classes + +(defclass magit-diff-prefix (transient-prefix) + ((history-key :initform 'magit-diff) + (major-mode :initform 'magit-diff-mode))) + +(defclass magit-diff-refresh-prefix (magit-diff-prefix) + ((history-key :initform 'magit-diff) + (major-mode :initform nil))) + +;;;; Prefix Methods + +(cl-defmethod transient-init-value ((obj magit-diff-prefix)) + (pcase-let ((`(,args ,files) + (magit-diff--get-value 'magit-diff-mode + magit-prefix-use-buffer-arguments))) + (unless (eq transient-current-command 'magit-dispatch) + (when-let ((file (magit-file-relative-name))) + (setq files (list file)))) + (oset obj value (if files `(("--" ,@files) ,args) args)))) + +(cl-defmethod transient-init-value ((obj magit-diff-refresh-prefix)) + (oset obj value (if magit-buffer-diff-files + `(("--" ,@magit-buffer-diff-files) + ,magit-buffer-diff-args) + magit-buffer-diff-args))) + +(cl-defmethod transient-set-value ((obj magit-diff-prefix)) + (magit-diff--set-value obj)) + +(cl-defmethod transient-save-value ((obj magit-diff-prefix)) + (magit-diff--set-value obj 'save)) + +;;;; Argument Access + +(defun magit-diff-arguments (&optional mode) + "Return the current diff arguments." + (if (memq transient-current-command '(magit-diff magit-diff-refresh)) + (magit--transient-args-and-files) + (magit-diff--get-value (or mode 'magit-diff-mode)))) + +(defun magit-diff--get-value (mode &optional use-buffer-args) + (unless use-buffer-args + (setq use-buffer-args magit-direct-use-buffer-arguments)) + (let (args files) + (cond + ((and (memq use-buffer-args '(always selected current)) + (eq major-mode mode)) + (setq args magit-buffer-diff-args) + (setq files magit-buffer-diff-files)) + ((and (memq use-buffer-args '(always selected)) + (when-let ((buffer (magit-get-mode-buffer + mode nil + (eq use-buffer-args 'selected)))) + (setq args (buffer-local-value 'magit-buffer-diff-args buffer)) + (setq files (buffer-local-value 'magit-buffer-diff-files buffer)) + t))) + ((plist-member (symbol-plist mode) 'magit-diff-current-arguments) + (setq args (get mode 'magit-diff-current-arguments))) + ((when-let ((elt (assq (intern (format "magit-diff:%s" mode)) + transient-values))) + (setq args (cdr elt)) + t)) + (t + (setq args (get mode 'magit-diff-default-arguments)))) + (list args files))) + +(defun magit-diff--set-value (obj &optional save) + (pcase-let* ((obj (oref obj prototype)) + (mode (or (oref obj major-mode) major-mode)) + (key (intern (format "magit-diff:%s" mode))) + (`(,args ,files) (magit--transient-args-and-files))) + (put mode 'magit-diff-current-arguments args) + (when save + (setf (alist-get key transient-values) args) + (transient-save-values)) + (transient--history-push obj) + (setq magit-buffer-diff-args args) + (setq magit-buffer-diff-files files) + (magit-refresh))) + +;;; Commands +;;;; Prefix Commands + +;;;###autoload (autoload 'magit-diff "magit-diff" nil t) +(transient-define-prefix magit-diff () + "Show changes between different versions." + :man-page "git-diff" + :class 'magit-diff-prefix + ["Limit arguments" + (magit:--) + (magit-diff:--ignore-submodules) + ("-b" "Ignore whitespace changes" ("-b" "--ignore-space-change")) + ("-w" "Ignore all whitespace" ("-w" "--ignore-all-space")) + (5 "-D" "Omit preimage for deletes" ("-D" "--irreversible-delete"))] + ["Context arguments" + (magit-diff:-U) + ("-W" "Show surrounding functions" ("-W" "--function-context"))] + ["Tune arguments" + (magit-diff:--diff-algorithm) + (magit-diff:--diff-merges) + (magit-diff:-M) + (magit-diff:-C) + (5 "-R" "Reverse sides" "-R") + (5 magit-diff:--color-moved) + (5 magit-diff:--color-moved-ws) + ("-x" "Disallow external diff drivers" "--no-ext-diff") + ("-s" "Show stats" "--stat") + ("=g" "Show signature" "--show-signature")] + ["Actions" + [("d" "Dwim" magit-diff-dwim) + ("r" "Diff range" magit-diff-range) + ("p" "Diff paths" magit-diff-paths)] + [("u" "Diff unstaged" magit-diff-unstaged) + ("s" "Diff staged" magit-diff-staged) + ("w" "Diff worktree" magit-diff-working-tree)] + [("c" "Show commit" magit-show-commit) + ("t" "Show stash" magit-stash-show)]]) + +;;;###autoload (autoload 'magit-diff-refresh "magit-diff" nil t) +(transient-define-prefix magit-diff-refresh () + "Change the arguments used for the diff(s) in the current buffer." + :man-page "git-diff" + :class 'magit-diff-refresh-prefix + ["Limit arguments" + (magit:--) + (magit-diff:--ignore-submodules) + ("-b" "Ignore whitespace changes" ("-b" "--ignore-space-change")) + ("-w" "Ignore all whitespace" ("-w" "--ignore-all-space")) + (5 "-D" "Omit preimage for deletes" ("-D" "--irreversible-delete"))] + ["Context arguments" + (magit-diff:-U) + ("-W" "Show surrounding functions" ("-W" "--function-context"))] + ["Tune arguments" + (magit-diff:--diff-algorithm) + (magit-diff:--diff-merges) + (magit-diff:-M) + (magit-diff:-C) + (5 "-R" "Reverse sides" "-R" + :if-derived magit-diff-mode) + (5 magit-diff:--color-moved) + (5 magit-diff:--color-moved-ws) + ("-x" "Disallow external diff drivers" "--no-ext-diff") + ("-s" "Show stats" "--stat" + :if-derived magit-diff-mode) + ("=g" "Show signature" "--show-signature" + :if-derived magit-diff-mode)] + [["Refresh" + ("g" "buffer" magit-diff-refresh) + ("s" "buffer and set defaults" transient-set-and-exit) + ("w" "buffer and save defaults" transient-save-and-exit)] + ["Toggle" + ("t" "hunk refinement" magit-diff-toggle-refine-hunk) + ("F" "file filter" magit-diff-toggle-file-filter) + ("b" "buffer lock" magit-toggle-buffer-lock + :if-mode (magit-diff-mode magit-revision-mode magit-stash-mode))] + [:if-mode magit-diff-mode + :description "Do" + ("r" "switch range type" magit-diff-switch-range-type) + ("f" "flip revisions" magit-diff-flip-revs)]] + (interactive) + (when (derived-mode-p 'magit-merge-preview-mode) + (user-error "Cannot use %s in %s" this-command major-mode)) + (if (not (eq transient-current-command 'magit-diff-refresh)) + (transient-setup 'magit-diff-refresh) + (pcase-let ((`(,args ,files) (magit-diff-arguments))) + (setq magit-buffer-diff-args args) + (setq magit-buffer-diff-files files)) + (magit-refresh))) + +;;;; Infix Commands + +(transient-define-argument magit:-- () + :description "Limit to files" + :class 'transient-files + :key "--" + :argument "--" + :prompt "Limit to file,s: " + :reader #'magit-read-files + :multi-value t) + +(defun magit-read-files (prompt initial-input history &optional list-fn) + (magit-with-toplevel + (magit-completing-read-multiple prompt + (funcall (or list-fn #'magit-list-files)) + nil nil + (or initial-input (magit-file-at-point)) + history))) + +(transient-define-argument magit-diff:-U () + :description "Context lines" + :class 'transient-option + :argument "-U" + :reader #'transient-read-number-N0) + +(transient-define-argument magit-diff:-M () + :description "Detect renames" + :class 'transient-option + :argument "-M" + :allow-empty t + :reader #'transient-read-number-N+) + +(transient-define-argument magit-diff:-C () + :description "Detect copies" + :class 'transient-option + :argument "-C" + :allow-empty t + :reader #'transient-read-number-N+) + +(transient-define-argument magit-diff:--diff-algorithm () + :description "Diff algorithm" + :class 'transient-option + :key "-A" + :argument "--diff-algorithm=" + :reader #'magit-diff-select-algorithm + :always-read t) + +(defun magit-diff-select-algorithm (&rest _ignore) + (magit-read-char-case nil t + (?u "[u]nspecified" nil) + (?d "[d]efault" "default") + (?m "[m]inimal" "minimal") + (?p "[p]atience" "patience") + (?h "[h]istogram" "histogram"))) + +(transient-define-argument magit-diff:--diff-merges () + :description "Diff merges" + :class 'transient-option + :key "-X" + :argument "--diff-merges=" + :reader #'magit-diff-select-merges + :always-read t) + +(defun magit-diff-select-merges (&rest _ignore) + (magit-read-char-case nil t + (?u "[u]nspecified" nil) + (?o "[o]ff" "off") + (?f "[f]irst-parent" "first-parent") + (?c "[c]ombined" "combined") + (?d "[d]ense-combined" "dense-combined"))) + +(transient-define-argument magit-diff:--ignore-submodules () + :description "Ignore submodules" + :class 'transient-option + :key "-i" + :argument "--ignore-submodules=" + :reader #'magit-diff-select-ignore-submodules) + +(defun magit-diff-select-ignore-submodules (&rest _ignored) + (magit-read-char-case "Ignore submodules " t + (?u "[u]ntracked" "untracked") + (?d "[d]irty" "dirty") + (?a "[a]ll" "all"))) + +(transient-define-argument magit-diff:--color-moved () + :description "Color moved lines" + :class 'transient-option + :key "-m" + :argument "--color-moved=" + :reader #'magit-diff-select-color-moved-mode) + +(defun magit-diff-select-color-moved-mode (&rest _ignore) + (magit-read-char-case "Color moved " t + (?d "[d]efault" "default") + (?p "[p]lain" "plain") + (?b "[b]locks" "blocks") + (?z "[z]ebra" "zebra") + (?Z "[Z] dimmed-zebra" "dimmed-zebra"))) + +(transient-define-argument magit-diff:--color-moved-ws () + :description "Whitespace treatment for --color-moved" + :class 'transient-option + :key "=w" + :argument "--color-moved-ws=" + :reader #'magit-diff-select-color-moved-ws-mode) + +(defun magit-diff-select-color-moved-ws-mode (&rest _ignore) + (magit-read-char-case "Ignore whitespace " t + (?i "[i]ndentation" "allow-indentation-change") + (?e "[e]nd of line" "ignore-space-at-eol") + (?s "[s]pace change" "ignore-space-change") + (?a "[a]ll space" "ignore-all-space") + (?n "[n]o" "no"))) + +;;;; Setup Commands + +;;;###autoload +(defun magit-diff-dwim (&optional args files) + "Show changes for the thing at point." + (interactive (magit-diff-arguments)) + (let ((default-directory default-directory) + (section (magit-current-section))) + (cond + ((magit-section-match 'module section) + (setq default-directory + (expand-file-name + (file-name-as-directory (oref section value)))) + (magit-diff-range (oref section range))) + (t + (when (magit-section-match 'module-commit section) + (setq args nil) + (setq files nil) + (setq default-directory + (expand-file-name + (file-name-as-directory (magit-section-parent-value section))))) + (pcase (magit-diff--dwim) + ('unmerged (magit-diff-unmerged args files)) + ('unstaged (magit-diff-unstaged args files)) + ('staged + (let ((file (magit-file-at-point))) + (if (and file (equal (cddr (car (magit-file-status file))) '(?D ?U))) + ;; File was deleted by us and modified by them. Show the latter. + (magit-diff-unmerged args (list file)) + (magit-diff-staged nil args files)))) + (`(stash . ,value) (magit-stash-show value args)) + (`(commit . ,value) + (magit-diff-range (format "%s^..%s" value value) args files)) + ((and range (pred stringp)) + (magit-diff-range range args files)) + (_ (call-interactively #'magit-diff-range))))))) + +(defun magit-diff--dwim () + "Return information for performing DWIM diff. + +The information can be in three forms: +1. TYPE + A symbol describing a type of diff where no additional information + is needed to generate the diff. Currently, this includes `staged', + `unstaged' and `unmerged'. +2. (TYPE . VALUE) + Like #1 but the diff requires additional information, which is + given by VALUE. Currently, this includes `commit' and `stash', + where VALUE is the given commit or stash, respectively. +3. RANGE + A string indicating a diff range. + +If no DWIM context is found, nil is returned." + (cond + ((and-let* ((commits (magit-region-values '(commit branch) t))) + (progn + (deactivate-mark) + (concat (car (last commits)) ".." (car commits))))) + (magit-buffer-refname + (cons 'commit magit-buffer-refname)) + ((derived-mode-p 'magit-stash-mode) + (cons 'commit + (magit-section-case + (commit (oref it value)) + (file (thread-first it + (oref parent) + (oref value))) + (hunk (thread-first it + (oref parent) + (oref parent) + (oref value)))))) + ((derived-mode-p 'magit-revision-mode) + (cons 'commit magit-buffer-revision)) + ((derived-mode-p 'magit-diff-mode) + magit-buffer-range) + (t + (magit-section-case + ([* unstaged] 'unstaged) + ([* staged] 'staged) + (unmerged 'unmerged) + (unpushed (magit-diff--range-to-endpoints (oref it value))) + (unpulled (magit-diff--range-to-endpoints (oref it value))) + (branch (let ((current (magit-get-current-branch)) + (atpoint (oref it value))) + (if (equal atpoint current) + (if-let ((upstream (magit-get-upstream-branch))) + (format "%s...%s" upstream current) + (if (magit-anything-modified-p) + current + (cons 'commit current))) + (format "%s...%s" + (or current "HEAD") + atpoint)))) + (commit (cons 'commit (oref it value))) + ([file commit] (cons 'commit (oref (oref it parent) value))) + ([hunk file commit] + (cons 'commit (oref (oref (oref it parent) parent) value))) + (stash (cons 'stash (oref it value))) + (pullreq (forge--pullreq-range (oref it value) t)))))) + +(defun magit-diff--range-to-endpoints (range) + (cond ((string-match "\\.\\.\\." range) (replace-match ".." nil nil range)) + ((string-match "\\.\\." range) (replace-match "..." nil nil range)) + (t range))) + +(defun magit-diff--region-range (&optional interactive mbase) + (and-let* ((commits (magit-region-values '(commit branch) t)) + (revA (car (last commits))) + (revB (car commits))) + (progn + (when interactive + (deactivate-mark)) + (if mbase + (let ((base (magit-git-string "merge-base" revA revB))) + (cond + ((string= (magit-rev-parse revA) base) + (format "%s..%s" revA revB)) + ((string= (magit-rev-parse revB) base) + (format "%s..%s" revB revA)) + (interactive + (let ((main (magit-completing-read "View changes along" + (list revA revB) + nil t nil nil revB))) + (format "%s...%s" + (if (string= main revB) revA revB) main))) + (t "%s...%s" revA revB))) + (format "%s..%s" revA revB))))) + +(defun magit-diff-read-range-or-commit (prompt &optional secondary-default mbase) + "Read range or revision with special diff range treatment. +If MBASE is non-nil, prompt for which rev to place at the end of +a \"revA...revB\" range. Otherwise, always construct +\"revA..revB\" range." + (or (magit-diff--region-range t mbase) + (magit-read-range prompt + (or (pcase (magit-diff--dwim) + (`(commit . ,value) + (format "%s^..%s" value value)) + ((and range (pred stringp)) + range)) + secondary-default + (magit-get-current-branch))))) + +;;;###autoload +(defun magit-diff-range (rev-or-range &optional args files) + "Show differences between two commits. + +REV-OR-RANGE should be a range or a single revision. If it is a +revision, then show changes in the working tree relative to that +revision. If it is a range, but one side is omitted, then show +changes relative to `HEAD'. + +If the region is active, use the revisions on the first and last +line of the region as the two sides of the range. With a prefix +argument, instead of diffing the revisions, choose a revision to +view changes along, starting at the common ancestor of both +revisions (i.e., use a \"...\" range)." + (interactive (cons (magit-diff-read-range-or-commit "Diff for range" + nil current-prefix-arg) + (magit-diff-arguments))) + (magit-diff-setup-buffer rev-or-range nil args files 'committed)) + +;;;###autoload +(defun magit-diff-working-tree (&optional rev args files) + "Show changes between the current working tree and the `HEAD' commit. +With a prefix argument show changes between the working tree and +a commit read from the minibuffer." + (interactive + (cons (and current-prefix-arg + (magit-read-branch-or-commit "Diff working tree and commit")) + (magit-diff-arguments))) + (magit-diff-setup-buffer (or rev "HEAD") nil args files 'unstaged)) + +;;;###autoload +(defun magit-diff-staged (&optional rev args files) + "Show changes between the index and the `HEAD' commit. +With a prefix argument show changes between the index and +a commit read from the minibuffer." + (interactive + (cons (and current-prefix-arg + (magit-read-branch-or-commit "Diff index and commit")) + (magit-diff-arguments))) + (magit-diff-setup-buffer rev "--cached" args files 'staged)) + +;;;###autoload +(defun magit-diff-unstaged (&optional args files) + "Show changes between the working tree and the index." + (interactive (magit-diff-arguments)) + (magit-diff-setup-buffer nil nil args files 'unstaged)) + +;;;###autoload +(defun magit-diff-unmerged (&optional args files) + "Show changes that are being merged." + (interactive (magit-diff-arguments)) + (unless (magit-merge-in-progress-p) + (user-error "No merge is in progress")) + (magit-diff-setup-buffer (magit--merge-range) nil args files 'committed)) + +;;;###autoload +(defun magit-diff-while-committing () + "While committing, show the changes that are about to be committed. +While amending, invoking the command again toggles between +showing just the new changes or all the changes that will +be committed." + (interactive) + (unless (magit-commit-message-buffer) + (user-error "No commit in progress")) + (magit-commit-diff-1)) + +(keymap-set git-commit-mode-map "C-c C-d" #'magit-diff-while-committing) + +;;;###autoload +(defun magit-diff-buffer-file () + "Show diff for the blob or file visited in the current buffer. + +When the buffer visits a blob, then show the respective commit. +When the buffer visits a file, then show the differences between +`HEAD' and the working tree. In both cases limit the diff to +the file or blob." + (interactive) + (require 'magit) + (if-let ((file (magit-file-relative-name))) + (if magit-buffer-refname + (magit-show-commit magit-buffer-refname + (car (magit-show-commit--arguments)) + (list file)) + (save-buffer) + (let ((line (line-number-at-pos)) + (col (current-column))) + (with-current-buffer + (magit-diff-setup-buffer (or (magit-get-current-branch) "HEAD") + nil + (car (magit-diff-arguments)) + (list file) + 'unstaged + magit-diff-buffer-file-locked) + (magit-diff--goto-position file line col)))) + (user-error "Buffer isn't visiting a file"))) + +;;;###autoload +(defun magit-diff-paths (a b) + "Show changes between any two files on disk." + (interactive (list (read-file-name "First file: " nil nil t) + (read-file-name "Second file: " nil nil t))) + (magit-diff-setup-buffer nil "--no-index" nil + (list (magit-convert-filename-for-git + (expand-file-name a)) + (magit-convert-filename-for-git + (expand-file-name b))) + 'undefined)) + +(defun magit-show-commit--arguments () + (pcase-let ((`(,args ,diff-files) + (magit-diff-arguments 'magit-revision-mode))) + (list args (if (derived-mode-p 'magit-log-mode) + (and (or magit-revision-filter-files-on-follow + (not (member "--follow" magit-buffer-log-args))) + magit-buffer-log-files) + diff-files)))) + +;;;###autoload +(defun magit-show-commit (rev &optional args files module) + "Visit the revision at point in another buffer. +If there is no revision at point or with a prefix argument prompt +for a revision." + (interactive + (pcase-let* ((mcommit (magit-section-value-if 'module-commit)) + (atpoint (or mcommit + (magit-thing-at-point 'git-revision t) + (magit-branch-or-commit-at-point))) + (`(,args ,files) (magit-show-commit--arguments))) + (list (or (and (not current-prefix-arg) atpoint) + (magit-read-branch-or-commit "Show commit" atpoint)) + args + files + (and mcommit + (magit-section-parent-value (magit-current-section)))))) + (require 'magit) + (let* ((file (magit-file-relative-name)) + (ln (and file (line-number-at-pos)))) + (magit-with-toplevel + (when module + (setq default-directory + (expand-file-name (file-name-as-directory module)))) + (unless (magit-commit-p rev) + (user-error "%s is not a commit" rev)) + (when file + (save-buffer)) + (let ((buf (magit-revision-setup-buffer rev args files))) + (when file + (let ((line (magit-diff-visit--offset file (list "-R" rev) ln)) + (col (current-column))) + (with-current-buffer buf + (magit-diff--goto-position file line col)))))))) + +(defun magit-diff--locate-hunk (file line &optional parent) + (and-let* ((diff (cl-find-if (lambda (section) + (and (cl-typep section 'magit-file-section) + (equal (oref section value) file))) + (oref (or parent magit-root-section) children)))) + (let ((hunks (oref diff children))) + (cl-block nil + (while-let ((hunk (pop hunks))) + (when-let ((range (oref hunk to-range))) + (pcase-let* ((`(,beg ,len) range) + (end (+ beg len))) + (cond ((> beg line) (cl-return (list diff nil))) + ((<= beg line end) (cl-return (list hunk t))) + ((null hunks) (cl-return (list hunk nil))))))))))) + +(defun magit-diff--goto-position (file line column &optional parent) + (when-let ((pos (magit-diff--locate-hunk file line parent))) + (pcase-let ((`(,section ,exact) pos)) + (cond ((cl-typep section 'magit-file-section) + (goto-char (oref section start))) + (exact + (goto-char (oref section content)) + (let ((pos (car (oref section to-range)))) + (while (or (< pos line) + (= (char-after) ?-)) + (unless (= (char-after) ?-) + (cl-incf pos)) + (forward-line))) + (forward-char (1+ column))) + (t + (goto-char (oref section start)) + (setq section (oref section parent)))) + (while section + (when (oref section hidden) + (magit-section-show section)) + (setq section (oref section parent)))) + (magit-section-update-highlight) + t)) + +;;;; Setting Commands + +(defun magit-diff-switch-range-type () + "Convert diff range type. +Change \"revA..revB\" to \"revA...revB\", or vice versa." + (interactive) + (if (and magit-buffer-range + (derived-mode-p 'magit-diff-mode) + (string-match magit-range-re magit-buffer-range)) + (setq magit-buffer-range + (replace-match (if (string= (match-string 2 magit-buffer-range) "..") + "..." + "..") + t t magit-buffer-range 2)) + (user-error "No range to change")) + (magit-refresh)) + +(defun magit-diff-flip-revs () + "Swap revisions in diff range. +Change \"revA..revB\" to \"revB..revA\"." + (interactive) + (if (and magit-buffer-range + (derived-mode-p 'magit-diff-mode) + (string-match magit-range-re magit-buffer-range)) + (progn + (setq magit-buffer-range + (concat (match-string 3 magit-buffer-range) + (match-string 2 magit-buffer-range) + (match-string 1 magit-buffer-range))) + (magit-refresh)) + (user-error "No range to swap"))) + +(defun magit-diff-toggle-file-filter () + "Toggle the file restriction of the current buffer's diffs. +If the current buffer's mode is derived from `magit-log-mode', +toggle the file restriction in the repository's revision buffer +instead." + (interactive) + (cl-flet ((toggle () + (if (or magit-buffer-diff-files + magit-buffer-diff-files-suspended) + (cl-rotatef magit-buffer-diff-files + magit-buffer-diff-files-suspended) + (setq magit-buffer-diff-files + (transient-infix-read 'magit:--))) + (magit-refresh))) + (cond + ((derived-mode-p 'magit-log-mode + 'magit-cherry-mode + 'magit-reflog-mode) + (if-let ((buffer (magit-get-mode-buffer 'magit-revision-mode))) + (with-current-buffer buffer (toggle)) + (message "No revision buffer"))) + ((local-variable-p 'magit-buffer-diff-files) + (toggle)) + (t + (user-error "Cannot toggle file filter in this buffer"))))) + +(defun magit-diff-less-context (&optional count) + "Decrease the context for diff hunks by COUNT lines." + (interactive "p") + (magit-diff-set-context (lambda (cur) (max 0 (- (or cur 0) count))))) + +(defun magit-diff-more-context (&optional count) + "Increase the context for diff hunks by COUNT lines." + (interactive "p") + (magit-diff-set-context (lambda (cur) (+ (or cur 0) count)))) + +(defun magit-diff-default-context () + "Reset context for diff hunks to the default height." + (interactive) + (magit-diff-set-context #'ignore)) + +(defun magit-diff-set-context (fn) + (when (derived-mode-p 'magit-merge-preview-mode) + (user-error "Cannot use %s in %s" this-command major-mode)) + (let* ((def (if-let ((context (magit-get "diff.context"))) + (string-to-number context) + 3)) + (val magit-buffer-diff-args) + (arg (--first (string-match "^-U\\([0-9]+\\)?$" it) val)) + (num (if-let ((str (and arg (match-string 1 arg)))) + (string-to-number str) + def)) + (val (delete arg val)) + (num (funcall fn num)) + (arg (and num (not (= num def)) (format "-U%d" num))) + (val (if arg (cons arg val) val))) + (setq magit-buffer-diff-args val)) + (magit-refresh)) + +(defun magit-diff-context-p () + (if-let ((arg (--first (string-match "^-U\\([0-9]+\\)$" it) + magit-buffer-diff-args))) + (not (equal arg "-U0")) + t)) + +(defun magit-diff-ignore-any-space-p () + (--any-p (member it magit-buffer-diff-args) + '("--ignore-cr-at-eol" + "--ignore-space-at-eol" + "--ignore-space-change" "-b" + "--ignore-all-space" "-w" + "--ignore-blank-space"))) + +(defun magit-diff-toggle-refine-hunk (&optional style) + "Turn diff-hunk refining on or off. + +If hunk refining is currently on, then hunk refining is turned off. +If hunk refining is off, then hunk refining is turned on, in +`selected' mode (only the currently selected hunk is refined). + +With a prefix argument, the \"third choice\" is used instead: +If hunk refining is currently on, then refining is kept on, but +the refining mode (`selected' or `all') is switched. +If hunk refining is off, then hunk refining is turned on, in +`all' mode (all hunks refined). + +Customize variable `magit-diff-refine-hunk' to change the default mode." + (interactive "P") + (setq-local magit-diff-refine-hunk + (if style + (if (eq magit-diff-refine-hunk 'all) t 'all) + (not magit-diff-refine-hunk))) + (magit-diff-update-hunk-refinement)) + +;;;; Visit Commands +;;;;; Dwim Variants + +(defun magit-diff-visit-file (file &optional other-window) + "From a diff visit the appropriate version of FILE. + +Display the buffer in the selected window. With a prefix +argument OTHER-WINDOW display the buffer in another window +instead. + +Visit the worktree version of the appropriate file. The location +of point inside the diff determines which file is being visited. +The visited version depends on what changes the diff is about. + +1. If the diff shows uncommitted changes (i.e., stage or unstaged + changes), then visit the file in the working tree (i.e., the + same \"real\" file that `find-file' would visit. In all other + cases visit a \"blob\" (i.e., the version of a file as stored + in some commit). + +2. If point is on a removed line, then visit the blob for the + first parent of the commit that removed that line, i.e., the + last commit where that line still exists. + +3. If point is on an added or context line, then visit the blob + that adds that line, or if the diff shows from more than a + single commit, then visit the blob from the last of these + commits. + +In the file-visiting buffer also go to the line that corresponds +to the line that point is on in the diff. + +Note that this command only works if point is inside a diff. +In other cases `magit-find-file' (which see) has to be used." + (interactive (list (magit-diff--file-at-point t t) current-prefix-arg)) + (magit-diff-visit-file--internal file nil + (if other-window + #'switch-to-buffer-other-window + #'pop-to-buffer-same-window))) + +(defun magit-diff-visit-file-other-window (file) + "From a diff visit the appropriate version of FILE in another window. +Like `magit-diff-visit-file' but use +`switch-to-buffer-other-window'." + (interactive (list (magit-diff--file-at-point t t))) + (magit-diff-visit-file--internal file nil #'switch-to-buffer-other-window)) + +(defun magit-diff-visit-file-other-frame (file) + "From a diff visit the appropriate version of FILE in another frame. +Like `magit-diff-visit-file' but use +`switch-to-buffer-other-frame'." + (interactive (list (magit-diff--file-at-point t t))) + (magit-diff-visit-file--internal file nil #'switch-to-buffer-other-frame)) + +;;;;; Worktree Variants + +(defun magit-diff-visit-worktree-file (file &optional other-window) + "From a diff visit the worktree version of FILE. + +Display the buffer in the selected window. With a prefix +argument OTHER-WINDOW display the buffer in another window +instead. + +Visit the worktree version of the appropriate file. The location +of point inside the diff determines which file is being visited. + +Unlike `magit-diff-visit-file' always visits the \"real\" file in +the working tree, i.e the \"current version\" of the file. + +In the file-visiting buffer also go to the line that corresponds +to the line that point is on in the diff. Lines that were added +or removed in the working tree, the index and other commits in +between are automatically accounted for." + (interactive (list (magit-file-at-point t t) current-prefix-arg)) + (magit-diff-visit-file--internal file t + (if other-window + #'switch-to-buffer-other-window + #'pop-to-buffer-same-window))) + +(defun magit-diff-visit-worktree-file-other-window (file) + "From a diff visit the worktree version of FILE in another window. +Like `magit-diff-visit-worktree-file' but use +`switch-to-buffer-other-window'." + (interactive (list (magit-file-at-point t t))) + (magit-diff-visit-file--internal file t #'switch-to-buffer-other-window)) + +(defun magit-diff-visit-worktree-file-other-frame (file) + "From a diff visit the worktree version of FILE in another frame. +Like `magit-diff-visit-worktree-file' but use +`switch-to-buffer-other-frame'." + (interactive (list (magit-file-at-point t t))) + (magit-diff-visit-file--internal file t #'switch-to-buffer-other-frame)) + +;;;;; Internal + +(defun magit-diff-visit-file--internal (file force-worktree fn) + "From a diff visit the appropriate version of FILE. +If FORCE-WORKTREE is non-nil, then visit the worktree version of +the file, even if the diff is about a committed change. Use FN +to display the buffer in some window." + (if (file-accessible-directory-p file) + (magit-diff-visit-directory file force-worktree) + (pcase-let ((`(,buf ,pos) + (magit-diff-visit-file--noselect file force-worktree))) + (funcall fn buf) + (magit-diff-visit-file--setup buf pos) + buf))) + +(defun magit-diff-visit-directory (directory &optional other-window) + "Visit DIRECTORY in some window. +Display the buffer in the selected window unless OTHER-WINDOW is +non-nil. If DIRECTORY is the top-level directory of the current +repository, then visit the containing directory using Dired and +in the Dired buffer put point on DIRECTORY. Otherwise display +the Magit-Status buffer for DIRECTORY." + (if (equal (magit-toplevel directory) + (magit-toplevel)) + (dired-jump other-window (concat directory "/.")) + (let ((display-buffer-overriding-action + (if other-window + '(nil (inhibit-same-window . t)) + '(display-buffer-same-window)))) + (magit-status-setup-buffer directory)))) + +(defun magit-diff-visit-file--setup (buf pos) + (if-let ((win (get-buffer-window buf 'visible))) + (with-selected-window win + (when pos + (unless (<= (point-min) pos (point-max)) + (widen)) + (goto-char pos)) + (when (and buffer-file-name + (magit-anything-unmerged-p buffer-file-name)) + (smerge-start-session)) + (run-hooks 'magit-diff-visit-file-hook)) + (error "File buffer is not visible"))) + +(defun magit-diff-visit-file--noselect (&optional file goto-worktree) + (unless file + (setq file (magit-diff--file-at-point t t))) + (let* ((hunk (magit-diff-visit--hunk)) + (goto-from (and hunk + (magit-diff-visit--goto-from-p hunk goto-worktree))) + (line (and hunk (magit-diff-hunk-line hunk goto-from))) + (col (and hunk (magit-diff-hunk-column hunk goto-from))) + (spec (magit-diff--dwim)) + (rev (if goto-from + (magit-diff-visit--range-from spec) + (magit-diff-visit--range-to spec))) + (buf (if (or goto-worktree + (and (not (stringp rev)) + (or magit-diff-visit-avoid-head-blob + (not goto-from)))) + (or (get-file-buffer file) + (find-file-noselect file)) + (magit-find-file-noselect (if (stringp rev) rev "HEAD") + file)))) + (if line + (with-current-buffer buf + (cond ((eq rev 'staged) + (setq line (magit-diff-visit--offset file nil line))) + ((and goto-worktree + (stringp rev)) + (setq line (magit-diff-visit--offset file rev line)))) + (list buf (save-restriction + (widen) + (goto-char (point-min)) + (forward-line (1- line)) + (move-to-column col) + (point)))) + (list buf nil)))) + +(defun magit-diff--file-at-point (&optional expand assert) + ;; This is a variation of magit-file-at-point. + (if-let* ((file-section (magit-section-case + (file it) + (hunk (oref it parent)))) + (file (or (and (magit-section-match 'hunk) + (magit-diff-visit--goto-from-p + (magit-current-section) nil) + (oref file-section source)) + (oref file-section value)))) + (if expand + (expand-file-name file (magit-toplevel)) + file) + (when assert + (user-error "No file at point")))) + +(defun magit-diff-visit--hunk () + (and-let* ((scope (magit-diff-scope)) + (section (magit-current-section))) + (progn + (cl-case scope + ((file files) + (setq section (car (oref section children)))) + (list + (setq section (car (oref section children))) + (when section + (setq section (car (oref section children)))))) + (and + ;; Unmerged files appear in the list of staged changes + ;; but unlike in the list of unstaged changes no diffs + ;; are shown here. In that case `section' is nil. + section + ;; Currently the `hunk' type is also abused for file + ;; mode changes, which we are not interested in here. + (not (equal (oref section value) '(chmod))) + section)))) + +(defun magit-diff-visit--goto-from-p (section in-worktree) + (and magit-diff-visit-previous-blob + (not in-worktree) + (not (oref section combined)) + (not (< (magit-point) (oref section content))) + (= (char-after (line-beginning-position)) ?-))) + +(defvar magit-diff-visit-jump-to-change t) + +(defun magit-diff-hunk-line (section goto-from) + (save-excursion + (goto-char (line-beginning-position)) + (with-slots (content combined from-ranges from-range to-range) section + (when (or from-range to-range) + (when (and magit-diff-visit-jump-to-change (< (point) content)) + (goto-char content) + (re-search-forward "^[-+]")) + (+ (car (if goto-from from-range to-range)) + (let ((prefix (if combined (length from-ranges) 1)) + (target (point)) + (offset 0)) + (goto-char content) + (while (< (point) target) + (unless (string-search + (if goto-from "+" "-") + (buffer-substring (point) (+ (point) prefix))) + (cl-incf offset)) + (forward-line)) + offset)))))) + +(defun magit-diff-hunk-column (section goto-from) + (if (or (< (magit-point) + (oref section content)) + (and (not goto-from) + (= (char-after (line-beginning-position)) ?-))) + 0 + (max 0 (- (+ (current-column) 2) + (length (oref section value)))))) + +(defun magit-diff-visit--range-from (spec) + (cond ((consp spec) + (concat (cdr spec) "^")) + ((stringp spec) + (car (magit-split-range spec))) + (t + spec))) + +(defun magit-diff-visit--range-to (spec) + (if (symbolp spec) + spec + (let ((rev (if (consp spec) + (cdr spec) + (cdr (magit-split-range spec))))) + (if (and magit-diff-visit-avoid-head-blob + (magit-rev-head-p rev)) + 'unstaged + rev)))) + +(defun magit-diff-visit--offset (file rev line) + (let ((offset 0)) + (with-temp-buffer + (save-excursion + (magit-with-toplevel + (magit-git-insert "diff" rev "--" file))) + (catch 'found + (while (re-search-forward + "^@@ -\\([0-9]+\\),\\([0-9]+\\) \\+\\([0-9]+\\),\\([0-9]+\\) @@.*\n" + nil t) + (let ((from-beg (string-to-number (match-string 1))) + (from-len (string-to-number (match-string 2))) + ( to-len (string-to-number (match-string 4)))) + (if (<= from-beg line) + (if (< (+ from-beg from-len) line) + (cl-incf offset (- to-len from-len)) + (let ((rest (- line from-beg))) + (while (> rest 0) + (pcase (char-after) + (?\s (cl-decf rest)) + (?- (cl-decf offset) (cl-decf rest)) + (?+ (cl-incf offset))) + (forward-line)))) + (throw 'found nil)))))) + (+ line offset))) + +;;;; Scroll Commands + +(defun magit-diff-show-or-scroll-up () + "Update the commit or diff buffer for the thing at point. + +Either show the commit or stash at point in the appropriate +buffer, or if that buffer is already being displayed in the +current frame and contains information about that commit or +stash, then instead scroll the buffer up. If there is no +commit or stash at point, then prompt for a commit." + (interactive) + (magit-diff-show-or-scroll #'scroll-up)) + +(defun magit-diff-show-or-scroll-down () + "Update the commit or diff buffer for the thing at point. + +Either show the commit or stash at point in the appropriate +buffer, or if that buffer is already being displayed in the +current frame and contains information about that commit or +stash, then instead scroll the buffer down. If there is no +commit or stash at point, then prompt for a commit." + (interactive) + (magit-diff-show-or-scroll #'scroll-down)) + +(defun magit-diff-show-or-scroll (fn) + (let (rev cmd buf win) + (cond + ((and (bound-and-true-p magit-blame-mode) + (fboundp 'magit-current-blame-chunk)) + (setq rev (oref (magit-current-blame-chunk) orig-rev)) + (setq cmd #'magit-show-commit) + (setq buf (magit-get-mode-buffer 'magit-revision-mode))) + ((derived-mode-p 'git-rebase-mode) + (with-slots (action-type target) + (git-rebase-current-line) + (if (not (eq action-type 'commit)) + (user-error "No commit on this line") + (setq rev target) + (setq cmd #'magit-show-commit) + (setq buf (magit-get-mode-buffer 'magit-revision-mode))))) + (t + (magit-section-case + (branch + (setq rev (magit-ref-maybe-qualify (oref it value))) + (setq cmd #'magit-show-commit) + (setq buf (magit-get-mode-buffer 'magit-revision-mode))) + (commit + (setq rev (oref it value)) + (setq cmd #'magit-show-commit) + (setq buf (magit-get-mode-buffer 'magit-revision-mode))) + (tag + (setq rev (magit-rev-hash (oref it value))) + (setq cmd #'magit-show-commit) + (setq buf (magit-get-mode-buffer 'magit-revision-mode))) + (stash + (setq rev (oref it value)) + (setq cmd #'magit-stash-show) + (setq buf (magit-get-mode-buffer 'magit-stash-mode)))))) + (if rev + (if (and buf + (setq win (get-buffer-window buf)) + (with-current-buffer buf + (and (equal rev magit-buffer-revision) + (equal (magit-rev-parse rev) + magit-buffer-revision-hash)))) + (with-selected-window win + (condition-case nil + (funcall fn) + (error + (goto-char (pcase fn + ('scroll-up (point-min)) + ('scroll-down (point-max))))))) + (let ((magit-display-buffer-noselect t)) + (if (eq cmd #'magit-show-commit) + (apply #'magit-show-commit rev (magit-show-commit--arguments)) + (funcall cmd rev)))) + (call-interactively #'magit-show-commit)))) + +;;;; Section Commands + +(defun magit-section-cycle-diffs () + "Cycle visibility of diff-related sections in the current buffer." + (interactive) + (when-let ((sections + (cond ((derived-mode-p 'magit-status-mode) + (--mapcat + (when it + (when (oref it hidden) + (magit-section-show it)) + (oref it children)) + (list (magit-get-section '((staged) (status))) + (magit-get-section '((unstaged) (status)))))) + ((derived-mode-p 'magit-diff-mode) + (seq-filter #'magit-file-section-p + (oref magit-root-section children)))))) + (if (--any-p (oref it hidden) sections) + (dolist (s sections) + (magit-section-show s) + (magit-section-hide-children s)) + (let ((children (--mapcat (oref it children) sections))) + (cond ((and (--any-p (oref it hidden) children) + (--any-p (oref it children) children)) + (mapc #'magit-section-show-headings sections)) + ((seq-some #'magit-section-hidden-body children) + (mapc #'magit-section-show-children sections)) + (t + (mapc #'magit-section-hide sections))))))) + +;;; Diff Mode + +(defvar-keymap magit-diff-mode-map + :doc "Keymap for `magit-diff-mode'." + :parent magit-mode-map + "C-c C-d" #'magit-diff-while-committing + "C-c C-b" #'magit-go-backward + "C-c C-f" #'magit-go-forward + "SPC" #'scroll-up + "DEL" #'scroll-down + "j" #'magit-jump-to-diffstat-or-diff + "<remap> <write-file>" #'magit-patch-save) + +(define-derived-mode magit-diff-mode magit-mode "Magit Diff" + "Mode for looking at a Git diff. + +This mode is documented in info node `(magit)Diff Buffer'. + +\\<magit-mode-map>\ +Type \\[magit-refresh] to refresh the current buffer. +Type \\[magit-section-toggle] to expand or hide the section at point. +Type \\[magit-visit-thing] to visit the hunk or file at point. + +Staging and applying changes is documented in info node +`(magit)Staging and Unstaging' and info node `(magit)Applying'. + +\\<magit-hunk-section-map>Type \ +\\[magit-apply] to apply the change at point, \ +\\[magit-stage] to stage, +\\[magit-unstage] to unstage, \ +\\[magit-discard] to discard, or \ +\\[magit-reverse] to reverse it. + +\\{magit-diff-mode-map}" + :group 'magit-diff + (hack-dir-local-variables-non-file-buffer) + (setq magit--imenu-item-types 'file)) + +(put 'magit-diff-mode 'magit-diff-default-arguments + '("--stat" "--no-ext-diff")) + +(defun magit-diff-setup-buffer ( range typearg args files + &optional type locked) + (require 'magit) + (magit-setup-buffer #'magit-diff-mode locked + (magit-buffer-range range) + (magit-buffer-typearg typearg) + (magit-buffer-diff-type type) + (magit-buffer-diff-args args) + (magit-buffer-diff-files files) + (magit-buffer-diff-files-suspended nil))) + +(defun magit-diff-refresh-buffer () + "Refresh the current `magit-diff-mode' buffer." + (magit-set-header-line-format + (if (equal magit-buffer-typearg "--no-index") + (apply #'format "Differences between %s and %s" magit-buffer-diff-files) + (concat (if magit-buffer-range + (if (string-match-p "\\(\\.\\.\\|\\^-\\)" + magit-buffer-range) + (format "Changes in %s" magit-buffer-range) + (let ((msg "Changes from %s to %s") + (end (if (equal magit-buffer-typearg "--cached") + "index" + "working tree"))) + (if (member "-R" magit-buffer-diff-args) + (format msg end magit-buffer-range) + (format msg magit-buffer-range end)))) + (cond ((equal magit-buffer-typearg "--cached") + "Staged changes") + ((and (magit-repository-local-get 'this-commit-command) + (not (magit-anything-staged-p))) + "Uncommitting changes") + (t "Unstaged changes"))) + (pcase (length magit-buffer-diff-files) + (0) + (1 (concat " in file " (car magit-buffer-diff-files))) + (_ (concat " in files " + (string-join magit-buffer-diff-files ", "))))))) + (setq magit-buffer-range-hashed + (and magit-buffer-range (magit-hash-range magit-buffer-range))) + (magit-insert-section (diffbuf) + (magit-run-section-hook 'magit-diff-sections-hook))) + +(cl-defmethod magit-buffer-value (&context (major-mode magit-diff-mode)) + (nconc (cond (magit-buffer-range + (delq nil (list magit-buffer-range magit-buffer-typearg))) + ((equal magit-buffer-typearg "--cached") + (list 'staged)) + (t + (list 'unstaged magit-buffer-typearg))) + (and magit-buffer-diff-files (cons "--" magit-buffer-diff-files)))) + +(cl-defmethod magit-menu-common-value ((_section magit-diff-section)) + (magit-diff-scope)) + +(define-obsolete-variable-alias 'magit-diff-section-base-map + 'magit-diff-section-map "Magit-Section 4.0.0") + +(defvar-keymap magit-diff-section-map + :doc "Keymap for diff sections. +The classes `magit-file-section' and `magit-hunk-section' derive +from the abstract `magit-diff-section' class. Accordingly this +keymap is the parent of their keymaps." + "C-j" #'magit-diff-visit-worktree-file + "C-<return>" #'magit-diff-visit-worktree-file + "C-x 4 <return>" #'magit-diff-visit-file-other-window + "C-x 5 <return>" #'magit-diff-visit-file-other-frame + "&" #'magit-do-async-shell-command + "C" #'magit-commit-add-log + "C-x a" #'magit-add-change-log-entry + "C-x 4 a" #'magit-add-change-log-entry-other-window + "C-c C-t" #'magit-diff-trace-definition + "C-c C-e" #'magit-diff-edit-hunk-commit + "<remap> <magit-file-rename>" #'magit-file-rename + "<remap> <magit-file-untrack>" #'magit-file-untrack + "<remap> <magit-visit-thing>" #'magit-diff-visit-file + "<remap> <magit-revert-no-commit>" #'magit-reverse + "<remap> <magit-delete-thing>" #'magit-discard + "<remap> <magit-unstage-file>" #'magit-unstage + "<remap> <magit-stage-file>" #'magit-stage + "<remap> <magit-cherry-apply>" #'magit-apply + "<8>" (magit-menu-item "Rename file" #'magit-file-rename + '(:enable (eq (magit-diff-scope) 'file))) + "<7>" (magit-menu-item "Untrack %x" #'magit-file-untrack) + "<6>" (magit-menu-item "Visit file" #'magit-diff-visit-file + '(:enable (memq (magit-diff-scope) '(file files)))) + "<5>" (magit-menu-item "Reverse %x" #'magit-reverse + '(:enable (not (memq (magit-diff-type) + '(untracked unstaged))))) + "<4>" (magit-menu-item "Discard %x" #'magit-discard + '(:enable (not (memq (magit-diff-type) + '(committed undefined))))) + "<3>" (magit-menu-item "Unstage %x" #'magit-unstage + '(:enable (eq (magit-diff-type) 'staged))) + "<2>" (magit-menu-item "Stage %x" #'magit-stage + '(:enable (eq (magit-diff-type) 'unstaged))) + "<1>" (magit-menu-item "Apply %x" #'magit-apply + '(:enable (not (memq (magit-diff-type) + '(unstaged staged)))))) + +(defvar-keymap magit-file-section-map + ;; Even though this derived map doesn't add any bindings by default, + ;; it is quite possible that some users would want to add their own. + :doc "Keymap for `file' sections." + :parent magit-diff-section-base-map) + +(defvar-keymap magit-hunk-section-smerge-map + :doc "Keymap bound to `smerge-command-prefix' in `magit-hunk-section-map'." + "RET" #'magit-smerge-keep-current + "u" #'magit-smerge-keep-upper + "b" #'magit-smerge-keep-base + "l" #'magit-smerge-keep-lower) + +(defvar-keymap magit-hunk-section-map + :doc "Keymap for `hunk' sections." + :parent magit-diff-section-base-map + (key-description smerge-command-prefix) magit-hunk-section-smerge-map) + +(defconst magit-diff-conflict-headline-re + (concat "^" (regexp-opt + ;; Defined in merge-tree.c in this order. + '("merged" + "added in remote" + "added in both" + "added in local" + "removed in both" + "changed in both" + "removed in local" + "removed in remote")))) + +(defconst magit-diff-headline-re + (concat "^\\(@@@?\\|diff\\|Submodule\\|" + "\\* Unmerged path\\|" + (substring magit-diff-conflict-headline-re 1) + "\\)")) + +(defconst magit-diff-statline-re + (concat "^ ?" + "\\(.*\\)" ; file + "\\( +| +\\)" ; separator + "\\([0-9]+\\|Bin\\(?: +[0-9]+ -> [0-9]+ bytes\\)?$\\) ?" + "\\(\\+*\\)" ; add + "\\(-*\\)$")) ; del + +(defvar magit-diff--reset-non-color-moved + (list + "-c" "color.diff.context=normal" + "-c" "color.diff.plain=normal" ; historical synonym for context + "-c" "color.diff.meta=normal" + "-c" "color.diff.frag=normal" + "-c" "color.diff.func=normal" + "-c" "color.diff.old=normal" + "-c" "color.diff.new=normal" + "-c" "color.diff.commit=normal" + "-c" "color.diff.whitespace=normal" + ;; "git-range-diff" does not support "--color-moved", so we don't + ;; need to reset contextDimmed, oldDimmed, newDimmed, contextBold, + ;; oldBold, and newBold. + )) + +(defun magit-insert-diff () + "Insert the diff into this `magit-diff-mode' buffer." + (magit--insert-diff t + "diff" magit-buffer-range "-p" "--no-prefix" + (and (member "--stat" magit-buffer-diff-args) "--numstat") + magit-buffer-typearg + magit-buffer-diff-args "--" + magit-buffer-diff-files)) + +(defun magit--insert-diff (keep-error &rest args) + (declare (indent 1)) + (pcase-let ((`(,cmd . ,args) + (flatten-tree args)) + (magit-git-global-arguments + (remove "--literal-pathspecs" magit-git-global-arguments))) + ;; As of Git 2.19.0, we need to generate diffs with + ;; --ita-visible-in-index so that `magit-stage' can work with + ;; intent-to-add files (see #4026). + (when (and (not (equal cmd "merge-tree")) + (magit-git-version>= "2.19.0")) + (push "--ita-visible-in-index" args)) + (setq args (magit-diff--maybe-add-stat-arguments args)) + (when (cl-member-if (lambda (arg) (string-prefix-p "--color-moved" arg)) args) + (push "--color=always" args) + (setq magit-git-global-arguments + (append magit-diff--reset-non-color-moved + magit-git-global-arguments))) + (magit--git-wash #'magit-diff-wash-diffs + (if (member "--no-index" args) 'wash-anyway keep-error) + cmd args))) + +(defun magit-diff--maybe-add-stat-arguments (args) + (if (member "--stat" args) + (append (if (functionp magit-diff-extra-stat-arguments) + (funcall magit-diff-extra-stat-arguments) + magit-diff-extra-stat-arguments) + args) + args)) + +(defun magit-diff-use-window-width-as-stat-width () + "Use the `window-width' as the value of `--stat-width'." + (and-let* ((window (get-buffer-window (current-buffer) 'visible))) + (list (format "--stat-width=%d" (window-width window))))) + +(defun magit-diff-wash-diffs (args &optional limit) + (run-hooks 'magit-diff-wash-diffs-hook) + (when (member "--show-signature" args) + (magit-diff-wash-signature magit-buffer-revision-hash)) + (when (member "--stat" args) + (magit-diff-wash-diffstat)) + (when (re-search-forward magit-diff-headline-re limit t) + (goto-char (line-beginning-position)) + (magit-wash-sequence (apply-partially #'magit-diff-wash-diff args)) + (insert ?\n))) + +(defun magit-jump-to-diffstat-or-diff () + "Jump to the diffstat or diff. +When point is on a file inside the diffstat section, then jump +to the respective diff section, otherwise jump to the diffstat +section or a child thereof." + (interactive) + (if-let ((section (magit-get-section + (append (magit-section-case + ([file diffstat] `((file . ,(oref it value)))) + (file `((file . ,(oref it value)) (diffstat))) + (t '((diffstat)))) + (magit-section-ident magit-root-section))))) + (magit-section-goto section) + (user-error "No diffstat in this buffer"))) + +(defun magit-diff-wash-signature (object) + (cond + ((looking-at "^No signature") + (delete-line)) + ((looking-at "^gpg: ") + (let (title end) + (save-excursion + (while (looking-at "^gpg: ") + (cond + ((looking-at "^gpg: Good signature from") + (setq title (propertize + (buffer-substring (point) (line-end-position)) + 'face 'magit-signature-good))) + ((looking-at "^gpg: Can't check signature") + (setq title (propertize + (buffer-substring (point) (line-end-position)) + 'face '(italic bold))))) + (forward-line)) + (setq end (point-marker))) + (magit-insert-section (signature object title) + (when title + (magit-insert-heading title)) + (goto-char end) + (set-marker end nil) + (insert "\n")))))) + +(defun magit-diff-wash-diffstat () + (let (heading (beg (point))) + (when (re-search-forward "^ ?\\([0-9]+ +files? change[^\n]*\n\\)" nil t) + (setq heading (match-string 1)) + (magit-delete-match) + (goto-char beg) + (magit-insert-section (diffstat) + (insert (propertize heading 'font-lock-face 'magit-diff-file-heading)) + (magit-insert-heading) + (let (files) + (while (looking-at "^[-0-9]+\t[-0-9]+\t\\(.+\\)$") + (push (magit-decode-git-path + (let ((f (match-string 1))) + (cond + ((string-match "{.* => \\(.*\\)}" f) + (replace-match (match-string 1 f) nil t f)) + ((string-match " => " f) + (substring f (match-end 0))) + (t f)))) + files) + (magit-delete-line)) + (setq files (nreverse files)) + (while (looking-at magit-diff-statline-re) + (magit-bind-match-strings (file sep cnt add del) nil + (magit-delete-line) + (when (string-match " +$" file) + (setq sep (concat (match-string 0 file) sep)) + (setq file (substring file 0 (match-beginning 0)))) + (let ((le (length file)) ld) + (setq file (magit-decode-git-path file)) + (setq ld (length file)) + (when (> le ld) + (setq sep (concat (make-string (- le ld) ?\s) sep)))) + (magit-insert-section (file (pop files)) + (insert (propertize file 'font-lock-face 'magit-filename) + sep cnt " ") + (when add + (insert (propertize add 'font-lock-face + 'magit-diffstat-added))) + (when del + (insert (propertize del 'font-lock-face + 'magit-diffstat-removed))) + (insert "\n"))))) + (if (looking-at "^$") (forward-line) (insert "\n")))))) + +(defun magit-diff-wash-diff (args) + (when (cl-member-if (lambda (arg) (string-prefix-p "--color-moved" arg)) args) + (require 'ansi-color) + (ansi-color-apply-on-region (point-min) (point-max))) + (cond + ((looking-at "^Submodule") + (magit-diff-wash-submodule)) + ((looking-at "^\\* Unmerged path \\(.*\\)") + (let ((file (magit-decode-git-path (match-string 1)))) + (magit-delete-line) + (unless (and (derived-mode-p 'magit-status-mode) + (not (member "--cached" args))) + (magit-insert-section (file file) + (insert (propertize + (format "unmerged %s%s" file + (pcase (cddr (car (magit-file-status file))) + ('(?D ?D) " (both deleted)") + ('(?D ?U) " (deleted by us)") + ('(?U ?D) " (deleted by them)") + ('(?A ?A) " (both added)") + ('(?A ?U) " (added by us)") + ('(?U ?A) " (added by them)") + ('(?U ?U) ""))) + 'font-lock-face 'magit-diff-file-heading)) + (insert ?\n)))) + t) + ((looking-at magit-diff-conflict-headline-re) + (let ((long-status (match-string 0)) + (status "BUG") + file orig base) + (if (equal long-status "merged") + (progn (setq status long-status) + (setq long-status nil)) + (setq status (pcase-exhaustive long-status + ("added in remote" "new file") + ("added in both" "new file") + ("added in local" "new file") + ("removed in both" "removed") + ("changed in both" "changed") + ("removed in local" "removed") + ("removed in remote" "removed")))) + (magit-delete-line) + (while (looking-at + "^ \\([^ ]+\\) +[0-9]\\{6\\} \\([a-z0-9]\\{40,\\}\\) \\(.+\\)$") + (magit-bind-match-strings (side _blob name) nil + (pcase side + ("result" (setq file name)) + ("our" (setq orig name)) + ("their" (setq file name)) + ("base" (setq base name)))) + (magit-delete-line)) + (when orig (setq orig (magit-decode-git-path orig))) + (when file (setq file (magit-decode-git-path file))) + (magit-diff-insert-file-section + (or file base) orig status nil nil nil nil long-status))) + ;; The files on this line may be ambiguous due to whitespace. + ;; That's okay. We can get their names from subsequent headers. + ((looking-at "^diff --\ +\\(?:\\(?1:git\\) \\(?:\\(?2:.+?\\) \\2\\)?\ +\\|\\(?:cc\\|combined\\) \\(?3:.+\\)\\)") + (let ((status (cond ((equal (match-string 1) "git") "modified") + ((derived-mode-p 'magit-revision-mode) "resolved") + (t "unmerged"))) + (orig nil) + (file (or (match-string 2) (match-string 3))) + (header (list (buffer-substring-no-properties + (line-beginning-position) (1+ (line-end-position))))) + (modes nil) + (rename nil) + (binary nil)) + (magit-delete-line) + (while (not (or (eobp) (looking-at magit-diff-headline-re))) + (cond + ((looking-at "old mode \\(?:[^\n]+\\)\nnew mode \\(?:[^\n]+\\)\n") + (setq modes (match-string 0))) + ((looking-at "deleted file .+\n") + (setq status "deleted")) + ((looking-at "new file .+\n") + (setq status "new file")) + ((looking-at "rename from \\(.+\\)\nrename to \\(.+\\)\n") + (setq rename (match-string 0)) + (setq orig (match-string 1)) + (setq file (match-string 2)) + (setq status "renamed")) + ((looking-at "copy from \\(.+\\)\ncopy to \\(.+\\)\n") + (setq orig (match-string 1)) + (setq file (match-string 2)) + (setq status "new file")) + ((looking-at "similarity index .+\n")) + ((looking-at "dissimilarity index .+\n")) + ((looking-at "index .+\n")) + ((looking-at "--- \\(.+?\\)\t?\n") + (unless (equal (match-string 1) "/dev/null") + (setq orig (match-string 1)))) + ((looking-at "\\+\\+\\+ \\(.+?\\)\t?\n") + (unless (equal (match-string 1) "/dev/null") + (setq file (match-string 1)))) + ((looking-at "Binary files .+ and .+ differ\n") + (setq binary t)) + ((looking-at "Binary files differ\n") + (setq binary t)) + ;; TODO Use all combined diff extended headers. + ((looking-at "mode .+\n")) + ((error "BUG: Unknown extended header: %S" + (buffer-substring (point) (line-end-position))))) + ;; These headers are treated as some sort of special hunk. + (unless (or (string-prefix-p "old mode" (match-string 0)) + (string-prefix-p "rename" (match-string 0))) + (push (match-string 0) header)) + (magit-delete-match)) + (when orig + (setq orig (magit-decode-git-path orig))) + (setq file (magit-decode-git-path file)) + (setq header (nreverse header)) + ;; KLUDGE `git-log' ignores `--no-prefix' when `-L' is used. + (when (and (derived-mode-p 'magit-log-mode) + (seq-some (lambda (arg) (string-prefix-p "-L" arg)) + magit-buffer-log-args)) + (when orig + (setq orig (substring orig 2))) + (setq file (substring file 2)) + (setq header (list (save-excursion + (string-match "diff [^ ]+" (car header)) + (format "%s %s %s\n" + (match-string 0 (car header)) + (or orig file) + (or file orig))) + (format "--- %s\n" (or orig "/dev/null")) + (format "+++ %s\n" (or file "/dev/null"))))) + (setq header (string-join header)) + (magit-diff-insert-file-section + file orig status modes rename header binary nil))))) + +(defun magit-diff-insert-file-section + (file orig status modes rename header binary long-status) + (magit-insert-section + ( file file + (or (equal status "deleted") (derived-mode-p 'magit-status-mode)) + :source (and (not (equal orig file)) orig) + :header header + :binary binary) + (insert (propertize (format "%-10s %s" status + (if (or (not orig) (equal orig file)) + file + (format "%s -> %s" orig file))) + 'font-lock-face 'magit-diff-file-heading)) + (cond ((and binary long-status) + (insert (format " (%s, binary)" long-status))) + ((or binary long-status) + (insert (format " (%s)" (if binary "binary" long-status))))) + (magit-insert-heading) + (when modes + (magit-insert-section (hunk '(chmod)) + (insert modes) + (magit-insert-heading))) + (when rename + (magit-insert-section (hunk '(rename)) + (insert rename) + (magit-insert-heading))) + (magit-wash-sequence #'magit-diff-wash-hunk))) + +(defun magit-diff-wash-submodule () + ;; See `show_submodule_summary' in submodule.c and "this" commit. + (when (looking-at "^Submodule \\([^ ]+\\)") + (let ((module (match-string 1)) + untracked modified) + (when (looking-at "^Submodule [^ ]+ contains untracked content$") + (magit-delete-line) + (setq untracked t)) + (when (looking-at "^Submodule [^ ]+ contains modified content$") + (magit-delete-line) + (setq modified t)) + (cond + ((and (looking-at "^Submodule \\([^ ]+\\) \\([^ :]+\\)\\( (rewind)\\)?:$") + (equal (match-string 1) module)) + (magit-bind-match-strings (_module range rewind) nil + (magit-delete-line) + (while (looking-at "^ \\([<>]\\) \\(.*\\)$") + (magit-delete-line)) + (when rewind + (setq range (replace-regexp-in-string "[^.]\\(\\.\\.\\)[^.]" + "..." range t t 1))) + (magit-insert-section (module module t) + (magit-insert-heading + (propertize (concat "modified " module) + 'font-lock-face 'magit-diff-file-heading) + " (" + (cond (rewind "rewind") + ((string-search "..." range) "non-ff") + (t "new commits")) + (and (or modified untracked) + (concat ", " + (and modified "modified") + (and modified untracked " and ") + (and untracked "untracked") + " content")) + ")") + (magit-insert-section-body + (let ((default-directory + (file-name-as-directory + (expand-file-name module (magit-toplevel))))) + (magit-git-wash (apply-partially #'magit-log-wash-log 'module) + "log" "--oneline" "--left-right" range) + (delete-char -1)))))) + ((and (looking-at "^Submodule \\([^ ]+\\) \\([^ ]+\\) (\\([^)]+\\))$") + (equal (match-string 1) module)) + (magit-bind-match-strings (_module _range msg) nil + (magit-delete-line) + (magit-insert-section (module module) + (magit-insert-heading + (propertize (concat "submodule " module) + 'font-lock-face 'magit-diff-file-heading) + " (" msg ")")))) + (t + (magit-insert-section (module module) + (magit-insert-heading + (propertize (concat "modified " module) + 'font-lock-face 'magit-diff-file-heading) + " (" + (and modified "modified") + (and modified untracked " and ") + (and untracked "untracked") + " content)"))))))) + +(defun magit-diff-wash-hunk () + (when (looking-at "^@\\{2,\\} \\(.+?\\) @\\{2,\\}\\(?: \\(.*\\)\\)?") + (let* ((heading (match-string 0)) + (ranges (mapcar + (lambda (str) + (let ((range + (mapcar #'string-to-number + (split-string (substring str 1) ",")))) + ;; A single line is +1 rather than +1,1. + (if (length= range 1) + (nconc range (list 1)) + range))) + (split-string (match-string 1)))) + (about (match-string 2)) + (combined (length= ranges 3)) + (value (cons about ranges))) + (magit-delete-line) + (magit-insert-section + ( hunk value nil + :washer #'magit-diff-paint-hunk + :combined combined + :from-range (if combined (butlast ranges) (car ranges)) + :to-range (car (last ranges)) + :about about) + (insert (propertize (concat heading "\n") + 'font-lock-face 'magit-diff-hunk-heading)) + (magit-insert-heading) + (while (not (or (eobp) (looking-at "^[^-+\s\\]"))) + (forward-line)))) + t)) + +(defun magit-diff-expansion-threshold (section) + "Keep new diff sections collapsed if washing takes too long." + (and (magit-file-section-p section) + (> (float-time (time-since magit-refresh-start-time)) + magit-diff-expansion-threshold) + 'hide)) + +(add-hook 'magit-section-set-visibility-hook #'magit-diff-expansion-threshold) + +;;; Revision Mode + +(define-derived-mode magit-revision-mode magit-diff-mode "Magit Rev" + "Mode for looking at a Git commit. + +This mode is documented in info node `(magit)Revision Buffer'. + +\\<magit-mode-map>\ +Type \\[magit-refresh] to refresh the current buffer. +Type \\[magit-section-toggle] to expand or hide the section at point. +Type \\[magit-visit-thing] to visit the hunk or file at point. + +Staging and applying changes is documented in info node +`(magit)Staging and Unstaging' and info node `(magit)Applying'. + +\\<magit-hunk-section-map>Type \ +\\[magit-apply] to apply the change at point, \ +\\[magit-stage] to stage, +\\[magit-unstage] to unstage, \ +\\[magit-discard] to discard, or \ +\\[magit-reverse] to reverse it. + +\\{magit-revision-mode-map}" + :group 'magit-revision + (hack-dir-local-variables-non-file-buffer)) + +(put 'magit-revision-mode 'magit-diff-default-arguments + '("--stat" "--no-ext-diff")) + +(defun magit-revision-setup-buffer (rev args files) + (magit-setup-buffer #'magit-revision-mode nil + (magit-buffer-revision rev) + (magit-buffer-range (format "%s^..%s" rev rev)) + (magit-buffer-diff-type 'committed) + (magit-buffer-diff-args args) + (magit-buffer-diff-files files) + (magit-buffer-diff-files-suspended nil))) + +(defun magit-revision-refresh-buffer () + (setq magit-buffer-revision-hash (magit-rev-hash magit-buffer-revision)) + (magit-set-header-line-format + (concat (magit-object-type magit-buffer-revision-hash) + " " magit-buffer-revision + (pcase (length magit-buffer-diff-files) + (0) + (1 (concat " limited to file " (car magit-buffer-diff-files))) + (_ (concat " limited to files " + (string-join magit-buffer-diff-files ", ")))))) + (magit-insert-section (commitbuf) + (magit-run-section-hook 'magit-revision-sections-hook))) + +(cl-defmethod magit-buffer-value (&context (major-mode magit-revision-mode)) + (cons magit-buffer-revision magit-buffer-diff-files)) + +(defun magit-insert-revision-diff () + "Insert the diff into this `magit-revision-mode' buffer." + (magit--insert-diff t + "show" "-p" "--format=" "--no-prefix" + (and (member "--stat" magit-buffer-diff-args) "--numstat") + magit-buffer-diff-args + (magit--rev-dereference magit-buffer-revision) + "--" magit-buffer-diff-files)) + +(defun magit-insert-revision-tag () + "Insert tag message and headers into a revision buffer. +This function only inserts anything when `magit-show-commit' is +called with a tag as argument, when that is called with a commit +or a ref which is not a branch, then it inserts nothing." + (when (equal (magit-object-type magit-buffer-revision) "tag") + (magit-insert-section (taginfo) + (let ((beg (point))) + ;; "git verify-tag -v" would output what we need, but the gpg + ;; output is send to stderr and we have no control over the + ;; order in which stdout and stderr are inserted, which would + ;; make parsing hard. We are forced to use "git cat-file tag" + ;; instead, which inserts the signature instead of verifying + ;; it. We remove that later and then insert the verification + ;; output using "git verify-tag" (without the "-v"). + (magit-git-insert "cat-file" "tag" magit-buffer-revision) + (goto-char beg) + (forward-line 3) + (delete-region beg (point))) + (looking-at "^tagger \\([^<]+\\) <\\([^>]+\\)") + (let ((heading (format "Tagger: %s <%s>" + (match-string 1) + (match-string 2)))) + (magit-delete-line) + (insert (propertize heading 'font-lock-face + 'magit-section-secondary-heading))) + (magit-insert-heading) + (forward-line) + (magit-insert-section + ( message nil nil + :heading-highlight-face 'magit-diff-revision-summary-highlight) + (let ((beg (point))) + (forward-line) + (magit--add-face-text-property + beg (point) 'magit-diff-revision-summary)) + (magit-insert-heading) + (if (re-search-forward "-----BEGIN PGP SIGNATURE-----" nil t) + (goto-char (match-beginning 0)) + (goto-char (point-max))) + (insert ?\n)) + (if (re-search-forward "-----BEGIN PGP SIGNATURE-----" nil t) + (progn + (let ((beg (match-beginning 0))) + (re-search-forward "-----END PGP SIGNATURE-----\n") + (delete-region beg (point))) + (save-excursion + (magit-process-git t "verify-tag" magit-buffer-revision)) + (magit-diff-wash-signature magit-buffer-revision)) + (goto-char (point-max))) + (insert ?\n)))) + +(defvar-keymap magit-commit-message-section-map + :doc "Keymap for `commit-message' sections." + "<remap> <magit-visit-thing>" #'magit-show-commit + "<1>" (magit-menu-item "Visit %t" #'magit-show-commit + '(:enable (magit-thing-at-point 'git-revision t)))) + +(defun magit-insert-revision-message () + "Insert the commit message into a revision buffer." + (magit-insert-section + ( commit-message nil nil + :heading-highlight-face 'magit-diff-revision-summary-highlight) + (if-let* ((rev magit-buffer-revision) + (msg (with-temp-buffer + (save-excursion (magit-rev-insert-format "%B" rev)) + (magit-revision--wash-message)))) + (progn + (save-excursion (insert msg)) + (magit-revision--wash-message-hashes) + (save-excursion + (magit--add-face-text-property (point) + (progn (forward-line) (point)) + 'magit-diff-revision-summary) + (magit-insert-heading)) + (goto-char (point-max))) + (insert "(no message)\n")))) + +(defun magit-insert-revision-notes () + "Insert commit notes into a revision buffer." + (let ((default (or (magit-get "core.notesRef") "refs/notes/commits"))) + (dolist (ref (magit-list-active-notes-refs)) + (when-let* ((rev magit-buffer-revision) + (msg (with-temp-buffer + (save-excursion + (magit-git-insert "-c" (concat "core.notesRef=" ref) + "notes" "show" rev)) + (magit-revision--wash-message)))) + (magit-insert-section + ( notes ref (not (equal ref default)) + :heading-highlight-face 'magit-diff-hunk-heading-highlight) + (save-excursion (insert msg)) + (magit-revision--wash-message-hashes) + (save-excursion + (end-of-line) + (insert (format " (%s)" + (propertize (if (string-prefix-p "refs/notes/" ref) + (substring ref 11) + ref) + 'font-lock-face 'magit-refname)))) + (magit--add-face-text-property (point) + (progn (forward-line) (point)) + 'magit-diff-revision-summary) + (magit-insert-heading) + (goto-char (point-max)) + (insert ?\n)))))) + +(defun magit-revision--wash-message () + (let ((major-mode 'git-commit-mode)) + (hack-dir-local-variables) + (hack-local-variables-apply)) + (unless (memq git-commit-major-mode '(nil text-mode)) + (funcall git-commit-major-mode) + (font-lock-ensure)) + (when (> (point-max) (point-min)) + (save-excursion + (while (search-forward "\r\n" nil t) ; Remove trailing CRs. + (delete-region (match-beginning 0) (1+ (match-beginning 0))))) + (when magit-revision-fill-summary-line + (let ((fill-column (min magit-revision-fill-summary-line + (window-width (get-buffer-window nil t))))) + (fill-region (point) (line-end-position)))) + (when magit-diff-highlight-keywords + (save-excursion + (while (re-search-forward "\\[[^[]*\\]" nil t) + (put-text-property (match-beginning 0) + (match-end 0) + 'font-lock-face 'magit-keyword)))) + (run-hook-wrapped 'magit-wash-message-hook + (lambda (fn) (save-excursion (funcall fn)))) + (buffer-string))) + +(defun magit-revision--wash-message-hashes () + (when magit-revision-use-hash-sections + (save-excursion + ;; Start after beg to prevent a (commit text) section from + ;; starting at the same point as the (commit-message) + ;; section. + (while (not (eobp)) + (re-search-forward "\\_<" nil 'move) + (let ((beg (point))) + (re-search-forward "\\_>" nil t) + (when (> (point) beg) + (let ((text (buffer-substring-no-properties beg (point)))) + (when (pcase magit-revision-use-hash-sections + ('quickest ; false negatives and positives + (and (>= (length text) 7) + (string-match-p "[0-9]" text) + (string-match-p "[a-z]" text))) + ('quicker ; false negatives (number-less hashes) + (and (>= (length text) 7) + (string-match-p "[0-9]" text) + (magit-commit-p text))) + ('quick ; false negatives (short hashes) + (and (>= (length text) 7) + (magit-commit-p text))) + ('slow + (magit-commit-p text))) + (put-text-property beg (point) + 'font-lock-face 'magit-hash) + (let ((end (point))) + (goto-char beg) + (magit-insert-section (commit text) + (goto-char end))))))))))) + +(defun magit-insert-revision-headers () + "Insert headers about the commit into a revision buffer." + (magit-insert-section (headers) + (when-let ((string (magit-rev-format "%D" magit-buffer-revision + "--decorate=full"))) + (insert (magit-format-ref-labels string) ?\s)) + (insert (propertize + (magit-rev-parse (magit--rev-dereference magit-buffer-revision)) + 'font-lock-face 'magit-hash)) + (magit-insert-heading) + (let ((beg (point))) + (magit-rev-insert-format magit-revision-headers-format + magit-buffer-revision) + (magit-insert-revision-gravatars magit-buffer-revision beg)) + (when magit-revision-insert-related-refs + (when (magit-revision-insert-related-refs-display-p 'parents) + (dolist (parent (magit-commit-parents magit-buffer-revision)) + (magit-insert-section (commit parent) + (let ((line (magit-rev-format "%h %s" parent))) + (string-match "^\\([^ ]+\\) \\(.*\\)" line) + (magit-bind-match-strings (hash msg) line + (insert "Parent: ") + (insert (propertize hash 'font-lock-face 'magit-hash)) + (insert " " msg "\n")))))) + (when (magit-revision-insert-related-refs-display-p 'merged) + (magit--insert-related-refs + magit-buffer-revision "--merged" "Merged" + (eq magit-revision-insert-related-refs 'all))) + (when (magit-revision-insert-related-refs-display-p 'contained) + (magit--insert-related-refs + magit-buffer-revision "--contains" "Contained" + (memq magit-revision-insert-related-refs '(all mixed)))) + (when (magit-revision-insert-related-refs-display-p 'follows) + (when-let ((follows (magit-get-current-tag magit-buffer-revision t))) + (let ((tag (car follows)) + (cnt (cadr follows))) + (magit-insert-section (tag tag) + (insert + (format "Follows: %s (%s)\n" + (propertize tag 'font-lock-face 'magit-tag) + (propertize (number-to-string cnt) + 'font-lock-face 'magit-branch-local))))))) + (when (magit-revision-insert-related-refs-display-p 'precedes) + (when-let ((precedes (magit-get-next-tag magit-buffer-revision t))) + (let ((tag (car precedes)) + (cnt (cadr precedes))) + (magit-insert-section (tag tag) + (insert (format "Precedes: %s (%s)\n" + (propertize tag 'font-lock-face 'magit-tag) + (propertize (number-to-string cnt) + 'font-lock-face 'magit-tag))))))) + (insert ?\n)))) + +(defun magit-revision-insert-related-refs-display-p (sym) + "Whether to display related branches of type SYM. +Refer to user option `magit-revision-insert-related-refs-display-alist'." + (if-let ((elt (assq sym magit-revision-insert-related-refs-display-alist))) + (cdr elt) + t)) + +(defun magit--insert-related-refs (rev arg title remote) + (when-let ((refs (magit-list-related-branches arg rev (and remote "-a")))) + (insert title ":" (make-string (- 10 (length title)) ?\s)) + (dolist (branch refs) + (if (<= (+ (current-column) 1 (length branch)) + (window-width)) + (insert ?\s) + (insert ?\n (make-string 12 ?\s))) + (magit-insert-section (branch branch) + (insert (propertize branch 'font-lock-face + (if (string-prefix-p "remotes/" branch) + 'magit-branch-remote + 'magit-branch-local))))) + (insert ?\n))) + +(defun magit-insert-revision-gravatars (rev beg) + (when (and magit-revision-show-gravatars + (window-system)) + (require 'gravatar) + (pcase-let ((`(,author . ,committer) + (pcase magit-revision-show-gravatars + ('t '("^Author: " . "^Commit: ")) + ('author '("^Author: " . nil)) + ('committer '(nil . "^Commit: ")) + (_ magit-revision-show-gravatars)))) + (when-let ((email (and author (magit-rev-format "%aE" rev)))) + (magit-insert-revision-gravatar beg rev email author)) + (when-let ((email (and committer (magit-rev-format "%cE" rev)))) + (magit-insert-revision-gravatar beg rev email committer))))) + +(defun magit-insert-revision-gravatar (beg rev email regexp) + (save-excursion + (goto-char beg) + (when (re-search-forward regexp nil t) + (when-let ((window (get-buffer-window))) + (let* ((column (length (match-string 0))) + (font-obj (query-font (font-at (point) window))) + (size (* 2 (+ (aref font-obj 4) + (aref font-obj 5)))) + (align-to (+ column + (ceiling (/ size (aref font-obj 7) 1.0)) + 1)) + (gravatar-size (- size 2))) + (ignore-errors ; service may be unreachable + (gravatar-retrieve email #'magit-insert-revision-gravatar-cb + (list gravatar-size rev + (point-marker) + align-to column)))))))) + +(defun magit-insert-revision-gravatar-cb (image size rev marker align-to column) + (unless (eq image 'error) + (when-let ((buffer (marker-buffer marker))) + (with-current-buffer buffer + (save-excursion + (goto-char marker) + ;; The buffer might display another revision by now or + ;; it might have been refreshed, in which case another + ;; process might already have inserted the image. + (when (and (equal rev magit-buffer-revision) + (not (eq (car-safe + (car-safe + (get-text-property (point) 'display))) + 'image))) + (setf (image-property image :ascent) 'center) + (setf (image-property image :relief) 1) + (setf (image-property image :scale) 1) + (setf (image-property image :height) size) + (let ((top (list image '(slice 0.0 0.0 1.0 0.5))) + (bot (list image '(slice 0.0 0.5 1.0 1.0))) + (align `((space :align-to ,align-to)))) + (let ((inhibit-read-only t)) + (insert (propertize " " 'display top)) + (insert (propertize " " 'display align)) + (forward-line) + (forward-char column) + (insert (propertize " " 'display bot)) + (insert (propertize " " 'display align)))))))))) + +;;; Merge-Preview Mode + +(define-derived-mode magit-merge-preview-mode magit-diff-mode "Magit Merge" + "Mode for previewing a merge." + :group 'magit-diff + (hack-dir-local-variables-non-file-buffer)) + +(put 'magit-merge-preview-mode 'magit-diff-default-arguments + '("--no-ext-diff")) + +(defun magit-merge-preview-setup-buffer (rev) + (magit-setup-buffer #'magit-merge-preview-mode nil + (magit-buffer-revision rev) + (magit-buffer-range (format "%s^..%s" rev rev)))) + +(defun magit-merge-preview-refresh-buffer () + (let* ((branch (magit-get-current-branch)) + (head (or branch (magit-rev-verify "HEAD")))) + (magit-set-header-line-format (format "Preview merge of %s into %s" + magit-buffer-revision + (or branch "HEAD"))) + (magit-insert-section (diffbuf) + (magit--insert-diff t + "merge-tree" (magit-git-string "merge-base" head magit-buffer-revision) + head magit-buffer-revision)))) + +(cl-defmethod magit-buffer-value (&context (major-mode magit-merge-preview-mode)) + magit-buffer-revision) + +;;; Hunk Section + +(defun magit-hunk-set-window-start (section) + "When SECTION is a `hunk', ensure that its beginning is visible. +It the SECTION has a different type, then do nothing." + (when (magit-hunk-section-p section) + (magit-section-set-window-start section))) + +(add-hook 'magit-section-movement-hook #'magit-hunk-set-window-start) + +(cl-defmethod magit-section-get-relative-position ((_section magit-hunk-section)) + (nconc (cl-call-next-method) + (and (region-active-p) + (progn + (goto-char (line-beginning-position)) + (when (looking-at "^[-+]") (forward-line)) + (while (looking-at "^[ @]") (forward-line)) + (let ((beg (magit-point))) + (list (cond + ((looking-at "^[-+]") + (forward-line) + (while (looking-at "^[-+]") (forward-line)) + (while (looking-at "^ ") (forward-line)) + (forward-line -1) + (regexp-quote (buffer-substring-no-properties + beg (line-end-position)))) + (t t)))))))) + +(cl-defmethod magit-section-goto-successor ((section magit-hunk-section) + line char &optional arg) + (or (magit-section-goto-successor--same section line char) + (and-let* ((parent (magit-get-section + (magit-section-ident + (oref section parent))))) + (let* ((children (oref parent children)) + (siblings (magit-section-siblings section 'prev)) + (previous (nth (length siblings) children))) + (if (not arg) + (when-let ((sibling (or previous (car (last children))))) + (magit-section-goto sibling) + t) + (when previous + (magit-section-goto previous)) + (if (and (stringp arg) + (re-search-forward arg (oref parent end) t)) + (goto-char (match-beginning 0)) + (goto-char (oref (car (last children)) end)) + (forward-line -1) + (while (looking-at "^ ") (forward-line -1)) + (while (looking-at "^[-+]") (forward-line -1)) + (forward-line))))) + (magit-section-goto-successor--related section))) + +;;; Diff Sections + +(defvar-keymap magit-unstaged-section-map + :doc "Keymap for the `unstaged' section." + "<remap> <magit-visit-thing>" #'magit-diff-unstaged + "<remap> <magit-stage-file>" #'magit-stage + "<remap> <magit-delete-thing>" #'magit-discard + "<3>" (magit-menu-item "Discard all" #'magit-discard) + "<2>" (magit-menu-item "Stage all" #'magit-stage) + "<1>" (magit-menu-item "Visit diff" #'magit-diff-unstaged)) + +(magit-define-section-jumper magit-jump-to-unstaged + "Unstaged changes" unstaged nil magit-insert-unstaged-changes) + +(defun magit-insert-unstaged-changes () + "Insert section showing unstaged changes." + (magit-insert-section (unstaged) + (magit-insert-heading t "Unstaged changes") + (magit--insert-diff nil + "diff" magit-buffer-diff-args "--no-prefix" + "--" magit-buffer-diff-files))) + +(defvar-keymap magit-staged-section-map + :doc "Keymap for the `staged' section." + "<remap> <magit-revert-no-commit>" #'magit-reverse + "<remap> <magit-delete-thing>" #'magit-discard + "<remap> <magit-unstage-file>" #'magit-unstage + "<remap> <magit-visit-thing>" #'magit-diff-staged + "<4>" (magit-menu-item "Reverse all" #'magit-reverse) + "<3>" (magit-menu-item "Discard all" #'magit-discard) + "<2>" (magit-menu-item "Unstage all" #'magit-unstage) + "<1>" (magit-menu-item "Visit diff" #'magit-diff-staged)) + +(magit-define-section-jumper magit-jump-to-staged + "Staged changes" staged nil magit-insert-staged-changes) + +(defun magit-insert-staged-changes () + "Insert section showing staged changes." + ;; Avoid listing all files as deleted when visiting a bare repo. + (unless (magit-bare-repo-p) + (magit-insert-section (staged) + (magit-insert-heading t "Staged changes") + (magit--insert-diff nil + "diff" "--cached" magit-buffer-diff-args "--no-prefix" + "--" magit-buffer-diff-files)))) + +;;; Diff Type + +(defvar magit--diff-use-recorded-type-p t) + +(defun magit-diff-type (&optional section) + "Return the diff type of SECTION. + +The returned type is one of the symbols `staged', `unstaged', +`committed', or `undefined'. This type serves a similar purpose +as the general type common to all sections (which is stored in +the `type' slot of the corresponding `magit-section' struct) but +takes additional information into account. When the SECTION +isn't related to diffs and the buffer containing it also isn't +a diff-only buffer, then return nil. + +Currently the type can also be one of `tracked' and `untracked' +but these values are not handled explicitly everywhere they +should be and a possible fix could be to just return nil here. + +The section has to be a `diff' or `hunk' section, or a section +whose children are of type `diff'. If optional SECTION is nil, +return the diff type for the current section. In buffers whose +major mode is `magit-diff-mode' SECTION is ignored and the type +is determined using other means. In `magit-revision-mode' +buffers the type is always `committed'. + +Do not confuse this with `magit-diff-scope' (which see)." + (when-let ((section (or section (magit-current-section)))) + (cond ((derived-mode-p 'magit-revision-mode 'magit-stash-mode) 'committed) + ((derived-mode-p 'magit-diff-mode) + (let ((range magit-buffer-range) + (const magit-buffer-typearg)) + (cond ((and magit--diff-use-recorded-type-p + magit-buffer-diff-type)) + ((equal const "--no-index") 'undefined) + ((or (not range) + (equal range "HEAD") + (magit-rev-eq range "HEAD")) + (if (equal const "--cached") + 'staged + 'unstaged)) + ((equal const "--cached") + (if (magit-rev-head-p range) + 'staged + 'undefined)) ; i.e., committed and staged + (t 'committed)))) + ((derived-mode-p 'magit-status-mode) + (let ((stype (oref section type))) + (if (memq stype '(staged unstaged tracked untracked)) + stype + (pcase stype + ((or 'file 'module) + (let* ((parent (oref section parent)) + (type (oref parent type))) + (if (memq type '(file module)) + (magit-diff-type parent) + type))) + ('hunk (thread-first section + (oref parent) + (oref parent) + (oref type))))))) + ((derived-mode-p 'magit-log-mode) + (if (or (and (magit-section-match 'commit section) + (oref section children)) + (magit-section-match [* file commit] section)) + 'committed + 'undefined)) + (t 'undefined)))) + +(cl-defun magit-diff-scope (&optional (section nil ssection) strict) + "Return the diff scope of SECTION or the selected section(s). + +A diff's \"scope\" describes what part of a diff is selected, it is +a symbol, one of `region', `hunk', `hunks', `file', `files', or +`list'. Do not confuse this with the diff \"type\", as returned by +`magit-diff-type'. + +If optional SECTION is non-nil, then return the scope of that, +ignoring the sections selected by the region. Otherwise return +the scope of the current section, or if the region is active and +selects a valid group of diff related sections, the type of these +sections, i.e., `hunks' or `files'. If SECTION, or if that is nil +the current section, is a `hunk' section; and the region region +starts and ends inside the body of a that section, then the type +is `region'. If the region is empty after a mouse click, then +`hunk' is returned instead of `region'. + +If optional STRICT is non-nil, then return nil if the diff type of +the section at point is `untracked' or the section at point is not +actually a `diff' but a `diffstat' section." + (let ((siblings (and (not ssection) (magit-region-sections nil t)))) + (setq section (or section (car siblings) (magit-current-section))) + (when (and section + (or (not strict) + (and (not (eq (magit-diff-type section) 'untracked)) + (not (eq (and-let* ((parent (oref section parent))) + (oref parent type)) + 'diffstat))))) + (pcase (list (oref section type) + (and siblings t) + (magit-diff-use-hunk-region-p) + ssection) + (`(hunk nil t ,_) + (if (magit-section-internal-region-p section) 'region 'hunk)) + ('(hunk t t nil) 'hunks) + (`(hunk ,_ ,_ ,_) 'hunk) + ('(file t t nil) 'files) + (`(file ,_ ,_ ,_) 'file) + ('(module t t nil) 'files) + (`(module ,_ ,_ ,_) 'file) + (`(,(or 'staged 'unstaged 'untracked) nil ,_ ,_) 'list))))) + +(defun magit-diff-use-hunk-region-p () + (and (region-active-p) + ;; TODO implement this from first principals + ;; currently it's trial-and-error + (not (and (or (eq this-command #'mouse-drag-region) + (eq last-command #'mouse-drag-region) + ;; When another window was previously + ;; selected then the last-command is + ;; some byte-code function. + (byte-code-function-p last-command)) + (eq (region-end) (region-beginning)))))) + +;;; Diff Highlight + +(add-hook 'magit-section-unhighlight-hook #'magit-diff-unhighlight) +(add-hook 'magit-section-highlight-hook #'magit-diff-highlight) + +(defun magit-diff-unhighlight (section selection) + "Remove the highlighting of the diff-related SECTION." + (when (magit-hunk-section-p section) + (magit-diff-paint-hunk section selection nil) + t)) + +(defun magit-diff-highlight (section selection) + "Highlight the diff-related SECTION. +If SECTION is not a diff-related section, then do nothing and +return nil. If SELECTION is non-nil, then it is a list of sections +selected by the region, including SECTION. All of these sections +are highlighted." + (if (and (magit-section-match 'commit section) + (oref section children)) + (progn (if selection + (dolist (section selection) + (magit-diff-highlight-list section selection)) + (magit-diff-highlight-list section)) + t) + (when-let ((scope (magit-diff-scope section t))) + (cond ((eq scope 'region) + (magit-diff-paint-hunk section selection t)) + (selection + (dolist (section selection) + (magit-diff-highlight-recursive section selection))) + (t + (magit-diff-highlight-recursive section))) + t))) + +(defun magit-diff-highlight-recursive (section &optional selection) + (pcase (magit-diff-scope section) + ('list (magit-diff-highlight-list section selection)) + ('file (magit-diff-highlight-file section selection)) + ('hunk (magit-diff-highlight-heading section selection) + (magit-diff-paint-hunk section selection t)) + (_ (magit-section-highlight section nil)))) + +(defun magit-diff-highlight-list (section &optional selection) + (let ((beg (oref section start)) + (cnt (oref section content)) + (end (oref section end))) + (when (or (eq this-command #'mouse-drag-region) + (not selection)) + (unless (and (region-active-p) + (<= (region-beginning) beg)) + (magit-section-make-overlay beg cnt 'magit-section-highlight)) + (if (oref section hidden) + (oset section washer #'ignore) + (dolist (child (oref section children)) + (when (or (eq this-command #'mouse-drag-region) + (not (and (region-active-p) + (<= (region-beginning) + (oref child start))))) + (magit-diff-highlight-recursive child selection))))) + (when magit-diff-highlight-hunk-body + (magit-section-make-overlay (1- end) end 'magit-section-highlight)))) + +(defun magit-diff-highlight-file (section &optional selection) + (magit-diff-highlight-heading section selection) + (when (or (not (oref section hidden)) + (cl-typep section 'magit-module-section)) + (dolist (child (oref section children)) + (magit-diff-highlight-recursive child selection)))) + +(defun magit-diff-highlight-heading (section &optional selection) + (magit-section-make-overlay + (oref section start) + (or (oref section content) + (oref section end)) + (pcase (list (oref section type) + (and (member section selection) + (not (eq this-command #'mouse-drag-region)))) + ('(file t) 'magit-diff-file-heading-selection) + ('(file nil) 'magit-diff-file-heading-highlight) + ('(module t) 'magit-diff-file-heading-selection) + ('(module nil) 'magit-diff-file-heading-highlight) + ('(hunk t) 'magit-diff-hunk-heading-selection) + ('(hunk nil) 'magit-diff-hunk-heading-highlight)))) + +;;; Hunk Paint + +(cl-defun magit-diff-paint-hunk + (section &optional selection + (highlight (magit-section-selected-p section selection))) + (let (paint) + (unless magit-diff-highlight-hunk-body + (setq highlight nil)) + (cond (highlight + (unless (oref section hidden) + (add-to-list 'magit-section-highlighted-sections section) + (cond ((memq section magit-section-unhighlight-sections) + (setq magit-section-unhighlight-sections + (delq section magit-section-unhighlight-sections))) + (magit-diff-highlight-hunk-body + (setq paint t))))) + (t + (cond ((and (oref section hidden) + (memq section magit-section-unhighlight-sections)) + (add-to-list 'magit-section-highlighted-sections section) + (setq magit-section-unhighlight-sections + (delq section magit-section-unhighlight-sections))) + (t + (setq paint t))))) + (when paint + (save-excursion + (goto-char (oref section start)) + (let ((end (oref section end)) + (merging (looking-at "@@@")) + (diff-type (magit-diff-type)) + (stage nil) + (tab-width (magit-diff-tab-width + (magit-section-parent-value section)))) + (forward-line) + (while (< (point) end) + (when (and magit-diff-hide-trailing-cr-characters + (char-equal ?\r (char-before (line-end-position)))) + (put-text-property (1- (line-end-position)) (line-end-position) + 'invisible t)) + (put-text-property + (point) (1+ (line-end-position)) 'font-lock-face + (cond + ((looking-at "^\\+\\+?\\([<=|>]\\)\\{7\\}") + (setq stage (pcase (list (match-string 1) highlight) + ('("<" nil) 'magit-diff-our) + ('("<" t) 'magit-diff-our-highlight) + ('("|" nil) 'magit-diff-base) + ('("|" t) 'magit-diff-base-highlight) + ('("=" nil) 'magit-diff-their) + ('("=" t) 'magit-diff-their-highlight) + ('(">" nil) nil))) + 'magit-diff-conflict-heading) + ((looking-at (if merging "^\\(\\+\\| \\+\\)" "^\\+")) + (magit-diff-paint-tab merging tab-width) + (magit-diff-paint-whitespace merging 'added diff-type) + (or stage + (if highlight 'magit-diff-added-highlight 'magit-diff-added))) + ((looking-at (if merging "^\\(-\\| -\\)" "^-")) + (magit-diff-paint-tab merging tab-width) + (magit-diff-paint-whitespace merging 'removed diff-type) + (if highlight 'magit-diff-removed-highlight 'magit-diff-removed)) + (t + (magit-diff-paint-tab merging tab-width) + (magit-diff-paint-whitespace merging 'context diff-type) + (if highlight 'magit-diff-context-highlight 'magit-diff-context)))) + (forward-line)))))) + (magit-diff-update-hunk-refinement section)) + +(defvar magit-diff--tab-width-cache nil) + +(defun magit-diff-tab-width (file) + (setq file (expand-file-name file)) + (cl-flet ((cache (value) + (let ((elt (assoc file magit-diff--tab-width-cache))) + (if elt + (setcdr elt value) + (setq magit-diff--tab-width-cache + (cons (cons file value) + magit-diff--tab-width-cache)))) + value)) + (cond + ((not magit-diff-adjust-tab-width) + tab-width) + ((and-let* ((buffer (find-buffer-visiting file))) + (cache (buffer-local-value 'tab-width buffer)))) + ((and-let* ((elt (assoc file magit-diff--tab-width-cache))) + (or (cdr elt) + tab-width))) + ((or (eq magit-diff-adjust-tab-width 'always) + (and (numberp magit-diff-adjust-tab-width) + (>= magit-diff-adjust-tab-width + (nth 7 (file-attributes file))))) + (cache (buffer-local-value 'tab-width (find-file-noselect file)))) + (t + (cache nil) + tab-width)))) + +(defun magit-diff-paint-tab (merging width) + (save-excursion + (forward-char (if merging 2 1)) + (while (= (char-after) ?\t) + (put-text-property (point) (1+ (point)) + 'display (list (list 'space :width width))) + (forward-char)))) + +(defun magit-diff-paint-whitespace (merging line-type diff-type) + (when (and magit-diff-paint-whitespace + (or (not (memq magit-diff-paint-whitespace '(uncommitted status))) + (memq diff-type '(staged unstaged))) + (cl-case line-type + (added t) + (removed (memq magit-diff-paint-whitespace-lines '(all both))) + (context (memq magit-diff-paint-whitespace-lines '(all))))) + (let ((prefix (if merging "^[-\\+\s]\\{2\\}" "^[-\\+\s]")) + (indent + (if (local-variable-p 'magit-diff-highlight-indentation) + magit-diff-highlight-indentation + (setq-local + magit-diff-highlight-indentation + (cdr (--first (string-match-p (car it) default-directory) + (nreverse + (default-value + 'magit-diff-highlight-indentation)))))))) + (when (and magit-diff-highlight-trailing + (looking-at (concat prefix ".*?\\([ \t]+\\)?$"))) + (let ((ov (make-overlay (match-beginning 1) (match-end 1) nil t))) + (overlay-put ov 'font-lock-face 'magit-diff-whitespace-warning) + (overlay-put ov 'priority 2) + (overlay-put ov 'evaporate t))) + (when (or (and (eq indent 'tabs) + (looking-at (concat prefix "\\( *\t[ \t]*\\)"))) + (and (integerp indent) + (looking-at (format "%s\\([ \t]* \\{%s,\\}[ \t]*\\)" + prefix indent)))) + (let ((ov (make-overlay (match-beginning 1) (match-end 1) nil t))) + (overlay-put ov 'font-lock-face 'magit-diff-whitespace-warning) + (overlay-put ov 'priority 2) + (overlay-put ov 'evaporate t)))))) + +(defun magit-diff-update-hunk-refinement (&optional section) + (if section + (unless (oref section hidden) + (pcase (list magit-diff-refine-hunk + (oref section refined) + (eq section (magit-current-section))) + ((or `(all nil ,_) '(t nil t)) + (oset section refined t) + (save-excursion + (goto-char (oref section start)) + ;; `diff-refine-hunk' does not handle combined diffs. + (unless (looking-at "@@@") + (let ((smerge-refine-ignore-whitespace + magit-diff-refine-ignore-whitespace) + ;; Avoid fsyncing many small temp files + (write-region-inhibit-fsync t)) + (diff-refine-hunk))))) + ((or `(nil t ,_) '(t t nil)) + (oset section refined nil) + (remove-overlays (oref section start) + (oref section end) + 'diff-mode 'fine)))) + (cl-labels ((recurse (section) + (if (magit-section-match 'hunk section) + (magit-diff-update-hunk-refinement section) + (dolist (child (oref section children)) + (recurse child))))) + (recurse magit-root-section)))) + + +;;; Hunk Region + +(defun magit-diff-hunk-region-beginning () + (save-excursion (goto-char (region-beginning)) + (line-beginning-position))) + +(defun magit-diff-hunk-region-end () + (save-excursion (goto-char (region-end)) + (line-end-position))) + +(defun magit-diff-update-hunk-region (section) + "Highlight the hunk-internal region if any." + (when (and (eq (oref section type) 'hunk) + (eq (magit-diff-scope section t) 'region)) + (magit-diff--make-hunk-overlay + (oref section start) + (1- (oref section content)) + 'font-lock-face 'magit-diff-lines-heading + 'display (magit-diff-hunk-region-header section) + 'after-string (magit-diff--hunk-after-string 'magit-diff-lines-heading)) + (run-hook-with-args 'magit-diff-highlight-hunk-region-functions section) + t)) + +(defun magit-diff-highlight-hunk-region-dim-outside (section) + "Dim the parts of the hunk that are outside the hunk-internal region. +This is done by using the same foreground and background color +for added and removed lines as for context lines." + (let ((face (if magit-diff-highlight-hunk-body + 'magit-diff-context-highlight + 'magit-diff-context))) + (when magit-diff-unmarked-lines-keep-foreground + (setq face `(,@(and (>= emacs-major-version 27) '(:extend t)) + :background ,(face-attribute face :background)))) + (magit-diff--make-hunk-overlay (oref section content) + (magit-diff-hunk-region-beginning) + 'font-lock-face face + 'priority 2) + (magit-diff--make-hunk-overlay (1+ (magit-diff-hunk-region-end)) + (oref section end) + 'font-lock-face face + 'priority 2))) + +(defun magit-diff-highlight-hunk-region-using-face (_section) + "Highlight the hunk-internal region by making it bold. +Or rather highlight using the face `magit-diff-hunk-region', though +changing only the `:weight' and/or `:slant' is recommended for that +face." + (magit-diff--make-hunk-overlay (magit-diff-hunk-region-beginning) + (1+ (magit-diff-hunk-region-end)) + 'font-lock-face 'magit-diff-hunk-region)) + +(defun magit-diff-highlight-hunk-region-using-overlays (section) + "Emphasize the hunk-internal region using delimiting horizontal lines. +This is implemented as single-pixel newlines places inside overlays." + (if (window-system) + (let ((beg (magit-diff-hunk-region-beginning)) + (end (magit-diff-hunk-region-end)) + (str (propertize + (concat (propertize "\s" 'display '(space :height (1))) + (propertize "\n" 'line-height t)) + 'font-lock-face 'magit-diff-lines-boundary))) + (magit-diff--make-hunk-overlay beg (1+ beg) 'before-string str) + (magit-diff--make-hunk-overlay end (1+ end) 'after-string str)) + (magit-diff-highlight-hunk-region-using-face section))) + +(defun magit-diff-highlight-hunk-region-using-underline (section) + "Emphasize the hunk-internal region using delimiting horizontal lines. +This is implemented by overlining and underlining the first and +last (visual) lines of the region." + (if (window-system) + (let* ((beg (magit-diff-hunk-region-beginning)) + (end (magit-diff-hunk-region-end)) + (beg-eol (save-excursion (goto-char beg) + (end-of-visual-line) + (point))) + (end-bol (save-excursion (goto-char end) + (beginning-of-visual-line) + (point))) + (color (face-background 'magit-diff-lines-boundary nil t))) + (cl-flet ((ln (b e &rest face) + (magit-diff--make-hunk-overlay + b e 'font-lock-face face 'after-string + (magit-diff--hunk-after-string face)))) + (if (= beg end-bol) + (ln beg beg-eol :overline color :underline color) + (ln beg beg-eol :overline color) + (ln end-bol end :underline color)))) + (magit-diff-highlight-hunk-region-using-face section))) + +(defun magit-diff--make-hunk-overlay (start end &rest args) + (let ((ov (make-overlay start end nil t))) + (overlay-put ov 'evaporate t) + (while args (overlay-put ov (pop args) (pop args))) + (push ov magit-section--region-overlays) + ov)) + +(defun magit-diff--hunk-after-string (face) + (propertize "\s" + 'font-lock-face face + 'display (list 'space :align-to + `(+ (0 . right) + ,(min (window-hscroll) + (- (line-end-position) + (line-beginning-position))))) + ;; This prevents the cursor from being rendered at the + ;; edge of the window. + 'cursor t)) + +;;; Utilities + +(defun magit-diff-inside-hunk-body-p () + "Return non-nil if point is inside the body of a hunk." + (and (magit-section-match 'hunk) + (and-let* ((content (oref (magit-current-section) content))) + (> (magit-point) content)))) + +(defun magit-diff--combined-p (section) + (cl-assert (cl-typep section 'magit-file-section)) + (string-match-p "\\`diff --\\(combined\\|cc\\)" (oref section value))) + +;;; Diff Extract + +(defun magit-diff-file-header (section &optional no-rename) + (when (magit-hunk-section-p section) + (setq section (oref section parent))) + (and (magit-file-section-p section) + (let ((header (oref section header))) + (if no-rename + (replace-regexp-in-string + "^--- \\(.+\\)" (oref section value) header t t 1) + header)))) + +(defun magit-diff-hunk-region-header (section) + (let ((patch (magit-diff-hunk-region-patch section))) + (string-match "\n" patch) + (substring patch 0 (1- (match-end 0))))) + +(defun magit-diff-hunk-region-patch (section &optional args) + (let ((op (if (member "--reverse" args) "+" "-")) + (sbeg (oref section start)) + (rbeg (magit-diff-hunk-region-beginning)) + (rend (region-end)) + (send (oref section end)) + (patch nil)) + (save-excursion + (goto-char sbeg) + (while (< (point) send) + (looking-at "\\(.\\)\\([^\n]*\n\\)") + (cond ((or (string-match-p "[@ ]" (match-string-no-properties 1)) + (and (>= (point) rbeg) + (<= (point) rend))) + (push (match-string-no-properties 0) patch)) + ((equal op (match-string-no-properties 1)) + (push (concat " " (match-string-no-properties 2)) patch))) + (forward-line))) + (let ((buffer-list-update-hook nil)) ; #3759 + (with-temp-buffer + (insert (string-join (reverse patch))) + (diff-fixup-modifs (point-min) (point-max)) + (setq patch (buffer-string)))) + patch)) + +;;; _ +(provide 'magit-diff) +;;; magit-diff.el ends here diff --git a/emacs/elpa/magit-20240625.2109/magit-diff.elc b/emacs/elpa/magit-20240625.2109/magit-diff.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/magit-ediff.el b/emacs/elpa/magit-20240625.2109/magit-ediff.el diff --git a/emacs/elpa/magit-20240625.2109/magit-ediff.elc b/emacs/elpa/magit-20240625.2109/magit-ediff.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/magit-extras.el b/emacs/elpa/magit-20240625.2109/magit-extras.el diff --git a/emacs/elpa/magit-20240622.1531/magit-extras.elc b/emacs/elpa/magit-20240625.2109/magit-extras.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/magit-fetch.el b/emacs/elpa/magit-20240625.2109/magit-fetch.el diff --git a/emacs/elpa/magit-20240622.1531/magit-fetch.elc b/emacs/elpa/magit-20240625.2109/magit-fetch.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/magit-files.el b/emacs/elpa/magit-20240625.2109/magit-files.el diff --git a/emacs/elpa/magit-20240622.1531/magit-files.elc b/emacs/elpa/magit-20240625.2109/magit-files.elc Binary files differ. diff --git a/emacs/elpa/magit-20240625.2109/magit-git.el b/emacs/elpa/magit-20240625.2109/magit-git.el @@ -0,0 +1,2873 @@ +;;; magit-git.el --- Git functionality -*- lexical-binding:t -*- + +;; Copyright (C) 2008-2024 The Magit Project Contributors + +;; Author: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> +;; Maintainer: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; 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. +;; +;; 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 Magit. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This library implements wrappers for various Git plumbing commands. + +;;; Code: + +(require 'magit-base) + +(require 'format-spec) + +;; From `magit-branch'. +(defvar magit-branch-prefer-remote-upstream) +(defvar magit-published-branches) + +;; From `magit-margin'. +(declare-function magit-maybe-make-margin-overlay "magit-margin" ()) + +;; From `magit-mode'. +(declare-function magit-get-mode-buffer "magit-mode" + (mode &optional value frame)) +(declare-function magit-refresh "magit-mode" ()) +(defvar magit-buffer-diff-type) +(defvar magit-buffer-diff-args) +(defvar magit-buffer-file-name) +(defvar magit-buffer-log-args) +(defvar magit-buffer-log-files) +(defvar magit-buffer-refname) +(defvar magit-buffer-revision) + +;; From `magit-process'. +(declare-function magit-call-git "magit-process" (&rest args)) +(declare-function magit-git "magit-process" (&rest args)) +(declare-function magit-process-buffer "magit-process" (&optional nodisplay)) +(declare-function magit-process-file "magit-process" + (process &optional infile buffer display &rest args)) +(declare-function magit-process-git "magit-process" (destination &rest args)) +(declare-function magit-process-insert-section "magit-process" + (pwd program args &optional errcode errlog)) +(defvar magit-this-error) +(defvar magit-process-error-message-regexps) + +(eval-when-compile + (cl-pushnew 'orig-rev eieio--known-slot-names) + (cl-pushnew 'number eieio--known-slot-names)) + +;;; Options + +;; For now this is shared between `magit-process' and `magit-git'. +(defgroup magit-process nil + "Git and other external processes used by Magit." + :group 'magit) + +(defvar magit-git-environment + (list (format "INSIDE_EMACS=%s,magit" emacs-version)) + "Prepended to `process-environment' while running git.") + +(defcustom magit-git-output-coding-system + (and (eq system-type 'windows-nt) 'utf-8) + "Coding system for receiving output from Git. + +If non-nil, the Git config value `i18n.logOutputEncoding' should +be set via `magit-git-global-arguments' to value consistent with +this." + :package-version '(magit . "2.9.0") + :group 'magit-process + :type '(choice (coding-system :tag "Coding system to decode Git output") + (const :tag "Use system default" nil))) + +(defvar magit-git-w32-path-hack nil + "Alist of (EXE . (PATHENTRY)). +This specifies what additional PATH setting needs to be added to +the environment in order to run the non-wrapper git executables +successfully.") + +(defcustom magit-git-executable + (or (and (eq system-type 'windows-nt) + ;; Avoid the wrappers "cmd/git.exe" and "cmd/git.cmd", + ;; which are much slower than using "bin/git.exe" directly. + (and-let* ((exec (executable-find "git"))) + (ignore-errors + ;; Git for Windows 2.x provides cygpath so we can + ;; ask it for native paths. + (let* ((core-exe + (car + (process-lines + exec "-c" + "alias.X=!x() { which \"$1\" | cygpath -mf -; }; x" + "X" "git"))) + (hack-entry (assoc core-exe magit-git-w32-path-hack)) + ;; Running the libexec/git-core executable + ;; requires some extra PATH entries. + (path-hack + (list (concat "PATH=" + (car (process-lines + exec "-c" + "alias.P=!cygpath -wp \"$PATH\"" + "P")))))) + ;; The defcustom STANDARD expression can be + ;; evaluated many times, so make sure it is + ;; idempotent. + (if hack-entry + (setcdr hack-entry path-hack) + (push (cons core-exe path-hack) magit-git-w32-path-hack)) + core-exe)))) + (and (eq system-type 'darwin) + (executable-find "git")) + "git") + "The Git executable used by Magit on the local host. +On remote machines `magit-remote-git-executable' is used instead." + :package-version '(magit . "3.2.0") + :group 'magit-process + :type 'string) + +(defcustom magit-remote-git-executable "git" + "The Git executable used by Magit on remote machines. +On the local host `magit-git-executable' is used instead. +Consider customizing `tramp-remote-path' instead of this +option." + :package-version '(magit . "3.2.0") + :group 'magit-process + :type 'string) + +(defcustom magit-git-global-arguments + `("--no-pager" "--literal-pathspecs" + "-c" "core.preloadindex=true" + "-c" "log.showSignature=false" + "-c" "color.ui=false" + "-c" "color.diff=false" + ,@(and (eq system-type 'windows-nt) + (list "-c" "i18n.logOutputEncoding=UTF-8"))) + "Global Git arguments. + +The arguments set here are used every time the git executable is +run as a subprocess. They are placed right after the executable +itself and before the git command - as in `git HERE... COMMAND +REST'. See the manpage `git(1)' for valid arguments. + +Be careful what you add here, especially if you are using Tramp +to connect to servers with ancient Git versions. Never remove +anything that is part of the default value, unless you really +know what you are doing. And think very hard before adding +something; it will be used every time Magit runs Git for any +purpose." + :package-version '(magit . "2.9.0") + :group 'magit-commands + :group 'magit-process + :type '(repeat string)) + +(defcustom magit-prefer-remote-upstream nil + "Whether to favor remote branches when reading the upstream branch. + +This controls whether commands that read a branch from the user +and then set it as the upstream branch, offer a local or a remote +branch as default completion candidate, when they have the choice. + +This affects all commands that use `magit-read-upstream-branch' +or `magit-read-starting-point', which includes most commands +that change the upstream and many that create new branches." + :package-version '(magit . "2.4.2") + :group 'magit-commands + :type 'boolean) + +(defcustom magit-list-refs-namespaces + '("refs/heads" + "refs/remotes" + "refs/tags" + "refs/pullreqs") + "List of ref namespaces considered when reading a ref. + +This controls the order of refs returned by `magit-list-refs', +which is called by functions like `magit-list-branch-names' to +generate the collection of refs." + :package-version '(magit . "3.1.0") + :group 'magit-commands + :type '(repeat string)) + +(defcustom magit-list-refs-sortby nil + "How to sort the ref collection in the prompt. + +This affects commands that read a ref. More specifically, it +controls the order of refs returned by `magit-list-refs', which +is called by functions like `magit-list-branch-names' to generate +the collection of refs. By default, refs are sorted according to +their full refname (i.e., \"refs/...\"). + +Any value accepted by the `--sort' flag of \"git for-each-ref\" can +be used. For example, \"-creatordate\" places refs with more +recent committer or tagger dates earlier in the list. A list of +strings can also be given in order to pass multiple sort keys to +\"git for-each-ref\". + +Note that, depending on the completion framework you use, this +may not be sufficient to change the order in which the refs are +displayed. It only controls the order of the collection passed +to `magit-completing-read' or, for commands that support reading +multiple strings, `read-from-minibuffer'. The completion +framework ultimately determines how the collection is displayed." + :package-version '(magit . "2.11.0") + :group 'magit-miscellaneous + :type '(choice string (repeat string))) + +;;; Git + +(defvar magit-git-debug nil + "Whether to enable additional reporting of git errors. + +Magit basically calls git for one of these two reasons: for +side-effects or to do something with its standard output. + +When git is run for side-effects then its output, including error +messages, go into the process buffer which is shown when using \ +\\<magit-status-mode-map>\\[magit-process-buffer]. + +When git's output is consumed in some way, then it would be too +expensive to also insert it into this buffer, but when this +option is non-nil and git returns with a non-zero exit status, +then at least its standard error is inserted into this buffer. + +This is only intended for debugging purposes. Do not enable this +permanently, that would negatively affect performance. Also note +that just because git exits with a non-zero exit status and prints +an error message that usually doesn't mean that it is an error as +far as Magit is concerned, which is another reason we usually hide +these error messages. Whether some error message is relevant in +the context of some unexpected behavior has to be judged on a case +by case basis. + +The command `magit-toggle-git-debug' changes the value of this +variable. + +Also see `magit-process-extreme-logging'.") + +(defun magit-toggle-git-debug () + "Toggle whether additional git errors are reported. +See info node `(magit)Debugging Tools' for more information." + (interactive) + (setq magit-git-debug (not magit-git-debug)) + (message "Additional reporting of Git errors %s" + (if magit-git-debug "enabled" "disabled"))) + +(defvar magit--refresh-cache nil) + +(defmacro magit--with-refresh-cache (key &rest body) + (declare (indent 1) (debug (form body))) + (let ((k (cl-gensym)) + (hit (cl-gensym))) + `(if magit--refresh-cache + (let ((,k ,key)) + (if-let ((,hit (assoc ,k (cdr magit--refresh-cache)))) + (progn (cl-incf (caar magit--refresh-cache)) + (cdr ,hit)) + (cl-incf (cdar magit--refresh-cache)) + (let ((value ,(macroexp-progn body))) + (push (cons ,k value) + (cdr magit--refresh-cache)) + value))) + ,@body))) + +(defvar magit-with-editor-envvar "GIT_EDITOR" + "The environment variable exported by `magit-with-editor'. +Set this to \"GIT_SEQUENCE_EDITOR\" if you do not want to use +Emacs to edit commit messages but would like to do so to edit +rebase sequences.") + +(defmacro magit-with-editor (&rest body) + "Like `with-editor*' but let-bind some more variables. +Also respect the value of `magit-with-editor-envvar'." + (declare (indent 0) (debug (body))) + `(let ((magit-process-popup-time -1) + ;; The user may have customized `shell-file-name' to + ;; something which results in `w32-shell-dos-semantics' nil + ;; (which changes the quoting style used by + ;; `shell-quote-argument'), but Git for Windows expects shell + ;; quoting in the dos style. + (shell-file-name (if (and (eq system-type 'windows-nt) + ;; If we have Cygwin mount points, + ;; the git flavor is cygwin, so dos + ;; shell quoting is probably wrong. + (not magit-cygwin-mount-points)) + "cmdproxy" + shell-file-name))) + (with-editor* magit-with-editor-envvar + ,@body))) + +(defmacro magit--with-temp-process-buffer (&rest body) + "Like `with-temp-buffer', but always propagate `process-environment'. +When that var is buffer-local in the calling buffer, it is not +propagated by `with-temp-buffer', so we explicitly ensure that +happens, so that processes will be invoked consistently. BODY is +as for that macro." + (declare (indent 0) (debug (body))) + (let ((p (cl-gensym))) + `(let ((,p process-environment)) + (with-temp-buffer + (setq-local process-environment ,p) + ,@body)))) + +(defsubst magit-git-executable () + "Return value of `magit-git-executable' or `magit-remote-git-executable'. +The variable is chosen depending on whether `default-directory' +is remote." + (if (file-remote-p default-directory) + magit-remote-git-executable + magit-git-executable)) + +(defun magit-process-git-arguments (args) + "Prepare ARGS for a function that invokes Git. + +Magit has many specialized functions for running Git; they all +pass arguments through this function before handing them to Git, +to do the following. + +* Flatten ARGS, removing nil arguments. +* Prepend `magit-git-global-arguments' to ARGS. +* On w32 systems, encode to `w32-ansi-code-page'." + (setq args (append magit-git-global-arguments (flatten-tree args))) + (if (and (eq system-type 'windows-nt) (boundp 'w32-ansi-code-page)) + ;; On w32, the process arguments *must* be encoded in the + ;; current code-page (see #3250). + (mapcar (lambda (arg) + (encode-coding-string + arg (intern (format "cp%d" w32-ansi-code-page)))) + args) + args)) + +(defun magit-git-exit-code (&rest args) + "Execute Git with ARGS, returning its exit code." + (magit-process-git nil args)) + +(defun magit-git-success (&rest args) + "Execute Git with ARGS, returning t if its exit code is 0." + (= (magit-git-exit-code args) 0)) + +(defun magit-git-failure (&rest args) + "Execute Git with ARGS, returning t if its exit code is 1." + (= (magit-git-exit-code args) 1)) + +(defun magit-git-string-p (&rest args) + "Execute Git with ARGS, returning the first line of its output. +If the exit code isn't zero or if there is no output, then return +nil. Neither of these results is considered an error; if that is +what you want, then use `magit-git-string-ng' instead. + +This is an experimental replacement for `magit-git-string', and +still subject to major changes." + (magit--with-refresh-cache (cons default-directory args) + (magit--with-temp-process-buffer + (and (zerop (magit-process-git t args)) + (not (bobp)) + (progn + (goto-char (point-min)) + (buffer-substring-no-properties (point) (line-end-position))))))) + +(defun magit-git-string-ng (&rest args) + "Execute Git with ARGS, returning the first line of its output. +If the exit code isn't zero or if there is no output, then that +is considered an error, but instead of actually signaling an +error, return nil. Additionally the output is put in the process +buffer (creating it if necessary) and the error message is shown +in the status buffer (provided it exists). + +This is an experimental replacement for `magit-git-string', and +still subject to major changes. Also see `magit-git-string-p'." + (magit--with-refresh-cache + (list default-directory 'magit-git-string-ng args) + (magit--with-temp-process-buffer + (let* ((args (magit-process-git-arguments args)) + (status (magit-process-git t args))) + (if (zerop status) + (and (not (bobp)) + (progn + (goto-char (point-min)) + (buffer-substring-no-properties + (point) (line-end-position)))) + (let ((buf (current-buffer))) + (with-current-buffer (magit-process-buffer t) + (magit-process-insert-section default-directory + magit-git-executable args + status buf))) + (when-let ((status-buf (magit-get-mode-buffer 'magit-status-mode))) + (let ((msg (magit--locate-error-message))) + (with-current-buffer status-buf + (setq magit-this-error msg)))) + nil))))) + +(defun magit-git-str (&rest args) + "Execute Git with ARGS, returning the first line of its output. +If there is no output, return nil. If the output begins with a +newline, return an empty string. Like `magit-git-string' but +ignore `magit-git-debug'." + (setq args (flatten-tree args)) + (magit--with-refresh-cache (cons default-directory args) + (magit--with-temp-process-buffer + (magit-process-git (list t nil) args) + (unless (bobp) + (goto-char (point-min)) + (buffer-substring-no-properties (point) (line-end-position)))))) + +(defun magit-git-output (&rest args) + "Execute Git with ARGS, returning its output." + (setq args (flatten-tree args)) + (magit--with-refresh-cache (cons default-directory args) + (magit--with-temp-process-buffer + (magit-process-git (list t nil) args) + (buffer-substring-no-properties (point-min) (point-max))))) + +(define-error 'magit-invalid-git-boolean "Not a Git boolean") + +(defun magit-git-true (&rest args) + "Execute Git with ARGS, returning t if it prints \"true\". +If it prints \"false\", then return nil. For any other output +signal `magit-invalid-git-boolean'." + (pcase (magit-git-output args) + ((or "true" "true\n") t) + ((or "false" "false\n") nil) + (output (signal 'magit-invalid-git-boolean (list output))))) + +(defun magit-git-false (&rest args) + "Execute Git with ARGS, returning t if it prints \"false\". +If it prints \"true\", then return nil. For any other output +signal `magit-invalid-git-boolean'." + (pcase (magit-git-output args) + ((or "true" "true\n") nil) + ((or "false" "false\n") t) + (output (signal 'magit-invalid-git-boolean (list output))))) + +(defun magit-git-config-p (variable &optional default) + "Return the boolean value of the Git variable VARIABLE. +VARIABLE has to be specified as a string. Return DEFAULT (which +defaults to nil) if VARIABLE is unset. If VARIABLE's value isn't +a boolean, then raise an error." + (let ((args (list "config" "--bool" "--default" (if default "true" "false") + variable))) + (magit--with-refresh-cache (cons default-directory args) + (magit--with-temp-process-buffer + (let ((status (magit-process-git t args)) + (output (buffer-substring (point-min) (1- (point-max))))) + (if (zerop status) + (equal output "true") + (signal 'magit-invalid-git-boolean (list output)))))))) + +(defun magit-git-insert (&rest args) + "Execute Git with ARGS, inserting its output at point. +If Git exits with a non-zero exit status, then show a message and +add a section in the respective process buffer." + (apply #'magit--git-insert nil args)) + +(defun magit--git-insert (return-error &rest args) + (setq args (magit-process-git-arguments args)) + (if (or return-error magit-git-debug) + (let (log) + (unwind-protect + (let (exit errmsg) + (setq log (make-temp-file "magit-stderr")) + (delete-file log) + (setq exit (magit-process-git (list t log) args)) + (when (> exit 0) + (when (file-exists-p log) + (with-temp-buffer + (insert-file-contents log) + (goto-char (point-max)) + (setq errmsg + (if (functionp magit-git-debug) + (funcall magit-git-debug (buffer-string)) + (magit--locate-error-message)))) + (unless return-error + (let ((magit-git-debug nil)) + (with-current-buffer (magit-process-buffer t) + (magit-process-insert-section default-directory + magit-git-executable + args exit log))))) + (unless return-error + (if errmsg + (message "%s" errmsg) + (message "Git returned with exit-code %s" exit)))) + (or errmsg exit)) + (ignore-errors (delete-file log)))) + (magit-process-git (list t nil) args))) + +(defun magit--locate-error-message () + (goto-char (point-max)) + (and (run-hook-wrapped 'magit-process-error-message-regexps + (lambda (re) (re-search-backward re nil t))) + (match-string-no-properties 1))) + +(defun magit-git-string (&rest args) + "Execute Git with ARGS, returning the first line of its output. +If there is no output, return nil. If the output begins with a +newline, return an empty string." + (setq args (flatten-tree args)) + (magit--with-refresh-cache (cons default-directory args) + (magit--with-temp-process-buffer + (apply #'magit-git-insert args) + (unless (bobp) + (goto-char (point-min)) + (buffer-substring-no-properties (point) (line-end-position)))))) + +(defun magit-git-lines (&rest args) + "Execute Git with ARGS, returning its output as a list of lines. +Empty lines anywhere in the output are omitted. + +If Git exits with a non-zero exit status, then report show a +message and add a section in the respective process buffer." + (magit--with-temp-process-buffer + (apply #'magit-git-insert args) + (split-string (buffer-string) "\n" t))) + +(defun magit-git-items (&rest args) + "Execute Git with ARGS, returning its null-separated output as a list. +Empty items anywhere in the output are omitted. + +If Git exits with a non-zero exit status, then report show a +message and add a section in the respective process buffer." + (magit--with-temp-process-buffer + (apply #'magit-git-insert args) + (split-string (buffer-string) "\0" t))) + +(defvar magit--git-wash-keep-error nil) ; experimental + +(defun magit-git-wash (washer &rest args) + "Execute Git with ARGS, inserting washed output at point. +Actually first insert the raw output at point. If there is no +output, call `magit-cancel-section'. Otherwise temporarily narrow +the buffer to the inserted text, move to its beginning, and then +call function WASHER with ARGS as its sole argument." + (declare (indent 1)) + (apply #'magit--git-wash washer magit--git-wash-keep-error args)) + +(defun magit--git-wash (washer keep-error &rest args) + (declare (indent 2)) + (setq args (flatten-tree args)) + (let ((beg (point)) + (exit (magit--git-insert keep-error args))) + (when (stringp exit) + (goto-char beg) + (insert (propertize exit 'face 'error)) + (unless (bolp) + (insert "\n"))) + (if (= (point) beg) + (magit-cancel-section) + (unless (bolp) + (insert "\n")) + (when (or (equal exit 0) + (eq keep-error 'wash-anyway)) + (save-restriction + (narrow-to-region beg (point)) + (goto-char beg) + (funcall washer args)) + (when (or (= (point) beg) + (= (point) (1+ beg))) + (magit-cancel-section)) + (magit-maybe-make-margin-overlay))) + exit)) + +(defun magit-git-executable-find (command) + "Search for COMMAND in Git's exec path, falling back to `exec-path'. +Like `executable-find', return the absolute file name of the +executable." + (or (locate-file command + (list (concat + (file-remote-p default-directory) + (or (magit-git-string "--exec-path") + (error "`git --exec-path' failed")))) + exec-suffixes + #'file-executable-p) + (compat-call executable-find command t))) + +;;; Git Version + +(defconst magit--git-version-regexp + "\\`git version \\([0-9]+\\(\\.[0-9]+\\)\\{1,2\\}\\)") + +(defvar magit--host-git-version-cache nil) + +(defun magit-git-version>= (n) + "Return t if `magit-git-version's value is greater than or equal to N." + (magit--version>= (magit-git-version) n)) + +(defun magit-git-version< (n) + "Return t if `magit-git-version's value is smaller than N." + (version< (magit-git-version) n)) + +(defun magit-git-version () + "Return the Git version used for `default-directory'. +Raise an error if Git cannot be found, if it exits with a +non-zero status, or the output does not have the expected +format." + (magit--with-refresh-cache default-directory + (let ((host (file-remote-p default-directory))) + (or (cdr (assoc host magit--host-git-version-cache)) + (magit--with-temp-process-buffer + ;; Unset global arguments for ancient Git versions. + (let* ((magit-git-global-arguments nil) + (status (magit-process-git t "version")) + (output (buffer-string))) + (cond + ((not (zerop status)) + (display-warning + 'magit + (format "%S\n\nRunning \"%s --version\" failed with output:\n\n%s" + (if host + (format "Magit cannot find Git on host %S.\n +Check the value of `magit-remote-git-executable' using +`magit-debug-git-executable' and consult the info node +`(tramp)Remote programs'." host) + "Magit cannot find Git.\n +Check the values of `magit-git-executable' and `exec-path' +using `magit-debug-git-executable'.") + (magit-git-executable) + output))) + ((save-match-data + (and (string-match magit--git-version-regexp output) + (let ((version (match-string 1 output))) + (push (cons host version) + magit--host-git-version-cache) + version)))) + ((error "Unexpected \"%s --version\" output: %S" + (magit-git-executable) + output))))))))) + +(defun magit-git-version-assert (&optional minimal who) + "Assert that the used Git version is greater than or equal to MINIMAL. +If optional MINIMAL is nil, compare with `magit--minimal-git' +instead. Optional WHO if non-nil specifies what functionality +needs at least MINIMAL, otherwise it defaults to \"Magit\"." + (when (magit-git-version< (or minimal magit--minimal-git)) + (let* ((host (file-remote-p default-directory)) + (msg (format-spec + (cond (host "\ +%w requires Git %m or greater, but on %h the version is %v. + +If multiple Git versions are installed on the host, then the +problem might be that TRAMP uses the wrong executable. + +Check the value of `magit-remote-git-executable' and consult +the info node `(tramp)Remote programs'.\n") + (t "\ +%w requires Git %m or greater, but you are using %v. + +If you have multiple Git versions installed, then check the +values of `magit-remote-git-executable' and `exec-path'.\n")) + `((?w . ,(or who "Magit")) + (?m . ,(or minimal magit--minimal-git)) + (?v . ,(magit-git-version)) + (?h . ,host))))) + (display-warning 'magit msg :error)))) + +(defun magit--safe-git-version () + "Return the Git version used for `default-directory' or an error message." + (magit--with-temp-process-buffer + (let* ((magit-git-global-arguments nil) + (status (magit-process-git t "version")) + (output (buffer-string))) + (cond ((not (zerop status)) output) + ((save-match-data + (and (string-match magit--git-version-regexp output) + (match-string 1 output)))) + (t output))))) + +(defun magit-debug-git-executable () + "Display a buffer with information about `magit-git-executable'. +Also include information about `magit-remote-git-executable'. +See info node `(magit)Debugging Tools' for more information." + (interactive) + (with-current-buffer (get-buffer-create "*magit-git-debug*") + (pop-to-buffer (current-buffer)) + (erase-buffer) + (insert (format "magit-remote-git-executable: %S\n" + magit-remote-git-executable)) + (insert (concat + (format "magit-git-executable: %S" magit-git-executable) + (and (not (file-name-absolute-p magit-git-executable)) + (format " [%S]" (executable-find magit-git-executable))) + (format " (%s)\n" (magit--safe-git-version)))) + (insert (format "exec-path: %S\n" exec-path)) + (when-let ((diff (cl-set-difference + (seq-filter #'file-exists-p (remq nil (parse-colon-path + (getenv "PATH")))) + (seq-filter #'file-exists-p (remq nil exec-path)) + :test #'file-equal-p))) + (insert (format " entries in PATH, but not in exec-path: %S\n" diff))) + (dolist (execdir exec-path) + (insert (format " %s (%s)\n" execdir (car (file-attributes execdir)))) + (when (file-directory-p execdir) + (dolist (exec (directory-files + execdir t (concat + "\\`git" (regexp-opt exec-suffixes) "\\'"))) + (insert (format " %s (%s)\n" exec + (magit--safe-git-version)))))))) + +;;; Variables + +(defun magit-config-get-from-cached-list (key) + (gethash + ;; `git config --list' downcases first and last components of the key. + (let* ((key (replace-regexp-in-string "\\`[^.]+" #'downcase key t t)) + (key (replace-regexp-in-string "[^.]+\\'" #'downcase key t t))) + key) + (magit--with-refresh-cache (cons (magit-toplevel) 'config) + (let ((configs (make-hash-table :test #'equal))) + (dolist (conf (magit-git-items "config" "--list" "-z")) + (let* ((nl-pos (cl-position ?\n conf)) + (key (substring conf 0 nl-pos)) + (val (if nl-pos (substring conf (1+ nl-pos)) ""))) + (puthash key (nconc (gethash key configs) (list val)) configs))) + configs)))) + +(defun magit-get (&rest keys) + "Return the value of the Git variable specified by KEYS." + (car (last (apply #'magit-get-all keys)))) + +(defun magit-get-all (&rest keys) + "Return all values of the Git variable specified by KEYS." + (let ((magit-git-debug nil) + (arg (and (or (null (car keys)) + (string-prefix-p "--" (car keys))) + (pop keys))) + (key (string-join keys "."))) + (if (and magit--refresh-cache (not arg)) + (magit-config-get-from-cached-list key) + (magit-git-items "config" arg "-z" "--get-all" key)))) + +(defun magit-get-boolean (&rest keys) + "Return the boolean value of the Git variable specified by KEYS. +Also see `magit-git-config-p'." + (let ((arg (and (or (null (car keys)) + (string-prefix-p "--" (car keys))) + (pop keys))) + (key (string-join keys "."))) + (equal (if magit--refresh-cache + (car (last (magit-config-get-from-cached-list key))) + (magit-git-str "config" arg "--bool" key)) + "true"))) + +(defun magit-set (value &rest keys) + "Set the value of the Git variable specified by KEYS to VALUE." + (let ((arg (and (or (null (car keys)) + (string-prefix-p "--" (car keys))) + (pop keys))) + (key (string-join keys "."))) + (if value + (magit-git-success "config" arg key value) + (magit-git-success "config" arg "--unset" key)) + value)) + +(gv-define-setter magit-get (val &rest keys) + `(magit-set ,val ,@keys)) + +(defun magit-set-all (values &rest keys) + "Set all values of the Git variable specified by KEYS to VALUES." + (let ((arg (and (or (null (car keys)) + (string-prefix-p "--" (car keys))) + (pop keys))) + (var (string-join keys "."))) + (when (magit-get var) + (magit-call-git "config" arg "--unset-all" var)) + (dolist (v values) + (magit-call-git "config" arg "--add" var v)))) + +;;; Files + +(defun magit--safe-default-directory (&optional file) + (catch 'unsafe-default-dir + (let ((dir (file-name-as-directory + (expand-file-name (or file default-directory)))) + (previous nil)) + (while (not (file-accessible-directory-p dir)) + (setq dir (file-name-directory (directory-file-name dir))) + (when (equal dir previous) + (throw 'unsafe-default-dir nil)) + (setq previous dir)) + dir))) + +(defmacro magit--with-safe-default-directory (file &rest body) + (declare (indent 1) (debug (form body))) + `(when-let ((default-directory (magit--safe-default-directory ,file))) + ,@body)) + +(defun magit-git-dir (&optional path) + "Like (expand-file-name PATH (magit-gitdir)) or just (magit-gitdir)." + (declare (obsolete 'magit-gitdir "Magit 4.0.0")) + (and-let* ((dir (magit-gitdir))) + (if path + (expand-file-name (convert-standard-filename path) dir) + dir))) + +(defun magit-gitdir (&optional directory) + "Return the absolute and resolved path of the .git directory. + +If the `GIT_DIR' environment variable is defined, return that. +Otherwise return the .git directory for DIRECTORY, or if that is +nil, then for `default-directory' instead. If the directory is +not located inside a Git repository, then return nil." + (let ((default-directory (or directory default-directory))) + (magit--with-refresh-cache (list default-directory 'magit-gitdir) + (magit--with-safe-default-directory nil + (and-let* + ((dir (magit-rev-parse-safe "--git-dir")) + (dir (file-name-as-directory (magit-expand-git-file-name dir)))) + (if (file-remote-p dir) + dir + (concat (file-remote-p default-directory) dir))))))) + +(defvar magit--separated-gitdirs nil) + +(defun magit--record-separated-gitdir () + (let ((topdir (magit-toplevel)) + (gitdir (magit-gitdir))) + ;; Kludge: git-annex converts submodule gitdirs to symlinks. See #3599. + (when (file-symlink-p (directory-file-name gitdir)) + (setq gitdir (file-truename gitdir))) + ;; We want to delete the entry for `topdir' here, rather than within + ;; (unless ...), in case a `--separate-git-dir' repository was switched to + ;; the standard structure (i.e., "topdir/.git/"). + (setq magit--separated-gitdirs (cl-delete topdir + magit--separated-gitdirs + :key #'car :test #'equal)) + (unless (equal (file-name-as-directory (expand-file-name ".git" topdir)) + gitdir) + (push (cons topdir gitdir) magit--separated-gitdirs)))) + +(defun magit-toplevel (&optional directory) + "Return the absolute path to the toplevel of the current repository. + +From within the working tree or control directory of a repository +return the absolute path to the toplevel directory of the working +tree. As a special case, from within a bare repository return +the control directory instead. When called outside a repository +then return nil. + +When optional DIRECTORY is non-nil then return the toplevel for +that directory instead of the one for `default-directory'. + +Try to respect the option `find-file-visit-truename', i.e., when +the value of that option is nil, then avoid needlessly returning +the truename. When a symlink to a sub-directory of the working +tree is involved, or when called from within a sub-directory of +the gitdir or from the toplevel of a gitdir, which itself is not +located within the working tree, then it is not possible to avoid +returning the truename." + (or + (magit--with-refresh-cache + (cons (or directory default-directory) 'magit-toplevel) + (magit--with-safe-default-directory directory + (if-let ((topdir (magit-rev-parse-safe "--show-toplevel"))) + (let (updir) + (setq topdir (magit-expand-git-file-name topdir)) + (cond + ((and + ;; Always honor these settings. + (not find-file-visit-truename) + (not (getenv "GIT_WORK_TREE")) + ;; `--show-cdup' is the relative path to the toplevel + ;; from `(file-truename default-directory)'. Here we + ;; pretend it is relative to `default-directory', and + ;; go to that directory. Then we check whether + ;; `--show-toplevel' still returns the same value and + ;; whether `--show-cdup' now is the empty string. If + ;; both is the case, then we are at the toplevel of + ;; the same working tree, but also avoided needlessly + ;; following any symlinks. + (progn + (setq updir (file-name-as-directory + (magit-rev-parse-safe "--show-cdup"))) + (setq updir (if (file-name-absolute-p updir) + (concat (file-remote-p default-directory) + updir) + (expand-file-name updir))) + (and-let* + ((default-directory updir) + (top (and (string-equal + (magit-rev-parse-safe "--show-cdup") "") + (magit-rev-parse-safe "--show-toplevel")))) + (string-equal (magit-expand-git-file-name top) topdir)))) + updir) + ((concat (file-remote-p default-directory) + (file-name-as-directory topdir))))) + (and-let* ((gitdir (magit-rev-parse-safe "--git-dir")) + (gitdir (file-name-as-directory + (if (file-name-absolute-p gitdir) + ;; We might have followed a symlink. + (concat (file-remote-p default-directory) + (magit-expand-git-file-name gitdir)) + (expand-file-name gitdir))))) + (if (magit-bare-repo-p) + gitdir + (let* ((link (expand-file-name "gitdir" gitdir)) + (wtree (and (file-exists-p link) + (magit-file-line link)))) + (cond + ((and wtree + ;; Ignore .git/gitdir files that result from a + ;; Git bug. See #2364. + (not (equal wtree ".git"))) + ;; Return the linked working tree. + (concat (file-remote-p default-directory) + (file-name-directory wtree))) + ;; The working directory may not be the parent + ;; directory of .git if it was set up with + ;; "git init --separate-git-dir". See #2955. + ((car (rassoc gitdir magit--separated-gitdirs))) + (;; Step outside the control directory to enter the + ;; working tree. + (file-name-directory (directory-file-name gitdir)))))))))))) + +(defun magit--toplevel-safe () + (or (magit-toplevel) + (magit--not-inside-repository-error))) + +(defmacro magit-with-toplevel (&rest body) + (declare (indent defun) (debug (body))) + `(let ((default-directory (magit--toplevel-safe))) + ,@body)) + +(define-error 'magit-outside-git-repo "Not inside Git repository") +(define-error 'magit-corrupt-git-config "Corrupt Git configuration") +(define-error 'magit-git-executable-not-found + "Git executable cannot be found (see https://magit.vc/goto/e6a78ed2)") + +(defun magit--assert-usable-git () + (if (not (compat-call executable-find (magit-git-executable) t)) + (signal 'magit-git-executable-not-found (magit-git-executable)) + (let ((magit-git-debug + (lambda (err) + (signal 'magit-corrupt-git-config + (format "%s: %s" default-directory err))))) + ;; This should always succeed unless there's a corrupt config + ;; (or at least a similarly severe failing state). Note that + ;; git-config's --default is avoided because it's not available + ;; until Git 2.18. + (magit-git-string "config" "--get-color" "" "reset")) + nil)) + +(defun magit--not-inside-repository-error () + (magit--assert-usable-git) + (signal 'magit-outside-git-repo default-directory)) + +(defun magit-inside-gitdir-p (&optional noerror) + "Return t if `default-directory' is below the repository directory. +If it is below the working directory, then return nil. +If it isn't below either, then signal an error unless NOERROR +is non-nil, in which case return nil." + (and (magit--assert-default-directory noerror) + ;; Below a repository directory that is not located below the + ;; working directory "git rev-parse --is-inside-git-dir" prints + ;; "false", which is wrong. + (let ((gitdir (magit-gitdir))) + (cond (gitdir (file-in-directory-p default-directory gitdir)) + (noerror nil) + ((signal 'magit-outside-git-repo default-directory)))))) + +(defun magit-inside-worktree-p (&optional noerror) + "Return t if `default-directory' is below the working directory. +If it is below the repository directory, then return nil. +If it isn't below either, then signal an error unless NOERROR +is non-nil, in which case return nil." + (and (magit--assert-default-directory noerror) + (condition-case nil + (magit-rev-parse-true "--is-inside-work-tree") + (magit-invalid-git-boolean + (and (not noerror) + (signal 'magit-outside-git-repo default-directory)))))) + +(cl-defgeneric magit-bare-repo-p (&optional noerror) + "Return t if the current repository is bare. +If it is non-bare, then return nil. If `default-directory' +isn't below a Git repository, then signal an error unless +NOERROR is non-nil, in which case return nil." + (and (magit--assert-default-directory noerror) + (condition-case nil + (magit-rev-parse-true "--is-bare-repository") + (magit-invalid-git-boolean + (and (not noerror) + (signal 'magit-outside-git-repo default-directory)))))) + +(defun magit--assert-default-directory (&optional noerror) + (or (file-directory-p default-directory) + (and (not noerror) + (let ((exists (file-exists-p default-directory))) + (signal (if exists 'file-error 'file-missing) + (list "Running git in directory" + (if exists + "Not a directory" + "No such file or directory") + default-directory)))))) + +(defun magit-git-repo-p (directory &optional non-bare) + "Return t if DIRECTORY is a Git repository. +When optional NON-BARE is non-nil also return nil if DIRECTORY is +a bare repository." + (and (file-directory-p directory) ; Avoid archives, see #3397. + (or (file-regular-p (expand-file-name ".git" directory)) + (file-directory-p (expand-file-name ".git" directory)) + (and (not non-bare) + (file-regular-p (expand-file-name "HEAD" directory)) + (file-directory-p (expand-file-name "refs" directory)) + (file-directory-p (expand-file-name "objects" directory)))))) + +(defun magit-file-relative-name (&optional file tracked) + "Return the path of FILE relative to the repository root. + +If optional FILE is nil or omitted, return the relative path of +the file being visited in the current buffer, if any, else nil. +If the file is not inside a Git repository, then return nil. + +If TRACKED is non-nil, return the path only if it matches a +tracked file." + (unless file + (with-current-buffer (or (buffer-base-buffer) + (current-buffer)) + (setq file (or magit-buffer-file-name buffer-file-name + (and (derived-mode-p 'dired-mode) default-directory))))) + (when (and file (or (not tracked) + (magit-file-tracked-p (file-relative-name file)))) + (and-let* ((dir (magit-toplevel + (magit--safe-default-directory + (directory-file-name (file-name-directory file)))))) + (file-relative-name file dir)))) + +(defun magit-file-ignored-p (file) + (magit-git-string-p "ls-files" "--others" "--ignored" "--exclude-standard" + "--" (magit-convert-filename-for-git file))) + +(defun magit-file-tracked-p (file) + (magit-git-success "ls-files" "--error-unmatch" + "--" (magit-convert-filename-for-git file))) + +(defun magit-list-files (&rest args) + (apply #'magit-git-items "ls-files" "-z" "--full-name" args)) + +(defun magit-tracked-files () + (magit-list-files "--cached")) + +(defun magit-untracked-files (&optional all files compact) + (if compact + (--mapcat (and (eq (aref it 0) ??) + (list (substring it 3))) + (magit-git-items "status" "-z" "--porcelain" + (magit-ignore-submodules-p t) + "--" files)) + (magit-list-files "--other" + (and (not all) "--exclude-standard") + "--" files))) + +(defun magit-modified-files (&optional nomodules files) + (magit-git-items "diff-index" "-z" "--name-only" + (and nomodules "--ignore-submodules") + (magit-headish) "--" files)) + +(defun magit-unstaged-files (&optional nomodules files) + (magit-git-items "diff-files" "-z" "--name-only" "--diff-filter=u" + (and nomodules "--ignore-submodules") + "--" files)) + +(defun magit-staged-files (&optional nomodules files) + (magit-git-items "diff-index" "-z" "--name-only" "--cached" + (and nomodules "--ignore-submodules") + (magit-headish) "--" files)) + +(defun magit-binary-files (&rest args) + (--mapcat (and (string-match "^-\t-\t\\(.+\\)" it) + (list (match-string 1 it))) + (apply #'magit-git-items + "diff" "-z" "--numstat" "--ignore-submodules" + args))) + +(defun magit-unmerged-files () + (magit-git-items "diff-files" "-z" "--name-only" "--diff-filter=U")) + +(defun magit-ignored-files () + (magit-git-items "ls-files" "-z" "--others" "--ignored" + "--exclude-standard" "--directory")) + +(defun magit-stashed-files (stash) + (magit-git-items "stash" "show" "-z" "--name-only" stash)) + +(defun magit-skip-worktree-files () + (--keep (and (= (aref it 0) ?S) + (substring it 2)) + (magit-list-files "-t"))) + +(defun magit-assume-unchanged-files () + (--keep (and (memq (aref it 0) '(?h ?s ?m ?r ?c ?k)) + (substring it 2)) + (magit-list-files "-v"))) + +(defun magit-revision-files (rev) + (magit-with-toplevel + (magit-git-items "ls-tree" "-z" "-r" "--name-only" rev))) + +(defun magit-revision-directories (rev) + "List directories that contain a tracked file in revision REV." + (magit-with-toplevel + (mapcar #'file-name-as-directory + (magit-git-items "ls-tree" "-z" "-r" "-d" "--name-only" rev)))) + +(defun magit-changed-files (rev-or-range &optional other-rev) + "Return list of files the have changed between two revisions. +If OTHER-REV is non-nil, REV-OR-RANGE should be a revision, not a +range. Otherwise, it can be any revision or range accepted by +\"git diff\" (i.e., <rev>, <revA>..<revB>, or <revA>...<revB>)." + (magit-with-toplevel + (magit-git-items "diff" "-z" "--name-only" rev-or-range other-rev))) + +(defun magit-renamed-files (revA revB) + (mapcar (pcase-lambda (`(,_status ,fileA ,fileB)) + (cons fileA fileB)) + (seq-partition (magit-git-items "diff" "-z" "--name-status" + "--find-renames" + "--diff-filter=R" revA revB) + 3))) + +(defun magit--rev-file-name (file rev other-rev) + "For FILE, potentially renamed between REV and OTHER-REV, return name in REV. +Return nil, if FILE appears neither in REV nor OTHER-REV, +or if no rename is detected." + (or (car (member file (magit-revision-files rev))) + (and-let* ((renamed (magit-renamed-files rev other-rev))) + (car (rassoc file renamed))))) + +(defun magit-file-status (&rest args) + (magit--with-temp-process-buffer + (save-excursion (magit-git-insert "status" "-z" args)) + (let ((pos (point)) status) + (while (> (skip-chars-forward "[:print:]") 0) + (let ((x (char-after pos)) + (y (char-after (1+ pos))) + (file (buffer-substring (+ pos 3) (point)))) + (forward-char) + (if (memq x '(?R ?C)) + (progn + (setq pos (point)) + (skip-chars-forward "[:print:]") + (push (list file (buffer-substring pos (point)) x y) status) + (forward-char)) + (push (list file nil x y) status))) + (setq pos (point))) + status))) + +(defcustom magit-cygwin-mount-points + (and (eq system-type 'windows-nt) + (cl-sort (--map (if (string-match "^\\(.*\\) on \\(.*\\) type" it) + (cons (file-name-as-directory (match-string 2 it)) + (file-name-as-directory (match-string 1 it))) + (lwarn '(magit) :error + "Failed to parse Cygwin mount: %S" it)) + ;; If --exec-path is not a native Windows path, + ;; then we probably have a cygwin git. + (let ((process-environment + (append magit-git-environment + process-environment))) + (and (not (string-match-p + "\\`[a-zA-Z]:" + (car (process-lines + magit-git-executable "--exec-path")))) + (ignore-errors (process-lines "mount"))))) + #'> :key (pcase-lambda (`(,cyg . ,_win)) (length cyg)))) + "Alist of (CYGWIN . WIN32) directory names. +Sorted from longest to shortest CYGWIN name." + :package-version '(magit . "2.3.0") + :group 'magit-process + :type '(alist :key-type string :value-type directory)) + +(defun magit-expand-git-file-name (filename) + (unless (file-name-absolute-p filename) + (setq filename (expand-file-name filename))) + (if-let ((cyg:win (and (not (file-remote-p default-directory)) ; see #4976 + (cl-assoc filename magit-cygwin-mount-points + :test (lambda (f cyg) (string-prefix-p cyg f)))))) + (concat (cdr cyg:win) + (substring filename (length (car cyg:win)))) + filename)) + +(defun magit-convert-filename-for-git (filename) + "Convert FILENAME so that it can be passed to git. +1. If it is a absolute filename, then pass it through + `expand-file-name' to replace things such as \"~/\" that + Git does not understand. +2. If it is a remote filename, then remove the remote part. +3. Deal with an `windows-nt' Emacs vs. Cygwin Git incompatibility." + (if (file-name-absolute-p filename) + (if-let ((cyg:win (cl-rassoc filename magit-cygwin-mount-points + :test (lambda (f win) (string-prefix-p win f))))) + (concat (car cyg:win) + (substring filename (length (cdr cyg:win)))) + (let ((expanded (expand-file-name filename))) + (or (file-remote-p expanded 'localname) + expanded))) + filename)) + +(defun magit-decode-git-path (path) + (if (eq (aref path 0) ?\") + (decode-coding-string (read path) + (or magit-git-output-coding-system + (car default-process-coding-system)) + t) + path)) + +(defun magit-file-at-point (&optional expand assert) + (if-let ((file (magit-section-case + (file (oref it value)) + (hunk (magit-section-parent-value it))))) + (if expand + (expand-file-name file (magit-toplevel)) + file) + (when assert + (user-error "No file at point")))) + +(defun magit-current-file () + (or (magit-file-relative-name) + (magit-file-at-point) + (and (derived-mode-p 'magit-log-mode) + (car magit-buffer-log-files)))) + +;;; Predicates + +(defun magit-no-commit-p () + "Return t if there is no commit in the current Git repository." + (not (magit-rev-verify "HEAD"))) + +(defun magit-merge-commit-p (commit) + "Return t if COMMIT is a merge commit." + (length> (magit-commit-parents commit) 1)) + +(defun magit-anything-staged-p (&optional ignore-submodules &rest files) + "Return t if there are any staged changes. +If optional FILES is non-nil, then only changes to those files +are considered." + (magit-git-failure "diff" "--quiet" "--cached" + (and ignore-submodules "--ignore-submodules") + "--" files)) + +(defun magit-anything-unstaged-p (&optional ignore-submodules &rest files) + "Return t if there are any unstaged changes. +If optional FILES is non-nil, then only changes to those files +are considered." + (magit-git-failure "diff" "--quiet" + (and ignore-submodules "--ignore-submodules") + "--" files)) + +(defun magit-anything-modified-p (&optional ignore-submodules &rest files) + "Return t if there are any staged or unstaged changes. +If optional FILES is non-nil, then only changes to those files +are considered." + (or (apply #'magit-anything-staged-p ignore-submodules files) + (apply #'magit-anything-unstaged-p ignore-submodules files))) + +(defun magit-anything-unmerged-p (&rest files) + "Return t if there are any merge conflicts. +If optional FILES is non-nil, then only conflicts in those files +are considered." + (and (magit-git-string "ls-files" "--unmerged" files) t)) + +(defun magit-module-worktree-p (module) + (magit-with-toplevel + (file-exists-p (expand-file-name ".git" module)))) + +(defun magit-module-no-worktree-p (module) + (not (magit-module-worktree-p module))) + +(defun magit-ignore-submodules-p (&optional return-argument) + (or (cl-find-if (lambda (arg) + (string-prefix-p "--ignore-submodules" arg)) + magit-buffer-diff-args) + (and-let* ((value (magit-get "diff.ignoreSubmodules"))) + (if return-argument + (concat "--ignore-submodules=" value) + (concat "diff.ignoreSubmodules=" value))))) + +;;; Revisions and References + +(defun magit-rev-parse (&rest args) + "Execute `git rev-parse ARGS', returning first line of output. +If there is no output, return nil." + (apply #'magit-git-string "rev-parse" args)) + +(defun magit-rev-parse-safe (&rest args) + "Execute `git rev-parse ARGS', returning first line of output. +If there is no output, return nil. Like `magit-rev-parse' but +ignore `magit-git-debug'." + (apply #'magit-git-str "rev-parse" args)) + +(defun magit-rev-parse-true (&rest args) + "Execute `git rev-parse ARGS', returning t if it prints \"true\". +If it prints \"false\", then return nil. For any other output +signal an error." + (magit-git-true "rev-parse" args)) + +(defun magit-rev-parse-false (&rest args) + "Execute `git rev-parse ARGS', returning t if it prints \"false\". +If it prints \"true\", then return nil. For any other output +signal an error." + (magit-git-false "rev-parse" args)) + +(defun magit-rev-parse-p (&rest args) + "Execute `git rev-parse ARGS', returning t if it prints \"true\". +Return t if the first (and usually only) output line is the +string \"true\", otherwise return nil." + (equal (magit-git-str "rev-parse" args) "true")) + +(defun magit-rev-verify (rev) + (magit-git-string-p "rev-parse" "--verify" rev)) + +(defun magit-commit-p (rev) + "Return full hash for REV if it names an existing commit." + (magit-rev-verify (magit--rev-dereference rev))) + +(defalias 'magit-rev-verify-commit #'magit-commit-p) + +(defalias 'magit-rev-hash #'magit-commit-p) + +(defun magit--rev-dereference (rev) + "Return a rev that forces Git to interpret REV as a commit. +If REV is nil or has the form \":/TEXT\", return REV itself." + (cond ((not rev) nil) + ((string-match-p "^:/" rev) rev) + ((concat rev "^{commit}")))) + +(defun magit-rev-equal (a b) + "Return t if there are no differences between the commits A and B." + (magit-git-success "diff" "--quiet" a b)) + +(defun magit-rev-eq (a b) + "Return t if A and B refer to the same commit." + (let ((a (magit-commit-p a)) + (b (magit-commit-p b))) + (and a b (equal a b)))) + +(defun magit-rev-ancestor-p (a b) + "Return non-nil if commit A is an ancestor of commit B." + (magit-git-success "merge-base" "--is-ancestor" a b)) + +(defun magit-rev-head-p (rev) + (or (equal rev "HEAD") + (and rev + (not (string-search ".." rev)) + (equal (magit-rev-parse rev) + (magit-rev-parse "HEAD"))))) + +(defun magit-rev-author-p (rev) + "Return t if the user is the author of REV. +More precisely return t if `user.name' is equal to the author +name of REV and/or `user.email' is equal to the author email +of REV." + (or (equal (magit-get "user.name") (magit-rev-format "%an" rev)) + (equal (magit-get "user.email") (magit-rev-format "%ae" rev)))) + +(defun magit-rev-name (rev &optional pattern not-anchored) + "Return a symbolic name for REV using `git-name-rev'. + +PATTERN can be used to limit the result to a matching ref. +Unless NOT-ANCHORED is non-nil, the beginning of the ref must +match PATTERN. + +An anchored lookup is done using the arguments +\"--exclude=*/<PATTERN> --exclude=*/HEAD\" in addition to +\"--refs=<PATTERN>\", provided at least version v2.13 of Git is +used. Older versions did not support the \"--exclude\" argument. +When \"--exclude\" cannot be used and `git-name-rev' returns a +ref that should have been excluded, then that is discarded and +this function returns nil instead. This is unfortunate because +there might be other refs that do match. To fix that, update +Git." + (if (magit-git-version< "2.13") + (and-let* + ((ref (magit-git-string "name-rev" "--name-only" "--no-undefined" + (and pattern (concat "--refs=" pattern)) + rev))) + (if (and pattern + (string-match-p "\\`refs/[^/]+/\\*\\'" pattern)) + (let ((namespace (substring pattern 0 -1))) + (and (not (or (string-suffix-p "HEAD" ref) + (and (string-match-p namespace ref) + (not (magit-rev-verify + (concat namespace ref)))))) + ref)) + ref)) + (magit-git-string "name-rev" "--name-only" "--no-undefined" + (and pattern (concat "--refs=" pattern)) + (and pattern + (not not-anchored) + (list "--exclude=*/HEAD" + (concat "--exclude=*/" pattern))) + rev))) + +(defun magit-rev-branch (rev) + (and-let* ((name (magit-rev-name rev "refs/heads/*"))) + (and (not (string-match-p "[~^]" name)) name))) + +(defun magit-rev-fixup-target (rev) + (let ((msg (magit-rev-format "%s" rev))) + (save-match-data + (and (string-match "\\`\\(fixup\\|squash\\)! \\(.+\\)" msg) + (magit-rev-format + "%h" (format "%s^{/^%s}" rev + (magit--ext-regexp-quote (match-string 2 msg)))))))) + +(defun magit-get-shortname (rev) + (let* ((fn (apply-partially #'magit-rev-name rev)) + (name (or (funcall fn "refs/tags/*") + (funcall fn "refs/heads/*") + (funcall fn "refs/remotes/*")))) + (cond ((not name) + (magit-rev-parse "--short" rev)) + ((string-match "^\\(?:tags\\|remotes\\)/\\(.+\\)" name) + (if (magit-ref-ambiguous-p (match-string 1 name)) + name + (match-string 1 name))) + ((magit-ref-maybe-qualify name))))) + +(defun magit-name-branch (rev &optional lax) + (or (magit-name-local-branch rev) + (magit-name-remote-branch rev) + (and lax (or (magit-name-local-branch rev t) + (magit-name-remote-branch rev t))))) + +(defun magit-name-local-branch (rev &optional lax) + (and-let* ((name (magit-rev-name rev "refs/heads/*"))) + (and (or lax (not (string-match-p "[~^]" name))) name))) + +(defun magit-name-remote-branch (rev &optional lax) + (and-let* ((name (magit-rev-name rev "refs/remotes/*"))) + (and (or lax (not (string-match-p "[~^]" name))) + (substring name 8)))) + +(defun magit-name-tag (rev &optional lax) + (and-let* ((name (magit-rev-name rev "refs/tags/*"))) + ;; The progn is necessary to work around debbugs#31840. This, and all + ;; the other instances, can be removed once we require at least Emacs 27. + (progn + (when (string-suffix-p "^0" name) + (setq name (substring name 0 -2))) + (and (or lax (not (string-match-p "[~^]" name))) + (substring name 5))))) + +(defun magit-ref-abbrev (refname) + "Return an unambiguous abbreviation of REFNAME." + (magit-rev-parse "--verify" "--abbrev-ref" refname)) + +(defun magit-ref-fullname (refname) + "Return fully qualified refname for REFNAME. +If REFNAME is ambiguous, return nil." + (magit-rev-parse "--verify" "--symbolic-full-name" refname)) + +(defun magit-ref-ambiguous-p (refname) + (save-match-data + (if (string-match "\\`\\([^^~]+\\)\\(.*\\)" refname) + (not (magit-ref-fullname (match-string 1 refname))) + (error "%S has an unrecognized format" refname)))) + +(defun magit-ref-maybe-qualify (refname &optional prefix) + "If REFNAME is ambiguous, try to disambiguate it by prepend PREFIX to it. +Return an unambiguous refname, either REFNAME or that prefixed +with PREFIX, nil otherwise. If REFNAME has an offset suffix +such as \"~1\", then that is preserved. If optional PREFIX is +nil, then use \"heads/\". " + (if (magit-ref-ambiguous-p refname) + (let ((refname (concat (or prefix "heads/") refname))) + (and (not (magit-ref-ambiguous-p refname)) refname)) + refname)) + +(defun magit-ref-exists-p (ref) + (magit-git-success "show-ref" "--verify" ref)) + +(defun magit-ref-equal (a b) + "Return t if the refnames A and B are `equal'. +A symbolic-ref pointing to some ref, is `equal' to that ref, +as are two symbolic-refs pointing to the same ref. Refnames +may be abbreviated." + (let ((a (magit-ref-fullname a)) + (b (magit-ref-fullname b))) + (and a b (equal a b)))) + +(defun magit-ref-eq (a b) + "Return t if the refnames A and B are `eq'. +A symbolic-ref is `eq' to itself, but not to the ref it points +to, or to some other symbolic-ref that points to the same ref." + (let ((symbolic-a (magit-symbolic-ref-p a)) + (symbolic-b (magit-symbolic-ref-p b))) + (or (and symbolic-a + symbolic-b + (equal a b)) + (and (not symbolic-a) + (not symbolic-b) + (magit-ref-equal a b))))) + +(defun magit-headish () + "Return the `HEAD' or if that doesn't exist the hash of the empty tree." + (if (magit-no-commit-p) + (magit-git-string "mktree") + "HEAD")) + +(defun magit-branch-at-point () + (magit-section-case + (branch (oref it value)) + (commit (or (magit--painted-branch-at-point) + (magit-name-branch (oref it value)))))) + +(defun magit--painted-branch-at-point (&optional type) + (or (and (not (eq type 'remote)) + (memq (get-text-property (magit-point) 'font-lock-face) + (list 'magit-branch-local + 'magit-branch-current)) + (and-let* ((branch (magit-thing-at-point 'git-revision t))) + (cdr (magit-split-branch-name branch)))) + (and (not (eq type 'local)) + (memq (get-text-property (magit-point) 'font-lock-face) + (list 'magit-branch-remote + 'magit-branch-remote-head)) + (thing-at-point 'git-revision t)))) + +(defun magit-local-branch-at-point () + (magit-section-case + (branch (let ((branch (magit-ref-maybe-qualify (oref it value)))) + (when (member branch (magit-list-local-branch-names)) + branch))) + (commit (or (magit--painted-branch-at-point 'local) + (magit-name-local-branch (oref it value)))))) + +(defun magit-remote-branch-at-point () + (magit-section-case + (branch (let ((branch (oref it value))) + (when (member branch (magit-list-remote-branch-names)) + branch))) + (commit (or (magit--painted-branch-at-point 'remote) + (magit-name-remote-branch (oref it value)))))) + +(defun magit-commit-at-point () + (or (magit-section-value-if 'commit) + (magit-thing-at-point 'git-revision t) + (and-let* ((chunk (and (bound-and-true-p magit-blame-mode) + (fboundp 'magit-current-blame-chunk) + (magit-current-blame-chunk)))) + (oref chunk orig-rev)) + (and (derived-mode-p 'magit-stash-mode + 'magit-merge-preview-mode + 'magit-revision-mode) + magit-buffer-revision))) + +(defun magit-branch-or-commit-at-point () + (or (magit-section-case + (branch (magit-ref-maybe-qualify (oref it value))) + (commit (or (magit--painted-branch-at-point) + (let ((rev (oref it value))) + (or (magit-name-branch rev) rev)))) + (tag (magit-ref-maybe-qualify (oref it value) "tags/")) + (pullreq (or (and (fboundp 'forge--pullreq-branch) + (magit-branch-p + (forge--pullreq-branch (oref it value)))) + (magit-ref-p (format "refs/pullreqs/%s" + (oref (oref it value) number))))) + ((unpulled unpushed) + (magit-ref-abbrev + (replace-regexp-in-string "\\.\\.\\.?" "" (oref it value))))) + (magit-thing-at-point 'git-revision t) + (and-let* ((chunk (and (bound-and-true-p magit-blame-mode) + (fboundp 'magit-current-blame-chunk) + (magit-current-blame-chunk)))) + (oref chunk orig-rev)) + (and magit-buffer-file-name + magit-buffer-refname) + (and (derived-mode-p 'magit-stash-mode + 'magit-merge-preview-mode + 'magit-revision-mode) + magit-buffer-revision))) + +(defun magit-tag-at-point () + (magit-section-case + (tag (oref it value)) + (commit (magit-name-tag (oref it value))))) + +(defun magit-stash-at-point () + (magit-section-value-if 'stash)) + +(defun magit-remote-at-point () + (magit-section-case + (remote (oref it value)) + ([branch remote] (magit-section-parent-value it)))) + +(defun magit-module-at-point (&optional predicate) + (when (magit-section-match 'module) + (let ((module (oref (magit-current-section) value))) + (and (or (not predicate) + (funcall predicate module)) + module)))) + +(defun magit-get-current-branch () + "Return the refname of the currently checked out branch. +Return nil if no branch is currently checked out." + (magit-git-string "symbolic-ref" "--short" "HEAD")) + +(defvar magit-get-previous-branch-timeout 0.5 + "Maximum time to spend in `magit-get-previous-branch'. +Given as a number of seconds.") + +(defun magit-get-previous-branch () + "Return the refname of the previously checked out branch. +Return nil if no branch can be found in the `HEAD' reflog +which is different from the current branch and still exists. +The amount of time spent searching is limited by +`magit-get-previous-branch-timeout'." + (let ((t0 (float-time)) + (current (magit-get-current-branch)) + (i 1) prev) + (while (if (> (- (float-time) t0) magit-get-previous-branch-timeout) + (setq prev nil) ;; Timed out. + (and (setq prev (magit-rev-verify (format "@{-%d}" i))) + (or (not (setq prev (magit-rev-branch prev))) + (equal prev current)))) + (cl-incf i)) + prev)) + +(defun magit--set-default-branch (newname oldname) + (let ((remote (or (magit-primary-remote) + (user-error "Cannot determine primary remote"))) + (branches (mapcar (lambda (line) (split-string line "\t")) + (magit-git-lines + "for-each-ref" "refs/heads" + "--format=%(refname:short)\t%(upstream:short)")))) + (when-let ((old (assoc oldname branches))) + (unless (assoc newname branches) + (magit-call-git "branch" "-m" oldname newname) + (setcar old newname))) + (let ((new (if (magit-branch-p newname) + newname + (concat remote "/" newname)))) + (pcase-dolist (`(,branch ,upstream) branches) + (cond + ((equal upstream oldname) + (magit-set-upstream-branch branch new)) + ((equal upstream (concat remote "/" oldname)) + (magit-set-upstream-branch branch (concat remote "/" newname)))))))) + +(defun magit--get-default-branch (&optional update) + (let ((remote (magit-primary-remote))) + (when update + (if (not remote) + (user-error "Cannot determine primary remote") + (message "Determining default branch...") + (magit-git "fetch" "--prune") + (magit-git "remote" "set-head" "--auto" remote) + (message "Determining default branch...done"))) + (let ((branch (magit-git-string "symbolic-ref" "--short" + (format "refs/remotes/%s/HEAD" remote)))) + (when (and update (not branch)) + (error "Cannot determine new default branch")) + (list remote (and branch (cdr (magit-split-branch-name branch))))))) + +(defun magit-set-upstream-branch (branch upstream) + "Set UPSTREAM as the upstream of BRANCH. +If UPSTREAM is nil, then unset BRANCH's upstream. +Otherwise UPSTREAM has to be an existing branch." + (if upstream + (magit-call-git "branch" "--set-upstream-to" upstream branch) + (magit-call-git "branch" "--unset-upstream" branch))) + +(defun magit-get-upstream-ref (&optional branch) + "Return the upstream branch of BRANCH as a fully qualified ref. +It BRANCH is nil, then return the upstream of the current branch, +if any, nil otherwise. If the upstream is not configured, the +configured remote is an url, or the named branch does not exist, +then return nil. I.e., return an existing local or +remote-tracking branch ref." + (and-let* ((branch (or branch (magit-get-current-branch)))) + (magit-ref-fullname (concat branch "@{upstream}")))) + +(defun magit-get-upstream-branch (&optional branch) + "Return the name of the upstream branch of BRANCH. +It BRANCH is nil, then return the upstream of the current branch +if any, nil otherwise. If the upstream is not configured, the +configured remote is an url, or the named branch does not exist, +then return nil. I.e., return the name of an existing local or +remote-tracking branch. The returned string is colorized +according to the branch type." + (magit--with-refresh-cache + (list default-directory 'magit-get-upstream-branch branch) + (and-let* ((branch (or branch (magit-get-current-branch))) + (upstream (magit-ref-abbrev (concat branch "@{upstream}")))) + (magit--propertize-face + upstream (if (equal (magit-get "branch" branch "remote") ".") + 'magit-branch-local + 'magit-branch-remote))))) + +(defun magit-get-indirect-upstream-branch (branch &optional force) + (let ((remote (magit-get "branch" branch "remote"))) + (and remote (not (equal remote ".")) + ;; The user has opted in... + (or force + (--some (if (magit-git-success "check-ref-format" "--branch" it) + (equal it branch) + (string-match-p it branch)) + magit-branch-prefer-remote-upstream)) + ;; and local BRANCH tracks a remote branch... + (let ((upstream (magit-get-upstream-branch branch))) + ;; whose upstream... + (and upstream + ;; has the same name as BRANCH... + (equal (substring upstream (1+ (length remote))) branch) + ;; and can be fast-forwarded to BRANCH. + (magit-rev-ancestor-p upstream branch) + upstream))))) + +(defun magit-get-upstream-remote (&optional branch allow-unnamed) + (and-let* ((branch (or branch (magit-get-current-branch))) + (remote (magit-get "branch" branch "remote"))) + (and (not (equal remote ".")) + (cond ((member remote (magit-list-remotes)) + (magit--propertize-face remote 'magit-branch-remote)) + ((and allow-unnamed + (string-match-p "\\(\\`.\\{0,2\\}/\\|[:@]\\)" remote)) + (magit--propertize-face remote 'bold)))))) + +(defun magit-get-unnamed-upstream (&optional branch) + (and-let* ((branch (or branch (magit-get-current-branch))) + (remote (magit-get "branch" branch "remote")) + (merge (magit-get "branch" branch "merge"))) + (and (magit--unnamed-upstream-p remote merge) + (list (magit--propertize-face remote 'bold) + (magit--propertize-face merge 'magit-branch-remote))))) + +(defun magit--unnamed-upstream-p (remote merge) + (and remote (string-match-p "\\(\\`\\.\\{0,2\\}/\\|[:@]\\)" remote) + merge (string-prefix-p "refs/" merge))) + +(defun magit--valid-upstream-p (remote merge) + (and (or (equal remote ".") + (member remote (magit-list-remotes))) + (string-prefix-p "refs/" merge))) + +(defun magit-get-current-remote (&optional allow-unnamed) + (or (magit-get-upstream-remote nil allow-unnamed) + (and-let* ((remotes (magit-list-remotes)) + (remote (if (length= remotes 1) + (car remotes) + (magit-primary-remote)))) + (magit--propertize-face remote 'magit-branch-remote)))) + +(defun magit-get-push-remote (&optional branch) + (and-let* ((remote + (or (and (or branch (setq branch (magit-get-current-branch))) + (magit-get "branch" branch "pushRemote")) + (magit-get "remote.pushDefault")))) + (magit--propertize-face remote 'magit-branch-remote))) + +(defun magit-get-push-branch (&optional branch verify) + (magit--with-refresh-cache + (list default-directory 'magit-get-push-branch branch verify) + (and-let* ((branch (or branch (setq branch (magit-get-current-branch)))) + (remote (magit-get-push-remote branch)) + (target (concat remote "/" branch))) + (and (or (not verify) + (magit-rev-verify target)) + (magit--propertize-face target 'magit-branch-remote))))) + +(defun magit-get-@{push}-branch (&optional branch) + (let ((ref (magit-rev-parse "--symbolic-full-name" + (concat branch "@{push}")))) + (and ref + (string-prefix-p "refs/remotes/" ref) + (substring ref 13)))) + +(defun magit-get-remote (&optional branch) + (and (or branch (setq branch (magit-get-current-branch))) + (let ((remote (magit-get "branch" branch "remote"))) + (and (not (equal remote ".")) + remote)))) + +(defun magit-get-some-remote (&optional branch) + (or (magit-get-remote branch) + (and-let* ((main (magit-main-branch))) + (magit-get-remote main)) + (magit-primary-remote) + (car (magit-list-remotes)))) + +(defvar magit-primary-remote-names + '("upstream" "origin")) + +(defun magit-primary-remote () + "Return the primary remote. + +The primary remote is the remote that tracks the repository that +other repositories are forked from. It often is called \"origin\" +but because many people name their own fork \"origin\", using that +term would be ambiguous. Likewise we avoid the term \"upstream\" +because a branch's @{upstream} branch may be a local branch or a +branch from a remote other than the primary remote. + +If a remote exists whose name matches `magit.primaryRemote', then +that is considered the primary remote. If no remote by that name +exists, then remotes in `magit-primary-remote-names' are tried in +order and the first remote from that list that actually exists in +the current repository is considered its primary remote." + (let ((remotes (magit-list-remotes))) + (seq-find (lambda (name) + (member name remotes)) + (delete-dups + (delq nil + (cons (magit-get "magit.primaryRemote") + magit-primary-remote-names)))))) + +(defun magit-branch-merged-p (branch &optional target) + "Return non-nil if BRANCH is merged into its upstream and TARGET. + +TARGET defaults to the current branch. If `HEAD' is detached and +TARGET is nil, then always return nil. As a special case, if +TARGET is t, then return non-nil if BRANCH is merged into any one +of the other local branches. + +If, and only if, BRANCH has an upstream, then only return non-nil +if BRANCH is merged into both TARGET (as described above) as well +as into its upstream." + (and (if-let ((upstream (and (magit-branch-p branch) + (magit-get-upstream-branch branch)))) + (magit-rev-ancestor-p branch upstream) + t) + (if (eq target t) + (delete (magit-name-local-branch branch) + (magit-list-containing-branches branch)) + (and-let* ((target (or target (magit-get-current-branch)))) + (magit-rev-ancestor-p branch target))))) + +(defun magit-get-tracked (refname) + "Return the remote branch tracked by the remote-tracking branch REFNAME. +The returned value has the form (REMOTE . REF), where REMOTE is +the name of a remote and REF is the ref local to the remote." + (and-let* ((ref (magit-ref-fullname refname))) + (save-match-data + (seq-some (lambda (line) + (and (string-match "\ +\\`remote\\.\\([^.]+\\)\\.fetch=\\+?\\([^:]+\\):\\(.+\\)" line) + (let ((rmt (match-string 1 line)) + (src (match-string 2 line)) + (dst (match-string 3 line))) + (and (string-match (format "\\`%s\\'" + (string-replace + "*" "\\(.+\\)" dst)) + ref) + (cons rmt (string-replace + "*" (match-string 1 ref) src)))))) + (magit-git-lines "config" "--local" "--list"))))) + +(defun magit-split-branch-name (branch) + (cond ((member branch (magit-list-local-branch-names)) + (cons "." branch)) + ((string-match "/" branch) + (or (seq-some (lambda (remote) + (and (string-match + (format "\\`\\(%s\\)/\\(.+\\)\\'" remote) + branch) + (cons (match-string 1 branch) + (match-string 2 branch)))) + (magit-list-remotes)) + (error "Invalid branch name %s" branch))))) + +(defun magit-get-current-tag (&optional rev with-distance) + "Return the closest tag reachable from REV. + +If optional REV is nil, then default to `HEAD'. +If optional WITH-DISTANCE is non-nil then return (TAG COMMITS), +if it is `dirty' return (TAG COMMIT DIRTY). COMMITS is the number +of commits in `HEAD' but not in TAG and DIRTY is t if there are +uncommitted changes, nil otherwise." + (and-let* ((str (magit-git-str "describe" "--long" "--tags" + (and (eq with-distance 'dirty) "--dirty") + rev))) + (save-match-data + (string-match + "\\(.+\\)-\\(?:0[0-9]*\\|\\([0-9]+\\)\\)-g[0-9a-z]+\\(-dirty\\)?$" str) + (if with-distance + `(,(match-string 1 str) + ,(string-to-number (or (match-string 2 str) "0")) + ,@(and (match-string 3 str) (list t))) + (match-string 1 str))))) + +(defun magit-get-next-tag (&optional rev with-distance) + "Return the closest tag from which REV is reachable. + +If optional REV is nil, then default to `HEAD'. +If no such tag can be found or if the distance is 0 (in which +case it is the current tag, not the next), return nil instead. +If optional WITH-DISTANCE is non-nil, then return (TAG COMMITS) +where COMMITS is the number of commits in TAG but not in REV." + (and-let* ((str (magit-git-str "describe" "--contains" (or rev "HEAD")))) + (save-match-data + (when (string-match "^[^^~]+" str) + (setq str (match-string 0 str)) + (unless (equal str (magit-get-current-tag rev)) + (if with-distance + (list str (car (magit-rev-diff-count str rev))) + str)))))) + +(defun magit-list-refs (&optional namespaces format sortby) + "Return list of references, excluding symbolic references. + +When NAMESPACES is non-nil, list refs from these namespaces +rather than those from `magit-list-refs-namespaces'. + +FORMAT is passed to the `--format' flag of `git for-each-ref' +and defaults to \"%(refname)\". + +SORTBY is a key or list of keys to pass to the `--sort' flag of +`git for-each-ref'. When nil, use `magit-list-refs-sortby'" + (unless format + (setq format "%(refname)")) + (seq-keep (lambda (line) + (pcase-let* ((`(,symrefp ,value) + (split-string line " ")) + (symrefp (not (equal symrefp "")))) + (and (not symrefp) value))) + (magit-git-lines "for-each-ref" + (concat "--format=%(symref) " format) + (--map (concat "--sort=" it) + (pcase (or sortby magit-list-refs-sortby) + ((and val (pred stringp)) (list val)) + ((and val (pred listp)) val))) + (or namespaces magit-list-refs-namespaces)))) + +(defun magit-list-branches () + (magit-list-refs (list "refs/heads" "refs/remotes"))) + +(defun magit-list-local-branches () + (magit-list-refs "refs/heads")) + +(defun magit-list-remote-branches (&optional remote) + (magit-list-refs (concat "refs/remotes/" remote))) + +(defun magit-list-related-branches (relation &optional commit &rest args) + (--remove (string-match-p "\\(\\`(HEAD\\|HEAD -> \\)" it) + (--map (substring it 2) + (magit-git-lines "branch" args relation commit)))) + +(defun magit-list-containing-branches (&optional commit &rest args) + (magit-list-related-branches "--contains" commit args)) + +(defun magit-list-publishing-branches (&optional commit) + (--filter (magit-rev-ancestor-p (or commit "HEAD") it) + magit-published-branches)) + +(defun magit-list-merged-branches (&optional commit &rest args) + (magit-list-related-branches "--merged" commit args)) + +(defun magit-list-unmerged-branches (&optional commit &rest args) + (magit-list-related-branches "--no-merged" commit args)) + +(defun magit-list-unmerged-to-upstream-branches () + (--filter (and-let* ((upstream (magit-get-upstream-branch it))) + (member it (magit-list-unmerged-branches upstream))) + (magit-list-local-branch-names))) + +(defun magit-list-branches-pointing-at (commit) + (let ((re (format "\\`%s refs/\\(heads\\|remotes\\)/\\(.*\\)\\'" + (magit-rev-verify commit)))) + (--keep (and (string-match re it) + (let ((name (match-string 2 it))) + (and (not (string-suffix-p "HEAD" name)) + name))) + (magit-git-lines "show-ref")))) + +(defun magit-list-refnames (&optional namespaces include-special) + (nconc (magit-list-refs namespaces "%(refname:short)") + (and include-special + (magit-list-special-refnames)))) + +(defvar magit-special-refnames + '("HEAD" "ORIG_HEAD" "FETCH_HEAD" "MERGE_HEAD" "CHERRY_PICK_HEAD")) + +(defun magit-list-special-refnames () + (let ((gitdir (magit-gitdir))) + (cl-mapcan (lambda (name) + (and (file-exists-p (expand-file-name name gitdir)) + (list name))) + magit-special-refnames))) + +(defun magit-list-branch-names () + (magit-list-refnames (list "refs/heads" "refs/remotes"))) + +(defun magit-list-local-branch-names () + (magit-list-refnames "refs/heads")) + +(defun magit-list-remote-branch-names (&optional remote relative) + (if (and remote relative) + (let ((regexp (format "^refs/remotes/%s/\\(.+\\)" remote))) + (--mapcat (when (string-match regexp it) + (list (match-string 1 it))) + (magit-list-remote-branches remote))) + (magit-list-refnames (concat "refs/remotes/" remote)))) + +(defun magit-format-refs (format &rest args) + (let ((lines (magit-git-lines + "for-each-ref" (concat "--format=" format) + (or args (list "refs/heads" "refs/remotes" "refs/tags"))))) + (if (string-search "\f" format) + (--map (split-string it "\f") lines) + lines))) + +(defun magit-list-remotes () + (magit-git-lines "remote")) + +(defun magit-list-tags () + (magit-git-lines "tag")) + +(defun magit-list-stashes (&optional format) + (magit-git-lines "stash" "list" (concat "--format=" (or format "%gd")))) + +(defun magit-list-active-notes-refs () + "Return notes refs according to `core.notesRef' and `notes.displayRef'." + (magit-git-lines "for-each-ref" "--format=%(refname)" + (or (magit-get "core.notesRef") "refs/notes/commits") + (magit-get-all "notes.displayRef"))) + +(defun magit-list-notes-refnames () + (--map (substring it 6) (magit-list-refnames "refs/notes"))) + +(defun magit-remote-list-tags (remote) + (--keep (and (not (string-suffix-p "^{}" it)) + (substring it 51)) + (magit-git-lines "ls-remote" "--tags" remote))) + +(defun magit-remote-list-branches (remote) + (--keep (and (not (string-suffix-p "^{}" it)) + (substring it 52)) + (magit-git-lines "ls-remote" "--heads" remote))) + +(defun magit-remote-list-refs (remote) + (--keep (and (not (string-suffix-p "^{}" it)) + (substring it 41)) + (magit-git-lines "ls-remote" remote))) + +(defun magit-remote-head (remote) + (and-let* ((line (cl-find-if + (lambda (line) + (string-match + "\\`ref: refs/heads/\\([^\s\t]+\\)[\s\t]HEAD\\'" line)) + (magit-git-lines "ls-remote" "--symref" remote "HEAD")))) + (match-string 1 line))) + +(defun magit-list-modified-modules () + (--keep (and (string-match "\\`\\+\\([^ ]+\\) \\(.+\\) (.+)\\'" it) + (match-string 2 it)) + (magit-git-lines "submodule" "status"))) + +(defun magit-list-module-paths () + (magit-with-toplevel + (--mapcat (and (string-match "^160000 [0-9a-z]\\{40,\\} 0\t\\(.+\\)$" it) + (list (match-string 1 it))) + (magit-git-items "ls-files" "-z" "--stage")))) + +(defun magit-list-module-names () + (mapcar #'magit-get-submodule-name (magit-list-module-paths))) + +(defun magit-get-submodule-name (path) + "Return the name of the submodule at PATH. +PATH has to be relative to the super-repository." + (if (magit-git-version>= "2.38.0") + ;; "git submodule--helper name" was removed, + ;; but might still come back in another form. + (substring + (car (split-string + (car (or (magit-git-items + "config" "-z" + "-f" (expand-file-name ".gitmodules" (magit-toplevel)) + "--get-regexp" "^submodule\\..*\\.path$" + (concat "^" (regexp-quote (directory-file-name path)) "$")) + (error "No such submodule `%s'" path))) + "\n")) + 10 -5) + (magit-git-string "submodule--helper" "name" path))) + +(defun magit-list-worktrees () + "Return list of the worktrees of this repository. + +The returned list has the form (PATH COMMIT BRANCH BARE DETACHED +LOCKED PRUNABLE). The last four elements are booleans, with the +exception of LOCKED and PRUNABLE, which may also be strings. +See git-worktree(1) manpage for the meaning of the various parts. + +This function corrects a situation where \"git worktree list\" +would claim a worktree is bare, even though the working tree is +specified using `core.worktree'." + (let ((remote (file-remote-p default-directory)) + worktrees worktree) + (dolist (line (let ((magit-git-global-arguments + ;; KLUDGE At least in Git v2.8.3 this argument + ;; would trigger a segfault. + (remove "--no-pager" magit-git-global-arguments))) + (if (magit-git-version>= "2.36") + (magit-git-items "worktree" "list" "--porcelain" "-z") + (magit-git-lines "worktree" "list" "--porcelain")))) + (cond ((string-prefix-p "worktree" line) + (let ((path (substring line 9))) + (when remote + (setq path (concat remote path))) + ;; If the git directory is separate from the main + ;; worktree, then "git worktree" returns the git + ;; directory instead of the worktree, which isn't + ;; what it is supposed to do and not what we want. + ;; However, if the worktree has been removed, then + ;; we want to return it anyway; instead of nil. + (setq path (or (magit-toplevel path) path)) + (setq worktree (list path nil nil nil nil nil nil)) + (push worktree worktrees))) + ((string-prefix-p "HEAD" line) + (setf (nth 1 worktree) (substring line 5))) + ((string-prefix-p "branch" line) + (setf (nth 2 worktree) (substring line 18))) + ((string-equal line "bare") + (let* ((default-directory (car worktree)) + (wt (and (not (magit-get-boolean "core.bare")) + (magit-get "core.worktree")))) + (if (and wt (file-exists-p (expand-file-name wt))) + (progn (setf (nth 0 worktree) (expand-file-name wt)) + (setf (nth 2 worktree) (magit-rev-parse "HEAD")) + (setf (nth 3 worktree) (magit-get-current-branch))) + (setf (nth 3 worktree) t)))) + ((string-equal line "detached") + (setf (nth 4 worktree) t)) + ((string-prefix-p line "locked") + (setf (nth 5 worktree) + (if (> (length line) 6) (substring line 7) t))) + ((string-prefix-p line "prunable") + (setf (nth 6 worktree) + (if (> (length line) 8) (substring line 9) t))))) + (nreverse worktrees))) + +(defun magit-symbolic-ref-p (name) + (magit-git-success "symbolic-ref" "--quiet" name)) + +(defun magit-ref-p (rev) + (or (car (member rev (magit-list-refs "refs/"))) + (car (member rev (magit-list-refnames "refs/"))))) + +(defun magit-branch-p (rev) + (or (car (member rev (magit-list-branches))) + (car (member rev (magit-list-branch-names))))) + +(defun magit-local-branch-p (rev) + (or (car (member rev (magit-list-local-branches))) + (car (member rev (magit-list-local-branch-names))))) + +(defun magit-remote-branch-p (rev) + (or (car (member rev (magit-list-remote-branches))) + (car (member rev (magit-list-remote-branch-names))))) + +(defun magit-branch-set-face (branch) + (magit--propertize-face branch (if (magit-local-branch-p branch) + 'magit-branch-local + 'magit-branch-remote))) + +(defun magit-tag-p (rev) + (car (member rev (magit-list-tags)))) + +(defun magit-remote-p (string) + (car (member string (magit-list-remotes)))) + +(defvar magit-main-branch-names + '("main" "master" "trunk" "development") + "Branch names reserved for use by the primary branch. +Use function `magit-main-branch' to get the name actually used in +the current repository.") + +(defvar magit-long-lived-branches + (append magit-main-branch-names (list "maint" "next")) + "Branch names reserved for use by long lived branches.") + +(defun magit-main-branch () + "Return the main branch. + +If a branch exists whose name matches `init.defaultBranch', then +that is considered the main branch. If no branch by that name +exists, then the branch names in `magit-main-branch-names' are +tried in order. The first branch from that list that actually +exists in the current repository is considered its main branch." + (let ((branches (magit-list-local-branch-names))) + (seq-find (lambda (name) + (member name branches)) + (delete-dups + (delq nil + (cons (magit-get "init.defaultBranch") + magit-main-branch-names)))))) + +(defun magit-rev-diff-count (a b &optional first-parent) + "Return the commits in A but not B and vice versa. +Return a list of two integers: (A>B B>A). + +If `first-parent' is set, traverse only first parents." + (mapcar #'string-to-number + (split-string (magit-git-string "rev-list" + "--count" "--left-right" + (and first-parent "--first-parent") + (concat a "..." b)) + "\t"))) + +(defun magit-abbrev-length () + (let ((abbrev (magit-get "core.abbrev"))) + (if (and abbrev (not (equal abbrev "auto"))) + (string-to-number abbrev) + ;; Guess the length git will be using based on an example + ;; abbreviation. Actually HEAD's abbreviation might be an + ;; outlier, so use the shorter of the abbreviations for two + ;; commits. See #3034. + (if-let ((head (magit-rev-parse "--short" "HEAD")) + (head-len (length head))) + (min head-len + (if-let ((rev (magit-rev-parse "--short" "HEAD~"))) + (length rev) + head-len)) + ;; We're on an unborn branch, but perhaps the repository has + ;; other commits. See #4123. + (if-let ((commits (magit-git-lines "rev-list" "-n2" "--all" + "--abbrev-commit"))) + (apply #'min (mapcar #'length commits)) + ;; A commit does not exist. Fall back to the default of 7. + 7))))) + +(defun magit-abbrev-arg (&optional arg) + (format "--%s=%d" (or arg "abbrev") (magit-abbrev-length))) + +(defun magit-rev-abbrev (rev) + (magit-rev-parse (magit-abbrev-arg "short") rev)) + +(defun magit-commit-children (commit &optional args) + (mapcar #'car + (--filter (member commit (cdr it)) + (--map (split-string it " ") + (magit-git-lines + "log" "--format=%H %P" + (or args (list "--branches" "--tags" "--remotes")) + "--not" commit))))) + +(defun magit-commit-parents (commit) + (and-let* ((str (magit-git-string "rev-list" "-1" "--parents" commit))) + (cdr (split-string str)))) + +(defun magit-patch-id (rev) + (magit--with-connection-local-variables + (magit--with-temp-process-buffer + (magit-process-file + shell-file-name nil '(t nil) nil shell-command-switch + (let ((exec (shell-quote-argument (magit-git-executable)))) + (format "%s diff-tree -u %s | %s patch-id" exec rev exec))) + (car (split-string (buffer-string)))))) + +(defun magit-rev-format (format &optional rev args) + ;; Prefer `git log --no-walk' to `git show --no-patch' because it + ;; performs better in some scenarios. + (let ((str (magit-git-string "log" "--no-walk" + (concat "--format=" format) args + (if rev (magit--rev-dereference rev) "HEAD") + "--"))) + (and (not (string-equal str "")) + str))) + +(defun magit-rev-insert-format (format &optional rev args) + ;; Prefer `git log --no-walk' to `git show --no-patch' because it + ;; performs better in some scenarios. + (magit-git-insert "log" "--no-walk" + (concat "--format=" format) args + (if rev (magit--rev-dereference rev) "HEAD") + "--")) + +(defun magit-format-rev-summary (rev) + (and-let* ((str (magit-rev-format "%h %s" rev))) + (progn + (magit--put-face 0 (string-match " " str) 'magit-hash str) + str))) + +(defvar magit-ref-namespaces + '(("\\`HEAD\\'" . magit-head) + ("\\`refs/tags/\\(.+\\)" . magit-tag) + ("\\`refs/heads/\\(.+\\)" . magit-branch-local) + ("\\`refs/remotes/\\(.+\\)" . magit-branch-remote) + ("\\`refs/bisect/\\(bad\\)" . magit-bisect-bad) + ("\\`refs/bisect/\\(skip.*\\)" . magit-bisect-skip) + ("\\`refs/bisect/\\(good.*\\)" . magit-bisect-good) + ("\\`refs/stash$" . magit-refname-stash) + ("\\`refs/wip/\\(.+\\)" . magit-refname-wip) + ("\\`refs/pullreqs/\\(.+\\)" . magit-refname-pullreq) + ("\\`\\(bad\\):" . magit-bisect-bad) + ("\\`\\(skip\\):" . magit-bisect-skip) + ("\\`\\(good\\):" . magit-bisect-good) + ("\\`\\(.+\\)" . magit-refname)) + "How refs are formatted for display. + +Each entry controls how a certain type of ref is displayed, and +has the form (REGEXP . FACE). REGEXP is a regular expression +used to match full refs. The first entry whose REGEXP matches +the reference is used. + +In log and revision buffers the first regexp submatch becomes the +\"label\" that represents the ref and is propertized with FONT. +In refs buffers the displayed text is controlled by other means +and this option only controls what face is used.") + +(defun magit-format-ref-labels (string) + (save-match-data + (let ((regexp "\\(, \\|tag: \\|HEAD -> \\)") + names) + (if (and (derived-mode-p 'magit-log-mode) + (member "--simplify-by-decoration" magit-buffer-log-args)) + (let ((branches (magit-list-local-branch-names)) + (re (format "^%s/.+" (regexp-opt (magit-list-remotes))))) + (setq names + (--map (cond ((string-equal it "HEAD") it) + ((string-prefix-p "refs/" it) it) + ((member it branches) (concat "refs/heads/" it)) + ((string-match re it) (concat "refs/remotes/" it)) + (t (concat "refs/" it))) + (split-string + (string-replace "tag: " "refs/tags/" string) + regexp t)))) + (setq names (split-string string regexp t))) + (let (state head upstream tags branches remotes other combined) + (dolist (ref names) + (let* ((face (cdr (--first (string-match (car it) ref) + magit-ref-namespaces))) + (name (magit--propertize-face + (or (match-string 1 ref) ref) face))) + (cl-case face + ((magit-bisect-bad magit-bisect-skip magit-bisect-good) + (setq state name)) + (magit-head + (setq head (magit--propertize-face "@" 'magit-head))) + (magit-tag (push name tags)) + (magit-branch-local (push name branches)) + (magit-branch-remote (push name remotes)) + (t (push name other))))) + (setq remotes + (seq-keep + (lambda (name) + (if (string-match "\\`\\([^/]*\\)/\\(.*\\)\\'" name) + (let ((r (match-string 1 name)) + (b (match-string 2 name))) + (and (not (equal b "HEAD")) + (if (equal (concat "refs/remotes/" name) + (magit-git-string + "symbolic-ref" + (format "refs/remotes/%s/HEAD" r))) + (magit--propertize-face + name 'magit-branch-remote-head) + name))) + name)) + remotes)) + (let* ((current (magit-get-current-branch)) + (target (magit-get-upstream-branch current))) + (dolist (name branches) + (let ((push (car (member (magit-get-push-branch name) remotes)))) + (when push + (setq remotes (delete push remotes)) + (string-match "^[^/]*/" push) + (setq push (substring push 0 (match-end 0)))) + (cond + ((equal name current) + (setq head + (concat push + (magit--propertize-face + name 'magit-branch-current)))) + ((equal name target) + (setq upstream + (concat push + (magit--propertize-face + name '(magit-branch-upstream + magit-branch-local))))) + (t + (push (concat push name) combined))))) + (when (and target (not upstream)) + (if (member target remotes) + (progn + (magit--add-face-text-property + 0 (length target) 'magit-branch-upstream nil target) + (setq upstream target) + (setq remotes (delete target remotes))) + (when-let ((target (car (member target combined)))) + (magit--add-face-text-property + 0 (length target) 'magit-branch-upstream nil target) + (setq upstream target) + (setq combined (delete target combined)))))) + (string-join (flatten-tree `(,state + ,head + ,upstream + ,@(nreverse tags) + ,@(nreverse combined) + ,@(nreverse remotes) + ,@other)) + " "))))) + +(defun magit-object-type (object) + (magit-git-string "cat-file" "-t" object)) + +(defmacro magit-with-blob (commit file &rest body) + (declare (indent 2) + (debug (form form body))) + `(magit--with-temp-process-buffer + (let ((buffer-file-name ,file)) + (save-excursion + (magit-git-insert "cat-file" "-p" + (concat ,commit ":" buffer-file-name))) + (decode-coding-inserted-region + (point-min) (point-max) buffer-file-name t nil nil t) + ,@body))) + +(defvar magit-tramp-process-environment nil) + +(defmacro magit-with-temp-index (tree arg &rest body) + (declare (indent 2) (debug (form form body))) + (let ((file (cl-gensym "file"))) + `(let ((magit--refresh-cache nil) + (,file (magit-convert-filename-for-git + (make-temp-name + (expand-file-name "index.magit." (magit-gitdir)))))) + (unwind-protect + (magit-with-toplevel + (when-let ((tree ,tree)) + (unless (magit-git-success "read-tree" ,arg tree + (concat "--index-output=" ,file)) + (error "Cannot read tree %s" tree))) + (if (file-remote-p default-directory) + (let ((magit-tramp-process-environment + (cons (concat "GIT_INDEX_FILE=" ,file) + magit-tramp-process-environment))) + ,@body) + (with-environment-variables (("GIT_INDEX_FILE" ,file)) + ,@body))) + (ignore-errors + (delete-file (concat (file-remote-p default-directory) ,file))))))) + +(defun magit-commit-tree (message &optional tree &rest parents) + (magit-git-string "commit-tree" "--no-gpg-sign" "-m" message + (--mapcat (list "-p" it) (delq nil parents)) + (or tree + (magit-git-string "write-tree") + (error "Cannot write tree")))) + +(defun magit-commit-worktree (message &optional arg &rest other-parents) + (magit-with-temp-index "HEAD" arg + (and (magit-update-files (magit-unstaged-files)) + (apply #'magit-commit-tree message nil "HEAD" other-parents)))) + +(defun magit-update-files (files) + (magit-git-success "update-index" "--add" "--remove" "--" files)) + +(defun magit-update-ref (ref message rev &optional stashish) + (let ((magit--refresh-cache nil)) + (or (if (magit-git-version>= "2.6.0") + (zerop (magit-call-git "update-ref" "--create-reflog" + "-m" message ref rev + (or (magit-rev-verify ref) ""))) + ;; `--create-reflog' didn't exist before v2.6.0 + (let ((oldrev (magit-rev-verify ref)) + (logfile (expand-file-name (concat "logs/" ref) + (magit-gitdir)))) + (unless (file-exists-p logfile) + (when oldrev + (magit-git-success "update-ref" "-d" ref oldrev)) + (make-directory (file-name-directory logfile) t) + (with-temp-file logfile) + (when (and oldrev (not stashish)) + (magit-git-success "update-ref" "-m" "enable reflog" + ref oldrev "")))) + (magit-git-success "update-ref" "-m" message ref rev + (or (magit-rev-verify ref) ""))) + (error "Cannot update %s with %s" ref rev)))) + +(defconst magit-range-re + (concat "\\`\\([^ \t]*[^.]\\)?" ; revA + "\\(\\.\\.\\.?\\)" ; range marker + "\\([^.][^ \t]*\\)?\\'")) ; revB + +(defun magit-split-range (range) + (pcase-let ((`(,beg ,end ,sep) (magit--split-range-raw range))) + (and sep + (let ((beg (or beg "HEAD")) + (end (or end "HEAD"))) + (if (string-equal (match-string 2 range) "...") + (and-let* ((base (magit-git-string "merge-base" beg end))) + (cons base end)) + (cons beg end)))))) + +(defun magit--split-range-raw (range) + (and (string-match magit-range-re range) + (let ((beg (match-string 1 range)) + (end (match-string 3 range))) + (and (or beg end) + (list beg end (match-string 2 range)))))) + +(defun magit-hash-range (range) + (if (string-match magit-range-re range) + (let ((beg (match-string 1 range)) + (end (match-string 3 range))) + (and (or beg end) + (let ((beg-hash (and beg (magit-rev-hash (match-string 1 range)))) + (end-hash (and end (magit-rev-hash (match-string 3 range))))) + (and (or (not beg) beg-hash) + (or (not end) end-hash) + (concat beg-hash (match-string 2 range) end-hash))))) + (magit-rev-hash range))) + +(defvar magit-revision-faces + '(magit-hash + magit-tag + magit-branch-remote + magit-branch-remote-head + magit-branch-local + magit-branch-current + magit-branch-upstream + magit-branch-warning + magit-head + magit-refname + magit-refname-stash + magit-refname-wip + magit-refname-pullreq)) + +(put 'git-revision 'thing-at-point #'magit-thingatpt--git-revision) +(defun magit-thingatpt--git-revision (&optional disallow) + ;; Support hashes and references. + (and-let* ((bounds + (let ((c (concat "\s\n\t~^:?*[\\" disallow))) + (cl-letf + (((get 'git-revision 'beginning-op) + (lambda () + (if (re-search-backward (format "[%s]" c) nil t) + (forward-char) + (goto-char (point-min))))) + ((get 'git-revision 'end-op) + (lambda () + (re-search-forward (format "\\=[^%s]*" c) nil t)))) + (bounds-of-thing-at-point 'git-revision)))) + (string (buffer-substring-no-properties (car bounds) (cdr bounds))) + ;; References are allowed to contain most parentheses and + ;; most punctuation, but if those characters appear at the + ;; edges of a possible reference in arbitrary text, then + ;; they are much more likely to be intended as just that: + ;; punctuation and delimiters. + (string (thread-first string + (string-trim-left "[(</]") + (string-trim-right "[])>/.,;!]")))) + (let (disallow) + (when (or (string-match-p "\\.\\." string) + (string-match-p "/\\." string)) + (setq disallow (concat disallow "."))) + (when (string-match-p "@{" string) + (setq disallow (concat disallow "@{"))) + (if disallow + ;; These additional restrictions overcompensate, + ;; but that only matters in rare cases. + (magit-thingatpt--git-revision disallow) + (and (not (equal string "@")) + (or (and (>= (length string) 7) + (string-match-p "[a-z]" string) + (magit-commit-p string)) + (and (magit-ref-p string) + (let ((face (get-text-property (point) 'face))) + (or (not face) + (member face magit-revision-faces))))) + string))))) + +(put 'git-revision-range 'thing-at-point #'magit-thingatpt--git-revision-range) +(defun magit-thingatpt--git-revision-range () + ;; Support hashes but no references. + (and-let* ((bounds + (cl-letf (((get 'git-revision 'beginning-op) + (lambda () + (if (re-search-backward "[^a-z0-9.]" nil t) + (forward-char) + (goto-char (point-min))))) + ((get 'git-revision 'end-op) + (lambda () + (and (re-search-forward "[^a-z0-9.]" nil t) + (backward-char))))) + (bounds-of-thing-at-point 'git-revision))) + (range (buffer-substring-no-properties (car bounds) (cdr bounds)))) + ;; Validate but return as-is. + (and (magit-hash-range range) range))) + +;;; Completion + +(defvar magit-revision-history nil) + +(defun magit--minibuf-default-add-commit () + (let ((fn minibuffer-default-add-function)) + (lambda () + (if-let ((commit (with-selected-window (minibuffer-selected-window) + (or (magit-thing-at-point 'git-revision-range t) + (magit-commit-at-point))))) + (let ((rest (cons commit (delete commit (funcall fn)))) + (def minibuffer-default)) + (if (listp def) + (append def rest) + (cons def (delete def rest)))) + (funcall fn))))) + +(defun magit-read-branch (prompt &optional secondary-default) + (magit-completing-read prompt (magit-list-branch-names) + nil t nil 'magit-revision-history + (or (magit-branch-at-point) + secondary-default + (magit-get-current-branch)))) + +(defun magit-read-branch-or-commit (prompt &optional secondary-default) + (let ((minibuffer-default-add-function (magit--minibuf-default-add-commit))) + (or (magit-completing-read prompt (magit-list-refnames nil t) + nil nil nil 'magit-revision-history + (or (magit-branch-or-commit-at-point) + secondary-default + (magit-get-current-branch))) + (user-error "Nothing selected")))) + +(defun magit-read-range-or-commit (prompt &optional secondary-default) + (magit-read-range + prompt + (or (and-let* ((revs (magit-region-values '(commit branch) t))) + (progn + (deactivate-mark) + (concat (car (last revs)) ".." (car revs)))) + (magit-branch-or-commit-at-point) + secondary-default + (magit-get-current-branch)))) + +(defun magit-read-range (prompt &optional default) + (let ((minibuffer-default-add-function (magit--minibuf-default-add-commit)) + (crm-separator "\\.\\.\\.?")) + (magit-completing-read-multiple + (concat prompt ": ") + (magit-list-refnames) + nil nil nil 'magit-revision-history default nil t))) + +(defun magit-read-remote-branch + (prompt &optional remote default local-branch require-match) + (let ((choice (magit-completing-read + prompt + (cl-union (and local-branch + (if remote + (concat remote "/" local-branch) + (--map (concat it "/" local-branch) + (magit-list-remotes)))) + (magit-list-remote-branch-names remote t) + :test #'equal) + nil require-match nil 'magit-revision-history default))) + (if (or remote (string-match "\\`\\([^/]+\\)/\\(.+\\)" choice)) + choice + (user-error "`%s' doesn't have the form REMOTE/BRANCH" choice)))) + +(defun magit-read-refspec (prompt remote) + (magit-completing-read prompt + (prog2 (message "Determining available refs...") + (magit-remote-list-refs remote) + (message "Determining available refs...done")))) + +(defun magit-read-local-branch (prompt &optional secondary-default) + (magit-completing-read prompt (magit-list-local-branch-names) + nil t nil 'magit-revision-history + (or (magit-local-branch-at-point) + secondary-default + (magit-get-current-branch)))) + +(defun magit-read-local-branch-or-commit (prompt) + (let ((minibuffer-default-add-function (magit--minibuf-default-add-commit)) + (choices (nconc (magit-list-local-branch-names) + (magit-list-special-refnames))) + (commit (magit-commit-at-point))) + (when commit + (push commit choices)) + (or (magit-completing-read prompt choices + nil nil nil 'magit-revision-history + (or (magit-local-branch-at-point) commit)) + (user-error "Nothing selected")))) + +(defun magit-read-local-branch-or-ref (prompt &optional secondary-default) + (magit-completing-read prompt (nconc (magit-list-local-branch-names) + (magit-list-refs "refs/")) + nil t nil 'magit-revision-history + (or (magit-local-branch-at-point) + secondary-default + (magit-get-current-branch)))) + +(defun magit-read-other-branch + (prompt &optional exclude secondary-default no-require-match) + (let* ((current (magit-get-current-branch)) + (atpoint (magit-branch-at-point)) + (exclude (or exclude current)) + (default (or (and (not (equal atpoint exclude)) atpoint) + (and (not (equal current exclude)) current) + secondary-default + (magit-get-previous-branch)))) + (magit-completing-read prompt (delete exclude (magit-list-branch-names)) + nil (not no-require-match) + nil 'magit-revision-history default))) + +(defun magit-read-other-branch-or-commit + (prompt &optional exclude secondary-default) + (let* ((minibuffer-default-add-function (magit--minibuf-default-add-commit)) + (current (magit-get-current-branch)) + (atpoint (magit-branch-or-commit-at-point)) + (exclude (or exclude current)) + (default (or (and (not (equal atpoint exclude)) + (not (and (not current) + (magit-rev-equal atpoint "HEAD"))) + atpoint) + (and (not (equal current exclude)) current) + secondary-default + (magit-get-previous-branch)))) + (or (magit-completing-read prompt (delete exclude (magit-list-refnames)) + nil nil nil 'magit-revision-history default) + (user-error "Nothing selected")))) + +(defun magit-read-other-local-branch + (prompt &optional exclude secondary-default no-require-match) + (let* ((current (magit-get-current-branch)) + (atpoint (magit-local-branch-at-point)) + (exclude (or exclude current)) + (default (or (and (not (equal atpoint exclude)) atpoint) + (and (not (equal current exclude)) current) + secondary-default + (magit-get-previous-branch)))) + (magit-completing-read prompt + (delete exclude (magit-list-local-branch-names)) + nil (not no-require-match) + nil 'magit-revision-history default))) + +(defun magit-read-branch-prefer-other (prompt) + (let* ((current (magit-get-current-branch)) + (commit (magit-commit-at-point)) + (atrev (and commit (magit-list-branches-pointing-at commit))) + (atpoint (magit--painted-branch-at-point))) + (magit-completing-read prompt (magit-list-branch-names) + nil t nil 'magit-revision-history + (or (magit-section-value-if 'branch) + atpoint + (and (not (cdr atrev)) (car atrev)) + (--first (not (equal it current)) atrev) + (magit-get-previous-branch) + (car atrev))))) + +(defun magit-read-upstream-branch (&optional branch prompt) + "Read the upstream for BRANCH using PROMPT. +If optional BRANCH is nil, then read the upstream for the +current branch, or raise an error if no branch is checked +out. Only existing branches can be selected." + (unless branch + (setq branch (or (magit-get-current-branch) + (error "Need a branch to set its upstream")))) + (let ((branches (delete branch (magit-list-branch-names)))) + (magit-completing-read + (or prompt (format "Change upstream of %s to" branch)) + branches nil t nil 'magit-revision-history + (or (let ((r (car (member (magit-remote-branch-at-point) branches))) + (l (car (member (magit-local-branch-at-point) branches)))) + (if magit-prefer-remote-upstream (or r l) (or l r))) + (and-let* ((main (magit-main-branch))) + (let ((r (car (member (concat "origin/" main) branches))) + (l (car (member main branches)))) + (if magit-prefer-remote-upstream (or r l) (or l r)))) + (car (member (magit-get-previous-branch) branches)))))) + +(defun magit-read-starting-point (prompt &optional branch default) + (or (magit-completing-read + (concat prompt + (and branch + (if (bound-and-true-p ivy-mode) + ;; Ivy-mode strips faces from prompt. + (format " `%s'" branch) + (concat " " (magit--propertize-face + branch 'magit-branch-local)))) + " starting at") + (nconc (list "HEAD") + (magit-list-refnames) + (directory-files (magit-gitdir) nil "_HEAD\\'")) + nil nil nil 'magit-revision-history + (or default (magit--default-starting-point))) + (user-error "Nothing selected"))) + +(defun magit--default-starting-point () + (or (let ((r (magit-remote-branch-at-point)) + (l (magit-local-branch-at-point))) + (if magit-prefer-remote-upstream (or r l) (or l r))) + (magit-commit-at-point) + (magit-stash-at-point) + (magit-get-current-branch))) + +(defun magit-read-tag (prompt &optional require-match) + (magit-completing-read prompt (magit-list-tags) nil + require-match nil 'magit-revision-history + (magit-tag-at-point))) + +(defun magit-read-stash (prompt) + (let* ((atpoint (magit-stash-at-point)) + (default (and atpoint + (concat atpoint (magit-rev-format " %s" atpoint)))) + (choices (mapcar (lambda (c) + (pcase-let ((`(,rev ,msg) (split-string c "\0"))) + (concat (propertize rev 'face 'magit-hash) + " " msg))) + (magit-list-stashes "%gd%x00%s"))) + (choice (magit-completing-read prompt choices + nil t nil nil + default + (car choices)))) + (and choice + (string-match "^\\([^ ]+\\) \\(.+\\)" choice) + (substring-no-properties (match-string 1 choice))))) + +(defun magit-read-remote (prompt &optional default use-only) + (let ((remotes (magit-list-remotes))) + (if (and use-only (length= remotes 1)) + (car remotes) + (magit-completing-read prompt remotes + nil t nil nil + (or default + (magit-remote-at-point) + (magit-get-remote)))))) + +(defun magit-read-remote-or-url (prompt &optional default) + (magit-completing-read prompt + (nconc (magit-list-remotes) + (list "https://" "git://" "git@")) + nil nil nil nil + (or default + (magit-remote-at-point) + (magit-get-remote)))) + +(defun magit-read-module-path (prompt &optional predicate) + (magit-completing-read prompt (magit-list-module-paths) + predicate t nil nil + (magit-module-at-point predicate))) + +(defun magit-module-confirm (verb &optional predicate) + ;; Some predicates use the inefficient `magit-toplevel' + ;; and some repositories have thousands of submodules. + (let ((magit--refresh-cache (list (cons 0 0))) + (modules nil)) + (if current-prefix-arg + (progn + (setq modules (magit-list-module-paths)) + (when predicate + (setq modules (seq-filter predicate modules))) + (unless modules + (if predicate + (user-error "No modules satisfying %s available" predicate) + (user-error "No modules available")))) + (setq modules (magit-region-values 'module)) + (when modules + (when predicate + (setq modules (seq-filter predicate modules))) + (unless modules + (user-error "No modules satisfying %s selected" predicate)))) + (if (or (length> modules 1) current-prefix-arg) + (magit-confirm t nil (format "%s %%d modules" verb) nil modules) + (list (magit-read-module-path (format "%s module" verb) predicate))))) + +;;; _ +(provide 'magit-git) +;;; magit-git.el ends here diff --git a/emacs/elpa/magit-20240625.2109/magit-git.elc b/emacs/elpa/magit-20240625.2109/magit-git.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/magit-gitignore.el b/emacs/elpa/magit-20240625.2109/magit-gitignore.el diff --git a/emacs/elpa/magit-20240622.1531/magit-gitignore.elc b/emacs/elpa/magit-20240625.2109/magit-gitignore.elc Binary files differ. diff --git a/emacs/elpa/magit-20240625.2109/magit-log.el b/emacs/elpa/magit-20240625.2109/magit-log.el @@ -0,0 +1,2022 @@ +;;; magit-log.el --- Inspect Git history -*- lexical-binding:t; coding:utf-8 -*- + +;; Copyright (C) 2008-2024 The Magit Project Contributors + +;; Author: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> +;; Maintainer: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; 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. +;; +;; 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 Magit. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This library implements support for looking at Git logs, including +;; special logs like cherry-logs, as well as for selecting a commit +;; from a log. + +;;; Code: + +(require 'magit-core) +(require 'magit-diff) + +(declare-function magit-blob-visit "magit-files" (blob-or-file)) +(declare-function magit-cherry-apply "magit-sequence" (commit &optional args)) +(declare-function magit-insert-head-branch-header "magit-status" + (&optional branch)) +(declare-function magit-insert-upstream-branch-header "magit-status" + (&optional branch pull keyword)) +(declare-function magit-read-file-from-rev "magit-files" + (rev prompt &optional default)) +(declare-function magit-rebase--get-state-lines "magit-sequence" + (file)) +(declare-function magit-show-commit "magit-diff" + (arg1 &optional arg2 arg3 arg4)) +(declare-function magit-reflog-format-subject "magit-reflog" (subject)) +(defvar magit-refs-focus-column-width) +(defvar magit-refs-margin) +(defvar magit-refs-show-commit-count) +(defvar magit-buffer-margin) +(defvar magit-status-margin) +(defvar magit-status-sections-hook) + +(require 'ansi-color) +(require 'crm) +(require 'which-func) + +;;; Options +;;;; Log Mode + +(defgroup magit-log nil + "Inspect and manipulate Git history." + :link '(info-link "(magit)Logging") + :group 'magit-commands + :group 'magit-modes) + +(defcustom magit-log-mode-hook nil + "Hook run after entering Magit-Log mode." + :group 'magit-log + :type 'hook) + +(defcustom magit-log-remove-graph-args '("--follow" "--grep" "-G" "-S" "-L") + "The log arguments that cause the `--graph' argument to be dropped. + +The default value lists the arguments that are incompatible with +`--graph' and therefore must be dropped when that is used. You +can add additional arguments that are available in `magit-log', +but I recommend that you don't do that. Nowadays I would define +this as a constant, but I am preserving it as an option, in case +someone actually customized it." + :package-version '(magit . "2.3.0") + :group 'magit-log + :type '(repeat (string :tag "Argument")) + :options '("--follow" "--grep" "-G" "-S" "-L")) + +(defcustom magit-log-revision-headers-format "\ +%+b%+N +Author: %aN <%aE> +Committer: %cN <%cE>" + "Additional format string used with the `++header' argument." + :package-version '(magit . "3.2.0") + :group 'magit-log + :type 'string) + +(defcustom magit-log-auto-more nil + "Insert more log entries automatically when moving past the last entry. +Only considered when moving past the last entry with +`magit-goto-*-section' commands." + :group 'magit-log + :type 'boolean) + +(defcustom magit-log-margin '(t age magit-log-margin-width t 18) + "Format of the margin in `magit-log-mode' buffers. + +The value has the form (INIT STYLE WIDTH AUTHOR AUTHOR-WIDTH). + +If INIT is non-nil, then the margin is shown initially. +STYLE controls how to format the author or committer date. + It can be one of `age' (to show the age of the commit), + `age-abbreviated' (to abbreviate the time unit to a character), + or a string (suitable for `format-time-string') to show the + actual date. Option `magit-log-margin-show-committer-date' + controls which date is being displayed. +WIDTH controls the width of the margin. This exists for forward + compatibility and currently the value should not be changed. +AUTHOR controls whether the name of the author is also shown by + default. +AUTHOR-WIDTH has to be an integer. When the name of the author + is shown, then this specifies how much space is used to do so." + :package-version '(magit . "2.9.0") + :group 'magit-log + :group 'magit-margin + :type magit-log-margin--custom-type + :initialize #'magit-custom-initialize-reset + :set (apply-partially #'magit-margin-set-variable 'magit-log-mode)) + +(defcustom magit-log-margin-show-committer-date nil + "Whether to show the committer date in the margin. + +This option only controls whether the committer date is displayed +instead of the author date. Whether some date is displayed in +the margin and whether the margin is displayed at all is +controlled by other options." + :package-version '(magit . "3.0.0") + :group 'magit-log + :group 'magit-margin + :type 'boolean) + +(defcustom magit-log-show-refname-after-summary nil + "Whether to show refnames after commit summaries. +This is useful if you use really long branch names." + :package-version '(magit . "2.2.0") + :group 'magit-log + :type 'boolean) + +(defcustom magit-log-highlight-keywords t + "Whether to highlight bracketed keywords in commit summaries." + :package-version '(magit . "2.12.0") + :group 'magit-log + :type 'boolean) + +(defcustom magit-log-header-line-function #'magit-log-header-line-sentence + "Function used to generate text shown in header line of log buffers." + :package-version '(magit . "2.12.0") + :group 'magit-log + :type '(choice (function-item magit-log-header-line-arguments) + (function-item magit-log-header-line-sentence) + function)) + +(defcustom magit-log-trace-definition-function #'magit-which-function + "Function used to determine the function at point. +This is used by the command `magit-log-trace-definition'. +You should prefer `magit-which-function' over `which-function' +because the latter may make use of Imenu's outdated cache." + :package-version '(magit . "3.0.0") + :group 'magit-log + :type '(choice (function-item magit-which-function) + (function-item which-function) + (function-item add-log-current-defun) + function)) + +(defcustom magit-log-color-graph-limit 256 + "Number of commits over which log graphs are not colored. +When showing more commits than specified, then the `--color' +argument is silently dropped. This is necessary because the +`ansi-color' library, which is used to turn control sequences +into faces, is just too slow." + :package-version '(magit . "4.0.0") + :group 'magit-log + :type 'number) + +(defcustom magit-log-show-signatures-limit 256 + "Number of commits over which signatures are not verified. +When showing more commits than specified by this option, then the +`--show-signature' argument, if specified, is silently dropped. +This is necessary because checking the signature of a large +number of commits is just too slow." + :package-version '(magit . "4.0.0") + :group 'magit-log + :type 'number) + +(defface magit-log-graph + '((((class color) (background light)) :foreground "grey30") + (((class color) (background dark)) :foreground "grey80")) + "Face for the graph part of the log output." + :group 'magit-faces) + +(defface magit-log-author + '((((class color) (background light)) + :foreground "firebrick" + :slant normal + :weight normal) + (((class color) (background dark)) + :foreground "tomato" + :slant normal + :weight normal)) + "Face for the author part of the log output." + :group 'magit-faces) + +(defface magit-log-date + '((((class color) (background light)) + :foreground "grey30" + :slant normal + :weight normal) + (((class color) (background dark)) + :foreground "grey80" + :slant normal + :weight normal)) + "Face for the date part of the log output." + :group 'magit-faces) + +(defface magit-header-line-log-select + '((t :inherit bold)) + "Face for the `header-line' in `magit-log-select-mode'." + :group 'magit-faces) + +;;;; File Log + +(defcustom magit-log-buffer-file-locked t + "Whether `magit-log-buffer-file-quick' uses a dedicated buffer." + :package-version '(magit . "2.7.0") + :group 'magit-commands + :group 'magit-log + :type 'boolean) + +;;;; Select Mode + +(defcustom magit-log-select-show-usage 'both + "Whether to show usage information when selecting a commit from a log. +The message can be shown in the `echo-area' or the `header-line', or in +`both' places. If the value isn't one of these symbols, then it should +be nil, in which case no usage information is shown." + :package-version '(magit . "2.1.0") + :group 'magit-log + :type '(choice (const :tag "in echo-area" echo-area) + (const :tag "in header-line" header-line) + (const :tag "in both places" both) + (const :tag "nowhere"))) + +(defcustom magit-log-select-margin + (list (nth 0 magit-log-margin) + (nth 1 magit-log-margin) + 'magit-log-margin-width t + (nth 4 magit-log-margin)) + "Format of the margin in `magit-log-select-mode' buffers. + +The value has the form (INIT STYLE WIDTH AUTHOR AUTHOR-WIDTH). + +If INIT is non-nil, then the margin is shown initially. +STYLE controls how to format the author or committer date. + It can be one of `age' (to show the age of the commit), + `age-abbreviated' (to abbreviate the time unit to a character), + or a string (suitable for `format-time-string') to show the + actual date. Option `magit-log-margin-show-committer-date' + controls which date is being displayed. +WIDTH controls the width of the margin. This exists for forward + compatibility and currently the value should not be changed. +AUTHOR controls whether the name of the author is also shown by + default. +AUTHOR-WIDTH has to be an integer. When the name of the author + is shown, then this specifies how much space is used to do so." + :package-version '(magit . "2.9.0") + :group 'magit-log + :group 'magit-margin + :type magit-log-margin--custom-type + :initialize #'magit-custom-initialize-reset + :set-after '(magit-log-margin) + :set (apply-partially #'magit-margin-set-variable 'magit-log-select-mode)) + +;;;; Cherry Mode + +(defcustom magit-cherry-sections-hook + '(magit-insert-cherry-headers + magit-insert-cherry-commits) + "Hook run to insert sections into the cherry buffer." + :package-version '(magit . "2.1.0") + :group 'magit-log + :type 'hook) + +(defcustom magit-cherry-margin + (list (nth 0 magit-log-margin) + (nth 1 magit-log-margin) + 'magit-log-margin-width t + (nth 4 magit-log-margin)) + "Format of the margin in `magit-cherry-mode' buffers. + +The value has the form (INIT STYLE WIDTH AUTHOR AUTHOR-WIDTH). + +If INIT is non-nil, then the margin is shown initially. +STYLE controls how to format the author or committer date. + It can be one of `age' (to show the age of the commit), + `age-abbreviated' (to abbreviate the time unit to a character), + or a string (suitable for `format-time-string') to show the + actual date. Option `magit-log-margin-show-committer-date' + controls which date is being displayed. +WIDTH controls the width of the margin. This exists for forward + compatibility and currently the value should not be changed. +AUTHOR controls whether the name of the author is also shown by + default. +AUTHOR-WIDTH has to be an integer. When the name of the author + is shown, then this specifies how much space is used to do so." + :package-version '(magit . "2.9.0") + :group 'magit-log + :group 'magit-margin + :type magit-log-margin--custom-type + :initialize #'magit-custom-initialize-reset + :set-after '(magit-log-margin) + :set (apply-partially #'magit-margin-set-variable 'magit-cherry-mode)) + +;;;; Log Sections + +(defcustom magit-log-section-commit-count 10 + "How many recent commits to show in certain log sections. +How many recent commits `magit-insert-recent-commits' and +`magit-insert-unpulled-from-upstream-or-recent' (provided +the upstream isn't ahead of the current branch) show." + :package-version '(magit . "2.1.0") + :group 'magit-status + :type 'number) + +(defcustom magit-log-merged-commit-count 20 + "How many surrounding commits to show for `magit-log-merged'. +`magit-log-merged' will shows approximately half of this number +commits before and half after." + :package-version '(magit . "3.3.0") + :group 'magit-log + :type 'integer) + +;;; Arguments +;;;; Prefix Classes + +(defclass magit-log-prefix (transient-prefix) + ((history-key :initform 'magit-log) + (major-mode :initform 'magit-log-mode))) + +(defclass magit-log-refresh-prefix (magit-log-prefix) + ((history-key :initform 'magit-log) + (major-mode :initform nil))) + +;;;; Prefix Methods + +(cl-defmethod transient-init-value ((obj magit-log-prefix)) + (pcase-let ((`(,args ,files) + (magit-log--get-value 'magit-log-mode + magit-prefix-use-buffer-arguments))) + (unless (eq transient-current-command 'magit-dispatch) + (when-let ((file (magit-file-relative-name))) + (setq files (list file)))) + (oset obj value (if files `(("--" ,@files) ,args) args)))) + +(cl-defmethod transient-init-value ((obj magit-log-refresh-prefix)) + (oset obj value (if magit-buffer-log-files + `(("--" ,@magit-buffer-log-files) + ,magit-buffer-log-args) + magit-buffer-log-args))) + +(cl-defmethod transient-set-value ((obj magit-log-prefix)) + (magit-log--set-value obj)) + +(cl-defmethod transient-save-value ((obj magit-log-prefix)) + (magit-log--set-value obj 'save)) + +;;;; Argument Access + +(defun magit-log-arguments (&optional mode) + "Return the current log arguments." + (if (memq transient-current-command '(magit-log magit-log-refresh)) + (magit--transient-args-and-files) + (magit-log--get-value (or mode 'magit-log-mode)))) + +(defun magit-log--get-value (mode &optional use-buffer-args) + (unless use-buffer-args + (setq use-buffer-args magit-direct-use-buffer-arguments)) + (let (args files) + (cond + ((and (memq use-buffer-args '(always selected current)) + (eq major-mode mode)) + (setq args magit-buffer-log-args) + (setq files magit-buffer-log-files)) + ((and (memq use-buffer-args '(always selected)) + (when-let ((buffer (magit-get-mode-buffer + mode nil + (eq use-buffer-args 'selected)))) + (setq args (buffer-local-value 'magit-buffer-log-args buffer)) + (setq files (buffer-local-value 'magit-buffer-log-files buffer)) + t))) + ((plist-member (symbol-plist mode) 'magit-log-current-arguments) + (setq args (get mode 'magit-log-current-arguments))) + ((when-let ((elt (assq (intern (format "magit-log:%s" mode)) + transient-values))) + (setq args (cdr elt)) + t)) + (t + (setq args (get mode 'magit-log-default-arguments)))) + (list args files))) + +(defun magit-log--set-value (obj &optional save) + (pcase-let* ((obj (oref obj prototype)) + (mode (or (oref obj major-mode) major-mode)) + (key (intern (format "magit-log:%s" mode))) + (`(,args ,files) (magit--transient-args-and-files))) + (put mode 'magit-log-current-arguments args) + (when save + (setf (alist-get key transient-values) args) + (transient-save-values)) + (transient--history-push obj) + (setq magit-buffer-log-args args) + (unless (derived-mode-p 'magit-log-select-mode) + (setq magit-buffer-log-files files)) + (magit-refresh))) + +;;; Commands +;;;; Prefix Commands + +;;;###autoload (autoload 'magit-log "magit-log" nil t) +(transient-define-prefix magit-log () + "Show a commit or reference log." + :man-page "git-log" + :class 'magit-log-prefix + ;; The grouping in git-log(1) appears to be guided by implementation + ;; details, so our logical grouping only follows it to an extend. + ;; Arguments that are "misplaced" here: + ;; 1. From "Commit Formatting". + ;; 2. From "Common Diff Options". + ;; 3. From unnamed first group. + ;; 4. Implemented by Magit. + ["Commit limiting" + (magit-log:-n) + (magit:--author) + (7 magit-log:--since) + (7 magit-log:--until) + (magit-log:--grep) + (7 "-i" "Search case-insensitive" ("-i" "--regexp-ignore-case")) + (7 "-I" "Invert search pattern" "--invert-grep") + (magit-log:-G) ;2 + (magit-log:-S) ;2 + (magit-log:-L) ;2 + (7 "=m" "Omit merges" "--no-merges") + (7 "=p" "First parent" "--first-parent")] + ["History simplification" + ( "-D" "Simplify by decoration" "--simplify-by-decoration") + (magit:--) + ( "-f" "Follow renames when showing single-file log" "--follow") ;3 + (6 "/s" "Only commits changing given paths" "--sparse") + (7 "/d" "Only selected commits plus meaningful history" "--dense") + (7 "/a" "Only commits existing directly on ancestry path" "--ancestry-path") + (6 "/f" "Do not prune history" "--full-history") + (7 "/m" "Prune some history" "--simplify-merges")] + ["Commit ordering" + (magit-log:--*-order) + ("-r" "Reverse order" "--reverse")] + ["Formatting" + ("-g" "Show graph" "--graph") ;1 + ("-c" "Show graph in color" "--color") ;2 + ("-d" "Show refnames" "--decorate") ;3 + ("=S" "Show signatures" "--show-signature") ;1 + ("-h" "Show header" "++header") ;4 + ("-p" "Show diffs" ("-p" "--patch")) ;2 + ("-s" "Show diffstats" "--stat")] ;2 + [["Log" + ("l" "current" magit-log-current) + ("h" "HEAD" magit-log-head) + ("u" "related" magit-log-related) + ("o" "other" magit-log-other)] + ["" + ("L" "local branches" magit-log-branches) + ("b" "all branches" magit-log-all-branches) + ("a" "all references" magit-log-all) + (7 "B" "matching branches" magit-log-matching-branches) + (7 "T" "matching tags" magit-log-matching-tags) + (7 "m" "merged" magit-log-merged)] + ["Reflog" + ("r" "current" magit-reflog-current) + ("H" "HEAD" magit-reflog-head) + ("O" "other" magit-reflog-other)] + [:if (lambda () + (and (fboundp 'magit--any-wip-mode-enabled-p) + (magit--any-wip-mode-enabled-p))) + :description "Wiplog" + ("i" "index" magit-wip-log-index) + ("w" "worktree" magit-wip-log-worktree)] + ["Other" + (5 "s" "shortlog" magit-shortlog)]]) + +;;;###autoload (autoload 'magit-log-refresh "magit-log" nil t) +(transient-define-prefix magit-log-refresh () + "Change the arguments used for the log(s) in the current buffer." + :man-page "git-log" + :class 'magit-log-refresh-prefix + [:if-mode magit-log-mode + :class transient-subgroups + ["Commit limiting" + (magit-log:-n) + (magit:--author) + (magit-log:--grep) + (7 "-i" "Search case-insensitive" ("-i" "--regexp-ignore-case")) + (7 "-I" "Invert search pattern" "--invert-grep") + (magit-log:-G) + (magit-log:-S) + (magit-log:-L)] + ["History simplification" + ( "-D" "Simplify by decoration" "--simplify-by-decoration") + (magit:--) + ( "-f" "Follow renames when showing single-file log" "--follow") ;3 + (6 "/s" "Only commits changing given paths" "--sparse") + (7 "/d" "Only selected commits plus meaningful history" "--dense") + (7 "/a" "Only commits existing directly on ancestry path" "--ancestry-path") + (6 "/f" "Do not prune history" "--full-history") + (7 "/m" "Prune some history" "--simplify-merges")] + ["Commit ordering" + (magit-log:--*-order) + ("-r" "Reverse order" "--reverse")] + ["Formatting" + ("-g" "Show graph" "--graph") + ("-c" "Show graph in color" "--color") + ("-d" "Show refnames" "--decorate") + ("=S" "Show signatures" "--show-signature") + ("-h" "Show header" "++header") + ("-p" "Show diffs" ("-p" "--patch")) + ("-s" "Show diffstats" "--stat")]] + [:if-not-mode magit-log-mode + :description "Arguments" + (magit-log:-n) + (magit-log:--*-order) + ("-g" "Show graph" "--graph") + ("-c" "Show graph in color" "--color") + ("-d" "Show refnames" "--decorate")] + [["Refresh" + ("g" "buffer" magit-log-refresh) + ("s" "buffer and set defaults" transient-set-and-exit) + ("w" "buffer and save defaults" transient-save-and-exit)] + ["Margin" + (magit-toggle-margin) + (magit-cycle-margin-style) + (magit-toggle-margin-details) + (magit-toggle-log-margin-style)] + [:if-mode magit-log-mode + :description "Toggle" + ("b" "buffer lock" magit-toggle-buffer-lock)]] + (interactive) + (cond + ((not (eq transient-current-command 'magit-log-refresh)) + (pcase major-mode + ('magit-reflog-mode + (user-error "Cannot change log arguments in reflog buffers")) + ('magit-cherry-mode + (user-error "Cannot change log arguments in cherry buffers"))) + (transient-setup 'magit-log-refresh)) + (t + (pcase-let ((`(,args ,files) (magit-log-arguments))) + (setq magit-buffer-log-args args) + (unless (derived-mode-p 'magit-log-select-mode) + (setq magit-buffer-log-files files))) + (magit-refresh)))) + +;;;; Infix Commands + +(transient-define-argument magit-log:-n () + :description "Limit number of commits" + :class 'transient-option + ;; For historic reasons (and because it easy to guess what "-n" + ;; stands for) this is the only argument where we do not use the + ;; long argument ("--max-count"). + :shortarg "-n" + :argument "-n" + :reader #'transient-read-number-N+) + +(transient-define-argument magit:--author () + :description "Limit to author" + :class 'transient-option + :key "-A" + :argument "--author=" + :reader #'magit-transient-read-person) + +(transient-define-argument magit-log:--since () + :description "Limit to commits since" + :class 'transient-option + :key "=s" + :argument "--since=" + :reader #'transient-read-date) + +(transient-define-argument magit-log:--until () + :description "Limit to commits until" + :class 'transient-option + :key "=u" + :argument "--until=" + :reader #'transient-read-date) + +(transient-define-argument magit-log:--*-order () + :description "Order commits by" + :class 'transient-switches + :key "-o" + :argument-format "--%s-order" + :argument-regexp "\\(--\\(topo\\|author-date\\|date\\)-order\\)" + :choices '("topo" "author-date" "date")) + +(transient-define-argument magit-log:--grep () + :description "Search messages" + :class 'transient-option + :key "-F" + :argument "--grep=") + +(transient-define-argument magit-log:-G () + :description "Search changes" + :class 'transient-option + :argument "-G") + +(transient-define-argument magit-log:-S () + :description "Search occurrences" + :class 'transient-option + :argument "-S") + +(transient-define-argument magit-log:-L () + :description "Trace line evolution" + :class 'transient-option + :argument "-L" + :reader #'magit-read-file-trace) + +(defun magit-read-file-trace (&rest _ignored) + (let ((file (magit-read-file-from-rev "HEAD" "File")) + (trace (magit-read-string "Trace"))) + (concat trace ":" file))) + +;;;; Setup Commands + +(defvar-keymap magit-log-read-revs-map + :parent crm-local-completion-map + "SPC" #'self-insert-command) + +(defun magit-log-read-revs (&optional use-current) + (or (and use-current (and-let* ((buf (magit-get-current-branch))) (list buf))) + (let ((crm-separator "\\(\\.\\.\\.?\\|[, ]\\)") + (crm-local-completion-map magit-log-read-revs-map)) + (split-string (magit-completing-read-multiple + "Log rev,s: " + (magit-list-refnames nil t) + nil nil nil 'magit-revision-history + (or (magit-branch-or-commit-at-point) + (and (not use-current) + (magit-get-previous-branch))) + nil t) + "[, ]" t)))) + +(defun magit-log-read-pattern (option) + "Read a string from the user to pass as parameter to OPTION." + (magit-read-string (format "Type a pattern to pass to %s" option))) + +;;;###autoload +(defun magit-log-current (revs &optional args files) + "Show log for the current branch. +When `HEAD' is detached or with a prefix argument show log for +one or more revs read from the minibuffer." + (interactive (cons (magit-log-read-revs t) + (magit-log-arguments))) + (magit-log-setup-buffer revs args files)) + +;;;###autoload +(defun magit-log-head (&optional args files) + "Show log for `HEAD'." + (interactive (magit-log-arguments)) + (magit-log-setup-buffer (list "HEAD") args files)) + +;;;###autoload +(defun magit-log-related (revs &optional args files) + "Show log for the current branch, its upstream and its push target. +When the upstream is a local branch, then also show its own +upstream. When `HEAD' is detached, then show log for that, the +previously checked out branch and its upstream and push-target." + (interactive + (cons (let ((current (magit-get-current-branch)) + head rebase target upstream upup) + (unless current + (setq rebase (magit-rebase--get-state-lines "head-name")) + (cond (rebase + (setq rebase (magit-ref-abbrev rebase)) + (setq current rebase) + (setq head "HEAD")) + ((setq current (magit-get-previous-branch))))) + (cond (current + (setq current + (magit--propertize-face current 'magit-branch-local)) + (setq target (magit-get-push-branch current t)) + (setq upstream (magit-get-upstream-branch current)) + (when upstream + (setq upup (and (magit-local-branch-p upstream) + (magit-get-upstream-branch upstream))))) + ((setq head "HEAD"))) + (delq nil (list current head target upstream upup))) + (magit-log-arguments))) + (magit-log-setup-buffer revs args files)) + +;;;###autoload +(defun magit-log-other (revs &optional args files) + "Show log for one or more revs read from the minibuffer. +The user can input any revision or revisions separated by a +space, or even ranges, but only branches and tags, and a +representation of the commit at point, are available as +completion candidates." + (interactive (cons (magit-log-read-revs) + (magit-log-arguments))) + (magit-log-setup-buffer revs args files)) + +;;;###autoload +(defun magit-log-branches (&optional args files) + "Show log for all local branches and `HEAD'." + (interactive (magit-log-arguments)) + (magit-log-setup-buffer (if (magit-get-current-branch) + (list "--branches") + (list "HEAD" "--branches")) + args files)) + +;;;###autoload +(defun magit-log-matching-branches (pattern &optional args files) + "Show log for all branches matching PATTERN and `HEAD'." + (interactive (cons (magit-log-read-pattern "--branches") (magit-log-arguments))) + (magit-log-setup-buffer + (list "HEAD" (format "--branches=%s" pattern)) + args files)) + +;;;###autoload +(defun magit-log-matching-tags (pattern &optional args files) + "Show log for all tags matching PATTERN and `HEAD'." + (interactive (cons (magit-log-read-pattern "--tags") (magit-log-arguments))) + (magit-log-setup-buffer + (list "HEAD" (format "--tags=%s" pattern)) + args files)) + +;;;###autoload +(defun magit-log-all-branches (&optional args files) + "Show log for all local and remote branches and `HEAD'." + (interactive (magit-log-arguments)) + (magit-log-setup-buffer (if (magit-get-current-branch) + (list "--branches" "--remotes") + (list "HEAD" "--branches" "--remotes")) + args files)) + +;;;###autoload +(defun magit-log-all (&optional args files) + "Show log for all references and `HEAD'." + (interactive (magit-log-arguments)) + (magit-log-setup-buffer (if (magit-get-current-branch) + (list "--all") + (list "HEAD" "--all")) + args files)) + +;;;###autoload +(defun magit-log-buffer-file (&optional follow beg end) + "Show log for the blob or file visited in the current buffer. +With a prefix argument or when `--follow' is an active log +argument, then follow renames. When the region is active, +restrict the log to the lines that the region touches." + (interactive + (cons current-prefix-arg + (and (region-active-p) + (magit-file-relative-name) + (not (derived-mode-p 'dired-mode)) + (save-restriction + (widen) + (list (line-number-at-pos (region-beginning)) + (line-number-at-pos + (let ((end (region-end))) + (if (char-after end) + end + ;; Ensure that we don't get the line number + ;; of a trailing newline. + (1- end))))))))) + (require 'magit) + (if-let ((file (magit-file-relative-name))) + (magit-log-setup-buffer + (list (or magit-buffer-refname + (magit-get-current-branch) + "HEAD")) + (let ((args (car (magit-log-arguments)))) + (when (and follow (not (member "--follow" args))) + (push "--follow" args)) + (when (and beg end) + (setq args (cons (format "-L%s,%s:%s" beg end file) + (cl-delete "-L" args :test + #'string-prefix-p))) + (setq file nil)) + args) + (and file (list file)) + magit-log-buffer-file-locked) + (user-error "Buffer isn't visiting a file"))) + +;;;###autoload +(defun magit-log-trace-definition (file fn rev) + "Show log for the definition at point." + (interactive (list (or (magit-file-relative-name) + (user-error "Buffer isn't visiting a file")) + (or (funcall magit-log-trace-definition-function) + (user-error "No function at point found")) + (or magit-buffer-refname + (magit-get-current-branch) + "HEAD"))) + (require 'magit) + (magit-log-setup-buffer + (list rev) + (cons (format "-L:%s%s:%s" + (string-replace ":" "\\:" (regexp-quote fn)) + (if (derived-mode-p 'lisp-mode 'emacs-lisp-mode) + ;; Git doesn't treat "-" the same way as + ;; "_", leading to false-positives such as + ;; "foo-suffix" being considered a match + ;; for "foo". Wing it. + "\\( \\|$\\)" + ;; We could use "\\b" here, but since Git + ;; already does something equivalent, that + ;; isn't necessary. + "") + file) + (cl-delete "-L" (car (magit-log-arguments)) + :test #'string-prefix-p)) + nil magit-log-buffer-file-locked)) + +(defun magit-diff-trace-definition () + "Show log for the definition at point in a diff." + (interactive) + (pcase-let ((`(,buf ,pos) (magit-diff-visit-file--noselect))) + (magit--with-temp-position buf pos + (call-interactively #'magit-log-trace-definition)))) + +;;;###autoload +(defun magit-log-merged (commit branch &optional args files) + "Show log for the merge of COMMIT into BRANCH. + +More precisely, find merge commit M that brought COMMIT into +BRANCH, and show the log of the range \"M^1..M\". If COMMIT is +directly on BRANCH, then show approximately +`magit-log-merged-commit-count' surrounding commits instead. + +This command requires git-when-merged, which is available from +https://github.com/mhagger/git-when-merged." + (interactive + (append (let ((commit (magit-read-branch-or-commit "Log merge of commit"))) + (list commit + (magit-read-other-branch "Merged into" commit))) + (magit-log-arguments))) + (unless (magit-git-executable-find "git-when-merged") + (user-error "This command requires git-when-merged (%s)" + "https://github.com/mhagger/git-when-merged")) + (let (exit m) + (with-temp-buffer + (save-excursion + (setq exit (magit-process-git t "when-merged" "-c" + (magit-abbrev-arg) + commit branch))) + (setq m (buffer-substring-no-properties (point) (line-end-position)))) + (if (zerop exit) + (magit-log-setup-buffer (list (format "%s^1..%s" m m)) + args files nil commit) + ;; Output: "<ref><lots of spaces><message>". + ;; This is not the same as `string-trim'. + (setq m (string-trim-left (substring m (string-match " " m)))) + (if (equal m "Commit is directly on this branch.") + (let* ((from (format "%s~%d" commit + (/ magit-log-merged-commit-count 2))) + (to (- (car (magit-rev-diff-count branch commit t)) + (/ magit-log-merged-commit-count 2))) + (to (if (<= to 0) + branch + (format "%s~%s" branch to)))) + (unless (magit-rev-verify-commit from) + (setq from (magit-git-string "rev-list" "--max-parents=0" + commit))) + (magit-log-setup-buffer (list (concat from ".." to)) + (cons "--first-parent" args) + files nil commit)) + (user-error "Could not find when %s was merged into %s: %s" + commit branch m))))) + +;;;; Limit Commands + +(defun magit-log-toggle-commit-limit () + "Toggle the number of commits the current log buffer is limited to. +If the number of commits is currently limited, then remove that +limit. Otherwise set it to 256." + (interactive) + (magit-log-set-commit-limit (lambda (&rest _) nil))) + +(defun magit-log-double-commit-limit () + "Double the number of commits the current log buffer is limited to." + (interactive) + (magit-log-set-commit-limit '*)) + +(defun magit-log-half-commit-limit () + "Half the number of commits the current log buffer is limited to." + (interactive) + (magit-log-set-commit-limit '/)) + +(defun magit-log-set-commit-limit (fn) + (let* ((val magit-buffer-log-args) + (arg (--first (string-match "^-n\\([0-9]+\\)?$" it) val)) + (num (and arg (string-to-number (match-string 1 arg)))) + (num (if num (funcall fn num 2) 256))) + (setq val (remove arg val)) + (setq magit-buffer-log-args + (if (and num (> num 0)) + (cons (format "-n%d" num) val) + val))) + (magit-refresh)) + +(defun magit-log-get-commit-limit (&optional args) + (and-let* ((str (--first (string-match "^-n\\([0-9]+\\)?$" it) + (or args magit-buffer-log-args)))) + (string-to-number (match-string 1 str)))) + +;;;; Mode Commands + +(defun magit-log-bury-buffer (&optional arg) + "Bury the current buffer or the revision buffer in the same frame. +Like `magit-mode-bury-buffer' (which see) but with a negative +prefix argument instead bury the revision buffer, provided it +is displayed in the current frame." + (interactive "p") + (if (< arg 0) + (let* ((buf (magit-get-mode-buffer 'magit-revision-mode)) + (win (and buf (get-buffer-window buf (selected-frame))))) + (if win + (with-selected-window win + (with-current-buffer buf + (magit-mode-bury-buffer (> (abs arg) 1)))) + (user-error "No revision buffer in this frame"))) + (magit-mode-bury-buffer (> arg 1)))) + +;;;###autoload +(defun magit-log-move-to-parent (&optional n) + "Move to the Nth parent of the current commit." + (interactive "p") + (when (derived-mode-p 'magit-log-mode) + (when (magit-section-match 'commit) + (let* ((section (magit-current-section)) + (parent-rev (format "%s^%s" (oref section value) (or n 1)))) + (if-let ((parent-hash (magit-rev-parse "--short" parent-rev))) + (if-let ((parent (--first (equal (oref it value) + parent-hash) + (magit-section-siblings section 'next)))) + (magit-section-goto parent) + (user-error + (substitute-command-keys + (concat "Parent " parent-hash " not found. Try typing " + "\\[magit-log-double-commit-limit] first")))) + (user-error "Parent %s does not exist" parent-rev)))))) + +(defun magit-log-move-to-revision (rev) + "Read a revision and move to it in current log buffer. + +If the chosen reference or revision isn't being displayed in +the current log buffer, then inform the user about that and do +nothing else. + +If invoked outside any log buffer, then display the log buffer +of the current repository first; creating it if necessary." + (interactive + (list (or (magit-completing-read + "In log, jump to" + (magit-list-refnames nil t) + nil nil nil 'magit-revision-history + (or (and-let* ((rev (magit-commit-at-point))) + (magit-rev-fixup-target rev)) + (magit-get-current-branch))) + (user-error "Nothing selected")))) + (with-current-buffer + (cond ((derived-mode-p 'magit-log-mode) + (current-buffer)) + ((and-let* ((buf (magit-get-mode-buffer 'magit-log-mode))) + (pop-to-buffer-same-window buf))) + (t + (apply #'magit-log-all-branches (magit-log-arguments)))) + (unless (magit-log-goto-commit-section (magit-rev-abbrev rev)) + (user-error "%s isn't visible in the current log buffer" rev)))) + +;;;; Shortlog Commands + +;;;###autoload (autoload 'magit-shortlog "magit-log" nil t) +(transient-define-prefix magit-shortlog () + "Show a history summary." + :man-page "git-shortlog" + :value '("--numbered" "--summary") + ["Arguments" + ("-n" "Sort by number of commits" ("-n" "--numbered")) + ("-s" "Show commit count summary only" ("-s" "--summary")) + ("-e" "Show email addresses" ("-e" "--email")) + ("-g" "Group commits by" "--group=" + :choices ("author" "committer" "trailer:")) + (7 "-f" "Format string" "--format=") + (7 "-w" "Linewrap" "-w" :class transient-option)] + ["Shortlog" + ("s" "since" magit-shortlog-since) + ("r" "range" magit-shortlog-range)]) + +(defun magit-git-shortlog (rev args) + (let ((dir default-directory)) + (with-current-buffer (get-buffer-create "*magit-shortlog*") + (setq default-directory dir) + (setq buffer-read-only t) + (let ((inhibit-read-only t)) + (erase-buffer) + (save-excursion + (magit-git-insert "shortlog" args rev)) + (switch-to-buffer-other-window (current-buffer)))))) + +;;;###autoload +(defun magit-shortlog-since (rev args) + "Show a history summary for commits since REV." + (interactive + (list (magit-read-branch-or-commit "Shortlog since" (magit-get-current-tag)) + (transient-args 'magit-shortlog))) + (magit-git-shortlog (concat rev "..") args)) + +;;;###autoload +(defun magit-shortlog-range (rev-or-range args) + "Show a history summary for commit or range REV-OR-RANGE." + (interactive + (list (magit-read-range-or-commit "Shortlog for revision or range") + (transient-args 'magit-shortlog))) + (magit-git-shortlog rev-or-range args)) + +;;; Log Mode + +(defvar magit-log-disable-graph-hack-args + '("-G" "--grep" "--author") + "Arguments which disable the graph speedup hack.") + +(defvar-keymap magit-log-mode-map + :doc "Keymap for `magit-log-mode'." + :parent magit-mode-map + "C-c C-b" #'magit-go-backward + "C-c C-f" #'magit-go-forward + "C-c C-n" #'magit-log-move-to-parent + "j" #'magit-log-move-to-revision + "=" #'magit-log-toggle-commit-limit + "+" #'magit-log-double-commit-limit + "-" #'magit-log-half-commit-limit + "q" #'magit-log-bury-buffer) + +(define-derived-mode magit-log-mode magit-mode "Magit Log" + "Mode for looking at Git log. + +This mode is documented in info node `(magit)Log Buffer'. + +\\<magit-mode-map>\ +Type \\[magit-refresh] to refresh the current buffer. +Type \\[magit-visit-thing] or \\[magit-diff-show-or-scroll-up] \ +to visit the commit at point. + +Type \\[magit-branch] to see available branch commands. +Type \\[magit-merge] to merge the branch or commit at point. +Type \\[magit-cherry-pick] to apply the commit at point. +Type \\[magit-reset] to reset `HEAD' to the commit at point. + +\\{magit-log-mode-map}" + :group 'magit-log + (hack-dir-local-variables-non-file-buffer) + (setq magit--imenu-item-types 'commit)) + +(put 'magit-log-mode 'magit-log-default-arguments + '("--graph" "-n256" "--decorate")) + +(defun magit-log-setup-buffer (revs args files &optional locked focus) + (require 'magit) + (with-current-buffer + (magit-setup-buffer #'magit-log-mode locked + (magit-buffer-revisions revs) + (magit-buffer-log-args args) + (magit-buffer-log-files files)) + (when (if focus + (magit-log-goto-commit-section focus) + (magit-log-goto-same-commit)) + (magit-section-update-highlight)) + (current-buffer))) + +(defun magit-log-refresh-buffer () + (let ((revs magit-buffer-revisions) + (args magit-buffer-log-args) + (files magit-buffer-log-files) + (limit (magit-log-get-commit-limit))) + (magit-set-header-line-format + (funcall magit-log-header-line-function revs args files)) + (unless (length= files 1) + (setq args (remove "--follow" args))) + (when (and (car magit-log-remove-graph-args) + (--any-p (string-match-p + (concat "^" (regexp-opt magit-log-remove-graph-args)) it) + args)) + (setq args (remove "--graph" args))) + (setq args (magit-log--maybe-drop-color-graph args limit)) + (when-let* ((limit limit) + (limit (* 2 limit)) ; increase odds for complete graph + (count (and (length= revs 1) + (> limit 1024) ; otherwise it's fast enough + (setq revs (car revs)) + (not (string-search ".." revs)) + (not (member revs '("--all" "--branches"))) + (not (seq-some + (lambda (arg) + (--any-p (string-prefix-p it arg) + magit-log-disable-graph-hack-args)) + args)) + (magit-git-string "rev-list" "--count" + "--first-parent" args revs)))) + (setq revs (if (< (string-to-number count) limit) + revs + (format "%s~%s..%s" revs limit revs)))) + (let ((delay (cl-find-if (lambda (arg) + (member arg '("++header" "--patch" "--stat"))) + args))) + (setq magit-section-inhibit-markers (if delay 'delay t)) + (setq magit-section-insert-in-reverse (not delay))) + (magit-insert-section (logbuf) + (magit--insert-log t revs args files)))) + +(defvar-local magit-log--color-graph nil) + +(defun magit-log--maybe-drop-color-graph (args limit) + (if (member "--color" args) + (if (cond ((not (member "--graph" args))) + ((not magit-log-color-graph-limit) nil) + ((not limit) + (message "Dropping --color because -n isn't set (see %s)" + 'magit-log-color-graph-limit)) + ((> limit magit-log-color-graph-limit) + (message "Dropping --color because -n is larger than %s" + 'magit-log-color-graph-limit))) + (progn (setq args (remove "--color" args)) + (setq magit-log--color-graph nil)) + (setq magit-log--color-graph t)) + (setq magit-log--color-graph nil)) + args) + +(cl-defmethod magit-buffer-value (&context (major-mode magit-log-mode)) + (append magit-buffer-revisions + (if (and magit-buffer-revisions magit-buffer-log-files) + (cons "--" magit-buffer-log-files) + magit-buffer-log-files))) + +(defun magit-log-header-line-arguments (revs args files) + "Return string describing some of the used arguments." + (mapconcat (lambda (arg) + (if (string-search " " arg) + (prin1 arg) + arg)) + `("git" "log" ,@args ,@revs "--" ,@files) + " ")) + +(defun magit-log-header-line-sentence (revs args files) + "Return string containing all arguments." + (concat "Commits in " + (string-join revs " ") + (and (member "--reverse" args) + " in reverse") + (and files (concat " touching " + (string-join files " "))) + (--some (and (string-prefix-p "-L" it) + (concat " " it)) + args))) + +(defun magit-insert-log (revs &optional args files) + (declare (obsolete magit--insert-log "Magit 4.0.0")) + (magit--insert-log nil revs args files)) + +(defun magit--insert-log (keep-error revs &optional args files) + "Insert a log section. +Do not add this to a hook variable." + (declare (indent defun)) + (setq magit-section-preserve-visibility t) ; TODO do it here? + (let ((magit-git-global-arguments + (remove "--literal-pathspecs" magit-git-global-arguments))) + (magit--git-wash (apply-partially #'magit-log-wash-log 'log) keep-error + "log" + (format "--format=%s%%h%%x0c%s%%x0c%s%%x0c%%aN%%x0c%s%%x0c%%s%s" + (if (and (member "--left-right" args) + (not (member "--graph" args))) + "%m " + "") + (if (member "--decorate" args) "%D" "") + (if (not (member "--show-signature" args)) + "" + (setq args (remove "--show-signature" args)) + (let ((limit (magit-log-get-commit-limit args))) + (cond + ((not limit) + (message + "Dropping --show-signature because -n isn't set (see %s)" + 'magit-log-show-signatures-limit) + "") + ((> limit magit-log-show-signatures-limit) + (message + "Dropping --show-signature because -n is larger than %s" + 'magit-log-show-signatures-limit) + "") + ("%G?")))) + (if magit-log-margin-show-committer-date "%ct" "%at") + (if (member "++header" args) + (if (member "--graph" (setq args (remove "++header" args))) + (concat "\n" magit-log-revision-headers-format "\n") + (concat "\n" magit-log-revision-headers-format "\n")) + "")) + (progn + (when-let ((order (--first (string-match "^\\+\\+order=\\(.+\\)$" it) + args))) + (setq args (cons (format "--%s-order" (match-string 1 order)) + (remove order args)))) + (when (member "--decorate" args) + (setq args (cons "--decorate=full" (remove "--decorate" args)))) + (when (member "--reverse" args) + (setq args (remove "--graph" args))) + (setq args (magit-diff--maybe-add-stat-arguments args)) + args) + "--use-mailmap" "--no-prefix" revs "--" files))) + +(cl-defmethod magit-menu-common-value ((_section magit-commit-section)) + (or (magit-diff--region-range) + (oref (magit-current-section) value))) + +(defvar-keymap magit-commit-section-map + :doc "Keymap for `commit' sections." + "<remap> <magit-visit-thing>" #'magit-show-commit + "<3>" (magit-menu-item "Apply %x" #'magit-cherry-apply) + "<2>" (magit-menu-item "Show commit %x" #'magit-show-commit + '(:visible (not (region-active-p)))) + "<1>" (magit-menu-item "Diff %x" #'magit-diff-range + '(:visible (region-active-p)))) + +(defvar-keymap magit-module-commit-section-map + :doc "Keymap for `module-commit' sections." + :parent magit-commit-section-map) + +(defconst magit-log-heading-re + ;; Note: A form feed instead of a null byte is used as the delimiter + ;; because using the latter interferes with the graph prefix when + ;; ++header is used. + (concat "^" + "\\(?4:[-_/|\\*o<>. ]*\\)" ; graph + "\\(?1:[0-9a-fA-F]+\\)? " ; hash + "\\(?3:[^ \n]+\\)? " ; refs + "\\(?7:[BGUXYREN]\\)? " ; gpg + "\\(?5:[^ \n]*\\) " ; author + ;; Note: Date is optional because, prior to Git v2.19.0, + ;; `git rebase -i --root` corrupts the root's author date. + "\\(?6:[^ \n]*\\) " ; date + "\\(?2:.*\\)$")) ; msg + +(defconst magit-log-cherry-re + (concat "^" + "\\(?8:[-+]\\) " ; cherry + "\\(?1:[0-9a-fA-F]+\\) " ; hash + "\\(?2:.*\\)$")) ; msg + +(defconst magit-log-module-re + (concat "^" + "\\(?:\\(?11:[<>]\\) \\)?" ; side + "\\(?1:[0-9a-fA-F]+\\) " ; hash + "\\(?2:.*\\)$")) ; msg + +(defconst magit-log-bisect-vis-re + (concat "^" + "\\(?4:[-_/|\\*o<>. ]*\\)" ; graph + "\\(?1:[0-9a-fA-F]+\\)?\0" ; hash + "\\(?3:[^\0\n]+\\)?\0" ; refs + "\\(?2:.*\\)$")) ; msg + +(defconst magit-log-bisect-log-re + (concat "^# " + "\\(?3:[^: \n]+:\\) " ; "refs" + "\\[\\(?1:[^]\n]+\\)\\] " ; hash + "\\(?2:.*\\)$")) ; msg + +(defconst magit-log-reflog-re + (concat "^" + "\\(?1:[^\0\n]+\\)\0" ; hash + "\\(?5:[^\0\n]*\\)\0" ; author + "\\(?:\\(?:[^@\n]+@{\\(?6:[^}\n]+\\)}\0" ; date + ;;; refsub + "\\(?10:merge \\|autosave \\|restart \\|rewritten \\|[^:\n]+: \\)?" + "\\(?2:.*\\)\\)\\|\0\\)$")) ; msg + +(defconst magit-reflog-subject-re + (concat "\\(?1:[^ ]+\\) ?" ; command + "\\(?2:\\(?: ?-[^ ]+\\)+\\)?" ; option + "\\(?: ?(\\(?3:[^)]+\\))\\)?")) ; type + +(defconst magit-log-stash-re + (concat "^" + "\\(?1:[^\0\n]+\\)\0" ; "hash" + "\\(?5:[^\0\n]*\\)\0" ; author + "\\(?6:[^\0\n]+\\)\0" ; date + "\\(?2:.*\\)$")) ; msg + +(defvar magit-log-count nil) + +(defvar magit-log-format-message-function #'magit-log-propertize-keywords) + +(defun magit-log-wash-log (style args) + (setq args (flatten-tree args)) + (when (if (derived-mode-p 'magit-log-mode) + magit-log--color-graph + (and (member "--graph" args) + (member "--color" args))) + (let ((ansi-color-apply-face-function + (lambda (beg end face) + (put-text-property beg end 'font-lock-face + (or face 'magit-log-graph))))) + (ansi-color-apply-on-region (point-min) (point-max)))) + (when (eq style 'cherry) + (reverse-region (point-min) (point-max))) + (let ((magit-log-count 0)) + (when (looking-at "^\\.\\.\\.") + (magit-delete-line)) + (magit-wash-sequence (apply-partially #'magit-log-wash-rev style + (magit-abbrev-length))) + (if (derived-mode-p 'magit-log-mode 'magit-reflog-mode) + (when (eq magit-log-count (magit-log-get-commit-limit)) + (magit-insert-section (longer) + (insert-text-button + (substitute-command-keys + (format "Type \\<%s>\\[%s] to show more history" + 'magit-log-mode-map + 'magit-log-double-commit-limit)) + 'action (lambda (_button) + (magit-log-double-commit-limit)) + 'follow-link t + 'mouse-face 'magit-section-highlight))) + (insert ?\n)))) + +(cl-defun magit-log-wash-rev (style abbrev) + (when (derived-mode-p 'magit-log-mode 'magit-reflog-mode) + (cl-incf magit-log-count)) + (looking-at (pcase style + ('log magit-log-heading-re) + ('cherry magit-log-cherry-re) + ('module magit-log-module-re) + ('reflog magit-log-reflog-re) + ('stash magit-log-stash-re) + ('bisect-vis magit-log-bisect-vis-re) + ('bisect-log magit-log-bisect-log-re))) + (magit-bind-match-strings + (hash msg refs graph author date gpg cherry _ refsub side) nil + (setq msg (substring-no-properties msg)) + (when refs + (setq refs (substring-no-properties refs))) + (let ((align (or (eq style 'cherry) + (not (member "--stat" magit-buffer-log-args)))) + (non-graph-re (if (eq style 'bisect-vis) + magit-log-bisect-vis-re + magit-log-heading-re))) + (magit-delete-line) + ;; If the reflog entries have been pruned, the output of `git + ;; reflog show' includes a partial line that refers to the hash + ;; of the youngest expired reflog entry. + (when (and (eq style 'reflog) (not date)) + (cl-return-from magit-log-wash-rev t)) + (magit-insert-section + ((eval (pcase style + ('stash 'stash) + ('module 'module-commit) + (_ 'commit))) + hash) + (setq hash (propertize (if (eq style 'bisect-log) + (magit-rev-parse "--short" hash) + hash) + 'font-lock-face + (pcase (and gpg (aref gpg 0)) + (?G 'magit-signature-good) + (?B 'magit-signature-bad) + (?U 'magit-signature-untrusted) + (?X 'magit-signature-expired) + (?Y 'magit-signature-expired-key) + (?R 'magit-signature-revoked) + (?E 'magit-signature-error) + (?N 'magit-hash) + (_ 'magit-hash)))) + (when cherry + (when (and (derived-mode-p 'magit-refs-mode) + magit-refs-show-commit-count) + (insert (make-string (1- magit-refs-focus-column-width) ?\s))) + (insert (propertize cherry 'font-lock-face + (if (string= cherry "-") + 'magit-cherry-equivalent + 'magit-cherry-unmatched))) + (insert ?\s)) + (when side + (insert (propertize side 'font-lock-face + (if (string= side "<") + 'magit-cherry-equivalent + 'magit-cherry-unmatched))) + (insert ?\s)) + (when align + (insert hash ?\s)) + (when graph + (insert graph)) + (unless align + (insert hash ?\s)) + (when (and refs (not magit-log-show-refname-after-summary)) + (insert (magit-format-ref-labels refs) ?\s)) + (when (eq style 'reflog) + (insert (format "%-2s " (1- magit-log-count))) + (when refsub + (insert (magit-reflog-format-subject + (substring refsub 0 + (if (string-search ":" refsub) -2 -1)))))) + (insert (funcall magit-log-format-message-function hash msg)) + (when (and refs magit-log-show-refname-after-summary) + (insert ?\s) + (insert (magit-format-ref-labels refs))) + (insert ?\n) + (when (memq style '(log reflog stash)) + (goto-char (line-beginning-position)) + (when (and refsub + (string-match "\\`\\([^ ]\\) \\+\\(..\\)\\(..\\)" date)) + (setq date (+ (string-to-number (match-string 1 date)) + (* (string-to-number (match-string 2 date)) 60 60) + (* (string-to-number (match-string 3 date)) 60)))) + (save-excursion + (backward-char) + (magit-log-format-margin hash author date))) + (when (and (eq style 'cherry) + (magit-buffer-margin-p)) + (save-excursion + (backward-char) + (apply #'magit-log-format-margin hash + (split-string (magit-rev-format "%aN%x00%ct" hash) "\0")))) + (when (and graph + (not (eobp)) + (not (looking-at non-graph-re))) + (when (looking-at "") + (magit-insert-heading) + (delete-char 1) + (magit-insert-section (commit-header) + (forward-line) + (magit-insert-heading) + (re-search-forward "") + (delete-char -1) + (forward-char) + (insert ?\n)) + (delete-char 1)) + (if (looking-at "^\\(---\\|\n\s\\|\ndiff\\)") + (let ((limit (save-excursion + (and (re-search-forward non-graph-re nil t) + (match-beginning 0))))) + (unless (oref magit-insert-section--current content) + (magit-insert-heading)) + (delete-char (if (looking-at "\n") 1 4)) + (magit-diff-wash-diffs (list "--stat") limit)) + (when align + (setq align (make-string (1+ abbrev) ? ))) + (when (and (not (eobp)) (not (looking-at non-graph-re))) + (when align + (setq align (make-string (1+ abbrev) ? ))) + (while (and (not (eobp)) (not (looking-at non-graph-re))) + (when align + (save-excursion (insert align))) + (magit-make-margin-overlay) + (forward-line)) + ;; When `--format' is used and its value isn't one of the + ;; predefined formats, then `git-log' does not insert a + ;; separator line. + (save-excursion + (forward-line -1) + (looking-at "[-_/|\\*o<>. ]*")) + (setq graph (match-string 0)) + (unless (string-match-p "[/\\.]" graph) + (insert graph ?\n)))))))) + t) + +(defun magit-log-propertize-keywords (_rev msg) + (let ((boundary 0)) + (when (string-match "^\\(?:squash\\|fixup\\)! " msg boundary) + (setq boundary (match-end 0)) + (magit--put-face (match-beginning 0) (1- boundary) + 'magit-keyword-squash msg)) + (when magit-log-highlight-keywords + (while (string-match "\\[[^][]*]" msg boundary) + (setq boundary (match-end 0)) + (magit--put-face (match-beginning 0) boundary + 'magit-keyword msg)))) + msg) + +(defun magit-log-maybe-show-more-commits (section) + "When point is at the end of a log buffer, insert more commits. + +Log buffers end with a button \"Type + to show more history\". +When the use of a section movement command puts point on that +button, then automatically show more commits, without the user +having to press \"+\". + +This function is called by `magit-section-movement-hook' and +exists mostly for backward compatibility reasons." + (when (and (eq (oref section type) 'longer) + magit-log-auto-more) + (magit-log-double-commit-limit) + (forward-line -1) + (magit-section-forward))) + +(add-hook 'magit-section-movement-hook #'magit-log-maybe-show-more-commits) + +(defvar magit--update-revision-buffer nil) + +(defun magit-log-maybe-update-revision-buffer (&optional _) + "When moving in a log or cherry buffer, update the revision buffer. +If there is no revision buffer in the same frame, then do nothing." + (when (derived-mode-p 'magit-log-mode 'magit-cherry-mode 'magit-reflog-mode) + (magit--maybe-update-revision-buffer))) + +(add-hook 'magit-section-movement-hook #'magit-log-maybe-update-revision-buffer) + +(defun magit--maybe-update-revision-buffer () + (when-let* ((commit (magit-section-value-if 'commit)) + (buffer (magit-get-mode-buffer 'magit-revision-mode nil t))) + (if magit--update-revision-buffer + (setq magit--update-revision-buffer (list commit buffer)) + (setq magit--update-revision-buffer (list commit buffer)) + (run-with-idle-timer + magit-update-other-window-delay nil + (let ((args (let ((magit-direct-use-buffer-arguments 'selected)) + (magit-show-commit--arguments)))) + (lambda () + (pcase-let ((`(,rev ,buf) magit--update-revision-buffer)) + (setq magit--update-revision-buffer nil) + (when (buffer-live-p buf) + (let ((magit-display-buffer-noselect t)) + (apply #'magit-show-commit rev args)))) + (setq magit--update-revision-buffer nil))))))) + +(defvar magit--update-blob-buffer nil) + +(defun magit-log-maybe-update-blob-buffer (&optional _) + "When moving in a log or cherry buffer, update the blob buffer. +If there is no blob buffer in the same frame, then do nothing." + (when (derived-mode-p 'magit-log-mode 'magit-cherry-mode 'magit-reflog-mode) + (magit--maybe-update-blob-buffer))) + +(defun magit--maybe-update-blob-buffer () + (when-let* ((commit (magit-section-value-if 'commit)) + (buffer (--first (with-current-buffer it + (eq revert-buffer-function + 'magit-revert-rev-file-buffer)) + (mapcar #'window-buffer (window-list))))) + (if magit--update-blob-buffer + (setq magit--update-blob-buffer (list commit buffer)) + (setq magit--update-blob-buffer (list commit buffer)) + (run-with-idle-timer + magit-update-other-window-delay nil + (lambda () + (pcase-let ((`(,rev ,buf) magit--update-blob-buffer)) + (setq magit--update-blob-buffer nil) + (when (buffer-live-p buf) + (with-selected-window (get-buffer-window buf) + (with-current-buffer buf + (save-excursion + (magit-blob-visit (list (magit-rev-parse rev) + (magit-file-relative-name + magit-buffer-file-name))))))))))))) + +(defun magit-log-goto-commit-section (rev) + (let ((abbrev (magit-rev-format "%h" rev))) + (when-let ((section (--first (equal (oref it value) abbrev) + (oref magit-root-section children)))) + (goto-char (oref section start))))) + +(defun magit-log-goto-same-commit () + (when (and magit-previous-section + (magit-section-match '(commit branch) + magit-previous-section)) + (magit-log-goto-commit-section (oref magit-previous-section value)))) + +;;; Log Margin + +(defvar-local magit-log-margin-show-shortstat nil) + +(transient-define-suffix magit-toggle-log-margin-style () + "Toggle between the regular and the shortstat margin style. +The shortstat style is experimental and rather slow." + :description "Toggle shortstat" + :key "x" + :transient t + (interactive) + (setq magit-log-margin-show-shortstat + (not magit-log-margin-show-shortstat)) + (magit-set-buffer-margin nil t)) + +(defun magit-log-format-margin (rev author date) + (when (magit-margin-option) + (if magit-log-margin-show-shortstat + (magit-log-format-shortstat-margin rev) + (magit-log-format-author-margin author date)))) + +(defun magit-log-format-author-margin (author date &optional previous-line) + (pcase-let ((`(,_ ,style ,width ,details ,details-width) + (or magit-buffer-margin + (symbol-value (magit-margin-option)) + (error "No margin format specified for %s" major-mode)))) + (magit-make-margin-overlay + (concat (and details + (concat (magit--propertize-face + (truncate-string-to-width + (or author "") + details-width + nil ?\s + (magit--ellipsis 'margin)) + 'magit-log-author) + " ")) + (magit--propertize-face + (if (stringp style) + (format-time-string + style + (seconds-to-time (string-to-number date))) + (pcase-let* ((abbr (eq style 'age-abbreviated)) + (`(,cnt ,unit) (magit--age date abbr))) + (format (format (if abbr "%%2d%%-%dc" "%%2d %%-%ds") + (- width (if details (1+ details-width) 0))) + cnt unit))) + 'magit-log-date)) + previous-line))) + +(defun magit-log-format-shortstat-margin (rev) + (magit-make-margin-overlay + (if-let ((line (and rev (magit-git-string + "show" "--format=" "--shortstat" rev)))) + (if (string-match "\ +\\([0-9]+\\) files? changed, \ +\\(?:\\([0-9]+\\) insertions?(\\+)\\)?\ +\\(?:\\(?:, \\)?\\([0-9]+\\) deletions?(-)\\)?\\'" line) + (magit-bind-match-strings (files add del) line + (format + "%5s %5s%4s" + (if add + (magit--propertize-face (format "%s+" add) + 'magit-diffstat-added) + "") + (if del + (magit--propertize-face (format "%s-" del) + 'magit-diffstat-removed) + "") + files)) + "") + ""))) + +(defun magit-log-margin-width (style details details-width) + (if magit-log-margin-show-shortstat + 16 + (+ (if details (1+ details-width) 0) + (if (stringp style) + (length (format-time-string style)) + (+ 2 ; two digits + 1 ; trailing space + (if (eq style 'age-abbreviated) + 1 ; single character + (+ 1 ; gap after digits + (apply #'max (--map (max (length (nth 1 it)) + (length (nth 2 it))) + magit--age-spec))))))))) + +;;; Select Mode + +(defvar-keymap magit-log-select-mode-map + :doc "Keymap for `magit-log-select-mode'." + :parent magit-log-mode-map + "C-c C-b" #'undefined + "C-c C-f" #'undefined + "." #'magit-log-select-pick + "e" #'magit-log-select-pick + "C-c C-c" #'magit-log-select-pick + "q" #'magit-log-select-quit + "C-c C-k" #'magit-log-select-quit) +(put 'magit-log-select-pick :advertised-binding [?\C-c ?\C-c]) +(put 'magit-log-select-quit :advertised-binding [?\C-c ?\C-k]) + +(define-derived-mode magit-log-select-mode magit-log-mode "Magit Select" + "Mode for selecting a commit from history. + +This mode is documented in info node `(magit)Select from Log'. + +\\<magit-mode-map>\ +Type \\[magit-refresh] to refresh the current buffer. +Type \\[magit-visit-thing] or \\[magit-diff-show-or-scroll-up] \ +to visit the commit at point. + +\\<magit-log-select-mode-map>\ +Type \\[magit-log-select-pick] to select the commit at point. +Type \\[magit-log-select-quit] to abort without selecting a commit." + :group 'magit-log + (hack-dir-local-variables-non-file-buffer)) + +(put 'magit-log-select-mode 'magit-log-default-arguments + '("--graph" "-n256" "--decorate")) + +(defun magit-log-select-setup-buffer (revs args) + (magit-setup-buffer #'magit-log-select-mode nil + (magit-buffer-revisions revs) + (magit-buffer-log-args args))) + +(defun magit-log-select-refresh-buffer () + (setq magit-section-inhibit-markers t) + (setq magit-section-insert-in-reverse t) + (magit-insert-section (logbuf) + (magit--insert-log t magit-buffer-revisions + (magit-log--maybe-drop-color-graph + magit-buffer-log-args + (magit-log-get-commit-limit))))) + +(cl-defmethod magit-buffer-value (&context (major-mode magit-log-select-mode)) + magit-buffer-revisions) + +(defvar-local magit-log-select-pick-function nil) +(defvar-local magit-log-select-quit-function nil) + +(defun magit-log-select (pick &optional msg quit branch args initial) + (declare (indent defun)) + (unless initial + (setq initial (magit-commit-at-point))) + (magit-log-select-setup-buffer + (or branch (magit-get-current-branch) "HEAD") + (append args + (car (magit-log--get-value 'magit-log-select-mode + magit-direct-use-buffer-arguments)))) + (when initial + (magit-log-goto-commit-section initial)) + (setq magit-log-select-pick-function pick) + (setq magit-log-select-quit-function quit) + (when magit-log-select-show-usage + (let ((pick (propertize (substitute-command-keys + "\\[magit-log-select-pick]") + 'font-lock-face + 'magit-header-line-key)) + (quit (propertize (substitute-command-keys + "\\[magit-log-select-quit]") + 'font-lock-face + 'magit-header-line-key))) + (setq msg (format-spec + (if msg + (if (string-suffix-p "," msg) + (concat msg " or %q to abort") + msg) + "Type %p to select commit at point, or %q to abort") + `((?p . ,pick) + (?q . ,quit))))) + (magit--add-face-text-property + 0 (length msg) 'magit-header-line-log-select t msg) + (when (memq magit-log-select-show-usage '(both header-line)) + (magit-set-header-line-format msg)) + (when (memq magit-log-select-show-usage '(both echo-area)) + (message "%s" (substring-no-properties msg))))) + +(defun magit-log-select-pick () + "Select the commit at point and act on it. +Call `magit-log-select-pick-function' with the selected +commit as argument." + (interactive) + (let ((fun magit-log-select-pick-function) + (rev (magit-commit-at-point))) + (magit-mode-bury-buffer 'kill) + (funcall fun rev))) + +(defun magit-log-select-quit () + "Abort selecting a commit, don't act on any commit. +Call `magit-log-select-quit-function' if set." + (interactive) + (let ((fun magit-log-select-quit-function)) + (magit-mode-bury-buffer 'kill) + (when fun (funcall fun)))) + +;;; Cherry Mode + +(defvar-keymap magit-cherry-mode-map + :doc "Keymap for `magit-cherry-mode'." + :parent magit-mode-map + "q" #'magit-log-bury-buffer + "L" #'magit-margin-settings) + +(define-derived-mode magit-cherry-mode magit-mode "Magit Cherry" + "Mode for looking at commits not merged upstream. + +\\<magit-mode-map>\ +Type \\[magit-refresh] to refresh the current buffer. +Type \\[magit-visit-thing] or \\[magit-diff-show-or-scroll-up] \ +to visit the commit at point. + +Type \\[magit-cherry-pick] to apply the commit at point. + +\\{magit-cherry-mode-map}" + :group 'magit-log + (hack-dir-local-variables-non-file-buffer) + (setq magit--imenu-group-types 'cherries)) + +(defun magit-cherry-setup-buffer (head upstream) + (magit-setup-buffer #'magit-cherry-mode nil + (magit-buffer-refname head) + (magit-buffer-upstream upstream) + (magit-buffer-range (concat upstream ".." head)))) + +(defun magit-cherry-refresh-buffer () + (setq magit-section-insert-in-reverse t) + (magit-insert-section (cherry) + (magit-run-section-hook 'magit-cherry-sections-hook))) + +(cl-defmethod magit-buffer-value (&context (major-mode magit-cherry-mode)) + magit-buffer-range) + +;;;###autoload +(defun magit-cherry (head upstream) + "Show commits in a branch that are not merged in the upstream branch." + (interactive + (let ((head (magit-read-branch "Cherry head"))) + (list head (magit-read-other-branch "Cherry upstream" head + (magit-get-upstream-branch head))))) + (require 'magit) + (magit-cherry-setup-buffer head upstream)) + +(defun magit-insert-cherry-headers () + "Insert headers appropriate for `magit-cherry-mode' buffers." + (let ((branch (propertize magit-buffer-refname + 'font-lock-face 'magit-branch-local)) + (upstream (propertize magit-buffer-upstream 'font-lock-face + (if (magit-local-branch-p magit-buffer-upstream) + 'magit-branch-local + 'magit-branch-remote)))) + (magit-insert-head-branch-header branch) + (magit-insert-upstream-branch-header branch upstream "Upstream: ") + (insert ?\n))) + +(defun magit-insert-cherry-commits () + "Insert commit sections into a `magit-cherry-mode' buffer." + (magit-insert-section (cherries) + (magit-insert-heading t "Cherry commits") + (magit-git-wash (apply-partially #'magit-log-wash-log 'cherry) + "cherry" "-v" "--abbrev" + magit-buffer-upstream + magit-buffer-refname))) + +;;; Log Sections +;;;; Standard Log Sections + +(defvar-keymap magit-log-section-map + :doc "Keymap for log sections. +The classes `magit-{unpulled,unpushed,unmerged}-section' derive +from the abstract `magit-log-section' class. Accordingly this +keymap is the parent of their keymaps." + "<remap> <magit-visit-thing>" #'magit-diff-dwim + "<1>" (magit-menu-item "Visit diff" #'magit-diff-dwim)) + +(cl-defmethod magit-section-ident-value ((section magit-unpulled-section)) + "\"..@{push}\" cannot be used as the value because that is +ambiguous if `push.default' does not allow a 1:1 mapping, and +many commands would fail because of that. But here that does +not matter and we need an unique value so we use that string +in the pushremote case." + (let ((value (oref section value))) + (if (equal value "..@{upstream}") value "..@{push}"))) + +(magit-define-section-jumper magit-jump-to-unpulled-from-upstream + "Unpulled from @{upstream}" unpulled "..@{upstream}" + magit-insert-unpulled-from-upstream) + +(defun magit-insert-unpulled-from-upstream () + "Insert commits that haven't been pulled from the upstream yet." + (when-let ((upstream (magit-get-upstream-branch))) + (magit-insert-section (unpulled "..@{upstream}" t) + (magit-insert-heading + (format (propertize "Unpulled from %s." + 'font-lock-face 'magit-section-heading) + upstream)) + (magit--insert-log nil "..@{upstream}" magit-buffer-log-args) + (magit-log-insert-child-count)))) + +(magit-define-section-jumper magit-jump-to-unpulled-from-pushremote + "Unpulled from <push-remote>" unpulled "..@{push}" + magit-insert-unpulled-from-pushremote) + +(defun magit-insert-unpulled-from-pushremote () + "Insert commits that haven't been pulled from the push-remote yet." + (when-let* ((target (magit-get-push-branch)) + (range (concat ".." target))) + (when (magit--insert-pushremote-log-p) + (magit-insert-section (unpulled range t) + (magit-insert-heading + (format (propertize "Unpulled from %s." + 'font-lock-face 'magit-section-heading) + (propertize target 'font-lock-face 'magit-branch-remote))) + (magit--insert-log nil range magit-buffer-log-args) + (magit-log-insert-child-count))))) + +(cl-defmethod magit-section-ident-value ((section magit-unpushed-section)) + "\"..@{push}\" cannot be used as the value because that is +ambiguous if `push.default' does not allow a 1:1 mapping, and +many commands would fail because of that. But here that does +not matter and we need an unique value so we use that string +in the pushremote case." + (let ((value (oref section value))) + (if (equal value "@{upstream}..") value "@{push}.."))) + +(magit-define-section-jumper magit-jump-to-unpushed-to-upstream + "Unpushed to @{upstream}" unpushed "@{upstream}.." nil + :if (lambda () + (or (memq 'magit-insert-unpushed-to-upstream-or-recent + magit-status-sections-hook) + (memq 'magit-insert-unpushed-to-upstream + magit-status-sections-hook))) + :description (lambda () + (let ((upstream (magit-get-upstream-branch))) + (if (or (not upstream) + (magit-rev-ancestor-p "HEAD" upstream)) + "Recent commits" + "Unmerged into upstream")))) + +(defun magit-insert-unpushed-to-upstream-or-recent () + "Insert section showing unpushed or other recent commits. +If an upstream is configured for the current branch and it is +behind of the current branch, then show the commits that have +not yet been pushed into the upstream branch. If no upstream is +configured or if the upstream is not behind of the current branch, +then show the last `magit-log-section-commit-count' commits." + (let ((upstream (magit-get-upstream-branch))) + (if (or (not upstream) + (magit-rev-ancestor-p "HEAD" upstream)) + (magit-insert-recent-commits 'unpushed "@{upstream}..") + (magit-insert-unpushed-to-upstream)))) + +(defun magit-insert-unpushed-to-upstream () + "Insert commits that haven't been pushed to the upstream yet." + (when (magit-git-success "rev-parse" "@{upstream}") + (magit-insert-section (unpushed "@{upstream}..") + (magit-insert-heading + (format (propertize "Unmerged into %s." + 'font-lock-face 'magit-section-heading) + (magit-get-upstream-branch))) + (magit--insert-log nil "@{upstream}.." magit-buffer-log-args) + (magit-log-insert-child-count)))) + +(defun magit-insert-recent-commits (&optional type value) + "Insert section showing recent commits. +Show the last `magit-log-section-commit-count' commits." + (let* ((start (format "HEAD~%s" magit-log-section-commit-count)) + (range (and (magit-rev-verify start) + (concat start "..HEAD")))) + (magit-insert-section ((eval (or type 'recent)) + (or value range) + t) + (magit-insert-heading "Recent commits") + (magit--insert-log nil range + (cons (format "-n%d" magit-log-section-commit-count) + (--remove (string-prefix-p "-n" it) + magit-buffer-log-args)))))) + +(magit-define-section-jumper magit-jump-to-unpushed-to-pushremote + "Unpushed to <push-remote>" unpushed "@{push}.." + magit-insert-unpushed-to-pushremote) + +(defun magit-insert-unpushed-to-pushremote () + "Insert commits that haven't been pushed to the push-remote yet." + (when-let* ((target (magit-get-push-branch)) + (range (concat target ".."))) + (when (magit--insert-pushremote-log-p) + (magit-insert-section (unpushed range t) + (magit-insert-heading + (format (propertize "Unpushed to %s." + 'font-lock-face 'magit-section-heading) + (propertize target 'font-lock-face 'magit-branch-remote))) + (magit--insert-log nil range magit-buffer-log-args) + (magit-log-insert-child-count))))) + +(defun magit--insert-pushremote-log-p () + (magit--with-refresh-cache + (cons default-directory 'magit--insert-pushremote-log-p) + (not (and (equal (magit-get-push-branch) + (magit-get-upstream-branch)) + (or (memq 'magit-insert-unpulled-from-upstream + magit-status-sections-hook) + (memq 'magit-insert-unpulled-from-upstream-or-recent + magit-status-sections-hook)))))) + +(defun magit-log-insert-child-count () + (when magit-section-show-child-count + (let ((count (length (oref magit-insert-section--current children)))) + (when (> count 0) + (when (eq count (magit-log-get-commit-limit)) + (setq count (format "%s+" count))) + (save-excursion + (goto-char (- (oref magit-insert-section--current content) 2)) + (insert (format " (%s)" count)) + (delete-char 1)))))) + +;;;; Auxiliary Log Sections + +(defun magit-insert-unpulled-cherries () + "Insert section showing unpulled commits. +Like `magit-insert-unpulled-from-upstream' but prefix each commit +which has not been applied yet (i.e., a commit with a patch-id +not shared with any local commit) with \"+\", and all others with +\"-\"." + (when (magit-git-success "rev-parse" "@{upstream}") + (magit-insert-section (unpulled "..@{upstream}") + (magit-insert-heading t "Unpulled commits") + (magit-git-wash (apply-partially #'magit-log-wash-log 'cherry) + "cherry" "-v" (magit-abbrev-arg) + (magit-get-current-branch) "@{upstream}")))) + +(defun magit-insert-unpushed-cherries () + "Insert section showing unpushed commits. +Like `magit-insert-unpushed-to-upstream' but prefix each commit +which has not been applied to upstream yet (i.e., a commit with +a patch-id not shared with any upstream commit) with \"+\", and +all others with \"-\"." + (when (magit-git-success "rev-parse" "@{upstream}") + (magit-insert-section (unpushed "@{upstream}..") + (magit-insert-heading t "Unpushed commits") + (magit-git-wash (apply-partially #'magit-log-wash-log 'cherry) + "cherry" "-v" (magit-abbrev-arg) "@{upstream}")))) + +;;; _ +(provide 'magit-log) +;;; magit-log.el ends here diff --git a/emacs/elpa/magit-20240625.2109/magit-log.elc b/emacs/elpa/magit-20240625.2109/magit-log.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/magit-margin.el b/emacs/elpa/magit-20240625.2109/magit-margin.el diff --git a/emacs/elpa/magit-20240622.1531/magit-margin.elc b/emacs/elpa/magit-20240625.2109/magit-margin.elc Binary files differ. diff --git a/emacs/elpa/magit-20240625.2109/magit-merge.el b/emacs/elpa/magit-20240625.2109/magit-merge.el @@ -0,0 +1,315 @@ +;;; magit-merge.el --- Merge functionality -*- lexical-binding:t -*- + +;; Copyright (C) 2008-2024 The Magit Project Contributors + +;; Author: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> +;; Maintainer: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; 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. +;; +;; 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 Magit. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This library implements merge commands. + +;;; Code: + +(require 'magit) +(require 'magit-diff) + +(declare-function magit-git-push "magit-push" (branch target args)) + +;;; Commands + +;;;###autoload (autoload 'magit-merge "magit" nil t) +(transient-define-prefix magit-merge () + "Merge branches." + :man-page "git-merge" + :incompatible '(("--ff-only" "--no-ff")) + ["Arguments" + :if-not magit-merge-in-progress-p + ("-f" "Fast-forward only" "--ff-only") + ("-n" "No fast-forward" "--no-ff") + (magit-merge:--strategy) + (5 magit-merge:--strategy-option) + (5 "-b" "Ignore changes in amount of whitespace" "-Xignore-space-change") + (5 "-w" "Ignore whitespace when comparing lines" "-Xignore-all-space") + (5 magit-diff:--diff-algorithm :argument "-Xdiff-algorithm=") + (5 magit:--gpg-sign)] + ["Actions" + :if-not magit-merge-in-progress-p + [("m" "Merge" magit-merge-plain) + ("e" "Merge and edit message" magit-merge-editmsg) + ("n" "Merge but don't commit" magit-merge-nocommit) + ("a" "Absorb" magit-merge-absorb)] + [("p" "Preview merge" magit-merge-preview) + "" + ("s" "Squash merge" magit-merge-squash) + ("i" "Dissolve" magit-merge-into)]] + ["Actions" + :if magit-merge-in-progress-p + ("m" "Commit merge" magit-commit-create) + ("a" "Abort merge" magit-merge-abort)]) + +(defun magit-merge-arguments () + (transient-args 'magit-merge)) + +(transient-define-argument magit-merge:--strategy () + :description "Strategy" + :class 'transient-option + ;; key for merge and rebase: "-s" + ;; key for cherry-pick and revert: "=s" + ;; shortarg for merge and rebase: "-s" + ;; shortarg for cherry-pick and revert: none + :key "-s" + :argument "--strategy=" + :choices '("resolve" "recursive" "octopus" "ours" "subtree")) + +(transient-define-argument magit-merge:--strategy-option () + :description "Strategy Option" + :class 'transient-option + :key "-X" + :argument "--strategy-option=" + :choices '("ours" "theirs" "patience")) + +;;;###autoload +(defun magit-merge-plain (rev &optional args nocommit) + "Merge commit REV into the current branch; using default message. + +Unless there are conflicts or a prefix argument is used create a +merge commit using a generic commit message and without letting +the user inspect the result. With a prefix argument pretend the +merge failed to give the user the opportunity to inspect the +merge. + +\(git merge --no-edit|--no-commit [ARGS] REV)" + (interactive (list (magit-read-other-branch-or-commit "Merge") + (magit-merge-arguments) + current-prefix-arg)) + (magit-merge-assert) + (magit-run-git-async "merge" (if nocommit "--no-commit" "--no-edit") args rev)) + +;;;###autoload +(defun magit-merge-editmsg (rev &optional args) + "Merge commit REV into the current branch; and edit message. +Perform the merge and prepare a commit message but let the user +edit it. +\n(git merge --edit --no-ff [ARGS] REV)" + (interactive (list (magit-read-other-branch-or-commit "Merge") + (magit-merge-arguments))) + (magit-merge-assert) + (cl-pushnew "--no-ff" args :test #'equal) + (apply #'magit-run-git-with-editor "merge" "--edit" + (append (delete "--ff-only" args) + (list rev)))) + +;;;###autoload +(defun magit-merge-nocommit (rev &optional args) + "Merge commit REV into the current branch; pretending it failed. +Pretend the merge failed to give the user the opportunity to +inspect the merge and change the commit message. +\n(git merge --no-commit --no-ff [ARGS] REV)" + (interactive (list (magit-read-other-branch-or-commit "Merge") + (magit-merge-arguments))) + (magit-merge-assert) + (cl-pushnew "--no-ff" args :test #'equal) + (magit-run-git-async "merge" "--no-commit" args rev)) + +;;;###autoload +(defun magit-merge-into (branch &optional args) + "Merge the current branch into BRANCH and remove the former. + +Before merging, force push the source branch to its push-remote, +provided the respective remote branch already exists, ensuring +that the respective pull-request (if any) won't get stuck on some +obsolete version of the commits that are being merged. Finally +if `forge-branch-pullreq' was used to create the merged branch, +then also remove the respective remote branch." + (interactive + (list (magit-read-other-local-branch + (format "Merge `%s' into" + (or (magit-get-current-branch) + (magit-rev-parse "HEAD"))) + nil + (and-let* ((upstream (magit-get-upstream-branch)) + (upstream (cdr (magit-split-branch-name upstream)))) + (and (magit-branch-p upstream) upstream))) + (magit-merge-arguments))) + (let ((current (magit-get-current-branch)) + (head (magit-rev-parse "HEAD"))) + (when (zerop (magit-call-git "checkout" branch)) + (if current + (magit--merge-absorb current args) + (magit-run-git-with-editor "merge" args head))))) + +;;;###autoload +(defun magit-merge-absorb (branch &optional args) + "Merge BRANCH into the current branch and remove the former. + +Before merging, force push the source branch to its push-remote, +provided the respective remote branch already exists, ensuring +that the respective pull-request (if any) won't get stuck on some +obsolete version of the commits that are being merged. Finally +if `forge-branch-pullreq' was used to create the merged branch, +then also remove the respective remote branch." + (interactive (list (magit-read-other-local-branch "Absorb branch") + (magit-merge-arguments))) + (magit--merge-absorb branch args)) + +(defun magit--merge-absorb (branch args) + (when (equal branch (magit-main-branch)) + (unless (yes-or-no-p + (format "Do you really want to merge `%s' into another branch? " + branch)) + (user-error "Abort"))) + (if-let ((target (magit-get-push-branch branch t))) + (progn + (magit-git-push branch target (list "--force-with-lease")) + (set-process-sentinel + magit-this-process + (lambda (process event) + (when (memq (process-status process) '(exit signal)) + (if (not (zerop (process-exit-status process))) + (magit-process-sentinel process event) + (process-put process 'inhibit-refresh t) + (magit-process-sentinel process event) + (magit--merge-absorb-1 branch args)))))) + (magit--merge-absorb-1 branch args))) + +(defun magit--merge-absorb-1 (branch args) + (if-let ((pr (magit-get "branch" branch "pullRequest"))) + (magit-run-git-async + "merge" args "-m" + (format "Merge branch '%s'%s [#%s]" + branch + (let ((current (magit-get-current-branch))) + (if (equal current (magit-main-branch)) + "" + (format " into %s" current))) + pr) + branch) + (magit-run-git-async "merge" args "--no-edit" branch)) + (set-process-sentinel + magit-this-process + (lambda (process event) + (when (memq (process-status process) '(exit signal)) + (if (> (process-exit-status process) 0) + (magit-process-sentinel process event) + (process-put process 'inhibit-refresh t) + (magit-process-sentinel process event) + (magit-branch-maybe-delete-pr-remote branch) + (magit-branch-unset-pushRemote branch) + (magit-run-git "branch" "-D" branch)))))) + +;;;###autoload +(defun magit-merge-squash (rev) + "Squash commit REV into the current branch; don't create a commit. +\n(git merge --squash REV)" + (interactive (list (magit-read-other-branch-or-commit "Squash"))) + (magit-merge-assert) + (magit-run-git-async "merge" "--squash" rev)) + +;;;###autoload +(defun magit-merge-preview (rev) + "Preview result of merging REV into the current branch." + (interactive (list (magit-read-other-branch-or-commit "Preview merge"))) + (magit-merge-preview-setup-buffer rev)) + +;;;###autoload +(defun magit-merge-abort () + "Abort the current merge operation. +\n(git merge --abort)" + (interactive) + (unless (file-exists-p (expand-file-name "MERGE_HEAD" (magit-gitdir))) + (user-error "No merge in progress")) + (magit-confirm 'abort-merge) + (magit-run-git-async "merge" "--abort")) + +(defun magit-checkout-stage (file arg) + "During a conflict checkout and stage side, or restore conflict." + (interactive + (let ((file (magit-completing-read "Checkout file" + (magit-tracked-files) nil nil nil + 'magit-read-file-hist + (magit-current-file)))) + (cond ((member file (magit-unmerged-files)) + (list file (magit-checkout-read-stage file))) + ((yes-or-no-p (format "Restore conflicts in %s? " file)) + (list file "--merge")) + (t + (user-error "Quit"))))) + (pcase (cons arg (cddr (car (magit-file-status file)))) + ((or `("--ours" ?D ,_) + '("--ours" ?U ?A) + `("--theirs" ,_ ?D) + '("--theirs" ?A ?U)) + (magit-run-git "rm" "--" file)) + (_ (if (equal arg "--merge") + ;; This fails if the file was deleted on one + ;; side. And we cannot do anything about it. + (magit-run-git "checkout" "--merge" "--" file) + (magit-call-git "checkout" arg "--" file) + (magit-run-git "add" "-u" "--" file))))) + +;;; Utilities + +(defun magit-merge-in-progress-p () + (file-exists-p (expand-file-name "MERGE_HEAD" (magit-gitdir)))) + +(defun magit--merge-range (&optional head) + (unless head + (setq head (magit-get-shortname + (car (magit-file-lines + (expand-file-name "MERGE_HEAD" (magit-gitdir))))))) + (and head + (concat (magit-git-string "merge-base" "--octopus" "HEAD" head) + ".." head))) + +(defun magit-merge-assert () + (or (not (magit-anything-modified-p t)) + (magit-confirm 'merge-dirty + "Merging with dirty worktree is risky. Continue"))) + +(defun magit-checkout-read-stage (file) + (magit-read-char-case (format "For %s checkout: " file) t + (?o "[o]ur stage" "--ours") + (?t "[t]heir stage" "--theirs") + (?c (if magit-verbose-messages "restore [c]onflict" "[c]onflict") + "--merge"))) + +;;; Sections + +(defun magit-insert-merge-log () + "Insert section for the on-going merge. +Display the heads that are being merged. +If no merge is in progress, do nothing." + (when (magit-merge-in-progress-p) + (let* ((heads (mapcar #'magit-get-shortname + (magit-file-lines + (expand-file-name "MERGE_HEAD" (magit-gitdir))))) + (range (magit--merge-range (car heads)))) + (magit-insert-section (unmerged range) + (magit-insert-heading + (format "Merging %s:" (string-join heads ", "))) + (magit--insert-log nil + range + (let ((args magit-buffer-log-args)) + (unless (member "--decorate=full" magit-buffer-log-args) + (push "--decorate=full" args)) + args)))))) + +;;; _ +(provide 'magit-merge) +;;; magit-merge.el ends here diff --git a/emacs/elpa/magit-20240625.2109/magit-merge.elc b/emacs/elpa/magit-20240625.2109/magit-merge.elc Binary files differ. diff --git a/emacs/elpa/magit-20240625.2109/magit-mode.el b/emacs/elpa/magit-20240625.2109/magit-mode.el @@ -0,0 +1,1469 @@ +;;; magit-mode.el --- Create and refresh Magit buffers -*- lexical-binding:t -*- + +;; Copyright (C) 2008-2024 The Magit Project Contributors + +;; Author: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> +;; Maintainer: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; 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. +;; +;; 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 Magit. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This library implements the abstract major-mode `magit-mode' from +;; which almost all other Magit major-modes derive. The code in here +;; is mostly concerned with creating and refreshing Magit buffers. + +;;; Code: + +(require 'magit-base) +(require 'magit-git) + +(require 'benchmark) +(require 'browse-url) +(require 'format-spec) +(require 'help-mode) + +(require 'transient) + +(defvar bookmark-make-record-function) +(defvar magit--wip-inhibit-autosave) +(defvar magit-wip-after-save-local-mode) +(declare-function magit-wip-get-ref "magit-wip" ()) +(declare-function magit-wip-commit-worktree "magit-wip" (ref files msg)) + +;;; Options + +(defcustom magit-mode-hook + '(magit-load-config-extensions) + "Hook run when entering a mode derived from Magit mode." + :package-version '(magit . "3.0.0") + :group 'magit-modes + :type 'hook + :options '(magit-load-config-extensions + bug-reference-mode)) + +(defcustom magit-setup-buffer-hook + '(magit-maybe-save-repository-buffers + magit-set-buffer-margin) + "Hook run by `magit-setup-buffer'. + +This is run right after displaying the buffer and right before +generating or updating its content. `magit-mode-hook' and other, +more specific, `magit-mode-*-hook's on the other hand are run +right before displaying the buffer. Usually one of these hooks +should be used instead of this one." + :package-version '(magit . "2.3.0") + :group 'magit-modes + :type 'hook + :options '(magit-maybe-save-repository-buffers + magit-set-buffer-margin)) + +(defcustom magit-pre-refresh-hook '(magit-maybe-save-repository-buffers) + "Hook run before refreshing in `magit-refresh'. + +This hook, or `magit-post-refresh-hook', should be used +for functions that are not tied to a particular buffer. + +To run a function with a particular buffer current, use +`magit-refresh-buffer-hook' and use `derived-mode-p' +inside your function." + :package-version '(magit . "2.4.0") + :group 'magit-refresh + :type 'hook + :options '(magit-maybe-save-repository-buffers)) + +(defcustom magit-post-refresh-hook + '(magit-auto-revert-buffers + magit-run-post-commit-hook + magit-run-post-stage-hook + magit-run-post-unstage-hook) + "Hook run after refreshing in `magit-refresh'. + +This hook, or `magit-pre-refresh-hook', should be used +for functions that are not tied to a particular buffer. + +To run a function with a particular buffer current, use +`magit-refresh-buffer-hook' and use `derived-mode-p' +inside your function." + :package-version '(magit . "2.4.0") + :group 'magit-refresh + :type 'hook + :options '(magit-auto-revert-buffers + magit-run-post-commit-hook + magit-run-post-stage-hook + magit-run-post-unstage-hook)) + +(defcustom magit-display-buffer-function #'magit-display-buffer-traditional + "The function used to display a Magit buffer. + +All Magit buffers (buffers whose major-modes derive from +`magit-mode') are displayed using `magit-display-buffer', +which in turn uses the function specified here." + :package-version '(magit . "2.3.0") + :group 'magit-buffers + :type '(radio (function-item magit-display-buffer-traditional) + (function-item magit-display-buffer-same-window-except-diff-v1) + (function-item magit-display-buffer-fullframe-status-v1) + (function-item magit-display-buffer-fullframe-status-topleft-v1) + (function-item magit-display-buffer-fullcolumn-most-v1) + (function-item display-buffer) + (function :tag "Function"))) + +(defcustom magit-pre-display-buffer-hook '(magit-save-window-configuration) + "Hook run by `magit-display-buffer' before displaying the buffer." + :package-version '(magit . "2.3.0") + :group 'magit-buffers + :type 'hook + :get #'magit-hook-custom-get + :options '(magit-save-window-configuration)) + +(defcustom magit-post-display-buffer-hook '(magit-maybe-set-dedicated) + "Hook run by `magit-display-buffer' after displaying the buffer." + :package-version '(magit . "2.3.0") + :group 'magit-buffers + :type 'hook + :get #'magit-hook-custom-get + :options '(magit-maybe-set-dedicated)) + +(defcustom magit-generate-buffer-name-function + #'magit-generate-buffer-name-default-function + "The function used to generate the name for a Magit buffer." + :package-version '(magit . "2.3.0") + :group 'magit-buffers + :type '(radio (function-item magit-generate-buffer-name-default-function) + (function :tag "Function"))) + +(defcustom magit-buffer-name-format "%x%M%v: %t%x" + "The format string used to name Magit buffers. + +The following %-sequences are supported: + +`%m' The name of the major-mode, but with the `-mode' suffix + removed. + +`%M' Like \"%m\" but abbreviate `magit-status-mode' as `magit'. + +`%v' The value the buffer is locked to, in parentheses, or an + empty string if the buffer is not locked to a value. + +`%V' Like \"%v\", but the string is prefixed with a space, unless + it is an empty string. + +`%t' The top-level directory of the working tree of the + repository, or if `magit-uniquify-buffer-names' is non-nil + an abbreviation of that. + +`%x' If `magit-uniquify-buffer-names' is nil \"*\", otherwise the + empty string. Due to limitations of the `uniquify' package, + buffer names must end with the path. + +The value should always contain \"%m\" or \"%M\", \"%v\" or \"%V\", and +\"%t\". If `magit-uniquify-buffer-names' is non-nil, then the +value must end with \"%t\" or \"%t%x\". See issue #2841. + +This is used by `magit-generate-buffer-name-default-function'. +If another `magit-generate-buffer-name-function' is used, then +it may not respect this option, or on the contrary it may +support additional %-sequences." + :package-version '(magit . "2.12.0") + :group 'magit-buffers + :type 'string) + +(defcustom magit-uniquify-buffer-names t + "Whether to uniquify the names of Magit buffers." + :package-version '(magit . "2.3.0") + :group 'magit-buffers + :type 'boolean) + +(defcustom magit-bury-buffer-function #'magit-mode-quit-window + "The function used to bury or kill the current Magit buffer." + :package-version '(magit . "3.2.0") + :group 'magit-buffers + :type '(radio (function-item quit-window) + (function-item magit-mode-quit-window) + (function-item magit-restore-window-configuration) + (function :tag "Function"))) + +(defcustom magit-prefix-use-buffer-arguments 'selected + "Whether certain prefix commands reuse arguments active in relevant buffer. + +This affects the transient prefix commands `magit-diff', +`magit-log' and `magit-show-refs'. + +Valid values are: + +`always': Always use the set of arguments that is currently + active in the respective buffer, provided that buffer exists + of course. +`selected': Use the set of arguments from the respective + buffer, but only if it is displayed in a window of the current + frame. This is the default. +`current': Use the set of arguments from the respective buffer, + but only if it is the current buffer. +`never': Never use the set of arguments from the respective + buffer. + +For more information see info node `(magit)Transient Arguments +and Buffer Variables'." + :package-version '(magit . "3.0.0") + :group 'magit-buffers + :group 'magit-commands + :group 'magit-diff + :group 'magit-log + :type '(choice + (const :tag "always use args from buffer" always) + (const :tag "use args from buffer if displayed in frame" selected) + (const :tag "use args from buffer if it is current" current) + (const :tag "never use args from buffer" never))) + +(defcustom magit-direct-use-buffer-arguments 'selected + "Whether certain commands reuse arguments active in relevant buffer. + +This affects certain commands such as `magit-show-commit' that +are suffixes of the diff or log transient prefix commands, but +only if they are invoked directly, i.e., *not* as a suffix. + +Valid values are: + +`always': Always use the set of arguments that is currently + active in the respective buffer, provided that buffer exists + of course. +`selected': Use the set of arguments from the respective + buffer, but only if it is displayed in a window of the current + frame. This is the default. +`current': Use the set of arguments from the respective buffer, + but only if it is the current buffer. +`never': Never use the set of arguments from the respective + buffer. + +For more information see info node `(magit)Transient Arguments +and Buffer Variables'." + :package-version '(magit . "3.0.0") + :group 'magit-buffers + :group 'magit-commands + :group 'magit-diff + :group 'magit-log + :type '(choice + (const :tag "always use args from buffer" always) + (const :tag "use args from buffer if displayed in frame" selected) + (const :tag "use args from buffer if it is current" current) + (const :tag "never use args from buffer" never))) + +(defcustom magit-region-highlight-hook '(magit-diff-update-hunk-region) + "Functions used to highlight the region. + +Each function is run with the current section as only argument +until one of them returns non-nil. If all functions return nil, +then fall back to regular region highlighting." + :package-version '(magit . "2.1.0") + :group 'magit-refresh + :type 'hook + :options '(magit-diff-update-hunk-region)) + +(defcustom magit-create-buffer-hook nil + "Normal hook run while creating a new `magit-mode' buffer. +Runs before the buffer is populated with sections. Also see +`magit-post-create-buffer-hook'." + :package-version '(magit . "2.90.0") + :group 'magit-refresh + :type 'hook) + +(defcustom magit-post-create-buffer-hook nil + "Normal hook run after creating a new `magit-mode' buffer. +Runs after the buffer is populated with sections for the first +time. Also see `magit-create-buffer-hook' (which runs earlier) +and `magit-refresh-buffer-hook' (which runs on every refresh)." + :package-version '(magit . "4.0.0") + :group 'magit-refresh + :type 'hook) + +(defcustom magit-refresh-buffer-hook nil + "Normal hook for `magit-refresh-buffer' to run after refreshing." + :package-version '(magit . "2.1.0") + :group 'magit-refresh + :type 'hook) + +(defcustom magit-refresh-status-buffer t + "Whether the status buffer is refreshed after running git. + +When this is non-nil, then the status buffer is automatically +refreshed after running git for side-effects, in addition to the +current Magit buffer, which is always refreshed automatically. + +Only set this to nil after exhausting all other options to +improve performance." + :package-version '(magit . "2.4.0") + :group 'magit-refresh + :group 'magit-status + :type 'boolean) + +(defcustom magit-refresh-verbose nil + "Whether to revert Magit buffers verbosely." + :package-version '(magit . "2.1.0") + :group 'magit-refresh + :type 'boolean) + +(defcustom magit-save-repository-buffers t + "Whether to save file-visiting buffers when appropriate. + +If non-nil, then all modified file-visiting buffers belonging +to the current repository may be saved before running Magit +commands and before creating or refreshing Magit buffers. +If `dontask', then this is done without user intervention, for +any other non-nil value the user has to confirm each save. + +The default is t to avoid surprises, but `dontask' is the +recommended value." + :group 'magit-essentials + :group 'magit-buffers + :type '(choice (const :tag "Never" nil) + (const :tag "Ask" t) + (const :tag "Save without asking" dontask))) + +;;; Key Bindings + +(defvar-keymap magit-mode-map + :doc "Parent keymap for all keymaps of modes derived from `magit-mode'." + :parent magit-section-mode-map + ;; Don't function-quote but make sure all commands are autoloaded. + "C-<return>" 'magit-visit-thing + "RET" 'magit-visit-thing + "M-TAB" 'magit-dired-jump + "M-<tab>" 'magit-section-cycle-diffs + "SPC" 'magit-diff-show-or-scroll-up + "S-SPC" 'magit-diff-show-or-scroll-down + "DEL" 'magit-diff-show-or-scroll-down + "+" 'magit-diff-more-context + "-" 'magit-diff-less-context + "0" 'magit-diff-default-context + "a" 'magit-cherry-apply + "A" 'magit-cherry-pick + "b" 'magit-branch + "B" 'magit-bisect + "c" 'magit-commit + "C" 'magit-clone + "d" 'magit-diff + "D" 'magit-diff-refresh + "e" 'magit-ediff-dwim + "E" 'magit-ediff + "f" 'magit-fetch + "F" 'magit-pull + "g" 'magit-refresh + "G" 'magit-refresh-all + "h" 'magit-dispatch + "?" 'magit-dispatch + "H" 'magit-describe-section + "i" 'magit-gitignore + "I" 'magit-init + "j" 'magit-status-quick + "J" 'magit-display-repository-buffer + "k" 'magit-delete-thing + "K" 'magit-file-untrack + "l" 'magit-log + "L" 'magit-log-refresh + "m" 'magit-merge + "M" 'magit-remote + ;; "n" magit-section-forward in magit-section-mode-map + ;; "N" forge-dispatch, added by forge package + "o" 'magit-submodule + "O" 'magit-subtree + ;; "p" magit-section-backward in magit-section-mode-map + "P" 'magit-push + "q" 'magit-mode-bury-buffer + "Q" 'magit-git-command + ":" 'magit-git-command + "r" 'magit-rebase + "R" 'magit-file-rename + "s" 'magit-stage-file + "S" 'magit-stage-modified + "t" 'magit-tag + "T" 'magit-notes + "u" 'magit-unstage-file + "U" 'magit-unstage-all + "v" 'magit-revert-no-commit + "V" 'magit-revert + "w" 'magit-am + "W" 'magit-patch + "x" 'magit-reset-quickly + "X" 'magit-reset + "y" 'magit-show-refs + "Y" 'magit-cherry + "z" 'magit-stash + "Z" 'magit-worktree + "%" 'magit-worktree + "$" 'magit-process-buffer + "!" 'magit-run + ">" 'magit-sparse-checkout + "C-c C-c" 'magit-dispatch + "C-c C-e" 'magit-edit-thing + "C-c C-o" 'magit-browse-thing + "C-c C-w" 'magit-copy-thing + "C-w" 'magit-copy-section-value + "M-w" 'magit-copy-buffer-revision + "<remap> <previous-line>" 'magit-previous-line + "<remap> <next-line>" 'magit-next-line + "<remap> <evil-previous-line>" 'evil-previous-visual-line + "<remap> <evil-next-line>" 'evil-next-visual-line) + +(defun magit-delete-thing () + "This is a placeholder command, which signals an error if called. +Where applicable, other keymaps remap this command to another, +which actually deletes the thing at point." + (interactive) + (user-error "There is no thing at point that could be deleted")) +;; Starting with Emacs 28.1 we could use (declare (completion ignore)). +(put 'magit-delete-thing 'completion-predicate #'ignore) + +(defun magit-visit-thing () + "This is a placeholder command, which may signal an error if called. +Where applicable, other keymaps remap this command to another, +which actually visits the thing at point." + (interactive) + (if (eq transient-current-command 'magit-dispatch) + (call-interactively (key-binding (this-command-keys))) + (if-let ((url (browse-url-url-at-point))) + (browse-url url) + (user-error "There is no thing at point that could be visited")))) +(put 'magit-visit-thing 'completion-predicate #'ignore) + +(defun magit-edit-thing () + "This is a placeholder command, which may signal an error if called. +Where applicable, other keymaps remap this command to another, +which actually lets you edit the thing at point, likely in another +buffer." + (interactive) + (if (eq transient-current-command 'magit-dispatch) + (call-interactively (key-binding (this-command-keys))) + (user-error "There is no thing at point that could be edited"))) +(put 'magit-edit-thing 'completion-predicate #'ignore) + +(defun magit-browse-thing () + "This is a placeholder command, which may signal an error if called. +Where applicable, other keymaps remap this command to another, +which actually visits thing at point using `browse-url'." + (interactive) + (if-let ((url (browse-url-url-at-point))) + (browse-url url) + (user-error "There is no thing at point that could be browsed"))) +(put 'magit-browse-thing 'completion-predicate #'ignore) + +(defun magit-copy-thing () + "This is a placeholder command, which signals an error if called. +Where applicable, other keymaps remap this command to another, +which actually copies some representation of the thing at point +to the kill ring." + (interactive) + (user-error "There is no thing at point that we know how to copy")) +(put 'magit-copy-thing 'completion-predicate #'ignore) + +;;;###autoload +(defun magit-info () + "Visit the Magit manual." + (interactive) + (info "magit")) + +(defvar bug-reference-map) +(with-eval-after-load 'bug-reference + (keymap-set bug-reference-map "<remap> <magit-visit-thing>" + 'bug-reference-push-button)) + +(easy-menu-define magit-mode-menu magit-mode-map + "Magit menu" + ;; Similar to `magit-dispatch' but exclude: + ;; - commands that are available from context menus: + ;; apply, reverse, discard, stage, unstage, + ;; cherry-pick, revert, reset, + ;; describe-section + ;; - commands that are available from submenus: + ;; git-command, ediff-dwim + ;; - and: refresh-all, status-jump, status-quick. + '("Magit" + "---" "Inspect" + [" Bisect..." magit-bisect t] + [" Cherries..." magit-cherry t] + [" Diff..." magit-diff t] + [" Ediff..." magit-ediff t] + [" Log..." magit-log t] + [" References..." magit-show-refs t] + "---" "Manipulate" + [" Commit..." magit-commit t] + [" Stash..." magit-stash t] + [" Tag..." magit-tag t] + "---" + [" Branch..." magit-branch t] + [" Remote..." magit-remote t] + "---" + [" Merge..." magit-merge t] + [" Rebase..." magit-rebase t] + "---" "Transfer" + [" Fetch..." magit-fetch t] + [" Pull..." magit-pull t] + [" Push..." magit-push t] + "---" "Setup" + [" Clone..." magit-clone t] + [" Ignore..." magit-gitignore t] + [" Init..." magit-init t] + "---" + ("Advanced" + ["Run..." magit-run t] + "---" + ["Apply patches..." magit-am t] + ["Format patches..." magit-patch t] + "---" + ["Note..." magit-notes t] + "---" + ["Submodule..." magit-submodule t] + ["Subtree..." magit-subtree t] + ["Worktree..." magit-worktree t]) + "---" + ["Show command dispatcher..." magit-dispatch t] + ["Show manual" magit-info t] + ["Show another buffer" magit-display-repository-buffer t] + "---" + ("Change buffer arguments" + ["Diff arguments" magit-diff-refresh t] + ["Log arguments" magit-log-refresh t]) + ["Refresh buffer" magit-refresh t] + ["Bury buffer" magit-mode-bury-buffer t])) + +;;; Mode + +(defun magit-load-config-extensions () + "Load Magit extensions that are defined at the Git config layer." + (dolist (ext (magit-get-all "magit.extension")) + (let ((sym (intern (format "magit-%s-mode" ext)))) + (when (fboundp sym) + (funcall sym 1))))) + +(define-derived-mode magit-mode magit-section-mode "Magit" + "Parent major mode from which Magit major modes inherit. + +Magit is documented in info node `(magit)'." + :group 'magit + (hack-dir-local-variables-non-file-buffer) + (face-remap-add-relative 'header-line 'magit-header-line) + (setq mode-line-process (magit-repository-local-get 'mode-line-process)) + (setq-local revert-buffer-function #'magit-refresh-buffer) + (setq-local bookmark-make-record-function #'magit--make-bookmark) + (setq-local imenu-create-index-function #'magit--imenu-create-index) + (setq-local imenu-default-goto-function #'magit--imenu-goto-function) + (setq-local isearch-filter-predicate #'magit-section--open-temporarily)) + +;;; Local Variables + +(defvar-local magit-buffer-arguments nil) +(defvar-local magit-buffer-diff-type nil) +(defvar-local magit-buffer-diff-args nil) +(defvar-local magit-buffer-diff-files nil) +(defvar-local magit-buffer-diff-files-suspended nil) +(defvar-local magit-buffer-file-name nil) +(defvar-local magit-buffer-files nil) +(defvar-local magit-buffer-log-args nil) +(defvar-local magit-buffer-log-files nil) +(defvar-local magit-buffer-range nil) +(defvar-local magit-buffer-range-hashed nil) +(defvar-local magit-buffer-refname nil) +(defvar-local magit-buffer-revision nil) +(defvar-local magit-buffer-revision-hash nil) +(defvar-local magit-buffer-revisions nil) +(defvar-local magit-buffer-typearg nil) +(defvar-local magit-buffer-upstream nil) + +;; These variables are also used in file-visiting buffers. +;; Because the user may change the major-mode, they have +;; to be permanent buffer-local. +(put 'magit-buffer-file-name 'permanent-local t) +(put 'magit-buffer-refname 'permanent-local t) +(put 'magit-buffer-revision 'permanent-local t) +(put 'magit-buffer-revision-hash 'permanent-local t) + +;; `magit-status' re-enables mode function but its refresher +;; function does not reinstate this. +(put 'magit-buffer-diff-files-suspended 'permanent-local t) + +(cl-defgeneric magit-buffer-value () + "Return the value of the current buffer. +The \"value\" identifies what is being displayed in the buffer. +The buffer's major-mode should derive from `magit-section-mode'." + nil) + +(defvar-local magit-previous-section nil) +(put 'magit-previous-section 'permanent-local t) + +;;; Setup Buffer + +(defmacro magit-setup-buffer (mode &optional locked &rest bindings) + (declare (indent 2)) + `(magit-setup-buffer-internal + ,mode ,locked + ,(cons 'list (mapcar (pcase-lambda (`(,var ,form)) + `(list ',var ,form)) + bindings)))) + +(defun magit-setup-buffer-internal ( mode locked bindings + &optional buffer-or-name) + (let* ((value (and locked + (with-temp-buffer + (pcase-dolist (`(,var ,val) bindings) + (set (make-local-variable var) val)) + (let ((major-mode mode)) + (magit-buffer-value))))) + (buffer (if buffer-or-name + (get-buffer-create buffer-or-name) + (magit-get-mode-buffer mode value))) + (section (and buffer (magit-current-section))) + (created (not buffer))) + (unless buffer + (setq buffer (magit-generate-new-buffer mode value))) + (with-current-buffer buffer + (setq magit-previous-section section) + (funcall mode) + (magit-xref-setup #'magit-setup-buffer-internal bindings) + (pcase-dolist (`(,var ,val) bindings) + (set (make-local-variable var) val)) + (when created + (run-hooks 'magit-create-buffer-hook))) + (magit-display-buffer buffer) + (with-current-buffer buffer + (run-hooks 'magit-setup-buffer-hook) + (magit-refresh-buffer) + (when created + (run-hooks 'magit-post-create-buffer-hook))) + buffer)) + +;;; Display Buffer + +(defvar magit-display-buffer-noselect nil + "If non-nil, then `magit-display-buffer' doesn't call `select-window'.") + +(defun magit-display-buffer (buffer &optional display-function) + "Display BUFFER in some window and maybe select it. + +If optional DISPLAY-FUNCTION is non-nil, then use that to display +the buffer. Otherwise use `magit-display-buffer-function', which +is the normal case. + +Then, unless `magit-display-buffer-noselect' is non-nil, select +the window which was used to display the buffer. + +Also run the hooks `magit-pre-display-buffer-hook' +and `magit-post-display-buffer-hook'." + (with-current-buffer buffer + (run-hooks 'magit-pre-display-buffer-hook)) + (let ((window (funcall (or display-function magit-display-buffer-function) + buffer))) + (unless magit-display-buffer-noselect + (let* ((old-frame (selected-frame)) + (new-frame (window-frame window))) + (select-window window) + (unless (eq old-frame new-frame) + (select-frame-set-input-focus new-frame))))) + (with-current-buffer buffer + (run-hooks 'magit-post-display-buffer-hook))) + +(defun magit-display-buffer-traditional (buffer) + "Display BUFFER the way this has traditionally been done." + (display-buffer + buffer (if (and (derived-mode-p 'magit-mode) + (not (memq (with-current-buffer buffer major-mode) + '(magit-process-mode + magit-revision-mode + magit-diff-mode + magit-stash-mode + magit-status-mode)))) + '(display-buffer-same-window) + nil))) ; display in another window + +(defun magit-display-buffer-same-window-except-diff-v1 (buffer) + "Display BUFFER in the selected window except for some modes. +If a buffer's `major-mode' derives from `magit-diff-mode' or +`magit-process-mode', display it in another window. Display all +other buffers in the selected window." + (display-buffer + buffer (if (with-current-buffer buffer + (derived-mode-p 'magit-diff-mode 'magit-process-mode)) + '(nil (inhibit-same-window . t)) + '(display-buffer-same-window)))) + +(defun magit--display-buffer-fullframe (buffer alist) + (when-let ((window (or (display-buffer-reuse-window buffer alist) + (display-buffer-same-window buffer alist) + (display-buffer-pop-up-window buffer alist) + (display-buffer-use-some-window buffer alist)))) + (delete-other-windows window) + window)) + +(defun magit-display-buffer-fullframe-status-v1 (buffer) + "Display BUFFER, filling entire frame if BUFFER is a status buffer. +Otherwise, behave like `magit-display-buffer-traditional'." + (if (eq (with-current-buffer buffer major-mode) + 'magit-status-mode) + (display-buffer buffer '(magit--display-buffer-fullframe)) + (magit-display-buffer-traditional buffer))) + +(defun magit--display-buffer-topleft (buffer alist) + (or (display-buffer-reuse-window buffer alist) + (when-let ((window2 (display-buffer-pop-up-window buffer alist))) + (let ((window1 (get-buffer-window)) + (buffer1 (current-buffer)) + (buffer2 (window-buffer window2)) + (w2-quit-restore (window-parameter window2 'quit-restore))) + (set-window-buffer window1 buffer2) + (set-window-buffer window2 buffer1) + (select-window window2) + ;; Swap some window state that `magit-mode-quit-window' and + ;; `quit-restore-window' inspect. + (set-window-prev-buffers window2 (cdr (window-prev-buffers window1))) + (set-window-prev-buffers window1 nil) + (set-window-parameter window2 'magit-dedicated + (window-parameter window1 'magit-dedicated)) + (set-window-parameter window1 'magit-dedicated t) + (set-window-parameter window1 'quit-restore + (list 'window 'window + (nth 2 w2-quit-restore) + (nth 3 w2-quit-restore))) + (set-window-parameter window2 'quit-restore nil) + window1)))) + +(defun magit-display-buffer-fullframe-status-topleft-v1 (buffer) + "Display BUFFER, filling entire frame if BUFFER is a status buffer. +When BUFFER derives from `magit-diff-mode' or +`magit-process-mode', try to display BUFFER to the top or left of +the current buffer rather than to the bottom or right, as +`magit-display-buffer-fullframe-status-v1' would. Whether the +split is made vertically or horizontally is determined by +`split-window-preferred-function'." + (display-buffer + buffer + (cond ((eq (with-current-buffer buffer major-mode) + 'magit-status-mode) + '(magit--display-buffer-fullframe)) + ((with-current-buffer buffer + (derived-mode-p 'magit-diff-mode 'magit-process-mode)) + '(magit--display-buffer-topleft)) + (t + '(display-buffer-same-window))))) + +(defun magit--display-buffer-fullcolumn (buffer alist) + (when-let ((window (or (display-buffer-reuse-window buffer alist) + (display-buffer-same-window buffer alist) + (display-buffer-below-selected buffer alist)))) + (delete-other-windows-vertically window) + window)) + +(defun magit-display-buffer-fullcolumn-most-v1 (buffer) + "Display BUFFER using the full column except in some cases. +For most cases where BUFFER's `major-mode' derives from +`magit-mode', display it in the selected window and grow that +window to the full height of the frame, deleting other windows in +that column as necessary. However, display BUFFER in another +window if 1) BUFFER's mode derives from `magit-process-mode', or +2) BUFFER's mode derives from `magit-diff-mode', provided that +the mode of the current buffer derives from `magit-log-mode' or +`magit-cherry-mode'." + (display-buffer + buffer + (cond ((and (or (bound-and-true-p git-commit-mode) + (derived-mode-p 'magit-log-mode + 'magit-cherry-mode + 'magit-reflog-mode)) + (with-current-buffer buffer + (derived-mode-p 'magit-diff-mode))) + nil) + ((with-current-buffer buffer + (derived-mode-p 'magit-process-mode)) + nil) + (t + '(magit--display-buffer-fullcolumn))))) + +(defun magit-maybe-set-dedicated () + "Mark the selected window as dedicated if appropriate. + +If a new window was created to display the buffer, then remember +that fact. That information is used by `magit-mode-quit-window', +to determine whether the window should be deleted when its last +Magit buffer is buried." + (let ((window (get-buffer-window (current-buffer)))) + (when (and (window-live-p window) + (not (window-prev-buffers window))) + (set-window-parameter window 'magit-dedicated t)))) + +;;; Get Buffer + +(defvar-local magit--default-directory nil + "Value of `default-directory' when buffer is generated. +This exists to prevent a let-bound `default-directory' from +tricking `magit-get-mode-buffer' or `magit-mode-get-buffers' +into thinking a buffer belongs to a repo that it doesn't.") +(put 'magit--default-directory 'permanent-local t) + +(defun magit-mode-get-buffers () + (let ((topdir (magit-toplevel))) + (--filter (with-current-buffer it + (and (derived-mode-p 'magit-mode) + (equal magit--default-directory topdir))) + (buffer-list)))) + +(defvar-local magit-buffer-locked-p nil) +(put 'magit-buffer-locked-p 'permanent-local t) + +(defun magit-get-mode-buffer (mode &optional value frame) + "Return buffer belonging to the current repository whose major-mode is MODE. + +If no such buffer exists then return nil. Multiple buffers with +the same major-mode may exist for a repository but only one can +exist that hasn't been locked to its value. Return that buffer +\(or nil if there is no such buffer) unless VALUE is non-nil, in +which case return the buffer that has been locked to that value. + +If FRAME is nil or omitted, then consider all buffers. Otherwise + only consider buffers that are displayed in some live window + on some frame. +If `all', then consider all buffers on all frames. +If `visible', then only consider buffers on all visible frames. +If `selected' or t, then only consider buffers on the selected + frame. +If a frame, then only consider buffers on that frame." + (let ((topdir (magit--toplevel-safe))) + (cl-flet* ((b (buffer) + (with-current-buffer buffer + (and (eq major-mode mode) + (equal magit--default-directory topdir) + (if value + (and magit-buffer-locked-p + (equal (magit-buffer-value) value)) + (not magit-buffer-locked-p)) + buffer))) + (w (window) + (b (window-buffer window))) + (f (frame) + (seq-some #'w (window-list frame 'no-minibuf)))) + (pcase-exhaustive frame + ('nil (seq-some #'b (buffer-list))) + ('all (seq-some #'f (frame-list))) + ('visible (seq-some #'f (visible-frame-list))) + ((or 'selected 't) (seq-some #'w (window-list (selected-frame)))) + ((guard (framep frame)) (seq-some #'w (window-list frame))))))) + +(defun magit-generate-new-buffer (mode &optional value directory) + (let* ((default-directory (or directory (magit--toplevel-safe))) + (name (funcall magit-generate-buffer-name-function mode value)) + (buffer (generate-new-buffer name))) + (with-current-buffer buffer + (setq magit--default-directory default-directory) + (setq magit-buffer-locked-p (and value t)) + (magit-restore-section-visibility-cache mode)) + (when magit-uniquify-buffer-names + (add-to-list 'uniquify-list-buffers-directory-modes mode) + (with-current-buffer buffer + (setq list-buffers-directory (abbreviate-file-name default-directory))) + (let ((uniquify-buffer-name-style + (if (memq uniquify-buffer-name-style '(nil forward)) + 'post-forward-angle-brackets + uniquify-buffer-name-style))) + (uniquify-rationalize-file-buffer-names + name (file-name-directory (directory-file-name default-directory)) + buffer))) + buffer)) + +(defun magit-generate-buffer-name-default-function (mode &optional value) + "Generate buffer name for a MODE buffer in the current repository. +The returned name is based on `magit-buffer-name-format' and +takes `magit-uniquify-buffer-names' and VALUE, if non-nil, into +account." + (let ((m (substring (symbol-name mode) 0 -5)) + (v (and value (format "%s" (if (listp value) value (list value))))) + (n (if magit-uniquify-buffer-names + (file-name-nondirectory + (directory-file-name default-directory)) + (abbreviate-file-name default-directory)))) + (format-spec + magit-buffer-name-format + `((?m . ,m) + (?M . ,(if (eq mode 'magit-status-mode) "magit" m)) + (?v . ,(or v "")) + (?V . ,(if v (concat " " v) "")) + (?t . ,n) + (?x . ,(if magit-uniquify-buffer-names "" "*")))))) + +;;; Buffer Lock + +(defun magit-toggle-buffer-lock () + "Lock the current buffer to its value or unlock it. + +Locking a buffer to its value prevents it from being reused to +display another value. The name of a locked buffer contains its +value, which allows telling it apart from other locked buffers +and the unlocked buffer. + +Not all Magit buffers can be locked to their values, for example +it wouldn't make sense to lock a status buffer. + +There can only be a single unlocked buffer using a certain +major-mode per repository. So when a buffer is being unlocked +and another unlocked buffer already exists for that mode and +repository, then the former buffer is instead deleted and the +latter is displayed in its place." + (interactive) + (if magit-buffer-locked-p + (if-let ((unlocked (magit-get-mode-buffer major-mode))) + (let ((locked (current-buffer))) + (switch-to-buffer unlocked nil t) + (kill-buffer locked)) + (setq magit-buffer-locked-p nil) + (rename-buffer (funcall magit-generate-buffer-name-function + major-mode))) + (if-let ((value (magit-buffer-value))) + (if-let ((locked (magit-get-mode-buffer major-mode value))) + (let ((unlocked (current-buffer))) + (switch-to-buffer locked nil t) + (kill-buffer unlocked)) + (setq magit-buffer-locked-p t) + (rename-buffer (funcall magit-generate-buffer-name-function + major-mode value))) + (user-error "Buffer has no value it could be locked to")))) + +;;; Bury Buffer + +(defun magit-mode-bury-buffer (&optional kill-buffer) + "Bury or kill the current buffer. + +Use `magit-bury-buffer-function' to bury the buffer when called +without a prefix argument or to kill it when called with a single +prefix argument. + +With two prefix arguments, always kill the current and all other +Magit buffers, associated with this repository." + (interactive "P") + (if (>= (prefix-numeric-value kill-buffer) 16) + (mapc #'kill-buffer (magit-mode-get-buffers)) + (funcall magit-bury-buffer-function kill-buffer))) + +(defun magit-mode-quit-window (kill-buffer) + "Quit the selected window and bury its buffer. + +This behaves similar to `quit-window', but when the window +was originally created to display a Magit buffer and the +current buffer is the last remaining Magit buffer that was +ever displayed in the selected window, then delete that +window." + (if (or (one-window-p) + (--first (let ((buffer (car it))) + (and (not (eq buffer (current-buffer))) + (buffer-live-p buffer) + (or (not (window-parameter nil 'magit-dedicated)) + (with-current-buffer buffer + (derived-mode-p 'magit-mode + 'magit-process-mode))))) + (window-prev-buffers))) + (quit-window kill-buffer) + (let ((window (selected-window))) + (quit-window kill-buffer) + (when (window-live-p window) + (delete-window window))))) + +;;; Refresh Buffers + +(defvar magit-inhibit-refresh nil) + +(defun magit-refresh () + "Refresh some buffers belonging to the current repository. + +Refresh the current buffer if its major mode derives from +`magit-mode', and refresh the corresponding status buffer. + +Run hooks `magit-pre-refresh-hook' and `magit-post-refresh-hook'." + (interactive) + (unless magit-inhibit-refresh + (unwind-protect + (let ((start (current-time)) + (magit--refresh-cache (or magit--refresh-cache + (list (cons 0 0))))) + (when magit-refresh-verbose + (message "Refreshing magit...")) + (magit-run-hook-with-benchmark 'magit-pre-refresh-hook) + (cond ((derived-mode-p 'magit-mode) + (magit-refresh-buffer)) + ((derived-mode-p 'tabulated-list-mode) + (revert-buffer))) + (when-let ((buffer (and magit-refresh-status-buffer + (not (derived-mode-p 'magit-status-mode)) + (magit-get-mode-buffer 'magit-status-mode)))) + (with-current-buffer buffer + (magit-refresh-buffer))) + (magit-run-hook-with-benchmark 'magit-post-refresh-hook) + (when magit-refresh-verbose + (let* ((c (caar magit--refresh-cache)) + (a (+ c (cdar magit--refresh-cache)))) + (message "Refreshing magit...done (%.3fs, cached %s/%s (%.0f%%))" + (float-time (time-since start)) + c a (* (/ c (* a 1.0)) 100))))) + (run-hooks 'magit-unwind-refresh-hook)))) + +(defun magit-refresh-all () + "Refresh all buffers belonging to the current repository. + +Refresh all Magit buffers belonging to the current repository, +and revert buffers that visit files located inside the current +repository. + +Run hooks `magit-pre-refresh-hook' and `magit-post-refresh-hook'." + (interactive) + (magit-run-hook-with-benchmark 'magit-pre-refresh-hook) + (dolist (buffer (magit-mode-get-buffers)) + (with-current-buffer buffer (magit-refresh-buffer))) + (magit-run-hook-with-benchmark 'magit-post-refresh-hook)) + +(defvar-local magit-refresh-start-time nil) + +(defun magit-refresh-buffer (&rest _ignore) + "Refresh the current Magit buffer." + (interactive) + (setq magit-refresh-start-time (current-time)) + (let ((refresh (intern (format "%s-refresh-buffer" + (substring (symbol-name major-mode) 0 -5)))) + (magit--refresh-cache (or magit--refresh-cache (list (cons 0 0))))) + (when (functionp refresh) + (when magit-refresh-verbose + (message "Refreshing buffer `%s'..." (buffer-name))) + (let* ((buffer (current-buffer)) + (windows (cl-mapcan + (lambda (window) + (with-selected-window window + (with-current-buffer buffer + (and-let* ((section (magit-section-at))) + `(( ,window + ,section + ,@(magit-section-get-relative-position + section))))))) + ;; If it qualifies, then the selected window + ;; comes first, but we want to handle it last + ;; so that its `magit-section-movement-hook' + ;; run can override the effects of other runs. + (or (nreverse (get-buffer-window-list buffer nil t)) + (list (selected-window)))))) + (deactivate-mark) + (setq magit-section-pre-command-section nil) + (setq magit-section-highlight-overlays nil) + (setq magit-section-highlighted-sections nil) + (setq magit-section-unhighlight-sections nil) + (let ((inhibit-read-only t)) + (erase-buffer) + (save-excursion + (funcall refresh))) + (pcase-dolist (`(,window . ,args) windows) + (if (eq buffer (window-buffer window)) + (with-selected-window window + (apply #'magit-section-goto-successor args)) + (with-current-buffer buffer + (let ((magit-section-movement-hook nil)) + (apply #'magit-section-goto-successor args))))) + (run-hooks 'magit-refresh-buffer-hook) + (magit-section-update-highlight) + (set-buffer-modified-p nil)) + (when magit-refresh-verbose + (message "Refreshing buffer `%s'...done (%.3fs)" (buffer-name) + (float-time (time-since magit-refresh-start-time))))))) + +(defun magit-profile-refresh-buffer () + "Profile refreshing the current Magit buffer." + (interactive) + (require (quote elp)) + (when (fboundp 'elp-reset-all) + (elp-reset-all) + (elp-instrument-package "magit-") + (elp-instrument-package "forge-") + (magit-refresh-buffer) + (elp-results) + (elp-reset-all))) + +;;; Save File-Visiting Buffers + +(defvar magit--disable-save-buffers nil) + +(defun magit-pre-command-hook () + (setq magit--disable-save-buffers nil)) +(add-hook 'pre-command-hook #'magit-pre-command-hook) + +(defvar magit-after-save-refresh-buffers nil) + +(defun magit-after-save-refresh-buffers () + (dolist (buffer magit-after-save-refresh-buffers) + (when (buffer-live-p buffer) + (with-current-buffer buffer + (magit-refresh-buffer)))) + (setq magit-after-save-refresh-buffers nil) + (remove-hook 'post-command-hook #'magit-after-save-refresh-buffers)) + +(defun magit-after-save-refresh-status () + "Refresh the status buffer of the current repository. + +This function is intended to be added to `after-save-hook'. + +If the status buffer does not exist or the file being visited in +the current buffer isn't inside the working tree of a repository, +then do nothing. + +Note that refreshing a Magit buffer is done by re-creating its +contents from scratch, which can be slow in large repositories. +If you are not satisfied with Magit's performance, then you +should obviously not add this function to that hook." + (when (and (not magit--disable-save-buffers) + (magit-inside-worktree-p t)) + (when-let ((buffer (ignore-errors + (magit-get-mode-buffer 'magit-status-mode)))) + (add-to-list 'magit-after-save-refresh-buffers buffer) + (add-hook 'post-command-hook #'magit-after-save-refresh-buffers)))) + +(defun magit-maybe-save-repository-buffers () + "Maybe save file-visiting buffers belonging to the current repository. +Do so if `magit-save-repository-buffers' is non-nil. You should +not remove this from any hooks, instead set that variable to nil +if you so desire." + (when (and magit-save-repository-buffers + (not magit--disable-save-buffers)) + (setq magit--disable-save-buffers t) + (let ((msg (current-message))) + (magit-save-repository-buffers + (eq magit-save-repository-buffers 'dontask)) + (when (and msg + (current-message) + (not (equal msg (current-message)))) + (message "%s" msg))))) + +(add-hook 'magit-pre-refresh-hook #'magit-maybe-save-repository-buffers) +(add-hook 'magit-pre-call-git-hook #'magit-maybe-save-repository-buffers) +(add-hook 'magit-pre-start-git-hook #'magit-maybe-save-repository-buffers) + +(defvar-local magit-inhibit-refresh-save nil) + +(defun magit-save-repository-buffers (&optional arg) + "Save file-visiting buffers belonging to the current repository. +After any buffer where `buffer-save-without-query' is non-nil +is saved without asking, the user is asked about each modified +buffer which visits a file in the current repository. Optional +argument (the prefix) non-nil means save all with no questions." + (interactive "P") + (when-let ((topdir (magit-rev-parse-safe "--show-toplevel"))) + (let ((remote (file-remote-p default-directory)) + (save-some-buffers-action-alist + `((?Y (lambda (buffer) + (with-current-buffer buffer + (setq buffer-save-without-query t) + (save-buffer))) + "to save the current buffer and remember choice") + (?N (lambda (buffer) + (with-current-buffer buffer + (setq magit-inhibit-refresh-save t))) + "to skip the current buffer and remember choice") + ,@save-some-buffers-action-alist)) + (topdirs nil) + (unwiped nil) + (magit--wip-inhibit-autosave t)) + (unwind-protect + (save-some-buffers + arg + (lambda () + ;; If the current file is modified and resides inside + ;; a repository, and a let-binding is in effect, which + ;; places us in another repository, then this binding + ;; is needed to prevent that file from being saved. + (and-let* ((default-directory + (and buffer-file-name + (file-name-directory buffer-file-name)))) + (and + ;; Check whether the repository still exists. + (file-exists-p default-directory) + ;; Check whether refreshing is disabled. + (not magit-inhibit-refresh-save) + ;; Check whether the visited file is either on the + ;; same remote as the repository, or both are on + ;; the local system. + (equal (file-remote-p buffer-file-name) remote) + ;; Delayed checks that are more expensive for remote + ;; repositories, due to the required network access. + ;; + ;; Check whether the file is inside the repository. + (equal (or (cdr (assoc default-directory topdirs)) + (let ((top (magit-rev-parse-safe "--show-toplevel"))) + (push (cons default-directory top) topdirs) + top)) + topdir) + ;; Check whether the file is actually writable. + (file-writable-p buffer-file-name) + (prog1 t + ;; Schedule for wip commit, if appropriate. + (when magit-wip-after-save-local-mode + (push (expand-file-name buffer-file-name) unwiped))))))) + (when unwiped + (let ((default-directory topdir)) + (magit-wip-commit-worktree + (magit-wip-get-ref) + unwiped + (if (cdr unwiped) + (format "autosave %s files after save" (length unwiped)) + (format "autosave %s after save" + (file-relative-name (car unwiped))))))))))) + +;;; Restore Window Configuration + +(defvar magit-inhibit-save-previous-winconf nil) + +(defvar-local magit-previous-window-configuration nil) +(put 'magit-previous-window-configuration 'permanent-local t) + +(defun magit-save-window-configuration () + "Save the current window configuration. + +Later, when the buffer is buried, it may be restored by +`magit-restore-window-configuration'." + (if magit-inhibit-save-previous-winconf + (when (eq magit-inhibit-save-previous-winconf 'unset) + (setq magit-previous-window-configuration nil)) + (unless (get-buffer-window (current-buffer) (selected-frame)) + (setq magit-previous-window-configuration + (current-window-configuration))))) + +(defun magit-restore-window-configuration (&optional kill-buffer) + "Bury or kill the current buffer and restore previous window configuration." + (let ((winconf magit-previous-window-configuration) + (buffer (current-buffer)) + (frame (selected-frame))) + (quit-window kill-buffer (selected-window)) + (when (and winconf (equal frame (window-configuration-frame winconf))) + (set-window-configuration winconf) + (when (buffer-live-p buffer) + (with-current-buffer buffer + (setq magit-previous-window-configuration nil))) + (set-buffer (with-selected-window (selected-window) + (current-buffer)))))) + +;;; Buffer History + +(defun magit-go-backward () + "Move backward in current buffer's history." + (interactive) + (if help-xref-stack + (help-xref-go-back (current-buffer)) + (user-error "No previous entry in buffer's history"))) + +(defun magit-go-forward () + "Move forward in current buffer's history." + (interactive) + (if help-xref-forward-stack + (help-xref-go-forward (current-buffer)) + (user-error "No next entry in buffer's history"))) + +(defun magit-insert-xref-buttons () + "Insert xref buttons." + (when (and (not magit-buffer-locked-p) + (or help-xref-stack help-xref-forward-stack)) + (when help-xref-stack + (magit-xref-insert-button help-back-label 'magit-xref-backward)) + (when help-xref-forward-stack + (when help-xref-stack + (insert " ")) + (magit-xref-insert-button help-forward-label 'magit-xref-forward)))) + +(defun magit-xref-insert-button (label type) + (magit-insert-section (button label) + (insert-text-button label 'type type + 'help-args (list (current-buffer))))) + +(define-button-type 'magit-xref-backward + :supertype 'help-back + 'mouse-face 'magit-section-highlight + 'help-echo (purecopy "mouse-2, RET: go back to previous history entry")) + +(define-button-type 'magit-xref-forward + :supertype 'help-forward + 'mouse-face 'magit-section-highlight + 'help-echo (purecopy "mouse-2, RET: go back to next history entry")) + +(defvar magit-xref-modes + '(magit-log-mode + magit-reflog-mode + magit-diff-mode + magit-revision-mode) + "List of modes for which to insert navigation buttons.") + +(defun magit-xref-setup (fn args) + (when (memq major-mode magit-xref-modes) + (when help-xref-stack-item + (push (cons (point) help-xref-stack-item) help-xref-stack) + (setq help-xref-forward-stack nil)) + (when-let ((tail (nthcdr 30 help-xref-stack))) + (setcdr tail nil)) + (setq help-xref-stack-item + (list 'magit-xref-restore fn default-directory args)))) + +(defun magit-xref-restore (fn dir args) + (setq default-directory dir) + (funcall fn major-mode nil args) + (magit-refresh-buffer)) + +;;; Repository-Local Cache + +(defvar magit-repository-local-cache nil + "Alist mapping `magit-toplevel' paths to alists of key/value pairs.") + +(defun magit-repository-local-repository () + "Return the key for the current repository." + (or (bound-and-true-p magit--default-directory) + (magit-toplevel))) + +(defun magit-repository-local-set (key value &optional repository) + "Set the repository-local VALUE for KEY. + +Unless specified, REPOSITORY is the current buffer's repository. + +If REPOSITORY is nil (meaning there is no current repository), +then the value is not cached, and we return nil." + (let* ((repokey (or repository (magit-repository-local-repository))) + (cache (assoc repokey magit-repository-local-cache))) + ;; Don't cache values for a nil REPOSITORY, as the 'set' and 'get' + ;; calls for some KEY may happen in unrelated contexts. + (when repokey + (if cache + (let ((keyvalue (assoc key (cdr cache)))) + (if keyvalue + ;; Update pre-existing value for key. + (setcdr keyvalue value) + ;; No such key in repository-local cache. + (push (cons key value) (cdr cache)))) + ;; No cache for this repository. + (push (cons repokey (list (cons key value))) + magit-repository-local-cache))))) + +(defun magit-repository-local-exists-p (key &optional repository) + "Non-nil when a repository-local value exists for KEY. + +Return a (KEY . VALUE) cons cell. + +The KEY is matched using `equal'. + +Unless specified, REPOSITORY is the current buffer's repository." + (and-let* ((cache (assoc (or repository + (magit-repository-local-repository)) + magit-repository-local-cache))) + (assoc key (cdr cache)))) + +(defun magit-repository-local-get (key &optional default repository) + "Return the repository-local value for KEY. + +Return DEFAULT if no value for KEY exists. + +The KEY is matched using `equal'. + +Unless specified, REPOSITORY is the current buffer's repository." + (if-let ((keyvalue (magit-repository-local-exists-p key repository))) + (cdr keyvalue) + default)) + +(defun magit-repository-local-delete (key &optional repository) + "Delete the repository-local value for KEY. + +Unless specified, REPOSITORY is the current buffer's repository. +If REPOSITORY is `all', then delete the value for KEY for all +repositories." + (if (eq repository 'all) + (dolist (cache magit-repository-local-cache) + (setf cache (compat-call assoc-delete-all key cache))) + (when-let ((cache (assoc (or repository + (magit-repository-local-repository)) + magit-repository-local-cache))) + (setf cache (compat-call assoc-delete-all key cache))))) + +(defmacro magit--with-repository-local-cache (key &rest body) + (declare (indent 1) (debug (form body))) + (let ((k (cl-gensym))) + `(let ((,k ,key)) + (if-let ((kv (magit-repository-local-exists-p ,k))) + (cdr kv) + (let ((v ,(macroexp-progn body))) + (magit-repository-local-set ,k v) + v))))) + +(defun magit-preserve-section-visibility-cache () + (when (derived-mode-p 'magit-status-mode 'magit-refs-mode) + (magit-repository-local-set + (cons major-mode 'magit-section-visibility-cache) + magit-section-visibility-cache))) + +(defun magit-restore-section-visibility-cache (mode) + (setq magit-section-visibility-cache + (magit-repository-local-get + (cons mode 'magit-section-visibility-cache)))) + +(defun magit-zap-caches (&optional all) + "Zap caches for the current repository. + +Remove the repository's entry from `magit-repository-local-cache', +remove the host's entry from `magit--host-git-version-cache', and +set `magit-section-visibility-cache' to nil for all Magit buffers +of the repository. + +With a prefix argument or if optional ALL is non-nil, discard the +mentioned caches completely." + (interactive) + (cond (all + (setq magit-repository-local-cache nil) + (setq magit--host-git-version-cache nil) + (dolist (buffer (buffer-list)) + (with-current-buffer buffer + (when (derived-mode-p 'magit-mode) + (setq magit-section-visibility-cache nil))))) + (t + (magit-with-toplevel + (setq magit-repository-local-cache + (cl-delete default-directory + magit-repository-local-cache + :key #'car :test #'equal)) + (setq magit--host-git-version-cache + (cl-delete (file-remote-p default-directory) + magit--host-git-version-cache + :key #'car :test #'equal))) + (dolist (buffer (magit-mode-get-buffers)) + (with-current-buffer buffer + (setq magit-section-visibility-cache nil)))))) + +;;; Utilities + +(defun magit-toggle-verbose-refresh () + "Toggle whether Magit refreshes buffers verbosely. +Enabling this helps figuring out which sections are bottlenecks. +The additional output can be found in the *Messages* buffer." + (interactive) + (setq magit-refresh-verbose (not magit-refresh-verbose)) + (message "%s verbose refreshing" + (if magit-refresh-verbose "Enabled" "Disabled"))) + +(defun magit-run-hook-with-benchmark (hook) + (cond + ((not hook)) + (magit-refresh-verbose + (message "Running %s..." hook) + (message "Running %s...done (%.3fs)" hook + (benchmark-elapse + (run-hook-wrapped + hook + (lambda (fn) + (message " %-50s %f" fn (benchmark-elapse (funcall fn)))))))) + ((run-hooks hook)))) + +;;; _ +(provide 'magit-mode) +;;; magit-mode.el ends here diff --git a/emacs/elpa/magit-20240625.2109/magit-mode.elc b/emacs/elpa/magit-20240625.2109/magit-mode.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/magit-notes.el b/emacs/elpa/magit-20240625.2109/magit-notes.el diff --git a/emacs/elpa/magit-20240622.1531/magit-notes.elc b/emacs/elpa/magit-20240625.2109/magit-notes.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/magit-patch.el b/emacs/elpa/magit-20240625.2109/magit-patch.el diff --git a/emacs/elpa/magit-20240625.2109/magit-patch.elc b/emacs/elpa/magit-20240625.2109/magit-patch.elc Binary files differ. diff --git a/emacs/elpa/magit-20240625.2109/magit-pkg.el b/emacs/elpa/magit-20240625.2109/magit-pkg.el @@ -0,0 +1,20 @@ +(define-package "magit" "20240625.2109" "A Git porcelain inside Emacs." + '((emacs "26.1") + (compat "29.1.4.5") + (dash "20240405") + (git-commit "20240429") + (magit-section "20240429") + (seq "2.24") + (transient "20240421") + (with-editor "20240415")) + :commit "703dfe58120cc5bdf1a1a454362b174a164d3613" :authors + '(("Marius Vollmer" . "marius.vollmer@gmail.com") + ("Jonas Bernoulli" . "emacs.magit@jonas.bernoulli.dev")) + :maintainer + '("Jonas Bernoulli" . "emacs.magit@jonas.bernoulli.dev") + :keywords + '("git" "tools" "vc") + :url "https://github.com/magit/magit") +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/emacs/elpa/magit-20240625.2109/magit-process.el b/emacs/elpa/magit-20240625.2109/magit-process.el @@ -0,0 +1,1291 @@ +;;; magit-process.el --- Process functionality -*- lexical-binding:t -*- + +;; Copyright (C) 2008-2024 The Magit Project Contributors + +;; Author: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> +;; Maintainer: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; 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. +;; +;; 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 Magit. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This library implements the tools used to run Git for side-effects. + +;; Note that the functions used to run Git and then consume its +;; output, are defined in `magit-git.el'. There's a bit of overlap +;; though. + +;;; Code: + +(require 'magit-base) +(require 'magit-git) +(require 'magit-mode) + +(require 'ansi-color) +(require 'auth-source) +(require 'with-editor) + +(defvar y-or-n-p-map) + +;;; Options + +(defcustom magit-process-connection-type (not (eq system-type 'cygwin)) + "Connection type used for the Git process. + +If nil, use pipes: this is usually more efficient, and works on Cygwin. +If t, use ptys: this enables Magit to prompt for passphrases when needed." + :group 'magit-process + :type '(choice (const :tag "pipe" nil) + (const :tag "pty" t))) + +(defcustom magit-need-cygwin-noglob + (and (eq system-type 'windows-nt) + (with-temp-buffer + (let ((process-environment + (append magit-git-environment process-environment))) + (condition-case e + (process-file magit-git-executable + nil (current-buffer) nil + "-c" "alias.echo=!echo" "echo" "x{0}") + (file-error + (lwarn 'magit-process :warning + "Could not run Git: %S" e)))) + (equal "x0\n" (buffer-string)))) + "Whether to use a workaround for Cygwin's globbing behavior. + +If non-nil, add environment variables to `process-environment' to +prevent the git.exe distributed by Cygwin and MSYS2 from +attempting to perform glob expansion when called from a native +Windows build of Emacs. See #2246." + :package-version '(magit . "2.3.0") + :group 'magit-process + :type '(choice (const :tag "Yes" t) + (const :tag "No" nil))) + +(defcustom magit-process-popup-time -1 + "Popup the process buffer if a command takes longer than this many seconds." + :group 'magit-process + :type '(choice (const :tag "Never" -1) + (const :tag "Immediately" 0) + (integer :tag "After this many seconds"))) + +(defcustom magit-process-log-max 32 + "Maximum number of sections to keep in a process log buffer. +When adding a new section would go beyond the limit set here, +then the older half of the sections are remove. Sections that +belong to processes that are still running are never removed. +When this is nil, no sections are ever removed." + :package-version '(magit . "2.1.0") + :group 'magit-process + :type '(choice (const :tag "Never remove old sections" nil) integer)) + +(defvar magit-process-extreme-logging nil + "Whether `magit-process-file' logs to the *Messages* buffer. + +Only intended for temporary use when you try to figure out how +Magit uses Git behind the scene. Output that normally goes to +the magit-process buffer continues to go there. Not all output +goes to either of these two buffers. + +Also see `magit-git-debug'.") + +(defcustom magit-process-error-tooltip-max-lines 20 + "The number of lines for `magit-process-error-lines' to return. + +These are displayed in a tooltip for `mode-line-process' errors. + +If `magit-process-error-tooltip-max-lines' is nil, the tooltip +displays the text of `magit-process-error-summary' instead." + :package-version '(magit . "2.12.0") + :group 'magit-process + :type '(choice (const :tag "Use summary line" nil) + integer)) + +(defcustom magit-credential-cache-daemon-socket + (--some (pcase-let ((`(,prog . ,args) (split-string it))) + (if (and prog + (string-match-p + "\\`\\(?:\\(?:/.*/\\)?git-credential-\\)?cache\\'" prog)) + (or (cl-loop for (opt val) on args + if (string= opt "--socket") + return val) + (expand-file-name "~/.git-credential-cache/socket")))) + ;; Note: `magit-process-file' is not yet defined when + ;; evaluating this form, so we use `process-lines'. + (ignore-errors + (let ((process-environment + (append magit-git-environment process-environment))) + (process-lines magit-git-executable + "config" "--get-all" "credential.helper")))) + "If non-nil, start a credential cache daemon using this socket. + +When using Git's cache credential helper in the normal way, Emacs +sends a SIGHUP to the credential daemon after the git subprocess +has exited, causing the daemon to also quit. This can be avoided +by starting the `git-credential-cache--daemon' process directly +from Emacs. + +The function `magit-maybe-start-credential-cache-daemon' takes +care of starting the daemon if necessary, using the value of this +option as the socket. If this option is nil, then it does not +start any daemon. Likewise if another daemon is already running, +then it starts no new daemon. This function has to be a member +of the hook variable `magit-credential-hook' for this to work. +If an error occurs while starting the daemon, most likely because +the necessary executable is missing, then the function removes +itself from the hook, to avoid further futile attempts." + :package-version '(magit . "2.3.0") + :group 'magit-process + :type '(choice (file :tag "Socket") + (const :tag "Don't start a cache daemon" nil))) + +(defcustom magit-process-yes-or-no-prompt-regexp + (concat " [([]" + "\\([Yy]\\(?:es\\)?\\)" + "[/|]" + "\\([Nn]o?\\)" + ;; OpenSSH v8 prints this. See #3969. + "\\(?:/\\[fingerprint\\]\\)?" + "[])] ?[?:]? ?$") + "Regexp matching Yes-or-No prompts of Git and its subprocesses." + :package-version '(magit . "2.1.0") + :group 'magit-process + :type 'regexp) + +(defcustom magit-process-password-prompt-regexps + '("^\\(Enter \\)?[Pp]assphrase\\( for \\(RSA \\)?key '.*'\\)?: ?$" + ;; Match-group 99 is used to identify the "user@host" part. + "^\\(Enter \\|([^) ]+) \\)?\ +[Pp]assword\\( for '?\\(https?://\\)?\\(?99:[^']*\\)'?\\)?: ?$" + "Please enter the passphrase for the ssh key" + "Please enter the passphrase to unlock the OpenPGP secret key" + "^.*'s password: ?$" + "^Token: $" ; For git-credential-manager-core (#4318). + "^Yubikey for .*: ?$" + "^Enter PIN for .*: ?$") + "List of regexps matching password prompts of Git and its subprocesses. +Also see `magit-process-find-password-functions'." + :package-version '(magit . "3.0.0") + :group 'magit-process + :type '(repeat (regexp))) + +(defcustom magit-process-find-password-functions nil + "List of functions to try in sequence to get a password. + +These functions may be called when git asks for a password, which +is detected using `magit-process-password-prompt-regexps'. They +are called if and only if matching the prompt resulted in the +value of the 99th submatch to be non-nil. Therefore users can +control for which prompts these functions should be called by +putting the host name in the 99th submatch, or not. + +If the functions are called, then they are called in the order +given, with the host name as only argument, until one of them +returns non-nil. If they are not called or none of them returns +non-nil, then the password is read from the user instead." + :package-version '(magit . "2.3.0") + :group 'magit-process + :type 'hook + :options '(magit-process-password-auth-source)) + +(defcustom magit-process-username-prompt-regexps + '("^Username for '.*': ?$") + "List of regexps matching username prompts of Git and its subprocesses." + :package-version '(magit . "2.1.0") + :group 'magit-process + :type '(repeat (regexp))) + +(defcustom magit-process-prompt-functions nil + "List of functions used to forward arbitrary questions to the user. + +Magit has dedicated support for forwarding username and password +prompts and Yes-or-No questions asked by Git and its subprocesses +to the user. This can be customized using other options in the +`magit-process' customization group. + +If you encounter a new question that isn't handled by default, +then those options should be used instead of this hook. + +However subprocesses may also ask questions that differ too much +from what the code related to the above options assume, and this +hook allows users to deal with such questions explicitly. + +Each function is called with the process and the output string +as arguments until one of the functions returns non-nil. The +function is responsible for asking the user the appropriate +question using, e.g., `read-char-choice' and then forwarding the +answer to the process using `process-send-string'. + +While functions such as `magit-process-yes-or-no-prompt' may not +be sufficient to handle some prompt, it may still be of benefit +to look at the implementations to gain some insights on how to +implement such functions." + :package-version '(magit . "3.0.0") + :group 'magit-process + :type 'hook) + +(defcustom magit-process-ensure-unix-line-ending t + "Whether Magit should ensure a unix coding system when talking to Git." + :package-version '(magit . "2.6.0") + :group 'magit-process + :type 'boolean) + +(defcustom magit-process-display-mode-line-error t + "Whether Magit should retain and highlight process errors in the mode line." + :package-version '(magit . "2.12.0") + :group 'magit-process + :type 'boolean) + +(defcustom magit-process-timestamp-format nil + "Format of timestamp for each process in the process buffer. +If non-nil, pass this to `format-time-string' when creating a +process section in the process buffer, and insert the returned +string in the heading of its section." + :package-version '(magit . "4.0.0") + :group 'magit-process + :type '(choice (const :tag "none" nil) string)) + +(defvar tramp-pipe-stty-settings) +(defvar magit-tramp-pipe-stty-settings "" + "Override `tramp-pipe-stty-settings' in `magit-start-process'. + +The default for that Tramp variable is \"-icanon min 1 time 0\", +which causes staging of individual hunks to hang. Using \"\" +prevents that, but apparently has other issues, which is why it +isn't the default. + +This variable defaults to \"\" and is used to override the Tramp +variable in `magit-start-process'. This only has an effect when +using Tramp 2.6.2 or greater. This can also be set to `pty', in +which case a pty is used instead of a pipe. That also prevents +the hanging, but comes with its own problems (see #20). To fall +back to the value of `tramp-pipe-stty-settings', set this +variable to nil. + +Also see https://github.com/magit/magit/issues/4720 +and https://debbugs.gnu.org/cgi/bugreport.cgi?bug=62093.") + +(defface magit-process-ok + '((t :inherit magit-section-heading :foreground "green")) + "Face for zero exit-status." + :group 'magit-faces) + +(defface magit-process-ng + '((t :inherit magit-section-heading :foreground "red")) + "Face for non-zero exit-status." + :group 'magit-faces) + +(defface magit-mode-line-process + '((t :inherit mode-line-emphasis)) + "Face for `mode-line-process' status when Git is running for side-effects." + :group 'magit-faces) + +(defface magit-mode-line-process-error + '((t :inherit error)) + "Face for `mode-line-process' error status. + +Used when `magit-process-display-mode-line-error' is non-nil." + :group 'magit-faces) + +;;; Process Mode + +(defvar-keymap magit-process-mode-map + :doc "Keymap for `magit-process-mode'." + :parent magit-mode-map + "<remap> <magit-delete-thing>" #'magit-process-kill) + +(define-derived-mode magit-process-mode magit-mode "Magit Process" + "Mode for looking at Git process output." + :group 'magit-process + (hack-dir-local-variables-non-file-buffer) + (setq magit--imenu-item-types 'process)) + +(defun magit-process-buffer (&optional nodisplay) + "Display the current repository's process buffer. + +If that buffer doesn't exist yet, then create it. +Non-interactively return the buffer and unless +optional NODISPLAY is non-nil also display it." + (interactive) + (let ((topdir (magit-toplevel))) + (unless topdir + (magit--with-safe-default-directory nil + (setq topdir default-directory) + (let (prev) + (while (not (equal topdir prev)) + (setq prev topdir) + (setq topdir (file-name-directory (directory-file-name topdir))))))) + (let ((buffer (or (--first (with-current-buffer it + (and (eq major-mode 'magit-process-mode) + (equal default-directory topdir))) + (buffer-list)) + (magit-generate-new-buffer 'magit-process-mode + nil topdir)))) + (with-current-buffer buffer + (if magit-root-section + (when magit-process-log-max + (magit-process-truncate-log)) + (magit-process-mode) + (let ((inhibit-read-only t) + (magit-insert-section--parent nil) + (magit-insert-section--oldroot nil)) + (make-local-variable 'text-property-default-nonsticky) + (magit-insert-section (processbuf) + (insert "\n"))))) + (unless nodisplay + (magit-display-buffer buffer)) + buffer))) + +(defun magit-process-kill () + "Kill the process at point." + (interactive) + (when-let ((process (magit-section-value-if 'process))) + (unless (eq (process-status process) 'run) + (user-error "Process isn't running")) + (magit-confirm 'kill-process) + (kill-process process))) + +;;; Synchronous Processes + +(defvar magit-process-raise-error nil) + +(defun magit-git (&rest args) + "Call Git synchronously in a separate process, for side-effects. + +Option `magit-git-executable' specifies the Git executable. +The arguments ARGS specify arguments to Git, they are flattened +before use. + +Process output goes into a new section in the buffer returned by +`magit-process-buffer'. If Git exits with a non-zero status, +then raise an error." + (let ((magit-process-raise-error t)) + (magit-call-git args))) + +(defun magit-run-git (&rest args) + "Call Git synchronously in a separate process, and refresh. + +Function `magit-git-executable' specifies the Git executable and +option `magit-git-global-arguments' specifies constant arguments. +The arguments ARGS specify arguments to Git, they are flattened +before use. + +After Git returns, the current buffer (if it is a Magit buffer) +as well as the current repository's status buffer are refreshed. + +Process output goes into a new section in the buffer returned by +`magit-process-buffer'." + (let ((magit--refresh-cache (list (cons 0 0)))) + (magit-call-git args) + (when (member (car args) '("init" "clone")) + ;; Creating a new repository invalidates the cache. + (setq magit--refresh-cache nil)) + (magit-refresh))) + +(defvar magit-pre-call-git-hook nil) + +(defun magit-call-git (&rest args) + "Call Git synchronously in a separate process. + +Function `magit-git-executable' specifies the Git executable and +option `magit-git-global-arguments' specifies constant arguments. +The arguments ARGS specify arguments to Git, they are flattened +before use. + +Process output goes into a new section in the buffer returned by +`magit-process-buffer'." + (run-hooks 'magit-pre-call-git-hook) + (let ((default-process-coding-system (magit--process-coding-system))) + (apply #'magit-call-process + (magit-git-executable) + (magit-process-git-arguments args)))) + +(defun magit-call-process (program &rest args) + "Call PROGRAM synchronously in a separate process. +Process output goes into a new section in the buffer returned by +`magit-process-buffer'." + (pcase-let ((`(,process-buf . ,section) + (magit-process-setup program args))) + (magit-process-finish + (let ((inhibit-read-only t)) + (apply #'magit-process-file program nil process-buf nil args)) + process-buf (current-buffer) default-directory section))) + +(defun magit-process-git (destination &rest args) + "Call Git synchronously in a separate process, returning its exit code. +DESTINATION specifies how to handle the output, like for +`call-process', except that file handlers are supported. +Enable Cygwin's \"noglob\" option during the call and +ensure unix eol conversion." + (apply #'magit-process-file + (magit-git-executable) + nil destination nil + (magit-process-git-arguments args))) + +(defun magit-process-file (process &optional infile buffer display &rest args) + "Process files synchronously in a separate process. +Identical to `process-file' but temporarily enable Cygwin's +\"noglob\" option during the call and ensure unix eol +conversion." + (when magit-process-extreme-logging + (let ((inhibit-message t)) + (message "$ %s" (magit-process--format-arguments process args)))) + (let ((process-environment (magit-process-environment)) + (default-process-coding-system (magit--process-coding-system))) + (apply #'process-file process infile buffer display args))) + +(defun magit-process-environment () + ;; The various w32 hacks are only applicable when running on the local + ;; machine. A local binding of process-environment different from the + ;; top-level value affects the environment used in + ;; tramp-sh-handle-{start-file-process,process-file}. + (let ((local (not (file-remote-p default-directory)))) + (append magit-git-environment + (and local + (cdr (assoc magit-git-executable magit-git-w32-path-hack))) + (and local magit-need-cygwin-noglob + (mapcar (lambda (var) + (concat var "=" (if-let ((val (getenv var))) + (concat val " noglob") + "noglob"))) + '("CYGWIN" "MSYS"))) + process-environment))) + +(defvar magit-this-process nil) + +(defun magit-run-git-with-input (&rest args) + "Call Git in a separate process. +ARGS is flattened and then used as arguments to Git. + +The current buffer's content is used as the process's standard +input. The buffer is assumed to be temporary and thus OK to +modify. + +Function `magit-git-executable' specifies the Git executable and +option `magit-git-global-arguments' specifies constant arguments. +The remaining arguments ARGS specify arguments to Git, they are +flattened before use." + (when (eq system-type 'windows-nt) + ;; On w32, git expects UTF-8 encoded input, ignore any user + ;; configuration telling us otherwise (see #3250). + (encode-coding-region (point-min) (point-max) 'utf-8-unix)) + (if (file-remote-p default-directory) + ;; We lack `process-file-region', so fall back to asynch + + ;; waiting in remote case. + (progn + (magit-start-git (current-buffer) args) + (while (and magit-this-process + (eq (process-status magit-this-process) 'run)) + (sleep-for 0.005))) + (run-hooks 'magit-pre-call-git-hook) + (pcase-let* ((process-environment (magit-process-environment)) + (default-process-coding-system (magit--process-coding-system)) + (flat-args (magit-process-git-arguments args)) + (`(,process-buf . ,section) + (magit-process-setup (magit-git-executable) flat-args)) + (inhibit-read-only t)) + (magit-process-finish + (apply #'call-process-region (point-min) (point-max) + (magit-git-executable) nil process-buf nil flat-args) + process-buf nil default-directory section)))) + +;;; Asynchronous Processes + +(defun magit-run-git-async (&rest args) + "Start Git, prepare for refresh, and return the process object. +ARGS is flattened and then used as arguments to Git. + +Display the command line arguments in the echo area. + +After Git returns some buffers are refreshed: the buffer that was +current when this function was called (if it is a Magit buffer +and still alive), as well as the respective Magit status buffer. + +See `magit-start-process' for more information." + (message "Running %s %s" (magit-git-executable) + (let ((m (string-join (flatten-tree args) " "))) + (remove-list-of-text-properties 0 (length m) '(face) m) + m)) + (magit-start-git nil args)) + +(defun magit-run-git-with-editor (&rest args) + "Export GIT_EDITOR and start Git. +Also prepare for refresh and return the process object. +ARGS is flattened and then used as arguments to Git. + +Display the command line arguments in the echo area. + +After Git returns some buffers are refreshed: the buffer that was +current when this function was called (if it is a Magit buffer +and still alive), as well as the respective Magit status buffer. + +See `magit-start-process' and `with-editor' for more information." + (magit--record-separated-gitdir) + (magit-with-editor (magit-run-git-async args))) + +(defun magit-run-git-sequencer (&rest args) + "Export GIT_EDITOR and start Git. +Also prepare for refresh and return the process object. +ARGS is flattened and then used as arguments to Git. + +Display the command line arguments in the echo area. + +After Git returns some buffers are refreshed: the buffer that was +current when this function was called (if it is a Magit buffer +and still alive), as well as the respective Magit status buffer. +If the sequence stops at a commit, make the section representing +that commit the current section by moving `point' there. + +See `magit-start-process' and `with-editor' for more information." + (apply #'magit-run-git-with-editor args) + (set-process-sentinel magit-this-process #'magit-sequencer-process-sentinel) + magit-this-process) + +(defvar magit-pre-start-git-hook nil) + +(defun magit-start-git (input &rest args) + "Start Git, prepare for refresh, and return the process object. + +If INPUT is non-nil, it has to be a buffer or the name of an +existing buffer. The buffer content becomes the processes +standard input. + +Function `magit-git-executable' specifies the Git executable and +option `magit-git-global-arguments' specifies constant arguments. +The remaining arguments ARGS specify arguments to Git, they are +flattened before use. + +After Git returns some buffers are refreshed: the buffer that was +current when this function was called (if it is a Magit buffer +and still alive), as well as the respective Magit status buffer. + +See `magit-start-process' for more information." + (run-hooks 'magit-pre-start-git-hook) + (let ((default-process-coding-system (magit--process-coding-system))) + (apply #'magit-start-process (magit-git-executable) input + (magit-process-git-arguments args)))) + +(defun magit-start-process (program &optional input &rest args) + "Start PROGRAM, prepare for refresh, and return the process object. + +If optional argument INPUT is non-nil, it has to be a buffer or +the name of an existing buffer. The buffer content becomes the +processes standard input. + +The process is started using `start-file-process' and then setup +to use the sentinel `magit-process-sentinel' and the filter +`magit-process-filter'. Information required by these functions +is stored in the process object. When this function returns the +process has not started to run yet so it is possible to override +the sentinel and filter. + +After the process returns, `magit-process-sentinel' refreshes the +buffer that was current when `magit-start-process' was called (if +it is a Magit buffer and still alive), as well as the respective +Magit status buffer." + (pcase-let* + ((`(,process-buf . ,section) + (magit-process-setup program args)) + (process + (let ((process-connection-type ;t=pty nil=pipe + (or + ;; With Tramp, maybe force use a pty. #4720 + (and (file-remote-p default-directory) + (eq magit-tramp-pipe-stty-settings 'pty)) + ;; Without input, don't use a pty, because it would + ;; set icrnl, which would modify the input. #20 + (and (not input) magit-process-connection-type))) + (tramp-pipe-stty-settings + (or (and (not (eq magit-tramp-pipe-stty-settings 'pty)) + ;; Defaults to "", to allow staging hunks over + ;; Tramp again. #4720 + magit-tramp-pipe-stty-settings) + tramp-pipe-stty-settings)) + (process-environment (magit-process-environment)) + (default-process-coding-system (magit--process-coding-system))) + (apply #'start-file-process + (file-name-nondirectory program) + process-buf program args)))) + (with-editor-set-process-filter process #'magit-process-filter) + (set-process-sentinel process #'magit-process-sentinel) + (set-process-buffer process process-buf) + (when (eq system-type 'windows-nt) + ;; On w32, git expects UTF-8 encoded input, ignore any user + ;; configuration telling us otherwise. + (set-process-coding-system process nil 'utf-8-unix)) + (process-put process 'section section) + (process-put process 'command-buf (current-buffer)) + (process-put process 'default-dir default-directory) + (when magit-inhibit-refresh + (process-put process 'inhibit-refresh t)) + (oset section process process) + (with-current-buffer process-buf + (set-marker (process-mark process) (point))) + (when input + (with-current-buffer input + (process-send-region process (point-min) (point-max)) + ;; `process-send-eof' appears to be broken over + ;; Tramp from Windows. See #3624 and bug#43226. + (if (and (eq system-type 'windows-nt) + (file-remote-p (process-get process 'default-dir) nil t)) + (process-send-string process "") + (process-send-eof process)))) + (setq magit-this-process process) + (oset section value process) + (magit-process-display-buffer process) + process)) + +(defun magit-parse-git-async (&rest args) + (setq args (magit-process-git-arguments args)) + (let ((command-buf (current-buffer)) + (process-buf (generate-new-buffer " *temp*")) + (toplevel (magit-toplevel))) + (with-current-buffer process-buf + (setq default-directory toplevel) + (let ((process + (let ((process-connection-type nil) + (process-environment (magit-process-environment)) + (default-process-coding-system + (magit--process-coding-system))) + (apply #'start-file-process "git" process-buf + (magit-git-executable) args)))) + (process-put process 'command-buf command-buf) + (process-put process 'parsed (point)) + (setq magit-this-process process) + process)))) + +;;; Process Internals + +(defclass magit-process-section (magit-section) + ((process :initform nil))) + +(setf (alist-get 'process magit--section-type-alist) 'magit-process-section) + +(defun magit-process-setup (program args) + (magit-process-set-mode-line program args) + (let ((pwd default-directory) + (buf (magit-process-buffer t))) + (cons buf (with-current-buffer buf + (prog1 (magit-process-insert-section pwd program args nil nil) + (backward-char 1)))))) + +(defun magit-process-insert-section (pwd program args &optional errcode errlog) + (let ((inhibit-read-only t) + (magit-insert-section--parent magit-root-section) + (magit-insert-section--oldroot nil)) + (goto-char (1- (point-max))) + (magit-insert-section (process) + (insert (if errcode + (format "%3s " (propertize (number-to-string errcode) + 'font-lock-face 'magit-process-ng)) + "run ")) + (when magit-process-timestamp-format + (insert (format-time-string magit-process-timestamp-format) " ")) + (unless (equal (expand-file-name pwd) + (expand-file-name default-directory)) + (insert (file-relative-name pwd default-directory) ?\s)) + (insert (magit-process--format-arguments program args)) + (magit-insert-heading) + (when errlog + (if (bufferp errlog) + (insert (with-current-buffer errlog + (buffer-substring-no-properties (point-min) (point-max)))) + (insert-file-contents errlog) + (goto-char (1- (point-max))))) + (insert "\n")))) + +(defun magit-process--format-arguments (program args) + (cond + ((and args (equal program (magit-git-executable))) + (let ((global (length magit-git-global-arguments))) + (concat + (propertize (file-name-nondirectory program) + 'font-lock-face 'magit-section-heading) + " " + (propertize (magit--ellipsis) + 'font-lock-face 'magit-section-heading + 'help-echo (string-join (seq-take args global) " ")) + " " + (propertize (mapconcat #'shell-quote-argument (seq-drop args global) " ") + 'font-lock-face 'magit-section-heading)))) + ((and args (equal program shell-file-name)) + (propertize (cadr args) + 'font-lock-face 'magit-section-heading)) + (t + (concat (propertize (file-name-nondirectory program) + 'font-lock-face 'magit-section-heading) + " " + (propertize (mapconcat #'shell-quote-argument args " ") + 'font-lock-face 'magit-section-heading))))) + +(defun magit-process-truncate-log () + (let* ((head nil) + (tail (oref magit-root-section children)) + (count (length tail))) + (when (> (1+ count) magit-process-log-max) + (while (and (cdr tail) + (> count (/ magit-process-log-max 2))) + (let* ((inhibit-read-only t) + (section (car tail)) + (process (oref section process))) + (cond ((not process)) + ((memq (process-status process) '(exit signal)) + (delete-region (oref section start) + (1+ (oref section end))) + (cl-decf count)) + (t + (push section head)))) + (pop tail)) + (oset magit-root-section children + (nconc (reverse head) tail))))) + +(defun magit-process-sentinel (process event) + "Default sentinel used by `magit-start-process'." + (when (memq (process-status process) '(exit signal)) + (setq event (substring event 0 -1)) + (when (string-match "^finished" event) + (message (concat (capitalize (process-name process)) " finished"))) + (magit-process-finish process) + (when (eq process magit-this-process) + (setq magit-this-process nil)) + (unless (process-get process 'inhibit-refresh) + (let ((command-buf (process-get process 'command-buf))) + (if (buffer-live-p command-buf) + (with-current-buffer command-buf + (magit-refresh)) + (with-temp-buffer + (setq default-directory (process-get process 'default-dir)) + (magit-refresh))))))) + +(defun magit-sequencer-process-sentinel (process event) + "Special sentinel used by `magit-run-git-sequencer'." + (when (memq (process-status process) '(exit signal)) + (magit-process-sentinel process event) + (when-let* ((process-buf (process-buffer process)) + ((buffer-live-p process-buf)) + (status-buf (with-current-buffer process-buf + (magit-get-mode-buffer 'magit-status-mode)))) + (with-current-buffer status-buf + (when-let ((section + (magit-get-section + `((commit . ,(magit-rev-parse "HEAD")) + (,(pcase (car (seq-drop + (process-command process) + (1+ (length magit-git-global-arguments)))) + ((or "rebase" "am") 'rebase-sequence) + ((or "cherry-pick" "revert") 'sequence))) + (status))))) + (goto-char (oref section start)) + (magit-section-update-highlight)))))) + +(defun magit-process-filter (proc string) + "Default filter used by `magit-start-process'." + (with-current-buffer (process-buffer proc) + (let ((inhibit-read-only t)) + (goto-char (process-mark proc)) + ;; Find last ^M in string. If one was found, ignore + ;; everything before it and delete the current line. + (when-let ((ret-pos (cl-position ?\r string :from-end t))) + (cl-callf substring string (1+ ret-pos)) + (delete-region (line-beginning-position) (point))) + (setq string (magit-process-remove-bogus-errors string)) + (insert (propertize string 'magit-section + (process-get proc 'section))) + (set-marker (process-mark proc) (point)) + ;; Make sure prompts are matched after removing ^M. + (magit-process-yes-or-no-prompt proc string) + (magit-process-username-prompt proc string) + (magit-process-password-prompt proc string) + (run-hook-with-args-until-success 'magit-process-prompt-functions + proc string)))) + +(defun magit-process-make-keymap (process parent) + "Remap `abort-minibuffers' to a command that also kills PROCESS. +PARENT is used as the parent of the returned keymap." + (let ((cmd (lambda () + (interactive) + (ignore-errors (kill-process process)) + (if (fboundp 'abort-minibuffers) + (abort-minibuffers) + (abort-recursive-edit))))) + (define-keymap :parent parent + "C-g" cmd + "<remap> <abort-minibuffers>" cmd + "<remap> <abort-recursive-edit>" cmd))) + +(defmacro magit-process-kill-on-abort (process &rest body) + (declare (indent 1) + (debug (form body)) + (obsolete magit-process-make-keymap "Magit 4.0.0")) + `(let ((minibuffer-local-map + (magit-process-make-keymap ,process minibuffer-local-map))) + ,@body)) + +(defun magit-process-remove-bogus-errors (str) + (save-match-data + (when (string-match "^\\(\\*ERROR\\*: \\)Canceled by user" str) + (setq str (replace-match "" nil nil str 1))) + (when (string-match "^error: There was a problem with the editor.*\n" str) + (setq str (replace-match "" nil nil str))) + (when (string-match + "^Please supply the message using either -m or -F option\\.\n" str) + (setq str (replace-match "" nil nil str)))) + str) + +(defun magit-process-yes-or-no-prompt (process string) + "Forward Yes-or-No prompts to the user." + (when-let ((beg (string-match magit-process-yes-or-no-prompt-regexp string))) + (process-send-string + process + (if (save-match-data + (let ((max-mini-window-height 30) + (minibuffer-local-map + (magit-process-make-keymap process minibuffer-local-map)) + ;; In case yes-or-no-p is fset to that, but does + ;; not cover use-dialog-box-p and y-or-n-p-read-key. + (y-or-n-p-map + (magit-process-make-keymap process y-or-n-p-map))) + (yes-or-no-p (substring string 0 beg)))) + (concat (downcase (match-string 1 string)) "\n") + (concat (downcase (match-string 2 string)) "\n"))))) + +(defun magit-process-password-auth-source (key) + "Use `auth-source-search' to get a password. +If found, return the password. Otherwise, return nil. + +To use this function add it to the appropriate hook + (add-hook \\='magit-process-find-password-functions + \\='magit-process-password-auth-source) + +KEY typically derives from a prompt such as: + Password for \\='https://yourname@github.com\\=' +in which case it would be the string + yourname@github.com +which matches the ~/.authinfo.gpg entry + machine github.com login yourname password 12345 +or iff that is undefined, for backward compatibility + machine yourname@github.com password 12345 + +On github.com you should not use your password but a +personal access token, see [1]. For information about +the peculiarities of other forges, please consult the +respective documentation. + +After manually editing ~/.authinfo.gpg you must reset +the cache using + M-x auth-source-forget-all-cached RET + +The above will save you from having to repeatedly type +your token or password, but you might still repeatedly +be asked for your username. To prevent that, change an +URL like + https://github.com/foo/bar.git +to + https://yourname@github.com/foo/bar.git + +Instead of changing all such URLs manually, they can +be translated on the fly by doing this once + git config --global \ + url.https://yourname@github.com.insteadOf \ + https://github.com + +[1]: https://docs.github.com/en/github/authenticating-to-github/creating-a-personal-access-token." + (require 'auth-source) + (and (fboundp 'auth-source-search) + (string-match "\\`\\(.+\\)@\\([^@]+\\)\\'" key) + (let* ((user (match-string 1 key)) + (host (match-string 2 key)) + (secret + (plist-get + (car (or (auth-source-search :max 1 :host host :user user) + (auth-source-search :max 1 :host key))) + :secret))) + (if (functionp secret) + (funcall secret) + secret)))) + +(defun magit-process-git-credential-manager-core (process string) + "Authenticate using `git-credential-manager-core'. + +To use this function add it to the appropriate hook + (add-hook \\='magit-process-prompt-functions + \\='magit-process-git-credential-manager-core)" + (and (string-match "^option (enter for default): $" string) + (progn + (magit-process-buffer) + (let ((option (format "%c\n" + (read-char-choice "Option: " '(?\r ?\j ?1 ?2))))) + (insert-before-markers-and-inherit option) + (process-send-string process option))))) + +(defun magit-process-password-prompt (process string) + "Find a password based on prompt STRING and send it to git. +Use `magit-process-password-prompt-regexps' to find a known +prompt. If and only if one is found, then call functions in +`magit-process-find-password-functions' until one of them returns +the password. If all functions return nil, then read the password +from the user." + (when-let ((prompt (magit-process-match-prompt + magit-process-password-prompt-regexps string))) + (process-send-string + process + (concat (or (and-let* ((key (match-string 99 string))) + (run-hook-with-args-until-success + 'magit-process-find-password-functions key)) + (let ((read-passwd-map + (magit-process-make-keymap process read-passwd-map))) + (read-passwd prompt))) + "\n")))) + +(defun magit-process-username-prompt (process string) + "Forward username prompts to the user." + (when-let ((prompt (magit-process-match-prompt + magit-process-username-prompt-regexps string))) + (process-send-string + process + (let ((minibuffer-local-map + (magit-process-make-keymap process minibuffer-local-map))) + (concat (read-string prompt nil nil (user-login-name)) "\n"))))) + +(defun magit-process-match-prompt (prompts string) + "Match STRING against PROMPTS and set match data. +Return the matched string suffixed with \": \", if needed." + (when (--any-p (string-match it string) prompts) + (let ((prompt (match-string 0 string))) + (cond ((string-suffix-p ": " prompt) prompt) + ((string-suffix-p ":" prompt) (concat prompt " ")) + (t (concat prompt ": ")))))) + +(defun magit--process-coding-system () + (let ((fro (or magit-git-output-coding-system + (car default-process-coding-system))) + (to (cdr default-process-coding-system))) + (if magit-process-ensure-unix-line-ending + (cons (coding-system-change-eol-conversion fro 'unix) + (coding-system-change-eol-conversion to 'unix)) + (cons fro to)))) + +(defvar magit-credential-hook nil + "Hook run before Git needs credentials.") + +(defvar magit-credential-cache-daemon-process nil) + +(defun magit-maybe-start-credential-cache-daemon () + "Maybe start a `git-credential-cache--daemon' process. + +If such a process is already running or if the value of option +`magit-credential-cache-daemon-socket' is nil, then do nothing. +Otherwise start the process passing the value of that options +as argument." + (unless (or (not magit-credential-cache-daemon-socket) + (process-live-p magit-credential-cache-daemon-process) + (memq magit-credential-cache-daemon-process + (list-system-processes))) + (setq magit-credential-cache-daemon-process + (or (--first (let* ((attr (process-attributes it)) + (comm (cdr (assq 'comm attr))) + (user (cdr (assq 'user attr)))) + (and (string= comm "git-credential-cache--daemon") + (string= user user-login-name))) + (list-system-processes)) + (condition-case nil + (start-process "git-credential-cache--daemon" + " *git-credential-cache--daemon*" + (magit-git-executable) + "credential-cache--daemon" + magit-credential-cache-daemon-socket) + ;; Some Git implementations (e.g., Windows) won't have + ;; this program; if we fail the first time, stop trying. + ((debug error) + (remove-hook 'magit-credential-hook + #'magit-maybe-start-credential-cache-daemon))))))) + +(add-hook 'magit-credential-hook #'magit-maybe-start-credential-cache-daemon) + +(define-advice tramp-sh-handle-start-file-process + (:around (fn name buffer program &rest args) + magit-tramp-process-environment) + (if magit-tramp-process-environment + (apply fn name buffer + (car magit-tramp-process-environment) + (append (cdr magit-tramp-process-environment) + (cons program args))) + (apply fn name buffer program args))) + +(define-advice tramp-sh-handle-process-file + (:around (fn program &optional infile destination display &rest args) + magit-tramp-process-environment) + (if magit-tramp-process-environment + (apply fn "env" infile destination display + (append magit-tramp-process-environment + (cons program args))) + (apply fn program infile destination display args))) + +(defvar-keymap magit-mode-line-process-map + :doc "Keymap for `mode-line-process'." + "<mode-line> <mouse-1>" ''magit-process-buffer) + +(defun magit-process-set-mode-line (program args) + "Display the git command (sans arguments) in the mode line." + (when (equal program (magit-git-executable)) + (setq args (nthcdr (length magit-git-global-arguments) args))) + (let ((str (concat " " (propertize + (concat (file-name-nondirectory program) + (and args (concat " " (car args)))) + 'mouse-face 'highlight + 'keymap magit-mode-line-process-map + 'help-echo "mouse-1: Show process buffer" + 'font-lock-face 'magit-mode-line-process)))) + (magit-repository-local-set 'mode-line-process str) + (dolist (buf (magit-mode-get-buffers)) + (with-current-buffer buf + (setq mode-line-process str))) + (force-mode-line-update t))) + +(defun magit-process-set-mode-line-error-status (&optional error str) + "Apply an error face to the string set by `magit-process-set-mode-line'. + +If ERROR is supplied, include it in the `mode-line-process' tooltip. + +If STR is supplied, it replaces the `mode-line-process' text." + (setq str (or str (magit-repository-local-get 'mode-line-process))) + (when str + (setq error (format "%smouse-1: Show process buffer" + (if (stringp error) + (concat error "\n\n") + ""))) + (setq str (concat " " (propertize + (substring-no-properties str 1) + 'mouse-face 'highlight + 'keymap magit-mode-line-process-map + 'help-echo error + 'font-lock-face 'magit-mode-line-process-error))) + (magit-repository-local-set 'mode-line-process str) + (dolist (buf (magit-mode-get-buffers)) + (with-current-buffer buf + (setq mode-line-process str))) + (force-mode-line-update t) + ;; We remove any error status from the mode line when a magit + ;; buffer is refreshed (see `magit-refresh-buffer'), but we must + ;; ensure that we ignore any refreshes during the remainder of the + ;; current command -- otherwise a newly-set error status would be + ;; removed before it was seen. We set a flag which prevents the + ;; status from being removed prior to the next command, so that + ;; the error status is guaranteed to remain visible until then. + (let ((repokey (magit-repository-local-repository))) + ;; The following closure captures the repokey value, and is + ;; added to `pre-command-hook'. + (cl-labels ((enable-magit-process-unset-mode-line () + ;; Remove ourself from the hook variable, so + ;; that we only run once. + (remove-hook 'pre-command-hook + #'enable-magit-process-unset-mode-line) + ;; Clear the inhibit flag for the repository in + ;; which we set it. + (magit-repository-local-set + 'inhibit-magit-process-unset-mode-line nil repokey))) + ;; Set the inhibit flag until the next command is invoked. + (magit-repository-local-set + 'inhibit-magit-process-unset-mode-line t repokey) + (add-hook 'pre-command-hook + #'enable-magit-process-unset-mode-line))))) + +(defun magit-process-unset-mode-line-error-status () + "Remove any current error status from the mode line." + (let ((status (or mode-line-process + (magit-repository-local-get 'mode-line-process)))) + (when (and status + (eq (get-text-property 1 'font-lock-face status) + 'magit-mode-line-process-error)) + (magit-process-unset-mode-line)))) + +(add-hook 'magit-refresh-buffer-hook + #'magit-process-unset-mode-line-error-status) + +(defun magit-process-unset-mode-line (&optional directory) + "Remove the git command from the mode line." + (let ((default-directory (or directory default-directory))) + (unless (magit-repository-local-get 'inhibit-magit-process-unset-mode-line) + (magit-repository-local-set 'mode-line-process nil) + (dolist (buf (magit-mode-get-buffers)) + (with-current-buffer buf (setq mode-line-process nil))) + (force-mode-line-update t)))) + +(defvar magit-process-error-message-regexps + (list "^\\*ERROR\\*: Canceled by user$" + "^\\(?:error\\|fatal\\|git\\): \\(.*\\)$" + "^\\(Cannot rebase:.*\\)$")) + +(define-error 'magit-git-error "Git error") + +(defun magit-process-error-summary (process-buf section) + "A one-line error summary from the given SECTION." + (or (and (buffer-live-p process-buf) + (with-current-buffer process-buf + (and (oref section content) + (save-excursion + (goto-char (oref section end)) + (run-hook-wrapped + 'magit-process-error-message-regexps + (lambda (re) + (save-excursion + (and (re-search-backward + re (oref section start) t) + (or (match-string-no-properties 1) + (and (not magit-process-raise-error) + 'suppressed)))))))))) + "Git failed")) + +(defun magit-process-error-tooltip (process-buf section) + "Returns the text from SECTION of the PROCESS-BUF buffer. + +Limited by `magit-process-error-tooltip-max-lines'." + (and (integerp magit-process-error-tooltip-max-lines) + (> magit-process-error-tooltip-max-lines 0) + (buffer-live-p process-buf) + (with-current-buffer process-buf + (save-excursion + (goto-char (or (oref section content) + (oref section start))) + (buffer-substring-no-properties + (point) + (save-excursion + (forward-line magit-process-error-tooltip-max-lines) + (goto-char + (if (> (point) (oref section end)) + (oref section end) + (point))) + ;; Remove any trailing whitespace. + (when (re-search-backward "[^[:space:]\n]" + (oref section start) t) + (forward-char 1)) + (point))))))) + +(defvar-local magit-this-error nil) + +(defvar magit-process-finish-apply-ansi-colors nil) + +(defun magit-process-finish (arg &optional process-buf command-buf + default-dir section) + (unless (integerp arg) + (setq process-buf (process-buffer arg)) + (setq command-buf (process-get arg 'command-buf)) + (setq default-dir (process-get arg 'default-dir)) + (setq section (process-get arg 'section)) + (setq arg (process-exit-status arg))) + (when (fboundp 'dired-uncache) + (dired-uncache default-dir)) + (when (buffer-live-p process-buf) + (with-current-buffer process-buf + (let ((inhibit-read-only t) + (marker (oref section start))) + (goto-char marker) + (save-excursion + (delete-char 3) + (set-marker-insertion-type marker nil) + (insert (propertize (format "%3s" arg) + 'magit-section section + 'font-lock-face (if (= arg 0) + 'magit-process-ok + 'magit-process-ng))) + (set-marker-insertion-type marker t)) + (when magit-process-finish-apply-ansi-colors + (ansi-color-apply-on-region (oref section content) + (oref section end))) + (if (= (oref section end) + (+ (line-end-position) 2)) + (save-excursion + (goto-char (1+ (line-end-position))) + (delete-char -1) + (oset section content nil)) + (when (and (= arg 0) + (not (--any-p (eq (window-buffer it) process-buf) + (window-list)))) + (magit-section-hide section)))))) + (if (= arg 0) + ;; Unset the `mode-line-process' value upon success. + (magit-process-unset-mode-line default-dir) + ;; Otherwise process the error. + (let ((msg (magit-process-error-summary process-buf section))) + ;; Change `mode-line-process' to an error face upon failure. + (if magit-process-display-mode-line-error + (magit-process-set-mode-line-error-status + (or (magit-process-error-tooltip process-buf section) + msg)) + (magit-process-unset-mode-line default-dir)) + ;; Either signal the error, or else display the error summary in + ;; the status buffer and with a message in the echo area. + (cond + (magit-process-raise-error + (signal 'magit-git-error (list (format "%s (in %s)" msg default-dir)))) + ((not (eq msg 'suppressed)) + (when (buffer-live-p process-buf) + (with-current-buffer process-buf + (when-let ((status-buf (magit-get-mode-buffer 'magit-status-mode))) + (with-current-buffer status-buf + (setq magit-this-error msg))))) + (message "%s ... [%s buffer %s for details]" msg + (if-let ((key (and (buffer-live-p command-buf) + (with-current-buffer command-buf + (car (where-is-internal + 'magit-process-buffer)))))) + (format "Hit %s to see" (key-description key)) + "See") + (buffer-name process-buf)))))) + arg) + +(defun magit-process-display-buffer (process) + (when (process-live-p process) + (let ((buf (process-buffer process))) + (cond ((not (buffer-live-p buf))) + ((= magit-process-popup-time 0) + (if (minibufferp) + (switch-to-buffer-other-window buf) + (pop-to-buffer buf))) + ((> magit-process-popup-time 0) + (run-with-timer magit-process-popup-time nil + (lambda (p) + (when (eq (process-status p) 'run) + (let ((buf (process-buffer p))) + (when (buffer-live-p buf) + (if (minibufferp) + (switch-to-buffer-other-window buf) + (pop-to-buffer buf)))))) + process)))))) + +(defun magit--log-action (summary line list) + (let (heading lines) + (if (cdr list) + (progn (setq heading (funcall summary list)) + (setq lines (mapcar line list))) + (setq heading (funcall line (car list)))) + (with-current-buffer (magit-process-buffer t) + (goto-char (1- (point-max))) + (let ((inhibit-read-only t)) + (magit-insert-section (message) + (magit-insert-heading (concat " * " heading)) + (when lines + (dolist (line lines) + (insert line "\n")) + (insert "\n")))) + (let ((inhibit-message t)) + (when heading + (setq lines (cons heading lines))) + (message (string-join lines "\n")))))) + +;;; _ +(provide 'magit-process) +;;; magit-process.el ends here diff --git a/emacs/elpa/magit-20240625.2109/magit-process.elc b/emacs/elpa/magit-20240625.2109/magit-process.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/magit-pull.el b/emacs/elpa/magit-20240625.2109/magit-pull.el diff --git a/emacs/elpa/magit-20240622.1531/magit-pull.elc b/emacs/elpa/magit-20240625.2109/magit-pull.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/magit-push.el b/emacs/elpa/magit-20240625.2109/magit-push.el diff --git a/emacs/elpa/magit-20240622.1531/magit-push.elc b/emacs/elpa/magit-20240625.2109/magit-push.elc Binary files differ. diff --git a/emacs/elpa/magit-20240625.2109/magit-reflog.el b/emacs/elpa/magit-20240625.2109/magit-reflog.el @@ -0,0 +1,207 @@ +;;; magit-reflog.el --- Inspect ref history -*- lexical-binding:t -*- + +;; Copyright (C) 2008-2024 The Magit Project Contributors + +;; Author: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> +;; Maintainer: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; 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. +;; +;; 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 Magit. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This library implements support for looking at Git reflogs. + +;;; Code: + +(require 'magit-core) +(require 'magit-log) + +;;; Options + +(defcustom magit-reflog-limit 256 + "Maximal number of entries initially shown in reflog buffers. +The limit in the current buffer can be changed using \"+\" +and \"-\"." + :package-version '(magit . "3.0.0") + :group 'magit-commands + :type 'number) + +(defcustom magit-reflog-margin + (list (nth 0 magit-log-margin) + (nth 1 magit-log-margin) + 'magit-log-margin-width nil + (nth 4 magit-log-margin)) + "Format of the margin in `magit-reflog-mode' buffers. + +The value has the form (INIT STYLE WIDTH AUTHOR AUTHOR-WIDTH). + +If INIT is non-nil, then the margin is shown initially. +STYLE controls how to format the author or committer date. + It can be one of `age' (to show the age of the commit), + `age-abbreviated' (to abbreviate the time unit to a character), + or a string (suitable for `format-time-string') to show the + actual date. Option `magit-log-margin-show-committer-date' + controls which date is being displayed. +WIDTH controls the width of the margin. This exists for forward + compatibility and currently the value should not be changed. +AUTHOR controls whether the name of the author is also shown by + default. +AUTHOR-WIDTH has to be an integer. When the name of the author + is shown, then this specifies how much space is used to do so." + :package-version '(magit . "2.9.0") + :group 'magit-log + :group 'magit-margin + :type magit-log-margin--custom-type + :initialize #'magit-custom-initialize-reset + :set-after '(magit-log-margin) + :set (apply-partially #'magit-margin-set-variable 'magit-reflog-mode)) + +;;; Faces + +(defface magit-reflog-commit '((t :foreground "green")) + "Face for commit commands in reflogs." + :group 'magit-faces) + +(defface magit-reflog-amend '((t :foreground "magenta")) + "Face for amend commands in reflogs." + :group 'magit-faces) + +(defface magit-reflog-merge '((t :foreground "green")) + "Face for merge, checkout and branch commands in reflogs." + :group 'magit-faces) + +(defface magit-reflog-checkout '((t :foreground "blue")) + "Face for checkout commands in reflogs." + :group 'magit-faces) + +(defface magit-reflog-reset '((t :foreground "red")) + "Face for reset commands in reflogs." + :group 'magit-faces) + +(defface magit-reflog-rebase '((t :foreground "magenta")) + "Face for rebase commands in reflogs." + :group 'magit-faces) + +(defface magit-reflog-cherry-pick '((t :foreground "green")) + "Face for cherry-pick commands in reflogs." + :group 'magit-faces) + +(defface magit-reflog-remote '((t :foreground "cyan")) + "Face for pull and clone commands in reflogs." + :group 'magit-faces) + +(defface magit-reflog-other '((t :foreground "cyan")) + "Face for other commands in reflogs." + :group 'magit-faces) + +;;; Commands + +;;;###autoload +(defun magit-reflog-current () + "Display the reflog of the current branch. +If `HEAD' is detached, then show the reflog for that instead." + (interactive) + (magit-reflog-setup-buffer (or (magit-get-current-branch) "HEAD"))) + +;;;###autoload +(defun magit-reflog-other (ref) + "Display the reflog of a branch or another ref." + (interactive (list (magit-read-local-branch-or-ref "Show reflog for"))) + (magit-reflog-setup-buffer ref)) + +;;;###autoload +(defun magit-reflog-head () + "Display the `HEAD' reflog." + (interactive) + (magit-reflog-setup-buffer "HEAD")) + +;;; Mode + +(defvar-keymap magit-reflog-mode-map + :doc "Keymap for `magit-reflog-mode'." + :parent magit-log-mode-map + "C-c C-n" #'undefined + "L" #'magit-margin-settings) + +(define-derived-mode magit-reflog-mode magit-mode "Magit Reflog" + "Mode for looking at Git reflog. + +This mode is documented in info node `(magit)Reflog'. + +\\<magit-mode-map>\ +Type \\[magit-refresh] to refresh the current buffer. +Type \\[magit-visit-thing] or \\[magit-diff-show-or-scroll-up] \ +to visit the commit at point. + +Type \\[magit-cherry-pick] to apply the commit at point. +Type \\[magit-reset] to reset `HEAD' to the commit at point. + +\\{magit-reflog-mode-map}" + :group 'magit-log + (hack-dir-local-variables-non-file-buffer) + (setq magit--imenu-item-types 'commit)) + +(defun magit-reflog-setup-buffer (ref) + (require 'magit) + (magit-setup-buffer #'magit-reflog-mode nil + (magit-buffer-refname ref) + (magit-buffer-log-args (list (format "-n%s" magit-reflog-limit))))) + +(defun magit-reflog-refresh-buffer () + (magit-set-header-line-format (concat "Reflog for " magit-buffer-refname)) + (magit-insert-section (reflogbuf) + (magit-git-wash (apply-partially #'magit-log-wash-log 'reflog) + "reflog" "show" "--format=%h%x00%aN%x00%gd%x00%gs" "--date=raw" + magit-buffer-log-args magit-buffer-refname "--"))) + +(cl-defmethod magit-buffer-value (&context (major-mode magit-reflog-mode)) + magit-buffer-refname) + +(defvar magit-reflog-labels + '(("commit" . magit-reflog-commit) + ("amend" . magit-reflog-amend) + ("merge" . magit-reflog-merge) + ("checkout" . magit-reflog-checkout) + ("branch" . magit-reflog-checkout) + ("reset" . magit-reflog-reset) + ("rebase" . magit-reflog-rebase) + ("rewritten" . magit-reflog-rebase) + ("cherry-pick" . magit-reflog-cherry-pick) + ("initial" . magit-reflog-commit) + ("pull" . magit-reflog-remote) + ("clone" . magit-reflog-remote) + ("autosave" . magit-reflog-commit) + ("restart" . magit-reflog-reset))) + +(defun magit-reflog-format-subject (subject) + (let* ((match (string-match magit-reflog-subject-re subject)) + (command (and match (match-string 1 subject))) + (option (and match (match-string 2 subject))) + (type (and match (match-string 3 subject))) + (label (if (string= command "commit") + (or type command) + command)) + (text (if (string= command "commit") + label + (string-join (delq nil (list command option type)) " ")))) + (format "%-16s " + (magit--propertize-face + text (or (cdr (assoc label magit-reflog-labels)) + 'magit-reflog-other))))) + +;;; _ +(provide 'magit-reflog) +;;; magit-reflog.el ends here diff --git a/emacs/elpa/magit-20240625.2109/magit-reflog.elc b/emacs/elpa/magit-20240625.2109/magit-reflog.elc Binary files differ. diff --git a/emacs/elpa/magit-20240625.2109/magit-refs.el b/emacs/elpa/magit-20240625.2109/magit-refs.el @@ -0,0 +1,789 @@ +;;; magit-refs.el --- Listing references -*- lexical-binding:t -*- + +;; Copyright (C) 2008-2024 The Magit Project Contributors + +;; Author: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> +;; Maintainer: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; 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. +;; +;; 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 Magit. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This library implements support for listing references in a buffer. + +;;; Code: + +(require 'magit) + +;;; Options + +(defgroup magit-refs nil + "Inspect and manipulate Git branches and tags." + :link '(info-link "(magit)References Buffer") + :group 'magit-modes) + +(defcustom magit-refs-mode-hook nil + "Hook run after entering Magit-Refs mode." + :package-version '(magit . "2.1.0") + :group 'magit-refs + :type 'hook) + +(defcustom magit-refs-sections-hook + '(magit-insert-error-header + magit-insert-branch-description + magit-insert-local-branches + magit-insert-remote-branches + magit-insert-tags) + "Hook run to insert sections into a references buffer." + :package-version '(magit . "2.1.0") + :group 'magit-refs + :type 'hook) + +(defcustom magit-refs-show-commit-count nil + "Whether to show commit counts in Magit-Refs mode buffers. + +all Show counts for branches and tags. +branch Show counts for branches only. +nil Never show counts. + +To change the value in an existing buffer use the command +`magit-refs-set-show-commit-count'." + :package-version '(magit . "2.1.0") + :group 'magit-refs + :safe (lambda (val) (memq val '(all branch nil))) + :type '(choice (const :tag "For branches and tags" all) + (const :tag "For branches only" branch) + (const :tag "Never" nil))) +(put 'magit-refs-show-commit-count 'safe-local-variable 'symbolp) +(put 'magit-refs-show-commit-count 'permanent-local t) + +(defcustom magit-refs-pad-commit-counts nil + "Whether to pad all counts on all sides in `magit-refs-mode' buffers. + +If this is nil, then some commit counts are displayed right next +to one of the branches that appear next to the count, without any +space in between. This might look bad if the branch name faces +look too similar to `magit-dimmed'. + +If this is non-nil, then spaces are placed on both sides of all +commit counts." + :package-version '(magit . "2.12.0") + :group 'magit-refs + :type 'boolean) + +(defvar magit-refs-show-push-remote nil + "Whether to show the push-remotes of local branches. +Also show the commits that the local branch is ahead and behind +the push-target. Unfortunately there is a bug in Git that makes +this useless (the commits ahead and behind the upstream are +shown), so this isn't enabled yet.") + +(defcustom magit-refs-show-remote-prefix nil + "Whether to show the remote prefix in lists of remote branches. + +This is redundant because the name of the remote is already shown +in the heading preceding the list of its branches." + :package-version '(magit . "2.12.0") + :group 'magit-refs + :type 'boolean) + +(defcustom magit-refs-margin + (list nil + (nth 1 magit-log-margin) + 'magit-log-margin-width nil + (nth 4 magit-log-margin)) + "Format of the margin in `magit-refs-mode' buffers. + +The value has the form (INIT STYLE WIDTH AUTHOR AUTHOR-WIDTH). + +If INIT is non-nil, then the margin is shown initially. +STYLE controls how to format the author or committer date. + It can be one of `age' (to show the age of the commit), + `age-abbreviated' (to abbreviate the time unit to a character), + or a string (suitable for `format-time-string') to show the + actual date. Option `magit-log-margin-show-committer-date' + controls which date is being displayed. +WIDTH controls the width of the margin. This exists for forward + compatibility and currently the value should not be changed. +AUTHOR controls whether the name of the author is also shown by + default. +AUTHOR-WIDTH has to be an integer. When the name of the author + is shown, then this specifies how much space is used to do so." + :package-version '(magit . "2.9.0") + :group 'magit-refs + :group 'magit-margin + :safe (lambda (val) (memq val '(all branch nil))) + :type magit-log-margin--custom-type + :initialize #'magit-custom-initialize-reset + :set-after '(magit-log-margin) + :set (apply-partially #'magit-margin-set-variable 'magit-refs-mode)) + +(defcustom magit-refs-margin-for-tags nil + "Whether to show information about tags in the margin. + +This is disabled by default because it is slow if there are many +tags." + :package-version '(magit . "2.9.0") + :group 'magit-refs + :group 'magit-margin + :type 'boolean) + +(defcustom magit-refs-primary-column-width (cons 16 32) + "Width of the focus column in `magit-refs-mode' buffers. + +The primary column is the column that contains the name of the +branch that the current row is about. + +If this is an integer, then the column is that many columns wide. +Otherwise it has to be a cons-cell of two integers. The first +specifies the minimal width, the second the maximal width. In that +case the actual width is determined using the length of the names +of the shown local branches. (Remote branches and tags are not +taken into account when calculating to optimal width.)" + :package-version '(magit . "2.12.0") + :group 'magit-refs + :type '(choice (integer :tag "Constant wide") + (cons :tag "Wide constrains" + (integer :tag "Minimum") + (integer :tag "Maximum")))) + +(defcustom magit-refs-focus-column-width 5 + "Width of the focus column in `magit-refs-mode' buffers. + +The focus column is the first column, which marks one +branch (usually the current branch) as the focused branch using +\"*\" or \"@\". For each other reference, this column optionally +shows how many commits it is ahead of the focused branch and \"<\", or +if it isn't ahead then the commits it is behind and \">\", or if it +isn't behind either, then a \"=\". + +This column may also display only \"*\" or \"@\" for the focused +branch, in which case this option is ignored. Use \"L v\" to +change the verbosity of this column." + :package-version '(magit . "2.12.0") + :group 'magit-refs + :type 'integer) + +(defcustom magit-refs-filter-alist nil + "Alist controlling which refs are omitted from `magit-refs-mode' buffers. + +The purpose of this option is to forgo displaying certain refs +based on their name. If you want to not display any refs of a +certain type, then you should remove the appropriate function +from `magit-refs-sections-hook' instead. + +All keys are tried in order until one matches. Then its value +is used and subsequent elements are ignored. If the value is +non-nil, then the reference is displayed, otherwise it is not. +If no element matches, then the reference is displayed. + +A key can either be a regular expression that the refname has to +match, or a function that takes the refname as only argument and +returns a boolean. A remote branch such as \"origin/master\" is +displayed as just \"master\", however for this comparison the +former is used." + :package-version '(magit . "2.12.0") + :group 'magit-refs + :type '(alist :key-type (choice :tag "Key" regexp function) + :value-type (boolean :tag "Value" + :on "show (non-nil)" + :off "omit (nil)"))) + +(defcustom magit-visit-ref-behavior nil + "Control how `magit-visit-ref' behaves in `magit-refs-mode' buffers. + +By default `magit-visit-ref' behaves like `magit-show-commit', +in all buffers, including `magit-refs-mode' buffers. When the +type of the section at point is `commit' then \"RET\" is bound to +`magit-show-commit', and when the type is either `branch' or +`tag' then it is bound to `magit-visit-ref'. + +\"RET\" is one of Magit's most essential keys and at least by +default it should behave consistently across all of Magit, +especially because users quickly learn that it does something +very harmless; it shows more information about the thing at point +in another buffer. + +However \"RET\" used to behave differently in `magit-refs-mode' +buffers, doing surprising things, some of which cannot really be +described as \"visit this thing\". If you have grown accustomed +to such inconsistent, but to you useful, behavior, then you can +restore that by adding one or more of the below symbols to the +value of this option. But keep in mind that by doing so you +don't only introduce inconsistencies, you also lose some +functionality and might have to resort to `M-x magit-show-commit' +to get it back. + +`magit-visit-ref' looks for these symbols in the order in which +they are described here. If the presence of a symbol applies to +the current situation, then the symbols that follow do not affect +the outcome. + +`focus-on-ref' + + With a prefix argument update the buffer to show commit counts + and lists of cherry commits relative to the reference at point + instead of relative to the current buffer or `HEAD'. + + Instead of adding this symbol, consider pressing \"C-u y o RET\". + +`create-branch' + + If point is on a remote branch, then create a new local branch + with the same name, use the remote branch as its upstream, and + then check out the local branch. + + Instead of adding this symbol, consider pressing \"b c RET RET\", + like you would do in other buffers. + +`checkout-any' + + Check out the reference at point. If that reference is a tag + or a remote branch, then this results in a detached `HEAD'. + + Instead of adding this symbol, consider pressing \"b b RET\", + like you would do in other buffers. + +`checkout-branch' + + Check out the local branch at point. + + Instead of adding this symbol, consider pressing \"b b RET\", + like you would do in other buffers." + :package-version '(magit . "2.9.0") + :group 'magit-refs + :group 'magit-commands + :options '(focus-on-ref create-branch checkout-any checkout-branch) + :type '(list :convert-widget custom-hook-convert-widget)) + +;;; Mode + +(defvar-keymap magit-refs-mode-map + :doc "Keymap for `magit-refs-mode'." + :parent magit-mode-map + "C-y" #'magit-refs-set-show-commit-count + "L" #'magit-margin-settings) + +(define-derived-mode magit-refs-mode magit-mode "Magit Refs" + "Mode which lists and compares references. + +This mode is documented in info node `(magit)References Buffer'. + +\\<magit-mode-map>\ +Type \\[magit-refresh] to refresh the current buffer. +Type \\[magit-section-toggle] to expand or hide the section at point. +Type \\[magit-visit-thing] or \\[magit-diff-show-or-scroll-up] \ +to visit the commit or branch at point. + +Type \\[magit-branch] to see available branch commands. +Type \\[magit-merge] to merge the branch or commit at point. +Type \\[magit-cherry-pick] to apply the commit at point. +Type \\[magit-reset] to reset `HEAD' to the commit at point. + +\\{magit-refs-mode-map}" + :group 'magit-refs + (hack-dir-local-variables-non-file-buffer) + (setq magit--imenu-group-types '(local remote tags))) + +(defun magit-refs-setup-buffer (ref args) + (magit-setup-buffer #'magit-refs-mode nil + (magit-buffer-upstream ref) + (magit-buffer-arguments args))) + +(defun magit-refs-refresh-buffer () + (setq magit-set-buffer-margin-refresh (not (magit-buffer-margin-p))) + (unless (magit-rev-verify magit-buffer-upstream) + (setq magit-refs-show-commit-count nil)) + (magit-set-header-line-format + (format "%s %s" magit-buffer-upstream + (string-join magit-buffer-arguments " "))) + (magit-insert-section (branchbuf) + (magit-run-section-hook 'magit-refs-sections-hook)) + (add-hook 'kill-buffer-hook #'magit-preserve-section-visibility-cache)) + +(cl-defmethod magit-buffer-value (&context (major-mode magit-refs-mode)) + (cons magit-buffer-upstream magit-buffer-arguments)) + +;;; Commands + +;;;###autoload (autoload 'magit-show-refs "magit-refs" nil t) +(transient-define-prefix magit-show-refs (&optional transient) + "List and compare references in a dedicated buffer." + :man-page "git-branch" + :value (lambda () + (magit-show-refs-arguments magit-prefix-use-buffer-arguments)) + ["Arguments" + (magit-for-each-ref:--contains) + ("-M" "Merged" "--merged=" magit-transient-read-revision) + ("-m" "Merged to HEAD" "--merged") + ("-N" "Not merged" "--no-merged=" magit-transient-read-revision) + ("-n" "Not merged to HEAD" "--no-merged") + (magit-for-each-ref:--sort)] + ["Actions" + ("y" "Show refs, comparing them with HEAD" magit-show-refs-head) + ("c" "Show refs, comparing them with current branch" magit-show-refs-current) + ("o" "Show refs, comparing them with other branch" magit-show-refs-other) + ("r" "Show refs, changing commit count display" + magit-refs-set-show-commit-count)] + (interactive (list (or (derived-mode-p 'magit-refs-mode) + current-prefix-arg))) + (if transient + (transient-setup 'magit-show-refs) + (magit-refs-setup-buffer "HEAD" (magit-show-refs-arguments)))) + +(defun magit-show-refs-arguments (&optional use-buffer-args) + (unless use-buffer-args + (setq use-buffer-args magit-direct-use-buffer-arguments)) + (let (args) + (cond + ((eq transient-current-command 'magit-show-refs) + (setq args (transient-args 'magit-show-refs))) + ((eq major-mode 'magit-refs-mode) + (setq args magit-buffer-arguments)) + ((and (memq use-buffer-args '(always selected)) + (and-let* ((buffer (magit-get-mode-buffer + 'magit-refs-mode nil + (eq use-buffer-args 'selected)))) + (progn + (setq args (buffer-local-value 'magit-buffer-arguments buffer)) + t)))) + (t + (setq args (alist-get 'magit-show-refs transient-values)))) + args)) + +(transient-define-argument magit-for-each-ref:--contains () + :description "Contains" + :class 'transient-option + :key "-c" + :argument "--contains=" + :reader #'magit-transient-read-revision) + +(transient-define-argument magit-for-each-ref:--sort () + :description "Sort" + :class 'transient-option + :key "-s" + :argument "--sort=" + :reader #'magit-read-ref-sort) + +(defun magit-read-ref-sort (prompt initial-input _history) + (magit-completing-read prompt + '("-committerdate" "-authordate" + "committerdate" "authordate") + nil nil initial-input)) + +;;;###autoload +(defun magit-show-refs-head (&optional args) + "List and compare references in a dedicated buffer. +Compared with `HEAD'." + (interactive (list (magit-show-refs-arguments))) + (magit-refs-setup-buffer "HEAD" args)) + +;;;###autoload +(defun magit-show-refs-current (&optional args) + "List and compare references in a dedicated buffer. +Compare with the current branch or `HEAD' if it is detached." + (interactive (list (magit-show-refs-arguments))) + (magit-refs-setup-buffer (magit-get-current-branch) args)) + +;;;###autoload +(defun magit-show-refs-other (&optional ref args) + "List and compare references in a dedicated buffer. +Compared with a branch read from the user." + (interactive (list (magit-read-other-branch "Compare with") + (magit-show-refs-arguments))) + (magit-refs-setup-buffer ref args)) + +(transient-define-suffix magit-refs-set-show-commit-count () + "Change for which refs the commit count is shown." + :description "Change verbosity" + :key "v" + :transient nil + :if-derived 'magit-refs-mode + (interactive) + (setq-local magit-refs-show-commit-count + (magit-read-char-case "Show commit counts for " nil + (?a "[a]ll refs" 'all) + (?b "[b]ranches only" t) + (?n "[n]othing" nil))) + (magit-refresh)) + +(defun magit-visit-ref () + "Visit the reference or revision at point in another buffer. +If there is no revision at point or with a prefix argument prompt +for a revision. + +This command behaves just like `magit-show-commit', except if +point is on a reference in a `magit-refs-mode' buffer (a buffer +listing branches and tags), in which case the behavior may be +different, but only if you have customized the option +`magit-visit-ref-behavior' (which see). When invoked from a +menu this command always behaves like `magit-show-commit'." + (interactive) + (if (and (derived-mode-p 'magit-refs-mode) + (magit-section-match '(branch tag)) + (not (magit-menu-position))) + (let ((ref (oref (magit-current-section) value))) + (cond (current-prefix-arg + (cond ((memq 'focus-on-ref magit-visit-ref-behavior) + (magit-refs-setup-buffer ref (magit-show-refs-arguments))) + (magit-visit-ref-behavior + ;; Don't prompt for commit to visit. + (let ((current-prefix-arg nil)) + (call-interactively #'magit-show-commit))))) + ((and (memq 'create-branch magit-visit-ref-behavior) + (magit-section-match [branch remote])) + (let ((branch (cdr (magit-split-branch-name ref)))) + (if (magit-branch-p branch) + (if (magit-rev-eq branch ref) + (magit-call-git "checkout" branch) + (setq branch (propertize branch 'face 'magit-branch-local)) + (setq ref (propertize ref 'face 'magit-branch-remote)) + (pcase (prog1 (read-char-choice (format (propertize "\ +Branch %s already exists. + [c]heckout %s as-is + [r]reset %s to %s and checkout %s + [a]bort " 'face 'minibuffer-prompt) branch branch branch ref branch) + '(?c ?r ?a)) + (message "")) ; otherwise prompt sticks + (?c (magit-call-git "checkout" branch)) + (?r (magit-call-git "checkout" "-B" branch ref)) + (?a (user-error "Abort")))) + (magit-call-git "checkout" "-b" branch ref)) + (setq magit-buffer-upstream branch) + (magit-refresh))) + ((or (memq 'checkout-any magit-visit-ref-behavior) + (and (memq 'checkout-branch magit-visit-ref-behavior) + (magit-section-match [branch local]))) + (magit-call-git "checkout" ref) + (setq magit-buffer-upstream ref) + (magit-refresh)) + (t + (call-interactively #'magit-show-commit)))) + (call-interactively #'magit-show-commit))) + +;;; Sections + +(defvar-keymap magit-remote-section-map + :doc "Keymap for `remote' sections." + "<remap> <magit-file-rename>" #'magit-remote-rename + "<remap> <magit-delete-thing>" #'magit-remote-remove + "<2>" (magit-menu-item "Rename %s" #'magit-remote-rename) + "<1>" (magit-menu-item "Remove %m" #'magit-remote-remove)) + +(defvar-keymap magit-branch-section-map + :doc "Keymap for `branch' sections." + "<remap> <magit-file-rename>" #'magit-branch-rename + "<remap> <magit-delete-thing>" #'magit-branch-delete + "<remap> <magit-visit-thing>" #'magit-visit-ref + "<3>" (magit-menu-item "Rename %s" #'magit-branch-rename) + "<2>" (magit-menu-item "Delete %m" #'magit-branch-delete) + "<1>" (magit-menu-item "Visit commit" #'magit-visit-ref)) + +(defvar-keymap magit-tag-section-map + :doc "Keymap for `tag' sections." + "<remap> <magit-delete-thing>" #'magit-tag-delete + "<remap> <magit-visit-thing>" #'magit-visit-ref + "<2>" (magit-menu-item "Delete %m" #'magit-tag-delete) + "<1>" (magit-menu-item "Visit %s" #'magit-visit-ref)) + +(defun magit--painted-branch-as-menu-section (section) + (and-let* ((branch (and (magit-section-match 'commit) + (magit--painted-branch-at-point)))) + (let ((dummy (magit-section :type 'branch :value branch))) + (oset dummy keymap magit-branch-section-map) + (dolist (slot '(start content hidden parent children)) + (when (slot-boundp section slot) + (setf (eieio-oref dummy slot) + (eieio-oref section slot)))) + dummy))) + +(add-hook 'magit-menu-alternative-section-hook + #'magit--painted-branch-as-menu-section) + +(defun magit-insert-branch-description () + "Insert header containing the description of the current branch. +Insert a header line with the name and description of the +current branch. The description is taken from the Git variable +`branch.<NAME>.description'; if that is undefined then no header +line is inserted at all." + (when-let* ((branch (magit-get-current-branch)) + (desc (magit-get "branch" branch "description")) + (desc (split-string desc "\n"))) + (when (equal (car (last desc)) "") + (setq desc (butlast desc))) + (magit-insert-section (branchdesc branch t) + (magit-insert-heading branch ": " (car desc)) + (when (cdr desc) + (insert (string-join (cdr desc) "\n")) + (insert "\n\n"))))) + +(defun magit-insert-tags () + "Insert sections showing all tags." + (when-let ((tags (magit-git-lines "tag" "--list" "-n" magit-buffer-arguments))) + (let ((_head (magit-rev-parse "HEAD"))) + (magit-insert-section (tags) + (magit-insert-heading (length tags) "Tags") + (dolist (tag tags) + (string-match "^\\([^ \t]+\\)[ \t]+\\([^ \t\n].*\\)?" tag) + (let ((tag (match-string 1 tag)) + (msg (match-string 2 tag))) + (when (magit-refs--insert-refname-p tag) + (magit-insert-section (tag tag t) + (magit-insert-heading + (magit-refs--format-focus-column tag 'tag) + (propertize tag 'font-lock-face 'magit-tag) + (make-string + (max 1 (- (if (consp magit-refs-primary-column-width) + (car magit-refs-primary-column-width) + magit-refs-primary-column-width) + (length tag))) + ?\s) + (and msg (magit-log-propertize-keywords nil msg))) + (when (and magit-refs-margin-for-tags (magit-buffer-margin-p)) + (magit-refs--format-margin tag)) + (magit-refs--insert-cherry-commits tag))))) + (insert ?\n) + (magit-make-margin-overlay nil t))))) + +(defun magit-insert-remote-branches () + "Insert sections showing all remote-tracking branches." + (dolist (remote (magit-list-remotes)) + (magit-insert-section (remote remote) + (magit-insert-heading + (let ((pull (magit-get "remote" remote "url")) + (push (magit-get "remote" remote "pushurl"))) + (format (propertize "Remote %s (%s):" + 'font-lock-face 'magit-section-heading) + (propertize remote 'font-lock-face 'magit-branch-remote) + (concat pull (and pull push ", ") push)))) + (let (head) + (dolist (line (magit-git-lines "for-each-ref" "--format=\ +%(symref:short)%00%(refname:short)%00%(refname)%00%(subject)" + (concat "refs/remotes/" remote) + magit-buffer-arguments)) + (pcase-let ((`(,head-branch ,branch ,ref ,msg) + (cl-substitute nil "" + (split-string line "\0") + :test #'equal))) + (cond + (head-branch + ;; Note: Use `ref' instead of `branch' for the check + ;; below because 'refname:short' shortens the remote + ;; HEAD to '<remote>' instead of '<remote>/HEAD' as of + ;; Git v2.40.0. + (cl-assert + (equal ref (concat "refs/remotes/" remote "/HEAD"))) + (setq head head-branch)) + ((not (equal ref (concat "refs/remotes/" remote "/HEAD"))) + ;; ^ Skip mis-configured remotes where HEAD is not a + ;; symref. See #5092. + (when (magit-refs--insert-refname-p branch) + (magit-insert-section (branch branch t) + (let ((headp (equal branch head)) + (abbrev (if magit-refs-show-remote-prefix + branch + (substring branch (1+ (length remote)))))) + (magit-insert-heading + (magit-refs--format-focus-column branch) + (magit-refs--propertize-branch + abbrev ref (and headp 'magit-branch-remote-head)) + (make-string + (max 1 (- (if (consp magit-refs-primary-column-width) + (car magit-refs-primary-column-width) + magit-refs-primary-column-width) + (length abbrev))) + ?\s) + (and msg (magit-log-propertize-keywords nil msg)))) + (when (magit-buffer-margin-p) + (magit-refs--format-margin branch)) + (magit-refs--insert-cherry-commits branch)))))))) + (insert ?\n) + (magit-make-margin-overlay nil t)))) + +(defun magit-insert-local-branches () + "Insert sections showing all local branches." + (magit-insert-section (local nil) + (magit-insert-heading t "Branches") + (dolist (line (magit-refs--format-local-branches)) + (pcase-let ((`(,branch . ,strings) line)) + (magit-insert-section + ((eval (if branch 'branch 'commit)) + (or branch (magit-rev-parse "HEAD")) + t) + (apply #'magit-insert-heading strings) + (when (magit-buffer-margin-p) + (magit-refs--format-margin branch)) + (magit-refs--insert-cherry-commits branch)))) + (insert ?\n) + (magit-make-margin-overlay nil t))) + +(defun magit-refs--format-local-branches () + (let ((lines (seq-keep #'magit-refs--format-local-branch + (magit-git-lines + "for-each-ref" + (concat "--format=\ +%(HEAD)%00%(refname:short)%00%(refname)%00\ +%(upstream:short)%00%(upstream)%00%(upstream:track)%00" + (if magit-refs-show-push-remote "\ +%(push:remotename)%00%(push)%00%(push:track)%00%(subject)" + "%00%00%00%(subject)")) + "refs/heads" + magit-buffer-arguments)))) + (unless (magit-get-current-branch) + (push (magit-refs--format-local-branch + (concat "*\0\0\0\0\0\0\0\0" (magit-rev-format "%s"))) + lines)) + (setq-local magit-refs-primary-column-width + (let ((def (default-value 'magit-refs-primary-column-width))) + (if (atom def) + def + (pcase-let ((`(,min . ,max) def)) + (min max (apply #'max min (mapcar #'car lines))))))) + (mapcar (pcase-lambda (`(,_ ,branch ,focus ,branch-desc ,u:ahead ,p:ahead + ,u:behind ,upstream ,p:behind ,push ,msg)) + (list branch focus branch-desc u:ahead p:ahead + (make-string (max 1 (- magit-refs-primary-column-width + (length (concat branch-desc + u:ahead + p:ahead + u:behind)))) + ?\s) + u:behind upstream p:behind push + msg)) + lines))) + +(defun magit-refs--format-local-branch (line) + (pcase-let ((`(,head ,branch ,ref ,upstream ,u:ref ,u:track + ,push ,p:ref ,p:track ,msg) + (cl-substitute nil "" (split-string line "\0") :test #'equal))) + (when (or (not branch) + (magit-refs--insert-refname-p branch)) + (let* ((headp (equal head "*")) + (pushp (and push + magit-refs-show-push-remote + (magit-rev-verify p:ref) + (not (equal p:ref u:ref)))) + (branch-desc + (if branch + (magit-refs--propertize-branch + branch ref (and headp 'magit-branch-current)) + (magit--propertize-face "(detached)" 'magit-branch-warning))) + (u:ahead (and u:track + (string-match "ahead \\([0-9]+\\)" u:track) + (magit--propertize-face + (concat (and magit-refs-pad-commit-counts " ") + (match-string 1 u:track) + ">") + 'magit-dimmed))) + (u:behind (and u:track + (string-match "behind \\([0-9]+\\)" u:track) + (magit--propertize-face + (concat "<" + (match-string 1 u:track) + (and magit-refs-pad-commit-counts " ")) + 'magit-dimmed))) + (p:ahead (and pushp p:track + (string-match "ahead \\([0-9]+\\)" p:track) + (magit--propertize-face + (concat (match-string 1 p:track) + ">" + (and magit-refs-pad-commit-counts " ")) + 'magit-branch-remote))) + (p:behind (and pushp p:track + (string-match "behind \\([0-9]+\\)" p:track) + (magit--propertize-face + (concat "<" + (match-string 1 p:track) + (and magit-refs-pad-commit-counts " ")) + 'magit-dimmed)))) + (list (1+ (length (concat branch-desc u:ahead p:ahead u:behind))) + branch + (magit-refs--format-focus-column branch headp) + branch-desc u:ahead p:ahead u:behind + (and upstream + (concat (if (equal u:track "[gone]") + (magit--propertize-face upstream 'error) + (magit-refs--propertize-branch upstream u:ref)) + " ")) + (and pushp + (concat p:behind + (magit--propertize-face + push 'magit-branch-remote) + " ")) + (and msg (magit-log-propertize-keywords nil msg))))))) + +(defun magit-refs--format-focus-column (ref &optional type) + (let ((focus magit-buffer-upstream) + (width (if magit-refs-show-commit-count + magit-refs-focus-column-width + 1))) + (format + (format "%%%ss " width) + (cond ((or (equal ref focus) + (and (eq type t) + (equal focus "HEAD"))) + (magit--propertize-face (concat (if (equal focus "HEAD") "@" "*") + (make-string (1- width) ?\s)) + 'magit-section-heading)) + ((if (eq type 'tag) + (eq magit-refs-show-commit-count 'all) + magit-refs-show-commit-count) + (pcase-let ((`(,behind ,ahead) + (magit-rev-diff-count magit-buffer-upstream ref))) + (magit--propertize-face + (cond ((> ahead 0) (concat "<" (number-to-string ahead))) + ((> behind 0) (concat (number-to-string behind) ">")) + (t "=")) + 'magit-dimmed))) + (t ""))))) + +(defun magit-refs--propertize-branch (branch ref &optional head-face) + (let ((face (cdr (cl-find-if (pcase-lambda (`(,re . ,_)) + (string-match-p re ref)) + magit-ref-namespaces)))) + (magit--propertize-face + branch (if head-face (list face head-face) face)))) + +(defun magit-refs--insert-refname-p (refname) + (if-let ((entry (seq-find (pcase-lambda (`(,key . ,_)) + (if (functionp key) + (funcall key refname) + (string-match-p key refname))) + magit-refs-filter-alist))) + (cdr entry) + t)) + +(defun magit-refs--insert-cherry-commits (ref) + (magit-insert-section-body + (let ((start (point)) + (magit-insert-section--current nil)) + (magit-git-wash (apply-partially #'magit-log-wash-log 'cherry) + "cherry" "-v" (magit-abbrev-arg) magit-buffer-upstream ref) + (if (= (point) start) + (message "No cherries for %s" ref) + (magit-make-margin-overlay nil t))))) + +(defun magit-refs--format-margin (commit) + (save-excursion + (goto-char (line-beginning-position 0)) + (let ((line (magit-rev-format "%ct%cN" commit))) + (magit-log-format-margin commit + (substring line 10) + (substring line 0 10))))) + +;;; _ +(provide 'magit-refs) +;;; magit-refs.el ends here diff --git a/emacs/elpa/magit-20240625.2109/magit-refs.elc b/emacs/elpa/magit-20240625.2109/magit-refs.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/magit-remote.el b/emacs/elpa/magit-20240625.2109/magit-remote.el diff --git a/emacs/elpa/magit-20240625.2109/magit-remote.elc b/emacs/elpa/magit-20240625.2109/magit-remote.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/magit-repos.el b/emacs/elpa/magit-20240625.2109/magit-repos.el diff --git a/emacs/elpa/magit-20240622.1531/magit-repos.elc b/emacs/elpa/magit-20240625.2109/magit-repos.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/magit-reset.el b/emacs/elpa/magit-20240625.2109/magit-reset.el diff --git a/emacs/elpa/magit-20240622.1531/magit-reset.elc b/emacs/elpa/magit-20240625.2109/magit-reset.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/magit-sequence.el b/emacs/elpa/magit-20240625.2109/magit-sequence.el diff --git a/emacs/elpa/magit-20240625.2109/magit-sequence.elc b/emacs/elpa/magit-20240625.2109/magit-sequence.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/magit-sparse-checkout.el b/emacs/elpa/magit-20240625.2109/magit-sparse-checkout.el diff --git a/emacs/elpa/magit-20240622.1531/magit-sparse-checkout.elc b/emacs/elpa/magit-20240625.2109/magit-sparse-checkout.elc Binary files differ. diff --git a/emacs/elpa/magit-20240625.2109/magit-stash.el b/emacs/elpa/magit-20240625.2109/magit-stash.el @@ -0,0 +1,644 @@ +;;; magit-stash.el --- Stash support for Magit -*- lexical-binding:t -*- + +;; Copyright (C) 2008-2024 The Magit Project Contributors + +;; Author: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> +;; Maintainer: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; 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. +;; +;; 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 Magit. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Support for Git stashes. + +;;; Code: + +(require 'magit) +(require 'magit-reflog) +(require 'magit-sequence) + +;;; Options + +(defgroup magit-stash nil + "List stashes and show stash diffs." + :group 'magit-modes) + +;;;; Diff options + +(defcustom magit-stash-sections-hook + '(magit-insert-stash-notes + magit-insert-stash-worktree + magit-insert-stash-index + magit-insert-stash-untracked) + "Hook run to insert sections into stash diff buffers." + :package-version '(magit . "2.1.0") + :group 'magit-stash + :type 'hook) + +;;;; Log options + +(defcustom magit-stashes-margin + (list (nth 0 magit-log-margin) + (nth 1 magit-log-margin) + 'magit-log-margin-width nil + (nth 4 magit-log-margin)) + "Format of the margin in `magit-stashes-mode' buffers. + +The value has the form (INIT STYLE WIDTH AUTHOR AUTHOR-WIDTH). + +If INIT is non-nil, then the margin is shown initially. +STYLE controls how to format the author or committer date. + It can be one of `age' (to show the age of the commit), + `age-abbreviated' (to abbreviate the time unit to a character), + or a string (suitable for `format-time-string') to show the + actual date. Option `magit-log-margin-show-committer-date' + controls which date is being displayed. +WIDTH controls the width of the margin. This exists for forward + compatibility and currently the value should not be changed. +AUTHOR controls whether the name of the author is also shown by + default. +AUTHOR-WIDTH has to be an integer. When the name of the author + is shown, then this specifies how much space is used to do so." + :package-version '(magit . "2.9.0") + :group 'magit-stash + :group 'magit-margin + :type magit-log-margin--custom-type + :initialize #'magit-custom-initialize-reset + :set-after '(magit-log-margin) + :set (apply-partially #'magit-margin-set-variable 'magit-stashes-mode)) + +;;;; Variables + +(defvar magit-stash-read-message-function #'magit-stash-read-message + "Function used to read the message when creating a stash.") + +;;; Commands + +;;;###autoload (autoload 'magit-stash "magit-stash" nil t) +(transient-define-prefix magit-stash () + "Stash uncommitted changes." + :man-page "git-stash" + ["Arguments" + ("-u" "Also save untracked files" ("-u" "--include-untracked")) + ("-a" "Also save untracked and ignored files" ("-a" "--all"))] + [["Stash" + ("z" "both" magit-stash-both) + ("i" "index" magit-stash-index) + ("w" "worktree" magit-stash-worktree) + ("x" "keeping index" magit-stash-keep-index) + ("P" "push" magit-stash-push :level 5)] + ["Snapshot" + ("Z" "both" magit-snapshot-both) + ("I" "index" magit-snapshot-index) + ("W" "worktree" magit-snapshot-worktree) + ("r" "to wip ref" magit-wip-commit)] + ["Use" + ("a" "Apply" magit-stash-apply) + ("p" "Pop" magit-stash-pop) + ("k" "Drop" magit-stash-drop)] + ["Inspect" + ("l" "List" magit-stash-list) + ("v" "Show" magit-stash-show)] + ["Transform" + ("b" "Branch" magit-stash-branch) + ("B" "Branch here" magit-stash-branch-here) + ("f" "Format patch" magit-stash-format-patch)]]) + +(defun magit-stash-arguments () + (transient-args 'magit-stash)) + +;;;###autoload +(defun magit-stash-both (message &optional include-untracked) + "Create a stash of the index and working tree. +Untracked files are included according to infix arguments. +One prefix argument is equivalent to `--include-untracked' +while two prefix arguments are equivalent to `--all'." + (interactive + (progn (when (and (magit-merge-in-progress-p) + (not (magit-y-or-n-p "\ +Stashing and resetting during a merge conflict. \ +Applying the resulting stash won't restore the merge state. \ +Proceed anyway? "))) + (user-error "Abort")) + (magit-stash-read-args))) + (magit-stash-save message t t include-untracked t)) + +;;;###autoload +(defun magit-stash-index (message) + "Create a stash of the index only. +Unstaged and untracked changes are not stashed. The stashed +changes are applied in reverse to both the index and the +worktree. This command can fail when the worktree is not clean. +Applying the resulting stash has the inverse effect." + (interactive (list (magit-stash-read-message))) + (magit-stash-save message t nil nil t 'worktree)) + +;;;###autoload +(defun magit-stash-worktree (message &optional include-untracked) + "Create a stash of unstaged changes in the working tree. +Untracked files are included according to infix arguments. +One prefix argument is equivalent to `--include-untracked' +while two prefix arguments are equivalent to `--all'." + (interactive (magit-stash-read-args)) + (magit-stash-save message nil t include-untracked t 'index)) + +;;;###autoload +(defun magit-stash-keep-index (message &optional include-untracked) + "Create a stash of the index and working tree, keeping index intact. +Untracked files are included according to infix arguments. +One prefix argument is equivalent to `--include-untracked' +while two prefix arguments are equivalent to `--all'." + (interactive (magit-stash-read-args)) + (magit-stash-save message t t include-untracked t 'index)) + +(defun magit-stash-read-args () + (list (funcall magit-stash-read-message-function) + (magit-stash-read-untracked))) + +(defun magit-stash-read-message () + "Read a message from the minibuffer, to be used for a stash. + +The message that Git would have picked, is available as the +default (used when the user enters the empty string) and as +the next history element (which can be accessed with \ +\\<minibuffer-local-map>\\[next-history-element])." + (read-string (format "Stash message (default: On%s:%s): " + (magit--ellipsis) (magit--ellipsis)) + nil nil + (format "On %s: %s" + (or (magit-get-current-branch) "(no branch)") + (magit-rev-format "%h %s")))) + +(defun magit-stash-read-message-traditional () + "Read a message from the minibuffer, to be used for a stash. + +If the user confirms the initial-input unmodified, then the +abbreviated commit hash and commit summary are appended. +The resulting message is what Git would have used." + (let* ((default (format "On %s: " + (or (magit-get-current-branch) "(no branch)"))) + (input (magit-read-string "Stash message" default))) + (if (equal input default) + (concat default (magit-rev-format "%h %s")) + input))) + +(defun magit-stash-read-untracked () + (let ((prefix (prefix-numeric-value current-prefix-arg)) + (args (magit-stash-arguments))) + (cond ((or (= prefix 16) (member "--all" args)) 'all) + ((or (= prefix 4) (member "--include-untracked" args)) t)))) + +;;;###autoload +(defun magit-snapshot-both (&optional include-untracked) + "Create a snapshot of the index and working tree. +Untracked files are included according to infix arguments. +One prefix argument is equivalent to `--include-untracked' +while two prefix arguments are equivalent to `--all'." + (interactive (magit-snapshot-read-args)) + (magit-snapshot-save t t include-untracked t)) + +;;;###autoload +(defun magit-snapshot-index () + "Create a snapshot of the index only. +Unstaged and untracked changes are not stashed." + (interactive) + (magit-snapshot-save t nil nil t)) + +;;;###autoload +(defun magit-snapshot-worktree (&optional include-untracked) + "Create a snapshot of unstaged changes in the working tree. +Untracked files are included according to infix arguments. +One prefix argument is equivalent to `--include-untracked' +while two prefix arguments are equivalent to `--all'." + (interactive (magit-snapshot-read-args)) + (magit-snapshot-save nil t include-untracked t)) + +(defun magit-snapshot-read-args () + (list (magit-stash-read-untracked))) + +(defun magit-snapshot-save (index worktree untracked &optional refresh) + (magit-stash-save (concat "WIP on " (magit-stash-summary)) + index worktree untracked refresh t)) + +;;;###autoload (autoload 'magit-stash-push "magit-stash" nil t) +(transient-define-prefix magit-stash-push (&optional transient args) + "Create stash using \"git stash push\". + +This differs from Magit's other stashing commands, which don't +use \"git stash\" and are generally more flexible but don't allow +specifying a list of files to be stashed." + :man-page "git-stash" + ["Arguments" + (magit:-- :reader (lambda (prompt initial-input history) + (magit-read-files prompt initial-input history + #'magit-modified-files))) + ("-u" "Also save untracked files" ("-u" "--include-untracked")) + ("-a" "Also save untracked and ignored files" ("-a" "--all")) + ("-k" "Keep index" ("-k" "--keep-index")) + ("-K" "Don't keep index" "--no-keep-index")] + ["Actions" + ("P" "push" magit-stash-push)] + (interactive (if (eq transient-current-command 'magit-stash-push) + (list nil (transient-args 'magit-stash-push)) + (list t))) + (if transient + (transient-setup 'magit-stash-push) + (magit-run-git "stash" "push" args))) + +;;;###autoload +(defun magit-stash-apply (stash) + "Apply a stash to the working tree. + +First try \"git stash apply --index\", which tries to preserve +the index stored in the stash, if any. This may fail because +applying the stash could result in conflicts and those have to +be stored in the index, making it impossible to also store the +stash's index there as well. + +If the above failed, then try \"git stash apply\". This fails +\(with or without \"--index\") if there are any uncommitted +changes to files that are also modified in the stash. + +If both of the above failed, then apply using \"git apply\". +If there are no conflicting files, use \"--3way\". If there are +conflicting files, then using \"--3way\" requires that those +files are staged first, which may be undesirable, so prompt +the user whether to use \"--3way\" or \"--reject\"." + (interactive (list (magit-read-stash "Apply stash"))) + (magit-stash--apply "apply" stash)) + +;;;###autoload +(defun magit-stash-pop (stash) + "Apply a stash to the working tree, on success remove it from stash list. + +First try \"git stash pop --index\", which tries to preserve +the index stored in the stash, if any. This may fail because +applying the stash could result in conflicts and those have to +be stored in the index, making it impossible to also store the +stash's index there as well. + +If the above failed, then try \"git stash apply\". This fails +\(with or without \"--index\") if there are any uncommitted +changes to files that are also modified in the stash. + +If both of the above failed, then apply using \"git apply\". +If there are no conflicting files, use \"--3way\". If there are +conflicting files, then using \"--3way\" requires that those +files are staged first, which may be undesirable, so prompt +the user whether to use \"--3way\" or \"--reject\"." + (interactive (list (magit-read-stash "Pop stash"))) + (magit-stash--apply "pop" stash)) + +(defun magit-stash--apply (action stash) + (or (= (magit-call-git "stash" action "--index" stash) 0) + ;; The stash's index could not be applied, so always keep the stash. + (= (magit-call-git "stash" "apply" stash) 0) + (let* ((range (format "%s^..%s" stash stash)) + (stashed (magit-git-items "diff" "-z" "--name-only" range "--")) + (conflicts (cl-sort (cl-union (magit-unstaged-files t stashed) + (magit-untracked-files t stashed) + :test #'equal) + #'string<)) + (arg (cond + ((not conflicts) "--3way") + ((magit-confirm-files + 'stash-apply-3way conflicts + "Apply stash using `--3way', which requires first staging" + "(else use `--reject')" + t) + (magit-stage-1 nil conflicts) + "--3way") + ("--reject")))) + (with-temp-buffer + (magit-git-insert "diff" range) + (magit-run-git-with-input "apply" arg "-")))) + (magit-refresh)) + +;;;###autoload +(defun magit-stash-drop (stash) + "Remove a stash from the stash list. +When the region is active offer to drop all contained stashes." + (interactive + (list (if-let ((values (magit-region-values 'stash))) + (magit-confirm 'drop-stashes nil "Drop %d stashes" nil values) + (magit-read-stash "Drop stash")))) + (dolist (stash (if (listp stash) + (nreverse (prog1 stash (setq stash (car stash)))) + (list stash))) + (message "Deleted refs/%s (was %s)" stash + (magit-rev-parse "--short" stash)) + (magit-call-git "rev-parse" stash) + (magit-call-git "stash" "drop" stash)) + (magit-refresh)) + +;;;###autoload +(defun magit-stash-clear (ref) + "Remove all stashes saved in REF's reflog by deleting REF." + (interactive (let ((ref (or (magit-section-value-if 'stashes) "refs/stash"))) + (magit-confirm t (format "Drop all stashes in %s" ref)) + (list ref))) + (magit-run-git "update-ref" "-d" ref)) + +;;;###autoload +(defun magit-stash-branch (stash branch) + "Create and checkout a new BRANCH from an existing STASH. +The new branch starts at the commit that was current when the +stash was created. If the stash applies cleanly, then drop it." + (interactive (list (magit-read-stash "Branch stash") + (magit-read-string-ns "Branch name"))) + (magit-run-git "stash" "branch" branch stash)) + +;;;###autoload +(defun magit-stash-branch-here (stash branch) + "Create and checkout a new BRANCH from an existing STASH. +Use the current branch or `HEAD' as the starting-point of BRANCH. +Then apply STASH, dropping it if it applies cleanly." + (interactive (list (magit-read-stash "Branch stash") + (magit-read-string-ns "Branch name"))) + (let ((start-point (or (magit-get-current-branch) "HEAD"))) + (magit-call-git "checkout" "-b" branch start-point) + (magit-branch-maybe-adjust-upstream branch start-point)) + (magit-stash-apply stash)) + +;;;###autoload +(defun magit-stash-format-patch (stash) + "Create a patch from STASH" + (interactive (list (magit-read-stash "Create patch from stash"))) + (with-temp-file (magit-rev-format "0001-%f.patch" stash) + (magit-git-insert "stash" "show" "-p" stash)) + (magit-refresh)) + +;;; Plumbing + +(defun magit-stash-save (message index worktree untracked + &optional refresh keep noerror ref) + (if (or (and index (magit-staged-files t)) + (and worktree (magit-unstaged-files t)) + (and untracked (magit-untracked-files (eq untracked 'all)))) + (magit-with-toplevel + (magit-stash-store message (or ref "refs/stash") + (magit-stash-create message index worktree untracked)) + (if (eq keep 'worktree) + (with-temp-buffer + (magit-git-insert "diff" "--cached" "--no-ext-diff") + (magit-run-git-with-input + "apply" "--reverse" "--cached" "--ignore-space-change" "-") + (magit-run-git-with-input + "apply" "--reverse" "--ignore-space-change" "-")) + (unless (eq keep t) + (if (eq keep 'index) + (magit-call-git "checkout" "--" ".") + (magit-call-git "reset" "--hard" "HEAD" "--")) + (when untracked + (magit-call-git "clean" "--force" "-d" + (and (eq untracked 'all) "-x"))))) + (when refresh + (magit-refresh))) + (unless noerror + (user-error "No %s changes to save" (cond ((not index) "unstaged") + ((not worktree) "staged") + (t "local")))))) + +(defun magit-stash-store (message ref commit) + (magit-update-ref ref message commit t)) + +(defun magit-stash-create (message index worktree untracked) + (unless (magit-rev-parse "--verify" "HEAD") + (error "You do not have the initial commit yet")) + (let ((magit-git-global-arguments (nconc (list "-c" "commit.gpgsign=false") + magit-git-global-arguments)) + (default-directory (magit-toplevel)) + (summary (magit-stash-summary)) + (head "HEAD")) + (when (and worktree (not index)) + (setq head (or (magit-commit-tree "pre-stash index" nil "HEAD") + (error "Cannot save the current index state")))) + (or (setq index (magit-commit-tree (concat "index on " summary) nil head)) + (error "Cannot save the current index state")) + (and untracked + (setq untracked (magit-untracked-files (eq untracked 'all))) + (setq untracked (magit-with-temp-index nil nil + (or (and (magit-update-files untracked) + (magit-commit-tree + (concat "untracked files on " summary))) + (error "Cannot save the untracked files"))))) + (magit-with-temp-index index "-m" + (when worktree + (or (magit-update-files (magit-git-items "diff" "-z" "--name-only" head)) + (error "Cannot save the current worktree state"))) + (or (magit-commit-tree message nil head index untracked) + (error "Cannot save the current worktree state"))))) + +(defun magit-stash-summary () + (concat (or (magit-get-current-branch) "(no branch)") + ": " (magit-rev-format "%h %s"))) + +;;; Sections + +(defvar-keymap magit-stashes-section-map + :doc "Keymap for `stashes' section." + "<remap> <magit-delete-thing>" #'magit-stash-clear + "<remap> <magit-visit-thing>" #'magit-stash-list + "<2>" (magit-menu-item "Clear %t" #'magit-stash-clear) + "<1>" (magit-menu-item "List %t" #'magit-stash-list)) + +(defvar-keymap magit-stash-section-map + :doc "Keymap for `stash' sections." + "<remap> <magit-cherry-pick>" #'magit-stash-pop + "<remap> <magit-cherry-apply>" #'magit-stash-apply + "<remap> <magit-delete-thing>" #'magit-stash-drop + "<remap> <magit-visit-thing>" #'magit-stash-show + "<4>" (magit-menu-item "Pop %M" #'magit-stash-pop) + "<3>" (magit-menu-item "Apply %M" #'magit-stash-apply) + "<2>" (magit-menu-item "Delete %M" #'magit-stash-drop) + "<1>" (magit-menu-item "Visit %v" #'magit-stash-show)) + +(magit-define-section-jumper magit-jump-to-stashes + "Stashes" stashes "refs/stash" magit-insert-stashes) + +(cl-defun magit-insert-stashes (&optional (ref "refs/stash") + (heading "Stashes:")) + "Insert `stashes' section showing reflog for \"refs/stash\". +If optional REF is non-nil, show reflog for that instead. +If optional HEADING is non-nil, use that as section heading +instead of \"Stashes:\"." + (let ((verified (magit-rev-verify ref)) + (autostash (magit-rebase--get-state-lines "autostash"))) + (when (or autostash verified) + (magit-insert-section (stashes ref) + (magit-insert-heading heading) + (when autostash + (pcase-let ((`(,author ,date ,msg) + (split-string + (car (magit-git-lines + "show" "-q" "--format=%aN%x00%at%x00%s" + autostash)) + "\0"))) + (magit-insert-section (stash autostash) + (insert (propertize "AUTOSTASH" 'font-lock-face 'magit-hash)) + (insert " " msg "\n") + (save-excursion + (backward-char) + (magit-log-format-margin autostash author date))))) + (if verified + (magit-git-wash (apply-partially #'magit-log-wash-log 'stash) + "reflog" "--format=%gd%x00%aN%x00%at%x00%gs" ref) + (insert ?\n) + (save-excursion + (backward-char) + (magit-make-margin-overlay))))))) + +;;; List Stashes + +;;;###autoload +(defun magit-stash-list () + "List all stashes in a buffer." + (interactive) + (magit-stashes-setup-buffer)) + +(define-derived-mode magit-stashes-mode magit-reflog-mode "Magit Stashes" + "Mode for looking at lists of stashes." + :group 'magit-log + (hack-dir-local-variables-non-file-buffer)) + +(defun magit-stashes-setup-buffer () + (magit-setup-buffer #'magit-stashes-mode nil + (magit-buffer-refname "refs/stash"))) + +(defun magit-stashes-refresh-buffer () + (magit-insert-section (stashesbuf) + (magit-insert-heading t + (if (equal magit-buffer-refname "refs/stash") + "Stashes" + (format "Stashes [%s]" magit-buffer-refname))) + (magit-git-wash (apply-partially #'magit-log-wash-log 'stash) + "reflog" "--format=%gd%x00%aN%x00%at%x00%gs" magit-buffer-refname))) + +(cl-defmethod magit-buffer-value (&context (major-mode magit-stashes-mode)) + magit-buffer-refname) + +(defvar magit--update-stash-buffer nil) + +(defun magit-stashes-maybe-update-stash-buffer (&optional _) + "When moving in the stashes buffer, update the stash buffer. +If there is no stash buffer in the same frame, then do nothing." + (when (derived-mode-p 'magit-stashes-mode) + (magit--maybe-update-stash-buffer))) + +(defun magit--maybe-update-stash-buffer () + (when-let* ((stash (magit-section-value-if 'stash)) + (buffer (magit-get-mode-buffer 'magit-stash-mode nil t))) + (if magit--update-stash-buffer + (setq magit--update-stash-buffer (list stash buffer)) + (setq magit--update-stash-buffer (list stash buffer)) + (run-with-idle-timer + magit-update-other-window-delay nil + (let ((args (with-current-buffer buffer + (let ((magit-direct-use-buffer-arguments 'selected)) + (magit-show-commit--arguments))))) + (lambda () + (pcase-let ((`(,stash ,buf) magit--update-stash-buffer)) + (setq magit--update-stash-buffer nil) + (when (buffer-live-p buf) + (let ((magit-display-buffer-noselect t)) + (apply #'magit-stash-show stash args)))) + (setq magit--update-stash-buffer nil))))))) + +;;; Show Stash + +;;;###autoload +(defun magit-stash-show (stash &optional args files) + "Show all diffs of a stash in a buffer." + (interactive (cons (or (and (not current-prefix-arg) + (magit-stash-at-point)) + (magit-read-stash "Show stash")) + (pcase-let ((`(,args ,files) + (magit-diff-arguments 'magit-stash-mode))) + (list (delete "--stat" args) files)))) + (magit-stash-setup-buffer stash args files)) + +(define-derived-mode magit-stash-mode magit-diff-mode "Magit Stash" + "Mode for looking at individual stashes." + :group 'magit-diff + (hack-dir-local-variables-non-file-buffer) + (setq magit--imenu-group-types '(commit))) + +(defun magit-stash-setup-buffer (stash args files) + (magit-setup-buffer #'magit-stash-mode nil + (magit-buffer-revision stash) + (magit-buffer-range (format "%s^..%s" stash stash)) + (magit-buffer-diff-args args) + (magit-buffer-diff-files files))) + +(defun magit-stash-refresh-buffer () + (magit-set-header-line-format + (concat (capitalize magit-buffer-revision) " " + (propertize (magit-rev-format "%s" magit-buffer-revision) + 'font-lock-face + (list :weight 'normal :foreground + (face-attribute 'default :foreground))))) + (setq magit-buffer-revision-hash (magit-rev-parse magit-buffer-revision)) + (magit-insert-section (stash) + (magit-run-section-hook 'magit-stash-sections-hook))) + +(cl-defmethod magit-buffer-value (&context (major-mode magit-stash-mode)) + magit-buffer-revision) + +(defun magit-stash-insert-section (commit range message &optional files) + (magit-insert-section (commit commit) + (magit-insert-heading message) + (magit--insert-diff nil + "diff" range "-p" "--no-prefix" magit-buffer-diff-args + "--" (or files magit-buffer-diff-files)))) + +(defun magit-insert-stash-notes () + "Insert section showing notes for a stash. +This shows the notes for stash@{N} but not for the other commits +that make up the stash." + (magit-insert-section (note) + (magit-insert-heading t "Notes") + (magit-git-insert "notes" "show" magit-buffer-revision) + (magit-cancel-section 'if-empty) + (insert "\n"))) + +(defun magit-insert-stash-index () + "Insert section showing staged changes of the stash." + (magit-stash-insert-section + (format "%s^2" magit-buffer-revision) + (format "%s^..%s^2" magit-buffer-revision magit-buffer-revision) + "Staged")) + +(defun magit-insert-stash-worktree () + "Insert section showing unstaged changes of the stash." + (magit-stash-insert-section + magit-buffer-revision + (format "%s^2..%s" magit-buffer-revision magit-buffer-revision) + "Unstaged")) + +(defun magit-insert-stash-untracked () + "Insert section showing the untracked files commit of the stash." + (let ((stash magit-buffer-revision) + (rev (concat magit-buffer-revision "^3"))) + (when (magit-rev-verify rev) + (magit-stash-insert-section (format "%s^3" stash) + (format "%s^..%s^3" stash stash) + "Untracked files" + (magit-git-items "ls-tree" "-z" "--name-only" + "-r" "--full-tree" rev))))) + +;;; _ +(provide 'magit-stash) +;;; magit-stash.el ends here diff --git a/emacs/elpa/magit-20240625.2109/magit-stash.elc b/emacs/elpa/magit-20240625.2109/magit-stash.elc Binary files differ. diff --git a/emacs/elpa/magit-20240625.2109/magit-status.el b/emacs/elpa/magit-20240625.2109/magit-status.el @@ -0,0 +1,789 @@ +;;; magit-status.el --- The grand overview -*- lexical-binding:t -*- + +;; Copyright (C) 2008-2024 The Magit Project Contributors + +;; Author: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> +;; Maintainer: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; 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. +;; +;; 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 Magit. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This library implements the status buffer. + +;;; Code: + +(require 'magit) + +;;; Options + +(defgroup magit-status nil + "Inspect and manipulate Git repositories." + :link '(info-link "(magit)Status Buffer") + :group 'magit-modes) + +(defcustom magit-status-mode-hook nil + "Hook run after entering Magit-Status mode." + :group 'magit-status + :type 'hook) + +(defcustom magit-status-headers-hook + '(magit-insert-error-header + magit-insert-diff-filter-header + magit-insert-head-branch-header + magit-insert-upstream-branch-header + magit-insert-push-branch-header + magit-insert-tags-header) + "Hook run to insert headers into the status buffer. + +This hook is run by `magit-insert-status-headers', which in turn +has to be a member of `magit-status-sections-hook' to be used at +all." + :package-version '(magit . "2.1.0") + :group 'magit-status + :type 'hook + :options '(magit-insert-error-header + magit-insert-diff-filter-header + magit-insert-repo-header + magit-insert-remote-header + magit-insert-head-branch-header + magit-insert-upstream-branch-header + magit-insert-push-branch-header + magit-insert-tags-header)) + +(defcustom magit-status-sections-hook + '(magit-insert-status-headers + magit-insert-merge-log + magit-insert-rebase-sequence + magit-insert-am-sequence + magit-insert-sequencer-sequence + magit-insert-bisect-output + magit-insert-bisect-rest + magit-insert-bisect-log + magit-insert-untracked-files + magit-insert-unstaged-changes + magit-insert-staged-changes + magit-insert-stashes + magit-insert-unpushed-to-pushremote + magit-insert-unpushed-to-upstream-or-recent + magit-insert-unpulled-from-pushremote + magit-insert-unpulled-from-upstream) + "Hook run to insert sections into a status buffer." + :package-version '(magit . "2.12.0") + :group 'magit-status + :type 'hook) + +(defcustom magit-status-initial-section '(1) + "The section point is placed on when a status buffer is created. + +When such a buffer is merely being refreshed or being shown again +after it was merely buried, then this option has no effect. + +If this is nil, then point remains on the very first section as +usual. Otherwise it has to be a list of integers and section +identity lists. The members of that list are tried in order +until a matching section is found. + +An integer means to jump to the nth section, 1 for example +jumps over the headings. To get a section's \"identity list\" +use \\[universal-argument] \\[magit-describe-section-briefly]. + +If, for example, you want to jump to the commits that haven't +been pulled from the upstream, or else the second section, then +use: (((unpulled . \"..@{upstream}\") (status)) 1). + +See option `magit-section-initial-visibility-alist' for how to +control the initial visibility of the jumped to section." + :package-version '(magit . "2.90.0") + :group 'magit-status + :type '(choice (const :tag "as usual" nil) + (repeat (choice (number :tag "nth top-level section") + (sexp :tag "section identity"))))) + +(defcustom magit-status-goto-file-position nil + "Whether to go to position corresponding to file position. + +If this is non-nil and the current buffer is visiting a file, +then `magit-status' tries to go to the position in the status +buffer that corresponds to the position in the file-visiting +buffer. This jumps into either the diff of unstaged changes +or the diff of staged changes. + +If the previously current buffer does not visit a file, or if +the file has neither unstaged nor staged changes then this has +no effect. + +The command `magit-status-here' tries to go to that position, +regardless of the value of this option." + :package-version '(magit . "3.0.0") + :group 'magit-status + :type 'boolean) + +(defcustom magit-status-show-hashes-in-headers nil + "Whether headers in the status buffer show hashes. +The functions which respect this option are +`magit-insert-head-branch-header', +`magit-insert-upstream-branch-header', and +`magit-insert-push-branch-header'." + :package-version '(magit . "2.4.0") + :group 'magit-status + :type 'boolean) + +(defcustom magit-status-margin + (list nil + (nth 1 magit-log-margin) + 'magit-log-margin-width nil + (nth 4 magit-log-margin)) + "Format of the margin in `magit-status-mode' buffers. + +The value has the form (INIT STYLE WIDTH AUTHOR AUTHOR-WIDTH). + +If INIT is non-nil, then the margin is shown initially. +STYLE controls how to format the author or committer date. + It can be one of `age' (to show the age of the commit), + `age-abbreviated' (to abbreviate the time unit to a character), + or a string (suitable for `format-time-string') to show the + actual date. Option `magit-log-margin-show-committer-date' + controls which date is being displayed. +WIDTH controls the width of the margin. This exists for forward + compatibility and currently the value should not be changed. +AUTHOR controls whether the name of the author is also shown by + default. +AUTHOR-WIDTH has to be an integer. When the name of the author + is shown, then this specifies how much space is used to do so." + :package-version '(magit . "2.9.0") + :group 'magit-status + :group 'magit-margin + :type magit-log-margin--custom-type + :initialize #'magit-custom-initialize-reset + :set-after '(magit-log-margin) + :set (apply-partially #'magit-margin-set-variable 'magit-status-mode)) + +(defcustom magit-status-use-buffer-arguments 'selected + "Whether `magit-status' reuses arguments when the buffer already exists. + +This option has no effect when merely refreshing the status +buffer using `magit-refresh'. + +Valid values are: + +`always': Always use the set of arguments that is currently + active in the status buffer, provided that buffer exists + of course. +`selected': Use the set of arguments from the status + buffer, but only if it is displayed in a window of the + current frame. This is the default. +`current': Use the set of arguments from the status buffer, + but only if it is the current buffer. +`never': Never use the set of arguments from the status + buffer." + :package-version '(magit . "3.0.0") + :group 'magit-buffers + :group 'magit-commands + :type '(choice + (const :tag "always use args from buffer" always) + (const :tag "use args from buffer if displayed in frame" selected) + (const :tag "use args from buffer if it is current" current) + (const :tag "never use args from buffer" never))) + +;;; Commands + +;;;###autoload +(defun magit-init (directory) + "Initialize a Git repository, then show its status. + +If the directory is below an existing repository, then the user +has to confirm that a new one should be created inside. If the +directory is the root of the existing repository, then the user +has to confirm that it should be reinitialized. + +Non-interactively DIRECTORY is (re-)initialized unconditionally." + (interactive + (let ((directory (file-name-as-directory + (expand-file-name + (read-directory-name "Create repository in: "))))) + (when-let ((toplevel (magit-toplevel directory))) + (setq toplevel (expand-file-name toplevel)) + (unless (y-or-n-p (if (file-equal-p toplevel directory) + (format "Reinitialize existing repository %s? " + directory) + (format "%s is a repository. Create another in %s? " + toplevel directory))) + (user-error "Abort"))) + (list directory))) + ;; `git init' does not understand the meaning of "~"! + (magit-call-git "init" (magit-convert-filename-for-git + (expand-file-name directory))) + (magit-status-setup-buffer directory)) + +;;;###autoload +(defun magit-status (&optional directory cache) + "Show the status of the current Git repository in a buffer. + +If the current directory isn't located within a Git repository, +then prompt for an existing repository or an arbitrary directory, +depending on option `magit-repository-directories', and show the +status of the selected repository instead. + +* If that option specifies any existing repositories, then offer + those for completion and show the status buffer for the + selected one. + +* Otherwise read an arbitrary directory using regular file-name + completion. If the selected directory is the top-level of an + existing working tree, then show the status buffer for that. + +* Otherwise offer to initialize the selected directory as a new + repository. After creating the repository show its status + buffer. + +These fallback behaviors can also be forced using one or more +prefix arguments: + +* With two prefix arguments (or more precisely a numeric prefix + value of 16 or greater) read an arbitrary directory and act on + it as described above. The same could be accomplished using + the command `magit-init'. + +* With a single prefix argument read an existing repository, or + if none can be found based on `magit-repository-directories', + then fall back to the same behavior as with two prefix + arguments." + (interactive + (let ((magit--refresh-cache (list (cons 0 0)))) + (list (and (or current-prefix-arg (not (magit-toplevel))) + (progn (magit--assert-usable-git) + (magit-read-repository + (>= (prefix-numeric-value current-prefix-arg) 16)))) + magit--refresh-cache))) + (let ((magit--refresh-cache (or cache (list (cons 0 0))))) + (if directory + (let ((toplevel (magit-toplevel directory))) + (setq directory (file-name-as-directory + (expand-file-name directory))) + (if (and toplevel (file-equal-p directory toplevel)) + (magit-status-setup-buffer directory) + (when (y-or-n-p + (if toplevel + (format "%s is a repository. Create another in %s? " + toplevel directory) + (format "Create repository in %s? " directory))) + ;; Creating a new repository invalidates cached values. + (setq magit--refresh-cache nil) + (magit-init directory)))) + (magit-status-setup-buffer default-directory)))) + +(put 'magit-status 'interactive-only 'magit-status-setup-buffer) + +;;;###autoload +(defalias 'magit #'magit-status + "Begin using Magit. + +This alias for `magit-status' exists for better discoverability. + +Instead of invoking this alias for `magit-status' using +\"M-x magit RET\", you should bind a key to `magit-status' +and read the info node `(magit)Getting Started', which +also contains other useful hints.") + +;;;###autoload +(defun magit-status-here () + "Like `magit-status' but with non-nil `magit-status-goto-file-position'." + (interactive) + (let ((magit-status-goto-file-position t)) + (call-interactively #'magit-status))) + +(put 'magit-status-here 'interactive-only 'magit-status-setup-buffer) + +;;;###autoload +(defun magit-status-quick () + "Show the status of the current Git repository, maybe without refreshing. + +If the status buffer of the current Git repository exists but +isn't being displayed in the selected frame, then display it +without refreshing it. + +If the status buffer is being displayed in the selected frame, +then also refresh it. + +Prefix arguments have the same meaning as for `magit-status', +and additionally cause the buffer to be refresh. + +To use this function instead of `magit-status', add this to your +init file: (global-set-key (kbd \"C-x g\") \\='magit-status-quick)." + (interactive) + (if-let ((buffer + (and (not current-prefix-arg) + (not (magit-get-mode-buffer 'magit-status-mode nil 'selected)) + (magit-get-mode-buffer 'magit-status-mode)))) + (magit-display-buffer buffer) + (call-interactively #'magit-status))) + +;;; Mode + +(defvar-keymap magit-status-mode-map + :doc "Keymap for `magit-status-mode'." + :parent magit-mode-map + "j" #'magit-status-jump + "<remap> <dired-jump>" #'magit-dired-jump) + +(transient-define-prefix magit-status-jump () + "In a Magit-Status buffer, jump to a section." + [["Jump to" + ("z " magit-jump-to-stashes) + ("t " magit-jump-to-tracked) + ("n " magit-jump-to-untracked) + ("i " magit-jump-to-ignored) + ("u " magit-jump-to-unstaged) + ("s " magit-jump-to-staged)] + ["" + ("fu" magit-jump-to-unpulled-from-upstream) + ("fp" magit-jump-to-unpulled-from-pushremote) + ("pu" magit-jump-to-unpushed-to-upstream) + ("pp" magit-jump-to-unpushed-to-pushremote) + ("a " magit-jump-to-assume-unchanged) + ("w " magit-jump-to-skip-worktree)] + ["Jump using" + ("j" "Imenu" imenu)]]) + +(define-derived-mode magit-status-mode magit-mode "Magit" + "Mode for looking at Git status. + +This mode is documented in info node `(magit)Status Buffer'. + +\\<magit-mode-map>\ +Type \\[magit-refresh] to refresh the current buffer. +Type \\[magit-section-toggle] to expand or hide the section at point. +Type \\[magit-visit-thing] to visit the change or commit at point. + +Type \\[magit-dispatch] to invoke major commands. + +Staging and applying changes is documented in info node +`(magit)Staging and Unstaging' and info node `(magit)Applying'. + +\\<magit-hunk-section-map>Type \ +\\[magit-apply] to apply the change at point, \ +\\[magit-stage] to stage, +\\[magit-unstage] to unstage, \ +\\[magit-discard] to discard, or \ +\\[magit-reverse] to reverse it. + +\\<magit-status-mode-map>\ +Type \\[magit-commit] to create a commit. + +\\{magit-status-mode-map}" + :group 'magit-status + (hack-dir-local-variables-non-file-buffer) + (when magit-status-initial-section + (add-hook 'magit-post-create-buffer-hook + #'magit-status-goto-initial-section nil t)) + (setq magit--imenu-group-types '(not branch commit))) + +(put 'magit-status-mode 'magit-diff-default-arguments + '("--no-ext-diff")) +(put 'magit-status-mode 'magit-log-default-arguments + '("-n256" "--decorate")) + +;;;###autoload +(defun magit-status-setup-buffer (&optional directory) + (unless directory + (setq directory default-directory)) + (when (file-remote-p directory) + (magit-git-version-assert)) + (let* ((default-directory directory) + (d (magit-diff--get-value 'magit-status-mode + magit-status-use-buffer-arguments)) + (l (magit-log--get-value 'magit-status-mode + magit-status-use-buffer-arguments)) + (file (and magit-status-goto-file-position + (magit-file-relative-name))) + (line (and file (save-restriction (widen) (line-number-at-pos)))) + (col (and file (save-restriction (widen) (current-column)))) + (buf (magit-setup-buffer #'magit-status-mode nil + (magit-buffer-diff-args (nth 0 d)) + (magit-buffer-diff-files (nth 1 d)) + (magit-buffer-log-args (nth 0 l)) + (magit-buffer-log-files (nth 1 l))))) + (when file + (with-current-buffer buf + (let ((staged (magit-get-section '((staged) (status))))) + (if (and staged + (cadr (magit-diff--locate-hunk file line staged))) + (magit-diff--goto-position file line col staged) + (let ((unstaged (magit-get-section '((unstaged) (status))))) + (unless (and unstaged + (magit-diff--goto-position file line col unstaged)) + (when staged + (magit-diff--goto-position file line col staged)))))))) + buf)) + +(defun magit-status-refresh-buffer () + (magit-git-exit-code "update-index" "--refresh") + (magit-insert-section (status) + (magit-run-section-hook 'magit-status-sections-hook))) + +(defun magit-status-goto-initial-section () + "Jump to the section specified by `magit-status-initial-section'." + (when-let ((section + (--some (if (integerp it) + (nth (1- it) + (magit-section-siblings (magit-current-section) + 'next)) + (magit-get-section it)) + magit-status-initial-section))) + (goto-char (oref section start)) + (when-let ((vis (cdr (assq 'magit-status-initial-section + magit-section-initial-visibility-alist)))) + (if (eq vis 'hide) + (magit-section-hide section) + (magit-section-show section))))) + +(defun magit-status-maybe-update-revision-buffer (&optional _) + "When moving in the status buffer, update the revision buffer. +If there is no revision buffer in the same frame, then do nothing." + (when (derived-mode-p 'magit-status-mode) + (magit--maybe-update-revision-buffer))) + +(defun magit-status-maybe-update-stash-buffer (&optional _) + "When moving in the status buffer, update the stash buffer. +If there is no stash buffer in the same frame, then do nothing." + (when (derived-mode-p 'magit-status-mode) + (magit--maybe-update-stash-buffer))) + +(defun magit-status-maybe-update-blob-buffer (&optional _) + "When moving in the status buffer, update the blob buffer. +If there is no blob buffer in the same frame, then do nothing." + (when (derived-mode-p 'magit-status-mode) + (magit--maybe-update-blob-buffer))) + +;;; Sections +;;;; Special Headers + +(defun magit-insert-status-headers () + "Insert header sections appropriate for `magit-status-mode' buffers. +The sections are inserted by running the functions on the hook +`magit-status-headers-hook'." + (if (magit-rev-verify "HEAD") + (magit-insert-headers 'magit-status-headers-hook) + (insert "In the beginning there was darkness\n\n"))) + +(defvar-keymap magit-error-section-map + :doc "Keymap for `error' sections." + "<remap> <magit-visit-thing>" #'magit-process-buffer + "<1>" (magit-menu-item "Visit process output" #'magit-process-buffer)) + +(defun magit-insert-error-header () + "Insert the message about the Git error that just occurred. + +This function is only aware of the last error that occur when Git +was run for side-effects. If, for example, an error occurs while +generating a diff, then that error won't be inserted. Refreshing +the status buffer causes this section to disappear again." + (when magit-this-error + (magit-insert-section (error 'git) + (insert (propertize (format "%-10s" "GitError! ") + 'font-lock-face 'magit-section-heading)) + (insert (propertize magit-this-error 'font-lock-face 'error)) + (when-let ((key (car (where-is-internal 'magit-process-buffer)))) + (insert (format " [Type `%s' for details]" (key-description key)))) + (insert ?\n)) + (setq magit-this-error nil))) + +(defun magit-insert-diff-filter-header () + "Insert a header line showing the effective diff filters." + (let ((ignore-modules (magit-ignore-submodules-p))) + (when (or ignore-modules + magit-buffer-diff-files) + (insert (propertize (format "%-10s" "Filter! ") + 'font-lock-face 'magit-section-heading)) + (when ignore-modules + (insert ignore-modules) + (when magit-buffer-diff-files + (insert " -- "))) + (when magit-buffer-diff-files + (insert (string-join magit-buffer-diff-files " "))) + (insert ?\n)))) + +;;;; Reference Headers + +(defun magit-insert-head-branch-header (&optional branch) + "Insert a header line about the current branch. +If `HEAD' is detached, then insert information about that commit +instead. The optional BRANCH argument is for internal use only." + (let ((branch (or branch (magit-get-current-branch))) + (output (magit-rev-format "%h %s" (or branch "HEAD")))) + (string-match "^\\([^ ]+\\) \\(.*\\)" output) + (magit-bind-match-strings (commit summary) output + (when (equal summary "") + (setq summary "(no commit message)")) + (if branch + (magit-insert-section (branch branch) + (insert (format "%-10s" "Head: ")) + (when magit-status-show-hashes-in-headers + (insert (propertize commit 'font-lock-face 'magit-hash) ?\s)) + (insert (propertize branch 'font-lock-face 'magit-branch-local)) + (insert ?\s) + (insert (funcall magit-log-format-message-function branch summary)) + (insert ?\n)) + (magit-insert-section (commit commit) + (insert (format "%-10s" "Head: ")) + (insert (propertize commit 'font-lock-face 'magit-hash)) + (insert ?\s) + (insert (funcall magit-log-format-message-function nil summary)) + (insert ?\n)))))) + +(defun magit-insert-upstream-branch-header (&optional branch upstream keyword) + "Insert a header line about the upstream of the current branch. +If no branch is checked out, then insert nothing. The optional +arguments are for internal use only." + (when-let ((branch (or branch (magit-get-current-branch)))) + (let ((remote (magit-get "branch" branch "remote")) + (merge (magit-get "branch" branch "merge")) + (rebase (magit-get "branch" branch "rebase"))) + (when (or remote merge) + (unless upstream + (setq upstream (magit-get-upstream-branch branch))) + (magit-insert-section (branch upstream) + (pcase rebase + ("true") + ("false" (setq rebase nil)) + (_ (setq rebase (magit-get-boolean "pull.rebase")))) + (insert (format "%-10s" (or keyword (if rebase "Rebase: " "Merge: ")))) + (insert + (if upstream + (concat (and magit-status-show-hashes-in-headers + (concat (propertize (magit-rev-format "%h" upstream) + 'font-lock-face 'magit-hash) + " ")) + upstream " " + (funcall magit-log-format-message-function upstream + (funcall magit-log-format-message-function nil + (or (magit-rev-format "%s" upstream) + "(no commit message)")))) + (cond + ((magit--unnamed-upstream-p remote merge) + (concat (propertize merge 'font-lock-face 'magit-branch-remote) + " from " + (propertize remote 'font-lock-face 'bold))) + ((magit--valid-upstream-p remote merge) + (if (equal remote ".") + (concat + (propertize merge 'font-lock-face 'magit-branch-local) " " + (propertize "does not exist" + 'font-lock-face 'magit-branch-warning)) + (format + "%s %s %s" + (propertize merge 'font-lock-face 'magit-branch-remote) + (propertize "does not exist on" + 'font-lock-face 'magit-branch-warning) + (propertize remote 'font-lock-face 'magit-branch-remote)))) + (t + (propertize "invalid upstream configuration" + 'font-lock-face 'magit-branch-warning))))) + (insert ?\n)))))) + +(defun magit-insert-push-branch-header () + "Insert a header line about the branch the current branch is pushed to." + (when-let* ((branch (magit-get-current-branch)) + (target (magit-get-push-branch branch))) + (magit-insert-section (branch target) + (insert (format "%-10s" "Push: ")) + (insert + (if (magit-rev-verify target) + (concat (and magit-status-show-hashes-in-headers + (concat (propertize (magit-rev-format "%h" target) + 'font-lock-face 'magit-hash) + " ")) + target " " + (funcall magit-log-format-message-function target + (funcall magit-log-format-message-function nil + (or (magit-rev-format "%s" target) + "(no commit message)")))) + (let ((remote (magit-get-push-remote branch))) + (if (magit-remote-p remote) + (concat target " " + (propertize "does not exist" + 'font-lock-face 'magit-branch-warning)) + (concat remote " " + (propertize "remote does not exist" + 'font-lock-face 'magit-branch-warning)))))) + (insert ?\n)))) + +(defun magit-insert-tags-header () + "Insert a header line about the current and/or next tag." + (let* ((this-tag (magit-get-current-tag nil t)) + (next-tag (magit-get-next-tag nil t)) + (this-cnt (cadr this-tag)) + (next-cnt (cadr next-tag)) + (this-tag (car this-tag)) + (next-tag (car next-tag)) + (both-tags (and this-tag next-tag t))) + (when (or this-tag next-tag) + (magit-insert-section (tag (or this-tag next-tag)) + (insert (format "%-10s" (if both-tags "Tags: " "Tag: "))) + (cl-flet ((insert-count (tag count face) + (insert (concat (propertize tag 'font-lock-face 'magit-tag) + (and (> count 0) + (format " (%s)" + (propertize + (format "%s" count) + 'font-lock-face face))))))) + (when this-tag (insert-count this-tag this-cnt 'magit-branch-local)) + (when both-tags (insert ", ")) + (when next-tag (insert-count next-tag next-cnt 'magit-tag))) + (insert ?\n))))) + +;;;; Auxiliary Headers + +(defun magit-insert-user-header () + "Insert a header line about the current user." + (let ((name (magit-get "user.name")) + (email (magit-get "user.email"))) + (when (and name email) + (magit-insert-section (user name) + (insert (format "%-10s" "User: ")) + (insert (propertize name 'font-lock-face 'magit-log-author)) + (insert " <" email ">\n"))))) + +(defun magit-insert-repo-header () + "Insert a header line showing the path to the repository top-level." + (let ((topdir (magit-toplevel))) + (magit-insert-section (repo topdir) + (insert (format "%-10s%s\n" "Repo: " (abbreviate-file-name topdir)))))) + +(defun magit-insert-remote-header () + "Insert a header line about the remote of the current branch. + +If no remote is configured for the current branch, then fall back +showing the \"origin\" remote, or if that does not exist the first +remote in alphabetic order." + (when-let* ((name (magit-get-some-remote)) + ;; Under certain configurations it's possible for + ;; url to be nil, when name is not, see #2858. + (url (magit-get "remote" name "url"))) + (magit-insert-section (remote name) + (insert (format "%-10s" "Remote: ")) + (insert (propertize name 'font-lock-face 'magit-branch-remote) ?\s) + (insert url ?\n)))) + +;;;; File Sections + +(defvar-keymap magit-untracked-section-map + :doc "Keymap for the `untracked' section." + "<remap> <magit-delete-thing>" #'magit-discard + "<remap> <magit-stage-file>" #'magit-stage + "<2>" (magit-menu-item "Discard files" #'magit-discard) + "<1>" (magit-menu-item "Stage files" #'magit-stage)) + +(magit-define-section-jumper magit-jump-to-untracked + "Untracked files" untracked nil magit-insert-untracked-files) + +(magit-define-section-jumper magit-jump-to-tracked + "Tracked files" tracked nil magit-insert-tracked-files) + +(magit-define-section-jumper magit-jump-to-ignored + "Ignored files" ignored nil magit-insert-ignored-files) + +(magit-define-section-jumper magit-jump-to-skip-worktree + "Skip-worktree files" skip-worktree nil magit-insert-skip-worktree-files) + +(magit-define-section-jumper magit-jump-to-assume-unchanged + "Assume-unchanged files" assume-unchanged nil + magit-insert-assume-unchanged-files) + +(defun magit-insert-untracked-files () + "Maybe insert a list or tree of untracked files. + +Do so depending on the value of `status.showUntrackedFiles'. +Note that even if the value is `all', Magit still initially +only shows directories. But the directory sections can then +be expanded using \"TAB\". + +If the first element of `magit-buffer-diff-files' is a +directory, then limit the list to files below that. The value +value of that variable can be set using \"D -- DIRECTORY RET g\"." + (let ((show (or (magit-get "status.showUntrackedFiles") "normal"))) + (unless (equal show "no") + (let* ((all (equal show "all")) + (base (car magit-buffer-diff-files)) + (base (and base (file-directory-p base) base))) + (magit-insert-files 'untracked + (lambda () (magit-untracked-files nil base (not all))) + (not all)))))) + +(defun magit-insert-tracked-files () + "Insert a tree of tracked files. + +If the first element of `magit-buffer-diff-files' is a +directory, then limit the list to files below that. The value +value of that variable can be set using \"D -- DIRECTORY RET g\"." + (magit-insert-files 'tracked #'magit-list-files)) + +(defun magit-insert-ignored-files () + "Insert a tree of ignored files. + +If the first element of `magit-buffer-diff-files' is a +directory, then limit the list to files below that. The value +of that variable can be set using \"D -- DIRECTORY RET g\"." + (magit-insert-files 'ignored #'magit-ignored-files)) + +(defun magit-insert-skip-worktree-files () + "Insert a tree of skip-worktree files. + +If the first element of `magit-buffer-diff-files' is a +directory, then limit the list to files below that. The value +of that variable can be set using \"D -- DIRECTORY RET g\"." + (magit-insert-files 'skip-worktree #'magit-skip-worktree-files)) + +(defun magit-insert-assume-unchanged-files () + "Insert a tree of files that are assumed to be unchanged. + +If the first element of `magit-buffer-diff-files' is a +directory, then limit the list to files below that. The value +of that variable can be set using \"D -- DIRECTORY RET g\"." + (magit-insert-files 'assume-unchanged #'magit-assume-unchanged-files)) + +(defun magit-insert-files (type fn &optional nogroup) + (when-let ((files (funcall fn))) + (let* ((base (car magit-buffer-diff-files)) + (base (and base (file-directory-p base) base)) + (title (symbol-name type))) + (magit-insert-section ((eval type) nil t) + (magit-insert-heading (length files) + (format "%c%s files" + (capitalize (aref title 0)) + (substring title 1))) + (magit-insert-files-1 files base nogroup) + (insert ?\n))))) + +(defun magit-insert-files-1 (files directory &optional nogroup) + (while (and files (or nogroup + (not directory) + (string-prefix-p directory (car files)))) + (let ((dir (file-name-directory (car files)))) + (if (or nogroup (equal dir directory)) + (let ((file (pop files))) + (magit-insert-section (file file) + (insert (propertize file 'font-lock-face 'magit-filename) ?\n))) + (magit-insert-section (file dir t) + (insert (propertize dir 'file 'magit-filename) ?\n) + (magit-insert-heading) + (setq files (magit-insert-files-1 files dir)))))) + files) + +;;; _ +(provide 'magit-status) +;;; magit-status.el ends here diff --git a/emacs/elpa/magit-20240625.2109/magit-status.elc b/emacs/elpa/magit-20240625.2109/magit-status.elc Binary files differ. diff --git a/emacs/elpa/magit-20240625.2109/magit-submodule.el b/emacs/elpa/magit-20240625.2109/magit-submodule.el @@ -0,0 +1,721 @@ +;;; magit-submodule.el --- Submodule support for Magit -*- lexical-binding:t -*- + +;; Copyright (C) 2008-2024 The Magit Project Contributors + +;; Author: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> +;; Maintainer: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; 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. +;; +;; 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 Magit. If not, see <https://www.gnu.org/licenses/>. + +;;; Code: + +(require 'magit) + +(defvar x-stretch-cursor) + +;;; Options + +(defcustom magit-module-sections-hook + '(magit-insert-modules-overview + magit-insert-modules-unpulled-from-upstream + magit-insert-modules-unpulled-from-pushremote + magit-insert-modules-unpushed-to-upstream + magit-insert-modules-unpushed-to-pushremote) + "Hook run by `magit-insert-modules'. + +That function isn't part of `magit-status-sections-hook's default +value, so you have to add it yourself for this hook to have any +effect." + :package-version '(magit . "2.11.0") + :group 'magit-status + :type 'hook) + +(defcustom magit-module-sections-nested t + "Whether `magit-insert-modules' wraps inserted sections. + +If this is non-nil, then only a single top-level section +is inserted. If it is nil, then all sections listed in +`magit-module-sections-hook' become top-level sections." + :package-version '(magit . "2.11.0") + :group 'magit-status + :type 'boolean) + +(defcustom magit-submodule-list-mode-hook '(hl-line-mode) + "Hook run after entering Magit-Submodule-List mode." + :package-version '(magit . "2.9.0") + :group 'magit-repolist + :type 'hook + :get 'magit-hook-custom-get + :options '(hl-line-mode)) + +(defcustom magit-submodule-list-columns + '(("Path" 25 magit-modulelist-column-path nil) + ("Version" 25 magit-repolist-column-version + ((:sort magit-repolist-version<))) + ("Branch" 20 magit-repolist-column-branch nil) + ("B<U" 3 magit-repolist-column-unpulled-from-upstream + ((:right-align t) + (:sort <))) + ("B>U" 3 magit-repolist-column-unpushed-to-upstream + ((:right-align t) + (:sort <))) + ("B<P" 3 magit-repolist-column-unpulled-from-pushremote + ((:right-align t) + (:sort <))) + ("B>P" 3 magit-repolist-column-unpushed-to-pushremote + ((:right-align t) + (:sort <))) + ("B" 3 magit-repolist-column-branches + ((:right-align t) + (:sort <))) + ("S" 3 magit-repolist-column-stashes + ((:right-align t) + (:sort <)))) + "List of columns displayed by `magit-list-submodules'. + +Each element has the form (HEADER WIDTH FORMAT PROPS). + +HEADER is the string displayed in the header. WIDTH is the width +of the column. FORMAT is a function that is called with one +argument, the repository identification (usually its basename), +and with `default-directory' bound to the toplevel of its working +tree. It has to return a string to be inserted or nil. PROPS is +an alist that supports the keys `:right-align', `:pad-right' and +`:sort'. + +The `:sort' function has a weird interface described in the +docstring of `tabulated-list--get-sort'. Alternatively `<' and +`magit-repolist-version<' can be used as those functions are +automatically replaced with functions that satisfy the interface. +Set `:sort' to nil to inhibit sorting; if unspecified, then the +column is sortable using the default sorter. + +You may wish to display a range of numeric columns using just one +character per column and without any padding between columns, in +which case you should use an appropriate HEADER, set WIDTH to 1, +and set `:pad-right' to 0. \"+\" is substituted for numbers higher +than 9." + :package-version '(magit . "2.8.0") + :group 'magit-repolist + :type `(repeat (list :tag "Column" + (string :tag "Header Label") + (integer :tag "Column Width") + (function :tag "Inserter Function") + (repeat :tag "Properties" + (list (choice :tag "Property" + (const :right-align) + (const :pad-right) + (const :sort) + (symbol)) + (sexp :tag "Value")))))) + +(defcustom magit-submodule-list-sort-key '("Path" . nil) + "Initial sort key for buffer created by `magit-list-submodules'. +If nil, no additional sorting is performed. Otherwise, this +should be a cons cell (NAME . FLIP). NAME is a string matching +one of the column names in `magit-submodule-list-columns'. FLIP, +if non-nil, means to invert the resulting sort." + :package-version '(magit . "3.2.0") + :group 'magit-repolist + :type '(choice (const nil) + (cons (string :tag "Column name") + (boolean :tag "Flip order")))) + +(defvar magit-submodule-list-format-path-functions nil) + +(defcustom magit-submodule-remove-trash-gitdirs nil + "Whether `magit-submodule-remove' offers to trash module gitdirs. + +If this is nil, then that command does not offer to do so unless +a prefix argument is used. When this is t, then it does offer to +do so even without a prefix argument. + +In both cases the action still has to be confirmed unless that is +disabled using the option `magit-no-confirm'. Doing the latter +and also setting this variable to t will lead to tears." + :package-version '(magit . "2.90.0") + :group 'magit-commands + :type 'boolean) + +;;; Popup + +;;;###autoload (autoload 'magit-submodule "magit-submodule" nil t) +(transient-define-prefix magit-submodule () + "Act on a submodule." + :man-page "git-submodule" + ["Arguments" + ("-f" "Force" ("-f" "--force")) + ("-r" "Recursive" "--recursive") + ("-N" "Do not fetch" ("-N" "--no-fetch")) + ("-C" "Checkout tip" "--checkout") + ("-R" "Rebase onto tip" "--rebase") + ("-M" "Merge tip" "--merge") + ("-U" "Use upstream tip" "--remote")] + ["One module actions" + ("a" magit-submodule-add) + ("r" magit-submodule-register) + ("p" magit-submodule-populate) + ("u" magit-submodule-update) + ("s" magit-submodule-synchronize) + ("d" magit-submodule-unpopulate) + ("k" "Remove" magit-submodule-remove)] + ["Populated modules actions" + ("l" "List modules" magit-list-submodules) + ("f" "Fetch modules" magit-fetch-modules)]) + +(defun magit-submodule-arguments (&rest filters) + (--filter (and (member it filters) it) + (transient-args 'magit-submodule))) + +(defclass magit--git-submodule-suffix (transient-suffix) + ()) + +(cl-defmethod transient-format-description ((obj magit--git-submodule-suffix)) + (let ((value (delq nil (mapcar #'transient-infix-value transient--suffixes)))) + (replace-regexp-in-string + "\\[--[^]]+\\]" + (lambda (match) + (format (propertize "[%s]" 'face 'transient-inactive-argument) + (mapconcat (lambda (arg) + (propertize arg 'face + (if (member arg value) + 'transient-argument + 'transient-inactive-argument))) + (save-match-data + (split-string (substring match 1 -1) "|")) + (propertize "|" 'face 'transient-inactive-argument)))) + (cl-call-next-method obj)))) + +;;;###autoload (autoload 'magit-submodule-add "magit-submodule" nil t) +(transient-define-suffix magit-submodule-add (url &optional path name args) + "Add the repository at URL as a module. + +Optional PATH is the path to the module relative to the root of +the superproject. If it is nil, then the path is determined +based on the URL. Optional NAME is the name of the module. If +it is nil, then PATH also becomes the name." + :class 'magit--git-submodule-suffix + :description "Add git submodule add [--force]" + (interactive + (magit-with-toplevel + (let* ((url (magit-read-string-ns "Add submodule (remote url)")) + (path (let ((read-file-name-function + (if (or (eq read-file-name-function 'ido-read-file-name) + (advice-function-member-p + 'ido-read-file-name + read-file-name-function)) + ;; The Ido variant doesn't work properly here. + #'read-file-name-default + read-file-name-function))) + (directory-file-name + (file-relative-name + (read-directory-name + "Add submodules at path: " nil nil nil + (and (string-match "\\([^./]+\\)\\(\\.git\\)?$" url) + (match-string 1 url)))))))) + (list url + (directory-file-name path) + (magit-submodule-read-name-for-path path) + (magit-submodule-arguments "--force"))))) + (magit-submodule-add-1 url path name args)) + +(defun magit-submodule-add-1 (url &optional path name args) + (magit-with-toplevel + (magit-submodule--maybe-reuse-gitdir name path) + (magit-run-git-async "submodule" "add" + (and name (list "--name" name)) + args "--" url path) + (set-process-sentinel + magit-this-process + (lambda (process event) + (when (memq (process-status process) '(exit signal)) + (if (> (process-exit-status process) 0) + (magit-process-sentinel process event) + (process-put process 'inhibit-refresh t) + (magit-process-sentinel process event) + (when (magit-git-version>= "2.12.0") + (magit-call-git "submodule" "absorbgitdirs" path)) + (magit-refresh))))))) + +;;;###autoload +(defun magit-submodule-read-name-for-path (path &optional prefer-short) + (let* ((path (directory-file-name (file-relative-name path))) + (name (file-name-nondirectory path))) + (push (if prefer-short path name) minibuffer-history) + (magit-read-string-ns + "Submodule name" nil (cons 'minibuffer-history 2) + (or (--keep (pcase-let ((`(,var ,val) (split-string it "="))) + (and (equal val path) + (cadr (split-string var "\\.")))) + (magit-git-lines "config" "--list" "-f" ".gitmodules")) + (if prefer-short name path))))) + +;;;###autoload (autoload 'magit-submodule-register "magit-submodule" nil t) +(transient-define-suffix magit-submodule-register (modules) + "Register MODULES. + +With a prefix argument act on all suitable modules. Otherwise, +if the region selects modules, then act on those. Otherwise, if +there is a module at point, then act on that. Otherwise read a +single module from the user." + ;; This command and the underlying "git submodule init" do NOT + ;; "initialize" modules. They merely "register" modules in the + ;; super-projects $GIT_DIR/config file, the purpose of which is to + ;; allow users to change such values before actually initializing + ;; the modules. + :description "Register git submodule init" + (interactive + (list (magit-module-confirm "Register" 'magit-module-no-worktree-p))) + (magit-with-toplevel + (magit-run-git-async "submodule" "init" "--" modules))) + +;;;###autoload (autoload 'magit-submodule-populate "magit-submodule" nil t) +(transient-define-suffix magit-submodule-populate (modules) + "Create MODULES working directories, checking out the recorded commits. + +With a prefix argument act on all suitable modules. Otherwise, +if the region selects modules, then act on those. Otherwise, if +there is a module at point, then act on that. Otherwise read a +single module from the user." + ;; This is the command that actually "initializes" modules. + ;; A module is initialized when it has a working directory, + ;; a gitlink, and a .gitmodules entry. + :description "Populate git submodule update --init" + (interactive + (list (magit-module-confirm "Populate" 'magit-module-no-worktree-p))) + (magit-with-toplevel + (magit-run-git-async "submodule" "update" "--init" "--" modules))) + +;;;###autoload (autoload 'magit-submodule-update "magit-submodule" nil t) +(transient-define-suffix magit-submodule-update (modules args) + "Update MODULES by checking out the recorded commits. + +With a prefix argument act on all suitable modules. Otherwise, +if the region selects modules, then act on those. Otherwise, if +there is a module at point, then act on that. Otherwise read a +single module from the user." + ;; Unlike `git-submodule's `update' command ours can only update + ;; "initialized" modules by checking out other commits but not + ;; "initialize" modules by creating the working directories. + ;; To do the latter we provide the "setup" command. + :class 'magit--git-submodule-suffix + :description "Update git submodule update [--force] [--no-fetch] + [--remote] [--recursive] [--checkout|--rebase|--merge]" + (interactive + (list (magit-module-confirm "Update" 'magit-module-worktree-p) + (magit-submodule-arguments + "--force" "--remote" "--recursive" "--checkout" "--rebase" "--merge" + "--no-fetch"))) + (magit-with-toplevel + (magit-run-git-async "submodule" "update" args "--" modules))) + +;;;###autoload (autoload 'magit-submodule-synchronize "magit-submodule" nil t) +(transient-define-suffix magit-submodule-synchronize (modules args) + "Synchronize url configuration of MODULES. + +With a prefix argument act on all suitable modules. Otherwise, +if the region selects modules, then act on those. Otherwise, if +there is a module at point, then act on that. Otherwise read a +single module from the user." + :class 'magit--git-submodule-suffix + :description "Synchronize git submodule sync [--recursive]" + (interactive + (list (magit-module-confirm "Synchronize" 'magit-module-worktree-p) + (magit-submodule-arguments "--recursive"))) + (magit-with-toplevel + (magit-run-git-async "submodule" "sync" args "--" modules))) + +;;;###autoload (autoload 'magit-submodule-unpopulate "magit-submodule" nil t) +(transient-define-suffix magit-submodule-unpopulate (modules args) + "Remove working directories of MODULES. + +With a prefix argument act on all suitable modules. Otherwise, +if the region selects modules, then act on those. Otherwise, if +there is a module at point, then act on that. Otherwise read a +single module from the user." + ;; Even when a submodule is "uninitialized" (it has no worktree) + ;; the super-project's $GIT_DIR/config may never-the-less set the + ;; module's url. This may happen if you `deinit' and then `init' + ;; to register (NOT initialize). Because the purpose of `deinit' + ;; is to remove the working directory AND to remove the url, this + ;; command does not limit itself to modules that have no working + ;; directory. + :class 'magit--git-submodule-suffix + :description "Unpopulate git submodule deinit [--force]" + (interactive + (list (magit-module-confirm "Unpopulate") + (magit-submodule-arguments "--force"))) + (magit-with-toplevel + (magit-run-git-async "submodule" "deinit" args "--" modules))) + +;;;###autoload +(defun magit-submodule-remove (modules args trash-gitdirs) + "Unregister MODULES and remove their working directories. + +For safety reasons, do not remove the gitdirs and if a module has +uncommitted changes, then do not remove it at all. If a module's +gitdir is located inside the working directory, then move it into +the gitdir of the superproject first. + +With the \"--force\" argument offer to remove dirty working +directories and with a prefix argument offer to delete gitdirs. +Both actions are very dangerous and have to be confirmed. There +are additional safety precautions in place, so you might be able +to recover from making a mistake here, but don't count on it." + (interactive + (list (if-let ((modules (magit-region-values 'magit-module-section t))) + (magit-confirm 'remove-modules nil "Remove %d modules" nil modules) + (list (magit-read-module-path "Remove module"))) + (magit-submodule-arguments "--force") + current-prefix-arg)) + (when (magit-git-version< "2.12.0") + (error "This command requires Git v2.12.0")) + (when magit-submodule-remove-trash-gitdirs + (setq trash-gitdirs t)) + (magit-with-toplevel + (when-let + ((modified + (seq-filter (lambda (module) + (let ((default-directory (file-name-as-directory + (expand-file-name module)))) + (and (cddr (directory-files default-directory)) + (magit-anything-modified-p)))) + modules))) + (if (member "--force" args) + (if (magit-confirm 'remove-dirty-modules + "Remove dirty module %s" + "Remove %d dirty modules" + t modified) + (dolist (module modified) + (let ((default-directory (file-name-as-directory + (expand-file-name module)))) + (magit-git "stash" "push" + "-m" "backup before removal of this module"))) + (setq modules (cl-set-difference modules modified :test #'equal))) + (if (cdr modified) + (message "Omitting %s modules with uncommitted changes: %s" + (length modified) + (string-join modified ", ")) + (message "Omitting module %s, it has uncommitted changes" + (car modified))) + (setq modules (cl-set-difference modules modified :test #'equal)))) + (when modules + (let ((alist + (and trash-gitdirs + (--map (split-string it "\0") + (magit-git-lines "submodule" "foreach" "-q" + "printf \"$sm_path\\0$name\n\""))))) + (magit-git "submodule" "absorbgitdirs" "--" modules) + (magit-git "submodule" "deinit" args "--" modules) + (magit-git "rm" args "--" modules) + (when (and trash-gitdirs + (magit-confirm 'trash-module-gitdirs + "Trash gitdir of module %s" + "Trash gitdirs of %d modules" + t modules)) + (dolist (module modules) + (if-let ((name (cadr (assoc module alist)))) + ;; Disregard if `magit-delete-by-moving-to-trash' + ;; is nil. Not doing so would be too dangerous. + (delete-directory (convert-standard-filename + (expand-file-name + (concat "modules/" name) + (magit-gitdir))) + t t) + (error "BUG: Weird module name and/or path for %s" module))))) + (magit-refresh)))) + +;;; Sections + +;;;###autoload +(defun magit-insert-modules () + "Insert submodule sections. +Hook `magit-module-sections-hook' controls which module sections +are inserted, and option `magit-module-sections-nested' controls +whether they are wrapped in an additional section." + (when-let ((modules (magit-list-module-paths))) + (if magit-module-sections-nested + (magit-insert-section (modules nil t) + (magit-insert-heading + (format "%s (%s)" + (propertize "Modules" + 'font-lock-face 'magit-section-heading) + (length modules))) + (magit-insert-section-body + (magit--insert-modules))) + (magit--insert-modules)))) + +(defun magit--insert-modules (&optional _section) + (magit-run-section-hook 'magit-module-sections-hook)) + +;;;###autoload +(defun magit-insert-modules-overview () + "Insert sections for all modules. +For each section insert the path and the output of `git describe --tags', +or, failing that, the abbreviated HEAD commit hash." + (when-let ((modules (magit-list-module-paths))) + (magit-insert-section (modules nil t) + (magit-insert-heading + (format "%s (%s)" + (propertize "Modules overview" + 'font-lock-face 'magit-section-heading) + (length modules))) + (magit-insert-section-body + (magit--insert-modules-overview))))) + +(defvar magit-modules-overview-align-numbers t) + +(defun magit--insert-modules-overview (&optional _section) + (magit-with-toplevel + (let* ((modules (magit-list-module-paths)) + (path-format (format "%%-%ds " + (min (apply #'max (mapcar #'length modules)) + (/ (window-width) 2)))) + (branch-format (format "%%-%ds " (min 25 (/ (window-width) 3))))) + (dolist (module modules) + (let ((default-directory + (expand-file-name (file-name-as-directory module)))) + (magit-insert-section (module module t) + (insert (propertize (format path-format module) + 'font-lock-face 'magit-diff-file-heading)) + (if (not (file-exists-p ".git")) + (insert "(unpopulated)") + (insert + (format + branch-format + (if-let ((branch (magit-get-current-branch))) + (propertize branch 'font-lock-face 'magit-branch-local) + (propertize "(detached)" 'font-lock-face 'warning)))) + (if-let ((desc (magit-git-string "describe" "--tags"))) + (progn (when (and magit-modules-overview-align-numbers + (string-match-p "\\`[0-9]" desc)) + (insert ?\s)) + (insert (propertize desc 'font-lock-face 'magit-tag))) + (when-let ((abbrev (magit-rev-format "%h"))) + (insert (propertize abbrev 'font-lock-face 'magit-hash))))) + (insert ?\n)))))) + (insert ?\n)) + +(defvar-keymap magit-modules-section-map + :doc "Keymap for `modules' sections." + "<remap> <magit-visit-thing>" #'magit-list-submodules + "<1>" (magit-menu-item "List %t" #'magit-list-submodules)) + +(defvar-keymap magit-module-section-map + :doc "Keymap for `module' sections." + "C-j" #'magit-submodule-visit + "C-<return>" #'magit-submodule-visit + "<remap> <magit-unstage-file>" #'magit-unstage + "<remap> <magit-stage-file>" #'magit-stage + "<remap> <magit-visit-thing>" #'magit-submodule-visit + "<5>" (magit-menu-item "Module commands..." #'magit-submodule) + "<4>" '(menu-item "--") + "<3>" (magit-menu-item "Unstage %T" #'magit-unstage + '(:visible (eq (magit-diff-type) 'staged))) + "<2>" (magit-menu-item "Stage %T" #'magit-stage + '(:visible (eq (magit-diff-type) 'unstaged))) + "<1>" (magit-menu-item "Visit %s" #'magit-submodule-visit)) + +(defun magit-submodule-visit (module &optional other-window) + "Visit MODULE by calling `magit-status' on it. +Offer to initialize MODULE if it's not checked out yet. +With a prefix argument, visit in another window." + (interactive (list (or (magit-section-value-if 'module) + (magit-read-module-path "Visit module")) + current-prefix-arg)) + (magit-with-toplevel + (let ((path (expand-file-name module))) + (cond + ((file-exists-p (expand-file-name ".git" module)) + (magit-diff-visit-directory path other-window)) + ((y-or-n-p (format "Initialize submodule '%s' first?" module)) + (magit-run-git-async "submodule" "update" "--init" "--" module) + (set-process-sentinel + magit-this-process + (lambda (process event) + (let ((magit-process-raise-error t)) + (magit-process-sentinel process event)) + (when (and (eq (process-status process) 'exit) + (= (process-exit-status process) 0)) + (magit-diff-visit-directory path other-window))))) + ((file-exists-p path) + (dired-jump other-window (concat path "/."))))))) + +;;;###autoload +(defun magit-insert-modules-unpulled-from-upstream () + "Insert sections for modules that haven't been pulled from the upstream. +These sections can be expanded to show the respective commits." + (magit--insert-modules-logs "Modules unpulled from @{upstream}" + 'modules-unpulled-from-upstream + "HEAD..@{upstream}")) + +;;;###autoload +(defun magit-insert-modules-unpulled-from-pushremote () + "Insert sections for modules that haven't been pulled from the push-remote. +These sections can be expanded to show the respective commits." + (magit--insert-modules-logs "Modules unpulled from @{push}" + 'modules-unpulled-from-pushremote + "HEAD..@{push}")) + +;;;###autoload +(defun magit-insert-modules-unpushed-to-upstream () + "Insert sections for modules that haven't been pushed to the upstream. +These sections can be expanded to show the respective commits." + (magit--insert-modules-logs "Modules unmerged into @{upstream}" + 'modules-unpushed-to-upstream + "@{upstream}..HEAD")) + +;;;###autoload +(defun magit-insert-modules-unpushed-to-pushremote () + "Insert sections for modules that haven't been pushed to the push-remote. +These sections can be expanded to show the respective commits." + (magit--insert-modules-logs "Modules unpushed to @{push}" + 'modules-unpushed-to-pushremote + "@{push}..HEAD")) + +(defun magit--insert-modules-logs (heading type range) + "For internal use, don't add to a hook." + (unless (magit-ignore-submodules-p) + (when-let ((modules (magit-list-module-paths))) + (magit-insert-section ((eval type) nil t) + (string-match "\\`\\(.+\\) \\([^ ]+\\)\\'" heading) + (magit-insert-heading + (propertize (match-string 1 heading) + 'font-lock-face 'magit-section-heading) + " " + (propertize (match-string 2 heading) + 'font-lock-face 'magit-branch-remote) + ":") + (dolist (module modules) + (when-let* ((default-directory (expand-file-name module)) + ((file-exists-p (expand-file-name ".git"))) + (lines (magit-git-lines "-c" "push.default=current" + "log" "--oneline" range)) + (count (length lines)) + ((> count 0))) + (magit-insert-section + ( module module t + :range range) + (magit-insert-heading count + (propertize module 'font-lock-face 'magit-diff-file-heading)) + (dolist (line lines) + (string-match magit-log-module-re line) + (let ((rev (match-string 1 line)) + (msg (match-string 2 line))) + (magit-insert-section (module-commit rev t) + (insert (propertize rev 'font-lock-face 'magit-hash) " " + (funcall magit-log-format-message-function rev msg) + "\n"))))))) + (magit-cancel-section 'if-empty) + (insert ?\n))))) + +;;; List + +;;;###autoload +(defun magit-list-submodules () + "Display a list of the current repository's populated submodules." + (interactive) + (magit-submodule-list-setup magit-submodule-list-columns)) + +(defvar-keymap magit-submodule-list-mode-map + :doc "Local keymap for Magit-Submodule-List mode buffers." + :parent magit-repolist-mode-map) + +(define-derived-mode magit-submodule-list-mode tabulated-list-mode "Modules" + "Major mode for browsing a list of Git submodules." + :group 'magit-repolist-mode + (setq-local x-stretch-cursor nil) + (setq tabulated-list-padding 0) + (add-hook 'tabulated-list-revert-hook #'magit-submodule-list-refresh nil t) + (setq imenu-prev-index-position-function + #'magit-repolist--imenu-prev-index-position) + (setq imenu-extract-index-name-function #'tabulated-list-get-id)) + +(defvar-local magit-submodule-list-predicate nil) + +(defun magit-submodule-list-setup (columns &optional predicate) + (magit-display-buffer + (or (magit-get-mode-buffer 'magit-submodule-list-mode) + (magit-generate-new-buffer 'magit-submodule-list-mode))) + (magit-submodule-list-mode) + (setq-local magit-repolist-columns columns) + (setq-local magit-repolist-sort-key magit-submodule-list-sort-key) + (setq-local magit-submodule-list-predicate predicate) + (magit-repolist-setup-1) + (magit-submodule-list-refresh)) + +(defun magit-submodule-list-refresh () + (setq tabulated-list-entries + (seq-keep + (lambda (module) + (let ((default-directory + (expand-file-name (file-name-as-directory module)))) + (and (file-exists-p ".git") + (or (not magit-submodule-list-predicate) + (funcall magit-submodule-list-predicate module)) + (list module + (vconcat + (mapcar (pcase-lambda (`(,title ,width ,fn ,props)) + (or (funcall fn `((:path ,module) + (:title ,title) + (:width ,width) + ,@props)) + "")) + magit-repolist-columns)))))) + (magit-list-module-paths))) + (message "Listing submodules...") + (tabulated-list-init-header) + (tabulated-list-print t) + (message "Listing submodules...done")) + +(defun magit-modulelist-column-path (spec) + "Insert the relative path of the submodule." + (let ((path (cadr (assq :path spec)))) + (or (run-hook-with-args-until-success + 'magit-submodule-list-format-path-functions path) + path))) + +;;; Utilities + +(defun magit-submodule--maybe-reuse-gitdir (name path) + (let ((gitdir (convert-standard-filename + (expand-file-name (concat "modules/" name) + (magit-gitdir))))) + (when (and (file-exists-p gitdir) + (not (file-exists-p path))) + (pcase (read-char-choice + (concat + gitdir " already exists.\n" + "Type [u] to use the existing gitdir and create the working tree\n" + " [r] to rename the existing gitdir and clone again\n" + " [t] to trash the existing gitdir and clone again\n" + " [C-g] to abort ") + '(?u ?r ?t)) + (?u (magit-submodule--restore-worktree (expand-file-name path) gitdir)) + (?r (rename-file gitdir (concat gitdir "-" + (format-time-string "%F-%T")))) + (?t (delete-directory gitdir t t)))))) + +(defun magit-submodule--restore-worktree (worktree gitdir) + (make-directory worktree t) + (with-temp-file (expand-file-name ".git" worktree) + (insert "gitdir: " (file-relative-name gitdir worktree) "\n")) + (let ((default-directory worktree)) + (magit-call-git "reset" "--hard" "HEAD" "--"))) + +;;; _ +(provide 'magit-submodule) +;;; magit-submodule.el ends here diff --git a/emacs/elpa/magit-20240625.2109/magit-submodule.elc b/emacs/elpa/magit-20240625.2109/magit-submodule.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/magit-subtree.el b/emacs/elpa/magit-20240625.2109/magit-subtree.el diff --git a/emacs/elpa/magit-20240622.1531/magit-subtree.elc b/emacs/elpa/magit-20240625.2109/magit-subtree.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/magit-tag.el b/emacs/elpa/magit-20240625.2109/magit-tag.el diff --git a/emacs/elpa/magit-20240622.1531/magit-tag.elc b/emacs/elpa/magit-20240625.2109/magit-tag.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/magit-transient.el b/emacs/elpa/magit-20240625.2109/magit-transient.el diff --git a/emacs/elpa/magit-20240622.1531/magit-transient.elc b/emacs/elpa/magit-20240625.2109/magit-transient.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/magit-wip.el b/emacs/elpa/magit-20240625.2109/magit-wip.el diff --git a/emacs/elpa/magit-20240622.1531/magit-wip.elc b/emacs/elpa/magit-20240625.2109/magit-wip.elc Binary files differ. diff --git a/emacs/elpa/magit-20240625.2109/magit-worktree.el b/emacs/elpa/magit-20240625.2109/magit-worktree.el @@ -0,0 +1,207 @@ +;;; magit-worktree.el --- Worktree support -*- lexical-binding:t -*- + +;; Copyright (C) 2008-2024 The Magit Project Contributors + +;; Author: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> +;; Maintainer: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; 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. +;; +;; 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 Magit. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This library implements support for `git-worktree'. + +;;; Code: + +(require 'magit) + +;;; Options + +(defcustom magit-worktree-read-directory-name-function #'read-directory-name + "Function used to read a directory for worktree commands. +This is called with one argument, the prompt, and can be used +to, e.g., use a base directory other than `default-directory'. +Used by `magit-worktree-checkout' and `magit-worktree-branch'." + :package-version '(magit . "3.0.0") + :group 'magit-commands + :type 'function) + +;;; Commands + +;;;###autoload (autoload 'magit-worktree "magit-worktree" nil t) +(transient-define-prefix magit-worktree () + "Act on a worktree." + :man-page "git-worktree" + [["Create new" + ("b" "worktree" magit-worktree-checkout) + ("c" "branch and worktree" magit-worktree-branch)] + ["Commands" + ("m" "Move worktree" magit-worktree-move) + ("k" "Delete worktree" magit-worktree-delete) + ("g" "Visit worktree" magit-worktree-status)]]) + +;;;###autoload +(defun magit-worktree-checkout (path branch) + "Checkout BRANCH in a new worktree at PATH." + (interactive + (let ((branch (magit-read-branch-or-commit "Checkout"))) + (list (funcall magit-worktree-read-directory-name-function + (format "Checkout %s in new worktree: " branch)) + branch))) + (magit-run-git "worktree" "add" (magit--expand-worktree path) branch) + (magit-diff-visit-directory path)) + +;;;###autoload +(defun magit-worktree-branch (path branch start-point &optional force) + "Create a new BRANCH and check it out in a new worktree at PATH." + (interactive + `(,(funcall magit-worktree-read-directory-name-function + "Create worktree: ") + ,@(magit-branch-read-args "Create and checkout branch") + ,current-prefix-arg)) + (magit-run-git "worktree" "add" (if force "-B" "-b") + branch (magit--expand-worktree path) start-point) + (magit-diff-visit-directory path)) + +;;;###autoload +(defun magit-worktree-move (worktree path) + "Move WORKTREE to PATH." + (interactive + (list (magit-completing-read "Move worktree" + (cdr (magit-list-worktrees)) + nil t nil nil + (magit-section-value-if 'worktree)) + (funcall magit-worktree-read-directory-name-function + "Move worktree to: "))) + (if (file-directory-p (expand-file-name ".git" worktree)) + (user-error "You may not move the main working tree") + (let ((preexisting-directory (file-directory-p path))) + (when (and (zerop (magit-call-git "worktree" "move" worktree + (magit--expand-worktree path))) + (not (file-exists-p default-directory)) + (derived-mode-p 'magit-status-mode)) + (kill-buffer) + (magit-diff-visit-directory + (if preexisting-directory + (concat (file-name-as-directory path) + (file-name-nondirectory worktree)) + path))) + (magit-refresh)))) + +(defun magit-worktree-delete (worktree) + "Delete a worktree, defaulting to the worktree at point. +The primary worktree cannot be deleted." + (interactive + (list (magit-completing-read "Delete worktree" + (cdr (magit-list-worktrees)) + nil t nil nil + (magit-section-value-if 'worktree)))) + (if (file-directory-p (expand-file-name ".git" worktree)) + (user-error "Deleting %s would delete the shared .git directory" worktree) + (let ((primary (file-name-as-directory (caar (magit-list-worktrees))))) + (magit-confirm-files (if magit-delete-by-moving-to-trash 'trash 'delete) + (list "worktree")) + (when (file-exists-p worktree) + (let ((delete-by-moving-to-trash magit-delete-by-moving-to-trash)) + (delete-directory worktree t magit-delete-by-moving-to-trash))) + (if (file-exists-p default-directory) + (magit-run-git "worktree" "prune") + (let ((default-directory primary)) + (magit-run-git "worktree" "prune")) + (when (derived-mode-p 'magit-status-mode) + (kill-buffer) + (magit-status-setup-buffer primary)))))) + +(defun magit-worktree-status (worktree) + "Show the status for the worktree at point. +If there is no worktree at point, then read one in the +minibuffer. If the worktree at point is the one whose +status is already being displayed in the current buffer, +then show it in Dired instead." + (interactive + (list (or (magit-section-value-if 'worktree) + (magit-completing-read + "Show status for worktree" + (cl-delete (directory-file-name (magit-toplevel)) + (magit-list-worktrees) + :test #'equal :key #'car))))) + (magit-diff-visit-directory worktree)) + +(defun magit--expand-worktree (path) + (magit-convert-filename-for-git (expand-file-name path))) + +;;; Sections + +(defvar-keymap magit-worktree-section-map + :doc "Keymap for `worktree' sections." + "<remap> <magit-delete-thing>" #'magit-worktree-delete + "<remap> <magit-visit-thing>" #'magit-worktree-status + "<4>" (magit-menu-item "Worktree commands..." #'magit-worktree) + "<3>" '(menu-item "--") + "<2>" (magit-menu-item "Delete %m" #'magit-worktree-delete) + "<1>" (magit-menu-item "Visit %s" #'magit-worktree-status)) + +(defun magit-insert-worktrees () + "Insert sections for all worktrees. +If there is only one worktree, then insert nothing." + (let ((worktrees (magit-list-worktrees))) + (when (length> worktrees 1) + (magit-insert-section (worktrees) + (magit-insert-heading t "Worktrees") + (let* ((cols + (mapcar + (lambda (config) + (pcase-let ((`(,_ ,commit ,branch ,bare) config)) + (cons (cond + (branch + (propertize + branch 'font-lock-face + (if (equal branch (magit-get-current-branch)) + 'magit-branch-current + 'magit-branch-local))) + (commit + (propertize (magit-rev-abbrev commit) + 'font-lock-face 'magit-hash)) + (bare "(bare)")) + config))) + worktrees)) + (align (1+ (apply #'max (--map (string-width (car it)) cols))))) + (pcase-dolist (`(,head . ,config) cols) + (magit--insert-worktree + config + (concat head (make-string (- align (length head)) ?\s))))) + (insert ?\n))))) + +(defun magit--insert-worktree (config head) + "Insert worktree section for CONFIG. +See `magit-list-worktrees' for the format of CONFIG. HEAD is +a prettified reference or revision representing the worktree, +with padding for alignment." + ;; #4926 Before changing the signature, inform @vermiculus. + (let ((path (car config))) + (magit-insert-section (worktree path) + (insert head) + (insert (let ((relative (file-relative-name path)) + (absolute (abbreviate-file-name path))) + (if (or (> (string-width relative) (string-width absolute)) + (equal relative "./")) + absolute + relative))) + (insert ?\n)))) + +;;; _ +(provide 'magit-worktree) +;;; magit-worktree.el ends here diff --git a/emacs/elpa/magit-20240625.2109/magit-worktree.elc b/emacs/elpa/magit-20240625.2109/magit-worktree.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/magit.el b/emacs/elpa/magit-20240625.2109/magit.el diff --git a/emacs/elpa/magit-20240622.1531/magit.elc b/emacs/elpa/magit-20240625.2109/magit.elc Binary files differ. diff --git a/emacs/elpa/magit-20240622.1531/magit.info b/emacs/elpa/magit-20240625.2109/magit.info diff --git a/emacs/elpa/magit-section-20240621.2229/magit-section-pkg.el b/emacs/elpa/magit-section-20240621.2229/magit-section-pkg.el @@ -1,14 +0,0 @@ -(define-package "magit-section" "20240621.2229" "Sections for read-only buffers." - '((emacs "26.1") - (compat "29.1.4.5") - (dash "20240405")) - :commit "ea0f07e54967197ac0b072a69ba314314a4080c1" :authors - '(("Jonas Bernoulli" . "emacs.magit@jonas.bernoulli.dev")) - :maintainer - '("Jonas Bernoulli" . "emacs.magit@jonas.bernoulli.dev") - :keywords - '("tools") - :url "https://github.com/magit/magit") -;; Local Variables: -;; no-byte-compile: t -;; End: diff --git a/emacs/elpa/magit-section-20240621.2229/magit-section.el b/emacs/elpa/magit-section-20240621.2229/magit-section.el @@ -1,2473 +0,0 @@ -;;; magit-section.el --- Sections for read-only buffers -*- lexical-binding:t; coding:utf-8 -*- - -;; Copyright (C) 2008-2024 The Magit Project Contributors - -;; Author: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> -;; Maintainer: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> - -;; Homepage: https://github.com/magit/magit -;; Keywords: tools - -;; Package-Version: 3.3.0.50-git -;; Package-Requires: ( -;; (emacs "26.1") -;; (compat "29.1.4.5") -;; (dash "2.19.1") -;; (seq "2.24")) - -;; SPDX-License-Identifier: GPL-3.0-or-later - -;; 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. -;; -;; 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 Magit. If not, see <https://www.gnu.org/licenses/>. - -;; You should have received a copy of the AUTHORS.md file, which -;; lists all contributors. If not, see https://magit.vc/authors. - -;;; Commentary: - -;; This package implements the main user interface of Magit — the -;; collapsible sections that make up its buffers. This package used -;; to be distributed as part of Magit but now it can also be used by -;; other packages that have nothing to do with Magit or Git. - -;;; Code: - -(require 'cl-lib) -(require 'compat) -(require 'dash) -(require 'eieio) -(require 'subr-x) - -;; For older Emacs releases we depend on an updated `seq' release from GNU -;; ELPA, for `seq-keep'. Unfortunately something else may require `seq' -;; before `package' had a chance to put this version on the `load-path'. -(when (and (featurep 'seq) - (not (fboundp 'seq-keep))) - (unload-feature 'seq 'force)) -(require 'seq) -;; Furthermore, by default `package' just silently refuses to upgrade. -(defconst magit--core-upgrade-instructions "\ -Magit requires `%s' >= %s, -but due to bad defaults, Emacs' package manager, refuses to -upgrade this and other built-in packages to higher releases -from GNU Elpa. - -To fix this, you have to add this to your init file: - - (setq package-install-upgrade-built-in t) - -Then evaluate that expression by placing the cursor after it -and typing \\[eval-last-sexp]. - -Once you have done that, you have to explicitly upgrade `%s': - - \\[package-install] %s \\`RET' - -Then you also must make sure the updated version is loaded, -by evaluating this form: - - (progn (unload-feature \\='%s t) (require \\='%s)) - -If this does not work, then try uninstalling Magit and all of its -dependencies. After that exit and restart Emacs, and only then -reinstalling Magit. - -If you don't use the `package' package manager but still get -this warning, then your chosen package manager likely has a -similar defect.") -(unless (fboundp 'seq-keep) - (display-warning 'magit (substitute-command-keys - (format magit--core-upgrade-instructions - 'seq "2.24" 'seq 'seq 'seq 'seq)) - :emergency)) - -(require 'cursor-sensor) -(require 'format-spec) - -(eval-when-compile (require 'benchmark)) - -;; For `magit-section-get-relative-position' -(declare-function magit-hunk-section-p "magit-diff" (section) t) - -;;; Hooks - -(defvar magit-section-movement-hook nil - "Hook run by `magit-section-goto'. -That function in turn is used by all section movement commands.") - -(defvar magit-section-highlight-hook - '(magit-section-highlight - magit-section-highlight-selection) - "Functions used to highlight the current section. -Each function is run with the current section as only argument -until one of them returns non-nil.") - -(defvar magit-section-unhighlight-hook nil - "Functions used to unhighlight the previously current section. -Each function is run with the current section as only argument -until one of them returns non-nil. Most sections are properly -unhighlighted without requiring a specialized unhighlighter, -diff-related sections being the only exception.") - -(defvar magit-section-set-visibility-hook - '(magit-section-cached-visibility) - "Hook used to set the initial visibility of a section. -Stop at the first function that returns non-nil. The returned -value should be `show', `hide' or nil. If no function returns -non-nil, determine the visibility as usual, i.e., use the -hardcoded section specific default (see `magit-insert-section').") - -;;; Options - -(defgroup magit-section nil - "Expandable sections." - :link '(info-link "(magit)Sections") - :group 'extensions) - -(defcustom magit-section-show-child-count t - "Whether to append the number of children to section headings. -This only applies to sections for which doing so makes sense." - :package-version '(magit-section . "2.1.0") - :group 'magit-section - :type 'boolean) - -(defcustom magit-section-cache-visibility t - "Whether to cache visibility of sections. - -Sections always retain their visibility state when they are being -recreated during a refresh. But if a section disappears and then -later reappears again, then this option controls whether this is -the case. - -If t, then cache the visibility of all sections. If a list of -section types, then only do so for matching sections. If nil, -then don't do so for any sections." - :package-version '(magit-section . "2.12.0") - :group 'magit-section - :type '(choice (const :tag "Don't cache visibility" nil) - (const :tag "Cache visibility of all sections" t) - (repeat :tag "Cache visibility for section types" symbol))) - -(defcustom magit-section-initial-visibility-alist - '((stashes . hide)) - "Alist controlling the initial visibility of sections. - -Each element maps a section type or lineage to the initial -visibility state for such sections. The state has to be one of -`show' or `hide', or a function that returns one of these symbols. -A function is called with the section as the only argument. - -Use the command `magit-describe-section' to determine a section's -lineage or type. The vector in the output is the section lineage -and the type is the first element of that vector. Wildcards can -be used, see `magit-section-match'. - -Currently this option is only used to override hardcoded defaults, -but in the future it will also be used set the defaults. - -An entry whose key is `magit-status-initial-section' specifies -the visibility of the section `magit-status-goto-initial-section' -jumps to. This does not only override defaults, but also other -entries of this alist." - :package-version '(magit-section . "2.12.0") - :group 'magit-section - :type '(alist :key-type (sexp :tag "Section type/lineage") - :value-type (choice (const hide) - (const show) - function))) - -(defcustom magit-section-visibility-indicator - (if (window-system) - '(magit-fringe-bitmap> . magit-fringe-bitmapv) - (cons (if (char-displayable-p ?…) "…" "...") - t)) - "Whether and how to indicate that a section can be expanded/collapsed. - -If nil, then don't show any indicators. -Otherwise the value has to have one of these two forms: - -\(EXPANDABLE-BITMAP . COLLAPSIBLE-BITMAP) - - Both values have to be variables whose values are fringe - bitmaps. In this case every section that can be expanded or - collapsed gets an indicator in the left fringe. - - To provide extra padding around the indicator, set - `left-fringe-width' in `magit-mode-hook'. - -\(STRING . BOOLEAN) - - In this case STRING (usually an ellipsis) is shown at the end - of the heading of every collapsed section. Expanded sections - get no indicator. The cdr controls whether the appearance of - these ellipsis take section highlighting into account. Doing - so might potentially have an impact on performance, while not - doing so is kinda ugly." - :package-version '(magit-section . "3.0.0") - :group 'magit-section - :type '(choice (const :tag "No indicators" nil) - (cons :tag "Use +- fringe indicators" - (const magit-fringe-bitmap+) - (const magit-fringe-bitmap-)) - (cons :tag "Use >v fringe indicators" - (const magit-fringe-bitmap>) - (const magit-fringe-bitmapv)) - (cons :tag "Use bold >v fringe indicators)" - (const magit-fringe-bitmap-bold>) - (const magit-fringe-bitmap-boldv)) - (cons :tag "Use custom fringe indicators" - (variable :tag "Expandable bitmap variable") - (variable :tag "Collapsible bitmap variable")) - (cons :tag "Use ellipses at end of headings" - (string :tag "Ellipsis" "…") - (choice :tag "Use face kludge" - (const :tag "Yes (potentially slow)" t) - (const :tag "No (kinda ugly)" nil))))) - -(define-obsolete-variable-alias 'magit-keep-region-overlay - 'magit-section-keep-region-overlay "Magit-Section 4.0.0") - -(defcustom magit-section-keep-region-overlay nil - "Whether to keep the region overlay when there is a valid selection. - -By default Magit removes the regular region overlay if, and only -if, that region constitutes a valid selection as understood by -Magit commands. Otherwise it does not remove that overlay, and -the region looks like it would in other buffers. - -There are two types of such valid selections: hunk-internal -regions and regions that select two or more sibling sections. -In such cases Magit removes the region overlay and instead -highlights a slightly larger range. All text (for hunk-internal -regions) or the headings of all sections (for sibling selections) -that are inside that range (not just inside the region) are acted -on by commands such as the staging command. This buffer range -begins at the beginning of the line on which the region begins -and ends at the end of the line on which the region ends. - -Because Magit acts on this larger range and not the region, it is -actually quite important to visualize that larger range. If we -don't do that, then one might think that these commands act on -the region instead. If you want to *also* visualize the region, -then set this option to t. But please note that when the region -does *not* constitute a valid selection, then the region is -*always* visualized as usual, and that it is usually under such -circumstances that you want to use a non-magit command to act on -the region. - -Besides keeping the region overlay, setting this option to t also -causes all face properties, except for `:foreground', to be -ignored for the faces used to highlight headings of selected -sections. This avoids the worst conflicts that result from -displaying the region and the selection overlays at the same -time. We are not interested in dealing with other conflicts. -In fact we *already* provide a way to avoid all of these -conflicts: *not* changing the value of this option. - -It should be clear by now that we consider it a mistake to set -this to display the region when the Magit selection is also -visualized, but since it has been requested a few times and -because it doesn't cost much to offer this option we do so. -However that might change. If the existence of this option -starts complicating other things, then it will be removed." - :package-version '(magit-section . "2.3.0") - :group 'magit-section - :type 'boolean) - -(defcustom magit-section-disable-line-numbers t - "In Magit buffers, whether to disable modes that display line numbers. - -Some users who turn on `global-display-line-numbers-mode' (or -`global-nlinum-mode' or `global-linum-mode') expect line numbers -to be displayed everywhere except in Magit buffers. Other users -do not expect Magit buffers to be treated differently. At least -in theory users in the first group should not use the global mode, -but that ship has sailed, thus this option." - :package-version '(magit-section . "3.0.0") - :group 'magit-section - :type 'boolean) - -(defcustom magit-section-show-context-menu-for-emacs<28 nil - "Whether `mouse-3' shows a context menu for Emacs < 28. - -This has to be set before loading `magit-section' or it has -no effect. This also has no effect for Emacs >= 28, where -`context-menu-mode' should be enabled instead." - :package-version '(magit-section . "4.0.0") - :group 'magit-section - :type 'boolean) - -;;; Variables - -(defvar-local magit-section-preserve-visibility t) - -(defvar-local magit-section-pre-command-region-p nil) -(defvar-local magit-section-pre-command-section nil) -(defvar-local magit-section-highlight-force-update nil) -(defvar-local magit-section-highlight-overlays nil) -(defvar-local magit-section-highlighted-sections nil) -(defvar-local magit-section-unhighlight-sections nil) - -(defvar-local magit-section-inhibit-markers nil) -(defvar-local magit-section-insert-in-reverse nil) - -;;; Faces - -(defgroup magit-section-faces nil - "Faces used by Magit-Section." - :group 'magit-section - :group 'faces) - -(defface magit-section-highlight - `((((class color) (background light)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :background "grey95") - (((class color) (background dark)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :background "grey20")) - "Face for highlighting the current section." - :group 'magit-section-faces) - -(defface magit-section-heading - `((((class color) (background light)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "DarkGoldenrod4" - :weight bold) - (((class color) (background dark)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "LightGoldenrod2" - :weight bold)) - "Face for section headings." - :group 'magit-section-faces) - -(defface magit-section-secondary-heading - `((t ,@(and (>= emacs-major-version 27) '(:extend t)) - :weight bold)) - "Face for section headings of some secondary headings." - :group 'magit-section-faces) - -(defface magit-section-heading-selection - `((((class color) (background light)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "salmon4") - (((class color) (background dark)) - ,@(and (>= emacs-major-version 27) '(:extend t)) - :foreground "LightSalmon3")) - "Face for selected section headings." - :group 'magit-section-faces) - -(defface magit-section-child-count '((t nil)) - "Face used for child counts at the end of some section headings." - :group 'magit-section-faces) - -;;; Classes - -(defvar magit--current-section-hook nil - "Internal variable used for `magit-describe-section'.") - -(defvar magit--section-type-alist nil) - -(defclass magit-section () - ((type :initform nil :initarg :type) - (keymap :initform nil) - (value :initform nil) - (start :initform nil) - (content :initform nil) - (end :initform nil) - (hidden) - (washer :initform nil :initarg :washer) - (inserter :initform (symbol-value 'magit--current-section-hook)) - (heading-highlight-face :initform nil :initarg :heading-highlight-face) - (parent :initform nil) - (children :initform nil))) - -;;; Mode - -(defvar symbol-overlay-inhibit-map) - -(defvar-keymap magit-section-heading-map - :doc "Keymap used in the heading line of all expandable sections. -This keymap is used in addition to the section-specific keymap, -if any." - "<double-down-mouse-1>" #'ignore - "<double-mouse-1>" #'magit-mouse-toggle-section - "<double-mouse-2>" #'magit-mouse-toggle-section) - -(defvar magit-section-mode-map - (let ((map (make-keymap))) - (suppress-keymap map t) - (when (and magit-section-show-context-menu-for-emacs<28 - (< emacs-major-version 28)) - (keymap-set map "<mouse-3>" nil) - (keymap-set - map "<down-mouse-3>" - `( menu-item "" ,(make-sparse-keymap) - :filter ,(lambda (_) - (let ((menu (make-sparse-keymap))) - (if (fboundp 'context-menu-local) - (context-menu-local menu last-input-event) - (magit--context-menu-local menu last-input-event)) - (magit-section-context-menu menu last-input-event) - menu))))) - (keymap-set map "<left-fringe> <mouse-1>" #'magit-mouse-toggle-section) - (keymap-set map "<left-fringe> <mouse-2>" #'magit-mouse-toggle-section) - (keymap-set map "TAB" #'magit-section-toggle) - (keymap-set map "C-c TAB" #'magit-section-cycle) - (keymap-set map "C-<tab>" #'magit-section-cycle) - (keymap-set map "M-<tab>" #'magit-section-cycle) - ;; <backtab> is the most portable binding for Shift+Tab. - (keymap-set map "<backtab>" #'magit-section-cycle-global) - (keymap-set map "^" #'magit-section-up) - (keymap-set map "p" #'magit-section-backward) - (keymap-set map "n" #'magit-section-forward) - (keymap-set map "M-p" #'magit-section-backward-sibling) - (keymap-set map "M-n" #'magit-section-forward-sibling) - (keymap-set map "1" #'magit-section-show-level-1) - (keymap-set map "2" #'magit-section-show-level-2) - (keymap-set map "3" #'magit-section-show-level-3) - (keymap-set map "4" #'magit-section-show-level-4) - (keymap-set map "M-1" #'magit-section-show-level-1-all) - (keymap-set map "M-2" #'magit-section-show-level-2-all) - (keymap-set map "M-3" #'magit-section-show-level-3-all) - (keymap-set map "M-4" #'magit-section-show-level-4-all) - map) - "Parent keymap for all keymaps of modes derived from `magit-section-mode'.") - -(define-derived-mode magit-section-mode special-mode "Magit-Sections" - "Parent major mode from which major modes with Magit-like sections inherit. - -Magit-Section is documented in info node `(magit-section)'." - :group 'magit-section - (buffer-disable-undo) - (setq truncate-lines t) - (setq buffer-read-only t) - (setq-local line-move-visual t) ; see #1771 - ;; Turn off syntactic font locking, but not by setting - ;; `font-lock-defaults' because that would enable font locking, and - ;; not all magit plugins may be ready for that (see #3950). - (setq-local font-lock-syntactic-face-function #'ignore) - (setq show-trailing-whitespace nil) - (setq-local symbol-overlay-inhibit-map t) - (setq list-buffers-directory (abbreviate-file-name default-directory)) - ;; (hack-dir-local-variables-non-file-buffer) - (make-local-variable 'text-property-default-nonsticky) - (push (cons 'keymap t) text-property-default-nonsticky) - (add-hook 'pre-command-hook #'magit-section-pre-command-hook nil t) - (add-hook 'post-command-hook #'magit-section-post-command-hook t t) - (add-hook 'deactivate-mark-hook #'magit-section-deactivate-mark t t) - (setq-local redisplay-highlight-region-function - #'magit-section--highlight-region) - (setq-local redisplay-unhighlight-region-function - #'magit-section--unhighlight-region) - (add-function :filter-return (local 'filter-buffer-substring-function) - #'magit-section--remove-text-properties) - (when (fboundp 'magit-section-context-menu) - (add-hook 'context-menu-functions #'magit-section-context-menu 10 t)) - (when magit-section-disable-line-numbers - (when (and (fboundp 'linum-mode) - (bound-and-true-p global-linum-mode)) - (linum-mode -1)) - (when (and (fboundp 'nlinum-mode) - (bound-and-true-p global-nlinum-mode)) - (nlinum-mode -1)) - (when (and (fboundp 'display-line-numbers-mode) - (bound-and-true-p global-display-line-numbers-mode)) - (display-line-numbers-mode -1))) - (when (fboundp 'magit-preserve-section-visibility-cache) - (add-hook 'kill-buffer-hook #'magit-preserve-section-visibility-cache))) - -(defun magit-section--remove-text-properties (string) - "Remove all text-properties from STRING. -Most importantly `magit-section'." - (set-text-properties 0 (length string) nil string) - string) - -;;; Core - -(defvar-local magit-root-section nil - "The root section in the current buffer. -All other sections are descendants of this section. The value -of this variable is set by `magit-insert-section' and you should -never modify it.") -(put 'magit-root-section 'permanent-local t) - -(defvar-local magit--context-menu-section nil "For internal use only.") - -(defvar magit--context-menu-buffer nil "For internal use only.") - -(defun magit-point () - "Return point or the position where the context menu was invoked. -When using the context menu, return the position the user clicked -on, provided the current buffer is the buffer in which the click -occurred. Otherwise return the same value as `point'." - (if magit--context-menu-section - (magit-menu-position) - (point))) - -(defun magit-thing-at-point (thing &optional no-properties) - "Return the THING at point or where the context menu was invoked. -When using the context menu, return the thing the user clicked -on, provided the current buffer is the buffer in which the click -occurred. Otherwise return the same value as `thing-at-point'. -For the meaning of THING and NO-PROPERTIES see that function." - (if-let ((pos (magit-menu-position))) - (save-excursion - (goto-char pos) - (thing-at-point thing no-properties)) - (thing-at-point thing no-properties))) - -(defun magit-current-section () - "Return the section at point or where the context menu was invoked. -When using the context menu, return the section that the user -clicked on, provided the current buffer is the buffer in which -the click occurred. Otherwise return the section at point." - (or magit--context-menu-section - (magit-section-at) - magit-root-section)) - -(defun magit-section-at (&optional position) - "Return the section at POSITION, defaulting to point." - (get-text-property (or position (point)) 'magit-section)) - -(defun magit-section-ident (section) - "Return an unique identifier for SECTION. -The return value has the form ((TYPE . VALUE)...)." - (cons (cons (oref section type) - (magit-section-ident-value section)) - (and-let* ((parent (oref section parent))) - (magit-section-ident parent)))) - -(cl-defgeneric magit-section-ident-value (object) - "Return OBJECT's value, making it constant and unique if necessary. - -This is used to correlate different incarnations of the same -section, see `magit-section-ident' and `magit-get-section'. - -Sections whose values that are not constant and/or unique should -implement a method that return a value that can be used for this -purpose.") - -(cl-defmethod magit-section-ident-value ((section magit-section)) - "Return the value unless it is an object. - -Different object incarnations representing the same value tend to not be -equal, so call this generic function on the object itself to determine a -constant value." - (let ((value (oref section value))) - (if (eieio-object-p value) - (magit-section-ident-value value) - value))) - -(cl-defmethod magit-section-ident-value ((object eieio-default-superclass)) - "Simply return the object itself. That likely isn't -good enough, so you need to implement your own method." - object) - -(defun magit-get-section (ident &optional root) - "Return the section identified by IDENT. -IDENT has to be a list as returned by `magit-section-ident'. -If optional ROOT is non-nil, then search in that section tree -instead of in the one whose root `magit-root-section' is." - (setq ident (reverse ident)) - (let ((section (or root magit-root-section))) - (when (eq (car (pop ident)) - (oref section type)) - (while (and ident - (pcase-let ((`(,type . ,value) (car ident))) - (setq section - (cl-find-if - (lambda (section) - (and (eq (oref section type) type) - (equal (magit-section-ident-value section) - value))) - (oref section children))))) - (pop ident)) - section))) - -(defun magit-section-lineage (section &optional raw) - "Return the lineage of SECTION. -If optional RAW is non-nil, return a list of section objects, beginning -with SECTION, otherwise return a list of section types." - (cons (if raw section (oref section type)) - (and-let* ((parent (oref section parent))) - (magit-section-lineage parent raw)))) - -(defvar magit-insert-section--current nil "For internal use only.") -(defvar magit-insert-section--parent nil "For internal use only.") -(defvar magit-insert-section--oldroot nil "For internal use only.") - -;;; Menu - -(defvar magit-menu-common-value nil "See function `magit-menu-common-value'.") -(defvar magit-menu--desc-values nil "For internal use only.") - -(defun magit-section-context-menu (menu click) - "Populate MENU with Magit-Section commands at CLICK." - (when-let ((section (save-excursion - (unless (region-active-p) - (mouse-set-point click)) - (magit-section-at)))) - (unless (region-active-p) - (setq magit--context-menu-buffer (current-buffer)) - (if-let ((alt (save-excursion - (mouse-set-point click) - (run-hook-with-args-until-success - 'magit-menu-alternative-section-hook section)))) - (setq magit--context-menu-section (setq section alt)) - (setq magit--context-menu-section section) - (magit-section-update-highlight t))) - (when (magit-section-content-p section) - (keymap-set-after menu "<magit-section-toggle>" - `(menu-item - ,(if (oref section hidden) "Expand section" "Collapse section") - magit-section-toggle)) - (unless (oref section hidden) - (when-let ((children (oref section children))) - (when (seq-some #'magit-section-content-p children) - (when (seq-some (lambda (c) (oref c hidden)) children) - (keymap-set-after menu "<magit-section-show-children>" - `(menu-item "Expand children" - magit-section-show-children))) - (when (seq-some (lambda (c) (not (oref c hidden))) children) - (keymap-set-after menu "<magit-section-hide-children>" - `(menu-item "Collapse children" - magit-section-hide-children)))))) - (keymap-set-after menu "<separator-magit-1>" menu-bar-separator)) - (keymap-set-after menu "<magit-describe-section>" - `(menu-item "Describe section" magit-describe-section)) - (when-let ((map (oref section keymap))) - (keymap-set-after menu "<separator-magit-2>" menu-bar-separator) - (when (symbolp map) - (setq map (symbol-value map))) - (setq magit-menu-common-value (magit-menu-common-value section)) - (setq magit-menu--desc-values (magit-menu--desc-values section)) - (map-keymap (lambda (key binding) - (when (consp binding) - (define-key-after menu (vector key) - (copy-sequence binding)))) - (if (fboundp 'menu-bar-keymap) - (menu-bar-keymap map) - (magit--menu-bar-keymap map))))) - menu) - -(defun magit-menu-item (desc def &optional props) - "Return a menu item named DESC binding DEF and using PROPS. - -If DESC contains a supported %-spec, substitute the -expression (magit-menu-format-desc DESC) for that. -See `magit-menu-format-desc'." - `(menu-item - ,(if (and (stringp desc) (string-match-p "%[tTvsmMx]" desc)) - (list 'magit-menu-format-desc desc) - desc) - ,def - ;; Without this, the keys for point would be shown instead - ;; of the relevant ones from where the click occurred. - :keys ,(apply-partially #'magit--menu-position-keys def) - ,@props)) - -(defun magit--menu-position-keys (def) - (or (ignore-errors - (save-excursion - (goto-char (magit-menu-position)) - (and-let* ((key (cl-find-if-not - (lambda (key) - (string-match-p "\\`<[0-9]+>\\'" - (key-description key))) - (where-is-internal def)))) - (key-description key)))) - "")) - -(defun magit-menu-position () - "Return the position where the context-menu was invoked. -If the current command wasn't invoked using the context-menu, -then return nil." - (and magit--context-menu-section - (ignore-errors - (posn-point (event-start (aref (this-command-keys-vector) 0)))))) - -(defun magit-menu-highlight-point-section () - (setq magit-section-highlight-force-update t) - (if (eq (current-buffer) magit--context-menu-buffer) - (setq magit--context-menu-section nil) - (if-let ((window (get-buffer-window magit--context-menu-buffer))) - (with-selected-window window - (setq magit--context-menu-section nil) - (magit-section-update-highlight)) - (with-current-buffer magit--context-menu-buffer - (setq magit--context-menu-section nil)))) - (setq magit--context-menu-buffer nil)) - -(defvar magit--plural-append-es '(branch)) - -(cl-defgeneric magit-menu-common-value (_section) - "Return some value to be used by multiple menu items. -This function is called by `magit-section-context-menu', which -stores the value in `magit-menu-common-value'. Individual menu -items can use it, e.g., in the expression used to set their -description." - nil) - -(defun magit-menu--desc-values (section) - (let ((type (oref section type)) - (value (oref section value)) - (multiple (magit-region-sections nil t))) - (list type - value - (format "%s %s" type value) - (and multiple (length multiple)) - (if (memq type magit--plural-append-es) "es" "s")))) - -(defun magit-menu-format-desc (format) - "Format a string based on FORMAT and menu section or selection. -The following %-specs are allowed: -%t means \"TYPE\". -%T means \"TYPE\", or \"TYPEs\" if multiple sections are selected. -%v means \"VALUE\". -%s means \"TYPE VALUE\". -%m means \"TYPE VALUE\", or \"COUNT TYPEs\" if multiple sections - are selected. -%M means \"VALUE\", or \"COUNT TYPEs\" if multiple sections are - selected. -%x means the value of `magit-menu-common-value'." - (pcase-let* ((`(,type ,value ,single ,count ,suffix) magit-menu--desc-values) - (multiple (and count (format "%s %s%s" count type suffix)))) - (format-spec format - `((?t . ,type) - (?T . ,(format "%s%s" type (if count suffix ""))) - (?v . ,value) - (?s . ,single) - (?m . ,(or multiple single)) - (?M . ,(or multiple value)) - (?x . ,(format "%s" magit-menu-common-value)))))) - -(defun magit--menu-bar-keymap (keymap) - "Backport of `menu-bar-keymap' for Emacs < 28. -Slight trimmed down." - (let ((menu-bar nil)) - (map-keymap (lambda (key binding) - (push (cons key binding) menu-bar)) - keymap) - (cons 'keymap (nreverse menu-bar)))) - -(defun magit--context-menu-local (menu _click) - "Backport of `context-menu-local' for Emacs < 28." - (run-hooks 'activate-menubar-hook 'menu-bar-update-hook) - (keymap-set-after menu "<separator-local>" menu-bar-separator) - (let ((keymap (local-key-binding [menu-bar]))) - (when keymap - (map-keymap (lambda (key binding) - (when (consp binding) - (define-key-after menu (vector key) - (copy-sequence binding)))) - (magit--menu-bar-keymap keymap)))) - menu) - -(define-advice context-menu-region (:around (fn menu click) magit-section-mode) - "Disable in `magit-section-mode' buffers." - (if (derived-mode-p 'magit-section-mode) - menu - (funcall fn menu click))) - -;;; Commands -;;;; Movement - -(defun magit-section-forward () - "Move to the beginning of the next visible section." - (interactive) - (if (eobp) - (user-error "No next section") - (let ((section (magit-current-section))) - (if (oref section parent) - (let ((next (and (not (oref section hidden)) - (not (= (oref section end) - (1+ (point)))) - (car (oref section children))))) - (while (and section (not next)) - (unless (setq next (car (magit-section-siblings section 'next))) - (setq section (oref section parent)))) - (if next - (magit-section-goto next) - (user-error "No next section"))) - (magit-section-goto 1))))) - -(defun magit-section-backward () - "Move to the beginning of the current or the previous visible section. -When point is at the beginning of a section then move to the -beginning of the previous visible section. Otherwise move to -the beginning of the current section." - (interactive) - (if (bobp) - (user-error "No previous section") - (let ((section (magit-current-section)) children) - (cond - ((and (= (point) - (1- (oref section end))) - (setq children (oref section children))) - (magit-section-goto (car (last children)))) - ((and (oref section parent) - (not (= (point) - (oref section start)))) - (magit-section-goto section)) - (t - (let ((prev (car (magit-section-siblings section 'prev)))) - (if prev - (while (and (not (oref prev hidden)) - (setq children (oref prev children))) - (setq prev (car (last children)))) - (setq prev (oref section parent))) - (cond (prev - (magit-section-goto prev)) - ((oref section parent) - (user-error "No previous section")) - ;; Eob special cases. - ((not (get-text-property (1- (point)) 'invisible)) - (magit-section-goto -1)) - (t - (goto-char (previous-single-property-change - (1- (point)) 'invisible)) - (forward-line -1) - (magit-section-goto (magit-current-section)))))))))) - -(defun magit-section-up () - "Move to the beginning of the parent section." - (interactive) - (if-let ((parent (oref (magit-current-section) parent))) - (magit-section-goto parent) - (user-error "No parent section"))) - -(defun magit-section-forward-sibling () - "Move to the beginning of the next sibling section. -If there is no next sibling section, then move to the parent." - (interactive) - (let ((current (magit-current-section))) - (if (oref current parent) - (if-let ((next (car (magit-section-siblings current 'next)))) - (magit-section-goto next) - (magit-section-forward)) - (magit-section-goto 1)))) - -(defun magit-section-backward-sibling () - "Move to the beginning of the previous sibling section. -If there is no previous sibling section, then move to the parent." - (interactive) - (let ((current (magit-current-section))) - (if (oref current parent) - (if-let ((previous (car (magit-section-siblings current 'prev)))) - (magit-section-goto previous) - (magit-section-backward)) - (magit-section-goto -1)))) - -(defun magit-section-goto (arg) - (if (integerp arg) - (progn (forward-line arg) - (setq arg (magit-current-section))) - (goto-char (oref arg start))) - (run-hook-with-args 'magit-section-movement-hook arg)) - -(defun magit-section-set-window-start (section) - "Ensure the beginning of SECTION is visible." - (unless (pos-visible-in-window-p (oref section end)) - (set-window-start (selected-window) (oref section start)))) - -(defmacro magit-define-section-jumper (name heading type &optional value) - "Define an interactive function to go some section. -Together TYPE and VALUE identify the section. -HEADING is the displayed heading of the section." - (declare (indent defun)) - `(defun ,name (&optional expand) - ,(format "Jump to the section \"%s\". -With a prefix argument also expand it." heading) - (interactive "P") - (if-let ((section (magit-get-section - (cons (cons ',type ,value) - (magit-section-ident magit-root-section))))) - (progn (goto-char (oref section start)) - (when expand - (with-local-quit (magit-section-show section)) - (recenter 0))) - (message ,(format "Section \"%s\" wasn't found" heading))))) - -;;;; Visibility - -(defun magit-section-show (section) - "Show the body of the current section." - (interactive (list (magit-current-section))) - (oset section hidden nil) - (magit-section--maybe-wash section) - (when-let ((beg (oref section content))) - (remove-overlays beg (oref section end) 'invisible t)) - (magit-section-maybe-update-visibility-indicator section) - (magit-section-maybe-cache-visibility section) - (dolist (child (oref section children)) - (if (oref child hidden) - (magit-section-hide child) - (magit-section-show child)))) - -(defun magit-section--maybe-wash (section) - (when-let ((washer (oref section washer))) - (oset section washer nil) - (let ((inhibit-read-only t) - (magit-insert-section--parent section) - (magit-insert-section--current section) - (content (oref section content))) - (save-excursion - (if (and content (< content (oref section end))) - (funcall washer section) ; already partially washed (hunk) - (goto-char (oref section end)) - (oset section content (point-marker)) - (funcall washer) - (oset section end (point-marker))))) - (setq magit-section-highlight-force-update t))) - -(defun magit-section-hide (section) - "Hide the body of the current section." - (interactive (list (magit-current-section))) - (if (eq section magit-root-section) - (user-error "Cannot hide root section") - (oset section hidden t) - (when-let ((beg (oref section content))) - (let ((end (oref section end))) - (when (< beg (point) end) - (goto-char (oref section start))) - (remove-overlays beg end 'invisible t) - (let ((o (make-overlay beg end))) - (overlay-put o 'evaporate t) - (overlay-put o 'invisible t) - (overlay-put o 'cursor-intangible t)))) - (magit-section-maybe-update-visibility-indicator section) - (magit-section-maybe-cache-visibility section))) - -(defun magit-section-toggle (section) - "Toggle visibility of the body of the current section." - (interactive (list (magit-current-section))) - (cond ((eq section magit-root-section) - (user-error "Cannot hide root section")) - ((oref section hidden) - (magit-section-show section)) - ((magit-section-hide section)))) - -(defun magit-section-toggle-children (section) - "Toggle visibility of bodies of children of the current section." - (interactive (list (magit-current-section))) - (let* ((children (oref section children)) - (show (--any-p (oref it hidden) children))) - (dolist (c children) - (oset c hidden show))) - (magit-section-show section)) - -(defun magit-section-show-children (section &optional depth) - "Recursively show the bodies of children of the current section. -With a prefix argument show children that deep and hide deeper -children." - (interactive (list (magit-current-section))) - (magit-section-show-children-1 section depth) - (magit-section-show section)) - -(defun magit-section-show-children-1 (section &optional depth) - (dolist (child (oref section children)) - (oset child hidden nil) - (if depth - (if (> depth 0) - (magit-section-show-children-1 child (1- depth)) - (magit-section-hide child)) - (magit-section-show-children-1 child)))) - -(defun magit-section-hide-children (section) - "Recursively hide the bodies of children of the current section." - (interactive (list (magit-current-section))) - (mapc #'magit-section-hide (oref section children))) - -(defun magit-section-show-headings (section) - "Recursively show headings of children of the current section. -Only show the headings, previously shown text-only bodies are -hidden." - (interactive (list (magit-current-section))) - (magit-section-show-headings-1 section) - (magit-section-show section)) - -(defun magit-section-show-headings-1 (section) - (dolist (child (oref section children)) - (oset child hidden nil) - (when (or (oref child children) - (not (oref child content))) - (magit-section-show-headings-1 child)))) - -(defun magit-section-cycle (section) - "Cycle visibility of current section and its children. - -If this command is invoked using \\`C-<tab>' and that is globally bound -to `tab-next', then this command pivots to behave like that command, and -you must instead use \\`C-c TAB' to cycle section visibility. - -If you would like to keep using \\`C-<tab>' to cycle section visibility -but also want to use `tab-bar-mode', then you have to prevent that mode -from using this key and instead bind another key to `tab-next'. Because -`tab-bar-mode' does not use a mode map but instead manipulates the -global map, this involves advising `tab-bar--define-keys'." - (interactive (list (magit-current-section))) - (cond - ((and (equal (this-command-keys) [C-tab]) - (eq (global-key-binding [C-tab]) 'tab-next) - (fboundp 'tab-bar-switch-to-next-tab)) - (tab-bar-switch-to-next-tab current-prefix-arg)) - ((oref section hidden) - (magit-section-show section) - (magit-section-hide-children section)) - ((let ((children (oref section children))) - (cond ((and (--any-p (oref it hidden) children) - (--any-p (oref it children) children)) - (magit-section-show-headings section)) - ((seq-some #'magit-section-hidden-body children) - (magit-section-show-children section)) - ((magit-section-hide section))))))) - -(defun magit-section-cycle-global () - "Cycle visibility of all sections in the current buffer." - (interactive) - (let ((children (oref magit-root-section children))) - (cond ((and (--any-p (oref it hidden) children) - (--any-p (oref it children) children)) - (magit-section-show-headings magit-root-section)) - ((seq-some #'magit-section-hidden-body children) - (magit-section-show-children magit-root-section)) - (t - (mapc #'magit-section-hide children))))) - -(defun magit-section-hidden-body (section &optional pred) - (if-let ((children (oref section children))) - (funcall (or pred #'-any-p) #'magit-section-hidden-body children) - (and (oref section content) - (oref section hidden)))) - -(defun magit-section-content-p (section) - "Return non-nil if SECTION has content or an unused washer function." - (with-slots (content end washer) section - (and content (or (not (= content end)) washer)))) - -(defun magit-section-invisible-p (section) - "Return t if the SECTION's body is invisible. -When the body of an ancestor of SECTION is collapsed then -SECTION's body (and heading) obviously cannot be visible." - (or (oref section hidden) - (and-let* ((parent (oref section parent))) - (magit-section-invisible-p parent)))) - -(defun magit-section-show-level (level) - "Show surrounding sections up to LEVEL. -If LEVEL is negative, show up to the absolute value. -Sections at higher levels are hidden." - (if (< level 0) - (let ((s (magit-current-section))) - (setq level (- level)) - (while (> (1- (length (magit-section-ident s))) level) - (setq s (oref s parent)) - (goto-char (oref s start))) - (magit-section-show-children magit-root-section (1- level))) - (cl-do* ((s (magit-current-section) - (oref s parent)) - (i (1- (length (magit-section-ident s))) - (cl-decf i))) - ((cond ((< i level) (magit-section-show-children s (- level i 1)) t) - ((= i level) (magit-section-hide s) t)) - (magit-section-goto s))))) - -(defun magit-section-show-level-1 () - "Show surrounding sections on first level." - (interactive) - (magit-section-show-level 1)) - -(defun magit-section-show-level-1-all () - "Show all sections on first level." - (interactive) - (magit-section-show-level -1)) - -(defun magit-section-show-level-2 () - "Show surrounding sections up to second level." - (interactive) - (magit-section-show-level 2)) - -(defun magit-section-show-level-2-all () - "Show all sections up to second level." - (interactive) - (magit-section-show-level -2)) - -(defun magit-section-show-level-3 () - "Show surrounding sections up to third level." - (interactive) - (magit-section-show-level 3)) - -(defun magit-section-show-level-3-all () - "Show all sections up to third level." - (interactive) - (magit-section-show-level -3)) - -(defun magit-section-show-level-4 () - "Show surrounding sections up to fourth level." - (interactive) - (magit-section-show-level 4)) - -(defun magit-section-show-level-4-all () - "Show all sections up to fourth level." - (interactive) - (magit-section-show-level -4)) - -(defun magit-mouse-toggle-section (event) - "Toggle visibility of the clicked section. -Clicks outside either the section heading or the left fringe are -silently ignored." - (interactive "e") - (let* ((pos (event-start event)) - (section (magit-section-at (posn-point pos)))) - (if (eq (posn-area pos) 'left-fringe) - (when section - (while (not (magit-section-content-p section)) - (setq section (oref section parent))) - (unless (eq section magit-root-section) - (goto-char (oref section start)) - (magit-section-toggle section))) - (magit-section-toggle section)))) - -;;;; Auxiliary - -(defun magit-describe-section-briefly (section &optional ident interactive) - "Show information about the section at point. -With a prefix argument show the section identity instead of the -section lineage. This command is intended for debugging purposes. -\n(fn SECTION &optional IDENT)" - (interactive (list (magit-current-section) current-prefix-arg t)) - (let ((str (format "#<%s %S %S %s-%s%s>" - (eieio-object-class section) - (let ((val (oref section value))) - (cond ((stringp val) - (substring-no-properties val)) - ((and (eieio-object-p val) - (fboundp 'cl-prin1-to-string)) - (cl-prin1-to-string val)) - (t - val))) - (if ident - (magit-section-ident section) - (apply #'vector (magit-section-lineage section))) - (and-let* ((m (oref section start))) - (if (markerp m) (marker-position m) m)) - (if-let ((m (oref section content))) - (format "[%s-]" - (if (markerp m) (marker-position m) m)) - "") - (and-let* ((m (oref section end))) - (if (markerp m) (marker-position m) m))))) - (when interactive - (message "%s" str)) - str)) - -(cl-defmethod cl-print-object ((section magit-section) stream) - "Print `magit-describe-section' result of SECTION." - ;; Used by debug and edebug as of Emacs 26. - (princ (magit-describe-section-briefly section) stream)) - -(defun magit-describe-section (section &optional interactive-p) - "Show information about the section at point." - (interactive (list (magit-current-section) t)) - (let ((inserter-section section)) - (while (and inserter-section (not (oref inserter-section inserter))) - (setq inserter-section (oref inserter-section parent))) - (when (and inserter-section (oref inserter-section inserter)) - (setq section inserter-section))) - (pcase (oref section inserter) - (`((,hook ,fun) . ,src-src) - (help-setup-xref `(magit-describe-section ,section) interactive-p) - (with-help-window (help-buffer) - (with-current-buffer standard-output - (insert (format-message - "%s\n is inserted by `%s'\n from `%s'" - (magit-describe-section-briefly section) - (make-text-button (symbol-name fun) nil - :type 'help-function - 'help-args (list fun)) - (make-text-button (symbol-name hook) nil - :type 'help-variable - 'help-args (list hook)))) - (pcase-dolist (`(,hook ,fun) src-src) - (insert (format-message - ",\n called by `%s'\n from `%s'" - (make-text-button (symbol-name fun) nil - :type 'help-function - 'help-args (list fun)) - (make-text-button (symbol-name hook) nil - :type 'help-variable - 'help-args (list hook))))) - (insert ".\n\n") - (insert - (format-message - "`%s' is " - (make-text-button (symbol-name fun) nil - :type 'help-function 'help-args (list fun)))) - (describe-function-1 fun)))) - (_ (message "%s, inserter unknown" - (magit-describe-section-briefly section))))) - -;;; Match - -(cl-defun magit-section-match - (condition &optional (section (magit-current-section))) - "Return t if SECTION matches CONDITION. - -SECTION defaults to the section at point. If SECTION is not -specified and there also is no section at point, then return -nil. - -CONDITION can take the following forms: - (CONDITION...) matches if any of the CONDITIONs matches. - [CLASS...] matches if the section's class is the same - as the first CLASS or a subclass of that; - the section's parent class matches the - second CLASS; and so on. - [* CLASS...] matches sections that match [CLASS...] and - also recursively all their child sections. - CLASS matches if the section's class is the same - as CLASS or a subclass of that; regardless - of the classes of the parent sections. - -Each CLASS should be a class symbol, identifying a class that -derives from `magit-section'. For backward compatibility CLASS -can also be a \"type symbol\". A section matches such a symbol -if the value of its `type' slot is `eq'. If a type symbol has -an entry in `magit--section-type-alist', then a section also -matches that type if its class is a subclass of the class that -corresponds to the type as per that alist. - -Note that it is not necessary to specify the complete section -lineage as printed by `magit-describe-section-briefly', unless -of course you want to be that precise." - (and section (magit-section-match-1 condition section))) - -(defun magit-section-match-1 (condition section) - (cl-assert condition) - (and section - (if (listp condition) - (--first (magit-section-match-1 it section) condition) - (magit-section-match-2 (if (symbolp condition) - (list condition) - (cl-coerce condition 'list)) - section)))) - -(defun magit-section-match-2 (condition section) - (if (eq (car condition) '*) - (or (magit-section-match-2 (cdr condition) section) - (and-let* ((parent (oref section parent))) - (magit-section-match-2 condition parent))) - (and (let ((c (car condition))) - (if (class-p c) - (cl-typep section c) - (if-let ((class (cdr (assq c magit--section-type-alist)))) - (cl-typep section class) - (eq (oref section type) c)))) - (or (not (setq condition (cdr condition))) - (and-let* ((parent (oref section parent))) - (magit-section-match-2 condition parent)))))) - -(defun magit-section-value-if (condition &optional section) - "If the section at point matches CONDITION, then return its value. - -If optional SECTION is non-nil then test whether that matches -instead. If there is no section at point and SECTION is nil, -then return nil. If the section does not match, then return -nil. - -See `magit-section-match' for the forms CONDITION can take." - (and-let* ((section (or section (magit-current-section)))) - (and (magit-section-match condition section) - (oref section value)))) - -(defmacro magit-section-case (&rest clauses) - "Choose among clauses on the type of the section at point. - -Each clause looks like (CONDITION BODY...). The type of the -section is compared against each CONDITION; the BODY forms of the -first match are evaluated sequentially and the value of the last -form is returned. Inside BODY the symbol `it' is bound to the -section at point. If no clause succeeds or if there is no -section at point, return nil. - -See `magit-section-match' for the forms CONDITION can take. -Additionally a CONDITION of t is allowed in the final clause, and -matches if no other CONDITION match, even if there is no section -at point." - (declare (indent 0) - (debug (&rest (sexp body)))) - `(let* ((it (magit-current-section))) - (cond ,@(mapcar (lambda (clause) - `(,(or (eq (car clause) t) - `(and it - (magit-section-match-1 ',(car clause) it))) - ,@(cdr clause))) - clauses)))) - -(defun magit-section-match-assoc (section alist) - "Return the value associated with SECTION's type or lineage in ALIST." - (seq-some (pcase-lambda (`(,key . ,val)) - (and (magit-section-match-1 key section) val)) - alist)) - -;;; Create - -(defvar magit-insert-section-hook nil - "Hook run after `magit-insert-section's BODY. -Avoid using this hook and only ever do so if you know -what you are doing and are sure there is no other way.") - -(defmacro magit-insert-section (&rest args) - "Insert a section at point. - -Create a section object of type CLASS, storing VALUE in its -`value' slot, and insert the section at point. CLASS is a -subclass of `magit-section' or has the form `(eval FORM)', in -which case FORM is evaluated at runtime and should return a -subclass. In other places a sections class is often referred -to as its \"type\". - -Many commands behave differently depending on the class of the -current section and sections of a certain class can have their -own keymap, which is specified using the `keymap' class slot. -The value of that slot should be a variable whose value is a -keymap. - -For historic reasons Magit and Forge in most cases use symbols -as CLASS that don't actually identify a class and that lack the -appropriate package prefix. This works due to some undocumented -kludges, which are not available to other packages. - -When optional HIDE is non-nil collapse the section body by -default, i.e., when first creating the section, but not when -refreshing the buffer. Else expand it by default. This can be -overwritten using `magit-section-set-visibility-hook'. When a -section is recreated during a refresh, then the visibility of -predecessor is inherited and HIDE is ignored (but the hook is -still honored). - -BODY is any number of forms that actually insert the section's -heading and body. Optional NAME, if specified, has to be a -symbol, which is then bound to the object of the section being -inserted. - -Before BODY is evaluated the `start' of the section object is set -to the value of `point' and after BODY was evaluated its `end' is -set to the new value of `point'; BODY is responsible for moving -`point' forward. - -If it turns out inside BODY that the section is empty, then -`magit-cancel-section' can be used to abort and remove all traces -of the partially inserted section. This can happen when creating -a section by washing Git's output and Git didn't actually output -anything this time around. - -\(fn [NAME] (CLASS &optional VALUE HIDE) &rest BODY)" - (declare (indent 1) - (debug ([&optional symbolp] - (&or [("eval" form) &optional form form &rest form] - [symbolp &optional form form &rest form]) - body))) - (pcase-let* ((bind (and (symbolp (car args)) - (pop args))) - (`((,class ,value ,hide . ,args) . ,body) args) - (obj (cl-gensym "section"))) - `(let* ((,obj (magit-insert-section--create - ,(if (eq (car-safe class) 'eval) (cadr class) `',class) - ,value ,hide ,@args)) - (magit-insert-section--current ,obj) - (magit-insert-section--oldroot - (or magit-insert-section--oldroot - (and (not magit-insert-section--parent) - (prog1 magit-root-section - (setq magit-root-section ,obj))))) - (magit-insert-section--parent ,obj)) - (catch 'cancel-section - ,@(if bind `((let ((,bind ,obj)) ,@body)) body) - (magit-insert-section--finish ,obj)) - ,obj))) - -(defun magit-insert-section--create (class value hide &rest args) - (let (type) - (if (class-p class) - (setq type (or (car (rassq class magit--section-type-alist)) - class)) - (setq type class) - (setq class (or (cdr (assq class magit--section-type-alist)) - 'magit-section))) - (let ((obj (apply class :type type args))) - (oset obj value value) - (oset obj parent magit-insert-section--parent) - (oset obj start (if magit-section-inhibit-markers (point) (point-marker))) - (unless (slot-boundp obj 'hidden) - (oset obj hidden - (let (set old) - (cond - ((setq set (run-hook-with-args-until-success - 'magit-section-set-visibility-hook obj)) - (eq set 'hide)) - ((setq old (and (not magit-section-preserve-visibility) - magit-insert-section--oldroot - (magit-get-section - (magit-section-ident obj) - magit-insert-section--oldroot))) - (oref old hidden)) - ((setq set (magit-section-match-assoc - obj magit-section-initial-visibility-alist)) - (eq (if (functionp set) (funcall set obj) set) 'hide)) - (hide))))) - (unless (oref obj keymap) - (let ((type (oref obj type))) - (oset obj keymap - (or (let ((sym (intern (format "magit-%s-section-map" type)))) - (and (boundp sym) sym)) - (let ((sym (intern (format "forge-%s-section-map" type)))) - (and (boundp sym) sym)))))) - obj))) - -(defun magit-insert-section--finish (obj) - (run-hooks 'magit-insert-section-hook) - (let ((beg (oref obj start)) - (end (oset obj end - (if magit-section-inhibit-markers - (point) - (point-marker)))) - (props `( magit-section ,obj - ,@(and-let* ((map (symbol-value (oref obj keymap)))) - (list 'keymap map))))) - (unless magit-section-inhibit-markers - (set-marker-insertion-type beg t)) - (cond ((eq obj magit-root-section)) - ((oref obj children) - (magit-insert-child-count obj) - (magit-section-maybe-add-heading-map obj) - (save-excursion - (goto-char beg) - (while (< (point) end) - (let ((next (or (next-single-property-change - (point) 'magit-section) - end))) - (unless (magit-section-at) - (add-text-properties (point) next props)) - (goto-char next))))) - ((add-text-properties beg end props))) - (cond ((eq obj magit-root-section) - (when (eq magit-section-inhibit-markers 'delay) - (setq magit-section-inhibit-markers nil) - (magit-map-sections - (lambda (section) - (oset section start (copy-marker (oref section start) t)) - (oset section end (copy-marker (oref section end) t))))) - (let ((magit-section-cache-visibility nil)) - (magit-section-show obj))) - (magit-section-insert-in-reverse - (push obj (oref (oref obj parent) children))) - ((let ((parent (oref obj parent))) - (oset parent children - (nconc (oref parent children) - (list obj)))))) - (when magit-section-insert-in-reverse - (oset obj children (nreverse (oref obj children)))))) - -(defun magit-cancel-section (&optional if-empty) - "Cancel inserting the section that is currently being inserted. - -Canceling returns from the inner most use of `magit-insert-section' and -removes all text that was inserted by that. - -If optional IF-EMPTY is non-nil, then only cancel the section, if it is -empty. If a section is split into a heading and a body (i.e., when its -`content' slot is non-nil), then only check if the body is empty." - (when (and magit-insert-section--current - (or (not if-empty) - (= (point) (or (oref magit-insert-section--current content) - (oref magit-insert-section--current start))))) - (if (eq magit-insert-section--current magit-root-section) - (insert "(empty)\n") - (delete-region (oref magit-insert-section--current start) - (point)) - (setq magit-insert-section--current nil) - (throw 'cancel-section nil)))) - -(defun magit-insert-heading (&rest args) - "Insert the heading for the section currently being inserted. - -This function should only be used inside `magit-insert-section'. - -When called without any arguments, then just set the `content' -slot of the object representing the section being inserted to -a marker at `point'. The section should only contain a single -line when this function is used like this. - -When called with arguments ARGS, which have to be strings, or -nil, then insert those strings at point. The section should not -contain any text before this happens and afterwards it should -again only contain a single line. If the `face' property is set -anywhere inside any of these strings, then insert all of them -unchanged. Otherwise use the `magit-section-heading' face for -all inserted text. - -The `content' property of the section object is the end of the -heading (which lasts from `start' to `content') and the beginning -of the the body (which lasts from `content' to `end'). If the -value of `content' is nil, then the section has no heading and -its body cannot be collapsed. If a section does have a heading, -then its height must be exactly one line, including a trailing -newline character. This isn't enforced, you are responsible for -getting it right. The only exception is that this function does -insert a newline character if necessary." - (declare (indent defun)) - (when args - (let ((heading (apply #'concat args))) - (insert (if (or (text-property-not-all 0 (length heading) - 'font-lock-face nil heading) - (text-property-not-all 0 (length heading) - 'face nil heading)) - heading - (propertize heading 'font-lock-face 'magit-section-heading))))) - (unless (bolp) - (insert ?\n)) - (when (fboundp 'magit-maybe-make-margin-overlay) - (magit-maybe-make-margin-overlay)) - (oset magit-insert-section--current content - (if magit-section-inhibit-markers (point) (point-marker)))) - -(defmacro magit-insert-section-body (&rest body) - "Use BODY to insert the section body, once the section is expanded. -If the section is expanded when it is created, then this is -like `progn'. Otherwise BODY isn't evaluated until the section -is explicitly expanded." - (declare (indent 0)) - (let ((f (cl-gensym)) - (s (cl-gensym)) - (l (cl-gensym))) - `(let ((,f (lambda () ,@body))) - (if (oref magit-insert-section--current hidden) - (oset magit-insert-section--current washer - (let ((,s magit-insert-section--current)) - (lambda () - (let ((,l (magit-section-lineage ,s t))) - (dolist (s ,l) - (set-marker-insertion-type (oref s end) t)) - (funcall ,f) - (dolist (s ,l) - (set-marker-insertion-type (oref s end) nil)) - (magit-section-maybe-remove-heading-map ,s) - (magit-section-maybe-remove-visibility-indicator ,s))))) - (funcall ,f))))) - -(defun magit-insert-headers (hook) - (let* ((header-sections nil) - (magit-insert-section-hook - (cons (lambda () - (push magit-insert-section--current - header-sections)) - (if (listp magit-insert-section-hook) - magit-insert-section-hook - (list magit-insert-section-hook))))) - (magit-run-section-hook hook) - (when header-sections - (insert "\n") - ;; Make the first header into the parent of the rest. - (when (cdr header-sections) - (cl-callf nreverse header-sections) - (let* ((1st-header (pop header-sections)) - (header-parent (oref 1st-header parent))) - (oset header-parent children (list 1st-header)) - (oset 1st-header children header-sections) - (oset 1st-header content (oref (car header-sections) start)) - (oset 1st-header end (oref (car (last header-sections)) end)) - (dolist (sub-header header-sections) - (oset sub-header parent 1st-header)) - (magit-section-maybe-add-heading-map 1st-header)))))) - -(defun magit-section-maybe-add-heading-map (section) - (when (magit-section-content-p section) - (let ((start (oref section start)) - (map (oref section keymap))) - (when (symbolp map) - (setq map (symbol-value map))) - (put-text-property - start - (save-excursion - (goto-char start) - (line-end-position)) - 'keymap (if map - (make-composed-keymap - (list map magit-section-heading-map)) - magit-section-heading-map))))) - -(defun magit-section-maybe-remove-heading-map (section) - (with-slots (start content end keymap) section - (when (= content end) - (put-text-property start end 'keymap keymap)))) - -(defun magit-insert-child-count (section) - "Modify SECTION's heading to contain number of child sections. - -If `magit-section-show-child-count' is non-nil and the SECTION -has children and its heading ends with \":\", then replace that -with \" (N)\", where N is the number of child sections. - -This function is called by `magit-insert-section' after that has -evaluated its BODY. Admittedly that's a bit of a hack." - (let (content count) - (when (and magit-section-show-child-count - (setq content (oref section content)) - (setq count (length (oref section children))) - (> count 0) - (eq (char-before (1- content)) ?:)) - (save-excursion - (goto-char (- content 2)) - (insert (magit--propertize-face (format " (%s)" count) - 'magit-section-child-count)) - (delete-char 1))))) - -;;; Highlight - -(defun magit-section-pre-command-hook () - (when (and (or magit--context-menu-buffer - magit--context-menu-section) - (not (eq (ignore-errors - (event-basic-type (aref (this-command-keys) 0))) - 'mouse-3))) - ;; This is the earliest opportunity to clean up after an aborted - ;; context-menu because that neither causes the command that created - ;; the menu to abort nor some abortion hook to be run. It is not - ;; possible to update highlighting before the first command invoked - ;; after the menu is aborted. Here we can only make sure it is - ;; updated afterwards. - (magit-menu-highlight-point-section)) - (setq magit-section-pre-command-region-p (region-active-p)) - (setq magit-section-pre-command-section (magit-current-section))) - -(defun magit-section-post-command-hook () - (let ((window (selected-window))) - ;; The command may have used `set-window-buffer' to change - ;; the window's buffer without changing the current buffer. - (when (eq (current-buffer) (window-buffer window)) - (cursor-sensor-move-to-tangible window) - (when (or magit--context-menu-buffer - magit--context-menu-section) - (magit-menu-highlight-point-section)))) - (unless (memq this-command '(magit-refresh magit-refresh-all)) - (magit-section-update-highlight))) - -(defun magit-section-deactivate-mark () - (setq magit-section-highlight-force-update t)) - -(defun magit-section-update-highlight (&optional force) - (let ((section (magit-current-section))) - (when (or force - magit-section-highlight-force-update - (xor magit-section-pre-command-region-p (region-active-p)) - (not (eq magit-section-pre-command-section section))) - (let ((inhibit-read-only t) - (deactivate-mark nil) - (selection (magit-region-sections))) - (mapc #'delete-overlay magit-section-highlight-overlays) - (setq magit-section-highlight-overlays nil) - (setq magit-section-unhighlight-sections - magit-section-highlighted-sections) - (setq magit-section-highlighted-sections nil) - (if (and (fboundp 'long-line-optimizations-p) - (long-line-optimizations-p)) - (magit-section--enable-long-lines-shortcuts) - (unless (eq section magit-root-section) - (run-hook-with-args-until-success - 'magit-section-highlight-hook section selection)) - (dolist (s magit-section-unhighlight-sections) - (run-hook-with-args-until-success - 'magit-section-unhighlight-hook s selection))) - (restore-buffer-modified-p nil))) - (setq magit-section-highlight-force-update nil) - (magit-section-maybe-paint-visibility-ellipses))) - -(defun magit-section-highlight (section selection) - "Highlight SECTION and if non-nil all sections in SELECTION. -This function works for any section but produces undesirable -effects for diff related sections, which by default are -highlighted using `magit-diff-highlight'. Return t." - (when-let ((face (oref section heading-highlight-face))) - (dolist (section (or selection (list section))) - (magit-section-make-overlay - (oref section start) - (or (oref section content) - (oref section end)) - face))) - (cond (selection - (magit-section-make-overlay (oref (car selection) start) - (oref (car (last selection)) end) - 'magit-section-highlight) - (magit-section-highlight-selection nil selection)) - (t - (magit-section-make-overlay (oref section start) - (oref section end) - 'magit-section-highlight))) - t) - -(defun magit-section-highlight-selection (_ selection) - "Highlight the section-selection region. -If SELECTION is non-nil, then it is a list of sections selected by -the region. The headings of these sections are then highlighted. - -This is a fallback for people who don't want to highlight the -current section and therefore removed `magit-section-highlight' -from `magit-section-highlight-hook'. - -This function is necessary to ensure that a representation of -such a region is visible. If neither of these functions were -part of the hook variable, then such a region would be -invisible." - (when (and selection - (not (and (eq this-command 'mouse-drag-region)))) - (dolist (section selection) - (magit-section-make-overlay (oref section start) - (or (oref section content) - (oref section end)) - 'magit-section-heading-selection)) - t)) - -(defun magit-section-make-overlay (start end face) - ;; Yes, this doesn't belong here. But the alternative of - ;; spreading this hack across the code base is even worse. - (when (and magit-section-keep-region-overlay - (memq face '(magit-section-heading-selection - magit-diff-file-heading-selection - magit-diff-hunk-heading-selection))) - (setq face (list :foreground (face-foreground face)))) - (let ((ov (make-overlay start end nil t))) - (overlay-put ov 'font-lock-face face) - (overlay-put ov 'evaporate t) - (push ov magit-section-highlight-overlays) - ov)) - -(defvar magit-show-long-lines-warning t) - -(defun magit-section--enable-long-lines-shortcuts () - (message "Enabling long lines shortcuts in %S" (current-buffer)) - (kill-local-variable 'redisplay-highlight-region-function) - (kill-local-variable 'redisplay-unhighlight-region-function) - (when magit-show-long-lines-warning - (setq magit-show-long-lines-warning nil) - (display-warning 'magit (format "\ -Emacs has enabled redisplay shortcuts -in this buffer because there are lines whose length go beyond -`long-line-threshold' \(%s characters). As a result, section -highlighting and the special appearance of the region has been -disabled. Some existing highlighting might remain in effect. - -These shortcuts remain enabled, even once there no longer are -any long lines in this buffer. To disable them again, kill -and recreate the buffer. - -This message won't be shown for this session again. To disable -it for all future sessions, set `magit-show-long-lines-warning' -to nil." (bound-and-true-p long-line-threshold)) :warning))) - -(cl-defgeneric magit-section-get-relative-position (section)) - -(cl-defmethod magit-section-get-relative-position ((section magit-section)) - (let ((start (oref section start)) - (point (magit-point))) - (list (- (line-number-at-pos point) - (line-number-at-pos start)) - (- point (line-beginning-position))))) - -(cl-defgeneric magit-section-goto-successor ()) - -(cl-defmethod magit-section-goto-successor ((section magit-section) - line char &optional _arg) - (or (magit-section-goto-successor--same section line char) - (magit-section-goto-successor--related section))) - -(defun magit-section-goto-successor--same (section line char) - (let ((ident (magit-section-ident section))) - (and-let* ((found (magit-get-section ident))) - (let ((start (oref found start))) - (goto-char start) - (unless (eq found magit-root-section) - (ignore-errors - (forward-line line) - (forward-char char)) - (unless (eq (magit-current-section) found) - (goto-char start))) - t)))) - -(defun magit-section-goto-successor--related (section) - (and-let* ((found (magit-section-goto-successor--related-1 section))) - (goto-char (if (eq (oref found type) 'button) - (point-min) - (oref found start))))) - -(defun magit-section-goto-successor--related-1 (section) - (or (and-let* ((alt (pcase (oref section type) - ('staged 'unstaged) - ('unstaged 'staged) - ('unpushed 'unpulled) - ('unpulled 'unpushed)))) - (magit-get-section `((,alt) (status)))) - (and-let* ((next (car (magit-section-siblings section 'next)))) - (magit-get-section (magit-section-ident next))) - (and-let* ((prev (car (magit-section-siblings section 'prev)))) - (magit-get-section (magit-section-ident prev))) - (and-let* ((parent (oref section parent))) - (or (magit-get-section (magit-section-ident parent)) - (magit-section-goto-successor--related-1 parent))))) - -;;; Region - -(defvar-local magit-section--region-overlays nil) - -(defun magit-section--delete-region-overlays () - (mapc #'delete-overlay magit-section--region-overlays) - (setq magit-section--region-overlays nil)) - -(defun magit-section--highlight-region (start end window rol) - (magit-section--delete-region-overlays) - (if (and (not magit-section-keep-region-overlay) - (or (magit-region-sections) - (run-hook-with-args-until-success 'magit-region-highlight-hook - (magit-current-section))) - (not (= (line-number-at-pos start) - (line-number-at-pos end))) - ;; (not (eq (car-safe last-command-event) 'mouse-movement)) - ) - (funcall (default-value 'redisplay-unhighlight-region-function) rol) - (funcall (default-value 'redisplay-highlight-region-function) - start end window rol))) - -(defun magit-section--unhighlight-region (rol) - (magit-section--delete-region-overlays) - (funcall (default-value 'redisplay-unhighlight-region-function) rol)) - -;;; Visibility - -(defvar-local magit-section-visibility-cache nil) -(put 'magit-section-visibility-cache 'permanent-local t) - -(defun magit-section-cached-visibility (section) - "Set SECTION's visibility to the cached value. -When `magit-section-preserve-visibility' is nil, do nothing." - (and magit-section-preserve-visibility - (cdr (assoc (magit-section-ident section) - magit-section-visibility-cache)))) - -(cl-defun magit-section-cache-visibility - (&optional (section magit-insert-section--current)) - (setf (compat-call alist-get - (magit-section-ident section) - magit-section-visibility-cache - nil nil #'equal) - (if (oref section hidden) 'hide 'show))) - -(cl-defun magit-section-maybe-cache-visibility - (&optional (section magit-insert-section--current)) - (when (or (eq magit-section-cache-visibility t) - (memq (oref section type) - magit-section-cache-visibility)) - (magit-section-cache-visibility section))) - -(defun magit-section-maybe-update-visibility-indicator (section) - (when (and magit-section-visibility-indicator - (magit-section-content-p section)) - (let* ((beg (oref section start)) - (eoh (save-excursion - (goto-char beg) - (line-end-position)))) - (cond - ((symbolp (car-safe magit-section-visibility-indicator)) - (let ((ov (magit--overlay-at beg 'magit-vis-indicator 'fringe))) - (unless ov - (setq ov (make-overlay beg eoh nil t)) - (overlay-put ov 'evaporate t) - (overlay-put ov 'magit-vis-indicator 'fringe)) - (overlay-put - ov 'before-string - (propertize "fringe" 'display - (list 'left-fringe - (if (oref section hidden) - (car magit-section-visibility-indicator) - (cdr magit-section-visibility-indicator)) - 'fringe))))) - ((stringp (car-safe magit-section-visibility-indicator)) - (let ((ov (magit--overlay-at (1- eoh) 'magit-vis-indicator 'eoh))) - (cond ((oref section hidden) - (unless ov - (setq ov (make-overlay (1- eoh) eoh)) - (overlay-put ov 'evaporate t) - (overlay-put ov 'magit-vis-indicator 'eoh)) - (overlay-put ov 'after-string - (car magit-section-visibility-indicator))) - (ov - (delete-overlay ov))))))))) - -(defvar-local magit--ellipses-sections nil) - -(defun magit-section-maybe-paint-visibility-ellipses () - ;; This is needed because we hide the body instead of "the body - ;; except the final newline and additionally the newline before - ;; the body"; otherwise we could use `buffer-invisibility-spec'. - (when (stringp (car-safe magit-section-visibility-indicator)) - (let* ((sections (append magit--ellipses-sections - (setq magit--ellipses-sections - (or (magit-region-sections) - (list (magit-current-section)))))) - (beg (--map (oref it start) sections)) - (end (--map (oref it end) sections))) - (when (region-active-p) - ;; This ensures that the region face is removed from ellipses - ;; when the region becomes inactive, but fails to ensure that - ;; all ellipses within the active region use the region face, - ;; because the respective overlay has not yet been updated at - ;; this time. The magit-selection face is always applied. - (push (region-beginning) beg) - (push (region-end) end)) - (setq beg (apply #'min beg)) - (setq end (apply #'max end)) - (dolist (ov (overlays-in beg end)) - (when (eq (overlay-get ov 'magit-vis-indicator) 'eoh) - (overlay-put - ov 'after-string - (propertize - (car magit-section-visibility-indicator) 'font-lock-face - (let ((pos (overlay-start ov))) - (delq nil (nconc (--map (overlay-get it 'font-lock-face) - (overlays-at pos)) - (list (get-char-property - pos 'font-lock-face)))))))))))) - -(defun magit-section-maybe-remove-visibility-indicator (section) - (when (and magit-section-visibility-indicator - (= (oref section content) - (oref section end))) - (dolist (o (overlays-in (oref section start) - (save-excursion - (goto-char (oref section start)) - (1+ (line-end-position))))) - (when (overlay-get o 'magit-vis-indicator) - (delete-overlay o))))) - -(defvar-local magit-section--opened-sections nil) - -(defun magit-section--open-temporarily (beg end) - (save-excursion - (goto-char beg) - (let ((section (magit-current-section))) - (while section - (let ((content (oref section content))) - (if (and (magit-section-invisible-p section) - (<= (or content (oref section start)) - beg - (oref section end))) - (progn - (when content - (magit-section-show section) - (push section magit-section--opened-sections)) - (setq section (oref section parent))) - (setq section nil)))))) - (or (eq search-invisible t) - (not (isearch-range-invisible beg end)))) - -(define-advice isearch-clean-overlays (:around (fn) magit-mode) - (if (derived-mode-p 'magit-mode) - (let ((pos (point))) - (dolist (section magit-section--opened-sections) - (unless (<= (oref section content) pos (oref section end)) - (magit-section-hide section))) - (setq magit-section--opened-sections nil)) - (funcall fn))) - -;;; Utilities - -(cl-defun magit-section-selected-p (section &optional (selection nil sselection)) - (and (not (eq section magit-root-section)) - (or (eq section (magit-current-section)) - (memq section (if sselection - selection - (setq selection (magit-region-sections)))) - (and-let* ((parent (oref section parent))) - (magit-section-selected-p parent selection))))) - -(defun magit-section-parent-value (section) - (and-let* ((parent (oref section parent))) - (oref parent value))) - -(defun magit-section-siblings (section &optional direction) - "Return a list of the sibling sections of SECTION. - -If optional DIRECTION is `prev', then return siblings that come -before SECTION. If it is `next', then return siblings that come -after SECTION. For all other values, return all siblings -excluding SECTION itself." - (and-let* ((parent (oref section parent)) - (siblings (oref parent children))) - (pcase direction - ('prev (cdr (member section (reverse siblings)))) - ('next (cdr (member section siblings))) - (_ (remq section siblings))))) - -(defun magit-region-values (&optional condition multiple) - "Return a list of the values of the selected sections. - -Return the values that themselves would be returned by -`magit-region-sections' (which see)." - (--map (oref it value) - (magit-region-sections condition multiple))) - -(defun magit-region-sections (&optional condition multiple) - "Return a list of the selected sections. - -When the region is active and constitutes a valid section -selection, then return a list of all selected sections. This is -the case when the region begins in the heading of a section and -ends in the heading of the same section or in that of a sibling -section. If optional MULTIPLE is non-nil, then the region cannot -begin and end in the same section. - -When the selection is not valid, then return nil. In this case, -most commands that can act on the selected sections will instead -act on the section at point. - -When the region looks like it would in any other buffer then -the selection is invalid. When the selection is valid then the -region uses the `magit-section-highlight' face. This does not -apply to diffs where things get a bit more complicated, but even -here if the region looks like it usually does, then that's not -a valid selection as far as this function is concerned. - -If optional CONDITION is non-nil, then the selection not only -has to be valid; all selected sections additionally have to match -CONDITION, or nil is returned. See `magit-section-match' for the -forms CONDITION can take." - (and (region-active-p) - (let* ((rbeg (region-beginning)) - (rend (region-end)) - (sbeg (magit-section-at rbeg)) - (send (magit-section-at rend))) - (and send - (not (eq send magit-root-section)) - (not (and multiple (eq send sbeg))) - (let ((siblings (cons sbeg (magit-section-siblings sbeg 'next))) - (sections ())) - (and (memq send siblings) - (magit-section-position-in-heading-p sbeg rbeg) - (magit-section-position-in-heading-p send rend) - (progn - (while siblings - (push (car siblings) sections) - (when (eq (pop siblings) send) - (setq siblings nil))) - (setq sections (nreverse sections)) - (and (or (not condition) - (--all-p (magit-section-match condition it) - sections)) - sections)))))))) - -(defun magit-map-sections (function &optional section) - "Apply FUNCTION to all sections for side effects only, depth first. -If optional SECTION is non-nil, only map over that section and -its descendants, otherwise map over all sections in the current -buffer, ending with `magit-root-section'." - (let ((section (or section magit-root-section))) - (mapc (lambda (child) (magit-map-sections function child)) - (oref section children)) - (funcall function section))) - -(defun magit-section-position-in-heading-p (&optional section pos) - "Return t if POSITION is inside the heading of SECTION. -POSITION defaults to point and SECTION defaults to the -current section." - (unless section - (setq section (magit-current-section))) - (unless pos - (setq pos (point))) - (ignore-errors ; Allow navigating broken sections. - (and section - (>= pos (oref section start)) - (< pos (or (oref section content) - (oref section end))) - t))) - -(defun magit-section-internal-region-p (&optional section) - "Return t if the region is active and inside SECTION's body. -If optional SECTION is nil, use the current section." - (and (region-active-p) - (or section (setq section (magit-current-section))) - (let ((beg (magit-section-at (region-beginning)))) - (and (eq beg (magit-section-at (region-end))) - (eq beg section))) - (not (or (magit-section-position-in-heading-p section (region-beginning)) - (magit-section-position-in-heading-p section (region-end)))) - t)) - -(defun magit-wash-sequence (function) - "Repeatedly call FUNCTION until it returns nil or eob is reached. -FUNCTION has to move point forward or return nil." - (while (and (not (eobp)) (funcall function)))) - -(defun magit-add-section-hook (hook function &optional at append local) - "Add to the value of section hook HOOK the function FUNCTION. - -Add FUNCTION at the beginning of the hook list unless optional -APPEND is non-nil, in which case FUNCTION is added at the end. -If FUNCTION already is a member, then move it to the new location. - -If optional AT is non-nil and a member of the hook list, then -add FUNCTION next to that instead. Add before or after AT, or -replace AT with FUNCTION depending on APPEND. If APPEND is the -symbol `replace', then replace AT with FUNCTION. For any other -non-nil value place FUNCTION right after AT. If nil, then place -FUNCTION right before AT. If FUNCTION already is a member of the -list but AT is not, then leave FUNCTION where ever it already is. - -If optional LOCAL is non-nil, then modify the hook's buffer-local -value rather than its global value. This makes the hook local by -copying the default value. That copy is then modified. - -HOOK should be a symbol. If HOOK is void, it is first set to nil. -HOOK's value must not be a single hook function. FUNCTION should -be a function that takes no arguments and inserts one or multiple -sections at point, moving point forward. FUNCTION may choose not -to insert its section(s), when doing so would not make sense. It -should not be abused for other side-effects. To remove FUNCTION -again use `remove-hook'." - (unless (boundp hook) - (error "Cannot add function to undefined hook variable %s" hook)) - (unless (default-boundp hook) - (set-default hook nil)) - (let ((value (if local - (if (local-variable-p hook) - (symbol-value hook) - (unless (local-variable-if-set-p hook) - (make-local-variable hook)) - (copy-sequence (default-value hook))) - (default-value hook)))) - (if at - (when (setq at (member at value)) - (setq value (delq function value)) - (cond ((eq append 'replace) - (setcar at function)) - (append - (push function (cdr at))) - (t - (push (car at) (cdr at)) - (setcar at function)))) - (setq value (delq function value))) - (unless (member function value) - (setq value (if append - (append value (list function)) - (cons function value)))) - (when (eq append 'replace) - (setq value (delq at value))) - (if local - (set hook value) - (set-default hook value)))) - -(defvar-local magit-disabled-section-inserters nil) - -(defun magit-disable-section-inserter (fn) - "Disable the section inserter FN in the current repository. -It is only intended for use in \".dir-locals.el\" and -\".dir-locals-2.el\". Also see info node `(magit)Per-Repository -Configuration'." - (cl-pushnew fn magit-disabled-section-inserters)) - -(put 'magit-disable-section-inserter 'safe-local-eval-function t) - -(defun magit-run-section-hook (hook &rest args) - "Run HOOK with ARGS, warning about invalid entries." - (let ((entries (symbol-value hook))) - (unless (listp entries) - (setq entries (list entries))) - (when-let ((invalid (seq-remove #'functionp entries))) - (message "`%s' contains entries that are no longer valid. -%s\nUsing standard value instead. Please re-configure hook variable." - hook - (mapconcat (lambda (sym) (format " `%s'" sym)) invalid "\n")) - (sit-for 5) - (setq entries (eval (car (get hook 'standard-value))))) - (dolist (entry entries) - (let ((magit--current-section-hook (cons (list hook entry) - magit--current-section-hook))) - (unless (memq entry magit-disabled-section-inserters) - (if (bound-and-true-p magit-refresh-verbose) - (let ((time (benchmark-elapse (apply entry args)))) - (message " %-50s %f %s" entry time - (cond ((> time 0.03) "!!") - ((> time 0.01) "!") - (t "")))) - (apply entry args))))))) - -(cl-defun magit--overlay-at (pos prop &optional (val nil sval) testfn) - (cl-find-if (lambda (o) - (let ((p (overlay-properties o))) - (and (plist-member p prop) - (or (not sval) - (funcall (or testfn #'eql) - (plist-get p prop) - val))))) - (overlays-at pos t))) - -(defun magit-face-property-all (face string) - "Return non-nil if FACE is present in all of STRING." - (catch 'missing - (let ((pos 0)) - (while (setq pos (next-single-property-change pos 'font-lock-face string)) - (let ((val (get-text-property pos 'font-lock-face string))) - (unless (if (consp val) - (memq face val) - (eq face val)) - (throw 'missing nil)))) - (not pos)))) - -(defun magit--add-face-text-property (beg end face &optional append object) - "Like `add-face-text-property' but for `font-lock-face'." - (while (< beg end) - (let* ((pos (next-single-property-change beg 'font-lock-face object end)) - (val (get-text-property beg 'font-lock-face object)) - (val (if (listp val) val (list val)))) - (put-text-property beg pos 'font-lock-face - (if append - (append val (list face)) - (cons face val)) - object) - (setq beg pos)))) - -(defun magit--propertize-face (string face) - (propertize string 'face face 'font-lock-face face)) - -(defun magit--put-face (beg end face string) - (put-text-property beg end 'face face string) - (put-text-property beg end 'font-lock-face face string)) - -;;; Imenu Support - -(defvar-local magit--imenu-group-types nil) -(defvar-local magit--imenu-item-types nil) - -(defun magit--imenu-create-index () - ;; If `which-function-mode' is active, then the create-index - ;; function is called at the time the major-mode is being enabled. - ;; Modes that derive from `magit-mode' have not populated the buffer - ;; at that time yet, so we have to abort. - (and magit-root-section - (or magit--imenu-group-types - magit--imenu-item-types) - (let ((index - (cl-mapcan - (lambda (section) - (cond - (magit--imenu-group-types - (and (if (eq (car-safe magit--imenu-group-types) 'not) - (not (magit-section-match - (cdr magit--imenu-group-types) - section)) - (magit-section-match magit--imenu-group-types section)) - (and-let* ((children (oref section children))) - `((,(magit--imenu-index-name section) - ,@(mapcar (lambda (s) - (cons (magit--imenu-index-name s) - (oref s start))) - children)))))) - (magit--imenu-item-types - (and (magit-section-match magit--imenu-item-types section) - `((,(magit--imenu-index-name section) - . ,(oref section start))))))) - (oref magit-root-section children)))) - (if (and magit--imenu-group-types (symbolp magit--imenu-group-types)) - (cdar index) - index)))) - -(defun magit--imenu-index-name (section) - (let ((heading (buffer-substring-no-properties - (oref section start) - (1- (or (oref section content) - (oref section end)))))) - (save-match-data - (cond - ((and (magit-section-match [commit logbuf] section) - (string-match "[^ ]+\\([ *|]*\\).+" heading)) - (replace-match " " t t heading 1)) - ((magit-section-match - '([branch local branchbuf] [tag tags branchbuf]) section) - (oref section value)) - ((magit-section-match [branch remote branchbuf] section) - (concat (oref (oref section parent) value) "/" - (oref section value))) - ((string-match " ([0-9]+)\\'" heading) - (substring heading 0 (match-beginning 0))) - (t heading))))) - -(defun magit--imenu-goto-function (_name position &rest _rest) - "Go to the section at POSITION. -Make sure it is visible, by showing its ancestors where -necessary. For use as `imenu-default-goto-function' in -`magit-mode' buffers." - (goto-char position) - (let ((section (magit-current-section))) - (while (setq section (oref section parent)) - (when (oref section hidden) - (magit-section-show section))))) - -;;; Bookmark support - -(declare-function bookmark-get-filename "bookmark" (bookmark-name-or-record)) -(declare-function bookmark-make-record-default "bookmark" - (&optional no-file no-context posn)) -(declare-function bookmark-prop-get "bookmark" (bookmark-name-or-record prop)) -(declare-function bookmark-prop-set "bookmark" (bookmark-name-or-record prop val)) - -(cl-defgeneric magit-bookmark-get-filename () - (or (buffer-file-name) (buffer-name))) - -(cl-defgeneric magit-bookmark--get-child-value (section) - (oref section value)) - -(cl-defgeneric magit-bookmark-get-buffer-create (bookmark mode)) - -(defun magit--make-bookmark () - "Create a bookmark for the current Magit buffer. -Input values are the major-mode's `magit-bookmark-name' method, -and the buffer-local values of the variables referenced in its -`magit-bookmark-variables' property." - (require 'bookmark) - (if (plist-member (symbol-plist major-mode) 'magit-bookmark-variables) - ;; `bookmark-make-record-default's return value does not match - ;; (NAME . ALIST), even though it is used as the default value - ;; of `bookmark-make-record-function', which states that such - ;; functions must do that. See #4356. - (let ((bookmark (cons nil (bookmark-make-record-default 'no-file)))) - (bookmark-prop-set bookmark 'handler #'magit--handle-bookmark) - (bookmark-prop-set bookmark 'mode major-mode) - (bookmark-prop-set bookmark 'filename (magit-bookmark-get-filename)) - (bookmark-prop-set bookmark 'defaults (list (magit-bookmark-name))) - (dolist (var (get major-mode 'magit-bookmark-variables)) - (bookmark-prop-set bookmark var (symbol-value var))) - (bookmark-prop-set - bookmark 'magit-hidden-sections - (--keep (and (oref it hidden) - (cons (oref it type) - (magit-bookmark--get-child-value it))) - (oref magit-root-section children))) - bookmark) - (user-error "Bookmarking is not implemented for %s buffers" major-mode))) - -(defun magit--handle-bookmark (bookmark) - "Open a bookmark created by `magit--make-bookmark'. - -Call the generic function `magit-bookmark-get-buffer-create' to get -the appropriate buffer without displaying it. - -Then call the `magit-*-setup-buffer' function of the the major-mode -with the variables' values as arguments, which were recorded by -`magit--make-bookmark'." - (let ((buffer (magit-bookmark-get-buffer-create - bookmark - (bookmark-prop-get bookmark 'mode)))) - (set-buffer buffer) ; That is the interface we have to adhere to. - (when-let ((hidden (bookmark-prop-get bookmark 'magit-hidden-sections))) - (with-current-buffer buffer - (dolist (child (oref magit-root-section children)) - (if (member (cons (oref child type) - (oref child value)) - hidden) - (magit-section-hide child) - (magit-section-show child))))) - ;; Compatibility with `bookmark+' package. See #4356. - (when (bound-and-true-p bmkp-jump-display-function) - (funcall bmkp-jump-display-function (current-buffer))) - nil)) - -(put 'magit--handle-bookmark 'bookmark-handler-type "Magit") - -(cl-defgeneric magit-bookmark-name () - "Return name for bookmark to current buffer." - (format "%s%s" - (substring (symbol-name major-mode) 0 -5) - (if-let ((vars (get major-mode 'magit-bookmark-variables))) - (cl-mapcan (lambda (var) - (let ((val (symbol-value var))) - (if (and val (atom val)) - (list val) - val))) - vars) - ""))) - -;;; Bitmaps - -(when (fboundp 'define-fringe-bitmap) ;for Emacs 26 - (define-fringe-bitmap 'magit-fringe-bitmap+ - [#b00000000 - #b00011000 - #b00011000 - #b01111110 - #b01111110 - #b00011000 - #b00011000 - #b00000000]) - - (define-fringe-bitmap 'magit-fringe-bitmap- - [#b00000000 - #b00000000 - #b00000000 - #b01111110 - #b01111110 - #b00000000 - #b00000000 - #b00000000]) - - (define-fringe-bitmap 'magit-fringe-bitmap> - [#b01100000 - #b00110000 - #b00011000 - #b00001100 - #b00011000 - #b00110000 - #b01100000 - #b00000000]) - - (define-fringe-bitmap 'magit-fringe-bitmapv - [#b00000000 - #b10000010 - #b11000110 - #b01101100 - #b00111000 - #b00010000 - #b00000000 - #b00000000]) - - (define-fringe-bitmap 'magit-fringe-bitmap-bold> - [#b11100000 - #b01110000 - #b00111000 - #b00011100 - #b00011100 - #b00111000 - #b01110000 - #b11100000]) - - (define-fringe-bitmap 'magit-fringe-bitmap-boldv - [#b10000001 - #b11000011 - #b11100111 - #b01111110 - #b00111100 - #b00011000 - #b00000000 - #b00000000]) - ) - -;;; _ -(provide 'magit-section) -;;; magit-section.el ends here diff --git a/emacs/elpa/magit-section-20240621.2229/magit-section.elc b/emacs/elpa/magit-section-20240621.2229/magit-section.elc Binary files differ. diff --git a/emacs/elpa/magit-section-20240621.2229/magit-section.info b/emacs/elpa/magit-section-20240621.2229/magit-section.info @@ -1,310 +0,0 @@ -This is magit-section.info, produced by makeinfo version 6.7 from -magit-section.texi. - - Copyright (C) 2015-2024 Jonas Bernoulli - <emacs.magit@jonas.bernoulli.dev> - - 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 -* Magit-Section: (magit-section). Use Magit sections in your own packages. -END-INFO-DIR-ENTRY - - -File: magit-section.info, Node: Top, Next: Introduction, Up: (dir) - -Magit-Section Developer Manual -****************************** - -This package implements the main user interface of Magit — the -collapsible sections that make up its buffers. This package used to be -distributed as part of Magit but how it can also be used by other -packages that have nothing to do with Magit or Git. - - To learn more about the section abstraction and available commands -and user options see *note (magit)Sections::. This manual documents how -you can use sections in your own packages. - -This manual is for Magit-Section version 3.3.0.50-git. - - Copyright (C) 2015-2024 Jonas Bernoulli - <emacs.magit@jonas.bernoulli.dev> - - 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:: -* Creating Sections:: -* Core Functions:: -* Matching Functions:: - - -File: magit-section.info, Node: Introduction, Next: Creating Sections, Prev: Top, Up: Top - -1 Introduction -************** - -This package implements the main user interface of Magit — the -collapsible sections that make up its buffers. This package used to be -distributed as part of Magit but how it can also be used by other -packages that have nothing to do with Magit or Git. - - To learn more about the section abstraction and available commands -and user options see *note (magit)Sections::. This manual documents how -you can use sections in your own packages. - - When the documentation leaves something unaddressed, then please -consider that Magit uses this library extensively and search its source -for suitable examples before asking me for help. Thanks! - - -File: magit-section.info, Node: Creating Sections, Next: Core Functions, Prev: Introduction, Up: Top - -2 Creating Sections -******************* - - -- Macro: magit-insert-section [name] (type &optional value hide) &rest - body - Create a section object of type CLASS, storing VALUE in its ‘value’ - slot, and insert the section at point. CLASS is a subclass of - ‘magit-section’ or has the form ‘(eval FORM)’, in which case FORM - is evaluated at runtime and should return a subclass. In other - places a sections class is often referred to as its "type". - - Many commands behave differently depending on the class of the - current section and sections of a certain class can have their own - keymap, which is specified using the ‘keymap’ class slot. The - value of that slot should be a variable whose value is a keymap. - - For historic reasons Magit and Forge in most cases use symbols as - CLASS that don’t actually identify a class and that lack the - appropriate package prefix. This works due to some undocumented - kludges, which are not available to other packages. - - When optional HIDE is non-nil collapse the section body by default, - i.e., when first creating the section, but not when refreshing the - buffer. Else expand it by default. This can be overwritten using - ‘magit-section-set-visibility-hook’. When a section is recreated - during a refresh, then the visibility of predecessor is inherited - and HIDE is ignored (but the hook is still honored). - - BODY is any number of forms that actually insert the section’s - heading and body. Optional NAME, if specified, has to be a symbol, - which is then bound to the object of the section being inserted. - - Before BODY is evaluated the ‘start’ of the section object is set - to the value of ‘point’ and after BODY was evaluated its ‘end’ is - set to the new value of ‘point’; BODY is responsible for moving - ‘point’ forward. - - If it turns out inside BODY that the section is empty, then - ‘magit-cancel-section’ can be used to abort and remove all traces - of the partially inserted section. This can happen when creating a - section by washing Git’s output and Git didn’t actually output - anything this time around. - - -- Function: magit-insert-heading &rest args - Insert the heading for the section currently being inserted. - - This function should only be used inside ‘magit-insert-section’. - - When called without any arguments, then just set the ‘content’ slot - of the object representing the section being inserted to a marker - at ‘point’. The section should only contain a single line when - this function is used like this. - - When called with arguments ARGS, which have to be strings, or nil, - then insert those strings at point. The section should not contain - any text before this happens and afterwards it should again only - contain a single line. If the ‘face’ property is set anywhere - inside any of these strings, then insert all of them unchanged. - Otherwise use the ‘magit-section-heading’ face for all inserted - text. - - The ‘content’ property of the section object is the end of the - heading (which lasts from ‘start’ to ‘content’) and the beginning - of the the body (which lasts from ‘content’ to ‘end’). If the - value of ‘content’ is nil, then the section has no heading and its - body cannot be collapsed. If a section does have a heading, then - its height must be exactly one line, including a trailing newline - character. This isn’t enforced, you are responsible for getting it - right. The only exception is that this function does insert a - newline character if necessary. - - -- Macro: magit-insert-section-body &rest body - Use BODY to insert the section body, once the section is expanded. - If the section is expanded when it is created, then this is like - ‘progn’. Otherwise BODY isn’t evaluated until the section is - explicitly expanded. - - -- Function: magit-cancel-section - Cancel inserting the section that is currently being inserted. - Remove all traces of that section. - - -- Function: magit-wash-sequence function - Repeatedly call FUNCTION until it returns ‘nil’ or the end of the - buffer is reached. FUNCTION has to move point forward or return - ‘nil’. - - -File: magit-section.info, Node: Core Functions, Next: Matching Functions, Prev: Creating Sections, Up: Top - -3 Core Functions -**************** - - -- Function: magit-current-section - Return the section at point or where the context menu was invoked. - When using the context menu, return the section that the user - clicked on, provided the current buffer is the buffer in which the - click occurred. Otherwise return the section at point. - -Function magit-section-at &optional position - Return the section at POSITION, defaulting to point. Default to - point even when the context menu is used. - - -- Function: magit-section-ident section - Return an unique identifier for SECTION. The return value has the - form ‘((TYPE . VALUE)...)’. - - -- Function: magit-section-ident-value value - Return a constant representation of VALUE. - - VALUE is the value of a ‘magit-section’ object. If that is an - object itself, then that is not suitable to be used to identify the - section because two objects may represent the same thing but not be - equal. If possible a method should be added for such objects, - which returns a value that is equal. Otherwise the catch-all - method is used, which just returns the argument itself. - - -- Function: magit-get-section ident &optional root - Return the section identified by IDENT. IDENT has to be a list as - returned by ‘magit-section-ident’. If optional ROOT is non-nil, - then search in that section tree instead of in the one whose root - ‘magit-root-section’ is. - - -- Function: magit-section-lineage section &optional raw - Return the lineage of SECTION. If optional RAW is non-nil, return - a list of section objects, beginning with SECTION, otherwise return - a list of section types. - - -- Function: magit-section-content-p section - Return non-nil if SECTION has content or an unused washer function. - - The next two functions are replacements for the Emacs functions that -have the same name except for the ‘magit-’ prefix. Like -‘magit-current-section’ they do not act on point, the cursors position, -but on the position where the user clicked to invoke the context menu. - - If your package provides a context menu and some of its commands act -on the "thing at point", even if just as a default, then use the -prefixed functions to teach them to instead use the click location when -appropriate. - -Function magit-point - Return point or the position where the context menu was invoked. - When using the context menu, return the position the user clicked - on, provided the current buffer is the buffer in which the click - occurred. Otherwise return the same value as ‘point’. - -Function magit-thing-at-point thing &optional no-properties - Return the THING at point or where the context menu was invoked. - When using the context menu, return the thing the user clicked on, - provided the current buffer is the buffer in which the click - occurred. Otherwise return the same value as ‘thing-at-point’. - For the meaning of THING and NO-PROPERTIES see that function. - - -File: magit-section.info, Node: Matching Functions, Prev: Core Functions, Up: Top - -4 Matching Functions -******************** - - -- Function: magit-section-match condition &optional (section - (magit-current-section)) - Return t if SECTION matches CONDITION. - - SECTION defaults to the section at point. If SECTION is not - specified and there also is no section at point, then return nil. - - CONDITION can take the following forms: - - • ‘(CONDITION...)’ matches if any of the CONDITIONs matches. - • ‘[CLASS...]’ matches if the section’s class is the same as the - first CLASS or a subclass of that; the section’s parent class - matches the second CLASS; and so on. - - • ‘[* CLASS...]’ matches sections that match [CLASS...] and also - recursively all their child sections. - • ‘CLASS’ matches if the section’s class is the same as CLASS or - a subclass of that; regardless of the classes of the parent - sections. - - Each CLASS should be a class symbol, identifying a class that - derives from ‘magit-section’. For backward compatibility CLASS can - also be a "type symbol". A section matches such a symbol if the - value of its ‘type’ slot is ‘eq’. If a type symbol has an entry in - ‘magit--section-type-alist’, then a section also matches that type - if its class is a subclass of the class that corresponds to the - type as per that alist. - - Note that it is not necessary to specify the complete section - lineage as printed by ‘magit-describe-section-briefly’, unless of - course you want to be that precise. - - -- Function: magit-section-value-if condition &optional section - If the section at point matches CONDITION, then return its value. - - If optional SECTION is non-nil then test whether that matches - instead. If there is no section at point and SECTION is nil, then - return nil. If the section does not match, then return nil. - - See ‘magit-section-match’ for the forms CONDITION can take. - - -- Macro: magit-section-case &rest clauses - Choose among clauses on the type of the section at point. - - Each clause looks like ‘(CONDITION BODY...)’. The type of the - section is compared against each CONDITION; the BODY forms of the - first match are evaluated sequentially and the value of the last - form is returned. Inside BODY the symbol ‘it’ is bound to the - section at point. If no clause succeeds or if there is no section - at point, return nil. - - See ‘magit-section-match’ for the forms CONDITION can take. - Additionally a CONDITION of t is allowed in the final clause, and - matches if no other CONDITION match, even if there is no section at - point. - - - -Tag Table: -Node: Top808 -Node: Introduction2116 -Node: Creating Sections2886 -Node: Core Functions7394 -Node: Matching Functions10546 - -End Tag Table - - -Local Variables: -coding: utf-8 -End: diff --git a/emacs/elpa/magit-section-20240621.2229/dir b/emacs/elpa/magit-section-20240624.719/dir diff --git a/emacs/elpa/magit-section-20240621.2229/magit-section-autoloads.el b/emacs/elpa/magit-section-20240624.719/magit-section-autoloads.el diff --git a/emacs/elpa/magit-section-20240624.719/magit-section-pkg.el b/emacs/elpa/magit-section-20240624.719/magit-section-pkg.el @@ -0,0 +1,14 @@ +(define-package "magit-section" "20240624.719" "Sections for read-only buffers." + '((emacs "26.1") + (compat "29.1.4.5") + (dash "20240405")) + :commit "0178d59d714f7968b8c5821fea95e68d27dde974" :authors + '(("Jonas Bernoulli" . "emacs.magit@jonas.bernoulli.dev")) + :maintainer + '("Jonas Bernoulli" . "emacs.magit@jonas.bernoulli.dev") + :keywords + '("tools") + :url "https://github.com/magit/magit") +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/emacs/elpa/magit-section-20240624.719/magit-section.el b/emacs/elpa/magit-section-20240624.719/magit-section.el @@ -0,0 +1,2507 @@ +;;; magit-section.el --- Sections for read-only buffers -*- lexical-binding:t; coding:utf-8 -*- + +;; Copyright (C) 2008-2024 The Magit Project Contributors + +;; Author: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> +;; Maintainer: Jonas Bernoulli <emacs.magit@jonas.bernoulli.dev> + +;; Homepage: https://github.com/magit/magit +;; Keywords: tools + +;; Package-Version: 3.3.0.50-git +;; Package-Requires: ( +;; (emacs "26.1") +;; (compat "29.1.4.5") +;; (dash "2.19.1") +;; (seq "2.24")) + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; 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. +;; +;; 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 Magit. If not, see <https://www.gnu.org/licenses/>. + +;; You should have received a copy of the AUTHORS.md file, which +;; lists all contributors. If not, see https://magit.vc/authors. + +;;; Commentary: + +;; This package implements the main user interface of Magit — the +;; collapsible sections that make up its buffers. This package used +;; to be distributed as part of Magit but now it can also be used by +;; other packages that have nothing to do with Magit or Git. + +;;; Code: + +(require 'cl-lib) +(require 'compat) +(require 'dash) +(require 'eieio) +(require 'subr-x) + +;; For older Emacs releases we depend on an updated `seq' release from GNU +;; ELPA, for `seq-keep'. Unfortunately something else may require `seq' +;; before `package' had a chance to put this version on the `load-path'. +(when (and (featurep 'seq) + (not (fboundp 'seq-keep))) + (unload-feature 'seq 'force)) +(require 'seq) +;; Furthermore, by default `package' just silently refuses to upgrade. +(defconst magit--core-upgrade-instructions "\ +Magit requires `%s' >= %s, +but due to bad defaults, Emacs' package manager, refuses to +upgrade this and other built-in packages to higher releases +from GNU Elpa. + +To fix this, you have to add this to your init file: + + (setq package-install-upgrade-built-in t) + +Then evaluate that expression by placing the cursor after it +and typing \\[eval-last-sexp]. + +Once you have done that, you have to explicitly upgrade `%s': + + \\[package-install] %s \\`RET' + +Then you also must make sure the updated version is loaded, +by evaluating this form: + + (progn (unload-feature \\='%s t) (require \\='%s)) + +If this does not work, then try uninstalling Magit and all of its +dependencies. After that exit and restart Emacs, and only then +reinstalling Magit. + +If you don't use the `package' package manager but still get +this warning, then your chosen package manager likely has a +similar defect.") +(unless (fboundp 'seq-keep) + (display-warning 'magit (substitute-command-keys + (format magit--core-upgrade-instructions + 'seq "2.24" 'seq 'seq 'seq 'seq)) + :emergency)) + +(require 'cursor-sensor) +(require 'format-spec) + +(eval-when-compile (require 'benchmark)) + +;; For `magit-section-get-relative-position' +(declare-function magit-hunk-section-p "magit-diff" (section) t) + +;;; Hooks + +(defvar magit-section-movement-hook nil + "Hook run by `magit-section-goto'. +That function in turn is used by all section movement commands.") + +(defvar magit-section-highlight-hook + '(magit-section-highlight + magit-section-highlight-selection) + "Functions used to highlight the current section. +Each function is run with the current section as only argument +until one of them returns non-nil.") + +(defvar magit-section-unhighlight-hook nil + "Functions used to unhighlight the previously current section. +Each function is run with the current section as only argument +until one of them returns non-nil. Most sections are properly +unhighlighted without requiring a specialized unhighlighter, +diff-related sections being the only exception.") + +(defvar magit-section-set-visibility-hook + '(magit-section-cached-visibility) + "Hook used to set the initial visibility of a section. +Stop at the first function that returns non-nil. The returned +value should be `show', `hide' or nil. If no function returns +non-nil, determine the visibility as usual, i.e., use the +hardcoded section specific default (see `magit-insert-section').") + +;;; Options + +(defgroup magit-section nil + "Expandable sections." + :link '(info-link "(magit)Sections") + :group 'extensions) + +(defcustom magit-section-show-child-count t + "Whether to append the number of children to section headings. +This only applies to sections for which doing so makes sense." + :package-version '(magit-section . "2.1.0") + :group 'magit-section + :type 'boolean) + +(defcustom magit-section-cache-visibility t + "Whether to cache visibility of sections. + +Sections always retain their visibility state when they are being +recreated during a refresh. But if a section disappears and then +later reappears again, then this option controls whether this is +the case. + +If t, then cache the visibility of all sections. If a list of +section types, then only do so for matching sections. If nil, +then don't do so for any sections." + :package-version '(magit-section . "2.12.0") + :group 'magit-section + :type '(choice (const :tag "Don't cache visibility" nil) + (const :tag "Cache visibility of all sections" t) + (repeat :tag "Cache visibility for section types" symbol))) + +(defcustom magit-section-initial-visibility-alist + '((stashes . hide)) + "Alist controlling the initial visibility of sections. + +Each element maps a section type or lineage to the initial +visibility state for such sections. The state has to be one of +`show' or `hide', or a function that returns one of these symbols. +A function is called with the section as the only argument. + +Use the command `magit-describe-section' to determine a section's +lineage or type. The vector in the output is the section lineage +and the type is the first element of that vector. Wildcards can +be used, see `magit-section-match'. + +Currently this option is only used to override hardcoded defaults, +but in the future it will also be used set the defaults. + +An entry whose key is `magit-status-initial-section' specifies +the visibility of the section `magit-status-goto-initial-section' +jumps to. This does not only override defaults, but also other +entries of this alist." + :package-version '(magit-section . "2.12.0") + :group 'magit-section + :type '(alist :key-type (sexp :tag "Section type/lineage") + :value-type (choice (const hide) + (const show) + function))) + +(defcustom magit-section-visibility-indicator + (if (window-system) + '(magit-fringe-bitmap> . magit-fringe-bitmapv) + (cons (if (char-displayable-p ?…) "…" "...") + t)) + "Whether and how to indicate that a section can be expanded/collapsed. + +If nil, then don't show any indicators. +Otherwise the value has to have one of these two forms: + +\(EXPANDABLE-BITMAP . COLLAPSIBLE-BITMAP) + + Both values have to be variables whose values are fringe + bitmaps. In this case every section that can be expanded or + collapsed gets an indicator in the left fringe. + + To provide extra padding around the indicator, set + `left-fringe-width' in `magit-mode-hook'. + +\(STRING . BOOLEAN) + + In this case STRING (usually an ellipsis) is shown at the end + of the heading of every collapsed section. Expanded sections + get no indicator. The cdr controls whether the appearance of + these ellipsis take section highlighting into account. Doing + so might potentially have an impact on performance, while not + doing so is kinda ugly." + :package-version '(magit-section . "3.0.0") + :group 'magit-section + :type '(choice (const :tag "No indicators" nil) + (cons :tag "Use +- fringe indicators" + (const magit-fringe-bitmap+) + (const magit-fringe-bitmap-)) + (cons :tag "Use >v fringe indicators" + (const magit-fringe-bitmap>) + (const magit-fringe-bitmapv)) + (cons :tag "Use bold >v fringe indicators)" + (const magit-fringe-bitmap-bold>) + (const magit-fringe-bitmap-boldv)) + (cons :tag "Use custom fringe indicators" + (variable :tag "Expandable bitmap variable") + (variable :tag "Collapsible bitmap variable")) + (cons :tag "Use ellipses at end of headings" + (string :tag "Ellipsis" "…") + (choice :tag "Use face kludge" + (const :tag "Yes (potentially slow)" t) + (const :tag "No (kinda ugly)" nil))))) + +(define-obsolete-variable-alias 'magit-keep-region-overlay + 'magit-section-keep-region-overlay "Magit-Section 4.0.0") + +(defcustom magit-section-keep-region-overlay nil + "Whether to keep the region overlay when there is a valid selection. + +By default Magit removes the regular region overlay if, and only +if, that region constitutes a valid selection as understood by +Magit commands. Otherwise it does not remove that overlay, and +the region looks like it would in other buffers. + +There are two types of such valid selections: hunk-internal +regions and regions that select two or more sibling sections. +In such cases Magit removes the region overlay and instead +highlights a slightly larger range. All text (for hunk-internal +regions) or the headings of all sections (for sibling selections) +that are inside that range (not just inside the region) are acted +on by commands such as the staging command. This buffer range +begins at the beginning of the line on which the region begins +and ends at the end of the line on which the region ends. + +Because Magit acts on this larger range and not the region, it is +actually quite important to visualize that larger range. If we +don't do that, then one might think that these commands act on +the region instead. If you want to *also* visualize the region, +then set this option to t. But please note that when the region +does *not* constitute a valid selection, then the region is +*always* visualized as usual, and that it is usually under such +circumstances that you want to use a non-magit command to act on +the region. + +Besides keeping the region overlay, setting this option to t also +causes all face properties, except for `:foreground', to be +ignored for the faces used to highlight headings of selected +sections. This avoids the worst conflicts that result from +displaying the region and the selection overlays at the same +time. We are not interested in dealing with other conflicts. +In fact we *already* provide a way to avoid all of these +conflicts: *not* changing the value of this option. + +It should be clear by now that we consider it a mistake to set +this to display the region when the Magit selection is also +visualized, but since it has been requested a few times and +because it doesn't cost much to offer this option we do so. +However that might change. If the existence of this option +starts complicating other things, then it will be removed." + :package-version '(magit-section . "2.3.0") + :group 'magit-section + :type 'boolean) + +(defcustom magit-section-disable-line-numbers t + "In Magit buffers, whether to disable modes that display line numbers. + +Some users who turn on `global-display-line-numbers-mode' (or +`global-nlinum-mode' or `global-linum-mode') expect line numbers +to be displayed everywhere except in Magit buffers. Other users +do not expect Magit buffers to be treated differently. At least +in theory users in the first group should not use the global mode, +but that ship has sailed, thus this option." + :package-version '(magit-section . "3.0.0") + :group 'magit-section + :type 'boolean) + +(defcustom magit-section-show-context-menu-for-emacs<28 nil + "Whether `mouse-3' shows a context menu for Emacs < 28. + +This has to be set before loading `magit-section' or it has +no effect. This also has no effect for Emacs >= 28, where +`context-menu-mode' should be enabled instead." + :package-version '(magit-section . "4.0.0") + :group 'magit-section + :type 'boolean) + +;;; Variables + +(defvar-local magit-section-preserve-visibility t) + +(defvar-local magit-section-pre-command-region-p nil) +(defvar-local magit-section-pre-command-section nil) +(defvar-local magit-section-highlight-force-update nil) +(defvar-local magit-section-highlight-overlays nil) +(defvar-local magit-section-highlighted-sections nil) +(defvar-local magit-section-unhighlight-sections nil) + +(defvar-local magit-section-inhibit-markers nil) +(defvar-local magit-section-insert-in-reverse nil) + +;;; Faces + +(defgroup magit-section-faces nil + "Faces used by Magit-Section." + :group 'magit-section + :group 'faces) + +(defface magit-section-highlight + `((((class color) (background light)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :background "grey95") + (((class color) (background dark)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :background "grey20")) + "Face for highlighting the current section." + :group 'magit-section-faces) + +(defface magit-section-heading + `((((class color) (background light)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "DarkGoldenrod4" + :weight bold) + (((class color) (background dark)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "LightGoldenrod2" + :weight bold)) + "Face for section headings." + :group 'magit-section-faces) + +(defface magit-section-secondary-heading + `((t ,@(and (>= emacs-major-version 27) '(:extend t)) + :weight bold)) + "Face for section headings of some secondary headings." + :group 'magit-section-faces) + +(defface magit-section-heading-selection + `((((class color) (background light)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "salmon4") + (((class color) (background dark)) + ,@(and (>= emacs-major-version 27) '(:extend t)) + :foreground "LightSalmon3")) + "Face for selected section headings." + :group 'magit-section-faces) + +(defface magit-section-child-count '((t nil)) + "Face used for child counts at the end of some section headings." + :group 'magit-section-faces) + +;;; Classes + +(defvar magit--current-section-hook nil + "Internal variable used for `magit-describe-section'.") + +(defvar magit--section-type-alist nil) + +(defclass magit-section () + ((type :initform nil :initarg :type) + (keymap :initform nil) + (value :initform nil) + (start :initform nil) + (content :initform nil) + (end :initform nil) + (hidden) + (washer :initform nil :initarg :washer) + (inserter :initform (symbol-value 'magit--current-section-hook)) + (heading-highlight-face :initform nil :initarg :heading-highlight-face) + (parent :initform nil) + (children :initform nil))) + +;;; Mode + +(defvar symbol-overlay-inhibit-map) + +(defvar-keymap magit-section-heading-map + :doc "Keymap used in the heading line of all expandable sections. +This keymap is used in addition to the section-specific keymap, +if any." + "<double-down-mouse-1>" #'ignore + "<double-mouse-1>" #'magit-mouse-toggle-section + "<double-mouse-2>" #'magit-mouse-toggle-section) + +(defvar magit-section-mode-map + (let ((map (make-keymap))) + (suppress-keymap map t) + (when (and magit-section-show-context-menu-for-emacs<28 + (< emacs-major-version 28)) + (keymap-set map "<mouse-3>" nil) + (keymap-set + map "<down-mouse-3>" + `( menu-item "" ,(make-sparse-keymap) + :filter ,(lambda (_) + (let ((menu (make-sparse-keymap))) + (if (fboundp 'context-menu-local) + (context-menu-local menu last-input-event) + (magit--context-menu-local menu last-input-event)) + (magit-section-context-menu menu last-input-event) + menu))))) + (keymap-set map "<left-fringe> <mouse-1>" #'magit-mouse-toggle-section) + (keymap-set map "<left-fringe> <mouse-2>" #'magit-mouse-toggle-section) + (keymap-set map "TAB" #'magit-section-toggle) + (keymap-set map "C-c TAB" #'magit-section-cycle) + (keymap-set map "C-<tab>" #'magit-section-cycle) + (keymap-set map "M-<tab>" #'magit-section-cycle) + ;; <backtab> is the most portable binding for Shift+Tab. + (keymap-set map "<backtab>" #'magit-section-cycle-global) + (keymap-set map "^" #'magit-section-up) + (keymap-set map "p" #'magit-section-backward) + (keymap-set map "n" #'magit-section-forward) + (keymap-set map "M-p" #'magit-section-backward-sibling) + (keymap-set map "M-n" #'magit-section-forward-sibling) + (keymap-set map "1" #'magit-section-show-level-1) + (keymap-set map "2" #'magit-section-show-level-2) + (keymap-set map "3" #'magit-section-show-level-3) + (keymap-set map "4" #'magit-section-show-level-4) + (keymap-set map "M-1" #'magit-section-show-level-1-all) + (keymap-set map "M-2" #'magit-section-show-level-2-all) + (keymap-set map "M-3" #'magit-section-show-level-3-all) + (keymap-set map "M-4" #'magit-section-show-level-4-all) + map) + "Parent keymap for all keymaps of modes derived from `magit-section-mode'.") + +(define-derived-mode magit-section-mode special-mode "Magit-Sections" + "Parent major mode from which major modes with Magit-like sections inherit. + +Magit-Section is documented in info node `(magit-section)'." + :group 'magit-section + (buffer-disable-undo) + (setq truncate-lines t) + (setq buffer-read-only t) + (setq-local line-move-visual t) ; see #1771 + ;; Turn off syntactic font locking, but not by setting + ;; `font-lock-defaults' because that would enable font locking, and + ;; not all magit plugins may be ready for that (see #3950). + (setq-local font-lock-syntactic-face-function #'ignore) + (setq show-trailing-whitespace nil) + (setq-local symbol-overlay-inhibit-map t) + (setq list-buffers-directory (abbreviate-file-name default-directory)) + ;; (hack-dir-local-variables-non-file-buffer) + (make-local-variable 'text-property-default-nonsticky) + (push (cons 'keymap t) text-property-default-nonsticky) + (add-hook 'pre-command-hook #'magit-section-pre-command-hook nil t) + (add-hook 'post-command-hook #'magit-section-post-command-hook t t) + (add-hook 'deactivate-mark-hook #'magit-section-deactivate-mark t t) + (setq-local redisplay-highlight-region-function + #'magit-section--highlight-region) + (setq-local redisplay-unhighlight-region-function + #'magit-section--unhighlight-region) + (add-function :filter-return (local 'filter-buffer-substring-function) + #'magit-section--remove-text-properties) + (when (fboundp 'magit-section-context-menu) + (add-hook 'context-menu-functions #'magit-section-context-menu 10 t)) + (when magit-section-disable-line-numbers + (when (and (fboundp 'linum-mode) + (bound-and-true-p global-linum-mode)) + (linum-mode -1)) + (when (and (fboundp 'nlinum-mode) + (bound-and-true-p global-nlinum-mode)) + (nlinum-mode -1)) + (when (and (fboundp 'display-line-numbers-mode) + (bound-and-true-p global-display-line-numbers-mode)) + (display-line-numbers-mode -1))) + (when (fboundp 'magit-preserve-section-visibility-cache) + (add-hook 'kill-buffer-hook #'magit-preserve-section-visibility-cache))) + +(defun magit-section--remove-text-properties (string) + "Remove all text-properties from STRING. +Most importantly `magit-section'." + (set-text-properties 0 (length string) nil string) + string) + +;;; Core + +(defvar-local magit-root-section nil + "The root section in the current buffer. +All other sections are descendants of this section. The value +of this variable is set by `magit-insert-section' and you should +never modify it.") +(put 'magit-root-section 'permanent-local t) + +(defvar-local magit--context-menu-section nil "For internal use only.") + +(defvar magit--context-menu-buffer nil "For internal use only.") + +(defun magit-point () + "Return point or the position where the context menu was invoked. +When using the context menu, return the position the user clicked +on, provided the current buffer is the buffer in which the click +occurred. Otherwise return the same value as `point'." + (if magit--context-menu-section + (magit-menu-position) + (point))) + +(defun magit-thing-at-point (thing &optional no-properties) + "Return the THING at point or where the context menu was invoked. +When using the context menu, return the thing the user clicked +on, provided the current buffer is the buffer in which the click +occurred. Otherwise return the same value as `thing-at-point'. +For the meaning of THING and NO-PROPERTIES see that function." + (if-let ((pos (magit-menu-position))) + (save-excursion + (goto-char pos) + (thing-at-point thing no-properties)) + (thing-at-point thing no-properties))) + +(defun magit-current-section () + "Return the section at point or where the context menu was invoked. +When using the context menu, return the section that the user +clicked on, provided the current buffer is the buffer in which +the click occurred. Otherwise return the section at point." + (or magit--context-menu-section + (magit-section-at) + magit-root-section)) + +(defun magit-section-at (&optional position) + "Return the section at POSITION, defaulting to point." + (get-text-property (or position (point)) 'magit-section)) + +(defun magit-section-ident (section) + "Return an unique identifier for SECTION. +The return value has the form ((TYPE . VALUE)...)." + (cons (cons (oref section type) + (magit-section-ident-value section)) + (and-let* ((parent (oref section parent))) + (magit-section-ident parent)))) + +(cl-defgeneric magit-section-ident-value (object) + "Return OBJECT's value, making it constant and unique if necessary. + +This is used to correlate different incarnations of the same +section, see `magit-section-ident' and `magit-get-section'. + +Sections whose values that are not constant and/or unique should +implement a method that return a value that can be used for this +purpose.") + +(cl-defmethod magit-section-ident-value ((section magit-section)) + "Return the value unless it is an object. + +Different object incarnations representing the same value tend to not be +equal, so call this generic function on the object itself to determine a +constant value." + (let ((value (oref section value))) + (if (eieio-object-p value) + (magit-section-ident-value value) + value))) + +(cl-defmethod magit-section-ident-value ((object eieio-default-superclass)) + "Simply return the object itself. That likely isn't +good enough, so you need to implement your own method." + object) + +(defun magit-get-section (ident &optional root) + "Return the section identified by IDENT. +IDENT has to be a list as returned by `magit-section-ident'. +If optional ROOT is non-nil, then search in that section tree +instead of in the one whose root `magit-root-section' is." + (setq ident (reverse ident)) + (let ((section (or root magit-root-section))) + (when (eq (car (pop ident)) + (oref section type)) + (while (and ident + (pcase-let ((`(,type . ,value) (car ident))) + (setq section + (cl-find-if + (lambda (section) + (and (eq (oref section type) type) + (equal (magit-section-ident-value section) + value))) + (oref section children))))) + (pop ident)) + section))) + +(defun magit-section-lineage (section &optional raw) + "Return the lineage of SECTION. +If optional RAW is non-nil, return a list of section objects, beginning +with SECTION, otherwise return a list of section types." + (cons (if raw section (oref section type)) + (and-let* ((parent (oref section parent))) + (magit-section-lineage parent raw)))) + +(defvar magit-insert-section--current nil "For internal use only.") +(defvar magit-insert-section--parent nil "For internal use only.") +(defvar magit-insert-section--oldroot nil "For internal use only.") + +;;; Menu + +(defvar magit-menu-common-value nil "See function `magit-menu-common-value'.") +(defvar magit-menu--desc-values nil "For internal use only.") + +(defun magit-section-context-menu (menu click) + "Populate MENU with Magit-Section commands at CLICK." + (when-let ((section (save-excursion + (unless (region-active-p) + (mouse-set-point click)) + (magit-section-at)))) + (unless (region-active-p) + (setq magit--context-menu-buffer (current-buffer)) + (if-let ((alt (save-excursion + (mouse-set-point click) + (run-hook-with-args-until-success + 'magit-menu-alternative-section-hook section)))) + (setq magit--context-menu-section (setq section alt)) + (setq magit--context-menu-section section) + (magit-section-update-highlight t))) + (when (magit-section-content-p section) + (keymap-set-after menu "<magit-section-toggle>" + `(menu-item + ,(if (oref section hidden) "Expand section" "Collapse section") + magit-section-toggle)) + (unless (oref section hidden) + (when-let ((children (oref section children))) + (when (seq-some #'magit-section-content-p children) + (when (seq-some (lambda (c) (oref c hidden)) children) + (keymap-set-after menu "<magit-section-show-children>" + `(menu-item "Expand children" + magit-section-show-children))) + (when (seq-some (lambda (c) (not (oref c hidden))) children) + (keymap-set-after menu "<magit-section-hide-children>" + `(menu-item "Collapse children" + magit-section-hide-children)))))) + (keymap-set-after menu "<separator-magit-1>" menu-bar-separator)) + (keymap-set-after menu "<magit-describe-section>" + `(menu-item "Describe section" magit-describe-section)) + (when-let ((map (oref section keymap))) + (keymap-set-after menu "<separator-magit-2>" menu-bar-separator) + (when (symbolp map) + (setq map (symbol-value map))) + (setq magit-menu-common-value (magit-menu-common-value section)) + (setq magit-menu--desc-values (magit-menu--desc-values section)) + (map-keymap (lambda (key binding) + (when (consp binding) + (define-key-after menu (vector key) + (copy-sequence binding)))) + (if (fboundp 'menu-bar-keymap) + (menu-bar-keymap map) + (magit--menu-bar-keymap map))))) + menu) + +(defun magit-menu-item (desc def &optional props) + "Return a menu item named DESC binding DEF and using PROPS. + +If DESC contains a supported %-spec, substitute the +expression (magit-menu-format-desc DESC) for that. +See `magit-menu-format-desc'." + `(menu-item + ,(if (and (stringp desc) (string-match-p "%[tTvsmMx]" desc)) + (list 'magit-menu-format-desc desc) + desc) + ,def + ;; Without this, the keys for point would be shown instead + ;; of the relevant ones from where the click occurred. + :keys ,(apply-partially #'magit--menu-position-keys def) + ,@props)) + +(defun magit--menu-position-keys (def) + (or (ignore-errors + (save-excursion + (goto-char (magit-menu-position)) + (and-let* ((key (cl-find-if-not + (lambda (key) + (string-match-p "\\`<[0-9]+>\\'" + (key-description key))) + (where-is-internal def)))) + (key-description key)))) + "")) + +(defun magit-menu-position () + "Return the position where the context-menu was invoked. +If the current command wasn't invoked using the context-menu, +then return nil." + (and magit--context-menu-section + (ignore-errors + (posn-point (event-start (aref (this-command-keys-vector) 0)))))) + +(defun magit-menu-highlight-point-section () + (setq magit-section-highlight-force-update t) + (if (eq (current-buffer) magit--context-menu-buffer) + (setq magit--context-menu-section nil) + (if-let ((window (get-buffer-window magit--context-menu-buffer))) + (with-selected-window window + (setq magit--context-menu-section nil) + (magit-section-update-highlight)) + (with-current-buffer magit--context-menu-buffer + (setq magit--context-menu-section nil)))) + (setq magit--context-menu-buffer nil)) + +(defvar magit--plural-append-es '(branch)) + +(cl-defgeneric magit-menu-common-value (_section) + "Return some value to be used by multiple menu items. +This function is called by `magit-section-context-menu', which +stores the value in `magit-menu-common-value'. Individual menu +items can use it, e.g., in the expression used to set their +description." + nil) + +(defun magit-menu--desc-values (section) + (let ((type (oref section type)) + (value (oref section value)) + (multiple (magit-region-sections nil t))) + (list type + value + (format "%s %s" type value) + (and multiple (length multiple)) + (if (memq type magit--plural-append-es) "es" "s")))) + +(defun magit-menu-format-desc (format) + "Format a string based on FORMAT and menu section or selection. +The following %-specs are allowed: +%t means \"TYPE\". +%T means \"TYPE\", or \"TYPEs\" if multiple sections are selected. +%v means \"VALUE\". +%s means \"TYPE VALUE\". +%m means \"TYPE VALUE\", or \"COUNT TYPEs\" if multiple sections + are selected. +%M means \"VALUE\", or \"COUNT TYPEs\" if multiple sections are + selected. +%x means the value of `magit-menu-common-value'." + (pcase-let* ((`(,type ,value ,single ,count ,suffix) magit-menu--desc-values) + (multiple (and count (format "%s %s%s" count type suffix)))) + (format-spec format + `((?t . ,type) + (?T . ,(format "%s%s" type (if count suffix ""))) + (?v . ,value) + (?s . ,single) + (?m . ,(or multiple single)) + (?M . ,(or multiple value)) + (?x . ,(format "%s" magit-menu-common-value)))))) + +(defun magit--menu-bar-keymap (keymap) + "Backport of `menu-bar-keymap' for Emacs < 28. +Slight trimmed down." + (let ((menu-bar nil)) + (map-keymap (lambda (key binding) + (push (cons key binding) menu-bar)) + keymap) + (cons 'keymap (nreverse menu-bar)))) + +(defun magit--context-menu-local (menu _click) + "Backport of `context-menu-local' for Emacs < 28." + (run-hooks 'activate-menubar-hook 'menu-bar-update-hook) + (keymap-set-after menu "<separator-local>" menu-bar-separator) + (let ((keymap (local-key-binding [menu-bar]))) + (when keymap + (map-keymap (lambda (key binding) + (when (consp binding) + (define-key-after menu (vector key) + (copy-sequence binding)))) + (magit--menu-bar-keymap keymap)))) + menu) + +(define-advice context-menu-region (:around (fn menu click) magit-section-mode) + "Disable in `magit-section-mode' buffers." + (if (derived-mode-p 'magit-section-mode) + menu + (funcall fn menu click))) + +;;; Commands +;;;; Movement + +(defun magit-section-forward () + "Move to the beginning of the next visible section." + (interactive) + (if (eobp) + (user-error "No next section") + (let ((section (magit-current-section))) + (if (oref section parent) + (let ((next (and (not (oref section hidden)) + (not (= (oref section end) + (1+ (point)))) + (car (oref section children))))) + (while (and section (not next)) + (unless (setq next (car (magit-section-siblings section 'next))) + (setq section (oref section parent)))) + (if next + (magit-section-goto next) + (user-error "No next section"))) + (magit-section-goto 1))))) + +(defun magit-section-backward () + "Move to the beginning of the current or the previous visible section. +When point is at the beginning of a section then move to the +beginning of the previous visible section. Otherwise move to +the beginning of the current section." + (interactive) + (if (bobp) + (user-error "No previous section") + (let ((section (magit-current-section)) children) + (cond + ((and (= (point) + (1- (oref section end))) + (setq children (oref section children))) + (magit-section-goto (car (last children)))) + ((and (oref section parent) + (not (= (point) + (oref section start)))) + (magit-section-goto section)) + (t + (let ((prev (car (magit-section-siblings section 'prev)))) + (if prev + (while (and (not (oref prev hidden)) + (setq children (oref prev children))) + (setq prev (car (last children)))) + (setq prev (oref section parent))) + (cond (prev + (magit-section-goto prev)) + ((oref section parent) + (user-error "No previous section")) + ;; Eob special cases. + ((not (get-text-property (1- (point)) 'invisible)) + (magit-section-goto -1)) + (t + (goto-char (previous-single-property-change + (1- (point)) 'invisible)) + (forward-line -1) + (magit-section-goto (magit-current-section)))))))))) + +(defun magit-section-up () + "Move to the beginning of the parent section." + (interactive) + (if-let ((parent (oref (magit-current-section) parent))) + (magit-section-goto parent) + (user-error "No parent section"))) + +(defun magit-section-forward-sibling () + "Move to the beginning of the next sibling section. +If there is no next sibling section, then move to the parent." + (interactive) + (let ((current (magit-current-section))) + (if (oref current parent) + (if-let ((next (car (magit-section-siblings current 'next)))) + (magit-section-goto next) + (magit-section-forward)) + (magit-section-goto 1)))) + +(defun magit-section-backward-sibling () + "Move to the beginning of the previous sibling section. +If there is no previous sibling section, then move to the parent." + (interactive) + (let ((current (magit-current-section))) + (if (oref current parent) + (if-let ((previous (car (magit-section-siblings current 'prev)))) + (magit-section-goto previous) + (magit-section-backward)) + (magit-section-goto -1)))) + +(defun magit-section-goto (arg) + (if (integerp arg) + (progn (forward-line arg) + (setq arg (magit-current-section))) + (goto-char (oref arg start))) + (run-hook-with-args 'magit-section-movement-hook arg)) + +(defun magit-section-set-window-start (section) + "Ensure the beginning of SECTION is visible." + (unless (pos-visible-in-window-p (oref section end)) + (set-window-start (selected-window) (oref section start)))) + +(defmacro magit-define-section-jumper + (name heading type &optional value inserter &rest properties) + "Define an interactive function to go some section. +Together TYPE and VALUE identify the section. +HEADING is the displayed heading of the section." + (declare (indent defun)) + `(transient-define-suffix ,name (&optional expand) + ,(format "Jump to the section \"%s\". +With a prefix argument also expand it." heading) + ,@properties + ,@(and (not (plist-member properties :description)) + (list :description heading)) + ,@(and inserter + `(:if (lambda () (memq ',inserter + (bound-and-true-p magit-status-sections-hook))))) + :inapt-if-not (lambda () (magit-get-section + (cons (cons ',type ,value) + (magit-section-ident magit-root-section)))) + (interactive "P") + (if-let ((section (magit-get-section + (cons (cons ',type ,value) + (magit-section-ident magit-root-section))))) + (progn (goto-char (oref section start)) + (when expand + (with-local-quit (magit-section-show section)) + (recenter 0))) + (message ,(format "Section \"%s\" wasn't found" heading))))) + +;;;; Visibility + +(defun magit-section-show (section) + "Show the body of the current section." + (interactive (list (magit-current-section))) + (oset section hidden nil) + (magit-section--maybe-wash section) + (when-let ((beg (oref section content))) + (remove-overlays beg (oref section end) 'invisible t)) + (magit-section-maybe-update-visibility-indicator section) + (magit-section-maybe-cache-visibility section) + (dolist (child (oref section children)) + (if (oref child hidden) + (magit-section-hide child) + (magit-section-show child)))) + +(defun magit-section--maybe-wash (section) + (when-let ((washer (oref section washer))) + (oset section washer nil) + (let ((inhibit-read-only t) + (magit-insert-section--parent section) + (magit-insert-section--current section) + (content (oref section content))) + (save-excursion + (if (and content (< content (oref section end))) + (funcall washer section) ; already partially washed (hunk) + (goto-char (oref section end)) + (oset section content (point-marker)) + (funcall washer) + (oset section end (point-marker))))) + (setq magit-section-highlight-force-update t))) + +(defun magit-section-hide (section) + "Hide the body of the current section." + (interactive (list (magit-current-section))) + (if (eq section magit-root-section) + (user-error "Cannot hide root section") + (oset section hidden t) + (when-let ((beg (oref section content))) + (let ((end (oref section end))) + (when (< beg (point) end) + (goto-char (oref section start))) + (remove-overlays beg end 'invisible t) + (let ((o (make-overlay beg end))) + (overlay-put o 'evaporate t) + (overlay-put o 'invisible t) + (overlay-put o 'cursor-intangible t)))) + (magit-section-maybe-update-visibility-indicator section) + (magit-section-maybe-cache-visibility section))) + +(defun magit-section-toggle (section) + "Toggle visibility of the body of the current section." + (interactive (list (magit-current-section))) + (cond ((eq section magit-root-section) + (user-error "Cannot hide root section")) + ((oref section hidden) + (magit-section-show section)) + ((magit-section-hide section)))) + +(defun magit-section-toggle-children (section) + "Toggle visibility of bodies of children of the current section." + (interactive (list (magit-current-section))) + (let* ((children (oref section children)) + (show (--any-p (oref it hidden) children))) + (dolist (c children) + (oset c hidden show))) + (magit-section-show section)) + +(defun magit-section-show-children (section &optional depth) + "Recursively show the bodies of children of the current section. +With a prefix argument show children that deep and hide deeper +children." + (interactive (list (magit-current-section))) + (magit-section-show-children-1 section depth) + (magit-section-show section)) + +(defun magit-section-show-children-1 (section &optional depth) + (dolist (child (oref section children)) + (oset child hidden nil) + (if depth + (if (> depth 0) + (magit-section-show-children-1 child (1- depth)) + (magit-section-hide child)) + (magit-section-show-children-1 child)))) + +(defun magit-section-hide-children (section) + "Recursively hide the bodies of children of the current section." + (interactive (list (magit-current-section))) + (mapc #'magit-section-hide (oref section children))) + +(defun magit-section-show-headings (section) + "Recursively show headings of children of the current section. +Only show the headings, previously shown text-only bodies are +hidden." + (interactive (list (magit-current-section))) + (magit-section-show-headings-1 section) + (magit-section-show section)) + +(defun magit-section-show-headings-1 (section) + (dolist (child (oref section children)) + (oset child hidden nil) + (when (or (oref child children) + (not (oref child content))) + (magit-section-show-headings-1 child)))) + +(defun magit-section-cycle (section) + "Cycle visibility of current section and its children. + +If this command is invoked using \\`C-<tab>' and that is globally bound +to `tab-next', then this command pivots to behave like that command, and +you must instead use \\`C-c TAB' to cycle section visibility. + +If you would like to keep using \\`C-<tab>' to cycle section visibility +but also want to use `tab-bar-mode', then you have to prevent that mode +from using this key and instead bind another key to `tab-next'. Because +`tab-bar-mode' does not use a mode map but instead manipulates the +global map, this involves advising `tab-bar--define-keys'." + (interactive (list (magit-current-section))) + (cond + ((and (equal (this-command-keys) [C-tab]) + (eq (global-key-binding [C-tab]) 'tab-next) + (fboundp 'tab-bar-switch-to-next-tab)) + (tab-bar-switch-to-next-tab current-prefix-arg)) + ((oref section hidden) + (magit-section-show section) + (magit-section-hide-children section)) + ((let ((children (oref section children))) + (cond ((and (--any-p (oref it hidden) children) + (--any-p (oref it children) children)) + (magit-section-show-headings section)) + ((seq-some #'magit-section-hidden-body children) + (magit-section-show-children section)) + ((magit-section-hide section))))))) + +(defun magit-section-cycle-global () + "Cycle visibility of all sections in the current buffer." + (interactive) + (let ((children (oref magit-root-section children))) + (cond ((and (--any-p (oref it hidden) children) + (--any-p (oref it children) children)) + (magit-section-show-headings magit-root-section)) + ((seq-some #'magit-section-hidden-body children) + (magit-section-show-children magit-root-section)) + (t + (mapc #'magit-section-hide children))))) + +(defun magit-section-hidden-body (section &optional pred) + (if-let ((children (oref section children))) + (funcall (or pred #'-any-p) #'magit-section-hidden-body children) + (and (oref section content) + (oref section hidden)))) + +(defun magit-section-content-p (section) + "Return non-nil if SECTION has content or an unused washer function." + (with-slots (content end washer) section + (and content (or (not (= content end)) washer)))) + +(defun magit-section-invisible-p (section) + "Return t if the SECTION's body is invisible. +When the body of an ancestor of SECTION is collapsed then +SECTION's body (and heading) obviously cannot be visible." + (or (oref section hidden) + (and-let* ((parent (oref section parent))) + (magit-section-invisible-p parent)))) + +(defun magit-section-show-level (level) + "Show surrounding sections up to LEVEL. +If LEVEL is negative, show up to the absolute value. +Sections at higher levels are hidden." + (if (< level 0) + (let ((s (magit-current-section))) + (setq level (- level)) + (while (> (1- (length (magit-section-ident s))) level) + (setq s (oref s parent)) + (goto-char (oref s start))) + (magit-section-show-children magit-root-section (1- level))) + (cl-do* ((s (magit-current-section) + (oref s parent)) + (i (1- (length (magit-section-ident s))) + (cl-decf i))) + ((cond ((< i level) (magit-section-show-children s (- level i 1)) t) + ((= i level) (magit-section-hide s) t)) + (magit-section-goto s))))) + +(defun magit-section-show-level-1 () + "Show surrounding sections on first level." + (interactive) + (magit-section-show-level 1)) + +(defun magit-section-show-level-1-all () + "Show all sections on first level." + (interactive) + (magit-section-show-level -1)) + +(defun magit-section-show-level-2 () + "Show surrounding sections up to second level." + (interactive) + (magit-section-show-level 2)) + +(defun magit-section-show-level-2-all () + "Show all sections up to second level." + (interactive) + (magit-section-show-level -2)) + +(defun magit-section-show-level-3 () + "Show surrounding sections up to third level." + (interactive) + (magit-section-show-level 3)) + +(defun magit-section-show-level-3-all () + "Show all sections up to third level." + (interactive) + (magit-section-show-level -3)) + +(defun magit-section-show-level-4 () + "Show surrounding sections up to fourth level." + (interactive) + (magit-section-show-level 4)) + +(defun magit-section-show-level-4-all () + "Show all sections up to fourth level." + (interactive) + (magit-section-show-level -4)) + +(defun magit-mouse-toggle-section (event) + "Toggle visibility of the clicked section. +Clicks outside either the section heading or the left fringe are +silently ignored." + (interactive "e") + (let* ((pos (event-start event)) + (section (magit-section-at (posn-point pos)))) + (if (eq (posn-area pos) 'left-fringe) + (when section + (while (not (magit-section-content-p section)) + (setq section (oref section parent))) + (unless (eq section magit-root-section) + (goto-char (oref section start)) + (magit-section-toggle section))) + (magit-section-toggle section)))) + +;;;; Auxiliary + +(defun magit-describe-section-briefly (section &optional ident interactive) + "Show information about the section at point. +With a prefix argument show the section identity instead of the +section lineage. This command is intended for debugging purposes. +\n(fn SECTION &optional IDENT)" + (interactive (list (magit-current-section) current-prefix-arg t)) + (let ((str (format "#<%s %S %S %s-%s%s>" + (eieio-object-class section) + (let ((val (oref section value))) + (cond ((stringp val) + (substring-no-properties val)) + ((and (eieio-object-p val) + (fboundp 'cl-prin1-to-string)) + (cl-prin1-to-string val)) + (t + val))) + (if ident + (magit-section-ident section) + (apply #'vector (magit-section-lineage section))) + (and-let* ((m (oref section start))) + (if (markerp m) (marker-position m) m)) + (if-let ((m (oref section content))) + (format "[%s-]" + (if (markerp m) (marker-position m) m)) + "") + (and-let* ((m (oref section end))) + (if (markerp m) (marker-position m) m))))) + (when interactive + (message "%s" str)) + str)) + +(cl-defmethod cl-print-object ((section magit-section) stream) + "Print `magit-describe-section' result of SECTION." + ;; Used by debug and edebug as of Emacs 26. + (princ (magit-describe-section-briefly section) stream)) + +(defun magit-describe-section (section &optional interactive-p) + "Show information about the section at point." + (interactive (list (magit-current-section) t)) + (let ((inserter-section section)) + (while (and inserter-section (not (oref inserter-section inserter))) + (setq inserter-section (oref inserter-section parent))) + (when (and inserter-section (oref inserter-section inserter)) + (setq section inserter-section))) + (pcase (oref section inserter) + (`((,hook ,fun) . ,src-src) + (help-setup-xref `(magit-describe-section ,section) interactive-p) + (with-help-window (help-buffer) + (with-current-buffer standard-output + (insert (format-message + "%s\n is inserted by `%s'\n from `%s'" + (magit-describe-section-briefly section) + (make-text-button (symbol-name fun) nil + :type 'help-function + 'help-args (list fun)) + (make-text-button (symbol-name hook) nil + :type 'help-variable + 'help-args (list hook)))) + (pcase-dolist (`(,hook ,fun) src-src) + (insert (format-message + ",\n called by `%s'\n from `%s'" + (make-text-button (symbol-name fun) nil + :type 'help-function + 'help-args (list fun)) + (make-text-button (symbol-name hook) nil + :type 'help-variable + 'help-args (list hook))))) + (insert ".\n\n") + (insert + (format-message + "`%s' is " + (make-text-button (symbol-name fun) nil + :type 'help-function 'help-args (list fun)))) + (describe-function-1 fun)))) + (_ (message "%s, inserter unknown" + (magit-describe-section-briefly section))))) + +;;; Match + +(cl-defun magit-section-match + (condition &optional (section (magit-current-section))) + "Return t if SECTION matches CONDITION. + +SECTION defaults to the section at point. If SECTION is not +specified and there also is no section at point, then return +nil. + +CONDITION can take the following forms: + (CONDITION...) matches if any of the CONDITIONs matches. + [CLASS...] matches if the section's class is the same + as the first CLASS or a subclass of that; + the section's parent class matches the + second CLASS; and so on. + [* CLASS...] matches sections that match [CLASS...] and + also recursively all their child sections. + CLASS matches if the section's class is the same + as CLASS or a subclass of that; regardless + of the classes of the parent sections. + +Each CLASS should be a class symbol, identifying a class that +derives from `magit-section'. For backward compatibility CLASS +can also be a \"type symbol\". A section matches such a symbol +if the value of its `type' slot is `eq'. If a type symbol has +an entry in `magit--section-type-alist', then a section also +matches that type if its class is a subclass of the class that +corresponds to the type as per that alist. + +Note that it is not necessary to specify the complete section +lineage as printed by `magit-describe-section-briefly', unless +of course you want to be that precise." + (and section (magit-section-match-1 condition section))) + +(defun magit-section-match-1 (condition section) + (cl-assert condition) + (and section + (if (listp condition) + (--first (magit-section-match-1 it section) condition) + (magit-section-match-2 (if (symbolp condition) + (list condition) + (cl-coerce condition 'list)) + section)))) + +(defun magit-section-match-2 (condition section) + (if (eq (car condition) '*) + (or (magit-section-match-2 (cdr condition) section) + (and-let* ((parent (oref section parent))) + (magit-section-match-2 condition parent))) + (and (let ((c (car condition))) + (if (class-p c) + (cl-typep section c) + (if-let ((class (cdr (assq c magit--section-type-alist)))) + (cl-typep section class) + (eq (oref section type) c)))) + (or (not (setq condition (cdr condition))) + (and-let* ((parent (oref section parent))) + (magit-section-match-2 condition parent)))))) + +(defun magit-section-value-if (condition &optional section) + "If the section at point matches CONDITION, then return its value. + +If optional SECTION is non-nil then test whether that matches +instead. If there is no section at point and SECTION is nil, +then return nil. If the section does not match, then return +nil. + +See `magit-section-match' for the forms CONDITION can take." + (and-let* ((section (or section (magit-current-section)))) + (and (magit-section-match condition section) + (oref section value)))) + +(defmacro magit-section-case (&rest clauses) + "Choose among clauses on the type of the section at point. + +Each clause looks like (CONDITION BODY...). The type of the +section is compared against each CONDITION; the BODY forms of the +first match are evaluated sequentially and the value of the last +form is returned. Inside BODY the symbol `it' is bound to the +section at point. If no clause succeeds or if there is no +section at point, return nil. + +See `magit-section-match' for the forms CONDITION can take. +Additionally a CONDITION of t is allowed in the final clause, and +matches if no other CONDITION match, even if there is no section +at point." + (declare (indent 0) + (debug (&rest (sexp body)))) + `(let* ((it (magit-current-section))) + (cond ,@(mapcar (lambda (clause) + `(,(or (eq (car clause) t) + `(and it + (magit-section-match-1 ',(car clause) it))) + ,@(cdr clause))) + clauses)))) + +(defun magit-section-match-assoc (section alist) + "Return the value associated with SECTION's type or lineage in ALIST." + (seq-some (pcase-lambda (`(,key . ,val)) + (and (magit-section-match-1 key section) val)) + alist)) + +;;; Create + +(defvar magit-insert-section-hook nil + "Hook run after `magit-insert-section's BODY. +Avoid using this hook and only ever do so if you know +what you are doing and are sure there is no other way.") + +(defmacro magit-insert-section (&rest args) + "Insert a section at point. + +Create a section object of type CLASS, storing VALUE in its +`value' slot, and insert the section at point. CLASS is a +subclass of `magit-section' or has the form `(eval FORM)', in +which case FORM is evaluated at runtime and should return a +subclass. In other places a sections class is often referred +to as its \"type\". + +Many commands behave differently depending on the class of the +current section and sections of a certain class can have their +own keymap, which is specified using the `keymap' class slot. +The value of that slot should be a variable whose value is a +keymap. + +For historic reasons Magit and Forge in most cases use symbols +as CLASS that don't actually identify a class and that lack the +appropriate package prefix. This works due to some undocumented +kludges, which are not available to other packages. + +When optional HIDE is non-nil collapse the section body by +default, i.e., when first creating the section, but not when +refreshing the buffer. Else expand it by default. This can be +overwritten using `magit-section-set-visibility-hook'. When a +section is recreated during a refresh, then the visibility of +predecessor is inherited and HIDE is ignored (but the hook is +still honored). + +BODY is any number of forms that actually insert the section's +heading and body. Optional NAME, if specified, has to be a +symbol, which is then bound to the object of the section being +inserted. + +Before BODY is evaluated the `start' of the section object is set +to the value of `point' and after BODY was evaluated its `end' is +set to the new value of `point'; BODY is responsible for moving +`point' forward. + +If it turns out inside BODY that the section is empty, then +`magit-cancel-section' can be used to abort and remove all traces +of the partially inserted section. This can happen when creating +a section by washing Git's output and Git didn't actually output +anything this time around. + +\(fn [NAME] (CLASS &optional VALUE HIDE) &rest BODY)" + (declare (indent 1) + (debug ([&optional symbolp] + (&or [("eval" form) &optional form form &rest form] + [symbolp &optional form form &rest form]) + body))) + (pcase-let* ((bind (and (symbolp (car args)) + (pop args))) + (`((,class ,value ,hide . ,args) . ,body) args) + (obj (cl-gensym "section"))) + `(let* ((,obj (magit-insert-section--create + ,(if (eq (car-safe class) 'eval) (cadr class) `',class) + ,value ,hide ,@args)) + (magit-insert-section--current ,obj) + (magit-insert-section--oldroot + (or magit-insert-section--oldroot + (and (not magit-insert-section--parent) + (prog1 magit-root-section + (setq magit-root-section ,obj))))) + (magit-insert-section--parent ,obj)) + (catch 'cancel-section + ,@(if bind `((let ((,bind ,obj)) ,@body)) body) + (magit-insert-section--finish ,obj)) + ,obj))) + +(defun magit-insert-section--create (class value hide &rest args) + (let (type) + (if (class-p class) + (setq type (or (car (rassq class magit--section-type-alist)) + class)) + (setq type class) + (setq class (or (cdr (assq class magit--section-type-alist)) + 'magit-section))) + (let ((obj (apply class :type type args))) + (oset obj value value) + (oset obj parent magit-insert-section--parent) + (oset obj start (if magit-section-inhibit-markers (point) (point-marker))) + (unless (slot-boundp obj 'hidden) + (oset obj hidden + (let (set old) + (cond + ((setq set (run-hook-with-args-until-success + 'magit-section-set-visibility-hook obj)) + (eq set 'hide)) + ((setq old (and (not magit-section-preserve-visibility) + magit-insert-section--oldroot + (magit-get-section + (magit-section-ident obj) + magit-insert-section--oldroot))) + (oref old hidden)) + ((setq set (magit-section-match-assoc + obj magit-section-initial-visibility-alist)) + (eq (if (functionp set) (funcall set obj) set) 'hide)) + (hide))))) + (unless (oref obj keymap) + (let ((type (oref obj type))) + (oset obj keymap + (or (let ((sym (intern (format "magit-%s-section-map" type)))) + (and (boundp sym) sym)) + (let ((sym (intern (format "forge-%s-section-map" type)))) + (and (boundp sym) sym)))))) + obj))) + +(defun magit-insert-section--finish (obj) + (run-hooks 'magit-insert-section-hook) + (let ((beg (oref obj start)) + (end (oset obj end + (if magit-section-inhibit-markers + (point) + (point-marker)))) + (props `( magit-section ,obj + ,@(and-let* ((map (symbol-value (oref obj keymap)))) + (list 'keymap map))))) + (unless magit-section-inhibit-markers + (set-marker-insertion-type beg t)) + (cond ((eq obj magit-root-section)) + ((oref obj children) + (magit-insert-child-count obj) + (magit-section-maybe-add-heading-map obj) + (save-excursion + (goto-char beg) + (while (< (point) end) + (let ((next (or (next-single-property-change + (point) 'magit-section) + end))) + (unless (magit-section-at) + (add-text-properties (point) next props)) + (goto-char next))))) + ((add-text-properties beg end props))) + (cond ((eq obj magit-root-section) + (when (eq magit-section-inhibit-markers 'delay) + (setq magit-section-inhibit-markers nil) + (magit-map-sections + (lambda (section) + (oset section start (copy-marker (oref section start) t)) + (oset section end (copy-marker (oref section end) t))))) + (let ((magit-section-cache-visibility nil)) + (magit-section-show obj))) + (magit-section-insert-in-reverse + (push obj (oref (oref obj parent) children))) + ((let ((parent (oref obj parent))) + (oset parent children + (nconc (oref parent children) + (list obj)))))) + (when magit-section-insert-in-reverse + (oset obj children (nreverse (oref obj children)))))) + +(defun magit-cancel-section (&optional if-empty) + "Cancel inserting the section that is currently being inserted. + +Canceling returns from the inner most use of `magit-insert-section' and +removes all text that was inserted by that. + +If optional IF-EMPTY is non-nil, then only cancel the section, if it is +empty. If a section is split into a heading and a body (i.e., when its +`content' slot is non-nil), then only check if the body is empty." + (when (and magit-insert-section--current + (or (not if-empty) + (= (point) (or (oref magit-insert-section--current content) + (oref magit-insert-section--current start))))) + (if (eq magit-insert-section--current magit-root-section) + (insert "(empty)\n") + (delete-region (oref magit-insert-section--current start) + (point)) + (setq magit-insert-section--current nil) + (throw 'cancel-section nil)))) + +(defun magit-insert-heading (&rest args) + "Insert the heading for the section currently being inserted. + +This function should only be used inside `magit-insert-section'. + +When called without any arguments, then just set the `content' +slot of the object representing the section being inserted to +a marker at `point'. The section should only contain a single +line when this function is used like this. + +When called with arguments ARGS, which have to be strings, or +nil, then insert those strings at point. The section should not +contain any text before this happens and afterwards it should +again only contain a single line. If the `face' property is set +anywhere inside any of these strings, then insert all of them +unchanged. Otherwise use the `magit-section-heading' face for +all inserted text. + +The `content' property of the section object is the end of the +heading (which lasts from `start' to `content') and the beginning +of the the body (which lasts from `content' to `end'). If the +value of `content' is nil, then the section has no heading and +its body cannot be collapsed. If a section does have a heading, +then its height must be exactly one line, including a trailing +newline character. This isn't enforced, you are responsible for +getting it right. The only exception is that this function does +insert a newline character if necessary + +If provided, optional CHILD-COUNT must evaluate to an integer or +boolean. If t, then the count is determined once the children have been +inserted, using `magit-insert-child-count' (which see). For historic +reasons, if the heading ends with \":\", the count is substituted for +that, at this time as well. If `magit-section-show-child-count' is nil, +no counts are inserted + +\n(fn [CHILD-COUNT] &rest STRINGS)" + (declare (indent defun)) + (when args + (let ((count (and (or (integerp (car args)) + (booleanp (car args))) + (pop args))) + (heading (apply #'concat args))) + (insert (if (or (text-property-not-all 0 (length heading) + 'font-lock-face nil heading) + (text-property-not-all 0 (length heading) + 'face nil heading)) + heading + (propertize heading 'font-lock-face 'magit-section-heading))) + (when (and count magit-section-show-child-count) + (insert (propertize (format " (%s)" count) + 'font-lock-face 'magit-section-child-count))))) + (unless (bolp) + (insert ?\n)) + (when (fboundp 'magit-maybe-make-margin-overlay) + (magit-maybe-make-margin-overlay)) + (oset magit-insert-section--current content + (if magit-section-inhibit-markers (point) (point-marker)))) + +(defmacro magit-insert-section-body (&rest body) + "Use BODY to insert the section body, once the section is expanded. +If the section is expanded when it is created, then this is +like `progn'. Otherwise BODY isn't evaluated until the section +is explicitly expanded." + (declare (indent 0)) + (let ((f (cl-gensym)) + (s (cl-gensym)) + (l (cl-gensym))) + `(let ((,f (lambda () ,@body))) + (if (oref magit-insert-section--current hidden) + (oset magit-insert-section--current washer + (let ((,s magit-insert-section--current)) + (lambda () + (let ((,l (magit-section-lineage ,s t))) + (dolist (s ,l) + (set-marker-insertion-type (oref s end) t)) + (funcall ,f) + (dolist (s ,l) + (set-marker-insertion-type (oref s end) nil)) + (magit-section-maybe-remove-heading-map ,s) + (magit-section-maybe-remove-visibility-indicator ,s))))) + (funcall ,f))))) + +(defun magit-insert-headers (hook) + (let* ((header-sections nil) + (magit-insert-section-hook + (cons (lambda () + (push magit-insert-section--current + header-sections)) + (if (listp magit-insert-section-hook) + magit-insert-section-hook + (list magit-insert-section-hook))))) + (magit-run-section-hook hook) + (when header-sections + (insert "\n") + ;; Make the first header into the parent of the rest. + (when (cdr header-sections) + (cl-callf nreverse header-sections) + (let* ((1st-header (pop header-sections)) + (header-parent (oref 1st-header parent))) + (oset header-parent children (list 1st-header)) + (oset 1st-header children header-sections) + (oset 1st-header content (oref (car header-sections) start)) + (oset 1st-header end (oref (car (last header-sections)) end)) + (dolist (sub-header header-sections) + (oset sub-header parent 1st-header)) + (magit-section-maybe-add-heading-map 1st-header)))))) + +(defun magit-section-maybe-add-heading-map (section) + (when (magit-section-content-p section) + (let ((start (oref section start)) + (map (oref section keymap))) + (when (symbolp map) + (setq map (symbol-value map))) + (put-text-property + start + (save-excursion + (goto-char start) + (line-end-position)) + 'keymap (if map + (make-composed-keymap + (list map magit-section-heading-map)) + magit-section-heading-map))))) + +(defun magit-section-maybe-remove-heading-map (section) + (with-slots (start content end keymap) section + (when (= content end) + (put-text-property start end 'keymap keymap)))) + +(defun magit-insert-child-count (section) + "Modify SECTION's heading to contain number of child sections. + +If `magit-section-show-child-count' is non-nil and the SECTION +has children and its heading ends with \":\", then replace that +with \" (N)\", where N is the number of child sections. + +This function is called by `magit-insert-section' after that has +evaluated its BODY. Admittedly that's a bit of a hack." + (let (content count) + (cond + ((not (and magit-section-show-child-count + (setq content (oref section content)) + (setq count (length (oref section children))) + (> count 0)))) + ((eq (char-before (- content 1)) ?:) + (save-excursion + (goto-char (- content 2)) + (insert (magit--propertize-face (format " (%s)" count) + 'magit-section-child-count)) + (delete-char 1))) + ((and (eq (char-before (- content 4)) ?\s) + (eq (char-before (- content 3)) ?\() + (eq (char-before (- content 2)) ?t ) + (eq (char-before (- content 1)) ?\))) + (save-excursion + (goto-char (- content 3)) + (delete-char 1) + (insert (format "%s" count))))))) + +;;; Highlight + +(defun magit-section-pre-command-hook () + (when (and (or magit--context-menu-buffer + magit--context-menu-section) + (not (eq (ignore-errors + (event-basic-type (aref (this-command-keys) 0))) + 'mouse-3))) + ;; This is the earliest opportunity to clean up after an aborted + ;; context-menu because that neither causes the command that created + ;; the menu to abort nor some abortion hook to be run. It is not + ;; possible to update highlighting before the first command invoked + ;; after the menu is aborted. Here we can only make sure it is + ;; updated afterwards. + (magit-menu-highlight-point-section)) + (setq magit-section-pre-command-region-p (region-active-p)) + (setq magit-section-pre-command-section (magit-current-section))) + +(defun magit-section-post-command-hook () + (let ((window (selected-window))) + ;; The command may have used `set-window-buffer' to change + ;; the window's buffer without changing the current buffer. + (when (eq (current-buffer) (window-buffer window)) + (cursor-sensor-move-to-tangible window) + (when (or magit--context-menu-buffer + magit--context-menu-section) + (magit-menu-highlight-point-section)))) + (unless (memq this-command '(magit-refresh magit-refresh-all)) + (magit-section-update-highlight))) + +(defun magit-section-deactivate-mark () + (setq magit-section-highlight-force-update t)) + +(defun magit-section-update-highlight (&optional force) + (let ((section (magit-current-section))) + (when (or force + magit-section-highlight-force-update + (xor magit-section-pre-command-region-p (region-active-p)) + (not (eq magit-section-pre-command-section section))) + (let ((inhibit-read-only t) + (deactivate-mark nil) + (selection (magit-region-sections))) + (mapc #'delete-overlay magit-section-highlight-overlays) + (setq magit-section-highlight-overlays nil) + (setq magit-section-unhighlight-sections + magit-section-highlighted-sections) + (setq magit-section-highlighted-sections nil) + (if (and (fboundp 'long-line-optimizations-p) + (long-line-optimizations-p)) + (magit-section--enable-long-lines-shortcuts) + (unless (eq section magit-root-section) + (run-hook-with-args-until-success + 'magit-section-highlight-hook section selection)) + (dolist (s magit-section-unhighlight-sections) + (run-hook-with-args-until-success + 'magit-section-unhighlight-hook s selection))) + (restore-buffer-modified-p nil))) + (setq magit-section-highlight-force-update nil) + (magit-section-maybe-paint-visibility-ellipses))) + +(defun magit-section-highlight (section selection) + "Highlight SECTION and if non-nil all sections in SELECTION. +This function works for any section but produces undesirable +effects for diff related sections, which by default are +highlighted using `magit-diff-highlight'. Return t." + (when-let ((face (oref section heading-highlight-face))) + (dolist (section (or selection (list section))) + (magit-section-make-overlay + (oref section start) + (or (oref section content) + (oref section end)) + face))) + (cond (selection + (magit-section-make-overlay (oref (car selection) start) + (oref (car (last selection)) end) + 'magit-section-highlight) + (magit-section-highlight-selection nil selection)) + (t + (magit-section-make-overlay (oref section start) + (oref section end) + 'magit-section-highlight))) + t) + +(defun magit-section-highlight-selection (_ selection) + "Highlight the section-selection region. +If SELECTION is non-nil, then it is a list of sections selected by +the region. The headings of these sections are then highlighted. + +This is a fallback for people who don't want to highlight the +current section and therefore removed `magit-section-highlight' +from `magit-section-highlight-hook'. + +This function is necessary to ensure that a representation of +such a region is visible. If neither of these functions were +part of the hook variable, then such a region would be +invisible." + (when (and selection + (not (and (eq this-command 'mouse-drag-region)))) + (dolist (section selection) + (magit-section-make-overlay (oref section start) + (or (oref section content) + (oref section end)) + 'magit-section-heading-selection)) + t)) + +(defun magit-section-make-overlay (start end face) + ;; Yes, this doesn't belong here. But the alternative of + ;; spreading this hack across the code base is even worse. + (when (and magit-section-keep-region-overlay + (memq face '(magit-section-heading-selection + magit-diff-file-heading-selection + magit-diff-hunk-heading-selection))) + (setq face (list :foreground (face-foreground face)))) + (let ((ov (make-overlay start end nil t))) + (overlay-put ov 'font-lock-face face) + (overlay-put ov 'evaporate t) + (push ov magit-section-highlight-overlays) + ov)) + +(defvar magit-show-long-lines-warning t) + +(defun magit-section--enable-long-lines-shortcuts () + (message "Enabling long lines shortcuts in %S" (current-buffer)) + (kill-local-variable 'redisplay-highlight-region-function) + (kill-local-variable 'redisplay-unhighlight-region-function) + (when magit-show-long-lines-warning + (setq magit-show-long-lines-warning nil) + (display-warning 'magit (format "\ +Emacs has enabled redisplay shortcuts +in this buffer because there are lines whose length go beyond +`long-line-threshold' \(%s characters). As a result, section +highlighting and the special appearance of the region has been +disabled. Some existing highlighting might remain in effect. + +These shortcuts remain enabled, even once there no longer are +any long lines in this buffer. To disable them again, kill +and recreate the buffer. + +This message won't be shown for this session again. To disable +it for all future sessions, set `magit-show-long-lines-warning' +to nil." (bound-and-true-p long-line-threshold)) :warning))) + +(cl-defgeneric magit-section-get-relative-position (section)) + +(cl-defmethod magit-section-get-relative-position ((section magit-section)) + (let ((start (oref section start)) + (point (magit-point))) + (list (- (line-number-at-pos point) + (line-number-at-pos start)) + (- point (line-beginning-position))))) + +(cl-defgeneric magit-section-goto-successor ()) + +(cl-defmethod magit-section-goto-successor ((section magit-section) + line char &optional _arg) + (or (magit-section-goto-successor--same section line char) + (magit-section-goto-successor--related section))) + +(defun magit-section-goto-successor--same (section line char) + (let ((ident (magit-section-ident section))) + (and-let* ((found (magit-get-section ident))) + (let ((start (oref found start))) + (goto-char start) + (unless (eq found magit-root-section) + (ignore-errors + (forward-line line) + (forward-char char)) + (unless (eq (magit-current-section) found) + (goto-char start))) + t)))) + +(defun magit-section-goto-successor--related (section) + (and-let* ((found (magit-section-goto-successor--related-1 section))) + (goto-char (if (eq (oref found type) 'button) + (point-min) + (oref found start))))) + +(defun magit-section-goto-successor--related-1 (section) + (or (and-let* ((alt (pcase (oref section type) + ('staged 'unstaged) + ('unstaged 'staged) + ('unpushed 'unpulled) + ('unpulled 'unpushed)))) + (magit-get-section `((,alt) (status)))) + (and-let* ((next (car (magit-section-siblings section 'next)))) + (magit-get-section (magit-section-ident next))) + (and-let* ((prev (car (magit-section-siblings section 'prev)))) + (magit-get-section (magit-section-ident prev))) + (and-let* ((parent (oref section parent))) + (or (magit-get-section (magit-section-ident parent)) + (magit-section-goto-successor--related-1 parent))))) + +;;; Region + +(defvar-local magit-section--region-overlays nil) + +(defun magit-section--delete-region-overlays () + (mapc #'delete-overlay magit-section--region-overlays) + (setq magit-section--region-overlays nil)) + +(defun magit-section--highlight-region (start end window rol) + (magit-section--delete-region-overlays) + (if (and (not magit-section-keep-region-overlay) + (or (magit-region-sections) + (run-hook-with-args-until-success 'magit-region-highlight-hook + (magit-current-section))) + (not (= (line-number-at-pos start) + (line-number-at-pos end))) + ;; (not (eq (car-safe last-command-event) 'mouse-movement)) + ) + (funcall (default-value 'redisplay-unhighlight-region-function) rol) + (funcall (default-value 'redisplay-highlight-region-function) + start end window rol))) + +(defun magit-section--unhighlight-region (rol) + (magit-section--delete-region-overlays) + (funcall (default-value 'redisplay-unhighlight-region-function) rol)) + +;;; Visibility + +(defvar-local magit-section-visibility-cache nil) +(put 'magit-section-visibility-cache 'permanent-local t) + +(defun magit-section-cached-visibility (section) + "Set SECTION's visibility to the cached value. +When `magit-section-preserve-visibility' is nil, do nothing." + (and magit-section-preserve-visibility + (cdr (assoc (magit-section-ident section) + magit-section-visibility-cache)))) + +(cl-defun magit-section-cache-visibility + (&optional (section magit-insert-section--current)) + (setf (compat-call alist-get + (magit-section-ident section) + magit-section-visibility-cache + nil nil #'equal) + (if (oref section hidden) 'hide 'show))) + +(cl-defun magit-section-maybe-cache-visibility + (&optional (section magit-insert-section--current)) + (when (or (eq magit-section-cache-visibility t) + (memq (oref section type) + magit-section-cache-visibility)) + (magit-section-cache-visibility section))) + +(defun magit-section-maybe-update-visibility-indicator (section) + (when (and magit-section-visibility-indicator + (magit-section-content-p section)) + (let* ((beg (oref section start)) + (eoh (save-excursion + (goto-char beg) + (line-end-position)))) + (cond + ((symbolp (car-safe magit-section-visibility-indicator)) + (let ((ov (magit--overlay-at beg 'magit-vis-indicator 'fringe))) + (unless ov + (setq ov (make-overlay beg eoh nil t)) + (overlay-put ov 'evaporate t) + (overlay-put ov 'magit-vis-indicator 'fringe)) + (overlay-put + ov 'before-string + (propertize "fringe" 'display + (list 'left-fringe + (if (oref section hidden) + (car magit-section-visibility-indicator) + (cdr magit-section-visibility-indicator)) + 'fringe))))) + ((stringp (car-safe magit-section-visibility-indicator)) + (let ((ov (magit--overlay-at (1- eoh) 'magit-vis-indicator 'eoh))) + (cond ((oref section hidden) + (unless ov + (setq ov (make-overlay (1- eoh) eoh)) + (overlay-put ov 'evaporate t) + (overlay-put ov 'magit-vis-indicator 'eoh)) + (overlay-put ov 'after-string + (car magit-section-visibility-indicator))) + (ov + (delete-overlay ov))))))))) + +(defvar-local magit--ellipses-sections nil) + +(defun magit-section-maybe-paint-visibility-ellipses () + ;; This is needed because we hide the body instead of "the body + ;; except the final newline and additionally the newline before + ;; the body"; otherwise we could use `buffer-invisibility-spec'. + (when (stringp (car-safe magit-section-visibility-indicator)) + (let* ((sections (append magit--ellipses-sections + (setq magit--ellipses-sections + (or (magit-region-sections) + (list (magit-current-section)))))) + (beg (--map (oref it start) sections)) + (end (--map (oref it end) sections))) + (when (region-active-p) + ;; This ensures that the region face is removed from ellipses + ;; when the region becomes inactive, but fails to ensure that + ;; all ellipses within the active region use the region face, + ;; because the respective overlay has not yet been updated at + ;; this time. The magit-selection face is always applied. + (push (region-beginning) beg) + (push (region-end) end)) + (setq beg (apply #'min beg)) + (setq end (apply #'max end)) + (dolist (ov (overlays-in beg end)) + (when (eq (overlay-get ov 'magit-vis-indicator) 'eoh) + (overlay-put + ov 'after-string + (propertize + (car magit-section-visibility-indicator) 'font-lock-face + (let ((pos (overlay-start ov))) + (delq nil (nconc (--map (overlay-get it 'font-lock-face) + (overlays-at pos)) + (list (get-char-property + pos 'font-lock-face)))))))))))) + +(defun magit-section-maybe-remove-visibility-indicator (section) + (when (and magit-section-visibility-indicator + (= (oref section content) + (oref section end))) + (dolist (o (overlays-in (oref section start) + (save-excursion + (goto-char (oref section start)) + (1+ (line-end-position))))) + (when (overlay-get o 'magit-vis-indicator) + (delete-overlay o))))) + +(defvar-local magit-section--opened-sections nil) + +(defun magit-section--open-temporarily (beg end) + (save-excursion + (goto-char beg) + (let ((section (magit-current-section))) + (while section + (let ((content (oref section content))) + (if (and (magit-section-invisible-p section) + (<= (or content (oref section start)) + beg + (oref section end))) + (progn + (when content + (magit-section-show section) + (push section magit-section--opened-sections)) + (setq section (oref section parent))) + (setq section nil)))))) + (or (eq search-invisible t) + (not (isearch-range-invisible beg end)))) + +(define-advice isearch-clean-overlays (:around (fn) magit-mode) + (if (derived-mode-p 'magit-mode) + (let ((pos (point))) + (dolist (section magit-section--opened-sections) + (unless (<= (oref section content) pos (oref section end)) + (magit-section-hide section))) + (setq magit-section--opened-sections nil)) + (funcall fn))) + +;;; Utilities + +(cl-defun magit-section-selected-p (section &optional (selection nil sselection)) + (and (not (eq section magit-root-section)) + (or (eq section (magit-current-section)) + (memq section (if sselection + selection + (setq selection (magit-region-sections)))) + (and-let* ((parent (oref section parent))) + (magit-section-selected-p parent selection))))) + +(defun magit-section-parent-value (section) + (and-let* ((parent (oref section parent))) + (oref parent value))) + +(defun magit-section-siblings (section &optional direction) + "Return a list of the sibling sections of SECTION. + +If optional DIRECTION is `prev', then return siblings that come +before SECTION. If it is `next', then return siblings that come +after SECTION. For all other values, return all siblings +excluding SECTION itself." + (and-let* ((parent (oref section parent)) + (siblings (oref parent children))) + (pcase direction + ('prev (cdr (member section (reverse siblings)))) + ('next (cdr (member section siblings))) + (_ (remq section siblings))))) + +(defun magit-region-values (&optional condition multiple) + "Return a list of the values of the selected sections. + +Return the values that themselves would be returned by +`magit-region-sections' (which see)." + (--map (oref it value) + (magit-region-sections condition multiple))) + +(defun magit-region-sections (&optional condition multiple) + "Return a list of the selected sections. + +When the region is active and constitutes a valid section +selection, then return a list of all selected sections. This is +the case when the region begins in the heading of a section and +ends in the heading of the same section or in that of a sibling +section. If optional MULTIPLE is non-nil, then the region cannot +begin and end in the same section. + +When the selection is not valid, then return nil. In this case, +most commands that can act on the selected sections will instead +act on the section at point. + +When the region looks like it would in any other buffer then +the selection is invalid. When the selection is valid then the +region uses the `magit-section-highlight' face. This does not +apply to diffs where things get a bit more complicated, but even +here if the region looks like it usually does, then that's not +a valid selection as far as this function is concerned. + +If optional CONDITION is non-nil, then the selection not only +has to be valid; all selected sections additionally have to match +CONDITION, or nil is returned. See `magit-section-match' for the +forms CONDITION can take." + (and (region-active-p) + (let* ((rbeg (region-beginning)) + (rend (region-end)) + (sbeg (magit-section-at rbeg)) + (send (magit-section-at rend))) + (and send + (not (eq send magit-root-section)) + (not (and multiple (eq send sbeg))) + (let ((siblings (cons sbeg (magit-section-siblings sbeg 'next))) + (sections ())) + (and (memq send siblings) + (magit-section-position-in-heading-p sbeg rbeg) + (magit-section-position-in-heading-p send rend) + (progn + (while siblings + (push (car siblings) sections) + (when (eq (pop siblings) send) + (setq siblings nil))) + (setq sections (nreverse sections)) + (and (or (not condition) + (--all-p (magit-section-match condition it) + sections)) + sections)))))))) + +(defun magit-map-sections (function &optional section) + "Apply FUNCTION to all sections for side effects only, depth first. +If optional SECTION is non-nil, only map over that section and +its descendants, otherwise map over all sections in the current +buffer, ending with `magit-root-section'." + (let ((section (or section magit-root-section))) + (mapc (lambda (child) (magit-map-sections function child)) + (oref section children)) + (funcall function section))) + +(defun magit-section-position-in-heading-p (&optional section pos) + "Return t if POSITION is inside the heading of SECTION. +POSITION defaults to point and SECTION defaults to the +current section." + (unless section + (setq section (magit-current-section))) + (unless pos + (setq pos (point))) + (ignore-errors ; Allow navigating broken sections. + (and section + (>= pos (oref section start)) + (< pos (or (oref section content) + (oref section end))) + t))) + +(defun magit-section-internal-region-p (&optional section) + "Return t if the region is active and inside SECTION's body. +If optional SECTION is nil, use the current section." + (and (region-active-p) + (or section (setq section (magit-current-section))) + (let ((beg (magit-section-at (region-beginning)))) + (and (eq beg (magit-section-at (region-end))) + (eq beg section))) + (not (or (magit-section-position-in-heading-p section (region-beginning)) + (magit-section-position-in-heading-p section (region-end)))) + t)) + +(defun magit-wash-sequence (function) + "Repeatedly call FUNCTION until it returns nil or eob is reached. +FUNCTION has to move point forward or return nil." + (while (and (not (eobp)) (funcall function)))) + +(defun magit-add-section-hook (hook function &optional at append local) + "Add to the value of section hook HOOK the function FUNCTION. + +Add FUNCTION at the beginning of the hook list unless optional +APPEND is non-nil, in which case FUNCTION is added at the end. +If FUNCTION already is a member, then move it to the new location. + +If optional AT is non-nil and a member of the hook list, then +add FUNCTION next to that instead. Add before or after AT, or +replace AT with FUNCTION depending on APPEND. If APPEND is the +symbol `replace', then replace AT with FUNCTION. For any other +non-nil value place FUNCTION right after AT. If nil, then place +FUNCTION right before AT. If FUNCTION already is a member of the +list but AT is not, then leave FUNCTION where ever it already is. + +If optional LOCAL is non-nil, then modify the hook's buffer-local +value rather than its global value. This makes the hook local by +copying the default value. That copy is then modified. + +HOOK should be a symbol. If HOOK is void, it is first set to nil. +HOOK's value must not be a single hook function. FUNCTION should +be a function that takes no arguments and inserts one or multiple +sections at point, moving point forward. FUNCTION may choose not +to insert its section(s), when doing so would not make sense. It +should not be abused for other side-effects. To remove FUNCTION +again use `remove-hook'." + (unless (boundp hook) + (error "Cannot add function to undefined hook variable %s" hook)) + (unless (default-boundp hook) + (set-default hook nil)) + (let ((value (if local + (if (local-variable-p hook) + (symbol-value hook) + (unless (local-variable-if-set-p hook) + (make-local-variable hook)) + (copy-sequence (default-value hook))) + (default-value hook)))) + (if at + (when (setq at (member at value)) + (setq value (delq function value)) + (cond ((eq append 'replace) + (setcar at function)) + (append + (push function (cdr at))) + (t + (push (car at) (cdr at)) + (setcar at function)))) + (setq value (delq function value))) + (unless (member function value) + (setq value (if append + (append value (list function)) + (cons function value)))) + (when (eq append 'replace) + (setq value (delq at value))) + (if local + (set hook value) + (set-default hook value)))) + +(defvar-local magit-disabled-section-inserters nil) + +(defun magit-disable-section-inserter (fn) + "Disable the section inserter FN in the current repository. +It is only intended for use in \".dir-locals.el\" and +\".dir-locals-2.el\". Also see info node `(magit)Per-Repository +Configuration'." + (cl-pushnew fn magit-disabled-section-inserters)) + +(put 'magit-disable-section-inserter 'safe-local-eval-function t) + +(defun magit-run-section-hook (hook &rest args) + "Run HOOK with ARGS, warning about invalid entries." + (let ((entries (symbol-value hook))) + (unless (listp entries) + (setq entries (list entries))) + (when-let ((invalid (seq-remove #'functionp entries))) + (message "`%s' contains entries that are no longer valid. +%s\nUsing standard value instead. Please re-configure hook variable." + hook + (mapconcat (lambda (sym) (format " `%s'" sym)) invalid "\n")) + (sit-for 5) + (setq entries (eval (car (get hook 'standard-value))))) + (dolist (entry entries) + (let ((magit--current-section-hook (cons (list hook entry) + magit--current-section-hook))) + (unless (memq entry magit-disabled-section-inserters) + (if (bound-and-true-p magit-refresh-verbose) + (let ((time (benchmark-elapse (apply entry args)))) + (message " %-50s %f %s" entry time + (cond ((> time 0.03) "!!") + ((> time 0.01) "!") + (t "")))) + (apply entry args))))))) + +(cl-defun magit--overlay-at (pos prop &optional (val nil sval) testfn) + (cl-find-if (lambda (o) + (let ((p (overlay-properties o))) + (and (plist-member p prop) + (or (not sval) + (funcall (or testfn #'eql) + (plist-get p prop) + val))))) + (overlays-at pos t))) + +(defun magit-face-property-all (face string) + "Return non-nil if FACE is present in all of STRING." + (catch 'missing + (let ((pos 0)) + (while (setq pos (next-single-property-change pos 'font-lock-face string)) + (let ((val (get-text-property pos 'font-lock-face string))) + (unless (if (consp val) + (memq face val) + (eq face val)) + (throw 'missing nil)))) + (not pos)))) + +(defun magit--add-face-text-property (beg end face &optional append object) + "Like `add-face-text-property' but for `font-lock-face'." + (while (< beg end) + (let* ((pos (next-single-property-change beg 'font-lock-face object end)) + (val (get-text-property beg 'font-lock-face object)) + (val (if (listp val) val (list val)))) + (put-text-property beg pos 'font-lock-face + (if append + (append val (list face)) + (cons face val)) + object) + (setq beg pos)))) + +(defun magit--propertize-face (string face) + (propertize string 'face face 'font-lock-face face)) + +(defun magit--put-face (beg end face string) + (put-text-property beg end 'face face string) + (put-text-property beg end 'font-lock-face face string)) + +;;; Imenu Support + +(defvar-local magit--imenu-group-types nil) +(defvar-local magit--imenu-item-types nil) + +(defun magit--imenu-create-index () + ;; If `which-function-mode' is active, then the create-index + ;; function is called at the time the major-mode is being enabled. + ;; Modes that derive from `magit-mode' have not populated the buffer + ;; at that time yet, so we have to abort. + (and magit-root-section + (or magit--imenu-group-types + magit--imenu-item-types) + (let ((index + (cl-mapcan + (lambda (section) + (cond + (magit--imenu-group-types + (and (if (eq (car-safe magit--imenu-group-types) 'not) + (not (magit-section-match + (cdr magit--imenu-group-types) + section)) + (magit-section-match magit--imenu-group-types section)) + (and-let* ((children (oref section children))) + `((,(magit--imenu-index-name section) + ,@(mapcar (lambda (s) + (cons (magit--imenu-index-name s) + (oref s start))) + children)))))) + (magit--imenu-item-types + (and (magit-section-match magit--imenu-item-types section) + `((,(magit--imenu-index-name section) + . ,(oref section start))))))) + (oref magit-root-section children)))) + (if (and magit--imenu-group-types (symbolp magit--imenu-group-types)) + (cdar index) + index)))) + +(defun magit--imenu-index-name (section) + (let ((heading (buffer-substring-no-properties + (oref section start) + (1- (or (oref section content) + (oref section end)))))) + (save-match-data + (cond + ((and (magit-section-match [commit logbuf] section) + (string-match "[^ ]+\\([ *|]*\\).+" heading)) + (replace-match " " t t heading 1)) + ((magit-section-match + '([branch local branchbuf] [tag tags branchbuf]) section) + (oref section value)) + ((magit-section-match [branch remote branchbuf] section) + (concat (oref (oref section parent) value) "/" + (oref section value))) + ((string-match " ([0-9]+)\\'" heading) + (substring heading 0 (match-beginning 0))) + (t heading))))) + +(defun magit--imenu-goto-function (_name position &rest _rest) + "Go to the section at POSITION. +Make sure it is visible, by showing its ancestors where +necessary. For use as `imenu-default-goto-function' in +`magit-mode' buffers." + (goto-char position) + (let ((section (magit-current-section))) + (while (setq section (oref section parent)) + (when (oref section hidden) + (magit-section-show section))))) + +;;; Bookmark support + +(declare-function bookmark-get-filename "bookmark" (bookmark-name-or-record)) +(declare-function bookmark-make-record-default "bookmark" + (&optional no-file no-context posn)) +(declare-function bookmark-prop-get "bookmark" (bookmark-name-or-record prop)) +(declare-function bookmark-prop-set "bookmark" (bookmark-name-or-record prop val)) + +(cl-defgeneric magit-bookmark-get-filename () + (or (buffer-file-name) (buffer-name))) + +(cl-defgeneric magit-bookmark--get-child-value (section) + (oref section value)) + +(cl-defgeneric magit-bookmark-get-buffer-create (bookmark mode)) + +(defun magit--make-bookmark () + "Create a bookmark for the current Magit buffer. +Input values are the major-mode's `magit-bookmark-name' method, +and the buffer-local values of the variables referenced in its +`magit-bookmark-variables' property." + (require 'bookmark) + (if (plist-member (symbol-plist major-mode) 'magit-bookmark-variables) + ;; `bookmark-make-record-default's return value does not match + ;; (NAME . ALIST), even though it is used as the default value + ;; of `bookmark-make-record-function', which states that such + ;; functions must do that. See #4356. + (let ((bookmark (cons nil (bookmark-make-record-default 'no-file)))) + (bookmark-prop-set bookmark 'handler #'magit--handle-bookmark) + (bookmark-prop-set bookmark 'mode major-mode) + (bookmark-prop-set bookmark 'filename (magit-bookmark-get-filename)) + (bookmark-prop-set bookmark 'defaults (list (magit-bookmark-name))) + (dolist (var (get major-mode 'magit-bookmark-variables)) + (bookmark-prop-set bookmark var (symbol-value var))) + (bookmark-prop-set + bookmark 'magit-hidden-sections + (--keep (and (oref it hidden) + (cons (oref it type) + (magit-bookmark--get-child-value it))) + (oref magit-root-section children))) + bookmark) + (user-error "Bookmarking is not implemented for %s buffers" major-mode))) + +(defun magit--handle-bookmark (bookmark) + "Open a bookmark created by `magit--make-bookmark'. + +Call the generic function `magit-bookmark-get-buffer-create' to get +the appropriate buffer without displaying it. + +Then call the `magit-*-setup-buffer' function of the the major-mode +with the variables' values as arguments, which were recorded by +`magit--make-bookmark'." + (let ((buffer (magit-bookmark-get-buffer-create + bookmark + (bookmark-prop-get bookmark 'mode)))) + (set-buffer buffer) ; That is the interface we have to adhere to. + (when-let ((hidden (bookmark-prop-get bookmark 'magit-hidden-sections))) + (with-current-buffer buffer + (dolist (child (oref magit-root-section children)) + (if (member (cons (oref child type) + (oref child value)) + hidden) + (magit-section-hide child) + (magit-section-show child))))) + ;; Compatibility with `bookmark+' package. See #4356. + (when (bound-and-true-p bmkp-jump-display-function) + (funcall bmkp-jump-display-function (current-buffer))) + nil)) + +(put 'magit--handle-bookmark 'bookmark-handler-type "Magit") + +(cl-defgeneric magit-bookmark-name () + "Return name for bookmark to current buffer." + (format "%s%s" + (substring (symbol-name major-mode) 0 -5) + (if-let ((vars (get major-mode 'magit-bookmark-variables))) + (cl-mapcan (lambda (var) + (let ((val (symbol-value var))) + (if (and val (atom val)) + (list val) + val))) + vars) + ""))) + +;;; Bitmaps + +(when (fboundp 'define-fringe-bitmap) ;for Emacs 26 + (define-fringe-bitmap 'magit-fringe-bitmap+ + [#b00000000 + #b00011000 + #b00011000 + #b01111110 + #b01111110 + #b00011000 + #b00011000 + #b00000000]) + + (define-fringe-bitmap 'magit-fringe-bitmap- + [#b00000000 + #b00000000 + #b00000000 + #b01111110 + #b01111110 + #b00000000 + #b00000000 + #b00000000]) + + (define-fringe-bitmap 'magit-fringe-bitmap> + [#b01100000 + #b00110000 + #b00011000 + #b00001100 + #b00011000 + #b00110000 + #b01100000 + #b00000000]) + + (define-fringe-bitmap 'magit-fringe-bitmapv + [#b00000000 + #b10000010 + #b11000110 + #b01101100 + #b00111000 + #b00010000 + #b00000000 + #b00000000]) + + (define-fringe-bitmap 'magit-fringe-bitmap-bold> + [#b11100000 + #b01110000 + #b00111000 + #b00011100 + #b00011100 + #b00111000 + #b01110000 + #b11100000]) + + (define-fringe-bitmap 'magit-fringe-bitmap-boldv + [#b10000001 + #b11000011 + #b11100111 + #b01111110 + #b00111100 + #b00011000 + #b00000000 + #b00000000]) + ) + +;;; _ +(provide 'magit-section) +;;; magit-section.el ends here diff --git a/emacs/elpa/magit-section-20240624.719/magit-section.elc b/emacs/elpa/magit-section-20240624.719/magit-section.elc Binary files differ. diff --git a/emacs/elpa/magit-section-20240624.719/magit-section.info b/emacs/elpa/magit-section-20240624.719/magit-section.info @@ -0,0 +1,317 @@ +This is magit-section.info, produced by makeinfo version 6.7 from +magit-section.texi. + + Copyright (C) 2015-2024 Jonas Bernoulli + <emacs.magit@jonas.bernoulli.dev> + + 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 +* Magit-Section: (magit-section). Use Magit sections in your own packages. +END-INFO-DIR-ENTRY + + +File: magit-section.info, Node: Top, Next: Introduction, Up: (dir) + +Magit-Section Developer Manual +****************************** + +This package implements the main user interface of Magit — the +collapsible sections that make up its buffers. This package used to be +distributed as part of Magit but how it can also be used by other +packages that have nothing to do with Magit or Git. + + To learn more about the section abstraction and available commands +and user options see *note (magit)Sections::. This manual documents how +you can use sections in your own packages. + +This manual is for Magit-Section version 3.3.0.50-git. + + Copyright (C) 2015-2024 Jonas Bernoulli + <emacs.magit@jonas.bernoulli.dev> + + 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:: +* Creating Sections:: +* Core Functions:: +* Matching Functions:: + + +File: magit-section.info, Node: Introduction, Next: Creating Sections, Prev: Top, Up: Top + +1 Introduction +************** + +This package implements the main user interface of Magit — the +collapsible sections that make up its buffers. This package used to be +distributed as part of Magit but how it can also be used by other +packages that have nothing to do with Magit or Git. + + To learn more about the section abstraction and available commands +and user options see *note (magit)Sections::. This manual documents how +you can use sections in your own packages. + + When the documentation leaves something unaddressed, then please +consider that Magit uses this library extensively and search its source +for suitable examples before asking me for help. Thanks! + + +File: magit-section.info, Node: Creating Sections, Next: Core Functions, Prev: Introduction, Up: Top + +2 Creating Sections +******************* + + -- Macro: magit-insert-section [name] (type &optional value hide) &rest + body + Create a section object of type CLASS, storing VALUE in its ‘value’ + slot, and insert the section at point. CLASS is a subclass of + ‘magit-section’ or has the form ‘(eval FORM)’, in which case FORM + is evaluated at runtime and should return a subclass. In other + places a sections class is often referred to as its "type". + + Many commands behave differently depending on the class of the + current section and sections of a certain class can have their own + keymap, which is specified using the ‘keymap’ class slot. The + value of that slot should be a variable whose value is a keymap. + + For historic reasons Magit and Forge in most cases use symbols as + CLASS that don’t actually identify a class and that lack the + appropriate package prefix. This works due to some undocumented + kludges, which are not available to other packages. + + When optional HIDE is non-nil collapse the section body by default, + i.e., when first creating the section, but not when refreshing the + buffer. Else expand it by default. This can be overwritten using + ‘magit-section-set-visibility-hook’. When a section is recreated + during a refresh, then the visibility of predecessor is inherited + and HIDE is ignored (but the hook is still honored). + + BODY is any number of forms that actually insert the section’s + heading and body. Optional NAME, if specified, has to be a symbol, + which is then bound to the object of the section being inserted. + + Before BODY is evaluated the ‘start’ of the section object is set + to the value of ‘point’ and after BODY was evaluated its ‘end’ is + set to the new value of ‘point’; BODY is responsible for moving + ‘point’ forward. + + If it turns out inside BODY that the section is empty, then + ‘magit-cancel-section’ can be used to abort and remove all traces + of the partially inserted section. This can happen when creating a + section by washing Git’s output and Git didn’t actually output + anything this time around. + + -- Function: magit-insert-heading [child-count] &rest args + Insert the heading for the section currently being inserted. + + This function should only be used inside ‘magit-insert-section’. + + When called without any arguments, then just set the ‘content’ slot + of the object representing the section being inserted to a marker + at ‘point’. The section should only contain a single line when + this function is used like this. + + When called with arguments ARGS, which have to be strings, or nil, + then insert those strings at point. The section should not contain + any text before this happens and afterwards it should again only + contain a single line. If the ‘face’ property is set anywhere + inside any of these strings, then insert all of them unchanged. + Otherwise use the ‘magit-section-heading’ face for all inserted + text. + + The ‘content’ property of the section object is the end of the + heading (which lasts from ‘start’ to ‘content’) and the beginning + of the the body (which lasts from ‘content’ to ‘end’). If the + value of ‘content’ is nil, then the section has no heading and its + body cannot be collapsed. If a section does have a heading, then + its height must be exactly one line, including a trailing newline + character. This isn’t enforced, you are responsible for getting it + right. The only exception is that this function does insert a + newline character if necessary. + + If provided, optional CHILD-COUNT must evaluate to an integer or + boolean. If t, then the count is determined once the children have + been inserted, using ‘magit-insert-child-count’ (which see). For + historic reasons, if the heading ends with ":", the count is + substituted for that, at this time as well. If + ‘magit-section-show-child-count’ is nil, no counts are inserted + + -- Macro: magit-insert-section-body &rest body + Use BODY to insert the section body, once the section is expanded. + If the section is expanded when it is created, then this is like + ‘progn’. Otherwise BODY isn’t evaluated until the section is + explicitly expanded. + + -- Function: magit-cancel-section + Cancel inserting the section that is currently being inserted. + Remove all traces of that section. + + -- Function: magit-wash-sequence function + Repeatedly call FUNCTION until it returns ‘nil’ or the end of the + buffer is reached. FUNCTION has to move point forward or return + ‘nil’. + + +File: magit-section.info, Node: Core Functions, Next: Matching Functions, Prev: Creating Sections, Up: Top + +3 Core Functions +**************** + + -- Function: magit-current-section + Return the section at point or where the context menu was invoked. + When using the context menu, return the section that the user + clicked on, provided the current buffer is the buffer in which the + click occurred. Otherwise return the section at point. + +Function magit-section-at &optional position + Return the section at POSITION, defaulting to point. Default to + point even when the context menu is used. + + -- Function: magit-section-ident section + Return an unique identifier for SECTION. The return value has the + form ‘((TYPE . VALUE)...)’. + + -- Function: magit-section-ident-value value + Return a constant representation of VALUE. + + VALUE is the value of a ‘magit-section’ object. If that is an + object itself, then that is not suitable to be used to identify the + section because two objects may represent the same thing but not be + equal. If possible a method should be added for such objects, + which returns a value that is equal. Otherwise the catch-all + method is used, which just returns the argument itself. + + -- Function: magit-get-section ident &optional root + Return the section identified by IDENT. IDENT has to be a list as + returned by ‘magit-section-ident’. If optional ROOT is non-nil, + then search in that section tree instead of in the one whose root + ‘magit-root-section’ is. + + -- Function: magit-section-lineage section &optional raw + Return the lineage of SECTION. If optional RAW is non-nil, return + a list of section objects, beginning with SECTION, otherwise return + a list of section types. + + -- Function: magit-section-content-p section + Return non-nil if SECTION has content or an unused washer function. + + The next two functions are replacements for the Emacs functions that +have the same name except for the ‘magit-’ prefix. Like +‘magit-current-section’ they do not act on point, the cursors position, +but on the position where the user clicked to invoke the context menu. + + If your package provides a context menu and some of its commands act +on the "thing at point", even if just as a default, then use the +prefixed functions to teach them to instead use the click location when +appropriate. + +Function magit-point + Return point or the position where the context menu was invoked. + When using the context menu, return the position the user clicked + on, provided the current buffer is the buffer in which the click + occurred. Otherwise return the same value as ‘point’. + +Function magit-thing-at-point thing &optional no-properties + Return the THING at point or where the context menu was invoked. + When using the context menu, return the thing the user clicked on, + provided the current buffer is the buffer in which the click + occurred. Otherwise return the same value as ‘thing-at-point’. + For the meaning of THING and NO-PROPERTIES see that function. + + +File: magit-section.info, Node: Matching Functions, Prev: Core Functions, Up: Top + +4 Matching Functions +******************** + + -- Function: magit-section-match condition &optional (section + (magit-current-section)) + Return t if SECTION matches CONDITION. + + SECTION defaults to the section at point. If SECTION is not + specified and there also is no section at point, then return nil. + + CONDITION can take the following forms: + + • ‘(CONDITION...)’ matches if any of the CONDITIONs matches. + • ‘[CLASS...]’ matches if the section’s class is the same as the + first CLASS or a subclass of that; the section’s parent class + matches the second CLASS; and so on. + + • ‘[* CLASS...]’ matches sections that match [CLASS...] and also + recursively all their child sections. + • ‘CLASS’ matches if the section’s class is the same as CLASS or + a subclass of that; regardless of the classes of the parent + sections. + + Each CLASS should be a class symbol, identifying a class that + derives from ‘magit-section’. For backward compatibility CLASS can + also be a "type symbol". A section matches such a symbol if the + value of its ‘type’ slot is ‘eq’. If a type symbol has an entry in + ‘magit--section-type-alist’, then a section also matches that type + if its class is a subclass of the class that corresponds to the + type as per that alist. + + Note that it is not necessary to specify the complete section + lineage as printed by ‘magit-describe-section-briefly’, unless of + course you want to be that precise. + + -- Function: magit-section-value-if condition &optional section + If the section at point matches CONDITION, then return its value. + + If optional SECTION is non-nil then test whether that matches + instead. If there is no section at point and SECTION is nil, then + return nil. If the section does not match, then return nil. + + See ‘magit-section-match’ for the forms CONDITION can take. + + -- Macro: magit-section-case &rest clauses + Choose among clauses on the type of the section at point. + + Each clause looks like ‘(CONDITION BODY...)’. The type of the + section is compared against each CONDITION; the BODY forms of the + first match are evaluated sequentially and the value of the last + form is returned. Inside BODY the symbol ‘it’ is bound to the + section at point. If no clause succeeds or if there is no section + at point, return nil. + + See ‘magit-section-match’ for the forms CONDITION can take. + Additionally a CONDITION of t is allowed in the final clause, and + matches if no other CONDITION match, even if there is no section at + point. + + + +Tag Table: +Node: Top808 +Node: Introduction2116 +Node: Creating Sections2886 +Node: Core Functions7819 +Node: Matching Functions10971 + +End Tag Table + + +Local Variables: +coding: utf-8 +End: diff --git a/emacs/elpa/markdown-mode-20240501.1057/markdown-mode-pkg.el b/emacs/elpa/markdown-mode-20240501.1057/markdown-mode-pkg.el @@ -1,14 +0,0 @@ -(define-package "markdown-mode" "20240501.1057" "Major mode for Markdown-formatted text" - '((emacs "27.1")) - :commit "0cdebc833ed9b98baf9f260ed12b1e36b0ca0e89" :authors - '(("Jason R. Blevins" . "jblevins@xbeta.org")) - :maintainers - '(("Jason R. Blevins" . "jblevins@xbeta.org")) - :maintainer - '("Jason R. Blevins" . "jblevins@xbeta.org") - :keywords - '("markdown" "github flavored markdown" "itex") - :url "https://jblevins.org/projects/markdown-mode/") -;; Local Variables: -;; no-byte-compile: t -;; End: diff --git a/emacs/elpa/markdown-mode-20240501.1057/markdown-mode.el b/emacs/elpa/markdown-mode-20240501.1057/markdown-mode.el @@ -1,10381 +0,0 @@ -;;; markdown-mode.el --- Major mode for Markdown-formatted text -*- lexical-binding: t; -*- - -;; Copyright (C) 2007-2023 Jason R. Blevins and markdown-mode -;; contributors (see the commit log for details). - -;; Author: Jason R. Blevins <jblevins@xbeta.org> -;; Maintainer: Jason R. Blevins <jblevins@xbeta.org> -;; Created: May 24, 2007 -;; Version: 2.7-alpha -;; Package-Requires: ((emacs "27.1")) -;; Keywords: Markdown, GitHub Flavored Markdown, itex -;; URL: https://jblevins.org/projects/markdown-mode/ - -;; This file is not part of GNU Emacs. - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; See the README.md file for details. - - -;;; Code: - -(require 'easymenu) -(require 'outline) -(require 'thingatpt) -(require 'cl-lib) -(require 'url-parse) -(require 'button) -(require 'color) -(require 'rx) -(require 'subr-x) - -(defvar jit-lock-start) -(defvar jit-lock-end) -(defvar flyspell-generic-check-word-predicate) -(defvar electric-pair-pairs) -(defvar sh-ancestor-alist) - -(declare-function project-roots "project") -(declare-function sh-set-shell "sh-script") -(declare-function mailcap-file-name-to-mime-type "mailcap") -(declare-function dnd-get-local-file-name "dnd") - -;; for older emacs<29 -(declare-function mailcap-mime-type-to-extension "mailcap") -(declare-function file-name-with-extension "files") -(declare-function yank-media-handler "yank-media") - - -;;; Constants ================================================================= - -(defconst markdown-mode-version "2.7-alpha" - "Markdown mode version number.") - -(defconst markdown-output-buffer-name "*markdown-output*" - "Name of temporary buffer for markdown command output.") - - -;;; Global Variables ========================================================== - -(defvar markdown-reference-label-history nil - "History of used reference labels.") - -(defvar markdown-live-preview-mode nil - "Sentinel variable for command `markdown-live-preview-mode'.") - -(defvar markdown-gfm-language-history nil - "History list of languages used in the current buffer in GFM code blocks.") - -(defvar markdown-follow-link-functions nil - "Functions used to follow a link. -Each function is called with one argument, the link's URL. It -should return non-nil if it followed the link, or nil if not. -Functions are called in order until one of them returns non-nil; -otherwise the default link-following function is used.") - - -;;; Customizable Variables ==================================================== - -(defvar markdown-mode-hook nil - "Hook run when entering Markdown mode.") - -(defvar markdown-before-export-hook nil - "Hook run before running Markdown to export XHTML output. -The hook may modify the buffer, which will be restored to it's -original state after exporting is complete.") - -(defvar markdown-after-export-hook nil - "Hook run after XHTML output has been saved. -Any changes to the output buffer made by this hook will be saved.") - -(defgroup markdown nil - "Major mode for editing text files in Markdown format." - :prefix "markdown-" - :group 'text - :link '(url-link "https://jblevins.org/projects/markdown-mode/")) - -(defcustom markdown-command (let ((command (cl-loop for cmd in '("markdown" "pandoc" "markdown_py") - when (executable-find cmd) - return (file-name-nondirectory it)))) - (or command "markdown")) - "Command to run markdown." - :group 'markdown - :type '(choice (string :tag "Shell command") (repeat (string)) function)) - -(defcustom markdown-command-needs-filename nil - "Set to non-nil if `markdown-command' does not accept input from stdin. -Instead, it will be passed a filename as the final command line -option. As a result, you will only be able to run Markdown from -buffers which are visiting a file." - :group 'markdown - :type 'boolean) - -(defcustom markdown-open-command nil - "Command used for opening Markdown files directly. -For example, a standalone Markdown previewer. This command will -be called with a single argument: the filename of the current -buffer. It can also be a function, which will be called without -arguments." - :group 'markdown - :type '(choice file function (const :tag "None" nil))) - -(defcustom markdown-open-image-command nil - "Command used for opening image files directly. -This is used at `markdown-follow-link-at-point'." - :group 'markdown - :type '(choice file function (const :tag "None" nil))) - -(defcustom markdown-hr-strings - '("-------------------------------------------------------------------------------" - "* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *" - "---------------------------------------" - "* * * * * * * * * * * * * * * * * * * *" - "---------" - "* * * * *") - "Strings to use when inserting horizontal rules. -The first string in the list will be the default when inserting a -horizontal rule. Strings should be listed in decreasing order of -prominence (as in headings from level one to six) for use with -promotion and demotion functions." - :group 'markdown - :type '(repeat string)) - -(defcustom markdown-bold-underscore nil - "Use two underscores when inserting bold text instead of two asterisks." - :group 'markdown - :type 'boolean) - -(defcustom markdown-italic-underscore nil - "Use underscores when inserting italic text instead of asterisks." - :group 'markdown - :type 'boolean) - -(defcustom markdown-marginalize-headers nil - "When non-nil, put opening atx header markup in a left margin. - -This setting goes well with `markdown-asymmetric-header'. But -sadly it conflicts with `linum-mode' since they both use the -same margin." - :group 'markdown - :type 'boolean - :safe 'booleanp - :package-version '(markdown-mode . "2.4")) - -(defcustom markdown-marginalize-headers-margin-width 6 - "Character width of margin used for marginalized headers. -The default value is based on there being six heading levels -defined by Markdown and HTML. Increasing this produces extra -whitespace on the left. Decreasing it may be preferred when -fewer than six nested heading levels are used." - :group 'markdown - :type 'integer - :safe 'natnump - :package-version '(markdown-mode . "2.4")) - -(defcustom markdown-asymmetric-header nil - "Determines if atx header style will be asymmetric. -Set to a non-nil value to use asymmetric header styling, placing -header markup only at the beginning of the line. By default, -balanced markup will be inserted at the beginning and end of the -line around the header title." - :group 'markdown - :type 'boolean) - -(defcustom markdown-indent-function 'markdown-indent-line - "Function to use to indent." - :group 'markdown - :type 'function) - -(defcustom markdown-indent-on-enter t - "Determines indentation behavior when pressing \\[newline]. -Possible settings are nil, t, and \\='indent-and-new-item. - -When non-nil, pressing \\[newline] will call `newline-and-indent' -to indent the following line according to the context using -`markdown-indent-function'. In this case, note that -\\[electric-newline-and-maybe-indent] can still be used to insert -a newline without indentation. - -When set to \\='indent-and-new-item and the point is in a list item -when \\[newline] is pressed, the list will be continued on the next -line, where a new item will be inserted. - -When set to nil, simply call `newline' as usual. In this case, -you can still indent lines using \\[markdown-cycle] and continue -lists with \\[markdown-insert-list-item]. - -Note that this assumes the variable `electric-indent-mode' is -non-nil (enabled). When it is *disabled*, the behavior of -\\[newline] and `\\[electric-newline-and-maybe-indent]' are -reversed." - :group 'markdown - :type '(choice (const :tag "Don't automatically indent" nil) - (const :tag "Automatically indent" t) - (const :tag "Automatically indent and insert new list items" indent-and-new-item))) - -(defcustom markdown-enable-wiki-links nil - "Syntax highlighting for wiki links. -Set this to a non-nil value to turn on wiki link support by default. -Support can be toggled later using the `markdown-toggle-wiki-links' -function or \\[markdown-toggle-wiki-links]." - :group 'markdown - :type 'boolean - :safe 'booleanp - :package-version '(markdown-mode . "2.2")) - -(defcustom markdown-wiki-link-alias-first t - "When non-nil, treat aliased wiki links like [[alias text|PageName]]. -Otherwise, they will be treated as [[PageName|alias text]]." - :group 'markdown - :type 'boolean - :safe 'booleanp) - -(defcustom markdown-wiki-link-search-subdirectories nil - "When non-nil, search for wiki link targets in subdirectories. -This is the default search behavior for GitHub and is -automatically set to t in `gfm-mode'." - :group 'markdown - :type 'boolean - :safe 'booleanp - :package-version '(markdown-mode . "2.2")) - -(defcustom markdown-wiki-link-search-parent-directories nil - "When non-nil, search for wiki link targets in parent directories. -This is the default search behavior of Ikiwiki." - :group 'markdown - :type 'boolean - :safe 'booleanp - :package-version '(markdown-mode . "2.2")) - -(defcustom markdown-wiki-link-search-type nil - "Searching type for markdown wiki link. - -sub-directories: search for wiki link targets in sub directories -parent-directories: search for wiki link targets in parent directories -project: search for wiki link targets under project root" - :group 'markdown - :type '(set - (const :tag "search wiki link from subdirectories" sub-directories) - (const :tag "search wiki link from parent directories" parent-directories) - (const :tag "search wiki link under project root" project)) - :package-version '(markdown-mode . "2.5")) - -(make-obsolete-variable 'markdown-wiki-link-search-subdirectories 'markdown-wiki-link-search-type "2.5") -(make-obsolete-variable 'markdown-wiki-link-search-parent-directories 'markdown-wiki-link-search-type "2.5") - -(defcustom markdown-wiki-link-fontify-missing nil - "When non-nil, change wiki link face according to existence of target files. -This is expensive because it requires checking for the file each time the buffer -changes or the user switches windows. It is disabled by default because it may -cause lag when typing on slower machines." - :group 'markdown - :type 'boolean - :safe 'booleanp - :package-version '(markdown-mode . "2.2")) - -(defcustom markdown-uri-types - '("acap" "cid" "data" "dav" "fax" "file" "ftp" - "geo" "gopher" "http" "https" "imap" "ldap" "mailto" - "mid" "message" "modem" "news" "nfs" "nntp" - "pop" "prospero" "rtsp" "service" "sip" "tel" - "telnet" "tip" "urn" "vemmi" "wais") - "Link types for syntax highlighting of URIs." - :group 'markdown - :type '(repeat (string :tag "URI scheme"))) - -(defcustom markdown-url-compose-char - '(?∞ ?… ?⋯ ?# ?★ ?⚓) - "Placeholder character for hidden URLs. -This may be a single character or a list of characters. In case -of a list, the first one that satisfies `char-displayable-p' will -be used." - :type '(choice - (character :tag "Single URL replacement character") - (repeat :tag "List of possible URL replacement characters" - character)) - :package-version '(markdown-mode . "2.3")) - -(defcustom markdown-blockquote-display-char - '("▌" "┃" ">") - "String to display when hiding blockquote markup. -This may be a single string or a list of string. In case of a -list, the first one that satisfies `char-displayable-p' will be -used." - :type '(choice - (string :tag "Single blockquote display string") - (repeat :tag "List of possible blockquote display strings" string)) - :package-version '(markdown-mode . "2.3")) - -(defcustom markdown-hr-display-char - '(?─ ?━ ?-) - "Character for hiding horizontal rule markup. -This may be a single character or a list of characters. In case -of a list, the first one that satisfies `char-displayable-p' will -be used." - :group 'markdown - :type '(choice - (character :tag "Single HR display character") - (repeat :tag "List of possible HR display characters" character)) - :package-version '(markdown-mode . "2.3")) - -(defcustom markdown-definition-display-char - '(?⁘ ?⁙ ?≡ ?⌑ ?◊ ?:) - "Character for replacing definition list markup. -This may be a single character or a list of characters. In case -of a list, the first one that satisfies `char-displayable-p' will -be used." - :type '(choice - (character :tag "Single definition list character") - (repeat :tag "List of possible definition list characters" character)) - :package-version '(markdown-mode . "2.3")) - -(defcustom markdown-enable-math nil - "Syntax highlighting for inline LaTeX and itex expressions. -Set this to a non-nil value to turn on math support by default. -Math support can be enabled, disabled, or toggled later using -`markdown-toggle-math' or \\[markdown-toggle-math]." - :group 'markdown - :type 'boolean - :safe 'booleanp) -(make-variable-buffer-local 'markdown-enable-math) - -(defcustom markdown-enable-html t - "Enable font-lock support for HTML tags and attributes." - :group 'markdown - :type 'boolean - :safe 'booleanp - :package-version '(markdown-mode . "2.4")) - -(defcustom markdown-enable-highlighting-syntax nil - "Enable highlighting syntax." - :group 'markdown - :type 'boolean - :safe 'booleanp - :package-version '(markdown-mode . "2.5")) - -(defcustom markdown-css-paths nil - "List of URLs of CSS files to link to in the output XHTML." - :group 'markdown - :type '(repeat (string :tag "CSS File Path"))) - -(defcustom markdown-content-type "text/html" - "Content type string for the http-equiv header in XHTML output. -When set to an empty string, this attribute is omitted. Defaults to -`text/html'." - :group 'markdown - :type 'string) - -(defcustom markdown-coding-system nil - "Character set string for the http-equiv header in XHTML output. -Defaults to `buffer-file-coding-system' (and falling back to -`utf-8' when not available). Common settings are `iso-8859-1' -and `iso-latin-1'. Use `list-coding-systems' for more choices." - :group 'markdown - :type 'coding-system) - -(defcustom markdown-export-kill-buffer t - "Kill output buffer after HTML export. -When non-nil, kill the HTML output buffer after -exporting with `markdown-export'." - :group 'markdown - :type 'boolean - :safe 'booleanp - :package-version '(markdown-mode . "2.4")) - -(defcustom markdown-xhtml-header-content "" - "Additional content to include in the XHTML <head> block." - :group 'markdown - :type 'string) - -(defcustom markdown-xhtml-body-preamble "" - "Content to include in the XHTML <body> block, before the output." - :group 'markdown - :type 'string - :safe 'stringp - :package-version '(markdown-mode . "2.4")) - -(defcustom markdown-xhtml-body-epilogue "" - "Content to include in the XHTML <body> block, after the output." - :group 'markdown - :type 'string - :safe 'stringp - :package-version '(markdown-mode . "2.4")) - -(defcustom markdown-xhtml-standalone-regexp - "^\\(<\\?xml\\|<!DOCTYPE\\|<html\\)" - "Regexp indicating whether `markdown-command' output is standalone XHTML." - :group 'markdown - :type 'regexp) - -(defcustom markdown-link-space-sub-char "_" - "Character to use instead of spaces when mapping wiki links to filenames." - :group 'markdown - :type 'string) - -(defcustom markdown-reference-location 'header - "Position where new reference definitions are inserted in the document." - :group 'markdown - :type '(choice (const :tag "At the end of the document" end) - (const :tag "Immediately after the current block" immediately) - (const :tag "At the end of the subtree" subtree) - (const :tag "Before next header" header))) - -(defcustom markdown-footnote-location 'end - "Position where new footnotes are inserted in the document." - :group 'markdown - :type '(choice (const :tag "At the end of the document" end) - (const :tag "Immediately after the current block" immediately) - (const :tag "At the end of the subtree" subtree) - (const :tag "Before next header" header))) - -(defcustom markdown-footnote-display '((raise 0.2) (height 0.8)) - "Display specification for footnote markers and inline footnotes. -By default, footnote text is reduced in size and raised. Set to -nil to disable this." - :group 'markdown - :type '(choice (sexp :tag "Display specification") - (const :tag "Don't set display property" nil)) - :package-version '(markdown-mode . "2.4")) - -(defcustom markdown-sub-superscript-display - '(((raise -0.3) (height 0.7)) . ((raise 0.3) (height 0.7))) - "Display specification for subscript and superscripts. -The car is used for subscript, the cdr is used for superscripts." - :group 'markdown - :type '(cons (choice (sexp :tag "Subscript form") - (const :tag "No lowering" nil)) - (choice (sexp :tag "Superscript form") - (const :tag "No raising" nil))) - :package-version '(markdown-mode . "2.4")) - -(defcustom markdown-unordered-list-item-prefix " * " - "String inserted before unordered list items." - :group 'markdown - :type 'string) - -(defcustom markdown-ordered-list-enumeration t - "When non-nil, use enumerated numbers(1. 2. 3. etc.) for ordered list marker. -While nil, always uses '1.' for the marker" - :group 'markdown - :type 'boolean - :package-version '(markdown-mode . "2.5")) - -(defcustom markdown-nested-imenu-heading-index t - "Use nested or flat imenu heading index. -A nested index may provide more natural browsing from the menu, -but a flat list may allow for faster keyboard navigation via tab -completion." - :group 'markdown - :type 'boolean - :safe 'booleanp - :package-version '(markdown-mode . "2.2")) - -(defcustom markdown-add-footnotes-to-imenu t - "Add footnotes to end of imenu heading index." - :group 'markdown - :type 'boolean - :safe 'booleanp - :package-version '(markdown-mode . "2.4")) - -(defcustom markdown-make-gfm-checkboxes-buttons t - "When non-nil, make GFM checkboxes into buttons." - :group 'markdown - :type 'boolean) - -(defcustom markdown-use-pandoc-style-yaml-metadata nil - "When non-nil, allow YAML metadata anywhere in the document." - :group 'markdown - :type 'boolean) - -(defcustom markdown-split-window-direction 'any - "Preference for splitting windows for static and live preview. -The default value is \\='any, which instructs Emacs to use -`split-window-sensibly' to automatically choose how to split -windows based on the values of `split-width-threshold' and -`split-height-threshold' and the available windows. To force -vertically split (left and right) windows, set this to \\='vertical -or \\='right. To force horizontally split (top and bottom) windows, -set this to \\='horizontal or \\='below. - -If this value is \\='any and `display-buffer-alist' is set then -`display-buffer' is used for open buffer function" - :group 'markdown - :type '(choice (const :tag "Automatic" any) - (const :tag "Right (vertical)" right) - (const :tag "Below (horizontal)" below)) - :package-version '(markdown-mode . "2.2")) - -(defcustom markdown-live-preview-window-function - #'markdown-live-preview-window-eww - "Function to display preview of Markdown output within Emacs. -Function must update the buffer containing the preview and return -the buffer." - :group 'markdown - :type 'function) - -(defcustom markdown-live-preview-delete-export 'delete-on-destroy - "Delete exported HTML file when using `markdown-live-preview-export'. -If set to \\='delete-on-export, delete on every export. When set to -\\='delete-on-destroy delete when quitting from command -`markdown-live-preview-mode'. Never delete if set to nil." - :group 'markdown - :type '(choice - (const :tag "Delete on every export" delete-on-export) - (const :tag "Delete when quitting live preview" delete-on-destroy) - (const :tag "Never delete" nil))) - -(defcustom markdown-list-indent-width 4 - "Depth of indentation for markdown lists. -Used in `markdown-demote-list-item' and -`markdown-promote-list-item'." - :group 'markdown - :type 'integer) - -(defcustom markdown-enable-prefix-prompts t - "Display prompts for certain prefix commands. -Set to nil to disable these prompts." - :group 'markdown - :type 'boolean - :safe 'booleanp - :package-version '(markdown-mode . "2.3")) - -(defcustom markdown-gfm-additional-languages nil - "Extra languages made available when inserting GFM code blocks. -Language strings must have be trimmed of whitespace and not -contain any curly braces. They may be of arbitrary -capitalization, though." - :group 'markdown - :type '(repeat (string :validate markdown-validate-language-string))) - -(defcustom markdown-gfm-use-electric-backquote t - "Use `markdown-electric-backquote' when backquote is hit three times." - :group 'markdown - :type 'boolean) - -(defcustom markdown-gfm-downcase-languages t - "If non-nil, downcase suggested languages. -This applies to insertions done with -`markdown-electric-backquote'." - :group 'markdown - :type 'boolean) - -(defcustom markdown-edit-code-block-default-mode 'normal-mode - "Default mode to use for editing code blocks. -This mode is used when automatic detection fails, such as for GFM -code blocks with no language specified." - :group 'markdown - :type '(choice function (const :tag "None" nil)) - :package-version '(markdown-mode . "2.4")) - -(defcustom markdown-gfm-uppercase-checkbox nil - "If non-nil, use [X] for completed checkboxes, [x] otherwise." - :group 'markdown - :type 'boolean - :safe 'booleanp) - -(defcustom markdown-hide-urls nil - "Hide URLs of inline links and reference tags of reference links. -Such URLs will be replaced by a single customizable -character, defined by `markdown-url-compose-char', but are still part -of the buffer. Links can be edited interactively with -\\[markdown-insert-link] or, for example, by deleting the final -parenthesis to remove the invisibility property. You can also -hover your mouse pointer over the link text to see the URL. -Set this to a non-nil value to turn this feature on by default. -You can interactively set the value of this variable by calling -`markdown-toggle-url-hiding', pressing \\[markdown-toggle-url-hiding], -or from the menu Markdown > Links & Images menu." - :group 'markdown - :type 'boolean - :safe 'booleanp - :package-version '(markdown-mode . "2.3")) -(make-variable-buffer-local 'markdown-hide-urls) - -(defcustom markdown-translate-filename-function #'identity - "Function to use to translate filenames when following links. -\\<markdown-mode-map>\\[markdown-follow-thing-at-point] and \\[markdown-follow-link-at-point] -call this function with the filename as only argument whenever -they encounter a filename (instead of a URL) to be visited and -use its return value instead of the filename in the link. For -example, if absolute filenames are actually relative to a server -root directory, you can set -`markdown-translate-filename-function' to a function that -prepends the root directory to the given filename." - :group 'markdown - :type 'function - :risky t - :package-version '(markdown-mode . "2.4")) - -(defcustom markdown-max-image-size nil - "Maximum width and height for displayed inline images. -This variable may be nil or a cons cell (MAX-WIDTH . MAX-HEIGHT). -When nil, use the actual size. Otherwise, use ImageMagick to -resize larger images to be of the given maximum dimensions. This -requires Emacs to be built with ImageMagick support." - :group 'markdown - :package-version '(markdown-mode . "2.4") - :type '(choice - (const :tag "Use actual image width" nil) - (cons (choice (sexp :tag "Maximum width in pixels") - (const :tag "No maximum width" nil)) - (choice (sexp :tag "Maximum height in pixels") - (const :tag "No maximum height" nil))))) - -(defcustom markdown-mouse-follow-link t - "Non-nil means mouse on a link will follow the link. -This variable must be set before loading markdown-mode." - :group 'markdown - :type 'boolean - :safe 'booleanp - :package-version '(markdown-mode . "2.5")) - -(defcustom markdown-table-align-p t - "Non-nil means that table is aligned after table operation." - :group 'markdown - :type 'boolean - :safe 'booleanp - :package-version '(markdown-mode . "2.5")) - -(defcustom markdown-fontify-whole-heading-line nil - "Non-nil means fontify the whole line for headings. -This is useful when setting a background color for the -markdown-header-face-* faces." - :group 'markdown - :type 'boolean - :safe 'booleanp - :package-version '(markdown-mode . "2.5")) - -(defcustom markdown-special-ctrl-a/e nil - "Non-nil means `C-a' and `C-e' behave specially in headlines and items. - -When t, `C-a' will bring back the cursor to the beginning of the -headline text. In an item, this will be the position after bullet -and check-box, if any. When the cursor is already at that -position, another `C-a' will bring it to the beginning of the -line. - -`C-e' will jump to the end of the headline, ignoring the presence -of closing tags in the headline. A second `C-e' will then jump to -the true end of the line, after closing tags. This also means -that, when this variable is non-nil, `C-e' also will never jump -beyond the end of the heading of a folded section, i.e. not after -the ellipses. - -When set to the symbol `reversed', the first `C-a' or `C-e' works -normally, going to the true line boundary first. Only a directly -following, identical keypress will bring the cursor to the -special positions. - -This may also be a cons cell where the behavior for `C-a' and -`C-e' is set separately." - :group 'markdown - :type '(choice - (const :tag "off" nil) - (const :tag "on: after hashes/bullet and before closing tags first" t) - (const :tag "reversed: true line boundary first" reversed) - (cons :tag "Set C-a and C-e separately" - (choice :tag "Special C-a" - (const :tag "off" nil) - (const :tag "on: after hashes/bullet first" t) - (const :tag "reversed: before hashes/bullet first" reversed)) - (choice :tag "Special C-e" - (const :tag "off" nil) - (const :tag "on: before closing tags first" t) - (const :tag "reversed: after closing tags first" reversed)))) - :package-version '(markdown-mode . "2.7")) - -;;; Markdown-Specific `rx' Macro ============================================== - -;; Based on python-rx from python.el. -(eval-and-compile - (defconst markdown-rx-constituents - `((newline . ,(rx "\n")) - ;; Note: #405 not consider markdown-list-indent-width however this is never used - (indent . ,(rx (or (repeat 4 " ") "\t"))) - (block-end . ,(rx (and (or (one-or-more (zero-or-more blank) "\n") line-end)))) - (numeral . ,(rx (and (one-or-more (any "0-9#")) "."))) - (bullet . ,(rx (any "*+:-"))) - (list-marker . ,(rx (or (and (one-or-more (any "0-9#")) ".") - (any "*+:-")))) - (checkbox . ,(rx "[" (any " xX") "]"))) - "Markdown-specific sexps for `markdown-rx'") - - (defun markdown-rx-to-string (form &optional no-group) - "Markdown mode specialized `rx-to-string' function. -This variant supports named Markdown expressions in FORM. -NO-GROUP non-nil means don't put shy groups around the result." - (let ((rx-constituents (append markdown-rx-constituents rx-constituents))) - (rx-to-string form no-group))) - - (defmacro markdown-rx (&rest regexps) - "Markdown mode specialized rx macro. -This variant of `rx' supports common Markdown named REGEXPS." - (cond ((null regexps) - (error "No regexp")) - ((cdr regexps) - (markdown-rx-to-string `(and ,@regexps) t)) - (t - (markdown-rx-to-string (car regexps) t))))) - - -;;; Regular Expressions ======================================================= - -(defconst markdown-regex-comment-start - "<!--" - "Regular expression matches HTML comment opening.") - -(defconst markdown-regex-comment-end - "--[ \t]*>" - "Regular expression matches HTML comment closing.") - -(defconst markdown-regex-link-inline - "\\(?1:!\\)?\\(?2:\\[\\)\\(?3:\\^?\\(?:\\\\\\]\\|[^]]\\)*\\|\\)\\(?4:\\]\\)\\(?5:(\\)\\s-*\\(?6:[^)]*?\\)\\(?:\\s-+\\(?7:\"[^\"]*\"\\)\\)?\\s-*\\(?8:)\\)" - "Regular expression for a [text](file) or an image link ![text](file). -Group 1 matches the leading exclamation point (optional). -Group 2 matches the opening square bracket. -Group 3 matches the text inside the square brackets. -Group 4 matches the closing square bracket. -Group 5 matches the opening parenthesis. -Group 6 matches the URL. -Group 7 matches the title (optional). -Group 8 matches the closing parenthesis.") - -(defconst markdown-regex-link-reference - "\\(?1:!\\)?\\(?2:\\[\\)\\(?3:[^]^][^]]*\\|\\)\\(?4:\\]\\)\\(?5:\\[\\)\\(?6:[^]]*?\\)\\(?7:\\]\\)" - "Regular expression for a reference link [text][id]. -Group 1 matches the leading exclamation point (optional). -Group 2 matches the opening square bracket for the link text. -Group 3 matches the text inside the square brackets. -Group 4 matches the closing square bracket for the link text. -Group 5 matches the opening square bracket for the reference label. -Group 6 matches the reference label. -Group 7 matches the closing square bracket for the reference label.") - -(defconst markdown-regex-reference-definition - "^ \\{0,3\\}\\(?1:\\[\\)\\(?2:[^]\n]+?\\)\\(?3:\\]\\)\\(?4::\\)\\s *\\(?5:.*?\\)\\s *\\(?6: \"[^\"]*\"$\\|$\\)" - "Regular expression for a reference definition. -Group 1 matches the opening square bracket. -Group 2 matches the reference label. -Group 3 matches the closing square bracket. -Group 4 matches the colon. -Group 5 matches the URL. -Group 6 matches the title attribute (optional).") - -(defconst markdown-regex-footnote - "\\(?1:\\[\\^\\)\\(?2:.+?\\)\\(?3:\\]\\)" - "Regular expression for a footnote marker [^fn]. -Group 1 matches the opening square bracket and carat. -Group 2 matches only the label, without the surrounding markup. -Group 3 matches the closing square bracket.") - -(defconst markdown-regex-header - "^\\(?:\\(?1:[^\r\n\t -].*\\)\n\\(?:\\(?2:=+\\)\\|\\(?3:-+\\)\\)\\|\\(?4:#+[ \t]+\\)\\(?5:.*?\\)\\(?6:[ \t]+#+\\)?\\)$" - "Regexp identifying Markdown headings. -Group 1 matches the text of a setext heading. -Group 2 matches the underline of a level-1 setext heading. -Group 3 matches the underline of a level-2 setext heading. -Group 4 matches the opening hash marks of an atx heading and whitespace. -Group 5 matches the text, without surrounding whitespace, of an atx heading. -Group 6 matches the closing whitespace and hash marks of an atx heading.") - -(defconst markdown-regex-header-setext - "^\\([^\r\n\t -].*\\)\n\\(=+\\|-+\\)$" - "Regular expression for generic setext-style (underline) headers.") - -(defconst markdown-regex-header-atx - "^\\(#+\\)[ \t]+\\(.*?\\)[ \t]*\\(#*\\)$" - "Regular expression for generic atx-style (hash mark) headers.") - -(defconst markdown-regex-hr - (rx line-start - (group (or (and (repeat 3 (and "*" (? " "))) (* (any "* "))) - (and (repeat 3 (and "-" (? " "))) (* (any "- "))) - (and (repeat 3 (and "_" (? " "))) (* (any "_ "))))) - line-end) - "Regular expression for matching Markdown horizontal rules.") - -(defconst markdown-regex-code - "\\(?:\\`\\|[^\\]\\)\\(?1:\\(?2:`+\\)\\(?3:\\(?:.\\|\n[^\n]\\)*?[^`]\\)\\(?4:\\2\\)\\)\\(?:[^`]\\|\\'\\)" - "Regular expression for matching inline code fragments. - -Group 1 matches the entire code fragment including the backquotes. -Group 2 matches the opening backquotes. -Group 3 matches the code fragment itself, without backquotes. -Group 4 matches the closing backquotes. - -The leading, unnumbered group ensures that the leading backquote -character is not escaped. -The last group, also unnumbered, requires that the character -following the code fragment is not a backquote. -Note that \\(?:.\\|\n[^\n]\\) matches any character, including newlines, -but not two newlines in a row.") - -(defconst markdown-regex-kbd - "\\(?1:<kbd>\\)\\(?2:\\(?:.\\|\n[^\n]\\)*?\\)\\(?3:</kbd>\\)" - "Regular expression for matching <kbd> tags. -Groups 1 and 3 match the opening and closing tags. -Group 2 matches the key sequence.") - -(defconst markdown-regex-gfm-code-block-open - "^[[:blank:]]*\\(?1:```\\)\\(?2:[[:blank:]]*{?[[:blank:]]*\\)\\(?3:[^`[:space:]]+?\\)?\\(?:[[:blank:]]+\\(?4:.+?\\)\\)?\\(?5:[[:blank:]]*}?[[:blank:]]*\\)$" - "Regular expression matching opening of GFM code blocks. -Group 1 matches the opening three backquotes and any following whitespace. -Group 2 matches the opening brace (optional) and surrounding whitespace. -Group 3 matches the language identifier (optional). -Group 4 matches the info string (optional). -Group 5 matches the closing brace (optional), whitespace, and newline. -Groups need to agree with `markdown-regex-tilde-fence-begin'.") - -(defconst markdown-regex-gfm-code-block-close - "^[[:blank:]]*\\(?1:```\\)\\(?2:\\s *?\\)$" - "Regular expression matching closing of GFM code blocks. -Group 1 matches the closing three backquotes. -Group 2 matches any whitespace and the final newline.") - -(defconst markdown-regex-pre - "^\\( \\|\t\\).*$" - "Regular expression for matching preformatted text sections.") - -(defconst markdown-regex-list - (markdown-rx line-start - ;; 1. Leading whitespace - (group (* blank)) - ;; 2. List marker: a numeral, bullet, or colon - (group list-marker) - ;; 3. Trailing whitespace - (group (+ blank)) - ;; 4. Optional checkbox for GFM task list items - (opt (group (and checkbox (* blank))))) - "Regular expression for matching list items.") - -(defconst markdown-regex-bold - "\\(?1:^\\|[^\\]\\)\\(?2:\\(?3:\\*\\*\\|__\\)\\(?4:[^ \n\t\\]\\|[^ \n\t]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?5:\\3\\)\\)" - "Regular expression for matching bold text. -Group 1 matches the character before the opening asterisk or -underscore, if any, ensuring that it is not a backslash escape. -Group 2 matches the entire expression, including delimiters. -Groups 3 and 5 matches the opening and closing delimiters. -Group 4 matches the text inside the delimiters.") - -(defconst markdown-regex-italic - "\\(?:^\\|[^\\]\\)\\(?1:\\(?2:[*_]\\)\\(?3:[^ \n\t\\]\\|[^ \n\t*]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?4:\\2\\)\\)" - "Regular expression for matching italic text. -The leading unnumbered matches the character before the opening -asterisk or underscore, if any, ensuring that it is not a -backslash escape. -Group 1 matches the entire expression, including delimiters. -Groups 2 and 4 matches the opening and closing delimiters. -Group 3 matches the text inside the delimiters.") - -(defconst markdown-regex-strike-through - "\\(?1:^\\|[^\\]\\)\\(?2:\\(?3:~~\\)\\(?4:[^ \n\t\\]\\|[^ \n\t]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?5:~~\\)\\)" - "Regular expression for matching strike-through text. -Group 1 matches the character before the opening tilde, if any, -ensuring that it is not a backslash escape. -Group 2 matches the entire expression, including delimiters. -Groups 3 and 5 matches the opening and closing delimiters. -Group 4 matches the text inside the delimiters.") - -(defconst markdown-regex-gfm-italic - "\\(?:^\\|[^\\]\\)\\(?1:\\(?2:[*_]\\)\\(?3:[^ \\]\\2\\|[^ ]\\(?:.\\|\n[^\n]\\)*?\\)\\(?4:\\2\\)\\)" - "Regular expression for matching italic text in GitHub Flavored Markdown. -Underscores in words are not treated as special. -Group 1 matches the entire expression, including delimiters. -Groups 2 and 4 matches the opening and closing delimiters. -Group 3 matches the text inside the delimiters.") - -(defconst markdown-regex-blockquote - "^[ \t]*\\(?1:[A-Z]?>\\)\\(?2:[ \t]*\\)\\(?3:.*\\)$" - "Regular expression for matching blockquote lines. -Also accounts for a potential capital letter preceding the angle -bracket, for use with Leanpub blocks (asides, warnings, info -blocks, etc.). -Group 1 matches the leading angle bracket. -Group 2 matches the separating whitespace. -Group 3 matches the text.") - -(defconst markdown-regex-line-break - "[^ \n\t][ \t]*\\( \\)\n" - "Regular expression for matching line breaks.") - -(defconst markdown-regex-escape - "\\(\\\\\\)." - "Regular expression for matching escape sequences.") - -(defconst markdown-regex-wiki-link - "\\(?:^\\|[^\\]\\)\\(?1:\\(?2:\\[\\[\\)\\(?3:[^]|]+\\)\\(?:\\(?4:|\\)\\(?5:[^]]+\\)\\)?\\(?6:\\]\\]\\)\\)" - "Regular expression for matching wiki links. -This matches typical bracketed [[WikiLinks]] as well as \\='aliased -wiki links of the form [[PageName|link text]]. -The meanings of the first and second components depend -on the value of `markdown-wiki-link-alias-first'. - -Group 1 matches the entire link. -Group 2 matches the opening square brackets. -Group 3 matches the first component of the wiki link. -Group 4 matches the pipe separator, when present. -Group 5 matches the second component of the wiki link, when present. -Group 6 matches the closing square brackets.") - -(defconst markdown-regex-uri - (concat "\\(" (regexp-opt markdown-uri-types) ":[^]\t\n\r<>; ]+\\)") - "Regular expression for matching inline URIs.") - -;; CommanMark specification says scheme length is 2-32 characters -(defconst markdown-regex-angle-uri - (concat "\\(<\\)\\([a-z][a-z0-9.+-]\\{1,31\\}:[^]\t\n\r<>,;()]+\\)\\(>\\)") - "Regular expression for matching inline URIs in angle brackets.") - -(defconst markdown-regex-email - "<\\(\\(?:\\sw\\|\\s_\\|\\s.\\)+@\\(?:\\sw\\|\\s_\\|\\s.\\)+\\)>" - "Regular expression for matching inline email addresses.") - -(defsubst markdown-make-regex-link-generic () - "Make regular expression for matching any recognized link." - (concat "\\(?:" markdown-regex-link-inline - (when markdown-enable-wiki-links - (concat "\\|" markdown-regex-wiki-link)) - "\\|" markdown-regex-link-reference - "\\|" markdown-regex-angle-uri "\\)")) - -(defconst markdown-regex-gfm-checkbox - " \\(\\[[ xX]\\]\\) " - "Regular expression for matching GFM checkboxes. -Group 1 matches the text to become a button.") - -(defconst markdown-regex-blank-line - "^[[:blank:]]*$" - "Regular expression that matches a blank line.") - -(defconst markdown-regex-block-separator - "\n[\n\t\f ]*\n" - "Regular expression for matching block boundaries.") - -(defconst markdown-regex-block-separator-noindent - (concat "\\(\\`\\|\\(" markdown-regex-block-separator "\\)[^\n\t\f ]\\)") - "Regexp for block separators before lines with no indentation.") - -(defconst markdown-regex-math-inline-single - "\\(?:^\\|[^\\]\\)\\(?1:\\$\\)\\(?2:\\(?:[^\\$]\\|\\\\.\\)*\\)\\(?3:\\$\\)" - "Regular expression for itex $..$ math mode expressions. -Groups 1 and 3 match the opening and closing dollar signs. -Group 2 matches the mathematical expression contained within.") - -(defconst markdown-regex-math-inline-double - "\\(?:^\\|[^\\]\\)\\(?1:\\$\\$\\)\\(?2:\\(?:[^\\$]\\|\\\\.\\)*\\)\\(?3:\\$\\$\\)" - "Regular expression for itex $$..$$ math mode expressions. -Groups 1 and 3 match opening and closing dollar signs. -Group 2 matches the mathematical expression contained within.") - -(defconst markdown-regex-math-display - (rx line-start (* blank) - (group (group (repeat 1 2 "\\")) "[") - (group (*? anything)) - (group (backref 2) "]") - line-end) - "Regular expression for \[..\] or \\[..\\] display math. -Groups 1 and 4 match the opening and closing markup. -Group 3 matches the mathematical expression contained within. -Group 2 matches the opening slashes, and is used internally to -match the closing slashes.") - -(defsubst markdown-make-tilde-fence-regex (num-tildes &optional end-of-line) - "Return regexp matching a tilde code fence at least NUM-TILDES long. -END-OF-LINE is the regexp construct to indicate end of line; $ if -missing." - (format "%s%d%s%s" "^[[:blank:]]*\\([~]\\{" num-tildes ",\\}\\)" - (or end-of-line "$"))) - -(defconst markdown-regex-tilde-fence-begin - (markdown-make-tilde-fence-regex - 3 "\\([[:blank:]]*{?\\)[[:blank:]]*\\([^[:space:]]+?\\)?\\(?:[[:blank:]]+\\(.+?\\)\\)?\\([[:blank:]]*}?[[:blank:]]*\\)$") - "Regular expression for matching tilde-fenced code blocks. -Group 1 matches the opening tildes. -Group 2 matches (optional) opening brace and surrounding whitespace. -Group 3 matches the language identifier (optional). -Group 4 matches the info string (optional). -Group 5 matches the closing brace (optional) and any surrounding whitespace. -Groups need to agree with `markdown-regex-gfm-code-block-open'.") - -(defconst markdown-regex-declarative-metadata - "^[ \t]*\\(?:-[ \t]*\\)?\\([[:alpha:]][[:alpha:] _-]*?\\)\\([:=][ \t]*\\)\\(.*\\)$" - "Regular expression for matching declarative metadata statements. -This matches MultiMarkdown metadata as well as YAML and TOML -assignments such as the following: - - variable: value - -or - - variable = value") - -(defconst markdown-regex-pandoc-metadata - "^\\(%\\)\\([ \t]*\\)\\(.*\\(?:\n[ \t]+.*\\)*\\)" - "Regular expression for matching Pandoc metadata.") - -(defconst markdown-regex-yaml-metadata-border - "\\(-\\{3\\}\\)$" - "Regular expression for matching YAML metadata.") - -(defconst markdown-regex-yaml-pandoc-metadata-end-border - "^\\(\\.\\{3\\}\\|\\-\\{3\\}\\)$" - "Regular expression for matching YAML metadata end borders.") - -(defsubst markdown-get-yaml-metadata-start-border () - "Return YAML metadata start border depending upon whether Pandoc is used." - (concat - (if markdown-use-pandoc-style-yaml-metadata "^" "\\`") - markdown-regex-yaml-metadata-border)) - -(defsubst markdown-get-yaml-metadata-end-border (_) - "Return YAML metadata end border depending upon whether Pandoc is used." - (if markdown-use-pandoc-style-yaml-metadata - markdown-regex-yaml-pandoc-metadata-end-border - markdown-regex-yaml-metadata-border)) - -(defconst markdown-regex-inline-attributes - "[ \t]*\\(?:{:?\\)[ \t]*\\(?:\\(?:#[[:alpha:]_.:-]+\\|\\.[[:alpha:]_.:-]+\\|\\w+=['\"]?[^\n'\"}]*['\"]?\\),?[ \t]*\\)+\\(?:}\\)[ \t]*$" - "Regular expression for matching inline identifiers or attribute lists. -Compatible with Pandoc, Python Markdown, PHP Markdown Extra, and Leanpub.") - -(defconst markdown-regex-leanpub-sections - (concat - "^\\({\\)\\(" - (regexp-opt '("frontmatter" "mainmatter" "backmatter" "appendix" "pagebreak")) - "\\)\\(}\\)[ \t]*\n") - "Regular expression for Leanpub section markers and related syntax.") - -(defconst markdown-regex-sub-superscript - "\\(?:^\\|[^\\~^]\\)\\(?1:\\(?2:[~^]\\)\\(?3:[+-\u2212]?[[:alnum:]]+\\)\\(?4:\\2\\)\\)" - "The regular expression matching a sub- or superscript. -The leading un-numbered group matches the character before the -opening tilde or carat, if any, ensuring that it is not a -backslash escape, carat, or tilde. -Group 1 matches the entire expression, including markup. -Group 2 matches the opening markup--a tilde or carat. -Group 3 matches the text inside the delimiters. -Group 4 matches the closing markup--a tilde or carat.") - -(defconst markdown-regex-include - "^\\(?1:<<\\)\\(?:\\(?2:\\[\\)\\(?3:.*\\)\\(?4:\\]\\)\\)?\\(?:\\(?5:(\\)\\(?6:.*\\)\\(?7:)\\)\\)?\\(?:\\(?8:{\\)\\(?9:.*\\)\\(?10:}\\)\\)?$" - "Regular expression matching common forms of include syntax. -Marked 2, Leanpub, and other processors support some of these forms: - -<<[sections/section1.md] -<<(folder/filename) -<<[Code title](folder/filename) -<<{folder/raw_file.html} - -Group 1 matches the opening two angle brackets. -Groups 2-4 match the opening square bracket, the text inside, -and the closing square bracket, respectively. -Groups 5-7 match the opening parenthesis, the text inside, and -the closing parenthesis. -Groups 8-10 match the opening brace, the text inside, and the brace.") - -(defconst markdown-regex-pandoc-inline-footnote - "\\(?1:\\^\\)\\(?2:\\[\\)\\(?3:\\(?:.\\|\n[^\n]\\)*?\\)\\(?4:\\]\\)" - "Regular expression for Pandoc inline footnote^[footnote text]. -Group 1 matches the opening caret. -Group 2 matches the opening square bracket. -Group 3 matches the footnote text, without the surrounding markup. -Group 4 matches the closing square bracket.") - -(defconst markdown-regex-html-attr - "\\(\\<[[:alpha:]:-]+\\>\\)\\(\\s-*\\(=\\)\\s-*\\(\".*?\"\\|'.*?'\\|[^'\">[:space:]]+\\)?\\)?" - "Regular expression for matching HTML attributes and values. -Group 1 matches the attribute name. -Group 2 matches the following whitespace, equals sign, and value, if any. -Group 3 matches the equals sign, if any. -Group 4 matches single-, double-, or un-quoted attribute values.") - -(defconst markdown-regex-html-tag - (concat "\\(</?\\)\\(\\w+\\)\\(\\(\\s-+" markdown-regex-html-attr - "\\)+\\s-*\\|\\s-*\\)\\(/?>\\)") - "Regular expression for matching HTML tags. -Groups 1 and 9 match the beginning and ending angle brackets and slashes. -Group 2 matches the tag name. -Group 3 matches all attributes and whitespace following the tag name.") - -(defconst markdown-regex-html-entity - "\\(&#?[[:alnum:]]+;\\)" - "Regular expression for matching HTML entities.") - -(defconst markdown-regex-highlighting - "\\(?1:^\\|[^\\]\\)\\(?2:\\(?3:==\\)\\(?4:[^ \n\t\\]\\|[^ \n\t]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?5:==\\)\\)" -"Regular expression for matching highlighting text. -Group 1 matches the character before the opening equal, if any, -ensuring that it is not a backslash escape. -Group 2 matches the entire expression, including delimiters. -Groups 3 and 5 matches the opening and closing delimiters. -Group 4 matches the text inside the delimiters.") - - -;;; Syntax ==================================================================== - -(defvar markdown--syntax-properties - (list 'markdown-tilde-fence-begin nil - 'markdown-tilde-fence-end nil - 'markdown-fenced-code nil - 'markdown-yaml-metadata-begin nil - 'markdown-yaml-metadata-end nil - 'markdown-yaml-metadata-section nil - 'markdown-gfm-block-begin nil - 'markdown-gfm-block-end nil - 'markdown-gfm-code nil - 'markdown-list-item nil - 'markdown-pre nil - 'markdown-blockquote nil - 'markdown-hr nil - 'markdown-comment nil - 'markdown-heading nil - 'markdown-heading-1-setext nil - 'markdown-heading-2-setext nil - 'markdown-heading-1-atx nil - 'markdown-heading-2-atx nil - 'markdown-heading-3-atx nil - 'markdown-heading-4-atx nil - 'markdown-heading-5-atx nil - 'markdown-heading-6-atx nil - 'markdown-metadata-key nil - 'markdown-metadata-value nil - 'markdown-metadata-markup nil) - "Property list of all Markdown syntactic properties.") - -(defvar markdown-literal-faces - '(markdown-inline-code-face - markdown-pre-face - markdown-math-face - markdown-url-face - markdown-plain-url-face - markdown-language-keyword-face - markdown-language-info-face - markdown-metadata-key-face - markdown-metadata-value-face - markdown-html-entity-face - markdown-html-tag-name-face - markdown-html-tag-delimiter-face - markdown-html-attr-name-face - markdown-html-attr-value-face - markdown-reference-face - markdown-footnote-marker-face - markdown-line-break-face - markdown-comment-face) - "A list of markdown-mode faces that contain literal text. -Literal text treats backslashes literally, rather than as an -escape character (see `markdown-match-escape').") - -(defsubst markdown-in-comment-p (&optional pos) - "Return non-nil if POS is in a comment. -If POS is not given, use point instead." - (get-text-property (or pos (point)) 'markdown-comment)) - -(defun markdown--face-p (pos faces) - "Return non-nil if face of POS contain FACES." - (let ((face-prop (get-text-property pos 'face))) - (if (listp face-prop) - (cl-loop for face in face-prop - thereis (memq face faces)) - (memq face-prop faces)))) - -(defsubst markdown--math-block-p (&optional pos) - (when markdown-enable-math - (markdown--face-p (or pos (point)) '(markdown-math-face)))) - -(defun markdown-syntax-propertize-extend-region (start end) - "Extend START to END region to include an entire block of text. -This helps improve syntax analysis for block constructs. -Returns a cons (NEW-START . NEW-END) or nil if no adjustment should be made. -Function is called repeatedly until it returns nil. For details, see -`syntax-propertize-extend-region-functions'." - (save-match-data - (save-excursion - (let* ((new-start (progn (goto-char start) - (skip-chars-forward "\n") - (if (re-search-backward "\n\n" nil t) - (min start (match-end 0)) - (point-min)))) - (new-end (progn (goto-char end) - (skip-chars-backward "\n") - (if (re-search-forward "\n\n" nil t) - (max end (match-beginning 0)) - (point-max)))) - (code-match (markdown-code-block-at-pos new-start)) - ;; FIXME: The `code-match' can return bogus values - ;; when text has been inserted/deleted! - (new-start (min (or (and code-match (cl-first code-match)) - (point-max)) - new-start)) - (code-match (and (< end (point-max)) - (markdown-code-block-at-pos end))) - (new-end (max (or (and code-match (cl-second code-match)) 0) - new-end))) - - (unless (and (eq new-start start) (eq new-end end)) - (cons new-start (min new-end (point-max)))))))) - -(defun markdown-font-lock-extend-region-function (start end _) - "Used in `jit-lock-after-change-extend-region-functions'. -Delegates to `markdown-syntax-propertize-extend-region'. START -and END are the previous region to refontify." - (let ((res (markdown-syntax-propertize-extend-region start end))) - (when res - ;; syntax-propertize-function is not called when character at - ;; (point-max) is deleted, but font-lock-extend-region-functions - ;; are called. Force a syntax property update in that case. - (when (= end (point-max)) - ;; This function is called in a buffer modification hook. - ;; `markdown-syntax-propertize' doesn't save the match data, - ;; so we have to do it here. - (save-match-data - (markdown-syntax-propertize (car res) (cdr res)))) - (setq jit-lock-start (car res) - jit-lock-end (cdr res))))) - -(defun markdown--cur-list-item-bounds () - "Return a list describing the list item at point. -Assumes that match data is set for `markdown-regex-list'. See the -documentation for `markdown-cur-list-item-bounds' for the format of -the returned list." - (save-excursion - (let* ((begin (match-beginning 0)) - (indent (length (match-string-no-properties 1))) - (nonlist-indent (- (match-end 3) (match-beginning 0))) - (marker (buffer-substring-no-properties - (match-beginning 2) (match-end 3))) - (checkbox (match-string-no-properties 4)) - (match (butlast (match-data t))) - (end (markdown-cur-list-item-end nonlist-indent))) - (list begin end indent nonlist-indent marker checkbox match)))) - -(defun markdown--append-list-item-bounds (marker indent cur-bounds bounds) - "Update list item BOUNDS given list MARKER, block INDENT, and CUR-BOUNDS. -Here, MARKER is a string representing the type of list and INDENT -is an integer giving the indentation, in spaces, of the current -block. CUR-BOUNDS is a list of the form returned by -`markdown-cur-list-item-bounds' and BOUNDS is a list of bounds -values for parent list items. When BOUNDS is nil, it means we are -at baseline (not inside of a nested list)." - (let ((prev-indent (or (cl-third (car bounds)) 0))) - (cond - ;; New list item at baseline. - ((and marker (null bounds)) - (list cur-bounds)) - ;; List item with greater indentation (four or more spaces). - ;; Increase list level by consing CUR-BOUNDS onto BOUNDS. - ((and marker (>= indent (+ prev-indent markdown-list-indent-width))) - (cons cur-bounds bounds)) - ;; List item with greater or equal indentation (less than four spaces). - ;; Keep list level the same by replacing the car of BOUNDS. - ((and marker (>= indent prev-indent)) - (cons cur-bounds (cdr bounds))) - ;; Lesser indentation level. - ;; Pop appropriate number of elements off BOUNDS list (e.g., lesser - ;; indentation could move back more than one list level). Note - ;; that this block need not be the beginning of list item. - ((< indent prev-indent) - (while (and (> (length bounds) 1) - (setq prev-indent (cl-third (cadr bounds))) - (< indent (+ prev-indent markdown-list-indent-width))) - (setq bounds (cdr bounds))) - (cons cur-bounds bounds)) - ;; Otherwise, do nothing. - (t bounds)))) - -(defun markdown-syntax-propertize-list-items (start end) - "Propertize list items from START to END. -Stores nested list item information in the `markdown-list-item' -text property to make later syntax analysis easier. The value of -this property is a list with elements of the form (begin . end) -giving the bounds of the current and parent list items." - (save-excursion - (goto-char start) - (let ((prev-list-line -100) - bounds level pre-regexp) - ;; Find a baseline point with zero list indentation - (markdown-search-backward-baseline) - ;; Search for all list items between baseline and END - (while (and (< (point) end) - (re-search-forward markdown-regex-list end 'limit)) - ;; Level of list nesting - (setq level (length bounds)) - ;; Pre blocks need to be indented one level past the list level - (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" (1+ level))) - (beginning-of-line) - (cond - ;; Reset at headings, horizontal rules, and top-level blank lines. - ;; Propertize baseline when in range. - ((markdown-new-baseline) - (setq bounds nil)) - ;; Make sure this is not a line from a pre block - ((and (looking-at-p pre-regexp) - ;; too indented line is also treated as list if previous line is list - (>= (- (line-number-at-pos) prev-list-line) 2))) - ;; If not, then update levels and propertize list item when in range. - (t - (let* ((indent (current-indentation)) - (cur-bounds (markdown--cur-list-item-bounds)) - (first (cl-first cur-bounds)) - (last (cl-second cur-bounds)) - (marker (cl-fifth cur-bounds))) - (setq bounds (markdown--append-list-item-bounds - marker indent cur-bounds bounds)) - (when (and (<= start (point)) (<= (point) end)) - (setq prev-list-line (line-number-at-pos first)) - (put-text-property first last 'markdown-list-item bounds))))) - (end-of-line))))) - -(defun markdown-syntax-propertize-pre-blocks (start end) - "Match preformatted text blocks from START to END." - (save-excursion - (goto-char start) - (let (finish) - ;; Use loop for avoiding too many recursive calls - ;; https://github.com/jrblevin/markdown-mode/issues/512 - (while (not finish) - (let ((levels (markdown-calculate-list-levels)) - indent pre-regexp close-regexp open close) - (while (and (< (point) end) (not close)) - ;; Search for a region with sufficient indentation - (if (null levels) - (setq indent 1) - (setq indent (1+ (length levels)))) - (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" indent)) - (setq close-regexp (format "^\\( \\|\t\\)\\{0,%d\\}\\([^ \t]\\)" (1- indent))) - - (cond - ;; If not at the beginning of a line, move forward - ((not (bolp)) (forward-line)) - ;; Move past blank lines - ((markdown-cur-line-blank-p) (forward-line)) - ;; At headers and horizontal rules, reset levels - ((markdown-new-baseline) (forward-line) (setq levels nil)) - ;; If the current line has sufficient indentation, mark out pre block - ;; The opening should be preceded by a blank line. - ((and (markdown-prev-line-blank) (looking-at pre-regexp)) - (setq open (match-beginning 0)) - (while (and (or (looking-at-p pre-regexp) (markdown-cur-line-blank-p)) - (not (eobp))) - (forward-line)) - (skip-syntax-backward "-") - (forward-line) - (setq close (point))) - ;; If current line has a list marker, update levels, move to end of block - ((looking-at markdown-regex-list) - (setq levels (markdown-update-list-levels - (match-string 2) (current-indentation) levels)) - (markdown-end-of-text-block)) - ;; If this is the end of the indentation level, adjust levels accordingly. - ;; Only match end of indentation level if levels is not the empty list. - ((and (car levels) (looking-at-p close-regexp)) - (setq levels (markdown-update-list-levels - nil (current-indentation) levels)) - (markdown-end-of-text-block)) - (t (markdown-end-of-text-block)))) - - (if (and open close) - ;; Set text property data and continue to search - (put-text-property open close 'markdown-pre (list open close)) - (setq finish t)))) - nil))) - -(defconst markdown-fenced-block-pairs - `(((,markdown-regex-tilde-fence-begin markdown-tilde-fence-begin) - (markdown-make-tilde-fence-regex markdown-tilde-fence-end) - markdown-fenced-code) - ((markdown-get-yaml-metadata-start-border markdown-yaml-metadata-begin) - (markdown-get-yaml-metadata-end-border markdown-yaml-metadata-end) - markdown-yaml-metadata-section) - ((,markdown-regex-gfm-code-block-open markdown-gfm-block-begin) - (,markdown-regex-gfm-code-block-close markdown-gfm-block-end) - markdown-gfm-code)) - "Mapping of regular expressions to \"fenced-block\" constructs. -These constructs are distinguished by having a distinctive start -and end pattern, both of which take up an entire line of text, -but no special pattern to identify text within the fenced -blocks (unlike blockquotes and indented-code sections). - -Each element within this list takes the form: - - ((START-REGEX-OR-FUN START-PROPERTY) - (END-REGEX-OR-FUN END-PROPERTY) - MIDDLE-PROPERTY) - -Each *-REGEX-OR-FUN element can be a regular expression as a string, or a -function which evaluates to same. Functions for START-REGEX-OR-FUN accept no -arguments, but functions for END-REGEX-OR-FUN accept a single numerical argument -which is the length of the first group of the START-REGEX-OR-FUN match, which -can be ignored if unnecessary. `markdown-maybe-funcall-regexp' is used to -evaluate these into \"real\" regexps. - -The *-PROPERTY elements are the text properties applied to each part of the -block construct when it is matched using -`markdown-syntax-propertize-fenced-block-constructs'. START-PROPERTY is applied -to the text matching START-REGEX-OR-FUN, END-PROPERTY to END-REGEX-OR-FUN, and -MIDDLE-PROPERTY to the text in between the two. The value of *-PROPERTY is the -`match-data' when the regexp was matched to the text. In the case of -MIDDLE-PROPERTY, the value is a false match data of the form \\='(begin end), with -begin and end set to the edges of the \"middle\" text. This makes fontification -easier.") - -(defun markdown-text-property-at-point (prop) - (get-text-property (point) prop)) - -(defsubst markdown-maybe-funcall-regexp (object &optional arg) - (cond ((functionp object) - (if arg (funcall object arg) (funcall object))) - ((stringp object) object) - (t (error "Object cannot be turned into regex")))) - -(defsubst markdown-get-start-fence-regexp () - "Return regexp to find all \"start\" sections of fenced block constructs. -Which construct is actually contained in the match must be found separately." - (mapconcat - #'identity - (mapcar (lambda (entry) (markdown-maybe-funcall-regexp (caar entry))) - markdown-fenced-block-pairs) - "\\|")) - -(defun markdown-get-fenced-block-begin-properties () - (cl-mapcar (lambda (entry) (cl-cadar entry)) markdown-fenced-block-pairs)) - -(defun markdown-get-fenced-block-end-properties () - (cl-mapcar (lambda (entry) (cl-cadadr entry)) markdown-fenced-block-pairs)) - -(defun markdown-get-fenced-block-middle-properties () - (cl-mapcar #'cl-third markdown-fenced-block-pairs)) - -(defun markdown-find-previous-prop (prop &optional lim) - "Find previous place where property PROP is non-nil, up to LIM. -Return a cons of (pos . property). pos is point if point contains -non-nil PROP." - (let ((res - (if (get-text-property (point) prop) (point) - (previous-single-property-change - (point) prop nil (or lim (point-min)))))) - (when (and (not (get-text-property res prop)) - (> res (point-min)) - (get-text-property (1- res) prop)) - (cl-decf res)) - (when (and res (get-text-property res prop)) (cons res prop)))) - -(defun markdown-find-next-prop (prop &optional lim) - "Find next place where property PROP is non-nil, up to LIM. -Return a cons of (POS . PROPERTY) where POS is point if point -contains non-nil PROP." - (let ((res - (if (get-text-property (point) prop) (point) - (next-single-property-change - (point) prop nil (or lim (point-max)))))) - (when (and res (get-text-property res prop)) (cons res prop)))) - -(defun markdown-min-of-seq (map-fn seq) - "Apply MAP-FN to SEQ and return element of SEQ with minimum value of MAP-FN." - (cl-loop for el in seq - with min = 1.0e+INF ; infinity - with min-el = nil - do (let ((res (funcall map-fn el))) - (when (< res min) - (setq min res) - (setq min-el el))) - finally return min-el)) - -(defun markdown-max-of-seq (map-fn seq) - "Apply MAP-FN to SEQ and return element of SEQ with maximum value of MAP-FN." - (cl-loop for el in seq - with max = -1.0e+INF ; negative infinity - with max-el = nil - do (let ((res (funcall map-fn el))) - (when (and res (> res max)) - (setq max res) - (setq max-el el))) - finally return max-el)) - -(defun markdown-find-previous-block () - "Find previous block. -Detect whether `markdown-syntax-propertize-fenced-block-constructs' was -unable to propertize the entire block, but was able to propertize the beginning -of the block. If so, return a cons of (pos . property) where the beginning of -the block was propertized." - (let ((start-pt (point)) - (closest-open - (markdown-max-of-seq - #'car - (cl-remove-if - #'null - (cl-mapcar - #'markdown-find-previous-prop - (markdown-get-fenced-block-begin-properties)))))) - (when closest-open - (let* ((length-of-open-match - (let ((match-d - (get-text-property (car closest-open) (cdr closest-open)))) - (- (cl-fourth match-d) (cl-third match-d)))) - (end-regexp - (markdown-maybe-funcall-regexp - (cl-caadr - (cl-find-if - (lambda (entry) (eq (cl-cadar entry) (cdr closest-open))) - markdown-fenced-block-pairs)) - length-of-open-match)) - (end-prop-loc - (save-excursion - (save-match-data - (goto-char (car closest-open)) - (and (re-search-forward end-regexp start-pt t) - (match-beginning 0)))))) - (and (not end-prop-loc) closest-open))))) - -(defun markdown-get-fenced-block-from-start (prop) - "Return limits of an enclosing fenced block from its start, using PROP. -Return value is a list usable as `match-data'." - (catch 'no-rest-of-block - (let* ((correct-entry - (cl-find-if - (lambda (entry) (eq (cl-cadar entry) prop)) - markdown-fenced-block-pairs)) - (begin-of-begin (cl-first (markdown-text-property-at-point prop))) - (middle-prop (cl-third correct-entry)) - (end-prop (cl-cadadr correct-entry)) - (end-of-end - (save-excursion - (goto-char (match-end 0)) ; end of begin - (unless (eobp) (forward-char)) - (let ((mid-prop-v (markdown-text-property-at-point middle-prop))) - (if (not mid-prop-v) ; no middle - (progn - ;; try to find end by advancing one - (let ((end-prop-v - (markdown-text-property-at-point end-prop))) - (if end-prop-v (cl-second end-prop-v) - (throw 'no-rest-of-block nil)))) - (set-match-data mid-prop-v) - (goto-char (match-end 0)) ; end of middle - (beginning-of-line) ; into end - (cl-second (markdown-text-property-at-point end-prop))))))) - (list begin-of-begin end-of-end)))) - -(defun markdown-get-fenced-block-from-middle (prop) - "Return limits of an enclosing fenced block from its middle, using PROP. -Return value is a list usable as `match-data'." - (let* ((correct-entry - (cl-find-if - (lambda (entry) (eq (cl-third entry) prop)) - markdown-fenced-block-pairs)) - (begin-prop (cl-cadar correct-entry)) - (begin-of-begin - (save-excursion - (goto-char (match-beginning 0)) - (unless (bobp) (forward-line -1)) - (beginning-of-line) - (cl-first (markdown-text-property-at-point begin-prop)))) - (end-prop (cl-cadadr correct-entry)) - (end-of-end - (save-excursion - (goto-char (match-end 0)) - (beginning-of-line) - (cl-second (markdown-text-property-at-point end-prop))))) - (list begin-of-begin end-of-end))) - -(defun markdown-get-fenced-block-from-end (prop) - "Return limits of an enclosing fenced block from its end, using PROP. -Return value is a list usable as `match-data'." - (let* ((correct-entry - (cl-find-if - (lambda (entry) (eq (cl-cadadr entry) prop)) - markdown-fenced-block-pairs)) - (end-of-end (cl-second (markdown-text-property-at-point prop))) - (middle-prop (cl-third correct-entry)) - (begin-prop (cl-cadar correct-entry)) - (begin-of-begin - (save-excursion - (goto-char (match-beginning 0)) ; beginning of end - (unless (bobp) (backward-char)) ; into middle - (let ((mid-prop-v (markdown-text-property-at-point middle-prop))) - (if (not mid-prop-v) - (progn - (beginning-of-line) - (cl-first (markdown-text-property-at-point begin-prop))) - (set-match-data mid-prop-v) - (goto-char (match-beginning 0)) ; beginning of middle - (unless (bobp) (forward-line -1)) ; into beginning - (beginning-of-line) - (cl-first (markdown-text-property-at-point begin-prop))))))) - (list begin-of-begin end-of-end))) - -(defun markdown-get-enclosing-fenced-block-construct (&optional pos) - "Get \"fake\" match data for block enclosing POS. -Returns fake match data which encloses the start, middle, and end -of the block construct enclosing POS, if it exists. Used in -`markdown-code-block-at-pos'." - (save-excursion - (when pos (goto-char pos)) - (beginning-of-line) - (car - (cl-remove-if - #'null - (cl-mapcar - (lambda (fun-and-prop) - (cl-destructuring-bind (fun prop) fun-and-prop - (when prop - (save-match-data - (set-match-data (markdown-text-property-at-point prop)) - (funcall fun prop))))) - `((markdown-get-fenced-block-from-start - ,(cl-find-if - #'markdown-text-property-at-point - (markdown-get-fenced-block-begin-properties))) - (markdown-get-fenced-block-from-middle - ,(cl-find-if - #'markdown-text-property-at-point - (markdown-get-fenced-block-middle-properties))) - (markdown-get-fenced-block-from-end - ,(cl-find-if - #'markdown-text-property-at-point - (markdown-get-fenced-block-end-properties))))))))) - -(defun markdown-propertize-end-match (reg end fence-spec middle-begin) - "Get match for REG up to END, if exists, and propertize appropriately. -FENCE-SPEC is an entry in `markdown-fenced-block-pairs' and -MIDDLE-BEGIN is the start of the \"middle\" section of the block." - (when (re-search-forward reg end t) - (let ((close-begin (match-beginning 0)) ; Start of closing line. - (close-end (match-end 0)) ; End of closing line. - (close-data (match-data t))) ; Match data for closing line. - ;; Propertize middle section of fenced block. - (put-text-property middle-begin close-begin - (cl-third fence-spec) - (list middle-begin close-begin)) - ;; If the block is a YAML block, propertize the declarations inside - (when (< middle-begin close-begin) ;; workaround #634 - (markdown-syntax-propertize-yaml-metadata middle-begin close-begin)) - ;; Propertize closing line of fenced block. - (put-text-property close-begin close-end - (cl-cadadr fence-spec) close-data)))) - -(defun markdown--triple-quote-single-line-p (begin) - (save-excursion - (goto-char begin) - (save-match-data - (and (search-forward "```" nil t) - (search-forward "```" (line-end-position) t))))) - -(defun markdown-syntax-propertize-fenced-block-constructs (start end) - "Propertize according to `markdown-fenced-block-pairs' from START to END. -If unable to propertize an entire block (if the start of a block is within START -and END, but the end of the block is not), propertize the start section of a -block, then in a subsequent call propertize both middle and end by finding the -start which was previously propertized." - (let ((start-reg (markdown-get-start-fence-regexp))) - (save-excursion - (goto-char start) - ;; start from previous unclosed block, if exists - (let ((prev-begin-block (markdown-find-previous-block))) - (when prev-begin-block - (let* ((correct-entry - (cl-find-if (lambda (entry) - (eq (cdr prev-begin-block) (cl-cadar entry))) - markdown-fenced-block-pairs)) - (enclosed-text-start (1+ (car prev-begin-block))) - (start-length - (save-excursion - (goto-char (car prev-begin-block)) - (string-match - (markdown-maybe-funcall-regexp - (caar correct-entry)) - (buffer-substring - (line-beginning-position) (line-end-position))) - (- (match-end 1) (match-beginning 1)))) - (end-reg (markdown-maybe-funcall-regexp - (cl-caadr correct-entry) start-length))) - (markdown-propertize-end-match - end-reg end correct-entry enclosed-text-start)))) - ;; find all new blocks within region - (while (re-search-forward start-reg end t) - ;; we assume the opening constructs take up (only) an entire line, - ;; so we re-check the current line - (let* ((block-start (match-beginning 0)) - (cur-line (buffer-substring (line-beginning-position) (line-end-position))) - ;; find entry in `markdown-fenced-block-pairs' corresponding - ;; to regex which was matched - (correct-entry - (cl-find-if - (lambda (fenced-pair) - (string-match-p - (markdown-maybe-funcall-regexp (caar fenced-pair)) - cur-line)) - markdown-fenced-block-pairs)) - (enclosed-text-start - (save-excursion (1+ (line-end-position)))) - (end-reg - (markdown-maybe-funcall-regexp - (cl-caadr correct-entry) - (if (and (match-beginning 1) (match-end 1)) - (- (match-end 1) (match-beginning 1)) - 0))) - (prop (cl-cadar correct-entry))) - (when (or (not (eq prop 'markdown-gfm-block-begin)) - (not (markdown--triple-quote-single-line-p block-start))) - ;; get correct match data - (save-excursion - (beginning-of-line) - (re-search-forward - (markdown-maybe-funcall-regexp (caar correct-entry)) - (line-end-position))) - ;; mark starting, even if ending is outside of region - (put-text-property (match-beginning 0) (match-end 0) prop (match-data t)) - (markdown-propertize-end-match - end-reg end correct-entry enclosed-text-start))))))) - -(defun markdown-syntax-propertize-blockquotes (start end) - "Match blockquotes from START to END." - (save-excursion - (goto-char start) - (while (and (re-search-forward markdown-regex-blockquote end t) - (not (markdown-code-block-at-pos (match-beginning 0)))) - (put-text-property (match-beginning 0) (match-end 0) - 'markdown-blockquote - (match-data t))))) - -(defun markdown-syntax-propertize-hrs (start end) - "Match horizontal rules from START to END." - (save-excursion - (goto-char start) - (while (re-search-forward markdown-regex-hr end t) - (let ((beg (match-beginning 0)) - (end (match-end 0))) - (goto-char beg) - (unless (or (markdown-on-heading-p) - (markdown-code-block-at-point-p)) - (put-text-property beg end 'markdown-hr (match-data t))) - (goto-char end))))) - -(defun markdown-syntax-propertize-yaml-metadata (start end) - "Propertize elements inside YAML metadata blocks from START to END. -Assumes region from START and END is already known to be the interior -region of a YAML metadata block as propertized by -`markdown-syntax-propertize-fenced-block-constructs'." - (save-excursion - (goto-char start) - (cl-loop - while (re-search-forward markdown-regex-declarative-metadata end t) - do (progn - (put-text-property (match-beginning 1) (match-end 1) - 'markdown-metadata-key (match-data t)) - (put-text-property (match-beginning 2) (match-end 2) - 'markdown-metadata-markup (match-data t)) - (put-text-property (match-beginning 3) (match-end 3) - 'markdown-metadata-value (match-data t)))))) - -(defun markdown-syntax-propertize-headings (start end) - "Match headings of type SYMBOL with REGEX from START to END." - (goto-char start) - (while (re-search-forward markdown-regex-header end t) - (unless (markdown-code-block-at-pos (match-beginning 0)) - (put-text-property - (match-beginning 0) (match-end 0) 'markdown-heading - (match-data t)) - (put-text-property - (match-beginning 0) (match-end 0) - (cond ((match-string-no-properties 2) 'markdown-heading-1-setext) - ((match-string-no-properties 3) 'markdown-heading-2-setext) - (t (let ((atx-level (length (markdown-trim-whitespace - (match-string-no-properties 4))))) - (intern (format "markdown-heading-%d-atx" atx-level))))) - (match-data t))))) - -(defun markdown-syntax-propertize-comments (start end) - "Match HTML comments from the START to END." - ;; Implement by loop instead of recursive call for avoiding - ;; exceed max-lisp-eval-depth issue - ;; https://github.com/jrblevin/markdown-mode/issues/536 - (let (finish) - (goto-char start) - (while (not finish) - (let* ((in-comment (nth 4 (syntax-ppss))) - (comment-begin (nth 8 (syntax-ppss)))) - (cond - ;; Comment start - ((and (not in-comment) - (re-search-forward markdown-regex-comment-start end t) - (not (markdown-inline-code-at-point-p)) - (not (markdown-code-block-at-point-p))) - (let ((open-beg (match-beginning 0))) - (put-text-property open-beg (1+ open-beg) - 'syntax-table (string-to-syntax "<")) - (goto-char (min (1+ (match-end 0)) end (point-max))))) - ;; Comment end - ((and in-comment comment-begin - (re-search-forward markdown-regex-comment-end end t)) - (let ((comment-end (match-end 0))) - (put-text-property (1- comment-end) comment-end - 'syntax-table (string-to-syntax ">")) - ;; Remove any other text properties inside the comment - (remove-text-properties comment-begin comment-end - markdown--syntax-properties) - (put-text-property comment-begin comment-end - 'markdown-comment (list comment-begin comment-end)) - (goto-char (min comment-end end (point-max))))) - ;; Nothing found - (t (setq finish t))))) - nil)) - -(defun markdown-syntax-propertize (start end) - "Function used as `syntax-propertize-function'. -START and END delimit region to propertize." - (with-silent-modifications - (save-excursion - (remove-text-properties start end markdown--syntax-properties) - (markdown-syntax-propertize-fenced-block-constructs start end) - (markdown-syntax-propertize-list-items start end) - (markdown-syntax-propertize-pre-blocks start end) - (markdown-syntax-propertize-blockquotes start end) - (markdown-syntax-propertize-headings start end) - (markdown-syntax-propertize-hrs start end) - (markdown-syntax-propertize-comments start end)))) - - -;;; Markup Hiding ============================================================= - -(defconst markdown-markup-properties - '(face markdown-markup-face invisible markdown-markup) - "List of properties and values to apply to markup.") - -(defconst markdown-line-break-properties - '(face markdown-line-break-face invisible markdown-markup) - "List of properties and values to apply to line break markup.") - -(defconst markdown-language-keyword-properties - '(face markdown-language-keyword-face invisible markdown-markup) - "List of properties and values to apply to code block language names.") - -(defconst markdown-language-info-properties - '(face markdown-language-info-face invisible markdown-markup) - "List of properties and values to apply to code block language info strings.") - -(defconst markdown-include-title-properties - '(face markdown-link-title-face invisible markdown-markup) - "List of properties and values to apply to included code titles.") - -(defcustom markdown-hide-markup nil - "Determines whether markup in the buffer will be hidden. -When set to nil, all markup is displayed in the buffer as it -appears in the file. An exception is when `markdown-hide-urls' -is non-nil. -Set this to a non-nil value to turn this feature on by default. -You can interactively toggle the value of this variable with -`markdown-toggle-markup-hiding', \\[markdown-toggle-markup-hiding], -or from the Markdown > Show & Hide menu. - -Markup hiding works by adding text properties to positions in the -buffer---either the `invisible' property or the `display' property -in cases where alternative glyphs are used (e.g., list bullets). -This does not, however, affect printing or other output. -Functions such as `htmlfontify-buffer' and `ps-print-buffer' will -not honor these text properties. For printing, it would be better -to first convert to HTML or PDF (e.g,. using Pandoc)." - :group 'markdown - :type 'boolean - :safe 'booleanp - :package-version '(markdown-mode . "2.3")) -(make-variable-buffer-local 'markdown-hide-markup) - -(defun markdown-toggle-markup-hiding (&optional arg) - "Toggle the display or hiding of markup. -With a prefix argument ARG, enable markup hiding if ARG is positive, -and disable it otherwise. -See `markdown-hide-markup' for additional details." - (interactive (list (or current-prefix-arg 'toggle))) - (setq markdown-hide-markup - (if (eq arg 'toggle) - (not markdown-hide-markup) - (> (prefix-numeric-value arg) 0))) - (if markdown-hide-markup - (add-to-invisibility-spec 'markdown-markup) - (remove-from-invisibility-spec 'markdown-markup)) - (when (called-interactively-p 'interactive) - (message "markdown-mode markup hiding %s" (if markdown-hide-markup "enabled" "disabled"))) - (markdown-reload-extensions)) - - -;;; Font Lock ================================================================= - -(require 'font-lock) - -(defgroup markdown-faces nil - "Faces used in Markdown Mode." - :group 'markdown - :group 'faces) - -(defface markdown-italic-face - '((t (:inherit italic))) - "Face for italic text." - :group 'markdown-faces) - -(defface markdown-bold-face - '((t (:inherit bold))) - "Face for bold text." - :group 'markdown-faces) - -(defface markdown-strike-through-face - '((t (:strike-through t))) - "Face for strike-through text." - :group 'markdown-faces) - -(defface markdown-markup-face - '((t (:inherit shadow :slant normal :weight normal))) - "Face for markup elements." - :group 'markdown-faces) - -(defface markdown-header-rule-face - '((t (:inherit markdown-markup-face))) - "Base face for headers rules." - :group 'markdown-faces) - -(defface markdown-header-delimiter-face - '((t (:inherit markdown-markup-face))) - "Base face for headers hash delimiter." - :group 'markdown-faces) - -(defface markdown-list-face - '((t (:inherit markdown-markup-face))) - "Face for list item markers." - :group 'markdown-faces) - -(defface markdown-blockquote-face - '((t (:inherit font-lock-doc-face))) - "Face for blockquote sections." - :group 'markdown-faces) - -(defface markdown-code-face - '((t (:inherit fixed-pitch))) - "Face for inline code, pre blocks, and fenced code blocks. -This may be used, for example, to add a contrasting background to -inline code fragments and code blocks." - :group 'markdown-faces) - -(defface markdown-inline-code-face - '((t (:inherit (markdown-code-face font-lock-constant-face)))) - "Face for inline code." - :group 'markdown-faces) - -(defface markdown-pre-face - '((t (:inherit (markdown-code-face font-lock-constant-face)))) - "Face for preformatted text." - :group 'markdown-faces) - -(defface markdown-table-face - '((t (:inherit (markdown-code-face)))) - "Face for tables." - :group 'markdown-faces) - -(defface markdown-language-keyword-face - '((t (:inherit font-lock-type-face))) - "Face for programming language identifiers." - :group 'markdown-faces) - -(defface markdown-language-info-face - '((t (:inherit font-lock-string-face))) - "Face for programming language info strings." - :group 'markdown-faces) - -(defface markdown-link-face - '((t (:inherit link))) - "Face for links." - :group 'markdown-faces) - -(defface markdown-missing-link-face - '((t (:inherit font-lock-warning-face))) - "Face for missing links." - :group 'markdown-faces) - -(defface markdown-reference-face - '((t (:inherit markdown-markup-face))) - "Face for link references." - :group 'markdown-faces) - -(defface markdown-footnote-marker-face - '((t (:inherit markdown-markup-face))) - "Face for footnote markers." - :group 'markdown-faces) - -(defface markdown-footnote-text-face - '((t (:inherit font-lock-comment-face))) - "Face for footnote text." - :group 'markdown-faces) - -(defface markdown-url-face - '((t (:inherit font-lock-string-face))) - "Face for URLs that are part of markup. -For example, this applies to URLs in inline links: -[link text](http://example.com/)." - :group 'markdown-faces) - -(defface markdown-plain-url-face - '((t (:inherit markdown-link-face))) - "Face for URLs that are also links. -For example, this applies to plain angle bracket URLs: -<http://example.com/>." - :group 'markdown-faces) - -(defface markdown-link-title-face - '((t (:inherit font-lock-comment-face))) - "Face for reference link titles." - :group 'markdown-faces) - -(defface markdown-line-break-face - '((t (:inherit font-lock-constant-face :underline t))) - "Face for hard line breaks." - :group 'markdown-faces) - -(defface markdown-comment-face - '((t (:inherit font-lock-comment-face))) - "Face for HTML comments." - :group 'markdown-faces) - -(defface markdown-math-face - '((t (:inherit font-lock-string-face))) - "Face for LaTeX expressions." - :group 'markdown-faces) - -(defface markdown-metadata-key-face - '((t (:inherit font-lock-variable-name-face))) - "Face for metadata keys." - :group 'markdown-faces) - -(defface markdown-metadata-value-face - '((t (:inherit font-lock-string-face))) - "Face for metadata values." - :group 'markdown-faces) - -(defface markdown-gfm-checkbox-face - '((t (:inherit font-lock-builtin-face))) - "Face for GFM checkboxes." - :group 'markdown-faces) - -(defface markdown-highlight-face - '((t (:inherit highlight))) - "Face for mouse highlighting." - :group 'markdown-faces) - -(defface markdown-hr-face - '((t (:inherit markdown-markup-face))) - "Face for horizontal rules." - :group 'markdown-faces) - -(defface markdown-html-tag-name-face - '((t (:inherit font-lock-type-face))) - "Face for HTML tag names." - :group 'markdown-faces) - -(defface markdown-html-tag-delimiter-face - '((t (:inherit markdown-markup-face))) - "Face for HTML tag delimiters." - :group 'markdown-faces) - -(defface markdown-html-attr-name-face - '((t (:inherit font-lock-variable-name-face))) - "Face for HTML attribute names." - :group 'markdown-faces) - -(defface markdown-html-attr-value-face - '((t (:inherit font-lock-string-face))) - "Face for HTML attribute values." - :group 'markdown-faces) - -(defface markdown-html-entity-face - '((t (:inherit font-lock-variable-name-face))) - "Face for HTML entities." - :group 'markdown-faces) - -(defface markdown-highlighting-face - '((t (:background "yellow" :foreground "black"))) - "Face for highlighting." - :group 'markdown-faces) - -(defcustom markdown-header-scaling nil - "Whether to use variable-height faces for headers. -When non-nil, `markdown-header-face' will inherit from -`variable-pitch' and the scaling values in -`markdown-header-scaling-values' will be applied to -headers of levels one through six respectively." - :type 'boolean - :initialize #'custom-initialize-default - :set (lambda (symbol value) - (set-default symbol value) - (markdown-update-header-faces value)) - :group 'markdown-faces - :package-version '(markdown-mode . "2.2")) - -(defcustom markdown-header-scaling-values - '(2.0 1.7 1.4 1.1 1.0 1.0) - "List of scaling values for headers of level one through six. -Used when `markdown-header-scaling' is non-nil." - :type '(repeat float) - :initialize #'custom-initialize-default - :set (lambda (symbol value) - (set-default symbol value) - (markdown-update-header-faces markdown-header-scaling value))) - -(defmacro markdown--dotimes-when-compile (i-n body) - (declare (indent 1) (debug ((symbolp form) form))) - (let ((var (car i-n)) - (n (cadr i-n)) - (code ())) - (dotimes (i (eval n t)) - (push (eval body `((,var . ,i))) code)) - `(progn ,@(nreverse code)))) - -(defface markdown-header-face - `((t (:inherit (,@(when markdown-header-scaling '(variable-pitch)) - font-lock-function-name-face) - :weight bold))) - "Base face for headers.") - -(markdown--dotimes-when-compile (num 6) - (let* ((num1 (1+ num)) - (face-name (intern (format "markdown-header-face-%s" num1)))) - `(defface ,face-name - (,'\` ((t (:inherit markdown-header-face - :height - (,'\, (if markdown-header-scaling - (float (nth ,num markdown-header-scaling-values)) - 1.0)))))) - (format "Face for level %s headers. -You probably don't want to customize this face directly. Instead -you can customize the base face `markdown-header-face' or the -variable-height variable `markdown-header-scaling'." ,num1)))) - -(defun markdown-update-header-faces (&optional scaling scaling-values) - "Update header faces, depending on if header SCALING is desired. -If so, use given list of SCALING-VALUES relative to the baseline -size of `markdown-header-face'." - (dotimes (num 6) - (let* ((face-name (intern (format "markdown-header-face-%s" (1+ num)))) - (scale (cond ((not scaling) 1.0) - (scaling-values (float (nth num scaling-values))) - (t (float (nth num markdown-header-scaling-values)))))) - (unless (get face-name 'saved-face) ; Don't update customized faces - (set-face-attribute face-name nil :height scale))))) - -(defun markdown-syntactic-face (state) - "Return font-lock face for characters with given STATE. -See `font-lock-syntactic-face-function' for details." - (let ((in-comment (nth 4 state))) - (cond - (in-comment 'markdown-comment-face) - (t nil)))) - -(defcustom markdown-list-item-bullets - '("●" "◎" "○" "◆" "◇" "►" "•") - "List of bullets to use for unordered lists. -It can contain any number of symbols, which will be repeated. -Depending on your font, some reasonable choices are: -♥ ● ◇ ✚ ✜ ☯ ◆ ♠ ♣ ♦ ❀ ◆ ◖ ▶ ► • ★ ▸." - :group 'markdown - :type '(repeat (string :tag "Bullet character")) - :package-version '(markdown-mode . "2.3")) - -(defun markdown--footnote-marker-properties () - "Return a font-lock facespec expression for footnote marker text." - `(face markdown-footnote-marker-face - ,@(when markdown-hide-markup - `(display ,markdown-footnote-display)))) - -(defun markdown--pandoc-inline-footnote-properties () - "Return a font-lock facespec expression for Pandoc inline footnote text." - `(face markdown-footnote-text-face - ,@(when markdown-hide-markup - `(display ,markdown-footnote-display)))) - -(defvar markdown-mode-font-lock-keywords - `((markdown-match-yaml-metadata-begin . ((1 'markdown-markup-face))) - (markdown-match-yaml-metadata-end . ((1 'markdown-markup-face))) - (markdown-match-yaml-metadata-key . ((1 'markdown-metadata-key-face) - (2 'markdown-markup-face) - (3 'markdown-metadata-value-face))) - (markdown-match-gfm-open-code-blocks . ((1 markdown-markup-properties) - (2 markdown-markup-properties nil t) - (3 markdown-language-keyword-properties nil t) - (4 markdown-language-info-properties nil t) - (5 markdown-markup-properties nil t))) - (markdown-match-gfm-close-code-blocks . ((0 markdown-markup-properties))) - (markdown-fontify-gfm-code-blocks) - (markdown-fontify-tables) - (markdown-match-fenced-start-code-block . ((1 markdown-markup-properties) - (2 markdown-markup-properties nil t) - (3 markdown-language-keyword-properties nil t) - (4 markdown-language-info-properties nil t) - (5 markdown-markup-properties nil t))) - (markdown-match-fenced-end-code-block . ((0 markdown-markup-properties))) - (markdown-fontify-fenced-code-blocks) - (markdown-match-pre-blocks . ((0 'markdown-pre-face))) - (markdown-fontify-headings) - (markdown-match-declarative-metadata . ((1 'markdown-metadata-key-face) - (2 'markdown-markup-face) - (3 'markdown-metadata-value-face))) - (markdown-match-pandoc-metadata . ((1 'markdown-markup-face) - (2 'markdown-markup-face) - (3 'markdown-metadata-value-face))) - (markdown-fontify-hrs) - (markdown-match-code . ((1 markdown-markup-properties prepend) - (2 'markdown-inline-code-face prepend) - (3 markdown-markup-properties prepend))) - (,markdown-regex-kbd . ((1 markdown-markup-properties) - (2 'markdown-inline-code-face) - (3 markdown-markup-properties))) - (markdown-fontify-angle-uris) - (,markdown-regex-email . 'markdown-plain-url-face) - (markdown-match-html-tag . ((1 'markdown-html-tag-delimiter-face t) - (2 'markdown-html-tag-name-face t) - (3 'markdown-html-tag-delimiter-face t) - ;; Anchored matcher for HTML tag attributes - (,markdown-regex-html-attr - ;; Before searching, move past tag - ;; name; set limit at tag close. - (progn - (goto-char (match-end 2)) (match-end 3)) - nil - . ((1 'markdown-html-attr-name-face) - (3 'markdown-html-tag-delimiter-face nil t) - (4 'markdown-html-attr-value-face nil t))))) - (,markdown-regex-html-entity . 'markdown-html-entity-face) - (markdown-fontify-list-items) - (,markdown-regex-footnote . ((1 markdown-markup-properties) ; [^ - (2 (markdown--footnote-marker-properties)) ; label - (3 markdown-markup-properties))) ; ] - (,markdown-regex-pandoc-inline-footnote . ((1 markdown-markup-properties) ; ^ - (2 markdown-markup-properties) ; [ - (3 (markdown--pandoc-inline-footnote-properties)) ; text - (4 markdown-markup-properties))) ; ] - (markdown-match-includes . ((1 markdown-markup-properties) - (2 markdown-markup-properties nil t) - (3 markdown-include-title-properties nil t) - (4 markdown-markup-properties nil t) - (5 markdown-markup-properties) - (6 'markdown-url-face) - (7 markdown-markup-properties))) - (markdown-fontify-inline-links) - (markdown-fontify-reference-links) - (,markdown-regex-reference-definition . ((1 'markdown-markup-face) ; [ - (2 'markdown-reference-face) ; label - (3 'markdown-markup-face) ; ] - (4 'markdown-markup-face) ; : - (5 'markdown-url-face) ; url - (6 'markdown-link-title-face))) ; "title" (optional) - (markdown-fontify-plain-uris) - ;; Math mode $..$ - (markdown-match-math-single . ((1 'markdown-markup-face prepend) - (2 'markdown-math-face append) - (3 'markdown-markup-face prepend))) - ;; Math mode $$..$$ - (markdown-match-math-double . ((1 'markdown-markup-face prepend) - (2 'markdown-math-face append) - (3 'markdown-markup-face prepend))) - ;; Math mode \[..\] and \\[..\\] - (markdown-match-math-display . ((1 'markdown-markup-face prepend) - (3 'markdown-math-face append) - (4 'markdown-markup-face prepend))) - (markdown-match-bold . ((1 markdown-markup-properties prepend) - (2 'markdown-bold-face append) - (3 markdown-markup-properties prepend))) - (markdown-match-italic . ((1 markdown-markup-properties prepend) - (2 'markdown-italic-face append) - (3 markdown-markup-properties prepend))) - (,markdown-regex-strike-through . ((3 markdown-markup-properties) - (4 'markdown-strike-through-face) - (5 markdown-markup-properties))) - (markdown--match-highlighting . ((3 markdown-markup-properties) - (4 'markdown-highlighting-face) - (5 markdown-markup-properties))) - (,markdown-regex-line-break . (1 markdown-line-break-properties prepend)) - (markdown-match-escape . ((1 markdown-markup-properties prepend))) - (markdown-fontify-sub-superscripts) - (markdown-match-inline-attributes . ((0 markdown-markup-properties prepend))) - (markdown-match-leanpub-sections . ((0 markdown-markup-properties))) - (markdown-fontify-blockquotes) - (markdown-match-wiki-link . ((0 'markdown-link-face prepend)))) - "Syntax highlighting for Markdown files.") - -;; Footnotes -(defvar-local markdown-footnote-counter 0 - "Counter for footnote numbers.") - -(defconst markdown-footnote-chars - "[[:alnum:]-]" - "Regular expression matching any character for a footnote identifier.") - -(defconst markdown-regex-footnote-definition - (concat "^ \\{0,3\\}\\[\\(\\^" markdown-footnote-chars "*?\\)\\]:\\(?:[ \t]+\\|$\\)") - "Regular expression matching a footnote definition, capturing the label.") - - -;;; Compatibility ============================================================= - -(defun markdown--pandoc-reference-p () - (let ((bounds (bounds-of-thing-at-point 'word))) - (when (and bounds (char-before (car bounds))) - (= (char-before (car bounds)) ?@)))) - -(defun markdown-flyspell-check-word-p () - "Return t if `flyspell' should check word just before point. -Used for `flyspell-generic-check-word-predicate'." - (save-excursion - (goto-char (1- (point))) - ;; https://github.com/jrblevin/markdown-mode/issues/560 - ;; enable spell check YAML meta data - (if (or (and (markdown-code-block-at-point-p) - (not (markdown-text-property-at-point 'markdown-yaml-metadata-section))) - (markdown-inline-code-at-point-p) - (markdown-in-comment-p) - (markdown--face-p (point) '(markdown-reference-face - markdown-markup-face - markdown-plain-url-face - markdown-inline-code-face - markdown-url-face)) - (markdown--pandoc-reference-p)) - (prog1 nil - ;; If flyspell overlay is put, then remove it - (let ((bounds (bounds-of-thing-at-point 'word))) - (when bounds - (cl-loop for ov in (overlays-in (car bounds) (cdr bounds)) - when (overlay-get ov 'flyspell-overlay) - do - (delete-overlay ov))))) - t))) - - -;;; Markdown Parsing Functions ================================================ - -(defun markdown-cur-line-blank-p () - "Return t if the current line is blank and nil otherwise." - (save-excursion - (beginning-of-line) - (looking-at-p markdown-regex-blank-line))) - -(defun markdown-prev-line-blank () - "Return t if the previous line is blank and nil otherwise. -If we are at the first line, then consider the previous line to be blank." - (or (= (line-beginning-position) (point-min)) - (save-excursion - (forward-line -1) - (looking-at markdown-regex-blank-line)))) - -(defun markdown-prev-line-blank-p () - "Like `markdown-prev-line-blank', but preserve `match-data'." - (save-match-data (markdown-prev-line-blank))) - -(defun markdown-next-line-blank-p () - "Return t if the next line is blank and nil otherwise. -If we are at the last line, then consider the next line to be blank." - (or (= (line-end-position) (point-max)) - (save-excursion - (forward-line 1) - (markdown-cur-line-blank-p)))) - -(defun markdown-prev-line-indent () - "Return the number of leading whitespace characters in the previous line. -Return 0 if the current line is the first line in the buffer." - (save-excursion - (if (= (line-beginning-position) (point-min)) - 0 - (forward-line -1) - (current-indentation)))) - -(defun markdown-next-line-indent () - "Return the number of leading whitespace characters in the next line. -Return 0 if line is the last line in the buffer." - (save-excursion - (if (= (line-end-position) (point-max)) - 0 - (forward-line 1) - (current-indentation)))) - -(defun markdown-new-baseline () - "Determine if the current line begins a new baseline level. -Assume point is positioned at beginning of line." - (or (looking-at markdown-regex-header) - (looking-at markdown-regex-hr) - (and (= (current-indentation) 0) - (not (looking-at markdown-regex-list)) - (markdown-prev-line-blank)))) - -(defun markdown-search-backward-baseline () - "Search backward baseline point with no indentation and not a list item." - (end-of-line) - (let (stop) - (while (not (or stop (bobp))) - (re-search-backward markdown-regex-block-separator-noindent nil t) - (when (match-end 2) - (goto-char (match-end 2)) - (cond - ((markdown-new-baseline) - (setq stop t)) - ((looking-at-p markdown-regex-list) - (setq stop nil)) - (t (setq stop t))))))) - -(defun markdown-update-list-levels (marker indent levels) - "Update list levels given list MARKER, block INDENT, and current LEVELS. -Here, MARKER is a string representing the type of list, INDENT is an integer -giving the indentation, in spaces, of the current block, and LEVELS is a -list of the indentation levels of parent list items. When LEVELS is nil, -it means we are at baseline (not inside of a nested list)." - (cond - ;; New list item at baseline. - ((and marker (null levels)) - (setq levels (list indent))) - ;; List item with greater indentation (four or more spaces). - ;; Increase list level. - ((and marker (>= indent (+ (car levels) markdown-list-indent-width))) - (setq levels (cons indent levels))) - ;; List item with greater or equal indentation (less than four spaces). - ;; Do not increase list level. - ((and marker (>= indent (car levels))) - levels) - ;; Lesser indentation level. - ;; Pop appropriate number of elements off LEVELS list (e.g., lesser - ;; indentation could move back more than one list level). Note - ;; that this block need not be the beginning of list item. - ((< indent (car levels)) - (while (and (> (length levels) 1) - (< indent (+ (cadr levels) markdown-list-indent-width))) - (setq levels (cdr levels))) - levels) - ;; Otherwise, do nothing. - (t levels))) - -(defun markdown-calculate-list-levels () - "Calculate list levels at point. -Return a list of the form (n1 n2 n3 ...) where n1 is the -indentation of the deepest nested list item in the branch of -the list at the point, n2 is the indentation of the parent -list item, and so on. The depth of the list item is therefore -the length of the returned list. If the point is not at or -immediately after a list item, return nil." - (save-excursion - (let ((first (point)) levels indent pre-regexp) - ;; Find a baseline point with zero list indentation - (markdown-search-backward-baseline) - ;; Search for all list items between baseline and LOC - (while (and (< (point) first) - (re-search-forward markdown-regex-list first t)) - (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" (1+ (length levels)))) - (beginning-of-line) - (cond - ;; Make sure this is not a header or hr - ((markdown-new-baseline) (setq levels nil)) - ;; Make sure this is not a line from a pre block - ((looking-at-p pre-regexp)) - ;; If not, then update levels - (t - (setq indent (current-indentation)) - (setq levels (markdown-update-list-levels (match-string 2) - indent levels)))) - (end-of-line)) - levels))) - -(defun markdown-prev-list-item (level) - "Search backward from point for a list item with indentation LEVEL. -Set point to the beginning of the item, and return point, or nil -upon failure." - (let (bounds indent prev) - (setq prev (point)) - (forward-line -1) - (setq indent (current-indentation)) - (while - (cond - ;; List item - ((and (looking-at-p markdown-regex-list) - (setq bounds (markdown-cur-list-item-bounds))) - (cond - ;; Stop and return point at item of equal indentation - ((= (nth 3 bounds) level) - (setq prev (point)) - nil) - ;; Stop and return nil at item with lesser indentation - ((< (nth 3 bounds) level) - (setq prev nil) - nil) - ;; Stop at beginning of buffer - ((bobp) (setq prev nil)) - ;; Continue at item with greater indentation - ((> (nth 3 bounds) level) t))) - ;; Stop at beginning of buffer - ((bobp) (setq prev nil)) - ;; Continue if current line is blank - ((markdown-cur-line-blank-p) t) - ;; Continue while indentation is the same or greater - ((>= indent level) t) - ;; Stop if current indentation is less than list item - ;; and the next is blank - ((and (< indent level) - (markdown-next-line-blank-p)) - (setq prev nil)) - ;; Stop at a header - ((looking-at-p markdown-regex-header) (setq prev nil)) - ;; Stop at a horizontal rule - ((looking-at-p markdown-regex-hr) (setq prev nil)) - ;; Otherwise, continue. - (t t)) - (forward-line -1) - (setq indent (current-indentation))) - prev)) - -(defun markdown-next-list-item (level) - "Search forward from point for the next list item with indentation LEVEL. -Set point to the beginning of the item, and return point, or nil -upon failure." - (let (bounds indent next) - (setq next (point)) - (if (looking-at markdown-regex-header-setext) - (goto-char (match-end 0))) - (forward-line) - (setq indent (current-indentation)) - (while - (cond - ;; Stop at end of the buffer. - ((eobp) nil) - ;; Continue if the current line is blank - ((markdown-cur-line-blank-p) t) - ;; List item - ((and (looking-at-p markdown-regex-list) - (setq bounds (markdown-cur-list-item-bounds))) - (cond - ;; Continue at item with greater indentation - ((> (nth 3 bounds) level) t) - ;; Stop and return point at item of equal indentation - ((= (nth 3 bounds) level) - (setq next (point)) - nil) - ;; Stop and return nil at item with lesser indentation - ((< (nth 3 bounds) level) - (setq next nil) - nil))) - ;; Continue while indentation is the same or greater - ((>= indent level) t) - ;; Stop if current indentation is less than list item - ;; and the previous line was blank. - ((and (< indent level) - (markdown-prev-line-blank-p)) - (setq next nil)) - ;; Stop at a header - ((looking-at-p markdown-regex-header) (setq next nil)) - ;; Stop at a horizontal rule - ((looking-at-p markdown-regex-hr) (setq next nil)) - ;; Otherwise, continue. - (t t)) - (forward-line) - (setq indent (current-indentation))) - next)) - -(defun markdown-cur-list-item-end (level) - "Move to end of list item with pre-marker indentation LEVEL. -Return the point at the end when a list item was found at the -original point. If the point is not in a list item, do nothing." - (let (indent) - (forward-line) - (setq indent (current-indentation)) - (while - (cond - ;; Stop at end of the buffer. - ((eobp) nil) - ;; Continue while indentation is the same or greater - ((>= indent level) t) - ;; Continue if the current line is blank - ((looking-at markdown-regex-blank-line) t) - ;; Stop if current indentation is less than list item - ;; and the previous line was blank. - ((and (< indent level) - (markdown-prev-line-blank)) - nil) - ;; Stop at a new list items of the same or lesser - ;; indentation, headings, and horizontal rules. - ((looking-at (concat "\\(?:" markdown-regex-list - "\\|" markdown-regex-header - "\\|" markdown-regex-hr "\\)")) - nil) - ;; Otherwise, continue. - (t t)) - (forward-line) - (setq indent (current-indentation))) - ;; Don't skip over whitespace for empty list items (marker and - ;; whitespace only), just move to end of whitespace. - (if (save-excursion - (beginning-of-line) - (looking-at (concat markdown-regex-list "[ \t]*$"))) - (goto-char (match-end 3)) - (skip-chars-backward " \t\n")) - (end-of-line) - (point))) - -(defun markdown-cur-list-item-bounds () - "Return bounds for list item at point. -Return a list of the following form: - - (begin end indent nonlist-indent marker checkbox match) - -The named components are: - - - begin: Position of beginning of list item, including leading indentation. - - end: Position of the end of the list item, including list item text. - - indent: Number of characters of indentation before list marker (an integer). - - nonlist-indent: Number characters of indentation, list - marker, and whitespace following list marker (an integer). - - marker: String containing the list marker and following whitespace - (e.g., \"- \" or \"* \"). - - checkbox: String containing the GFM checkbox portion, if any, - including any trailing whitespace before the text - begins (e.g., \"[x] \"). - - match: match data for markdown-regex-list - -As an example, for the following unordered list item - - - item - -the returned list would be - - (1 14 3 5 \"- \" nil (1 6 1 4 4 5 5 6)) - -If the point is not inside a list item, return nil." - (car (get-text-property (line-beginning-position) 'markdown-list-item))) - -(defun markdown-list-item-at-point-p () - "Return t if there is a list item at the point and nil otherwise." - (save-match-data (markdown-cur-list-item-bounds))) - -(defun markdown-prev-list-item-bounds () - "Return bounds of previous item in the same list of any level. -The return value has the same form as that of -`markdown-cur-list-item-bounds'." - (save-excursion - (let ((cur-bounds (markdown-cur-list-item-bounds)) - (beginning-of-list (save-excursion (markdown-beginning-of-list))) - stop) - (when cur-bounds - (goto-char (nth 0 cur-bounds)) - (while (and (not stop) (not (bobp)) - (re-search-backward markdown-regex-list - beginning-of-list t)) - (unless (or (looking-at markdown-regex-hr) - (markdown-code-block-at-point-p)) - (setq stop (point)))) - (markdown-cur-list-item-bounds))))) - -(defun markdown-next-list-item-bounds () - "Return bounds of next item in the same list of any level. -The return value has the same form as that of -`markdown-cur-list-item-bounds'." - (save-excursion - (let ((cur-bounds (markdown-cur-list-item-bounds)) - (end-of-list (save-excursion (markdown-end-of-list))) - stop) - (when cur-bounds - (goto-char (nth 0 cur-bounds)) - (end-of-line) - (while (and (not stop) (not (eobp)) - (re-search-forward markdown-regex-list - end-of-list t)) - (unless (or (looking-at markdown-regex-hr) - (markdown-code-block-at-point-p)) - (setq stop (point)))) - (when stop - (markdown-cur-list-item-bounds)))))) - -(defun markdown-beginning-of-list () - "Move point to beginning of list at point, if any." - (interactive) - (let ((orig-point (point)) - (list-begin (save-excursion - (markdown-search-backward-baseline) - ;; Stop at next list item, regardless of the indentation. - (markdown-next-list-item (point-max)) - (when (looking-at markdown-regex-list) - (point))))) - (when (and list-begin (<= list-begin orig-point)) - (goto-char list-begin)))) - -(defun markdown-end-of-list () - "Move point to end of list at point, if any." - (interactive) - (let ((start (point)) - (end (save-excursion - (when (markdown-beginning-of-list) - ;; Items can't have nonlist-indent <= 1, so this - ;; moves past all list items. - (markdown-next-list-item 1) - (skip-syntax-backward "-") - (unless (eobp) (forward-char 1)) - (point))))) - (when (and end (>= end start)) - (goto-char end)))) - -(defun markdown-up-list () - "Move point to beginning of parent list item." - (interactive) - (let ((cur-bounds (markdown-cur-list-item-bounds))) - (when cur-bounds - (markdown-prev-list-item (1- (nth 3 cur-bounds))) - (let ((up-bounds (markdown-cur-list-item-bounds))) - (when (and up-bounds (< (nth 3 up-bounds) (nth 3 cur-bounds))) - (point)))))) - -(defun markdown-bounds-of-thing-at-point (thing) - "Call `bounds-of-thing-at-point' for THING with slight modifications. -Does not include trailing newlines when THING is \\='line. Handles the -end of buffer case by setting both endpoints equal to the value of -`point-max', since an empty region will trigger empty markup insertion. -Return bounds of form (beg . end) if THING is found, or nil otherwise." - (let* ((bounds (bounds-of-thing-at-point thing)) - (a (car bounds)) - (b (cdr bounds))) - (when bounds - (when (eq thing 'line) - (cond ((and (eobp) (markdown-cur-line-blank-p)) - (setq a b)) - ((char-equal (char-before b) ?\^J) - (setq b (1- b))))) - (cons a b)))) - -(defun markdown-reference-definition (reference) - "Find out whether Markdown REFERENCE is defined. -REFERENCE should not include the square brackets. -When REFERENCE is defined, return a list of the form (text start end) -containing the definition text itself followed by the start and end -locations of the text. Otherwise, return nil. -Leave match data for `markdown-regex-reference-definition' -intact additional processing." - (let ((reference (downcase reference))) - (save-excursion - (goto-char (point-min)) - (catch 'found - (while (re-search-forward markdown-regex-reference-definition nil t) - (when (string= reference (downcase (match-string-no-properties 2))) - (throw 'found - (list (match-string-no-properties 5) - (match-beginning 5) (match-end 5))))))))) - -(defun markdown-get-defined-references () - "Return all defined reference labels and their line numbers. -They does not include square brackets)." - (save-excursion - (goto-char (point-min)) - (let (refs) - (while (re-search-forward markdown-regex-reference-definition nil t) - (let ((target (match-string-no-properties 2))) - (cl-pushnew - (cons (downcase target) - (markdown-line-number-at-pos (match-beginning 2))) - refs :test #'equal :key #'car))) - (reverse refs)))) - -(defun markdown-get-used-uris () - "Return a list of all used URIs in the buffer." - (save-excursion - (goto-char (point-min)) - (let (uris) - (while (re-search-forward - (concat "\\(?:" markdown-regex-link-inline - "\\|" markdown-regex-angle-uri - "\\|" markdown-regex-uri - "\\|" markdown-regex-email - "\\)") - nil t) - (unless (or (markdown-inline-code-at-point-p) - (markdown-code-block-at-point-p)) - (cl-pushnew (or (match-string-no-properties 6) - (match-string-no-properties 10) - (match-string-no-properties 12) - (match-string-no-properties 13)) - uris :test #'equal))) - (reverse uris)))) - -(defun markdown-inline-code-at-pos (pos) - "Return non-nil if there is an inline code fragment at POS. -Return nil otherwise. Set match data according to -`markdown-match-code' upon success. -This function searches the block for a code fragment that -contains the point using `markdown-match-code'. We do this -because `thing-at-point-looking-at' does not work reliably with -`markdown-regex-code'. - -The match data is set as follows: -Group 1 matches the opening backquotes. -Group 2 matches the code fragment itself, without backquotes. -Group 3 matches the closing backquotes." - (save-excursion - (goto-char pos) - (let ((old-point (point)) - (end-of-block (progn (markdown-end-of-text-block) (point))) - found) - (markdown-beginning-of-text-block) - (while (and (markdown-match-code end-of-block) - (setq found t) - (< (match-end 0) old-point))) - (let ((match-group (if (eq (char-after (match-beginning 0)) ?`) 0 1))) - (and found ; matched something - (<= (match-beginning match-group) old-point) ; match contains old-point - (> (match-end 0) old-point)))))) - -(defun markdown-inline-code-at-pos-p (pos) - "Return non-nil if there is an inline code fragment at POS. -Like `markdown-inline-code-at-pos`, but preserves match data." - (save-match-data (markdown-inline-code-at-pos pos))) - -(defun markdown-inline-code-at-point () - "Return non-nil if the point is at an inline code fragment. -See `markdown-inline-code-at-pos' for details." - (markdown-inline-code-at-pos (point))) - -(defun markdown-inline-code-at-point-p (&optional pos) - "Return non-nil if there is inline code at the POS. -This is a predicate function counterpart to -`markdown-inline-code-at-point' which does not modify the match -data. See `markdown-code-block-at-point-p' for code blocks." - (save-match-data (markdown-inline-code-at-pos (or pos (point))))) - -(defun markdown-code-block-at-pos (pos) - "Return match data list if there is a code block at POS. -Uses text properties at the beginning of the line position. -This includes pre blocks, tilde-fenced code blocks, and GFM -quoted code blocks. Return nil otherwise." - (let ((bol (save-excursion (goto-char pos) (line-beginning-position)))) - (or (get-text-property bol 'markdown-pre) - (let* ((bounds (markdown-get-enclosing-fenced-block-construct pos)) - (second (cl-second bounds))) - (if second - ;; chunks are right open - (when (< pos second) - bounds) - bounds))))) - -;; Function was renamed to emphasize that it does not modify match-data. -(defalias 'markdown-code-block-at-point 'markdown-code-block-at-point-p) - -(defun markdown-code-block-at-point-p (&optional pos) - "Return non-nil if there is a code block at the POS. -This includes pre blocks, tilde-fenced code blocks, and GFM -quoted code blocks. This function does not modify the match -data. See `markdown-inline-code-at-point-p' for inline code." - (save-match-data (markdown-code-block-at-pos (or pos (point))))) - -(defun markdown-heading-at-point (&optional pos) - "Return non-nil if there is a heading at the POS. -Set match data for `markdown-regex-header'." - (let ((match-data (get-text-property (or pos (point)) 'markdown-heading))) - (when match-data - (set-match-data match-data) - t))) - -(defun markdown-pipe-at-bol-p () - "Return non-nil if the line begins with a pipe symbol. -This may be useful for tables and Pandoc's line_blocks extension." - (char-equal (char-after (line-beginning-position)) ?|)) - - -;;; Markdown Font Lock Matching Functions ===================================== - -(defun markdown-range-property-any (begin end prop prop-values) - "Return t if PROP from BEGIN to END is equal to one of the given PROP-VALUES. -Also returns t if PROP is a list containing one of the PROP-VALUES. -Return nil otherwise." - (let (props) - (catch 'found - (dolist (loc (number-sequence begin end)) - (when (setq props (get-text-property loc prop)) - (cond ((listp props) - ;; props is a list, check for membership - (dolist (val prop-values) - (when (memq val props) (throw 'found loc)))) - (t - ;; props is a scalar, check for equality - (dolist (val prop-values) - (when (eq val props) (throw 'found loc)))))))))) - -(defun markdown-range-properties-exist (begin end props) - (cl-loop - for loc in (number-sequence begin end) - with result = nil - while (not - (setq result - (cl-some (lambda (prop) (get-text-property loc prop)) props))) - finally return result)) - -(defun markdown-match-inline-generic (regex last &optional faceless) - "Match inline REGEX from the point to LAST. -When FACELESS is non-nil, do not return matches where faces have been applied." - (when (re-search-forward regex last t) - (let ((bounds (markdown-code-block-at-pos (match-beginning 1))) - (face (and faceless (text-property-not-all - (match-beginning 0) (match-end 0) 'face nil)))) - (cond - ;; In code block: move past it and recursively search again - (bounds - (when (< (goto-char (cl-second bounds)) last) - (markdown-match-inline-generic regex last faceless))) - ;; When faces are found in the match range, skip over the match and - ;; recursively search again. - (face - (when (< (goto-char (match-end 0)) last) - (markdown-match-inline-generic regex last faceless))) - ;; Keep match data and return t when in bounds. - (t - (<= (match-end 0) last)))))) - -(defun markdown-match-code (last) - "Match inline code fragments from point to LAST." - (unless (bobp) - (backward-char 1)) - (when (markdown-search-until-condition - (lambda () - (and - ;; Advance point in case of failure, but without exceeding last. - (goto-char (min (1+ (match-beginning 1)) last)) - (not (markdown-in-comment-p (match-beginning 1))) - (not (markdown-in-comment-p (match-end 1))) - (not (markdown-code-block-at-pos (match-beginning 1))))) - markdown-regex-code last t) - (set-match-data (list (match-beginning 1) (match-end 1) - (match-beginning 2) (match-end 2) - (match-beginning 3) (match-end 3) - (match-beginning 4) (match-end 4))) - (goto-char (min (1+ (match-end 0)) last (point-max))) - t)) - -(defun markdown--gfm-markup-underscore-p (begin end) - (let ((is-underscore (eql (char-after begin) ?_))) - (if (not is-underscore) - t - (save-excursion - (save-match-data - (goto-char begin) - (and (looking-back "\\(?:^\\|[[:blank:][:punct:]]\\)" (1- begin)) - (progn - (goto-char end) - (looking-at-p "\\(?:[[:blank:][:punct:]]\\|$\\)")))))))) - -(defun markdown-match-bold (last) - "Match inline bold from the point to LAST." - (when (markdown-match-inline-generic markdown-regex-bold last) - (let ((is-gfm (derived-mode-p 'gfm-mode)) - (begin (match-beginning 2)) - (end (match-end 2))) - (if (or (markdown-inline-code-at-pos-p begin) - (markdown-inline-code-at-pos-p end) - (markdown-in-comment-p) - (markdown-range-property-any - begin begin 'face '(markdown-url-face - markdown-plain-url-face)) - (markdown-range-property-any - begin end 'face '(markdown-hr-face - markdown-math-face)) - (and is-gfm (not (markdown--gfm-markup-underscore-p begin end)))) - (progn (goto-char (min (1+ begin) last)) - (when (< (point) last) - (markdown-match-bold last))) - (set-match-data (list (match-beginning 2) (match-end 2) - (match-beginning 3) (match-end 3) - (match-beginning 4) (match-end 4) - (match-beginning 5) (match-end 5))) - t)))) - -(defun markdown-match-italic (last) - "Match inline italics from the point to LAST." - (let* ((is-gfm (derived-mode-p 'gfm-mode)) - (regex (if is-gfm - markdown-regex-gfm-italic - markdown-regex-italic))) - (when (and (markdown-match-inline-generic regex last) - (not (markdown--face-p - (match-beginning 1) - '(markdown-html-attr-name-face markdown-html-attr-value-face)))) - (let ((begin (match-beginning 1)) - (end (match-end 1)) - (close-end (match-end 4))) - (if (or (eql (char-before begin) (char-after begin)) - (markdown-inline-code-at-pos-p begin) - (markdown-inline-code-at-pos-p (1- end)) - (markdown-in-comment-p) - (markdown-range-property-any - begin begin 'face '(markdown-url-face - markdown-plain-url-face - markdown-markup-face)) - (markdown-range-property-any - begin end 'face '(markdown-bold-face - markdown-list-face - markdown-hr-face - markdown-math-face)) - (and is-gfm - (or (char-equal (char-after begin) (char-after (1+ begin))) ;; check bold case - (not (markdown--gfm-markup-underscore-p begin close-end))))) - (progn (goto-char (min (1+ begin) last)) - (when (< (point) last) - (markdown-match-italic last))) - (set-match-data (list (match-beginning 1) (match-end 1) - (match-beginning 2) (match-end 2) - (match-beginning 3) (match-end 3) - (match-beginning 4) (match-end 4))) - t))))) - -(defun markdown--match-highlighting (last) - (when markdown-enable-highlighting-syntax - (re-search-forward markdown-regex-highlighting last t))) - -(defun markdown-match-escape (last) - "Match escape characters (backslashes) from point to LAST. -Backlashes only count as escape characters outside of literal -regions (e.g. code blocks). See `markdown-literal-faces'." - (catch 'found - (while (search-forward-regexp markdown-regex-escape last t) - (let* ((face (get-text-property (match-beginning 1) 'face)) - (face-list (if (listp face) face (list face)))) - ;; Ignore any backslashes with a literal face. - (unless (cl-intersection face-list markdown-literal-faces) - (throw 'found t)))))) - -(defun markdown-match-math-generic (regex last) - "Match REGEX from point to LAST. -REGEX is either `markdown-regex-math-inline-single' for matching -$..$ or `markdown-regex-math-inline-double' for matching $$..$$." - (when (markdown-match-inline-generic regex last) - (let ((begin (match-beginning 1)) (end (match-end 1))) - (prog1 - (if (or (markdown-range-property-any - begin end 'face - '(markdown-inline-code-face markdown-bold-face)) - (markdown-range-properties-exist - begin end - (markdown-get-fenced-block-middle-properties))) - (markdown-match-math-generic regex last) - t) - (goto-char (1+ (match-end 0))))))) - -(defun markdown-match-list-items (last) - "Match list items from point to LAST." - (let* ((first (point)) - (pos first) - (prop 'markdown-list-item) - (bounds (car (get-text-property pos prop)))) - (while - (and (or (null (setq bounds (car (get-text-property pos prop)))) - (< (cl-first bounds) pos)) - (< (point) last) - (setq pos (next-single-property-change pos prop nil last)) - (goto-char pos))) - (when bounds - (set-match-data (cl-seventh bounds)) - ;; Step at least one character beyond point. Otherwise - ;; `font-lock-fontify-keywords-region' infloops. - (goto-char (min (1+ (max (line-end-position) first)) - (point-max))) - t))) - -(defun markdown-match-math-single (last) - "Match single quoted $..$ math from point to LAST." - (when markdown-enable-math - (when (and (char-equal (char-after) ?$) - (not (bolp)) - (not (char-equal (char-before) ?\\)) - (not (char-equal (char-before) ?$))) - (forward-char -1)) - (markdown-match-math-generic markdown-regex-math-inline-single last))) - -(defun markdown-match-math-double (last) - "Match double quoted $$..$$ math from point to LAST." - (when markdown-enable-math - (when (and (< (1+ (point)) (point-max)) - (char-equal (char-after) ?$) - (char-equal (char-after (1+ (point))) ?$) - (not (bolp)) - (not (char-equal (char-before) ?\\)) - (not (char-equal (char-before) ?$))) - (forward-char -1)) - (markdown-match-math-generic markdown-regex-math-inline-double last))) - -(defun markdown-match-math-display (last) - "Match bracketed display math \[..\] and \\[..\\] from point to LAST." - (when markdown-enable-math - (markdown-match-math-generic markdown-regex-math-display last))) - -(defun markdown-match-propertized-text (property last) - "Match text with PROPERTY from point to LAST. -Restore match data previously stored in PROPERTY." - (let ((saved (get-text-property (point) property)) - pos) - (unless saved - (setq pos (next-single-property-change (point) property nil last)) - (unless (= pos last) - (setq saved (get-text-property pos property)))) - (when saved - (set-match-data saved) - ;; Step at least one character beyond point. Otherwise - ;; `font-lock-fontify-keywords-region' infloops. - (goto-char (min (1+ (max (match-end 0) (point))) - (point-max))) - saved))) - -(defun markdown-match-pre-blocks (last) - "Match preformatted blocks from point to LAST. -Use data stored in \\='markdown-pre text property during syntax -analysis." - (markdown-match-propertized-text 'markdown-pre last)) - -(defun markdown-match-gfm-code-blocks (last) - "Match GFM quoted code blocks from point to LAST. -Use data stored in \\='markdown-gfm-code text property during syntax -analysis." - (markdown-match-propertized-text 'markdown-gfm-code last)) - -(defun markdown-match-gfm-open-code-blocks (last) - (markdown-match-propertized-text 'markdown-gfm-block-begin last)) - -(defun markdown-match-gfm-close-code-blocks (last) - (markdown-match-propertized-text 'markdown-gfm-block-end last)) - -(defun markdown-match-fenced-code-blocks (last) - "Match fenced code blocks from the point to LAST." - (markdown-match-propertized-text 'markdown-fenced-code last)) - -(defun markdown-match-fenced-start-code-block (last) - (markdown-match-propertized-text 'markdown-tilde-fence-begin last)) - -(defun markdown-match-fenced-end-code-block (last) - (markdown-match-propertized-text 'markdown-tilde-fence-end last)) - -(defun markdown-match-blockquotes (last) - "Match blockquotes from point to LAST. -Use data stored in \\='markdown-blockquote text property during syntax -analysis." - (markdown-match-propertized-text 'markdown-blockquote last)) - -(defun markdown-match-hr (last) - "Match horizontal rules comments from the point to LAST." - (markdown-match-propertized-text 'markdown-hr last)) - -(defun markdown-match-comments (last) - "Match HTML comments from the point to LAST." - (when (and (skip-syntax-forward "^<" last)) - (let ((beg (point))) - (when (and (skip-syntax-forward "^>" last) (< (point) last)) - (forward-char) - (set-match-data (list beg (point))) - t)))) - -(defun markdown-match-generic-links (last ref) - "Match inline links from point to LAST. -When REF is non-nil, match reference links instead of standard -links with URLs. -This function should only be used during font-lock, as it -determines syntax based on the presence of faces for previously -processed elements." - ;; Search for the next potential link (not in a code block). - (let ((prohibited-faces '(markdown-pre-face - markdown-code-face - markdown-inline-code-face - markdown-comment-face)) - found) - (while - (and (not found) (< (point) last) - (progn - ;; Clear match data to test for a match after functions returns. - (set-match-data nil) - ;; Preliminary regular expression search so we can return - ;; quickly upon failure. This doesn't handle malformed links - ;; or nested square brackets well, so if it passes we back up - ;; continue with a more precise search. - (re-search-forward - (if ref - markdown-regex-link-reference - markdown-regex-link-inline) - last 'limit))) - ;; Keep searching if this is in a code block, inline code, or a - ;; comment, or if it is include syntax. The link text portion - ;; (group 3) may contain inline code or comments, but the - ;; markup, URL, and title should not be part of such elements. - (if (or (markdown-range-property-any - (match-beginning 0) (match-end 2) 'face prohibited-faces) - (markdown-range-property-any - (match-beginning 4) (match-end 0) 'face prohibited-faces) - (and (char-equal (char-after (line-beginning-position)) ?<) - (char-equal (char-after (1+ (line-beginning-position))) ?<))) - (set-match-data nil) - (setq found t)))) - ;; Match opening exclamation point (optional) and left bracket. - (when (match-beginning 2) - (let* ((bang (match-beginning 1)) - (first-begin (match-beginning 2)) - ;; Find end of block to prevent matching across blocks. - (end-of-block (save-excursion - (progn - (goto-char (match-beginning 2)) - (markdown-end-of-text-block) - (point)))) - ;; Move over balanced expressions to closing right bracket. - ;; Catch unbalanced expression errors and return nil. - (first-end (condition-case nil - (and (goto-char first-begin) - (scan-sexps (point) 1)) - (error nil))) - ;; Continue with point at CONT-POINT upon failure. - (cont-point (min (1+ first-begin) last)) - second-begin second-end url-begin url-end - title-begin title-end) - ;; When bracket found, in range, and followed by a left paren/bracket... - (when (and first-end (< first-end end-of-block) (goto-char first-end) - (char-equal (char-after (point)) (if ref ?\[ ?\())) - ;; Scan across balanced expressions for closing parenthesis/bracket. - (setq second-begin (point) - second-end (condition-case nil - (scan-sexps (point) 1) - (error nil))) - ;; Check that closing parenthesis/bracket is in range. - (if (and second-end (<= second-end end-of-block) (<= second-end last)) - (progn - ;; Search for (optional) title inside closing parenthesis - (when (and (not ref) (search-forward "\"" second-end t)) - (setq title-begin (1- (point)) - title-end (and (goto-char second-end) - (search-backward "\"" (1+ title-begin) t)) - title-end (and title-end (1+ title-end)))) - ;; Store URL/reference range - (setq url-begin (1+ second-begin) - url-end (1- (or title-begin second-end))) - ;; Set match data, move point beyond link, and return - (set-match-data - (list (or bang first-begin) second-end ; 0 - all - bang (and bang (1+ bang)) ; 1 - bang - first-begin (1+ first-begin) ; 2 - markup - (1+ first-begin) (1- first-end) ; 3 - link text - (1- first-end) first-end ; 4 - markup - second-begin (1+ second-begin) ; 5 - markup - url-begin url-end ; 6 - url/reference - title-begin title-end ; 7 - title - (1- second-end) second-end)) ; 8 - markup - ;; Nullify cont-point and leave point at end and - (setq cont-point nil) - (goto-char second-end)) - ;; If no closing parenthesis in range, update continuation point - (setq cont-point (min end-of-block second-begin)))) - (cond - ;; On failure, continue searching at cont-point - ((and cont-point (< cont-point last)) - (goto-char cont-point) - (markdown-match-generic-links last ref)) - ;; No more text, return nil - ((and cont-point (= cont-point last)) - nil) - ;; Return t if a match occurred - (t t))))) - -(defun markdown-match-angle-uris (last) - "Match angle bracket URIs from point to LAST." - (when (markdown-match-inline-generic markdown-regex-angle-uri last) - (goto-char (1+ (match-end 0))))) - -(defun markdown-match-plain-uris (last) - "Match plain URIs from point to LAST." - (when (markdown-match-inline-generic markdown-regex-uri last t) - (goto-char (1+ (match-end 0))))) - -(defvar markdown-conditional-search-function #'re-search-forward - "Conditional search function used in `markdown-search-until-condition'. -Made into a variable to allow for dynamic let-binding.") - -(defun markdown-search-until-condition (condition &rest args) - (let (ret) - (while (and (not ret) (apply markdown-conditional-search-function args)) - (setq ret (funcall condition))) - ret)) - -(defun markdown-metadata-line-p (pos regexp) - (save-excursion - (or (= (line-number-at-pos pos) 1) - (progn - (forward-line -1) - ;; skip multi-line metadata - (while (and (looking-at-p "^\\s-+[[:alpha:]]") - (> (line-number-at-pos (point)) 1)) - (forward-line -1)) - (looking-at-p regexp))))) - -(defun markdown-match-generic-metadata (regexp last) - "Match metadata declarations specified by REGEXP from point to LAST. -These declarations must appear inside a metadata block that begins at -the beginning of the buffer and ends with a blank line (or the end of -the buffer)." - (let* ((first (point)) - (end-re "\n[ \t]*\n\\|\n\\'\\|\\'") - (block-begin (goto-char 1)) - (block-end (re-search-forward end-re nil t))) - (if (and block-end (> first block-end)) - ;; Don't match declarations if there is no metadata block or if - ;; the point is beyond the block. Move point to point-max to - ;; prevent additional searches and return return nil since nothing - ;; was found. - (progn (goto-char (point-max)) nil) - ;; If a block was found that begins before LAST and ends after - ;; point, search for declarations inside it. If the starting is - ;; before the beginning of the block, start there. Otherwise, - ;; move back to FIRST. - (goto-char (if (< first block-begin) block-begin first)) - (if (and (re-search-forward regexp (min last block-end) t) - (markdown-metadata-line-p (point) regexp)) - ;; If a metadata declaration is found, set match-data and return t. - (let ((key-beginning (match-beginning 1)) - (key-end (match-end 1)) - (markup-begin (match-beginning 2)) - (markup-end (match-end 2)) - (value-beginning (match-beginning 3))) - (set-match-data (list key-beginning (point) ; complete metadata - key-beginning key-end ; key - markup-begin markup-end ; markup - value-beginning (point))) ; value - t) - ;; Otherwise, move the point to last and return nil - (goto-char last) - nil)))) - -(defun markdown-match-declarative-metadata (last) - "Match declarative metadata from the point to LAST." - (markdown-match-generic-metadata markdown-regex-declarative-metadata last)) - -(defun markdown-match-pandoc-metadata (last) - "Match Pandoc metadata from the point to LAST." - (markdown-match-generic-metadata markdown-regex-pandoc-metadata last)) - -(defun markdown-match-yaml-metadata-begin (last) - (markdown-match-propertized-text 'markdown-yaml-metadata-begin last)) - -(defun markdown-match-yaml-metadata-end (last) - (markdown-match-propertized-text 'markdown-yaml-metadata-end last)) - -(defun markdown-match-yaml-metadata-key (last) - (markdown-match-propertized-text 'markdown-metadata-key last)) - -(defun markdown-match-wiki-link (last) - "Match wiki links from point to LAST." - (when (and markdown-enable-wiki-links - (not markdown-wiki-link-fontify-missing) - (markdown-match-inline-generic markdown-regex-wiki-link last)) - (let ((begin (match-beginning 1)) (end (match-end 1))) - (if (or (markdown-in-comment-p begin) - (markdown-in-comment-p end) - (markdown-inline-code-at-pos-p begin) - (markdown-inline-code-at-pos-p end) - (markdown-code-block-at-pos begin)) - (progn (goto-char (min (1+ begin) last)) - (when (< (point) last) - (markdown-match-wiki-link last))) - (set-match-data (list begin end)) - t)))) - -(defun markdown-match-inline-attributes (last) - "Match inline attributes from point to LAST." - ;; #428 re-search-forward markdown-regex-inline-attributes is very slow. - ;; So use simple regex for re-search-forward and use markdown-regex-inline-attributes - ;; against matched string. - (when (markdown-match-inline-generic "[ \t]*\\({\\)\\([^\n]*\\)}[ \t]*$" last) - (if (not (string-match-p markdown-regex-inline-attributes (match-string 0))) - (markdown-match-inline-attributes last) - (unless (or (markdown-inline-code-at-pos-p (match-beginning 0)) - (markdown-inline-code-at-pos-p (match-end 0)) - (markdown-in-comment-p)) - t)))) - -(defun markdown-match-leanpub-sections (last) - "Match Leanpub section markers from point to LAST." - (when (markdown-match-inline-generic markdown-regex-leanpub-sections last) - (unless (or (markdown-inline-code-at-pos-p (match-beginning 0)) - (markdown-inline-code-at-pos-p (match-end 0)) - (markdown-in-comment-p)) - t))) - -(defun markdown-match-includes (last) - "Match include statements from point to LAST. -Sets match data for the following seven groups: -Group 1: opening two angle brackets -Group 2: opening title delimiter (optional) -Group 3: title text (optional) -Group 4: closing title delimiter (optional) -Group 5: opening filename delimiter -Group 6: filename -Group 7: closing filename delimiter" - (when (markdown-match-inline-generic markdown-regex-include last) - (let ((valid (not (or (markdown-in-comment-p (match-beginning 0)) - (markdown-in-comment-p (match-end 0)) - (markdown-code-block-at-pos (match-beginning 0)))))) - (cond - ;; Parentheses and maybe square brackets, but no curly braces: - ;; match optional title in square brackets and file in parentheses. - ((and valid (match-beginning 5) - (not (match-beginning 8))) - (set-match-data (list (match-beginning 1) (match-end 7) - (match-beginning 1) (match-end 1) - (match-beginning 2) (match-end 2) - (match-beginning 3) (match-end 3) - (match-beginning 4) (match-end 4) - (match-beginning 5) (match-end 5) - (match-beginning 6) (match-end 6) - (match-beginning 7) (match-end 7)))) - ;; Only square brackets present: match file in square brackets. - ((and valid (match-beginning 2) - (not (match-beginning 5)) - (not (match-beginning 7))) - (set-match-data (list (match-beginning 1) (match-end 4) - (match-beginning 1) (match-end 1) - nil nil - nil nil - nil nil - (match-beginning 2) (match-end 2) - (match-beginning 3) (match-end 3) - (match-beginning 4) (match-end 4)))) - ;; Only curly braces present: match file in curly braces. - ((and valid (match-beginning 8) - (not (match-beginning 2)) - (not (match-beginning 5))) - (set-match-data (list (match-beginning 1) (match-end 10) - (match-beginning 1) (match-end 1) - nil nil - nil nil - nil nil - (match-beginning 8) (match-end 8) - (match-beginning 9) (match-end 9) - (match-beginning 10) (match-end 10)))) - (t - ;; Not a valid match, move to next line and search again. - (forward-line) - (when (< (point) last) - (setq valid (markdown-match-includes last))))) - valid))) - -(defun markdown-match-html-tag (last) - "Match HTML tags from point to LAST." - (when (and markdown-enable-html - (markdown-match-inline-generic markdown-regex-html-tag last t)) - (set-match-data (list (match-beginning 0) (match-end 0) - (match-beginning 1) (match-end 1) - (match-beginning 2) (match-end 2) - (match-beginning 9) (match-end 9))) - t)) - - -;;; Markdown Font Fontification Functions ===================================== - -(defvar markdown--first-displayable-cache (make-hash-table :test #'equal)) - -(defun markdown--first-displayable (seq) - "Return the first displayable character or string in SEQ. -SEQ may be an atom or a sequence." - (let ((c (gethash seq markdown--first-displayable-cache t))) - (if (not (eq c t)) - c - (puthash seq - (let ((seq (if (listp seq) seq (list seq)))) - (cond ((stringp (car seq)) - (cl-find-if - (lambda (str) - (and (mapcar #'char-displayable-p (string-to-list str)))) - seq)) - ((characterp (car seq)) - (cl-find-if #'char-displayable-p seq)))) - markdown--first-displayable-cache)))) - -(defun markdown--marginalize-string (level) - "Generate atx markup string of given LEVEL for left margin." - (let ((margin-left-space-count - (- markdown-marginalize-headers-margin-width level))) - (concat (make-string margin-left-space-count ? ) - (make-string level ?#)))) - -(defun markdown-marginalize-update-current () - "Update the window configuration to create a left margin." - (if window-system - (let* ((header-delimiter-font-width - (window-font-width nil 'markdown-header-delimiter-face)) - (margin-pixel-width (* markdown-marginalize-headers-margin-width - header-delimiter-font-width)) - (margin-char-width (/ margin-pixel-width (default-font-width)))) - (set-window-margins nil margin-char-width)) - ;; As a fallback, simply set margin based on character count. - (set-window-margins nil (1+ markdown-marginalize-headers-margin-width)))) - -(defun markdown-fontify-headings (last) - "Add text properties to headings from point to LAST." - (when (markdown-match-propertized-text 'markdown-heading last) - (let* ((level (markdown-outline-level)) - (heading-face - (intern (format "markdown-header-face-%d" level))) - (heading-props `(face ,heading-face)) - (left-markup-props - `(face markdown-header-delimiter-face - ,@(cond - (markdown-hide-markup - `(display "")) - (markdown-marginalize-headers - `(display ((margin left-margin) - ,(markdown--marginalize-string level))))))) - (right-markup-props - `(face markdown-header-delimiter-face - ,@(when markdown-hide-markup `(display "")))) - (rule-props `(face markdown-header-rule-face - ,@(when markdown-hide-markup `(display ""))))) - (if (match-end 1) - ;; Setext heading - (progn (add-text-properties - (match-beginning 1) (match-end 1) heading-props) - (if (= level 1) - (add-text-properties - (match-beginning 2) (match-end 2) rule-props) - (add-text-properties - (match-beginning 3) (match-end 3) rule-props))) - ;; atx heading - (let ((header-end - (if markdown-fontify-whole-heading-line - (min (point-max) (1+ (match-end 0))) - (match-end 0)))) - (add-text-properties - (match-beginning 4) (match-end 4) left-markup-props) - - ;; If closing tag is present - (if (match-end 6) - (progn - (if markdown-hide-markup - (progn - (add-text-properties - (match-beginning 5) header-end heading-props) - (add-text-properties - (match-beginning 6) (match-end 6) right-markup-props)) - (add-text-properties - (match-beginning 5) (match-end 5) heading-props) - (add-text-properties - (match-beginning 6) header-end right-markup-props))) - ;; If closing tag is not present - (add-text-properties - (match-beginning 5) header-end heading-props)) - ))) - t)) - -(defun markdown-fontify-tables (last) - (when (re-search-forward "|" last t) - (when (markdown-table-at-point-p) - (font-lock-append-text-property - (line-beginning-position) (min (1+ (line-end-position)) (point-max)) - 'face 'markdown-table-face)) - (forward-line 1) - t)) - -(defun markdown-fontify-blockquotes (last) - "Apply font-lock properties to blockquotes from point to LAST." - (when (markdown-match-blockquotes last) - (let ((display-string - (markdown--first-displayable markdown-blockquote-display-char))) - (add-text-properties - (match-beginning 1) (match-end 1) - (if markdown-hide-markup - `(face markdown-blockquote-face display ,display-string) - `(face markdown-markup-face))) - (font-lock-append-text-property - (match-beginning 0) (match-end 0) 'face 'markdown-blockquote-face) - t))) - -(defun markdown-fontify-list-items (last) - "Apply font-lock properties to list markers from point to LAST." - (when (markdown-match-list-items last) - (when (not (markdown-code-block-at-point-p (match-beginning 2))) - (let* ((indent (length (match-string-no-properties 1))) - (level (/ indent markdown-list-indent-width)) ;; level = 0, 1, 2, ... - (bullet (nth (mod level (length markdown-list-item-bullets)) - markdown-list-item-bullets))) - (add-text-properties - (match-beginning 2) (match-end 2) '(face markdown-list-face)) - (when markdown-hide-markup - (cond - ;; Unordered lists - ((string-match-p "[\\*\\+-]" (match-string 2)) - (add-text-properties - (match-beginning 2) (match-end 2) `(display ,bullet))) - ;; Definition lists - ((string-equal ":" (match-string 2)) - (let ((display-string - (char-to-string (markdown--first-displayable - markdown-definition-display-char)))) - (add-text-properties (match-beginning 2) (match-end 2) - `(display ,display-string)))))))) - t)) - -(defun markdown--fontify-hrs-view-mode (hr-char) - (if (and hr-char (display-supports-face-attributes-p '(:extend t))) - (add-text-properties - (match-beginning 0) (match-end 0) - `(face - (:inherit markdown-hr-face :underline t :extend t) - font-lock-multiline t - display "\n")) - (let ((hr-len (and hr-char (/ (1- (window-body-width)) (char-width hr-char))))) - (add-text-properties - (match-beginning 0) (match-end 0) - `(face - markdown-hr-face font-lock-multiline t - display ,(make-string hr-len hr-char)))))) - -(defun markdown-fontify-hrs (last) - "Add text properties to horizontal rules from point to LAST." - (when (markdown-match-hr last) - (let ((hr-char (markdown--first-displayable markdown-hr-display-char))) - (if (and markdown-hide-markup hr-char) - (markdown--fontify-hrs-view-mode hr-char) - (add-text-properties - (match-beginning 0) (match-end 0) - `(face markdown-hr-face font-lock-multiline t))) - t))) - -(defun markdown-fontify-sub-superscripts (last) - "Apply text properties to sub- and superscripts from point to LAST." - (when (markdown-search-until-condition - (lambda () (and (not (markdown-code-block-at-point-p)) - (not (markdown-inline-code-at-point-p)) - (not (markdown-in-comment-p)) - (not (markdown--math-block-p)))) - markdown-regex-sub-superscript last t) - (let* ((subscript-p (string= (match-string 2) "~")) - (props - (if subscript-p - (car markdown-sub-superscript-display) - (cdr markdown-sub-superscript-display))) - (mp (list 'face 'markdown-markup-face - 'invisible 'markdown-markup))) - (when markdown-hide-markup - (put-text-property (match-beginning 3) (match-end 3) - 'display props)) - (add-text-properties (match-beginning 2) (match-end 2) mp) - (add-text-properties (match-beginning 4) (match-end 4) mp) - t))) - - -;;; Syntax Table ============================================================== - -(defvar markdown-mode-syntax-table - (let ((tab (make-syntax-table text-mode-syntax-table))) - (modify-syntax-entry ?\" "." tab) - tab) - "Syntax table for `markdown-mode'.") - - -;;; Element Insertion ========================================================= - -(defun markdown-ensure-blank-line-before () - "If previous line is not already blank, insert a blank line before point." - (unless (bolp) (insert "\n")) - (unless (or (bobp) (looking-back "\n\\s-*\n" nil)) (insert "\n"))) - -(defun markdown-ensure-blank-line-after () - "If following line is not already blank, insert a blank line after point. -Return the point where it was originally." - (save-excursion - (unless (eolp) (insert "\n")) - (unless (or (eobp) (looking-at-p "\n\\s-*\n")) (insert "\n")))) - -(defun markdown-wrap-or-insert (s1 s2 &optional thing beg end) - "Insert the strings S1 and S2, wrapping around region or THING. -If a region is specified by the optional BEG and END arguments, -wrap the strings S1 and S2 around that region. -If there is an active region, wrap the strings S1 and S2 around -the region. If there is not an active region but the point is at -THING, wrap that thing (which defaults to word). Otherwise, just -insert S1 and S2 and place the point in between. Return the -bounds of the entire wrapped string, or nil if nothing was wrapped -and S1 and S2 were only inserted." - (let (a b bounds new-point) - (cond - ;; Given region - ((and beg end) - (setq a beg - b end - new-point (+ (point) (length s1)))) - ;; Active region - ((use-region-p) - (setq a (region-beginning) - b (region-end) - new-point (+ (point) (length s1)))) - ;; Thing (word) at point - ((setq bounds (markdown-bounds-of-thing-at-point (or thing 'word))) - (setq a (car bounds) - b (cdr bounds) - new-point (+ (point) (length s1)))) - ;; No active region and no word - (t - (setq a (point) - b (point)))) - (goto-char b) - (insert s2) - (goto-char a) - (insert s1) - (when new-point (goto-char new-point)) - (if (= a b) - nil - (setq b (+ b (length s1) (length s2))) - (cons a b)))) - -(defun markdown-point-after-unwrap (cur prefix suffix) - "Return desired position of point after an unwrapping operation. -CUR gives the position of the point before the operation. -Additionally, two cons cells must be provided. PREFIX gives the -bounds of the prefix string and SUFFIX gives the bounds of the -suffix string." - (cond ((< cur (cdr prefix)) (car prefix)) - ((< cur (car suffix)) (- cur (- (cdr prefix) (car prefix)))) - ((<= cur (cdr suffix)) - (- cur (+ (- (cdr prefix) (car prefix)) - (- cur (car suffix))))) - (t cur))) - -(defun markdown-unwrap-thing-at-point (regexp all text) - "Remove prefix and suffix of thing at point and reposition the point. -When the thing at point matches REGEXP, replace the subexpression -ALL with the string in subexpression TEXT. Reposition the point -in an appropriate location accounting for the removal of prefix -and suffix strings. Return new bounds of string from group TEXT. -When REGEXP is nil, assumes match data is already set." - (when (or (null regexp) - (thing-at-point-looking-at regexp)) - (let ((cur (point)) - (prefix (cons (match-beginning all) (match-beginning text))) - (suffix (cons (match-end text) (match-end all))) - (bounds (cons (match-beginning text) (match-end text)))) - ;; Replace the thing at point - (replace-match (match-string text) t t nil all) - ;; Reposition the point - (goto-char (markdown-point-after-unwrap cur prefix suffix)) - ;; Adjust bounds - (setq bounds (cons (car prefix) - (- (cdr bounds) (- (cdr prefix) (car prefix)))))))) - -(defun markdown-unwrap-things-in-region (beg end regexp all text) - "Remove prefix and suffix of all things in region from BEG to END. -When a thing in the region matches REGEXP, replace the -subexpression ALL with the string in subexpression TEXT. -Return a cons cell containing updated bounds for the region." - (save-excursion - (goto-char beg) - (let ((removed 0) len-all len-text) - (while (re-search-forward regexp (- end removed) t) - (setq len-all (length (match-string-no-properties all))) - (setq len-text (length (match-string-no-properties text))) - (setq removed (+ removed (- len-all len-text))) - (replace-match (match-string text) t t nil all)) - (cons beg (- end removed))))) - -(defun markdown-insert-hr (arg) - "Insert or replace a horizontal rule. -By default, use the first element of `markdown-hr-strings'. When -ARG is non-nil, as when given a prefix, select a different -element as follows. When prefixed with \\[universal-argument], -use the last element of `markdown-hr-strings' instead. When -prefixed with an integer from 1 to the length of -`markdown-hr-strings', use the element in that position instead." - (interactive "*P") - (when (thing-at-point-looking-at markdown-regex-hr) - (delete-region (match-beginning 0) (match-end 0))) - (markdown-ensure-blank-line-before) - (cond ((equal arg '(4)) - (insert (car (reverse markdown-hr-strings)))) - ((and (integerp arg) (> arg 0) - (<= arg (length markdown-hr-strings))) - (insert (nth (1- arg) markdown-hr-strings))) - (t - (insert (car markdown-hr-strings)))) - (markdown-ensure-blank-line-after)) - -(defun markdown--insert-common (start-delim end-delim regex start-group end-group face - &optional skip-space) - (if (use-region-p) - ;; Active region - (let* ((bounds (markdown-unwrap-things-in-region - (region-beginning) (region-end) - regex start-group end-group)) - (beg (car bounds)) - (end (cdr bounds))) - (when (and beg skip-space) - (save-excursion - (goto-char beg) - (skip-chars-forward "[ \t]") - (setq beg (point)))) - (when (and end skip-space) - (save-excursion - (goto-char end) - (skip-chars-backward "[ \t]") - (setq end (point)))) - (markdown-wrap-or-insert start-delim end-delim nil beg end)) - (if (markdown--face-p (point) (list face)) - (save-excursion - (while (and (markdown--face-p (point) (list face)) (not (bobp))) - (forward-char -1)) - (forward-char (- (1- (length start-delim)))) ;; for delimiter - (unless (bolp) - (forward-char -1)) - (when (looking-at regex) - (markdown-unwrap-thing-at-point nil start-group end-group))) - (if (thing-at-point-looking-at regex) - (markdown-unwrap-thing-at-point nil start-group end-group) - (markdown-wrap-or-insert start-delim end-delim 'word nil nil))))) - -(defun markdown-insert-bold () - "Insert markup to make a region or word bold. -If there is an active region, make the region bold. If the point -is at a non-bold word, make the word bold. If the point is at a -bold word or phrase, remove the bold markup. Otherwise, simply -insert bold delimiters and place the point in between them." - (interactive) - (let ((delim (if markdown-bold-underscore "__" "**"))) - (markdown--insert-common delim delim markdown-regex-bold 2 4 'markdown-bold-face t))) - -(defun markdown-insert-italic () - "Insert markup to make a region or word italic. -If there is an active region, make the region italic. If the point -is at a non-italic word, make the word italic. If the point is at an -italic word or phrase, remove the italic markup. Otherwise, simply -insert italic delimiters and place the point in between them." - (interactive) - (let ((delim (if markdown-italic-underscore "_" "*"))) - (markdown--insert-common delim delim markdown-regex-italic 1 3 'markdown-italic-face t))) - -(defun markdown-insert-strike-through () - "Insert markup to make a region or word strikethrough. -If there is an active region, make the region strikethrough. If the point -is at a non-bold word, make the word strikethrough. If the point is at a -strikethrough word or phrase, remove the strikethrough markup. Otherwise, -simply insert bold delimiters and place the point in between them." - (interactive) - (markdown--insert-common - "~~" "~~" markdown-regex-strike-through 2 4 'markdown-strike-through-face t)) - -(defun markdown-insert-code () - "Insert markup to make a region or word an inline code fragment. -If there is an active region, make the region an inline code -fragment. If the point is at a word, make the word an inline -code fragment. Otherwise, simply insert code delimiters and -place the point in between them." - (interactive) - (if (use-region-p) - ;; Active region - (let ((bounds (markdown-unwrap-things-in-region - (region-beginning) (region-end) - markdown-regex-code 1 3))) - (markdown-wrap-or-insert "`" "`" nil (car bounds) (cdr bounds))) - ;; Code markup removal, code markup for word, or empty markup insertion - (if (markdown-inline-code-at-point) - (markdown-unwrap-thing-at-point nil 0 2) - (markdown-wrap-or-insert "`" "`" 'word nil nil)))) - -(defun markdown-insert-kbd () - "Insert markup to wrap region or word in <kbd> tags. -If there is an active region, use the region. If the point is at -a word, use the word. Otherwise, simply insert <kbd> tags and -place the point in between them." - (interactive) - (if (use-region-p) - ;; Active region - (let ((bounds (markdown-unwrap-things-in-region - (region-beginning) (region-end) - markdown-regex-kbd 0 2))) - (markdown-wrap-or-insert "<kbd>" "</kbd>" nil (car bounds) (cdr bounds))) - ;; Markup removal, markup for word, or empty markup insertion - (if (thing-at-point-looking-at markdown-regex-kbd) - (markdown-unwrap-thing-at-point nil 0 2) - (markdown-wrap-or-insert "<kbd>" "</kbd>" 'word nil nil)))) - -(defun markdown-insert-inline-link (text url &optional title) - "Insert an inline link with TEXT pointing to URL. -Optionally, the user can provide a TITLE." - (let ((cur (point))) - (setq title (and title (concat " \"" title "\""))) - (insert (concat "[" text "](" url title ")")) - (cond ((not text) (goto-char (+ 1 cur))) - ((not url) (goto-char (+ 3 (length text) cur)))))) - -(defun markdown-insert-inline-image (text url &optional title) - "Insert an inline link with alt TEXT pointing to URL. -Optionally, also provide a TITLE." - (let ((cur (point))) - (setq title (and title (concat " \"" title "\""))) - (insert (concat "![" text "](" url title ")")) - (cond ((not text) (goto-char (+ 2 cur))) - ((not url) (goto-char (+ 4 (length text) cur)))))) - -(defun markdown-insert-reference-link (text label &optional url title) - "Insert a reference link and, optionally, a reference definition. -The link TEXT will be inserted followed by the optional LABEL. -If a URL is given, also insert a definition for the reference -LABEL according to `markdown-reference-location'. If a TITLE is -given, it will be added to the end of the reference definition -and will be used to populate the title attribute when converted -to XHTML. If URL is nil, insert only the link portion (for -example, when a reference label is already defined)." - (insert (concat "[" text "][" label "]")) - (when url - (markdown-insert-reference-definition - (if (string-equal label "") text label) - url title))) - -(defun markdown-insert-reference-image (text label &optional url title) - "Insert a reference image and, optionally, a reference definition. -The alt TEXT will be inserted followed by the optional LABEL. -If a URL is given, also insert a definition for the reference -LABEL according to `markdown-reference-location'. If a TITLE is -given, it will be added to the end of the reference definition -and will be used to populate the title attribute when converted -to XHTML. If URL is nil, insert only the link portion (for -example, when a reference label is already defined)." - (insert (concat "![" text "][" label "]")) - (when url - (markdown-insert-reference-definition - (if (string-equal label "") text label) - url title))) - -(defun markdown-insert-reference-definition (label &optional url title) - "Add definition for reference LABEL with URL and TITLE. -LABEL is a Markdown reference label without square brackets. -URL and TITLE are optional. When given, the TITLE will -be used to populate the title attribute when converted to XHTML." - ;; END specifies where to leave the point upon return - (let ((end (point))) - (cl-case markdown-reference-location - (end (goto-char (point-max))) - (immediately (markdown-end-of-text-block)) - (subtree (markdown-end-of-subtree)) - (header (markdown-end-of-defun))) - ;; Skip backwards over local variables. This logic is similar to the one - ;; used in ‘hack-local-variables’. - (when (and enable-local-variables (eobp)) - (search-backward "\n\f" (max (- (point) 3000) (point-min)) :move) - (when (let ((case-fold-search t)) - (search-forward "Local Variables:" nil :move)) - (beginning-of-line 0) - (when (eq (char-before) ?\n) (backward-char)))) - (unless (or (markdown-cur-line-blank-p) - (thing-at-point-looking-at markdown-regex-reference-definition)) - (insert "\n")) - (insert "\n[" label "]: ") - (if url - (insert url) - ;; When no URL is given, leave point at END following the colon - (setq end (point))) - (when (> (length title) 0) - (insert " \"" title "\"")) - (unless (looking-at-p "\n") - (insert "\n")) - (goto-char end) - (when url - (message - (markdown--substitute-command-keys - "Reference [%s] was defined, press \\[markdown-do] to jump there") - label)))) - -(defcustom markdown-link-make-text-function nil - "Function that automatically generates a link text for a URL. - -If non-nil, this function will be called by -`markdown--insert-link-or-image' and the result will be the -default link text. The function should receive exactly one -argument that corresponds to the link URL." - :group 'markdown - :type 'function - :package-version '(markdown-mode . "2.5")) - -(defcustom markdown-disable-tooltip-prompt nil - "Disable prompt for tooltip when inserting a link or image. - -If non-nil, `markdown-insert-link' and `markdown-insert-link' -will not prompt the user to insert a tooltip text for the given -link or image." - :group 'markdown - :type 'boolean - :safe 'booleanp - :package-version '(markdown-mode . "2.5")) - -(defun markdown--insert-link-or-image (image) - "Interactively insert new or update an existing link or image. -When IMAGE is non-nil, insert an image. Otherwise, insert a link. -This is an internal function called by -`markdown-insert-link' and `markdown-insert-image'." - (cl-multiple-value-bind (begin end text uri ref title) - (if (use-region-p) - ;; Use region as either link text or URL as appropriate. - (let ((region (buffer-substring-no-properties - (region-beginning) (region-end)))) - (if (string-match markdown-regex-uri region) - ;; Region contains a URL; use it as such. - (list (region-beginning) (region-end) - nil (match-string 0 region) nil nil) - ;; Region doesn't contain a URL, so use it as text. - (list (region-beginning) (region-end) - region nil nil nil))) - ;; Extract and use properties of existing link, if any. - (markdown-link-at-pos (point))) - (let* ((ref (when ref (concat "[" ref "]"))) - (defined-refs (mapcar #'car (markdown-get-defined-references))) - (defined-ref-cands (mapcar (lambda (ref) (concat "[" ref "]")) defined-refs)) - (used-uris (markdown-get-used-uris)) - (uri-or-ref (completing-read - "URL or [reference]: " - (append defined-ref-cands used-uris) - nil nil (or uri ref))) - (ref (cond ((string-match "\\`\\[\\(.*\\)\\]\\'" uri-or-ref) - (match-string 1 uri-or-ref)) - ((string-equal "" uri-or-ref) - ""))) - (uri (unless ref uri-or-ref)) - (text-prompt (if image - "Alt text: " - (if ref - "Link text: " - "Link text (blank for plain URL): "))) - (text (or text (and markdown-link-make-text-function uri - (funcall markdown-link-make-text-function uri)))) - (text (completing-read text-prompt defined-refs nil nil text)) - (text (if (= (length text) 0) nil text)) - (plainp (and uri (not text))) - (implicitp (string-equal ref "")) - (ref (if implicitp text ref)) - (definedp (and ref (markdown-reference-definition ref))) - (ref-url (unless (or uri definedp) - (completing-read "Reference URL: " used-uris))) - (title (unless (or plainp definedp markdown-disable-tooltip-prompt) - (read-string "Title (tooltip text, optional): " title))) - (title (if (= (length title) 0) nil title))) - (when (and image implicitp) - (user-error "Reference required: implicit image references are invalid")) - (when (and begin end) - (delete-region begin end)) - (cond - ((and (not image) uri text) - (markdown-insert-inline-link text uri title)) - ((and image uri text) - (markdown-insert-inline-image text uri title)) - ((and ref text) - (if image - (markdown-insert-reference-image text (unless implicitp ref) nil title) - (markdown-insert-reference-link text (unless implicitp ref) nil title)) - (unless definedp - (markdown-insert-reference-definition ref ref-url title))) - ((and (not image) uri) - (markdown-insert-uri uri)))))) - -(defun markdown-insert-link () - "Insert new or update an existing link, with interactive prompt. -If the point is at an existing link or URL, update the link text, -URL, reference label, and/or title. Otherwise, insert a new link. -The type of link inserted (inline, reference, or plain URL) -depends on which values are provided: - -* If a URL and TEXT are given, insert an inline link: [TEXT](URL). -* If [REF] and TEXT are given, insert a reference link: [TEXT][REF]. -* If only TEXT is given, insert an implicit reference link: [TEXT][]. -* If only a URL is given, insert a plain link: <URL>. - -In other words, to create an implicit reference link, leave the -URL prompt empty and to create a plain URL link, leave the link -text empty. - -If there is an active region, use the text as the default URL, if -it seems to be a URL, or link text value otherwise. - -If a given reference is not defined, this function will -additionally prompt for the URL and optional title. In this case, -the reference definition is placed at the location determined by -`markdown-reference-location'. In addition, it is possible to -have the `markdown-link-make-text-function' function, if non-nil, -define the default link text before prompting the user for it. - -If `markdown-disable-tooltip-prompt' is non-nil, the user will -not be prompted to add or modify a tooltip text. - -Through updating the link, this function can be used to convert a -link of one type (inline, reference, or plain) to another type by -selectively adding or removing information via the prompts." - (interactive) - (markdown--insert-link-or-image nil)) - -(defun markdown-insert-image () - "Insert new or update an existing image, with interactive prompt. -If the point is at an existing image, update the alt text, URL, -reference label, and/or title. Otherwise, insert a new image. -The type of image inserted (inline or reference) depends on which -values are provided: - -* If a URL and ALT-TEXT are given, insert an inline image: - ![ALT-TEXT](URL). -* If [REF] and ALT-TEXT are given, insert a reference image: - ![ALT-TEXT][REF]. - -If there is an active region, use the text as the default URL, if -it seems to be a URL, or alt text value otherwise. - -If a given reference is not defined, this function will -additionally prompt for the URL and optional title. In this case, -the reference definition is placed at the location determined by -`markdown-reference-location'. - -Through updating the image, this function can be used to convert an -image of one type (inline or reference) to another type by -selectively adding or removing information via the prompts." - (interactive) - (markdown--insert-link-or-image t)) - -(defun markdown-insert-uri (&optional uri) - "Insert markup for an inline URI. -If there is an active region, use it as the URI. If the point is -at a URI, wrap it with angle brackets. If the point is at an -inline URI, remove the angle brackets. Otherwise, simply insert -angle brackets place the point between them." - (interactive) - (if (use-region-p) - ;; Active region - (let ((bounds (markdown-unwrap-things-in-region - (region-beginning) (region-end) - markdown-regex-angle-uri 0 2))) - (markdown-wrap-or-insert "<" ">" nil (car bounds) (cdr bounds))) - ;; Markup removal, URI at point, new URI, or empty markup insertion - (if (thing-at-point-looking-at markdown-regex-angle-uri) - (markdown-unwrap-thing-at-point nil 0 2) - (if uri - (insert "<" uri ">") - (markdown-wrap-or-insert "<" ">" 'url nil nil))))) - -(defun markdown-insert-wiki-link () - "Insert a wiki link of the form [[WikiLink]]. -If there is an active region, use the region as the link text. -If the point is at a word, use the word as the link text. If -there is no active region and the point is not at word, simply -insert link markup." - (interactive) - (if (use-region-p) - ;; Active region - (markdown-wrap-or-insert "[[" "]]" nil (region-beginning) (region-end)) - ;; Markup removal, wiki link at at point, or empty markup insertion - (if (thing-at-point-looking-at markdown-regex-wiki-link) - (if (or markdown-wiki-link-alias-first - (null (match-string 5))) - (markdown-unwrap-thing-at-point nil 1 3) - (markdown-unwrap-thing-at-point nil 1 5)) - (markdown-wrap-or-insert "[[" "]]")))) - -(defun markdown-remove-header () - "Remove header markup if point is at a header. -Return bounds of remaining header text if a header was removed -and nil otherwise." - (interactive "*") - (or (markdown-unwrap-thing-at-point markdown-regex-header-atx 0 2) - (markdown-unwrap-thing-at-point markdown-regex-header-setext 0 1))) - -(defun markdown-insert-header (&optional level text setext) - "Insert or replace header markup. -The level of the header is specified by LEVEL and header text is -given by TEXT. LEVEL must be an integer from 1 and 6, and the -default value is 1. -When TEXT is nil, the header text is obtained as follows. -If there is an active region, it is used as the header text. -Otherwise, the current line will be used as the header text. -If there is not an active region and the point is at a header, -remove the header markup and replace with level N header. -Otherwise, insert empty header markup and place the point in -between. -The style of the header will be atx (hash marks) unless -SETEXT is non-nil, in which case a setext-style (underlined) -header will be inserted." - (interactive "p\nsHeader text: ") - (setq level (min (max (or level 1) 1) (if setext 2 6))) - ;; Determine header text if not given - (when (null text) - (if (use-region-p) - ;; Active region - (setq text (delete-and-extract-region (region-beginning) (region-end))) - ;; No active region - (markdown-remove-header) - (setq text (delete-and-extract-region - (line-beginning-position) (line-end-position))) - (when (and setext (string-match-p "^[ \t]*$" text)) - (setq text (read-string "Header text: ")))) - (setq text (markdown-compress-whitespace-string text))) - ;; Insertion with given text - (markdown-ensure-blank-line-before) - (let (hdr) - (cond (setext - (setq hdr (make-string (string-width text) (if (= level 2) ?- ?=))) - (insert text "\n" hdr)) - (t - (setq hdr (make-string level ?#)) - (insert hdr " " text) - (when (null markdown-asymmetric-header) (insert " " hdr))))) - (markdown-ensure-blank-line-after) - ;; Leave point at end of text - (cond (setext - (backward-char (1+ (string-width text)))) - ((null markdown-asymmetric-header) - (backward-char (1+ level))))) - -(defun markdown-insert-header-dwim (&optional arg setext) - "Insert or replace header markup. -The level and type of the header are determined automatically by -the type and level of the previous header, unless a prefix -argument is given via ARG. -With a numeric prefix valued 1 to 6, insert a header of the given -level, with the type being determined automatically (note that -only level 1 or 2 setext headers are possible). - -With a \\[universal-argument] prefix (i.e., when ARG is (4)), -promote the heading by one level. -With two \\[universal-argument] prefixes (i.e., when ARG is (16)), -demote the heading by one level. -When SETEXT is non-nil, prefer setext-style headers when -possible (levels one and two). - -When there is an active region, use it for the header text. When -the point is at an existing header, change the type and level -according to the rules above. -Otherwise, if the line is not empty, create a header using the -text on the current line as the header text. -Finally, if the point is on a blank line, insert empty header -markup (atx) or prompt for text (setext). -See `markdown-insert-header' for more details about how the -header text is determined." - (interactive "*P") - (let (level) - (save-excursion - (when (or (thing-at-point-looking-at markdown-regex-header) - (re-search-backward markdown-regex-header nil t)) - ;; level of current or previous header - (setq level (markdown-outline-level)) - ;; match group 1 indicates a setext header - (setq setext (match-end 1)))) - ;; check prefix argument - (cond - ((and (equal arg '(4)) level (> level 1)) ;; C-u - (cl-decf level)) - ((and (equal arg '(16)) level (< level 6)) ;; C-u C-u - (cl-incf level)) - (arg ;; numeric prefix - (setq level (prefix-numeric-value arg)))) - ;; setext headers must be level one or two - (and level (setq setext (and setext (<= level 2)))) - ;; insert the heading - (markdown-insert-header level nil setext))) - -(defun markdown-insert-header-setext-dwim (&optional arg) - "Insert or replace header markup, with preference for setext. -See `markdown-insert-header-dwim' for details, including how ARG is handled." - (interactive "*P") - (markdown-insert-header-dwim arg t)) - -(defun markdown-insert-header-atx-1 () - "Insert a first level atx-style (hash mark) header. -See `markdown-insert-header'." - (interactive "*") - (markdown-insert-header 1 nil nil)) - -(defun markdown-insert-header-atx-2 () - "Insert a level two atx-style (hash mark) header. -See `markdown-insert-header'." - (interactive "*") - (markdown-insert-header 2 nil nil)) - -(defun markdown-insert-header-atx-3 () - "Insert a level three atx-style (hash mark) header. -See `markdown-insert-header'." - (interactive "*") - (markdown-insert-header 3 nil nil)) - -(defun markdown-insert-header-atx-4 () - "Insert a level four atx-style (hash mark) header. -See `markdown-insert-header'." - (interactive "*") - (markdown-insert-header 4 nil nil)) - -(defun markdown-insert-header-atx-5 () - "Insert a level five atx-style (hash mark) header. -See `markdown-insert-header'." - (interactive "*") - (markdown-insert-header 5 nil nil)) - -(defun markdown-insert-header-atx-6 () - "Insert a sixth level atx-style (hash mark) header. -See `markdown-insert-header'." - (interactive "*") - (markdown-insert-header 6 nil nil)) - -(defun markdown-insert-header-setext-1 () - "Insert a setext-style (underlined) first-level header. -See `markdown-insert-header'." - (interactive "*") - (markdown-insert-header 1 nil t)) - -(defun markdown-insert-header-setext-2 () - "Insert a setext-style (underlined) second-level header. -See `markdown-insert-header'." - (interactive "*") - (markdown-insert-header 2 nil t)) - -(defun markdown-blockquote-indentation (loc) - "Return string containing necessary indentation for a blockquote at LOC. -Also see `markdown-pre-indentation'." - (save-excursion - (goto-char loc) - (let* ((list-level (length (markdown-calculate-list-levels))) - (indent "")) - (dotimes (_ list-level indent) - (setq indent (concat indent " ")))))) - -(defun markdown-insert-blockquote () - "Start a blockquote section (or blockquote the region). -If Transient Mark mode is on and a region is active, it is used as -the blockquote text." - (interactive) - (if (use-region-p) - (markdown-blockquote-region (region-beginning) (region-end)) - (markdown-ensure-blank-line-before) - (insert (markdown-blockquote-indentation (point)) "> ") - (markdown-ensure-blank-line-after))) - -(defun markdown-block-region (beg end prefix) - "Format the region using a block prefix. -Arguments BEG and END specify the beginning and end of the -region. The characters PREFIX will appear at the beginning -of each line." - (save-excursion - (let* ((end-marker (make-marker)) - (beg-marker (make-marker)) - (prefix-without-trailing-whitespace - (replace-regexp-in-string (rx (+ blank) eos) "" prefix))) - ;; Ensure blank line after and remove extra whitespace - (goto-char end) - (skip-syntax-backward "-") - (set-marker end-marker (point)) - (delete-horizontal-space) - (markdown-ensure-blank-line-after) - ;; Ensure blank line before and remove extra whitespace - (goto-char beg) - (skip-syntax-forward "-") - (delete-horizontal-space) - (markdown-ensure-blank-line-before) - (set-marker beg-marker (point)) - ;; Insert PREFIX before each line - (goto-char beg-marker) - (while (and (< (line-beginning-position) end-marker) - (not (eobp))) - ;; Don’t insert trailing whitespace. - (insert (if (eolp) prefix-without-trailing-whitespace prefix)) - (forward-line))))) - -(defun markdown-blockquote-region (beg end) - "Blockquote the region. -Arguments BEG and END specify the beginning and end of the region." - (interactive "*r") - (markdown-block-region - beg end (concat (markdown-blockquote-indentation - (max (point-min) (1- beg))) "> "))) - -(defun markdown-pre-indentation (loc) - "Return string containing necessary whitespace for a pre block at LOC. -Also see `markdown-blockquote-indentation'." - (save-excursion - (goto-char loc) - (let* ((list-level (length (markdown-calculate-list-levels))) - indent) - (dotimes (_ (1+ list-level) indent) - (setq indent (concat indent " ")))))) - -(defun markdown-insert-pre () - "Start a preformatted section (or apply to the region). -If Transient Mark mode is on and a region is active, it is marked -as preformatted text." - (interactive) - (if (use-region-p) - (markdown-pre-region (region-beginning) (region-end)) - (markdown-ensure-blank-line-before) - (insert (markdown-pre-indentation (point))) - (markdown-ensure-blank-line-after))) - -(defun markdown-pre-region (beg end) - "Format the region as preformatted text. -Arguments BEG and END specify the beginning and end of the region." - (interactive "*r") - (let ((indent (markdown-pre-indentation (max (point-min) (1- beg))))) - (markdown-block-region beg end indent))) - -(defun markdown-electric-backquote (arg) - "Insert a backquote. -The numeric prefix argument ARG says how many times to repeat the insertion. -Call `markdown-insert-gfm-code-block' interactively -if three backquotes inserted at the beginning of line." - (interactive "*P") - (self-insert-command (prefix-numeric-value arg)) - (when (and markdown-gfm-use-electric-backquote (looking-back "^```" nil)) - (replace-match "") - (call-interactively #'markdown-insert-gfm-code-block))) - -(defconst markdown-gfm-recognized-languages - ;; To reproduce/update, evaluate the let-form in - ;; scripts/get-recognized-gfm-languages.el. that produces a single long sexp, - ;; but with appropriate use of a keyboard macro, indenting and filling it - ;; properly is pretty fast. - '("1C-Enterprise" "2-Dimensional-Array" "4D" "ABAP" "ABAP-CDS" "ABNF" - "AGS-Script" "AIDL" "AL" "AMPL" "ANTLR" "API-Blueprint" "APL" "ASL" - "ASN.1" "ASP.NET" "ATS" "ActionScript" "Ada" "Adblock-Filter-List" - "Adobe-Font-Metrics" "Agda" "Alloy" "Alpine-Abuild" "Altium-Designer" - "AngelScript" "Ant-Build-System" "Antlers" "ApacheConf" "Apex" - "Apollo-Guidance-Computer" "AppleScript" "Arc" "AsciiDoc" "AspectJ" - "Assembly" "Astro" "Asymptote" "Augeas" "AutoHotkey" "AutoIt" - "Avro-IDL" "Awk" "BASIC" "Ballerina" "Batchfile" "Beef" "Befunge" - "Berry" "BibTeX" "Bicep" "Bikeshed" "Bison" "BitBake" "Blade" - "BlitzBasic" "BlitzMax" "Bluespec" "Bluespec-BH" "Boo" "Boogie" - "Brainfuck" "BrighterScript" "Brightscript" "Browserslist" "C" "C#" - "C++" "C-ObjDump" "C2hs-Haskell" "CAP-CDS" "CIL" "CLIPS" "CMake" - "COBOL" "CODEOWNERS" "COLLADA" "CSON" "CSS" "CSV" "CUE" "CWeb" - "Cabal-Config" "Cadence" "Cairo" "CameLIGO" "Cap'n-Proto" "CartoCSS" - "Ceylon" "Chapel" "Charity" "Checksums" "ChucK" "Circom" "Cirru" - "Clarion" "Clarity" "Classic-ASP" "Clean" "Click" "Clojure" - "Closure-Templates" "Cloud-Firestore-Security-Rules" "CoNLL-U" - "CodeQL" "CoffeeScript" "ColdFusion" "ColdFusion-CFC" "Common-Lisp" - "Common-Workflow-Language" "Component-Pascal" "Cool" "Coq" - "Cpp-ObjDump" "Creole" "Crystal" "Csound" "Csound-Document" - "Csound-Score" "Cuda" "Cue-Sheet" "Curry" "Cycript" "Cypher" "Cython" - "D" "D-ObjDump" "D2" "DIGITAL-Command-Language" "DM" "DNS-Zone" - "DTrace" "Dafny" "Darcs-Patch" "Dart" "DataWeave" - "Debian-Package-Control-File" "DenizenScript" "Dhall" "Diff" - "DirectX-3D-File" "Dockerfile" "Dogescript" "Dotenv" "Dylan" "E" - "E-mail" "EBNF" "ECL" "ECLiPSe" "EJS" "EQ" "Eagle" "Earthly" - "Easybuild" "Ecere-Projects" "Ecmarkup" "Edge" "EdgeQL" - "EditorConfig" "Edje-Data-Collection" "Eiffel" "Elixir" "Elm" - "Elvish" "Elvish-Transcript" "Emacs-Lisp" "EmberScript" "Erlang" - "Euphoria" "F#" "F*" "FIGlet-Font" "FLUX" "Factor" "Fancy" "Fantom" - "Faust" "Fennel" "Filebench-WML" "Filterscript" "Fluent" "Formatted" - "Forth" "Fortran" "Fortran-Free-Form" "FreeBasic" "FreeMarker" - "Frege" "Futhark" "G-code" "GAML" "GAMS" "GAP" - "GCC-Machine-Description" "GDB" "GDScript" "GEDCOM" "GLSL" "GN" "GSC" - "Game-Maker-Language" "Gemfile.lock" "Gemini" "Genero-4gl" - "Genero-per" "Genie" "Genshi" "Gentoo-Ebuild" "Gentoo-Eclass" - "Gerber-Image" "Gettext-Catalog" "Gherkin" "Git-Attributes" - "Git-Config" "Git-Revision-List" "Gleam" "Glimmer-JS" "Glimmer-TS" - "Glyph" "Glyph-Bitmap-Distribution-Format" "Gnuplot" "Go" - "Go-Checksums" "Go-Module" "Go-Workspace" "Godot-Resource" "Golo" - "Gosu" "Grace" "Gradle" "Gradle-Kotlin-DSL" "Grammatical-Framework" - "Graph-Modeling-Language" "GraphQL" "Graphviz-(DOT)" "Groovy" - "Groovy-Server-Pages" "HAProxy" "HCL" "HLSL" "HOCON" "HTML" - "HTML+ECR" "HTML+EEX" "HTML+ERB" "HTML+PHP" "HTML+Razor" "HTTP" - "HXML" "Hack" "Haml" "Handlebars" "Harbour" "Haskell" "Haxe" "HiveQL" - "HolyC" "Hosts-File" "Hy" "HyPhy" "IDL" "IGOR-Pro" "INI" "IRC-log" - "Idris" "Ignore-List" "ImageJ-Macro" "Imba" "Inform-7" "Ink" - "Inno-Setup" "Io" "Ioke" "Isabelle" "Isabelle-ROOT" "J" - "JAR-Manifest" "JCL" "JFlex" "JSON" "JSON-with-Comments" "JSON5" - "JSONLD" "JSONiq" "Janet" "Jasmin" "Java" "Java-Properties" - "Java-Server-Pages" "JavaScript" "JavaScript+ERB" "Jest-Snapshot" - "JetBrains-MPS" "Jinja" "Jison" "Jison-Lex" "Jolie" "Jsonnet" "Julia" - "Jupyter-Notebook" "Just" "KRL" "Kaitai-Struct" "KakouneScript" - "KerboScript" "KiCad-Layout" "KiCad-Legacy-Layout" "KiCad-Schematic" - "Kickstart" "Kit" "Kotlin" "Kusto" "LFE" "LLVM" "LOLCODE" "LSL" - "LTspice-Symbol" "LabVIEW" "Lark" "Lasso" "Latte" "Lean" "Lean-4" - "Less" "Lex" "LigoLANG" "LilyPond" "Limbo" "Linker-Script" - "Linux-Kernel-Module" "Liquid" "Literate-Agda" - "Literate-CoffeeScript" "Literate-Haskell" "LiveScript" "Logos" - "Logtalk" "LookML" "LoomScript" "Lua" "M" "M4" "M4Sugar" "MATLAB" - "MAXScript" "MDX" "MLIR" "MQL4" "MQL5" "MTML" "MUF" "Macaulay2" - "Makefile" "Mako" "Markdown" "Marko" "Mask" "Mathematica" "Maven-POM" - "Max" "Mercury" "Mermaid" "Meson" "Metal" - "Microsoft-Developer-Studio-Project" - "Microsoft-Visual-Studio-Solution" "MiniD" "MiniYAML" "Mint" "Mirah" - "Modelica" "Modula-2" "Modula-3" "Module-Management-System" "Mojo" - "Monkey" "Monkey-C" "Moocode" "MoonScript" "Motoko" - "Motorola-68K-Assembly" "Move" "Muse" "Mustache" "Myghty" "NASL" - "NCL" "NEON" "NL" "NPM-Config" "NSIS" "NWScript" "Nasal" "Nearley" - "Nemerle" "NetLinx" "NetLinx+ERB" "NetLogo" "NewLisp" "Nextflow" - "Nginx" "Nim" "Ninja" "Nit" "Nix" "Nu" "NumPy" "Nunjucks" "Nushell" - "OASv2-json" "OASv2-yaml" "OASv3-json" "OASv3-yaml" "OCaml" "Oberon" - "ObjDump" "Object-Data-Instance-Notation" "ObjectScript" - "Objective-C" "Objective-C++" "Objective-J" "Odin" "Omgrofl" "Opa" - "Opal" "Open-Policy-Agent" "OpenAPI-Specification-v2" - "OpenAPI-Specification-v3" "OpenCL" "OpenEdge-ABL" "OpenQASM" - "OpenRC-runscript" "OpenSCAD" "OpenStep-Property-List" - "OpenType-Feature-File" "Option-List" "Org" "Ox" "Oxygene" "Oz" "P4" - "PDDL" "PEG.js" "PHP" "PLSQL" "PLpgSQL" "POV-Ray-SDL" "Pact" "Pan" - "Papyrus" "Parrot" "Parrot-Assembly" "Parrot-Internal-Representation" - "Pascal" "Pawn" "Pep8" "Perl" "Pic" "Pickle" "PicoLisp" "PigLatin" - "Pike" "Pip-Requirements" "PlantUML" "Pod" "Pod-6" "PogoScript" - "Polar" "Pony" "Portugol" "PostCSS" "PostScript" "PowerBuilder" - "PowerShell" "Praat" "Prisma" "Processing" "Procfile" "Proguard" - "Prolog" "Promela" "Propeller-Spin" "Protocol-Buffer" - "Protocol-Buffer-Text-Format" "Public-Key" "Pug" "Puppet" "Pure-Data" - "PureBasic" "PureScript" "Pyret" "Python" "Python-console" - "Python-traceback" "Q#" "QML" "QMake" "Qt-Script" "Quake" "R" "RAML" - "RBS" "RDoc" "REALbasic" "REXX" "RMarkdown" "RPC" "RPGLE" "RPM-Spec" - "RUNOFF" "Racket" "Ragel" "Raku" "Rascal" "Raw-token-data" "ReScript" - "Readline-Config" "Reason" "ReasonLIGO" "Rebol" "Record-Jar" "Red" - "Redcode" "Redirect-Rules" "Regular-Expression" "Ren'Py" - "RenderScript" "Rez" "Rich-Text-Format" "Ring" "Riot" - "RobotFramework" "Roc" "Roff" "Roff-Manpage" "Rouge" - "RouterOS-Script" "Ruby" "Rust" "SAS" "SCSS" "SELinux-Policy" "SMT" - "SPARQL" "SQF" "SQL" "SQLPL" "SRecode-Template" "SSH-Config" "STAR" - "STL" "STON" "SVG" "SWIG" "Sage" "SaltStack" "Sass" "Scala" "Scaml" - "Scenic" "Scheme" "Scilab" "Self" "ShaderLab" "Shell" - "ShellCheck-Config" "ShellSession" "Shen" "Sieve" - "Simple-File-Verification" "Singularity" "Slash" "Slice" "Slim" - "Slint" "SmPL" "Smali" "Smalltalk" "Smarty" "Smithy" "Snakemake" - "Solidity" "Soong" "SourcePawn" "Spline-Font-Database" "Squirrel" - "Stan" "Standard-ML" "Starlark" "Stata" "StringTemplate" "Stylus" - "SubRip-Text" "SugarSS" "SuperCollider" "Svelte" "Sway" "Sweave" - "Swift" "SystemVerilog" "TI-Program" "TL-Verilog" "TLA" "TOML" "TSQL" - "TSV" "TSX" "TXL" "Talon" "Tcl" "Tcsh" "TeX" "Tea" "Terra" - "Terraform-Template" "Texinfo" "Text" "TextGrid" - "TextMate-Properties" "Textile" "Thrift" "Toit" "Turing" "Turtle" - "Twig" "Type-Language" "TypeScript" "Typst" "Unified-Parallel-C" - "Unity3D-Asset" "Unix-Assembly" "Uno" "UnrealScript" "UrWeb" "V" - "VBA" "VBScript" "VCL" "VHDL" "Vala" "Valve-Data-Format" - "Velocity-Template-Language" "Verilog" "Vim-Help-File" "Vim-Script" - "Vim-Snippet" "Visual-Basic-.NET" "Visual-Basic-6.0" "Volt" "Vue" - "Vyper" "WDL" "WGSL" "Wavefront-Material" "Wavefront-Object" - "Web-Ontology-Language" "WebAssembly" "WebAssembly-Interface-Type" - "WebIDL" "WebVTT" "Wget-Config" "Whiley" "Wikitext" - "Win32-Message-File" "Windows-Registry-Entries" "Witcher-Script" - "Wollok" "World-of-Warcraft-Addon-Data" "Wren" "X-BitMap" - "X-Font-Directory-Index" "X-PixMap" "X10" "XC" "XCompose" "XML" - "XML-Property-List" "XPages" "XProc" "XQuery" "XS" "XSLT" "Xojo" - "Xonsh" "Xtend" "YAML" "YANG" "YARA" "YASnippet" "Yacc" "Yul" "ZAP" - "ZIL" "Zeek" "ZenScript" "Zephir" "Zig" "Zimpl" "cURL-Config" - "desktop" "dircolors" "eC" "edn" "fish" "hoon" "jq" "kvlang" - "mIRC-Script" "mcfunction" "mupad" "nanorc" "nesC" "ooc" "q" - "reStructuredText" "robots.txt" "sed" "wisp" "xBase") - "Language specifiers recognized by GitHub's syntax highlighting features.") - -(defvar-local markdown-gfm-used-languages nil - "Language names used in GFM code blocks.") - -(defun markdown-trim-whitespace (str) - (replace-regexp-in-string - "\\(?:[[:space:]\r\n]+\\'\\|\\`[[:space:]\r\n]+\\)" "" str)) - -(defun markdown-clean-language-string (str) - (replace-regexp-in-string - "{\\.?\\|}" "" (markdown-trim-whitespace str))) - -(defun markdown-validate-language-string (widget) - (let ((str (widget-value widget))) - (unless (string= str (markdown-clean-language-string str)) - (widget-put widget :error (format "Invalid language spec: '%s'" str)) - widget))) - -(defun markdown-gfm-get-corpus () - "Create corpus of recognized GFM code block languages for the given buffer." - (let ((given-corpus (append markdown-gfm-additional-languages - markdown-gfm-recognized-languages))) - (append - markdown-gfm-used-languages - (if markdown-gfm-downcase-languages (cl-mapcar #'downcase given-corpus) - given-corpus)))) - -(defun markdown-gfm-add-used-language (lang) - "Clean LANG and add to list of used languages." - (setq markdown-gfm-used-languages - (cons lang (remove lang markdown-gfm-used-languages)))) - -(defcustom markdown-spaces-after-code-fence 1 - "Number of space characters to insert after a code fence. -\\<gfm-mode-map>\\[markdown-insert-gfm-code-block] inserts this many spaces between an -opening code fence and an info string." - :group 'markdown - :type 'integer - :safe #'natnump - :package-version '(markdown-mode . "2.3")) - -(defcustom markdown-code-block-braces nil - "When non-nil, automatically insert braces for GFM code blocks." - :group 'markdown - :type 'boolean) - -(defun markdown-insert-gfm-code-block (&optional lang edit) - "Insert GFM code block for language LANG. -If LANG is nil, the language will be queried from user. If a -region is active, wrap this region with the markup instead. If -the region boundaries are not on empty lines, these are added -automatically in order to have the correct markup. When EDIT is -non-nil (e.g., when \\[universal-argument] is given), edit the -code block in an indirect buffer after insertion." - (interactive - (list (let ((completion-ignore-case nil)) - (condition-case nil - (markdown-clean-language-string - (completing-read - "Programming language: " - (markdown-gfm-get-corpus) - nil 'confirm (car markdown-gfm-used-languages) - 'markdown-gfm-language-history)) - (quit ""))) - current-prefix-arg)) - (unless (string= lang "") (markdown-gfm-add-used-language lang)) - (when (and (> (length lang) 0) - (not markdown-code-block-braces)) - (setq lang (concat (make-string markdown-spaces-after-code-fence ?\s) - lang))) - (let ((gfm-open-brace (if markdown-code-block-braces "{" "")) - (gfm-close-brace (if markdown-code-block-braces "}" ""))) - (if (use-region-p) - (let* ((b (region-beginning)) (e (region-end)) end - (indent (progn (goto-char b) (current-indentation)))) - (goto-char e) - ;; if we're on a blank line, don't newline, otherwise the ``` - ;; should go on its own line - (unless (looking-back "\n" nil) - (newline)) - (indent-to indent) - (insert "```") - (markdown-ensure-blank-line-after) - (setq end (point)) - (goto-char b) - ;; if we're on a blank line, insert the quotes here, otherwise - ;; add a new line first - (unless (looking-at-p "\n") - (newline) - (forward-line -1)) - (markdown-ensure-blank-line-before) - (indent-to indent) - (insert "```" gfm-open-brace lang gfm-close-brace) - (markdown-syntax-propertize-fenced-block-constructs (line-beginning-position) end)) - (let ((indent (current-indentation)) - start-bol) - (delete-horizontal-space :backward-only) - (markdown-ensure-blank-line-before) - (indent-to indent) - (setq start-bol (line-beginning-position)) - (insert "```" gfm-open-brace lang gfm-close-brace "\n") - (indent-to indent) - (unless edit (insert ?\n)) - (indent-to indent) - (insert "```") - (markdown-ensure-blank-line-after) - (markdown-syntax-propertize-fenced-block-constructs start-bol (point))) - (end-of-line 0) - (when edit (markdown-edit-code-block))))) - -(defun markdown-code-block-lang (&optional pos-prop) - "Return the language name for a GFM or tilde fenced code block. -The beginning of the block may be described by POS-PROP, -a cons of (pos . prop) giving the position and property -at the beginning of the block." - (or pos-prop - (setq pos-prop - (markdown-max-of-seq - #'car - (cl-remove-if - #'null - (cl-mapcar - #'markdown-find-previous-prop - (markdown-get-fenced-block-begin-properties)))))) - (when pos-prop - (goto-char (car pos-prop)) - (set-match-data (get-text-property (point) (cdr pos-prop))) - ;; Note: Hard-coded group number assumes tilde - ;; and GFM fenced code regexp groups agree. - (let ((begin (match-beginning 3)) - (end (match-end 3))) - (when (and begin end) - ;; Fix language strings beginning with periods, like ".ruby". - (when (eq (char-after begin) ?.) - (setq begin (1+ begin))) - (buffer-substring-no-properties begin end))))) - -(defun markdown-gfm-parse-buffer-for-languages (&optional buffer) - (with-current-buffer (or buffer (current-buffer)) - (save-excursion - (goto-char (point-min)) - (cl-loop - with prop = 'markdown-gfm-block-begin - for pos-prop = (markdown-find-next-prop prop) - while pos-prop - for lang = (markdown-code-block-lang pos-prop) - do (progn (when lang (markdown-gfm-add-used-language lang)) - (goto-char (next-single-property-change (point) prop))))))) - -(defun markdown-insert-foldable-block () - "Insert details disclosure element to make content foldable. -If a region is active, wrap this region with the disclosure -element. More details here https://developer.mozilla.org/en-US/docs/Web/HTML/Element/details." - (interactive) - (let ((details-open-tag "<details>") - (details-close-tag "</details>") - (summary-open-tag "<summary>") - (summary-close-tag " </summary>")) - (if (use-region-p) - (let* ((b (region-beginning)) - (e (region-end)) - (indent (progn (goto-char b) (current-indentation)))) - (goto-char e) - ;; if we're on a blank line, don't newline, otherwise the tags - ;; should go on its own line - (unless (looking-back "\n" nil) - (newline)) - (indent-to indent) - (insert details-close-tag) - (markdown-ensure-blank-line-after) - (goto-char b) - ;; if we're on a blank line, insert the quotes here, otherwise - ;; add a new line first - (unless (looking-at-p "\n") - (newline) - (forward-line -1)) - (markdown-ensure-blank-line-before) - (indent-to indent) - (insert details-open-tag "\n") - (insert summary-open-tag summary-close-tag) - (search-backward summary-close-tag)) - (let ((indent (current-indentation))) - (delete-horizontal-space :backward-only) - (markdown-ensure-blank-line-before) - (indent-to indent) - (insert details-open-tag "\n") - (insert summary-open-tag summary-close-tag "\n") - (insert details-close-tag) - (indent-to indent) - (markdown-ensure-blank-line-after) - (search-backward summary-close-tag))))) - - -;;; Footnotes ================================================================= - -(defun markdown-footnote-counter-inc () - "Increment `markdown-footnote-counter' and return the new value." - (when (= markdown-footnote-counter 0) ; hasn't been updated in this buffer yet. - (save-excursion - (goto-char (point-min)) - (while (re-search-forward (concat "^\\[\\^\\(" markdown-footnote-chars "*?\\)\\]:") - (point-max) t) - (let ((fn (string-to-number (match-string 1)))) - (when (> fn markdown-footnote-counter) - (setq markdown-footnote-counter fn)))))) - (cl-incf markdown-footnote-counter)) - -(defun markdown-insert-footnote () - "Insert footnote with a new number and move point to footnote definition." - (interactive) - (let ((fn (markdown-footnote-counter-inc))) - (insert (format "[^%d]" fn)) - (push-mark (point) t) - (markdown-footnote-text-find-new-location) - (markdown-ensure-blank-line-before) - (unless (markdown-cur-line-blank-p) - (insert "\n")) - (insert (format "[^%d]: " fn)) - (markdown-ensure-blank-line-after))) - -(defun markdown-footnote-text-find-new-location () - "Position the point at the proper location for a new footnote text." - (cond - ((eq markdown-footnote-location 'end) (goto-char (point-max))) - ((eq markdown-footnote-location 'immediately) (markdown-end-of-text-block)) - ((eq markdown-footnote-location 'subtree) (markdown-end-of-subtree)) - ((eq markdown-footnote-location 'header) (markdown-end-of-defun)))) - -(defun markdown-footnote-kill () - "Kill the footnote at point. -The footnote text is killed (and added to the kill ring), the -footnote marker is deleted. Point has to be either at the -footnote marker or in the footnote text." - (interactive) - (let ((marker-pos nil) - (skip-deleting-marker nil) - (starting-footnote-text-positions - (markdown-footnote-text-positions))) - (when starting-footnote-text-positions - ;; We're starting in footnote text, so mark our return position and jump - ;; to the marker if possible. - (let ((marker-pos (markdown-footnote-find-marker - (cl-first starting-footnote-text-positions)))) - (if marker-pos - (goto-char (1- marker-pos)) - ;; If there isn't a marker, we still want to kill the text. - (setq skip-deleting-marker t)))) - ;; Either we didn't start in the text, or we started in the text and jumped - ;; to the marker. We want to assume we're at the marker now and error if - ;; we're not. - (unless skip-deleting-marker - (let ((marker (markdown-footnote-delete-marker))) - (unless marker - (error "Not at a footnote")) - ;; Even if we knew the text position before, it changed when we deleted - ;; the label. - (setq marker-pos (cl-second marker)) - (let ((new-text-pos (markdown-footnote-find-text (cl-first marker)))) - (unless new-text-pos - (error "No text for footnote `%s'" (cl-first marker))) - (goto-char new-text-pos)))) - (let ((pos (markdown-footnote-kill-text))) - (goto-char (if starting-footnote-text-positions - pos - marker-pos))))) - -(defun markdown-footnote-delete-marker () - "Delete a footnote marker at point. -Returns a list (ID START) containing the footnote ID and the -start position of the marker before deletion. If no footnote -marker was deleted, this function returns NIL." - (let ((marker (markdown-footnote-marker-positions))) - (when marker - (delete-region (cl-second marker) (cl-third marker)) - (butlast marker)))) - -(defun markdown-footnote-kill-text () - "Kill footnote text at point. -Returns the start position of the footnote text before deletion, -or NIL if point was not inside a footnote text. - -The killed text is placed in the kill ring (without the footnote -number)." - (let ((fn (markdown-footnote-text-positions))) - (when fn - (let ((text (delete-and-extract-region (cl-second fn) (cl-third fn)))) - (string-match (concat "\\[\\" (cl-first fn) "\\]:[[:space:]]*\\(\\(.*\n?\\)*\\)") text) - (kill-new (match-string 1 text)) - (when (and (markdown-cur-line-blank-p) - (markdown-prev-line-blank-p) - (not (bobp))) - (delete-region (1- (point)) (point))) - (cl-second fn))))) - -(defun markdown-footnote-goto-text () - "Jump to the text of the footnote at point." - (interactive) - (let ((fn (car (markdown-footnote-marker-positions)))) - (unless fn - (user-error "Not at a footnote marker")) - (let ((new-pos (markdown-footnote-find-text fn))) - (unless new-pos - (error "No definition found for footnote `%s'" fn)) - (goto-char new-pos)))) - -(defun markdown-footnote-return () - "Return from a footnote to its footnote number in the main text." - (interactive) - (let ((fn (save-excursion - (car (markdown-footnote-text-positions))))) - (unless fn - (user-error "Not in a footnote")) - (let ((new-pos (markdown-footnote-find-marker fn))) - (unless new-pos - (error "Footnote marker `%s' not found" fn)) - (goto-char new-pos)))) - -(defun markdown-footnote-find-marker (id) - "Find the location of the footnote marker with ID. -The actual buffer position returned is the position directly -following the marker's closing bracket. If no marker is found, -NIL is returned." - (save-excursion - (goto-char (point-min)) - (when (re-search-forward (concat "\\[" id "\\]\\([^:]\\|\\'\\)") nil t) - (skip-chars-backward "^]") - (point)))) - -(defun markdown-footnote-find-text (id) - "Find the location of the text of footnote ID. -The actual buffer position returned is the position of the first -character of the text, after the footnote's identifier. If no -footnote text is found, NIL is returned." - (save-excursion - (goto-char (point-min)) - (when (re-search-forward (concat "^ \\{0,3\\}\\[" id "\\]:") nil t) - (skip-chars-forward "[ \t]") - (point)))) - -(defun markdown-footnote-marker-positions () - "Return the position and ID of the footnote marker point is on. -The return value is a list (ID START END). If point is not on a -footnote, NIL is returned." - ;; first make sure we're at a footnote marker - (if (or (looking-back (concat "\\[\\^" markdown-footnote-chars "*\\]?") (line-beginning-position)) - (looking-at-p (concat "\\[?\\^" markdown-footnote-chars "*?\\]"))) - (save-excursion - ;; move point between [ and ^: - (if (looking-at-p "\\[") - (forward-char 1) - (skip-chars-backward "^[")) - (looking-at (concat "\\(\\^" markdown-footnote-chars "*?\\)\\]")) - (list (match-string 1) (1- (match-beginning 1)) (1+ (match-end 1)))))) - -(defun markdown-footnote-text-positions () - "Return the start and end positions of the footnote text point is in. -The exact return value is a list of three elements: (ID START END). -The start position is the position of the opening bracket -of the footnote id. The end position is directly after the -newline that ends the footnote. If point is not in a footnote, -NIL is returned instead." - (save-excursion - (let (result) - (move-beginning-of-line 1) - ;; Try to find the label. If we haven't found the label and we're at a blank - ;; or indented line, back up if possible. - (while (and - (not (and (looking-at markdown-regex-footnote-definition) - (setq result (list (match-string 1) (point))))) - (and (not (bobp)) - (or (markdown-cur-line-blank-p) - (>= (current-indentation) 4)))) - (forward-line -1)) - (when result - ;; Advance if there is a next line that is either blank or indented. - ;; (Need to check if we're on the last line, because - ;; markdown-next-line-blank-p returns true for last line in buffer.) - (while (and (/= (line-end-position) (point-max)) - (or (markdown-next-line-blank-p) - (>= (markdown-next-line-indent) 4))) - (forward-line)) - ;; Move back while the current line is blank. - (while (markdown-cur-line-blank-p) - (forward-line -1)) - ;; Advance to capture this line and a single trailing newline (if there - ;; is one). - (forward-line) - (append result (list (point))))))) - -(defun markdown-get-defined-footnotes () - "Return a list of all defined footnotes. -Result is an alist of pairs (MARKER . LINE), where MARKER is the -footnote marker, a string, and LINE is the line number containing -the footnote definition. - -For example, suppose the following footnotes are defined at positions -448 and 475: - -\[^1]: First footnote here. -\[^marker]: Second footnote. - -Then the returned list is: ((\"^1\" . 478) (\"^marker\" . 475))" - (save-excursion - (goto-char (point-min)) - (let (footnotes) - (while (markdown-search-until-condition - (lambda () (and (not (markdown-code-block-at-point-p)) - (not (markdown-inline-code-at-point-p)) - (not (markdown-in-comment-p)))) - markdown-regex-footnote-definition nil t) - (let ((marker (match-string-no-properties 1)) - (pos (match-beginning 0))) - (unless (zerop (length marker)) - (cl-pushnew (cons marker pos) footnotes :test #'equal)))) - (reverse footnotes)))) - - -;;; Element Removal =========================================================== - -(defun markdown-kill-thing-at-point () - "Kill thing at point and add important text, without markup, to kill ring. -Possible things to kill include (roughly in order of precedence): -inline code, headers, horizontal rules, links (add link text to -kill ring), images (add alt text to kill ring), angle uri, email -addresses, bold, italics, reference definition (add URI to kill -ring), footnote markers and text (kill both marker and text, add -text to kill ring), and list items." - (interactive "*") - (let (val) - (cond - ;; Inline code - ((markdown-inline-code-at-point) - (kill-new (match-string 2)) - (delete-region (match-beginning 0) (match-end 0))) - ;; ATX header - ((thing-at-point-looking-at markdown-regex-header-atx) - (kill-new (match-string 2)) - (delete-region (match-beginning 0) (match-end 0))) - ;; Setext header - ((thing-at-point-looking-at markdown-regex-header-setext) - (kill-new (match-string 1)) - (delete-region (match-beginning 0) (match-end 0))) - ;; Horizontal rule - ((thing-at-point-looking-at markdown-regex-hr) - (kill-new (match-string 0)) - (delete-region (match-beginning 0) (match-end 0))) - ;; Inline link or image (add link or alt text to kill ring) - ((thing-at-point-looking-at markdown-regex-link-inline) - (kill-new (match-string 3)) - (delete-region (match-beginning 0) (match-end 0))) - ;; Reference link or image (add link or alt text to kill ring) - ((thing-at-point-looking-at markdown-regex-link-reference) - (kill-new (match-string 3)) - (delete-region (match-beginning 0) (match-end 0))) - ;; Angle URI (add URL to kill ring) - ((thing-at-point-looking-at markdown-regex-angle-uri) - (kill-new (match-string 2)) - (delete-region (match-beginning 0) (match-end 0))) - ;; Email address in angle brackets (add email address to kill ring) - ((thing-at-point-looking-at markdown-regex-email) - (kill-new (match-string 1)) - (delete-region (match-beginning 0) (match-end 0))) - ;; Wiki link (add alias text to kill ring) - ((and markdown-enable-wiki-links - (thing-at-point-looking-at markdown-regex-wiki-link)) - (kill-new (markdown-wiki-link-alias)) - (delete-region (match-beginning 1) (match-end 1))) - ;; Bold - ((thing-at-point-looking-at markdown-regex-bold) - (kill-new (match-string 4)) - (delete-region (match-beginning 2) (match-end 2))) - ;; Italics - ((thing-at-point-looking-at markdown-regex-italic) - (kill-new (match-string 3)) - (delete-region (match-beginning 1) (match-end 1))) - ;; Strikethrough - ((thing-at-point-looking-at markdown-regex-strike-through) - (kill-new (match-string 4)) - (delete-region (match-beginning 2) (match-end 2))) - ;; Footnote marker (add footnote text to kill ring) - ((thing-at-point-looking-at markdown-regex-footnote) - (markdown-footnote-kill)) - ;; Footnote text (add footnote text to kill ring) - ((setq val (markdown-footnote-text-positions)) - (markdown-footnote-kill)) - ;; Reference definition (add URL to kill ring) - ((thing-at-point-looking-at markdown-regex-reference-definition) - (kill-new (match-string 5)) - (delete-region (match-beginning 0) (match-end 0))) - ;; List item - ((setq val (markdown-cur-list-item-bounds)) - (kill-new (delete-and-extract-region (cl-first val) (cl-second val)))) - (t - (user-error "Nothing found at point to kill"))))) - -(defun markdown-kill-outline () - "Kill visible heading and add it to `kill-ring'." - (interactive) - (save-excursion - (markdown-outline-previous) - (kill-region (point) (progn (markdown-outline-next) (point))))) - -(defun markdown-kill-block () - "Kill visible code block, list item, or blockquote and add it to `kill-ring'." - (interactive) - (save-excursion - (markdown-backward-block) - (kill-region (point) (progn (markdown-forward-block) (point))))) - - -;;; Indentation =============================================================== - -(defun markdown-indent-find-next-position (cur-pos positions) - "Return the position after the index of CUR-POS in POSITIONS. -Positions are calculated by `markdown-calc-indents'." - (while (and positions - (not (equal cur-pos (car positions)))) - (setq positions (cdr positions))) - (or (cadr positions) 0)) - -(defun markdown-outdent-find-next-position (cur-pos positions) - "Return the maximal element that precedes CUR-POS from POSITIONS. -Positions are calculated by `markdown-calc-indents'." - (let ((result 0)) - (dolist (i positions) - (when (< i cur-pos) - (setq result (max result i)))) - result)) - -(defun markdown-indent-line () - "Indent the current line using some heuristics. -If the _previous_ command was either `markdown-enter-key' or -`markdown-cycle', then we should cycle to the next -reasonable indentation position. Otherwise, we could have been -called directly by `markdown-enter-key', by an initial call of -`markdown-cycle', or indirectly by `auto-fill-mode'. In -these cases, indent to the default position. -Positions are calculated by `markdown-calc-indents'." - (interactive) - (let ((positions (markdown-calc-indents)) - (point-pos (current-column)) - (_ (back-to-indentation)) - (cur-pos (current-column))) - (if (not (equal this-command 'markdown-cycle)) - (indent-line-to (car positions)) - (setq positions (sort (delete-dups positions) '<)) - (let* ((next-pos (markdown-indent-find-next-position cur-pos positions)) - (new-point-pos (max (+ point-pos (- next-pos cur-pos)) 0))) - (indent-line-to next-pos) - (move-to-column new-point-pos))))) - -(defun markdown-calc-indents () - "Return a list of indentation columns to cycle through. -The first element in the returned list should be considered the -default indentation level. This function does not worry about -duplicate positions, which are handled up by calling functions." - (let (pos prev-line-pos positions) - - ;; Indentation of previous line - (setq prev-line-pos (markdown-prev-line-indent)) - (setq positions (cons prev-line-pos positions)) - - ;; Indentation of previous non-list-marker text - (when (setq pos (save-excursion - (forward-line -1) - (when (looking-at markdown-regex-list) - (- (match-end 3) (match-beginning 0))))) - (setq positions (cons pos positions))) - - ;; Indentation required for a pre block in current context - (setq pos (length (markdown-pre-indentation (point)))) - (setq positions (cons pos positions)) - - ;; Indentation of the previous line + tab-width - (if prev-line-pos - (setq positions (cons (+ prev-line-pos tab-width) positions)) - (setq positions (cons tab-width positions))) - - ;; Indentation of the previous line - tab-width - (if (and prev-line-pos (> prev-line-pos tab-width)) - (setq positions (cons (- prev-line-pos tab-width) positions))) - - ;; Indentation of all preceding list markers (when in a list) - (when (setq pos (markdown-calculate-list-levels)) - (setq positions (append pos positions))) - - ;; First column - (setq positions (cons 0 positions)) - - ;; Return reversed list - (reverse positions))) - -(defun markdown-enter-key () ;FIXME: Partly obsoleted by electric-indent - "Handle RET depending on the context. -If the point is at a table, move to the next row. Otherwise, -indent according to value of `markdown-indent-on-enter'. -When it is nil, simply call `newline'. Otherwise, indent the next line -following RET using `markdown-indent-line'. Furthermore, when it -is set to \\='indent-and-new-item and the point is in a list item, -start a new item with the same indentation. If the point is in an -empty list item, remove it (so that pressing RET twice when in a -list simply adds a blank line)." - (interactive) - (cond - ;; Table - ((markdown-table-at-point-p) - (call-interactively #'markdown-table-next-row)) - ;; Indent non-table text - (markdown-indent-on-enter - (let (bounds) - (if (and (memq markdown-indent-on-enter '(indent-and-new-item)) - (setq bounds (markdown-cur-list-item-bounds))) - (let ((beg (cl-first bounds)) - (end (cl-second bounds)) - (nonlist-indent (cl-fourth bounds)) - (checkbox (cl-sixth bounds))) - ;; Point is in a list item - (if (= (- end beg) (+ nonlist-indent (length checkbox))) - ;; Delete blank list - (progn - (delete-region beg end) - (newline) - (markdown-indent-line)) - (call-interactively #'markdown-insert-list-item))) - ;; Point is not in a list - (newline) - (markdown-indent-line)))) - ;; Insert a raw newline - (t (newline)))) - -(defun markdown-outdent-or-delete (arg) - "Handle BACKSPACE by cycling through indentation points. -When BACKSPACE is pressed, if there is only whitespace -before the current point, then outdent the line one level. -Otherwise, do normal delete by repeating -`backward-delete-char-untabify' ARG times." - (interactive "*p") - (if (use-region-p) - (backward-delete-char-untabify arg) - (let ((cur-pos (current-column)) - (start-of-indention (save-excursion - (back-to-indentation) - (current-column))) - (positions (markdown-calc-indents))) - (if (and (> cur-pos 0) (= cur-pos start-of-indention)) - (indent-line-to (markdown-outdent-find-next-position cur-pos positions)) - (backward-delete-char-untabify arg))))) - -(defun markdown-find-leftmost-column (beg end) - "Find the leftmost column in the region from BEG to END." - (let ((mincol 1000)) - (save-excursion - (goto-char beg) - (while (< (point) end) - (back-to-indentation) - (unless (looking-at-p "[ \t]*$") - (setq mincol (min mincol (current-column)))) - (forward-line 1) - )) - mincol)) - -(defun markdown-indent-region (beg end arg) - "Indent the region from BEG to END using some heuristics. -When ARG is non-nil, outdent the region instead. -See `markdown-indent-line' and `markdown-indent-line'." - (interactive "*r\nP") - (let* ((positions (sort (delete-dups (markdown-calc-indents)) '<)) - (leftmostcol (markdown-find-leftmost-column beg end)) - (next-pos (if arg - (markdown-outdent-find-next-position leftmostcol positions) - (markdown-indent-find-next-position leftmostcol positions)))) - (indent-rigidly beg end (- next-pos leftmostcol)) - (setq deactivate-mark nil))) - -(defun markdown-outdent-region (beg end) - "Call `markdown-indent-region' on region from BEG to END with prefix." - (interactive "*r") - (markdown-indent-region beg end t)) - -(defun markdown--indent-region (start end) - (let ((deactivate-mark nil)) - (save-excursion - (goto-char end) - (setq end (point-marker)) - (goto-char start) - (when (bolp) - (forward-line 1)) - (while (< (point) end) - (unless (or (markdown-code-block-at-point-p) (and (bolp) (eolp))) - (indent-according-to-mode)) - (forward-line 1)) - (move-marker end nil)))) - - -;;; Markup Completion ========================================================= - -(defconst markdown-complete-alist - '((markdown-regex-header-atx . markdown-complete-atx) - (markdown-regex-header-setext . markdown-complete-setext) - (markdown-regex-hr . markdown-complete-hr)) - "Association list of form (regexp . function) for markup completion.") - -(defun markdown-incomplete-atx-p () - "Return t if ATX header markup is incomplete and nil otherwise. -Assumes match data is available for `markdown-regex-header-atx'. -Checks that the number of trailing hash marks equals the number of leading -hash marks, that there is only a single space before and after the text, -and that there is no extraneous whitespace in the text." - (or - ;; Number of starting and ending hash marks differs - (not (= (length (match-string 1)) (length (match-string 3)))) - ;; When the header text is not empty... - (and (> (length (match-string 2)) 0) - ;; ...if there are extra leading, trailing, or interior spaces - (or (not (= (match-beginning 2) (1+ (match-end 1)))) - (not (= (match-beginning 3) (1+ (match-end 2)))) - (string-match-p "[ \t\n]\\{2\\}" (match-string 2)))) - ;; When the header text is empty... - (and (= (length (match-string 2)) 0) - ;; ...if there are too many or too few spaces - (not (= (match-beginning 3) (+ (match-end 1) 2)))))) - -(defun markdown-complete-atx () - "Complete and normalize ATX headers. -Add or remove hash marks to the end of the header to match the -beginning. Ensure that there is only a single space between hash -marks and header text. Removes extraneous whitespace from header text. -Assumes match data is available for `markdown-regex-header-atx'. -Return nil if markup was complete and non-nil if markup was completed." - (when (markdown-incomplete-atx-p) - (let* ((new-marker (make-marker)) - (new-marker (set-marker new-marker (match-end 2)))) - ;; Hash marks and spacing at end - (goto-char (match-end 2)) - (delete-region (match-end 2) (match-end 3)) - (insert " " (match-string 1)) - ;; Remove extraneous whitespace from title - (replace-match (markdown-compress-whitespace-string (match-string 2)) - t t nil 2) - ;; Spacing at beginning - (goto-char (match-end 1)) - (delete-region (match-end 1) (match-beginning 2)) - (insert " ") - ;; Leave point at end of text - (goto-char new-marker)))) - -(defun markdown-incomplete-setext-p () - "Return t if setext header markup is incomplete and nil otherwise. -Assumes match data is available for `markdown-regex-header-setext'. -Checks that length of underline matches text and that there is no -extraneous whitespace in the text." - (or (not (= (length (match-string 1)) (length (match-string 2)))) - (string-match-p "[ \t\n]\\{2\\}" (match-string 1)))) - -(defun markdown-complete-setext () - "Complete and normalize setext headers. -Add or remove underline characters to match length of header -text. Removes extraneous whitespace from header text. Assumes -match data is available for `markdown-regex-header-setext'. -Return nil if markup was complete and non-nil if markup was completed." - (when (markdown-incomplete-setext-p) - (let* ((text (markdown-compress-whitespace-string (match-string 1))) - (char (char-after (match-beginning 2))) - (level (if (char-equal char ?-) 2 1))) - (goto-char (match-beginning 0)) - (delete-region (match-beginning 0) (match-end 0)) - (markdown-insert-header level text t) - t))) - -(defun markdown-incomplete-hr-p () - "Return non-nil if hr is not in `markdown-hr-strings' and nil otherwise. -Assumes match data is available for `markdown-regex-hr'." - (not (member (match-string 0) markdown-hr-strings))) - -(defun markdown-complete-hr () - "Complete horizontal rules. -If horizontal rule string is a member of `markdown-hr-strings', -do nothing. Otherwise, replace with the car of -`markdown-hr-strings'. -Assumes match data is available for `markdown-regex-hr'. -Return nil if markup was complete and non-nil if markup was completed." - (when (markdown-incomplete-hr-p) - (replace-match (car markdown-hr-strings)) - t)) - -(defun markdown-complete () - "Complete markup of object near point or in region when active. -Handle all objects in `markdown-complete-alist', in order. -See `markdown-complete-at-point' and `markdown-complete-region'." - (interactive "*") - (if (use-region-p) - (markdown-complete-region (region-beginning) (region-end)) - (markdown-complete-at-point))) - -(defun markdown-complete-at-point () - "Complete markup of object near point. -Handle all elements of `markdown-complete-alist' in order." - (interactive "*") - (let ((list markdown-complete-alist) found changed) - (while list - (let ((regexp (eval (caar list) t)) ;FIXME: Why `eval'? - (function (cdar list))) - (setq list (cdr list)) - (when (thing-at-point-looking-at regexp) - (setq found t) - (setq changed (funcall function)) - (setq list nil)))) - (if found - (or changed (user-error "Markup at point is complete")) - (user-error "Nothing to complete at point")))) - -(defun markdown-complete-region (beg end) - "Complete markup of objects in region from BEG to END. -Handle all objects in `markdown-complete-alist', in order. Each -match is checked to ensure that a previous regexp does not also -match." - (interactive "*r") - (let ((end-marker (set-marker (make-marker) end)) - previous) - (dolist (element markdown-complete-alist) - (let ((regexp (eval (car element) t)) ;FIXME: Why `eval'? - (function (cdr element))) - (goto-char beg) - (while (re-search-forward regexp end-marker 'limit) - (when (match-string 0) - ;; Make sure this is not a match for any of the preceding regexps. - ;; This prevents mistaking an HR for a Setext subheading. - (let (match) - (save-match-data - (dolist (prev-regexp previous) - (or match (setq match (looking-back prev-regexp nil))))) - (unless match - (save-excursion (funcall function)))))) - (cl-pushnew regexp previous :test #'equal))) - previous)) - -(defun markdown-complete-buffer () - "Complete markup for all objects in the current buffer." - (interactive "*") - (markdown-complete-region (point-min) (point-max))) - - -;;; Markup Cycling ============================================================ - -(defun markdown-cycle-atx (arg &optional remove) - "Cycle ATX header markup. -Promote header (decrease level) when ARG is 1 and demote -header (increase level) if arg is -1. When REMOVE is non-nil, -remove the header when the level reaches zero and stop cycling -when it reaches six. Otherwise, perform a proper cycling through -levels one through six. Assumes match data is available for -`markdown-regex-header-atx'." - (let* ((old-level (length (match-string 1))) - (new-level (+ old-level arg)) - (text (match-string 2))) - (when (not remove) - (setq new-level (% new-level 6)) - (setq new-level (cond ((= new-level 0) 6) - ((< new-level 0) (+ new-level 6)) - (t new-level)))) - (cond - ((= new-level 0) - (markdown-unwrap-thing-at-point nil 0 2)) - ((<= new-level 6) - (goto-char (match-beginning 0)) - (delete-region (match-beginning 0) (match-end 0)) - (markdown-insert-header new-level text nil))))) - -(defun markdown-cycle-setext (arg &optional remove) - "Cycle setext header markup. -Promote header (increase level) when ARG is 1 and demote -header (decrease level or remove) if arg is -1. When demoting a -level-two setext header, replace with a level-three atx header. -When REMOVE is non-nil, remove the header when the level reaches -zero. Otherwise, cycle back to a level six atx header. Assumes -match data is available for `markdown-regex-header-setext'." - (let* ((char (char-after (match-beginning 2))) - (old-level (if (char-equal char ?=) 1 2)) - (new-level (+ old-level arg))) - (when (and (not remove) (= new-level 0)) - (setq new-level 6)) - (cond - ((= new-level 0) - (markdown-unwrap-thing-at-point nil 0 1)) - ((<= new-level 2) - (markdown-insert-header new-level nil t)) - ((<= new-level 6) - (markdown-insert-header new-level nil nil))))) - -(defun markdown-cycle-hr (arg &optional remove) - "Cycle string used for horizontal rule from `markdown-hr-strings'. -When ARG is 1, cycle forward (demote), and when ARG is -1, cycle -backwards (promote). When REMOVE is non-nil, remove the hr instead -of cycling when the end of the list is reached. -Assumes match data is available for `markdown-regex-hr'." - (let* ((strings (if (= arg -1) - (reverse markdown-hr-strings) - markdown-hr-strings)) - (tail (member (match-string 0) strings)) - (new (or (cadr tail) - (if remove - (if (= arg 1) - "" - (car tail)) - (car strings))))) - (replace-match new))) - -(defun markdown-cycle-bold () - "Cycle bold markup between underscores and asterisks. -Assumes match data is available for `markdown-regex-bold'." - (save-excursion - (let* ((old-delim (match-string 3)) - (new-delim (if (string-equal old-delim "**") "__" "**"))) - (replace-match new-delim t t nil 3) - (replace-match new-delim t t nil 5)))) - -(defun markdown-cycle-italic () - "Cycle italic markup between underscores and asterisks. -Assumes match data is available for `markdown-regex-italic'." - (save-excursion - (let* ((old-delim (match-string 2)) - (new-delim (if (string-equal old-delim "*") "_" "*"))) - (replace-match new-delim t t nil 2) - (replace-match new-delim t t nil 4)))) - - -;;; Keymap ==================================================================== - -(defun markdown--style-map-prompt () - "Return a formatted prompt for Markdown markup insertion." - (when markdown-enable-prefix-prompts - (concat - "Markdown: " - (propertize "bold" 'face 'markdown-bold-face) ", " - (propertize "italic" 'face 'markdown-italic-face) ", " - (propertize "code" 'face 'markdown-inline-code-face) ", " - (propertize "C = GFM code" 'face 'markdown-code-face) ", " - (propertize "pre" 'face 'markdown-pre-face) ", " - (propertize "footnote" 'face 'markdown-footnote-text-face) ", " - (propertize "F = foldable" 'face 'markdown-bold-face) ", " - (propertize "q = blockquote" 'face 'markdown-blockquote-face) ", " - (propertize "h & 1-6 = heading" 'face 'markdown-header-face) ", " - (propertize "- = hr" 'face 'markdown-hr-face) ", " - "C-h = more"))) - -(defun markdown--command-map-prompt () - "Return prompt for Markdown buffer-wide commands." - (when markdown-enable-prefix-prompts - (concat - "Command: " - (propertize "m" 'face 'markdown-bold-face) "arkdown, " - (propertize "p" 'face 'markdown-bold-face) "review, " - (propertize "o" 'face 'markdown-bold-face) "pen, " - (propertize "e" 'face 'markdown-bold-face) "xport, " - "export & pre" (propertize "v" 'face 'markdown-bold-face) "iew, " - (propertize "c" 'face 'markdown-bold-face) "heck refs, " - (propertize "u" 'face 'markdown-bold-face) "nused refs, " - "C-h = more"))) - -(defvar markdown-mode-style-map - (let ((map (make-keymap (markdown--style-map-prompt)))) - (define-key map (kbd "1") 'markdown-insert-header-atx-1) - (define-key map (kbd "2") 'markdown-insert-header-atx-2) - (define-key map (kbd "3") 'markdown-insert-header-atx-3) - (define-key map (kbd "4") 'markdown-insert-header-atx-4) - (define-key map (kbd "5") 'markdown-insert-header-atx-5) - (define-key map (kbd "6") 'markdown-insert-header-atx-6) - (define-key map (kbd "!") 'markdown-insert-header-setext-1) - (define-key map (kbd "@") 'markdown-insert-header-setext-2) - (define-key map (kbd "b") 'markdown-insert-bold) - (define-key map (kbd "c") 'markdown-insert-code) - (define-key map (kbd "C") 'markdown-insert-gfm-code-block) - (define-key map (kbd "f") 'markdown-insert-footnote) - (define-key map (kbd "F") 'markdown-insert-foldable-block) - (define-key map (kbd "h") 'markdown-insert-header-dwim) - (define-key map (kbd "H") 'markdown-insert-header-setext-dwim) - (define-key map (kbd "i") 'markdown-insert-italic) - (define-key map (kbd "k") 'markdown-insert-kbd) - (define-key map (kbd "l") 'markdown-insert-link) - (define-key map (kbd "p") 'markdown-insert-pre) - (define-key map (kbd "P") 'markdown-pre-region) - (define-key map (kbd "q") 'markdown-insert-blockquote) - (define-key map (kbd "s") 'markdown-insert-strike-through) - (define-key map (kbd "t") 'markdown-insert-table) - (define-key map (kbd "Q") 'markdown-blockquote-region) - (define-key map (kbd "w") 'markdown-insert-wiki-link) - (define-key map (kbd "-") 'markdown-insert-hr) - (define-key map (kbd "[") 'markdown-insert-gfm-checkbox) - ;; Deprecated keys that may be removed in a future version - (define-key map (kbd "e") 'markdown-insert-italic) - map) - "Keymap for Markdown text styling commands.") - -(defvar markdown-mode-command-map - (let ((map (make-keymap (markdown--command-map-prompt)))) - (define-key map (kbd "m") 'markdown-other-window) - (define-key map (kbd "p") 'markdown-preview) - (define-key map (kbd "e") 'markdown-export) - (define-key map (kbd "v") 'markdown-export-and-preview) - (define-key map (kbd "o") 'markdown-open) - (define-key map (kbd "l") 'markdown-live-preview-mode) - (define-key map (kbd "w") 'markdown-kill-ring-save) - (define-key map (kbd "c") 'markdown-check-refs) - (define-key map (kbd "u") 'markdown-unused-refs) - (define-key map (kbd "n") 'markdown-cleanup-list-numbers) - (define-key map (kbd "]") 'markdown-complete-buffer) - (define-key map (kbd "^") 'markdown-table-sort-lines) - (define-key map (kbd "|") 'markdown-table-convert-region) - (define-key map (kbd "t") 'markdown-table-transpose) - map) - "Keymap for Markdown buffer-wide commands.") - -(defvar markdown-mode-map - (let ((map (make-keymap))) - ;; Markup insertion & removal - (define-key map (kbd "C-c C-s") markdown-mode-style-map) - (define-key map (kbd "C-c C-l") 'markdown-insert-link) - (define-key map (kbd "C-c C-k") 'markdown-kill-thing-at-point) - ;; Promotion, demotion, and cycling - (define-key map (kbd "C-c C--") 'markdown-promote) - (define-key map (kbd "C-c C-=") 'markdown-demote) - (define-key map (kbd "C-c C-]") 'markdown-complete) - ;; Following and doing things - (define-key map (kbd "C-c C-o") 'markdown-follow-thing-at-point) - (define-key map (kbd "C-c C-d") 'markdown-do) - (define-key map (kbd "C-c '") 'markdown-edit-code-block) - ;; Indentation - (define-key map (kbd "RET") 'markdown-enter-key) - (define-key map (kbd "DEL") 'markdown-outdent-or-delete) - (define-key map (kbd "C-c >") 'markdown-indent-region) - (define-key map (kbd "C-c <") 'markdown-outdent-region) - ;; Visibility cycling - (define-key map (kbd "TAB") 'markdown-cycle) - ;; S-iso-lefttab and S-tab should both be mapped to `backtab' by - ;; (local-)function-key-map. - ;;(define-key map (kbd "<S-iso-lefttab>") 'markdown-shifttab) - ;;(define-key map (kbd "<S-tab>") 'markdown-shifttab) - (define-key map (kbd "<backtab>") 'markdown-shifttab) - ;; Heading and list navigation - (define-key map (kbd "C-c C-n") 'markdown-outline-next) - (define-key map (kbd "C-c C-p") 'markdown-outline-previous) - (define-key map (kbd "C-c C-f") 'markdown-outline-next-same-level) - (define-key map (kbd "C-c C-b") 'markdown-outline-previous-same-level) - (define-key map (kbd "C-c C-u") 'markdown-outline-up) - ;; Buffer-wide commands - (define-key map (kbd "C-c C-c") markdown-mode-command-map) - ;; Subtree, list, and table editing - (define-key map (kbd "C-c <up>") 'markdown-move-up) - (define-key map (kbd "C-c <down>") 'markdown-move-down) - (define-key map (kbd "C-c <left>") 'markdown-promote) - (define-key map (kbd "C-c <right>") 'markdown-demote) - (define-key map (kbd "C-c S-<up>") 'markdown-table-delete-row) - (define-key map (kbd "C-c S-<down>") 'markdown-table-insert-row) - (define-key map (kbd "C-c S-<left>") 'markdown-table-delete-column) - (define-key map (kbd "C-c S-<right>") 'markdown-table-insert-column) - (define-key map (kbd "C-c C-M-h") 'markdown-mark-subtree) - (define-key map (kbd "C-x n s") 'markdown-narrow-to-subtree) - (define-key map (kbd "M-RET") 'markdown-insert-list-item) - (define-key map (kbd "C-c C-j") 'markdown-insert-list-item) - ;; Lines - (define-key map [remap move-beginning-of-line] 'markdown-beginning-of-line) - (define-key map [remap move-end-of-line] 'markdown-end-of-line) - ;; Paragraphs (Markdown context aware) - (define-key map [remap backward-paragraph] 'markdown-backward-paragraph) - (define-key map [remap forward-paragraph] 'markdown-forward-paragraph) - (define-key map [remap mark-paragraph] 'markdown-mark-paragraph) - ;; Blocks (one or more paragraphs) - (define-key map (kbd "C-M-{") 'markdown-backward-block) - (define-key map (kbd "C-M-}") 'markdown-forward-block) - (define-key map (kbd "C-c M-h") 'markdown-mark-block) - (define-key map (kbd "C-x n b") 'markdown-narrow-to-block) - ;; Pages (top-level sections) - (define-key map [remap backward-page] 'markdown-backward-page) - (define-key map [remap forward-page] 'markdown-forward-page) - (define-key map [remap mark-page] 'markdown-mark-page) - (define-key map [remap narrow-to-page] 'markdown-narrow-to-page) - ;; Link Movement - (define-key map (kbd "M-n") 'markdown-next-link) - (define-key map (kbd "M-p") 'markdown-previous-link) - ;; Toggling functionality - (define-key map (kbd "C-c C-x C-e") 'markdown-toggle-math) - (define-key map (kbd "C-c C-x C-f") 'markdown-toggle-fontify-code-blocks-natively) - (define-key map (kbd "C-c C-x C-i") 'markdown-toggle-inline-images) - (define-key map (kbd "C-c C-x C-l") 'markdown-toggle-url-hiding) - (define-key map (kbd "C-c C-x C-m") 'markdown-toggle-markup-hiding) - ;; Alternative keys (in case of problems with the arrow keys) - (define-key map (kbd "C-c C-x u") 'markdown-move-up) - (define-key map (kbd "C-c C-x d") 'markdown-move-down) - (define-key map (kbd "C-c C-x l") 'markdown-promote) - (define-key map (kbd "C-c C-x r") 'markdown-demote) - ;; Deprecated keys that may be removed in a future version - (define-key map (kbd "C-c C-a L") 'markdown-insert-link) ;; C-c C-l - (define-key map (kbd "C-c C-a l") 'markdown-insert-link) ;; C-c C-l - (define-key map (kbd "C-c C-a r") 'markdown-insert-link) ;; C-c C-l - (define-key map (kbd "C-c C-a u") 'markdown-insert-uri) ;; C-c C-l - (define-key map (kbd "C-c C-a f") 'markdown-insert-footnote) - (define-key map (kbd "C-c C-a w") 'markdown-insert-wiki-link) - (define-key map (kbd "C-c C-t 1") 'markdown-insert-header-atx-1) - (define-key map (kbd "C-c C-t 2") 'markdown-insert-header-atx-2) - (define-key map (kbd "C-c C-t 3") 'markdown-insert-header-atx-3) - (define-key map (kbd "C-c C-t 4") 'markdown-insert-header-atx-4) - (define-key map (kbd "C-c C-t 5") 'markdown-insert-header-atx-5) - (define-key map (kbd "C-c C-t 6") 'markdown-insert-header-atx-6) - (define-key map (kbd "C-c C-t !") 'markdown-insert-header-setext-1) - (define-key map (kbd "C-c C-t @") 'markdown-insert-header-setext-2) - (define-key map (kbd "C-c C-t h") 'markdown-insert-header-dwim) - (define-key map (kbd "C-c C-t H") 'markdown-insert-header-setext-dwim) - (define-key map (kbd "C-c C-t s") 'markdown-insert-header-setext-2) - (define-key map (kbd "C-c C-t t") 'markdown-insert-header-setext-1) - (define-key map (kbd "C-c C-i") 'markdown-insert-image) - (define-key map (kbd "C-c C-x m") 'markdown-insert-list-item) ;; C-c C-j - (define-key map (kbd "C-c C-x C-x") 'markdown-toggle-gfm-checkbox) ;; C-c C-d - (define-key map (kbd "C-c -") 'markdown-insert-hr) - map) - "Keymap for Markdown major mode.") - -(defvar markdown-mode-mouse-map - (when markdown-mouse-follow-link - (let ((map (make-sparse-keymap))) - (define-key map [follow-link] 'mouse-face) - (define-key map [mouse-2] #'markdown-follow-thing-at-point) - map)) - "Keymap for following links with mouse.") - -(defvar gfm-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map markdown-mode-map) - (define-key map (kbd "C-c C-s d") 'markdown-insert-strike-through) - (define-key map "`" 'markdown-electric-backquote) - map) - "Keymap for `gfm-mode'. -See also `markdown-mode-map'.") - - -;;; Menu ====================================================================== - -(easy-menu-define markdown-mode-menu markdown-mode-map - "Menu for Markdown mode." - '("Markdown" - "---" - ("Movement" - ["Jump" markdown-do] - ["Follow Link" markdown-follow-thing-at-point] - ["Next Link" markdown-next-link] - ["Previous Link" markdown-previous-link] - "---" - ["Next Heading or List Item" markdown-outline-next] - ["Previous Heading or List Item" markdown-outline-previous] - ["Next at Same Level" markdown-outline-next-same-level] - ["Previous at Same Level" markdown-outline-previous-same-level] - ["Up to Parent" markdown-outline-up] - "---" - ["Forward Paragraph" markdown-forward-paragraph] - ["Backward Paragraph" markdown-backward-paragraph] - ["Forward Block" markdown-forward-block] - ["Backward Block" markdown-backward-block]) - ("Show & Hide" - ["Cycle Heading Visibility" markdown-cycle - :enable (markdown-on-heading-p)] - ["Cycle Heading Visibility (Global)" markdown-shifttab] - "---" - ["Narrow to Region" narrow-to-region] - ["Narrow to Block" markdown-narrow-to-block] - ["Narrow to Section" narrow-to-defun] - ["Narrow to Subtree" markdown-narrow-to-subtree] - ["Widen" widen (buffer-narrowed-p)] - "---" - ["Toggle Markup Hiding" markdown-toggle-markup-hiding - :keys "C-c C-x C-m" - :style radio - :selected markdown-hide-markup]) - "---" - ("Headings & Structure" - ["Automatic Heading" markdown-insert-header-dwim - :keys "C-c C-s h"] - ["Automatic Heading (Setext)" markdown-insert-header-setext-dwim - :keys "C-c C-s H"] - ("Specific Heading (atx)" - ["First Level atx" markdown-insert-header-atx-1 - :keys "C-c C-s 1"] - ["Second Level atx" markdown-insert-header-atx-2 - :keys "C-c C-s 2"] - ["Third Level atx" markdown-insert-header-atx-3 - :keys "C-c C-s 3"] - ["Fourth Level atx" markdown-insert-header-atx-4 - :keys "C-c C-s 4"] - ["Fifth Level atx" markdown-insert-header-atx-5 - :keys "C-c C-s 5"] - ["Sixth Level atx" markdown-insert-header-atx-6 - :keys "C-c C-s 6"]) - ("Specific Heading (Setext)" - ["First Level Setext" markdown-insert-header-setext-1 - :keys "C-c C-s !"] - ["Second Level Setext" markdown-insert-header-setext-2 - :keys "C-c C-s @"]) - ["Horizontal Rule" markdown-insert-hr - :keys "C-c C-s -"] - "---" - ["Move Subtree Up" markdown-move-up - :keys "C-c <up>"] - ["Move Subtree Down" markdown-move-down - :keys "C-c <down>"] - ["Promote Subtree" markdown-promote - :keys "C-c <left>"] - ["Demote Subtree" markdown-demote - :keys "C-c <right>"]) - ("Region & Mark" - ["Indent Region" markdown-indent-region] - ["Outdent Region" markdown-outdent-region] - "--" - ["Mark Paragraph" mark-paragraph] - ["Mark Block" markdown-mark-block] - ["Mark Section" mark-defun] - ["Mark Subtree" markdown-mark-subtree]) - ("Tables" - ["Move Row Up" markdown-move-up - :enable (markdown-table-at-point-p) - :keys "C-c <up>"] - ["Move Row Down" markdown-move-down - :enable (markdown-table-at-point-p) - :keys "C-c <down>"] - ["Move Column Left" markdown-promote - :enable (markdown-table-at-point-p) - :keys "C-c <left>"] - ["Move Column Right" markdown-demote - :enable (markdown-table-at-point-p) - :keys "C-c <right>"] - ["Delete Row" markdown-table-delete-row - :enable (markdown-table-at-point-p)] - ["Insert Row" markdown-table-insert-row - :enable (markdown-table-at-point-p)] - ["Delete Column" markdown-table-delete-column - :enable (markdown-table-at-point-p)] - ["Insert Column" markdown-table-insert-column - :enable (markdown-table-at-point-p)] - ["Insert Table" markdown-insert-table] - "--" - ["Convert Region to Table" markdown-table-convert-region] - ["Sort Table Lines" markdown-table-sort-lines - :enable (markdown-table-at-point-p)] - ["Transpose Table" markdown-table-transpose - :enable (markdown-table-at-point-p)]) - ("Lists" - ["Insert List Item" markdown-insert-list-item] - ["Move Subtree Up" markdown-move-up - :keys "C-c <up>"] - ["Move Subtree Down" markdown-move-down - :keys "C-c <down>"] - ["Indent Subtree" markdown-demote - :keys "C-c <right>"] - ["Outdent Subtree" markdown-promote - :keys "C-c <left>"] - ["Renumber List" markdown-cleanup-list-numbers] - ["Insert Task List Item" markdown-insert-gfm-checkbox - :keys "C-c C-x ["] - ["Toggle Task List Item" markdown-toggle-gfm-checkbox - :enable (markdown-gfm-task-list-item-at-point) - :keys "C-c C-d"]) - ("Links & Images" - ["Insert Link" markdown-insert-link] - ["Insert Image" markdown-insert-image] - ["Insert Footnote" markdown-insert-footnote - :keys "C-c C-s f"] - ["Insert Wiki Link" markdown-insert-wiki-link - :keys "C-c C-s w"] - "---" - ["Check References" markdown-check-refs] - ["Find Unused References" markdown-unused-refs] - ["Toggle URL Hiding" markdown-toggle-url-hiding - :style radio - :selected markdown-hide-urls] - ["Toggle Inline Images" markdown-toggle-inline-images - :keys "C-c C-x C-i" - :style radio - :selected markdown-inline-image-overlays] - ["Toggle Wiki Links" markdown-toggle-wiki-links - :style radio - :selected markdown-enable-wiki-links]) - ("Styles" - ["Bold" markdown-insert-bold] - ["Italic" markdown-insert-italic] - ["Code" markdown-insert-code] - ["Strikethrough" markdown-insert-strike-through] - ["Keyboard" markdown-insert-kbd] - "---" - ["Blockquote" markdown-insert-blockquote] - ["Preformatted" markdown-insert-pre] - ["GFM Code Block" markdown-insert-gfm-code-block] - ["Edit Code Block" markdown-edit-code-block - :enable (markdown-code-block-at-point-p)] - ["Foldable Block" markdown-insert-foldable-block] - "---" - ["Blockquote Region" markdown-blockquote-region] - ["Preformatted Region" markdown-pre-region] - "---" - ["Fontify Code Blocks Natively" - markdown-toggle-fontify-code-blocks-natively - :style radio - :selected markdown-fontify-code-blocks-natively] - ["LaTeX Math Support" markdown-toggle-math - :style radio - :selected markdown-enable-math]) - "---" - ("Preview & Export" - ["Compile" markdown-other-window] - ["Preview" markdown-preview] - ["Export" markdown-export] - ["Export & View" markdown-export-and-preview] - ["Open" markdown-open] - ["Live Export" markdown-live-preview-mode - :style radio - :selected markdown-live-preview-mode] - ["Kill ring save" markdown-kill-ring-save]) - ("Markup Completion and Cycling" - ["Complete Markup" markdown-complete] - ["Promote Element" markdown-promote - :keys "C-c C--"] - ["Demote Element" markdown-demote - :keys "C-c C-="]) - "---" - ["Kill Element" markdown-kill-thing-at-point] - "---" - ("Documentation" - ["Version" markdown-show-version] - ["Homepage" markdown-mode-info] - ["Describe Mode" (describe-function 'markdown-mode)] - ["Guide" (browse-url "https://leanpub.com/markdown-mode")]))) - - -;;; imenu ===================================================================== - -(defun markdown-imenu-create-nested-index () - "Create and return a nested imenu index alist for the current buffer. -See `imenu-create-index-function' and `imenu--index-alist' for details." - (let* ((root (list nil)) - (min-level 9999) - hashes headers) - (save-excursion - ;; Headings - (goto-char (point-min)) - (while (re-search-forward markdown-regex-header (point-max) t) - (unless (or (markdown-code-block-at-point-p) - (and (match-beginning 3) - (get-text-property (match-beginning 3) 'markdown-yaml-metadata-end))) - (cond - ((match-string-no-properties 2) ;; level 1 setext - (setq min-level 1) - (push (list :heading (match-string-no-properties 1) - :point (match-beginning 1) - :level 1) headers)) - ((match-string-no-properties 3) ;; level 2 setext - (setq min-level (min min-level 2)) - (push (list :heading (match-string-no-properties 1) - :point (match-beginning 1) - :level (- 2 (1- min-level))) headers)) - ((setq hashes (markdown-trim-whitespace - (match-string-no-properties 4))) - (setq min-level (min min-level (length hashes))) - (push (list :heading (match-string-no-properties 5) - :point (match-beginning 4) - :level (- (length hashes) (1- min-level))) headers))))) - (cl-loop with cur-level = 0 - with cur-alist = nil - with empty-heading = "-" - with self-heading = "." - for header in (reverse headers) - for level = (plist-get header :level) - do - (let ((alist (list (cons (plist-get header :heading) (plist-get header :point))))) - (cond - ((= cur-level level) ; new sibling - (setcdr cur-alist alist) - (setq cur-alist alist)) - ((< cur-level level) ; first child - (dotimes (_ (- level cur-level 1)) - (setq alist (list (cons empty-heading alist)))) - (if cur-alist - (let* ((parent (car cur-alist)) - (self-pos (cdr parent))) - (setcdr parent (cons (cons self-heading self-pos) alist))) - (setcdr root alist)) ; primogenitor - (setq cur-alist alist) - (setq cur-level level)) - (t ; new sibling of an ancestor - (let ((sibling-alist (last (cdr root)))) - (dotimes (_ (1- level)) - (setq sibling-alist (last (cdar sibling-alist)))) - (setcdr sibling-alist alist) - (setq cur-alist alist)) - (setq cur-level level))))) - (setq root (copy-tree root)) - ;; Footnotes - (let ((fn (markdown-get-defined-footnotes))) - (if (or (zerop (length fn)) - (null markdown-add-footnotes-to-imenu)) - (cdr root) - (nconc (cdr root) (list (cons "Footnotes" fn)))))))) - -(defun markdown-imenu-create-flat-index () - "Create and return a flat imenu index alist for the current buffer. -See `imenu-create-index-function' and `imenu--index-alist' for details." - (let* ((empty-heading "-") index heading pos) - (save-excursion - ;; Headings - (goto-char (point-min)) - (while (re-search-forward markdown-regex-header (point-max) t) - (when (and (not (markdown-code-block-at-point-p (line-beginning-position))) - (not (markdown-text-property-at-point 'markdown-yaml-metadata-begin))) - (cond - ((setq heading (match-string-no-properties 1)) - (setq pos (match-beginning 1))) - ((setq heading (match-string-no-properties 5)) - (setq pos (match-beginning 4)))) - (or (> (length heading) 0) - (setq heading empty-heading)) - (setq index (append index (list (cons heading pos)))))) - ;; Footnotes - (when markdown-add-footnotes-to-imenu - (nconc index (markdown-get-defined-footnotes))) - index))) - - -;;; References ================================================================ - -(defun markdown-reference-goto-definition () - "Jump to the definition of the reference at point or create it." - (interactive) - (when (thing-at-point-looking-at markdown-regex-link-reference) - (let* ((text (match-string-no-properties 3)) - (reference (match-string-no-properties 6)) - (target (downcase (if (string= reference "") text reference))) - (loc (cadr (save-match-data (markdown-reference-definition target))))) - (if loc - (goto-char loc) - (goto-char (match-beginning 0)) - (markdown-insert-reference-definition target))))) - -(defun markdown-reference-find-links (reference) - "Return a list of all links for REFERENCE. -REFERENCE should not include the surrounding square brackets. -Elements of the list have the form (text start line), where -text is the link text, start is the location at the beginning of -the link, and line is the line number on which the link appears." - (let* ((ref-quote (regexp-quote reference)) - (regexp (format "!?\\(?:\\[\\(%s\\)\\][ ]?\\[\\]\\|\\[\\([^]]+?\\)\\][ ]?\\[%s\\]\\)" - ref-quote ref-quote)) - links) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward regexp nil t) - (let* ((text (or (match-string-no-properties 1) - (match-string-no-properties 2))) - (start (match-beginning 0)) - (line (markdown-line-number-at-pos))) - (cl-pushnew (list text start line) links :test #'equal)))) - links)) - -(defmacro markdown-for-all-refs (f) - `(let ((result)) - (save-excursion - (goto-char (point-min)) - (while - (re-search-forward markdown-regex-link-reference nil t) - (let* ((text (match-string-no-properties 3)) - (reference (match-string-no-properties 6)) - (target (downcase (if (string= reference "") text reference)))) - (,f text target result)))) - (reverse result))) - -(defmacro markdown-collect-always (_ target result) - `(cl-pushnew ,target ,result :test #'equal)) - -(defmacro markdown-collect-undefined (text target result) - `(unless (markdown-reference-definition target) - (let ((entry (assoc ,target ,result))) - (if (not entry) - (cl-pushnew - (cons ,target (list (cons ,text (markdown-line-number-at-pos)))) - ,result :test #'equal) - (setcdr entry - (append (cdr entry) (list (cons ,text (markdown-line-number-at-pos))))))))) - -(defun markdown-get-all-refs () - "Return a list of all Markdown references." - (markdown-for-all-refs markdown-collect-always)) - -(defun markdown-get-undefined-refs () - "Return a list of undefined Markdown references. -Result is an alist of pairs (reference . occurrences), where -occurrences is itself another alist of pairs (label . line-number). -For example, an alist corresponding to [Nice editor][Emacs] at line 12, -\[GNU Emacs][Emacs] at line 45 and [manual][elisp] at line 127 is -\((\"emacs\" (\"Nice editor\" . 12) (\"GNU Emacs\" . 45)) (\"elisp\" (\"manual\" . 127)))." - (markdown-for-all-refs markdown-collect-undefined)) - -(defun markdown-get-unused-refs () - (cl-sort - (cl-set-difference - (markdown-get-defined-references) (markdown-get-all-refs) - :test (lambda (e1 e2) (equal (car e1) e2))) - #'< :key #'cdr)) - -(defmacro defun-markdown-buffer (name docstring) - "Define a function to name and return a buffer. - -By convention, NAME must be a name of a string constant with -%buffer% placeholder used to name the buffer, and will also be -used as a name of the function defined. - -DOCSTRING will be used as the first part of the docstring." - `(defun ,name (&optional buffer-name) - ,(concat docstring "\n\nBUFFER-NAME is the name of the main buffer being visited.") - (or buffer-name (setq buffer-name (buffer-name))) - (let ((refbuf (get-buffer-create (replace-regexp-in-string - "%buffer%" buffer-name - ,name)))) - (with-current-buffer refbuf - (when view-mode - (View-exit-and-edit)) - (use-local-map button-buffer-map) - (erase-buffer)) - refbuf))) - -(defconst markdown-reference-check-buffer - "*Undefined references for %buffer%*" - "Pattern for name of buffer for listing undefined references. -The string %buffer% will be replaced by the corresponding -`markdown-mode' buffer name.") - -(defun-markdown-buffer - markdown-reference-check-buffer - "Name and return buffer for reference checking.") - -(defconst markdown-unused-references-buffer - "*Unused references for %buffer%*" - "Pattern for name of buffer for listing unused references. -The string %buffer% will be replaced by the corresponding -`markdown-mode' buffer name.") - -(defun-markdown-buffer - markdown-unused-references-buffer - "Name and return buffer for unused reference checking.") - -(defconst markdown-reference-links-buffer - "*Reference links for %buffer%*" - "Pattern for name of buffer for listing references. -The string %buffer% will be replaced by the corresponding buffer name.") - -(defun-markdown-buffer - markdown-reference-links-buffer - "Name, setup, and return a buffer for listing links.") - -;; Add an empty Markdown reference definition to buffer -;; specified in the 'target-buffer property. The reference name is -;; the button's label. -(define-button-type 'markdown-undefined-reference-button - 'help-echo "mouse-1, RET: create definition for undefined reference" - 'follow-link t - 'face 'bold - 'action (lambda (b) - (let ((buffer (button-get b 'target-buffer)) - (line (button-get b 'target-line)) - (label (button-label b))) - (switch-to-buffer-other-window buffer) - (goto-char (point-min)) - (forward-line line) - (markdown-insert-reference-definition label) - (markdown-check-refs t)))) - -;; Jump to line in buffer specified by 'target-buffer property. -;; Line number is button's 'target-line property. -(define-button-type 'markdown-goto-line-button - 'help-echo "mouse-1, RET: go to line" - 'follow-link t - 'face 'italic - 'action (lambda (b) - (switch-to-buffer-other-window (button-get b 'target-buffer)) - ;; use call-interactively to silence compiler - (let ((current-prefix-arg (button-get b 'target-line))) - (call-interactively 'goto-line)))) - -;; Kill a line in buffer specified by 'target-buffer property. -;; Line number is button's 'target-line property. -(define-button-type 'markdown-kill-line-button - 'help-echo "mouse-1, RET: kill line" - 'follow-link t - 'face 'italic - 'action (lambda (b) - (switch-to-buffer-other-window (button-get b 'target-buffer)) - ;; use call-interactively to silence compiler - (let ((current-prefix-arg (button-get b 'target-line))) - (call-interactively 'goto-line)) - (kill-line 1) - (markdown-unused-refs t))) - -;; Jumps to a particular link at location given by 'target-char -;; property in buffer given by 'target-buffer property. -(define-button-type 'markdown-location-button - 'help-echo "mouse-1, RET: jump to location of link" - 'follow-link t - 'face 'bold - 'action (lambda (b) - (let ((target (button-get b 'target-buffer)) - (loc (button-get b 'target-char))) - (kill-buffer-and-window) - (switch-to-buffer target) - (goto-char loc)))) - -(defun markdown-insert-undefined-reference-button (reference oldbuf) - "Insert a button for creating REFERENCE in buffer OLDBUF. -REFERENCE should be a list of the form (reference . occurrences), -as returned by `markdown-get-undefined-refs'." - (let ((label (car reference))) - ;; Create a reference button - (insert-button label - :type 'markdown-undefined-reference-button - 'target-buffer oldbuf - 'target-line (cdr (car (cdr reference)))) - (insert " (") - (dolist (occurrence (cdr reference)) - (let ((line (cdr occurrence))) - ;; Create a line number button - (insert-button (number-to-string line) - :type 'markdown-goto-line-button - 'target-buffer oldbuf - 'target-line line) - (insert " "))) - (delete-char -1) - (insert ")") - (newline))) - -(defun markdown-insert-unused-reference-button (reference oldbuf) - "Insert a button for creating REFERENCE in buffer OLDBUF. -REFERENCE must be a pair of (ref . line-number)." - (let ((label (car reference)) - (line (cdr reference))) - ;; Create a reference button - (insert-button label - :type 'markdown-goto-line-button - 'face 'bold - 'target-buffer oldbuf - 'target-line line) - (insert (format " (%d) [" line)) - (insert-button "X" - :type 'markdown-kill-line-button - 'face 'bold - 'target-buffer oldbuf - 'target-line line) - (insert "]") - (newline))) - -(defun markdown-insert-link-button (link oldbuf) - "Insert a button for jumping to LINK in buffer OLDBUF. -LINK should be a list of the form (text char line) containing -the link text, location, and line number." - (let ((label (cl-first link)) - (char (cl-second link)) - (line (cl-third link))) - ;; Create a reference button - (insert-button label - :type 'markdown-location-button - 'target-buffer oldbuf - 'target-char char) - (insert (format " (line %d)\n" line)))) - -(defun markdown-reference-goto-link (&optional reference) - "Jump to the location of the first use of REFERENCE." - (interactive) - (unless reference - (if (thing-at-point-looking-at markdown-regex-reference-definition) - (setq reference (match-string-no-properties 2)) - (user-error "No reference definition at point"))) - (let ((links (markdown-reference-find-links reference))) - (cond ((= (length links) 1) - (goto-char (cadr (car links)))) - ((> (length links) 1) - (let ((oldbuf (current-buffer)) - (linkbuf (markdown-reference-links-buffer))) - (with-current-buffer linkbuf - (insert "Links using reference " reference ":\n\n") - (dolist (link (reverse links)) - (markdown-insert-link-button link oldbuf))) - (view-buffer-other-window linkbuf) - (goto-char (point-min)) - (forward-line 2))) - (t - (error "No links for reference %s" reference))))) - -(defmacro defun-markdown-ref-checker - (name docstring checker-function buffer-function none-message buffer-header insert-reference) - "Define a function NAME acting on result of CHECKER-FUNCTION. - -DOCSTRING is used as a docstring for the defined function. - -BUFFER-FUNCTION should name and return an auxiliary buffer to put -results in. - -NONE-MESSAGE is used when CHECKER-FUNCTION returns no results. - -BUFFER-HEADER is put into the auxiliary buffer first, followed by -calling INSERT-REFERENCE for each element in the list returned by -CHECKER-FUNCTION." - `(defun ,name (&optional silent) - ,(concat - docstring - "\n\nIf SILENT is non-nil, do not message anything when no -such references found.") - (interactive "P") - (unless (derived-mode-p 'markdown-mode) - (user-error "Not available in current mode")) - (let ((oldbuf (current-buffer)) - (refs (,checker-function)) - (refbuf (,buffer-function))) - (if (null refs) - (progn - (when (not silent) - (message ,none-message)) - (kill-buffer refbuf)) - (with-current-buffer refbuf - (insert ,buffer-header) - (dolist (ref refs) - (,insert-reference ref oldbuf)) - (view-buffer-other-window refbuf) - (goto-char (point-min)) - (forward-line 2)))))) - -(defun-markdown-ref-checker - markdown-check-refs - "Show all undefined Markdown references in current `markdown-mode' buffer. - -Links which have empty reference definitions are considered to be -defined." - markdown-get-undefined-refs - markdown-reference-check-buffer - "No undefined references found" - "The following references are undefined:\n\n" - markdown-insert-undefined-reference-button) - - -(defun-markdown-ref-checker - markdown-unused-refs - "Show all unused Markdown references in current `markdown-mode' buffer." - markdown-get-unused-refs - markdown-unused-references-buffer - "No unused references found" - "The following references are unused:\n\n" - markdown-insert-unused-reference-button) - - - -;;; Lists ===================================================================== - -(defun markdown-insert-list-item (&optional arg) - "Insert a new list item. -If the point is inside unordered list, insert a bullet mark. If -the point is inside ordered list, insert the next number followed -by a period. Use the previous list item to determine the amount -of whitespace to place before and after list markers. - -With a \\[universal-argument] prefix (i.e., when ARG is (4)), -decrease the indentation by one level. - -With two \\[universal-argument] prefixes (i.e., when ARG is (16)), -increase the indentation by one level." - (interactive "p") - (let (bounds cur-indent marker indent new-indent new-loc) - (save-match-data - ;; Look for a list item on current or previous non-blank line - (save-excursion - (while (and (not (setq bounds (markdown-cur-list-item-bounds))) - (not (bobp)) - (markdown-cur-line-blank-p)) - (forward-line -1))) - (when bounds - (cond ((save-excursion - (skip-chars-backward " \t") - (looking-at-p markdown-regex-list)) - (beginning-of-line) - (insert "\n") - (forward-line -1)) - ((not (markdown-cur-line-blank-p)) - (newline))) - (setq new-loc (point))) - ;; Look ahead for a list item on next non-blank line - (unless bounds - (save-excursion - (while (and (null bounds) - (not (eobp)) - (markdown-cur-line-blank-p)) - (forward-line) - (setq bounds (markdown-cur-list-item-bounds)))) - (when bounds - (setq new-loc (point)) - (unless (markdown-cur-line-blank-p) - (newline)))) - (if (not bounds) - ;; When not in a list, start a new unordered one - (progn - (unless (markdown-cur-line-blank-p) - (insert "\n")) - (insert markdown-unordered-list-item-prefix)) - ;; Compute indentation and marker for new list item - (setq cur-indent (nth 2 bounds)) - (setq marker (nth 4 bounds)) - ;; If current item is a GFM checkbox, insert new unchecked checkbox. - (when (nth 5 bounds) - (setq marker - (concat marker - (replace-regexp-in-string "[Xx]" " " (nth 5 bounds))))) - (cond - ;; Dedent: decrement indentation, find previous marker. - ((= arg 4) - (setq indent (max (- cur-indent markdown-list-indent-width) 0)) - (let ((prev-bounds - (save-excursion - (goto-char (nth 0 bounds)) - (when (markdown-up-list) - (markdown-cur-list-item-bounds))))) - (when prev-bounds - (setq marker (nth 4 prev-bounds))))) - ;; Indent: increment indentation by 4, use same marker. - ((= arg 16) (setq indent (+ cur-indent markdown-list-indent-width))) - ;; Same level: keep current indentation and marker. - (t (setq indent cur-indent))) - (setq new-indent (make-string indent 32)) - (goto-char new-loc) - (cond - ;; Ordered list - ((string-match-p "[0-9]" marker) - (if (= arg 16) ;; starting a new column indented one more level - (insert (concat new-indent "1. ")) - ;; Don't use previous match-data - (set-match-data nil) - ;; travel up to the last item and pick the correct number. If - ;; the argument was nil, "new-indent = cur-indent" is the same, - ;; so we don't need special treatment. Neat. - (save-excursion - (while (and (not (looking-at (concat new-indent "\\([0-9]+\\)\\(\\.[ \t]*\\)"))) - (>= (forward-line -1) 0)))) - (let* ((old-prefix (match-string 1)) - (old-spacing (match-string 2)) - (new-prefix (if (and old-prefix markdown-ordered-list-enumeration) - (int-to-string (1+ (string-to-number old-prefix))) - "1")) - (space-adjust (- (length old-prefix) (length new-prefix))) - (new-spacing (if (and (match-string 2) - (not (string-match-p "\t" old-spacing)) - (< space-adjust 0) - (> space-adjust (- 1 (length (match-string 2))))) - (substring (match-string 2) 0 space-adjust) - (or old-spacing ". ")))) - (insert (concat new-indent new-prefix new-spacing))))) - ;; Unordered list, GFM task list, or ordered list with hash mark - ((string-match-p "[\\*\\+-]\\|#\\." marker) - (insert new-indent marker)))) - ;; Propertize the newly inserted list item now - (markdown-syntax-propertize-list-items (line-beginning-position) (line-end-position))))) - -(defun markdown-move-list-item-up () - "Move the current list item up in the list when possible. -In nested lists, move child items with the parent item." - (interactive) - (let (cur prev old) - (when (setq cur (markdown-cur-list-item-bounds)) - (setq old (point)) - (goto-char (nth 0 cur)) - (if (markdown-prev-list-item (nth 3 cur)) - (progn - (setq prev (markdown-cur-list-item-bounds)) - (condition-case nil - (progn - (transpose-regions (nth 0 prev) (nth 1 prev) - (nth 0 cur) (nth 1 cur) t) - (goto-char (+ (nth 0 prev) (- old (nth 0 cur))))) - ;; Catch error in case regions overlap. - (error (goto-char old)))) - (goto-char old))))) - -(defun markdown-move-list-item-down () - "Move the current list item down in the list when possible. -In nested lists, move child items with the parent item." - (interactive) - (let (cur next old) - (when (setq cur (markdown-cur-list-item-bounds)) - (setq old (point)) - (if (markdown-next-list-item (nth 3 cur)) - (progn - (setq next (markdown-cur-list-item-bounds)) - (condition-case nil - (progn - (transpose-regions (nth 0 cur) (nth 1 cur) - (nth 0 next) (nth 1 next) nil) - (goto-char (+ old (- (nth 1 next) (nth 1 cur))))) - ;; Catch error in case regions overlap. - (error (goto-char old)))) - (goto-char old))))) - -(defun markdown-demote-list-item (&optional bounds) - "Indent (or demote) the current list item. -Optionally, BOUNDS of the current list item may be provided if available. -In nested lists, demote child items as well." - (interactive) - (when (or bounds (setq bounds (markdown-cur-list-item-bounds))) - (save-excursion - (let* ((item-start (set-marker (make-marker) (nth 0 bounds))) - (item-end (set-marker (make-marker) (nth 1 bounds))) - (list-start (progn (markdown-beginning-of-list) - (set-marker (make-marker) (point)))) - (list-end (progn (markdown-end-of-list) - (set-marker (make-marker) (point))))) - (goto-char item-start) - (while (< (point) item-end) - (unless (markdown-cur-line-blank-p) - (insert (make-string markdown-list-indent-width ? ))) - (forward-line)) - (markdown-syntax-propertize-list-items list-start list-end))))) - -(defun markdown-promote-list-item (&optional bounds) - "Unindent (or promote) the current list item. -Optionally, BOUNDS of the current list item may be provided if available. -In nested lists, demote child items as well." - (interactive) - (when (or bounds (setq bounds (markdown-cur-list-item-bounds))) - (save-excursion - (save-match-data - (let ((item-start (set-marker (make-marker) (nth 0 bounds))) - (item-end (set-marker (make-marker) (nth 1 bounds))) - (list-start (progn (markdown-beginning-of-list) - (set-marker (make-marker) (point)))) - (list-end (progn (markdown-end-of-list) - (set-marker (make-marker) (point)))) - num regexp) - (goto-char item-start) - (when (looking-at (format "^[ ]\\{1,%d\\}" - markdown-list-indent-width)) - (setq num (- (match-end 0) (match-beginning 0))) - (setq regexp (format "^[ ]\\{1,%d\\}" num)) - (while (and (< (point) item-end) - (re-search-forward regexp item-end t)) - (replace-match "" nil nil) - (forward-line)) - (markdown-syntax-propertize-list-items list-start list-end))))))) - -(defun markdown-cleanup-list-numbers-level (&optional pfx prev-item) - "Update the numbering for level PFX (as a string of spaces) and PREV-ITEM. -PREV-ITEM is width of previous-indentation and list number - -Assume that the previously found match was for a numbered item in -a list." - (let ((cpfx pfx) - (cur-item nil) - (idx 0) - (continue t) - (step t) - (sep nil)) - (while (and continue (not (eobp))) - (setq step t) - (cond - ((looking-at "^\\(\\([\s-]*\\)[0-9]+\\)\\. ") - (setq cpfx (match-string-no-properties 2)) - (setq cur-item (match-string-no-properties 1)) ;; indentation and list marker - (cond - ((or (= (length cpfx) (length pfx)) - (= (length cur-item) (length prev-item))) - (save-excursion - (replace-match - (if (not markdown-ordered-list-enumeration) - (concat pfx "1. ") - (cl-incf idx) - (concat pfx (number-to-string idx) ". ")))) - (setq sep nil)) - ;; indented a level - ((< (length pfx) (length cpfx)) - (setq sep (markdown-cleanup-list-numbers-level cpfx cur-item)) - (setq step nil)) - ;; exit the loop - (t - (setq step nil) - (setq continue nil)))) - - ((looking-at "^\\([\s-]*\\)[^ \t\n\r].*$") - (setq cpfx (match-string-no-properties 1)) - (cond - ;; reset if separated before - ((string= cpfx pfx) (when sep (setq idx 0))) - ((string< cpfx pfx) - (setq step nil) - (setq continue nil)))) - (t (setq sep t))) - - (when step - (beginning-of-line) - (setq continue (= (forward-line) 0)))) - sep)) - -(defun markdown-cleanup-list-numbers () - "Update the numbering of ordered lists." - (interactive) - (save-excursion - (goto-char (point-min)) - (markdown-cleanup-list-numbers-level ""))) - - -;;; Movement ================================================================== - -;; This function was originally derived from `org-beginning-of-line' from org.el. -(defun markdown-beginning-of-line (&optional n) - "Go to the beginning of the current visible line. - -If this is a headline, and `markdown-special-ctrl-a/e' is not nil -or symbol `reversed', on the first attempt move to where the -headline text hashes, and only move to beginning of line when the -cursor is already before the hashes of the text of the headline. - -If `markdown-special-ctrl-a/e' is symbol `reversed' then go to -the hashes of the text on the second attempt. - -With argument N not nil or 1, move forward N - 1 lines first." - (interactive "^p") - (let ((origin (point)) - (special (pcase markdown-special-ctrl-a/e - (`(,C-a . ,_) C-a) (_ markdown-special-ctrl-a/e))) - deactivate-mark) - ;; First move to a visible line. - (if visual-line-mode - (beginning-of-visual-line n) - (move-beginning-of-line n) - ;; `move-beginning-of-line' may leave point after invisible - ;; characters if line starts with such of these (e.g., with - ;; a link at column 0). Really move to the beginning of the - ;; current visible line. - (forward-line 0)) - (cond - ;; No special behavior. Point is already at the beginning of - ;; a line, logical or visual. - ((not special)) - ;; `beginning-of-visual-line' left point before logical beginning - ;; of line: point is at the beginning of a visual line. Bail - ;; out. - ((and visual-line-mode (not (bolp)))) - ((looking-at markdown-regex-header-atx) - ;; At a header, special position is before the title. - (let ((refpos (match-beginning 2)) - (bol (point))) - (if (eq special 'reversed) - (when (and (= origin bol) (eq last-command this-command)) - (goto-char refpos)) - (when (or (> origin refpos) (<= origin bol)) - (goto-char refpos))) - ;; Prevent automatic cursor movement caused by the command loop. - ;; Enable disable-point-adjustment to avoid unintended cursor repositioning. - (when (and markdown-hide-markup - (equal (get-char-property (point) 'display) "")) - (setq disable-point-adjustment t)))) - ((looking-at markdown-regex-list) - ;; At a list item, special position is after the list marker or checkbox. - (let ((refpos (or (match-end 4) (match-end 3)))) - (if (eq special 'reversed) - (when (and (= (point) origin) (eq last-command this-command)) - (goto-char refpos)) - (when (or (> origin refpos) (<= origin (line-beginning-position))) - (goto-char refpos))))) - ;; No special case, already at beginning of line. - (t nil)))) - -;; This function was originally derived from `org-end-of-line' from org.el. -(defun markdown-end-of-line (&optional n) - "Go to the end of the line, but before ellipsis, if any. - -If this is a headline, and `markdown-special-ctrl-a/e' is not nil -or symbol `reversed', ignore closing tags on the first attempt, -and only move to after the closing tags when the cursor is -already beyond the end of the headline. - -If `markdown-special-ctrl-a/e' is symbol `reversed' then ignore -closing tags on the second attempt. - -With argument N not nil or 1, move forward N - 1 lines first." - (interactive "^p") - (let ((origin (point)) - (special (pcase markdown-special-ctrl-a/e - (`(,_ . ,C-e) C-e) (_ markdown-special-ctrl-a/e))) - deactivate-mark) - ;; First move to a visible line. - (if visual-line-mode - (beginning-of-visual-line n) - (move-beginning-of-line n)) - (cond - ;; At a headline, with closing tags. - ((save-excursion - (forward-line 0) - (and (looking-at markdown-regex-header-atx) (match-end 3))) - (let ((refpos (match-end 2)) - (visual-end (and visual-line-mode - (save-excursion - (end-of-visual-line) - (point))))) - ;; If `end-of-visual-line' brings us before end of line or even closing - ;; tags, i.e., the headline spans over multiple visual lines, move - ;; there. - (cond ((and visual-end - (< visual-end refpos) - (<= origin visual-end)) - (goto-char visual-end)) - ((not special) (end-of-line)) - ((eq special 'reversed) - (if (and (= origin (line-end-position)) - (eq this-command last-command)) - (goto-char refpos) - (end-of-line))) - (t - (if (or (< origin refpos) (>= origin (line-end-position))) - (goto-char refpos) - (end-of-line)))) - ;; Prevent automatic cursor movement caused by the command loop. - ;; Enable disable-point-adjustment to avoid unintended cursor repositioning. - (when (and markdown-hide-markup - (equal (get-char-property (point) 'display) "")) - (setq disable-point-adjustment t)))) - (visual-line-mode - (let ((bol (line-beginning-position))) - (end-of-visual-line) - ;; If `end-of-visual-line' gets us past the ellipsis at the - ;; end of a line, backtrack and use `end-of-line' instead. - (when (/= bol (line-beginning-position)) - (goto-char bol) - (end-of-line)))) - (t (end-of-line))))) - -(defun markdown-beginning-of-defun (&optional arg) - "`beginning-of-defun-function' for Markdown. -This is used to find the beginning of the defun and should behave -like ‘beginning-of-defun’, returning non-nil if it found the -beginning of a defun. It moves the point backward, right before a -heading which defines a defun. When ARG is non-nil, repeat that -many times. When ARG is negative, move forward to the ARG-th -following section." - (or arg (setq arg 1)) - (when (< arg 0) (end-of-line)) - ;; Adjust position for setext headings. - (when (and (thing-at-point-looking-at markdown-regex-header-setext) - (not (= (point) (match-beginning 0))) - (not (markdown-code-block-at-point-p))) - (goto-char (match-end 0))) - (let (found) - ;; Move backward with positive argument. - (while (and (not (bobp)) (> arg 0)) - (setq found nil) - (while (and (not found) - (not (bobp)) - (re-search-backward markdown-regex-header nil 'move)) - (markdown-code-block-at-pos (match-beginning 0)) - (setq found (match-beginning 0))) - (setq arg (1- arg))) - ;; Move forward with negative argument. - (while (and (not (eobp)) (< arg 0)) - (setq found nil) - (while (and (not found) - (not (eobp)) - (re-search-forward markdown-regex-header nil 'move)) - (markdown-code-block-at-pos (match-beginning 0)) - (setq found (match-beginning 0))) - (setq arg (1+ arg))) - (when found - (beginning-of-line) - t))) - -(defun markdown-end-of-defun () - "`end-of-defun-function’ for Markdown. -This is used to find the end of the defun at point. -It is called with no argument, right after calling ‘beginning-of-defun-raw’, -so it can assume that point is at the beginning of the defun body. -It should move point to the first position after the defun." - (or (eobp) (forward-char 1)) - (let (found) - (while (and (not found) - (not (eobp)) - (re-search-forward markdown-regex-header nil 'move)) - (when (not (markdown-code-block-at-pos (match-beginning 0))) - (setq found (match-beginning 0)))) - (when found - (goto-char found) - (skip-syntax-backward "-")))) - -(defun markdown-beginning-of-text-block () - "Move backward to previous beginning of a plain text block. -This function simply looks for blank lines without considering -the surrounding context in light of Markdown syntax. For that, see -`markdown-backward-block'." - (interactive) - (let ((start (point))) - (if (re-search-backward markdown-regex-block-separator nil t) - (goto-char (match-end 0)) - (goto-char (point-min))) - (when (and (= start (point)) (not (bobp))) - (forward-line -1) - (if (re-search-backward markdown-regex-block-separator nil t) - (goto-char (match-end 0)) - (goto-char (point-min)))))) - -(defun markdown-end-of-text-block () - "Move forward to next beginning of a plain text block. -This function simply looks for blank lines without considering -the surrounding context in light of Markdown syntax. For that, see -`markdown-forward-block'." - (interactive) - (beginning-of-line) - (skip-chars-forward " \t\n") - (when (= (point) (point-min)) - (forward-char)) - (if (re-search-forward markdown-regex-block-separator nil t) - (goto-char (match-end 0)) - (goto-char (point-max))) - (skip-chars-backward " \t\n") - (forward-line)) - -(defun markdown-backward-paragraph (&optional arg) - "Move the point to the start of the current paragraph. -With argument ARG, do it ARG times; a negative argument ARG = -N -means move forward N blocks." - (interactive "^p") - (or arg (setq arg 1)) - (if (< arg 0) - (markdown-forward-paragraph (- arg)) - (dotimes (_ arg) - ;; Skip over whitespace in between paragraphs when moving backward. - (skip-chars-backward " \t\n") - (beginning-of-line) - ;; Skip over code block endings. - (when (markdown-range-properties-exist - (line-beginning-position) (line-end-position) - '(markdown-gfm-block-end - markdown-tilde-fence-end)) - (forward-line -1)) - ;; Skip over blank lines inside blockquotes. - (while (and (not (eobp)) - (looking-at markdown-regex-blockquote) - (= (length (match-string 3)) 0)) - (forward-line -1)) - ;; Proceed forward based on the type of block of paragraph. - (let (bounds skip) - (cond - ;; Blockquotes - ((looking-at markdown-regex-blockquote) - (while (and (not (bobp)) - (looking-at markdown-regex-blockquote) - (> (length (match-string 3)) 0)) ;; not blank - (forward-line -1)) - (forward-line)) - ;; List items - ((setq bounds (markdown-cur-list-item-bounds)) - (goto-char (nth 0 bounds))) - ;; Other - (t - (while (and (not (bobp)) - (not skip) - (not (markdown-cur-line-blank-p)) - (not (looking-at markdown-regex-blockquote)) - (not (markdown-range-properties-exist - (line-beginning-position) (line-end-position) - '(markdown-gfm-block-end - markdown-tilde-fence-end)))) - (setq skip (markdown-range-properties-exist - (line-beginning-position) (line-end-position) - '(markdown-gfm-block-begin - markdown-tilde-fence-begin))) - (forward-line -1)) - (unless (bobp) - (forward-line 1)))))))) - -(defun markdown-forward-paragraph (&optional arg) - "Move forward to the next end of a paragraph. -With argument ARG, do it ARG times; a negative argument ARG = -N -means move backward N blocks." - (interactive "^p") - (or arg (setq arg 1)) - (if (< arg 0) - (markdown-backward-paragraph (- arg)) - (dotimes (_ arg) - ;; Skip whitespace in between paragraphs. - (when (markdown-cur-line-blank-p) - (skip-syntax-forward "-") - (beginning-of-line)) - ;; Proceed forward based on the type of block. - (let (bounds skip) - (cond - ;; Blockquotes - ((looking-at markdown-regex-blockquote) - ;; Skip over blank lines inside blockquotes. - (while (and (not (eobp)) - (looking-at markdown-regex-blockquote) - (= (length (match-string 3)) 0)) - (forward-line)) - ;; Move to end of quoted text block - (while (and (not (eobp)) - (looking-at markdown-regex-blockquote) - (> (length (match-string 3)) 0)) ;; not blank - (forward-line))) - ;; List items - ((and (markdown-cur-list-item-bounds) - (setq bounds (markdown-next-list-item-bounds))) - (goto-char (nth 0 bounds))) - ;; Other - (t - (forward-line) - (while (and (not (eobp)) - (not skip) - (not (markdown-cur-line-blank-p)) - (not (looking-at markdown-regex-blockquote)) - (not (markdown-range-properties-exist - (line-beginning-position) (line-end-position) - '(markdown-gfm-block-begin - markdown-tilde-fence-begin)))) - (setq skip (markdown-range-properties-exist - (line-beginning-position) (line-end-position) - '(markdown-gfm-block-end - markdown-tilde-fence-end))) - (forward-line)))))))) - -(defun markdown-backward-block (&optional arg) - "Move the point to the start of the current Markdown block. -Moves across complete code blocks, list items, and blockquotes, -but otherwise stops at blank lines, headers, and horizontal -rules. With argument ARG, do it ARG times; a negative argument -ARG = -N means move forward N blocks." - (interactive "^p") - (or arg (setq arg 1)) - (if (< arg 0) - (markdown-forward-block (- arg)) - (dotimes (_ arg) - ;; Skip over whitespace in between blocks when moving backward, - ;; unless at a block boundary with no whitespace. - (skip-syntax-backward "-") - (beginning-of-line) - ;; Proceed forward based on the type of block. - (cond - ;; Code blocks - ((and (markdown-code-block-at-pos (point)) ;; this line - (markdown-code-block-at-pos (line-beginning-position 0))) ;; previous line - (forward-line -1) - (while (and (markdown-code-block-at-point-p) (not (bobp))) - (forward-line -1)) - (forward-line)) - ;; Headings - ((markdown-heading-at-point) - (goto-char (match-beginning 0))) - ;; Horizontal rules - ((looking-at markdown-regex-hr)) - ;; Blockquotes - ((looking-at markdown-regex-blockquote) - (forward-line -1) - (while (and (looking-at markdown-regex-blockquote) - (not (bobp))) - (forward-line -1)) - (forward-line)) - ;; List items - ((markdown-cur-list-item-bounds) - (markdown-beginning-of-list)) - ;; Other - (t - ;; Move forward in case it is a one line regular paragraph. - (unless (markdown-next-line-blank-p) - (forward-line)) - (unless (markdown-prev-line-blank-p) - (markdown-backward-paragraph))))))) - -(defun markdown-forward-block (&optional arg) - "Move forward to the next end of a Markdown block. -Moves across complete code blocks, list items, and blockquotes, -but otherwise stops at blank lines, headers, and horizontal -rules. With argument ARG, do it ARG times; a negative argument -ARG = -N means move backward N blocks." - (interactive "^p") - (or arg (setq arg 1)) - (if (< arg 0) - (markdown-backward-block (- arg)) - (dotimes (_ arg) - ;; Skip over whitespace in between blocks when moving forward. - (if (markdown-cur-line-blank-p) - (skip-syntax-forward "-") - (beginning-of-line)) - ;; Proceed forward based on the type of block. - (cond - ;; Code blocks - ((markdown-code-block-at-point-p) - (forward-line) - (while (and (markdown-code-block-at-point-p) (not (eobp))) - (forward-line))) - ;; Headings - ((looking-at markdown-regex-header) - (goto-char (or (match-end 4) (match-end 2) (match-end 3))) - (forward-line)) - ;; Horizontal rules - ((looking-at markdown-regex-hr) - (forward-line)) - ;; Blockquotes - ((looking-at markdown-regex-blockquote) - (forward-line) - (while (and (looking-at markdown-regex-blockquote) (not (eobp))) - (forward-line))) - ;; List items - ((markdown-cur-list-item-bounds) - (markdown-end-of-list) - (forward-line)) - ;; Other - (t (markdown-forward-paragraph)))) - (skip-syntax-backward "-") - (unless (eobp) - (forward-char 1)))) - -(defun markdown-backward-page (&optional count) - "Move backward to boundary of the current toplevel section. -With COUNT, repeat, or go forward if negative." - (interactive "p") - (or count (setq count 1)) - (if (< count 0) - (markdown-forward-page (- count)) - (skip-syntax-backward "-") - (or (markdown-back-to-heading-over-code-block t t) - (goto-char (point-min))) - (when (looking-at markdown-regex-header) - (let ((level (markdown-outline-level))) - (when (> level 1) (markdown-up-heading level)) - (when (> count 1) - (condition-case nil - (markdown-backward-same-level (1- count)) - (error (goto-char (point-min))))))))) - -(defun markdown-forward-page (&optional count) - "Move forward to boundary of the current toplevel section. -With COUNT, repeat, or go backward if negative." - (interactive "p") - (or count (setq count 1)) - (if (< count 0) - (markdown-backward-page (- count)) - (if (markdown-back-to-heading-over-code-block t t) - (let ((level (markdown-outline-level))) - (when (> level 1) (markdown-up-heading level)) - (condition-case nil - (markdown-forward-same-level count) - (error (goto-char (point-max))))) - (markdown-next-visible-heading 1)))) - -(defun markdown-next-link () - "Jump to next inline, reference, or wiki link. -If successful, return point. Otherwise, return nil. -See `markdown-wiki-link-p' and `markdown-previous-wiki-link'." - (interactive) - (let ((opoint (point))) - (when (or (markdown-link-p) (markdown-wiki-link-p)) - ;; At a link already, move past it. - (goto-char (+ (match-end 0) 1))) - ;; Search for the next wiki link and move to the beginning. - (while (and (re-search-forward (markdown-make-regex-link-generic) nil t) - (markdown-code-block-at-point-p) - (< (point) (point-max)))) - (if (and (not (eq (point) opoint)) - (or (markdown-link-p) (markdown-wiki-link-p))) - ;; Group 1 will move past non-escape character in wiki link regexp. - ;; Go to beginning of group zero for all other link types. - (goto-char (or (match-beginning 1) (match-beginning 0))) - (goto-char opoint) - nil))) - -(defun markdown-previous-link () - "Jump to previous wiki link. -If successful, return point. Otherwise, return nil. -See `markdown-wiki-link-p' and `markdown-next-wiki-link'." - (interactive) - (let ((opoint (point))) - (while (and (re-search-backward (markdown-make-regex-link-generic) nil t) - (markdown-code-block-at-point-p) - (> (point) (point-min)))) - (if (and (not (eq (point) opoint)) - (or (markdown-link-p) (markdown-wiki-link-p))) - (goto-char (or (match-beginning 1) (match-beginning 0))) - (goto-char opoint) - nil))) - - -;;; Outline =================================================================== - -(defun markdown-move-heading-common (move-fn &optional arg adjust) - "Wrapper for `outline-mode' functions to skip false positives. -MOVE-FN is a function and ARG is its argument. For example, -headings inside preformatted code blocks may match -`outline-regexp' but should not be considered as headings. -When ADJUST is non-nil, adjust the point for interactive calls -to avoid leaving the point at invisible markup. This adjustment -generally should only be done for interactive calls, since other -functions may expect the point to be at the beginning of the -regular expression." - (let ((prev -1) (start (point))) - (if arg (funcall move-fn arg) (funcall move-fn)) - (while (and (/= prev (point)) (markdown-code-block-at-point-p)) - (setq prev (point)) - (if arg (funcall move-fn arg) (funcall move-fn))) - ;; Adjust point for setext headings and invisible text. - (save-match-data - (when (and adjust (thing-at-point-looking-at markdown-regex-header)) - (if markdown-hide-markup - ;; Move to beginning of heading text if markup is hidden. - (goto-char (or (match-beginning 1) (match-beginning 5))) - ;; Move to beginning of markup otherwise. - (goto-char (or (match-beginning 1) (match-beginning 4)))))) - (if (= (point) start) nil (point)))) - -(defun markdown-next-visible-heading (arg) - "Move to the next visible heading line of any level. -With argument, repeats or can move backward if negative. ARG is -passed to `outline-next-visible-heading'." - (interactive "p") - (markdown-move-heading-common #'outline-next-visible-heading arg 'adjust)) - -(defun markdown-previous-visible-heading (arg) - "Move to the previous visible heading line of any level. -With argument, repeats or can move backward if negative. ARG is -passed to `outline-previous-visible-heading'." - (interactive "p") - (markdown-move-heading-common #'outline-previous-visible-heading arg 'adjust)) - -(defun markdown-next-heading () - "Move to the next heading line of any level." - (markdown-move-heading-common #'outline-next-heading)) - -(defun markdown-previous-heading () - "Move to the previous heading line of any level." - (markdown-move-heading-common #'outline-previous-heading)) - -(defun markdown-back-to-heading-over-code-block (&optional invisible-ok no-error) - "Move back to the beginning of the previous heading. -Returns t if the point is at a heading, the location if a heading -was found, and nil otherwise. -Only visible heading lines are considered, unless INVISIBLE-OK is -non-nil. Throw an error if there is no previous heading unless -NO-ERROR is non-nil. -Leaves match data intact for `markdown-regex-header'." - (beginning-of-line) - (or (and (markdown-heading-at-point) - (not (markdown-code-block-at-point-p))) - (let (found) - (save-excursion - (while (and (not found) - (re-search-backward markdown-regex-header nil t)) - (when (and (or invisible-ok (not (outline-invisible-p))) - (not (markdown-code-block-at-point-p))) - (setq found (point)))) - (if (not found) - (unless no-error (user-error "Before first heading")) - (setq found (point)))) - (when found (goto-char found))))) - -(defun markdown-forward-same-level (arg) - "Move forward to the ARG'th heading at same level as this one. -Stop at the first and last headings of a superior heading." - (interactive "p") - (markdown-back-to-heading-over-code-block) - (markdown-move-heading-common #'outline-forward-same-level arg 'adjust)) - -(defun markdown-backward-same-level (arg) - "Move backward to the ARG'th heading at same level as this one. -Stop at the first and last headings of a superior heading." - (interactive "p") - (markdown-back-to-heading-over-code-block) - (while (> arg 0) - (let ((point-to-move-to - (save-excursion - (markdown-move-heading-common #'outline-get-last-sibling nil 'adjust)))) - (if point-to-move-to - (progn - (goto-char point-to-move-to) - (setq arg (1- arg))) - (user-error "No previous same-level heading"))))) - -(defun markdown-up-heading (arg &optional interactive) - "Move to the visible heading line of which the present line is a subheading. -With argument, move up ARG levels. When called interactively (or -INTERACTIVE is non-nil), also push the mark." - (interactive "p\np") - (and interactive (not (eq last-command 'markdown-up-heading)) - (push-mark)) - (markdown-move-heading-common #'outline-up-heading arg 'adjust)) - -(defun markdown-back-to-heading (&optional invisible-ok) - "Move to previous heading line, or beg of this line if it's a heading. -Only visible heading lines are considered, unless INVISIBLE-OK is non-nil." - (interactive) - (markdown-move-heading-common #'outline-back-to-heading invisible-ok)) - -(defalias 'markdown-end-of-heading 'outline-end-of-heading) - -(defun markdown-on-heading-p () - "Return non-nil if point is on a heading line." - (get-text-property (line-beginning-position) 'markdown-heading)) - -(defun markdown-end-of-subtree (&optional invisible-OK) - "Move to the end of the current subtree. -Only visible heading lines are considered, unless INVISIBLE-OK is -non-nil. -Derived from `org-end-of-subtree'." - (markdown-back-to-heading invisible-OK) - (let ((first t) - (level (markdown-outline-level))) - (while (and (not (eobp)) - (or first (> (markdown-outline-level) level))) - (setq first nil) - (markdown-next-heading)) - (if (memq (preceding-char) '(?\n ?\^M)) - (progn - ;; Go to end of line before heading - (forward-char -1) - (if (memq (preceding-char) '(?\n ?\^M)) - ;; leave blank line before heading - (forward-char -1))))) - (point)) - -(defun markdown-outline-fix-visibility () - "Hide any false positive headings that should not be shown. -For example, headings inside preformatted code blocks may match -`outline-regexp' but should not be shown as headings when cycling. -Also, the ending --- line in metadata blocks appears to be a -setext header, but should not be folded." - (save-excursion - (goto-char (point-min)) - ;; Unhide any false positives in metadata blocks - (when (markdown-text-property-at-point 'markdown-yaml-metadata-begin) - (let ((body (progn (forward-line) - (markdown-text-property-at-point - 'markdown-yaml-metadata-section)))) - (when body - (let ((end (progn (goto-char (cl-second body)) - (markdown-text-property-at-point - 'markdown-yaml-metadata-end)))) - (outline-flag-region (point-min) (1+ (cl-second end)) nil))))) - ;; Hide any false positives in code blocks - (unless (outline-on-heading-p) - (outline-next-visible-heading 1)) - (while (< (point) (point-max)) - (when (markdown-code-block-at-point-p) - (outline-flag-region (1- (line-beginning-position)) (line-end-position) t)) - (outline-next-visible-heading 1)))) - -(defvar markdown-cycle-global-status 1) -(defvar markdown-cycle-subtree-status nil) - -(defun markdown-next-preface () - (let (finish) - (while (and (not finish) (re-search-forward (concat "\n\\(?:" outline-regexp "\\)") - nil 'move)) - (unless (markdown-code-block-at-point-p) - (goto-char (match-beginning 0)) - (setq finish t)))) - (when (and (bolp) (or outline-blank-line (eobp)) (not (bobp))) - (forward-char -1))) - -(defun markdown-show-entry () - (save-excursion - (outline-back-to-heading t) - (outline-flag-region (1- (point)) - (progn - (markdown-next-preface) - (if (= 1 (- (point-max) (point))) - (point-max) - (point))) - nil))) - -;; This function was originally derived from `org-cycle' from org.el. -(defun markdown-cycle (&optional arg) - "Visibility cycling for Markdown mode. -This function is called with a `\\[universal-argument]' or if ARG is t, perform -global visibility cycling. If the point is at an atx-style header, cycle -visibility of the corresponding subtree. Otherwise, indent the current line - or insert a tab, as appropriate, by calling `indent-for-tab-command'." - (interactive "P") - (cond - - ;; Global cycling - (arg - (cond - ;; Move from overview to contents - ((and (eq last-command this-command) - (eq markdown-cycle-global-status 2)) - (outline-hide-sublevels 1) - (message "CONTENTS") - (setq markdown-cycle-global-status 3) - (markdown-outline-fix-visibility)) - ;; Move from contents to all - ((and (eq last-command this-command) - (eq markdown-cycle-global-status 3)) - (outline-show-all) - (message "SHOW ALL") - (setq markdown-cycle-global-status 1)) - ;; Defaults to overview - (t - (outline-hide-body) - (message "OVERVIEW") - (setq markdown-cycle-global-status 2) - (markdown-outline-fix-visibility)))) - - ;; At a heading: rotate between three different views - ((save-excursion (beginning-of-line 1) (markdown-on-heading-p)) - (markdown-back-to-heading) - (let ((goal-column 0) eoh eol eos) - ;; Determine boundaries - (save-excursion - (markdown-back-to-heading) - (save-excursion - (beginning-of-line 2) - (while (and (not (eobp)) ;; this is like `next-line' - (get-char-property (1- (point)) 'invisible)) - (beginning-of-line 2)) (setq eol (point))) - (markdown-end-of-heading) (setq eoh (point)) - (markdown-end-of-subtree t) - (skip-chars-forward " \t\n") - (beginning-of-line 1) ; in case this is an item - (setq eos (1- (point)))) - ;; Find out what to do next and set `this-command' - (cond - ;; Nothing is hidden behind this heading - ((= eos eoh) - (message "EMPTY ENTRY") - (setq markdown-cycle-subtree-status nil)) - ;; Entire subtree is hidden in one line: open it - ((>= eol eos) - (markdown-show-entry) - (outline-show-children) - (message "CHILDREN") - (setq markdown-cycle-subtree-status 'children)) - ;; We just showed the children, now show everything. - ((and (eq last-command this-command) - (eq markdown-cycle-subtree-status 'children)) - (outline-show-subtree) - (message "SUBTREE") - (setq markdown-cycle-subtree-status 'subtree)) - ;; Default action: hide the subtree. - (t - (outline-hide-subtree) - (message "FOLDED") - (setq markdown-cycle-subtree-status 'folded))))) - - ;; In a table, move forward by one cell - ((markdown-table-at-point-p) - (call-interactively #'markdown-table-forward-cell)) - - ;; Otherwise, indent as appropriate - (t - (indent-for-tab-command)))) - -(defun markdown-shifttab () - "Handle S-TAB keybinding based on context. -When in a table, move backward one cell. -Otherwise, cycle global heading visibility by calling -`markdown-cycle' with argument t." - (interactive) - (cond ((markdown-table-at-point-p) - (call-interactively #'markdown-table-backward-cell)) - (t (markdown-cycle t)))) - -(defun markdown-outline-level () - "Return the depth to which a statement is nested in the outline." - (cond - ((and (match-beginning 0) - (markdown-code-block-at-pos (match-beginning 0))) - 7) ;; Only 6 header levels are defined. - ((match-end 2) 1) - ((match-end 3) 2) - ((match-end 4) - (length (markdown-trim-whitespace (match-string-no-properties 4)))))) - -(defun markdown-promote-subtree (&optional arg) - "Promote the current subtree of ATX headings. -Note that Markdown does not support heading levels higher than -six and therefore level-six headings will not be promoted -further. If ARG is non-nil promote the heading, otherwise -demote." - (interactive "*P") - (save-excursion - (when (and (or (thing-at-point-looking-at markdown-regex-header-atx) - (re-search-backward markdown-regex-header-atx nil t)) - (not (markdown-code-block-at-point-p))) - (let ((level (length (match-string 1))) - (promote-or-demote (if arg 1 -1)) - (remove 't)) - (markdown-cycle-atx promote-or-demote remove) - (catch 'end-of-subtree - (while (and (markdown-next-heading) - (looking-at markdown-regex-header-atx)) - ;; Exit if this not a higher level heading; promote otherwise. - (if (and (looking-at markdown-regex-header-atx) - (<= (length (match-string-no-properties 1)) level)) - (throw 'end-of-subtree nil) - (markdown-cycle-atx promote-or-demote remove)))))))) - -(defun markdown-demote-subtree () - "Demote the current subtree of ATX headings." - (interactive) - (markdown-promote-subtree t)) - -(defun markdown-move-subtree-up () - "Move the current subtree of ATX headings up." - (interactive) - (outline-move-subtree-up 1)) - -(defun markdown-move-subtree-down () - "Move the current subtree of ATX headings down." - (interactive) - (outline-move-subtree-down 1)) - -(defun markdown-outline-next () - "Move to next list item, when in a list, or next visible heading." - (interactive) - (let ((bounds (markdown-next-list-item-bounds))) - (if bounds - (goto-char (nth 0 bounds)) - (markdown-next-visible-heading 1)))) - -(defun markdown-outline-previous () - "Move to previous list item, when in a list, or previous visible heading." - (interactive) - (let ((bounds (markdown-prev-list-item-bounds))) - (if bounds - (goto-char (nth 0 bounds)) - (markdown-previous-visible-heading 1)))) - -(defun markdown-outline-next-same-level () - "Move to next list item or heading of same level." - (interactive) - (let ((bounds (markdown-cur-list-item-bounds))) - (if bounds - (markdown-next-list-item (nth 3 bounds)) - (markdown-forward-same-level 1)))) - -(defun markdown-outline-previous-same-level () - "Move to previous list item or heading of same level." - (interactive) - (let ((bounds (markdown-cur-list-item-bounds))) - (if bounds - (markdown-prev-list-item (nth 3 bounds)) - (markdown-backward-same-level 1)))) - -(defun markdown-outline-up () - "Move to previous list item, when in a list, or previous heading." - (interactive) - (unless (markdown-up-list) - (markdown-up-heading 1))) - - -;;; Marking and Narrowing ===================================================== - -(defun markdown-mark-paragraph () - "Put mark at end of this block, point at beginning. -The block marked is the one that contains point or follows point. - -Interactively, if this command is repeated or (in Transient Mark -mode) if the mark is active, it marks the next block after the -ones already marked." - (interactive) - (if (or (and (eq last-command this-command) (mark t)) - (and transient-mark-mode mark-active)) - (set-mark - (save-excursion - (goto-char (mark)) - (markdown-forward-paragraph) - (point))) - (let ((beginning-of-defun-function #'markdown-backward-paragraph) - (end-of-defun-function #'markdown-forward-paragraph)) - (mark-defun)))) - -(defun markdown-mark-block () - "Put mark at end of this block, point at beginning. -The block marked is the one that contains point or follows point. - -Interactively, if this command is repeated or (in Transient Mark -mode) if the mark is active, it marks the next block after the -ones already marked." - (interactive) - (if (or (and (eq last-command this-command) (mark t)) - (and transient-mark-mode mark-active)) - (set-mark - (save-excursion - (goto-char (mark)) - (markdown-forward-block) - (point))) - (let ((beginning-of-defun-function #'markdown-backward-block) - (end-of-defun-function #'markdown-forward-block)) - (mark-defun)))) - -(defun markdown-narrow-to-block () - "Make text outside current block invisible. -The current block is the one that contains point or follows point." - (interactive) - (let ((beginning-of-defun-function #'markdown-backward-block) - (end-of-defun-function #'markdown-forward-block)) - (narrow-to-defun))) - -(defun markdown-mark-text-block () - "Put mark at end of this plain text block, point at beginning. -The block marked is the one that contains point or follows point. - -Interactively, if this command is repeated or (in Transient Mark -mode) if the mark is active, it marks the next block after the -ones already marked." - (interactive) - (if (or (and (eq last-command this-command) (mark t)) - (and transient-mark-mode mark-active)) - (set-mark - (save-excursion - (goto-char (mark)) - (markdown-end-of-text-block) - (point))) - (let ((beginning-of-defun-function #'markdown-beginning-of-text-block) - (end-of-defun-function #'markdown-end-of-text-block)) - (mark-defun)))) - -(defun markdown-mark-page () - "Put mark at end of this top level section, point at beginning. -The top level section marked is the one that contains point or -follows point. - -Interactively, if this command is repeated or (in Transient Mark -mode) if the mark is active, it marks the next page after the -ones already marked." - (interactive) - (if (or (and (eq last-command this-command) (mark t)) - (and transient-mark-mode mark-active)) - (set-mark - (save-excursion - (goto-char (mark)) - (markdown-forward-page) - (point))) - (let ((beginning-of-defun-function #'markdown-backward-page) - (end-of-defun-function #'markdown-forward-page)) - (mark-defun)))) - -(defun markdown-narrow-to-page () - "Make text outside current top level section invisible. -The current section is the one that contains point or follows point." - (interactive) - (let ((beginning-of-defun-function #'markdown-backward-page) - (end-of-defun-function #'markdown-forward-page)) - (narrow-to-defun))) - -(defun markdown-mark-subtree () - "Mark the current subtree. -This puts point at the start of the current subtree, and mark at the end." - (interactive) - (let ((beg)) - (if (markdown-heading-at-point) - (beginning-of-line) - (markdown-previous-visible-heading 1)) - (setq beg (point)) - (markdown-end-of-subtree) - (push-mark (point) nil t) - (goto-char beg))) - -(defun markdown-narrow-to-subtree () - "Narrow buffer to the current subtree." - (interactive) - (save-excursion - (save-match-data - (narrow-to-region - (progn (markdown-back-to-heading-over-code-block t) (point)) - (progn (markdown-end-of-subtree) - (if (and (markdown-heading-at-point) (not (eobp))) - (backward-char 1)) - (point)))))) - - -;;; Generic Structure Editing, Completion, and Cycling Commands =============== - -(defun markdown-move-up () - "Move thing at point up. -When in a list item, call `markdown-move-list-item-up'. -When in a table, call `markdown-table-move-row-up'. -Otherwise, move the current heading subtree up with -`markdown-move-subtree-up'." - (interactive) - (cond - ((markdown-list-item-at-point-p) - (call-interactively #'markdown-move-list-item-up)) - ((markdown-table-at-point-p) - (call-interactively #'markdown-table-move-row-up)) - (t - (call-interactively #'markdown-move-subtree-up)))) - -(defun markdown-move-down () - "Move thing at point down. -When in a list item, call `markdown-move-list-item-down'. -Otherwise, move the current heading subtree up with -`markdown-move-subtree-down'." - (interactive) - (cond - ((markdown-list-item-at-point-p) - (call-interactively #'markdown-move-list-item-down)) - ((markdown-table-at-point-p) - (call-interactively #'markdown-table-move-row-down)) - (t - (call-interactively #'markdown-move-subtree-down)))) - -(defun markdown-promote () - "Promote or move element at point to the left. -Depending on the context, this function will promote a heading or -list item at the point, move a table column to the left, or cycle -markup." - (interactive) - (let (bounds) - (cond - ;; Promote atx heading subtree - ((thing-at-point-looking-at markdown-regex-header-atx) - (markdown-promote-subtree)) - ;; Promote setext heading - ((thing-at-point-looking-at markdown-regex-header-setext) - (markdown-cycle-setext -1)) - ;; Promote horizontal rule - ((thing-at-point-looking-at markdown-regex-hr) - (markdown-cycle-hr -1)) - ;; Promote list item - ((setq bounds (markdown-cur-list-item-bounds)) - (markdown-promote-list-item bounds)) - ;; Move table column to the left - ((markdown-table-at-point-p) - (call-interactively #'markdown-table-move-column-left)) - ;; Promote bold - ((thing-at-point-looking-at markdown-regex-bold) - (markdown-cycle-bold)) - ;; Promote italic - ((thing-at-point-looking-at markdown-regex-italic) - (markdown-cycle-italic)) - (t - (user-error "Nothing to promote at point"))))) - -(defun markdown-demote () - "Demote or move element at point to the right. -Depending on the context, this function will demote a heading or -list item at the point, move a table column to the right, or cycle -or remove markup." - (interactive) - (let (bounds) - (cond - ;; Demote atx heading subtree - ((thing-at-point-looking-at markdown-regex-header-atx) - (markdown-demote-subtree)) - ;; Demote setext heading - ((thing-at-point-looking-at markdown-regex-header-setext) - (markdown-cycle-setext 1)) - ;; Demote horizontal rule - ((thing-at-point-looking-at markdown-regex-hr) - (markdown-cycle-hr 1)) - ;; Demote list item - ((setq bounds (markdown-cur-list-item-bounds)) - (markdown-demote-list-item bounds)) - ;; Move table column to the right - ((markdown-table-at-point-p) - (call-interactively #'markdown-table-move-column-right)) - ;; Demote bold - ((thing-at-point-looking-at markdown-regex-bold) - (markdown-cycle-bold)) - ;; Demote italic - ((thing-at-point-looking-at markdown-regex-italic) - (markdown-cycle-italic)) - (t - (user-error "Nothing to demote at point"))))) - - -;;; Commands ================================================================== - -(defun markdown (&optional output-buffer-name) - "Run `markdown-command' on buffer, sending output to OUTPUT-BUFFER-NAME. -The output buffer name defaults to `markdown-output-buffer-name'. -Return the name of the output buffer used." - (interactive) - (save-window-excursion - (let* ((commands (cond ((stringp markdown-command) (split-string markdown-command)) - ((listp markdown-command) markdown-command))) - (command (car-safe commands)) - (command-args (cdr-safe commands)) - begin-region end-region) - (if (use-region-p) - (setq begin-region (region-beginning) - end-region (region-end)) - (setq begin-region (point-min) - end-region (point-max))) - - (unless output-buffer-name - (setq output-buffer-name markdown-output-buffer-name)) - (when (and (stringp command) (not (executable-find command))) - (user-error "Markdown command %s is not found" command)) - (let ((exit-code - (cond - ;; Handle case when `markdown-command' does not read from stdin - ((and (stringp command) markdown-command-needs-filename) - (if (not buffer-file-name) - (user-error "Must be visiting a file") - ;; Don’t use ‘shell-command’ because it’s not guaranteed to - ;; return the exit code of the process. - (let ((command (if (listp markdown-command) - (string-join markdown-command " ") - markdown-command))) - (shell-command-on-region - ;; Pass an empty region so that stdin is empty. - (point) (point) - (concat command " " - (shell-quote-argument buffer-file-name)) - output-buffer-name)))) - ;; Pass region to `markdown-command' via stdin - (t - (let ((buf (get-buffer-create output-buffer-name))) - (with-current-buffer buf - (setq buffer-read-only nil) - (erase-buffer)) - (if (stringp command) - (if (not (null command-args)) - (apply #'call-process-region begin-region end-region command nil buf nil command-args) - (call-process-region begin-region end-region command nil buf)) - (if markdown-command-needs-filename - (if (not buffer-file-name) - (user-error "Must be visiting a file") - (funcall markdown-command begin-region end-region buf buffer-file-name)) - (funcall markdown-command begin-region end-region buf)) - ;; If the ‘markdown-command’ function didn’t signal an - ;; error, assume it succeeded by binding ‘exit-code’ to 0. - 0)))))) - ;; The exit code can be a signal description string, so don’t use ‘=’ - ;; or ‘zerop’. - (unless (eq exit-code 0) - (user-error "%s failed with exit code %s" - markdown-command exit-code)))) - output-buffer-name)) - -(defun markdown-standalone (&optional output-buffer-name) - "Special function to provide standalone HTML output. -Insert the output in the buffer named OUTPUT-BUFFER-NAME." - (interactive) - (setq output-buffer-name (markdown output-buffer-name)) - (with-current-buffer output-buffer-name - (set-buffer output-buffer-name) - (unless (markdown-output-standalone-p) - (markdown-add-xhtml-header-and-footer output-buffer-name)) - (goto-char (point-min)) - (html-mode)) - output-buffer-name) - -(defun markdown-other-window (&optional output-buffer-name) - "Run `markdown-command' on current buffer and display in other window. -When OUTPUT-BUFFER-NAME is given, insert the output in the buffer with -that name." - (interactive) - (markdown-display-buffer-other-window - (markdown-standalone output-buffer-name))) - -(defun markdown-output-standalone-p () - "Determine whether `markdown-command' output is standalone XHTML. -Standalone XHTML output is identified by an occurrence of -`markdown-xhtml-standalone-regexp' in the first five lines of output." - (save-excursion - (goto-char (point-min)) - (save-match-data - (re-search-forward - markdown-xhtml-standalone-regexp - (save-excursion (goto-char (point-min)) (forward-line 4) (point)) - t)))) - -(defun markdown-stylesheet-link-string (stylesheet-path) - (concat "<link rel=\"stylesheet\" type=\"text/css\" media=\"all\" href=\"" - (or (and (string-prefix-p "~" stylesheet-path) - (expand-file-name stylesheet-path)) - stylesheet-path) - "\" />")) - -(defun markdown-escape-title (title) - "Escape a minimum set of characters in TITLE so they don't clash with html." - (replace-regexp-in-string ">" "&gt;" - (replace-regexp-in-string "<" "&lt;" - (replace-regexp-in-string "&" "&amp;" title)))) - -(defun markdown-add-xhtml-header-and-footer (title) - "Wrap XHTML header and footer with given TITLE around current buffer." - (goto-char (point-min)) - (insert "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>\n" - "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"\n" - "\t\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n\n" - "<html xmlns=\"http://www.w3.org/1999/xhtml\">\n\n" - "<head>\n<title>") - (insert (markdown-escape-title title)) - (insert "</title>\n") - (unless (= (length markdown-content-type) 0) - (insert - (format - "<meta http-equiv=\"Content-Type\" content=\"%s;charset=%s\"/>\n" - markdown-content-type - (or (and markdown-coding-system - (coding-system-get markdown-coding-system - 'mime-charset)) - (coding-system-get buffer-file-coding-system - 'mime-charset) - "utf-8")))) - (if (> (length markdown-css-paths) 0) - (insert (mapconcat #'markdown-stylesheet-link-string - markdown-css-paths "\n"))) - (when (> (length markdown-xhtml-header-content) 0) - (insert markdown-xhtml-header-content)) - (insert "\n</head>\n\n" - "<body>\n\n") - (when (> (length markdown-xhtml-body-preamble) 0) - (insert markdown-xhtml-body-preamble "\n")) - (goto-char (point-max)) - (when (> (length markdown-xhtml-body-epilogue) 0) - (insert "\n" markdown-xhtml-body-epilogue)) - (insert "\n" - "</body>\n" - "</html>\n")) - -(defun markdown-preview (&optional output-buffer-name) - "Run `markdown-command' on the current buffer and view output in browser. -When OUTPUT-BUFFER-NAME is given, insert the output in the buffer with -that name." - (interactive) - (browse-url-of-buffer - (markdown-standalone (or output-buffer-name markdown-output-buffer-name)))) - -(defun markdown-export-file-name (&optional extension) - "Attempt to generate a filename for Markdown output. -The file extension will be EXTENSION if given, or .html by default. -If the current buffer is visiting a file, we construct a new -output filename based on that filename. Otherwise, return nil." - (when (buffer-file-name) - (unless extension - (setq extension ".html")) - (let ((candidate - (concat - (cond - ((buffer-file-name) - (file-name-sans-extension (buffer-file-name))) - (t (buffer-name))) - extension))) - (cond - ((equal candidate (buffer-file-name)) - (concat candidate extension)) - (t - candidate))))) - -(defun markdown-export (&optional output-file) - "Run Markdown on the current buffer, save to file, and return the filename. -If OUTPUT-FILE is given, use that as the filename. Otherwise, use the filename -generated by `markdown-export-file-name', which will be constructed using the -current filename, but with the extension removed and replaced with .html." - (interactive) - (unless output-file - (setq output-file (markdown-export-file-name ".html"))) - (when output-file - (let* ((init-buf (current-buffer)) - (init-point (point)) - (init-buf-string (buffer-string)) - (output-buffer (find-file-noselect output-file)) - (output-buffer-name (buffer-name output-buffer))) - (run-hooks 'markdown-before-export-hook) - (markdown-standalone output-buffer-name) - (with-current-buffer output-buffer - (run-hooks 'markdown-after-export-hook) - (save-buffer) - (when markdown-export-kill-buffer (kill-buffer))) - ;; if modified, restore initial buffer - (when (buffer-modified-p init-buf) - (erase-buffer) - (insert init-buf-string) - (save-buffer) - (goto-char init-point)) - output-file))) - -(defun markdown-export-and-preview () - "Export to XHTML using `markdown-export' and browse the resulting file." - (interactive) - (browse-url-of-file (markdown-export))) - -(defvar-local markdown-live-preview-buffer nil - "Buffer used to preview markdown output in `markdown-live-preview-export'.") - -(defvar-local markdown-live-preview-source-buffer nil - "Source buffer from which current buffer was generated. -This is the inverse of `markdown-live-preview-buffer'.") - -(defvar markdown-live-preview-currently-exporting nil) - -(defun markdown-live-preview-get-filename () - "Standardize the filename exported by `markdown-live-preview-export'." - (markdown-export-file-name ".html")) - -(defun markdown-live-preview-window-eww (file) - "Preview FILE with eww. -To be used with `markdown-live-preview-window-function'." - (when (and (bound-and-true-p eww-auto-rename-buffer) - markdown-live-preview-buffer) - (kill-buffer markdown-live-preview-buffer)) - (eww-open-file file) - ;; #737 if `eww-auto-rename-buffer' is non-nil, the buffer name is not "*eww*" - ;; Try to find the buffer whose name ends with "eww*" - (if (bound-and-true-p eww-auto-rename-buffer) - (cl-loop for buf in (buffer-list) - when (string-match-p "eww\\*\\'" (buffer-name buf)) - return buf) - (get-buffer "*eww*"))) - -(defun markdown-visual-lines-between-points (beg end) - (save-excursion - (goto-char beg) - (cl-loop with count = 0 - while (progn (end-of-visual-line) - (and (< (point) end) (line-move-visual 1 t))) - do (cl-incf count) - finally return count))) - -(defun markdown-live-preview-window-serialize (buf) - "Get window point and scroll data for all windows displaying BUF." - (when (buffer-live-p buf) - (with-current-buffer buf - (mapcar - (lambda (win) - (with-selected-window win - (let* ((start (window-start)) - (pt (window-point)) - (pt-or-sym (cond ((= pt (point-min)) 'min) - ((= pt (point-max)) 'max) - (t pt))) - (diff (markdown-visual-lines-between-points - start pt))) - (list win pt-or-sym diff)))) - (get-buffer-window-list buf))))) - -(defun markdown-get-point-back-lines (pt num-lines) - (save-excursion - (goto-char pt) - (line-move-visual (- num-lines) t) - ;; in testing, can occasionally overshoot the number of lines to traverse - (let ((actual-num-lines (markdown-visual-lines-between-points (point) pt))) - (when (> actual-num-lines num-lines) - (line-move-visual (- actual-num-lines num-lines) t))) - (point))) - -(defun markdown-live-preview-window-deserialize (window-posns) - "Apply window point and scroll data from WINDOW-POSNS. -WINDOW-POSNS is provided by `markdown-live-preview-window-serialize'." - (cl-destructuring-bind (win pt-or-sym diff) window-posns - (when (window-live-p win) - (with-current-buffer markdown-live-preview-buffer - (set-window-buffer win (current-buffer)) - (cl-destructuring-bind (actual-pt actual-diff) - (cl-case pt-or-sym - (min (list (point-min) 0)) - (max (list (point-max) diff)) - (t (list pt-or-sym diff))) - (set-window-start - win (markdown-get-point-back-lines actual-pt actual-diff)) - (set-window-point win actual-pt)))))) - -(defun markdown-live-preview-export () - "Export to XHTML using `markdown-export'. -Browse the resulting file within Emacs using -`markdown-live-preview-window-function' Return the buffer -displaying the rendered output." - (interactive) - (let ((filename (markdown-live-preview-get-filename))) - (when filename - (let* ((markdown-live-preview-currently-exporting t) - (cur-buf (current-buffer)) - (export-file (markdown-export filename)) - ;; get positions in all windows currently displaying output buffer - (window-data - (markdown-live-preview-window-serialize - markdown-live-preview-buffer))) - (save-window-excursion - (let ((output-buffer - (funcall markdown-live-preview-window-function export-file))) - (with-current-buffer output-buffer - (setq markdown-live-preview-source-buffer cur-buf) - (add-hook 'kill-buffer-hook - #'markdown-live-preview-remove-on-kill t t)) - (with-current-buffer cur-buf - (setq markdown-live-preview-buffer output-buffer)))) - (with-current-buffer cur-buf - ;; reset all windows displaying output buffer to where they were, - ;; now with the new output - (mapc #'markdown-live-preview-window-deserialize window-data) - ;; delete html editing buffer - (let ((buf (get-file-buffer export-file))) (when buf (kill-buffer buf))) - (when (and export-file (file-exists-p export-file) - (eq markdown-live-preview-delete-export - 'delete-on-export)) - (delete-file export-file)) - markdown-live-preview-buffer))))) - -(defun markdown-live-preview-remove () - (when (buffer-live-p markdown-live-preview-buffer) - (kill-buffer markdown-live-preview-buffer)) - (setq markdown-live-preview-buffer nil) - ;; if set to 'delete-on-export, the output has already been deleted - (when (eq markdown-live-preview-delete-export 'delete-on-destroy) - (let ((outfile-name (markdown-live-preview-get-filename))) - (when (and outfile-name (file-exists-p outfile-name)) - (delete-file outfile-name))))) - -(defun markdown-get-other-window () - "Find another window to display preview or output content." - (cond - ((memq markdown-split-window-direction '(vertical below)) - (or (window-in-direction 'below) (split-window-vertically))) - ((memq markdown-split-window-direction '(horizontal right)) - (or (window-in-direction 'right) (split-window-horizontally))) - (t (split-window-sensibly (get-buffer-window))))) - -(defun markdown-display-buffer-other-window (buf) - "Display preview or output buffer BUF in another window." - (if (and display-buffer-alist (eq markdown-split-window-direction 'any)) - (display-buffer buf) - (let ((cur-buf (current-buffer)) - (window (markdown-get-other-window))) - (set-window-buffer window buf) - (set-buffer cur-buf)))) - -(defun markdown-live-preview-if-markdown () - (when (and (derived-mode-p 'markdown-mode) - markdown-live-preview-mode) - (unless markdown-live-preview-currently-exporting - (if (buffer-live-p markdown-live-preview-buffer) - (markdown-live-preview-export) - (markdown-display-buffer-other-window - (markdown-live-preview-export)))))) - -(defun markdown-live-preview-remove-on-kill () - (cond ((and (derived-mode-p 'markdown-mode) - markdown-live-preview-mode) - (markdown-live-preview-remove)) - (markdown-live-preview-source-buffer - (with-current-buffer markdown-live-preview-source-buffer - (setq markdown-live-preview-buffer nil)) - (setq markdown-live-preview-source-buffer nil)))) - -(defun markdown-live-preview-switch-to-output () - "Turn on `markdown-live-preview-mode' and switch to output buffer. -The output buffer is opened in another window." - (interactive) - (if markdown-live-preview-mode - (markdown-display-buffer-other-window (markdown-live-preview-export))) - (markdown-live-preview-mode)) - -(defun markdown-live-preview-re-export () - "Re-export the current live previewed content. -If the current buffer is a buffer displaying the exported version of a -`markdown-live-preview-mode' buffer, call `markdown-live-preview-export' and -update this buffer's contents." - (interactive) - (when markdown-live-preview-source-buffer - (with-current-buffer markdown-live-preview-source-buffer - (markdown-live-preview-export)))) - -(defun markdown-open () - "Open file for the current buffer with `markdown-open-command'." - (interactive) - (unless markdown-open-command - (user-error "Variable `markdown-open-command' must be set")) - (if (stringp markdown-open-command) - (if (not buffer-file-name) - (user-error "Must be visiting a file") - (save-buffer) - (let ((exit-code (call-process markdown-open-command nil nil nil - buffer-file-name))) - ;; The exit code can be a signal description string, so don’t use ‘=’ - ;; or ‘zerop’. - (unless (eq exit-code 0) - (user-error "%s failed with exit code %s" - markdown-open-command exit-code)))) - (funcall markdown-open-command)) - nil) - -(defun markdown-kill-ring-save () - "Run Markdown on file and store output in the kill ring." - (interactive) - (save-window-excursion - (markdown) - (with-current-buffer markdown-output-buffer-name - (kill-ring-save (point-min) (point-max))))) - - -;;; Links ===================================================================== - -(defun markdown-backward-to-link-start () - "Backward link start position if current position is in link title." - ;; Issue #305 - (when (eq (get-text-property (point) 'face) 'markdown-link-face) - (skip-chars-backward "^[") - (forward-char -1))) - -(defun markdown-link-p () - "Return non-nil when `point' is at a non-wiki link. -See `markdown-wiki-link-p' for more information." - (save-excursion - (let ((case-fold-search nil)) - (when (and (not (markdown-wiki-link-p)) (not (markdown-code-block-at-point-p))) - (markdown-backward-to-link-start) - (or (thing-at-point-looking-at markdown-regex-link-inline) - (thing-at-point-looking-at markdown-regex-link-reference) - (thing-at-point-looking-at markdown-regex-uri) - (thing-at-point-looking-at markdown-regex-angle-uri)))))) - -(defun markdown-link-at-pos (pos) - "Return properties of link or image at position POS. -Value is a list of elements describing the link: - 0. beginning position - 1. end position - 2. link text - 3. URL - 4. reference label - 5. title text - 6. bang (nil or \"!\")" - (save-excursion - (goto-char pos) - (markdown-backward-to-link-start) - (let (begin end text url reference title bang) - (cond - ;; Inline image or link at point. - ((thing-at-point-looking-at markdown-regex-link-inline) - (setq bang (match-string-no-properties 1) - begin (match-beginning 0) - text (match-string-no-properties 3) - url (match-string-no-properties 6)) - ;; consider nested parentheses - ;; if link target contains parentheses, (match-end 0) isn't correct end position of the link - (let* ((close-pos (scan-sexps (match-beginning 5) 1)) - (destination-part (string-trim (buffer-substring-no-properties (1+ (match-beginning 5)) (1- close-pos))))) - (setq end close-pos) - ;; A link can contain spaces if it is wrapped with angle brackets - (cond ((string-match "\\`<\\(.+\\)>\\'" destination-part) - (setq url (match-string-no-properties 1 destination-part))) - ((string-match "\\([^ ]+\\)\\s-+\\(.+\\)" destination-part) - (setq url (match-string-no-properties 1 destination-part) - title (substring (match-string-no-properties 2 destination-part) 1 -1))) - (t (setq url destination-part))) - (setq url (url-unhex-string url)))) - ;; Reference link at point. - ((thing-at-point-looking-at markdown-regex-link-reference) - (setq bang (match-string-no-properties 1) - begin (match-beginning 0) - end (match-end 0) - text (match-string-no-properties 3)) - (when (char-equal (char-after (match-beginning 5)) ?\[) - (setq reference (match-string-no-properties 6)))) - ;; Angle bracket URI at point. - ((thing-at-point-looking-at markdown-regex-angle-uri) - (setq begin (match-beginning 0) - end (match-end 0) - url (match-string-no-properties 2))) - ;; Plain URI at point. - ((thing-at-point-looking-at markdown-regex-uri) - (setq begin (match-beginning 0) - end (match-end 0) - url (match-string-no-properties 1)))) - (list begin end text url reference title bang)))) - -(defun markdown-link-url () - "Return the URL part of the regular (non-wiki) link at point. -Works with both inline and reference style links, and with images. -If point is not at a link or the link reference is not defined -returns nil." - (let* ((values (markdown-link-at-pos (point))) - (text (nth 2 values)) - (url (nth 3 values)) - (ref (nth 4 values))) - (or url (and ref (car (markdown-reference-definition - (downcase (if (string= ref "") text ref)))))))) - -(defun markdown--browse-url (url) - (let* ((struct (url-generic-parse-url url)) - (full (url-fullness struct)) - (file url)) - ;; Parse URL, determine fullness, strip query string - (setq file (car (url-path-and-query struct))) - ;; Open full URLs in browser, files in Emacs - (if full - (browse-url url) - (when (and file (> (length file) 0)) - (let ((link-file (funcall markdown-translate-filename-function file))) - (if (and markdown-open-image-command (string-match-p (image-file-name-regexp) link-file)) - (if (functionp markdown-open-image-command) - (funcall markdown-open-image-command link-file) - (process-file markdown-open-image-command nil nil nil link-file)) - (find-file link-file))))))) - -(defun markdown-follow-link-at-point (&optional event) - "Open the non-wiki link at point or EVENT. -If the link is a complete URL, open in browser with `browse-url'. -Otherwise, open with `find-file' after stripping anchor and/or query string. -Translate filenames using `markdown-filename-translate-function'." - (interactive (list last-command-event)) - (if event (posn-set-point (event-start event))) - (if (markdown-link-p) - (or (run-hook-with-args-until-success 'markdown-follow-link-functions (markdown-link-url)) - (markdown--browse-url (markdown-link-url))) - (user-error "Point is not at a Markdown link or URL"))) - -(defun markdown-fontify-inline-links (last) - "Add text properties to next inline link from point to LAST." - (when (markdown-match-generic-links last nil) - (let* ((link-start (match-beginning 3)) - (link-end (match-end 3)) - (url-start (match-beginning 6)) - (url-end (match-end 6)) - (url (match-string-no-properties 6)) - (title-start (match-beginning 7)) - (title-end (match-end 7)) - (title (match-string-no-properties 7)) - ;; Markup part - (mp (list 'invisible 'markdown-markup - 'rear-nonsticky t - 'font-lock-multiline t)) - ;; Link part (without face) - (lp (list 'keymap markdown-mode-mouse-map - 'mouse-face 'markdown-highlight-face - 'font-lock-multiline t - 'help-echo (if title (concat title "\n" url) url))) - ;; URL part - (up (list 'keymap markdown-mode-mouse-map - 'invisible 'markdown-markup - 'mouse-face 'markdown-highlight-face - 'font-lock-multiline t)) - ;; URL composition character - (url-char (markdown--first-displayable markdown-url-compose-char)) - ;; Title part - (tp (list 'invisible 'markdown-markup - 'font-lock-multiline t))) - (dolist (g '(1 2 4 5 8)) - (when (match-end g) - (add-text-properties (match-beginning g) (match-end g) mp) - (add-face-text-property (match-beginning g) (match-end g) 'markdown-markup-face))) - ;; Preserve existing faces applied to link part (e.g., inline code) - (when link-start - (add-text-properties link-start link-end lp) - (add-face-text-property link-start link-end 'markdown-link-face)) - (when url-start - (add-text-properties url-start url-end up) - (add-face-text-property url-start url-end 'markdown-url-face)) - (when title-start - (add-text-properties url-end title-end tp) - (add-face-text-property url-end title-end 'markdown-link-title-face)) - (when (and markdown-hide-urls url-start) - (compose-region url-start (or title-end url-end) url-char)) - t))) - -(defun markdown-fontify-reference-links (last) - "Add text properties to next reference link from point to LAST." - (when (markdown-match-generic-links last t) - (let* ((link-start (match-beginning 3)) - (link-end (match-end 3)) - (ref-start (match-beginning 6)) - (ref-end (match-end 6)) - ;; Markup part - (mp (list 'invisible 'markdown-markup - 'rear-nonsticky t - 'font-lock-multiline t)) - ;; Link part - (lp (list 'keymap markdown-mode-mouse-map - 'mouse-face 'markdown-highlight-face - 'font-lock-multiline t - 'help-echo (lambda (_ __ pos) - (save-match-data - (save-excursion - (goto-char pos) - (or (markdown-link-url) - "Undefined reference")))))) - ;; URL composition character - (url-char (markdown--first-displayable markdown-url-compose-char)) - ;; Reference part - (rp (list 'invisible 'markdown-markup - 'font-lock-multiline t))) - (dolist (g '(1 2 4 5 8)) - (when (match-end g) - (add-text-properties (match-beginning g) (match-end g) mp) - (add-face-text-property (match-beginning g) (match-end g) 'markdown-markup-face))) - (when link-start - (add-text-properties link-start link-end lp) - (add-face-text-property link-start link-end 'markdown-link-face)) - (when ref-start - (add-text-properties ref-start ref-end rp) - (add-face-text-property ref-start ref-end 'markdown-reference-face) - (when (and markdown-hide-urls (> (- ref-end ref-start) 2)) - (compose-region ref-start ref-end url-char))) - t))) - -(defun markdown-fontify-angle-uris (last) - "Add text properties to angle URIs from point to LAST." - (when (markdown-match-angle-uris last) - (let* ((url-start (match-beginning 2)) - (url-end (match-end 2)) - ;; Markup part - (mp (list 'face 'markdown-markup-face - 'invisible 'markdown-markup - 'rear-nonsticky t - 'font-lock-multiline t)) - ;; URI part - (up (list 'keymap markdown-mode-mouse-map - 'face 'markdown-plain-url-face - 'mouse-face 'markdown-highlight-face - 'font-lock-multiline t))) - (dolist (g '(1 3)) - (add-text-properties (match-beginning g) (match-end g) mp)) - (add-text-properties url-start url-end up) - t))) - -(defun markdown-fontify-plain-uris (last) - "Add text properties to plain URLs from point to LAST." - (when (markdown-match-plain-uris last) - (let* ((start (match-beginning 0)) - (end (match-end 0)) - (props (list 'keymap markdown-mode-mouse-map - 'face 'markdown-plain-url-face - 'mouse-face 'markdown-highlight-face - 'rear-nonsticky t - 'font-lock-multiline t))) - (add-text-properties start end props) - t))) - -(defun markdown-toggle-url-hiding (&optional arg) - "Toggle the display or hiding of URLs. -With a prefix argument ARG, enable URL hiding if ARG is positive, -and disable it otherwise." - (interactive (list (or current-prefix-arg 'toggle))) - (setq markdown-hide-urls - (if (eq arg 'toggle) - (not markdown-hide-urls) - (> (prefix-numeric-value arg) 0))) - (when (called-interactively-p 'interactive) - (message "markdown-mode URL hiding %s" (if markdown-hide-urls "enabled" "disabled"))) - (markdown-reload-extensions)) - - -;;; Wiki Links ================================================================ - -(defun markdown-wiki-link-p () - "Return non-nil if wiki links are enabled and `point' is at a true wiki link. -A true wiki link name matches `markdown-regex-wiki-link' but does -not match the current file name after conversion. This modifies -the data returned by `match-data'. Note that the potential wiki -link name must be available via `match-string'." - (when markdown-enable-wiki-links - (let ((case-fold-search nil)) - (and (thing-at-point-looking-at markdown-regex-wiki-link) - (not (markdown-code-block-at-point-p)) - (or (not buffer-file-name) - (not (string-equal (buffer-file-name) - (markdown-convert-wiki-link-to-filename - (markdown-wiki-link-link))))))))) - -(defun markdown-wiki-link-link () - "Return the link part of the wiki link using current match data. -The location of the link component depends on the value of -`markdown-wiki-link-alias-first'." - (if markdown-wiki-link-alias-first - (or (match-string-no-properties 5) (match-string-no-properties 3)) - (match-string-no-properties 3))) - -(defun markdown-wiki-link-alias () - "Return the alias or text part of the wiki link using current match data. -The location of the alias component depends on the value of -`markdown-wiki-link-alias-first'." - (if markdown-wiki-link-alias-first - (match-string-no-properties 3) - (or (match-string-no-properties 5) (match-string-no-properties 3)))) - -(defun markdown--wiki-link-search-types () - (let ((ret (and markdown-wiki-link-search-type - (cl-copy-list markdown-wiki-link-search-type)))) - (when (and markdown-wiki-link-search-subdirectories - (not (memq 'sub-directories markdown-wiki-link-search-type))) - (push 'sub-directories ret)) - (when (and markdown-wiki-link-search-parent-directories - (not (memq 'parent-directories markdown-wiki-link-search-type))) - (push 'parent-directories ret)) - ret)) - -(defun markdown--project-root () - (or (cl-loop for dir in '(".git" ".hg" ".svn") - when (locate-dominating-file default-directory dir) - return it) - (progn - (require 'project) - (let ((project (project-current t))) - (with-no-warnings - (if (fboundp 'project-root) - (project-root project) - (car (project-roots project)))))))) - -(defun markdown-convert-wiki-link-to-filename (name) - "Generate a filename from the wiki link NAME. -Spaces in NAME are replaced with `markdown-link-space-sub-char'. -When in `gfm-mode', follow GitHub's conventions where [[Test Test]] -and [[test test]] both map to Test-test.ext. Look in the current -directory first, then in subdirectories if -`markdown-wiki-link-search-subdirectories' is non-nil, and then -in parent directories if -`markdown-wiki-link-search-parent-directories' is non-nil." - (save-match-data - ;; This function must not overwrite match data(PR #590) - (let* ((basename (replace-regexp-in-string - "[[:space:]\n]" markdown-link-space-sub-char name)) - (basename (if (derived-mode-p 'gfm-mode) - (concat (upcase (substring basename 0 1)) - (downcase (substring basename 1 nil))) - basename)) - (search-types (markdown--wiki-link-search-types)) - directory extension default candidates dir) - (when buffer-file-name - (setq directory (file-name-directory buffer-file-name) - extension (file-name-extension buffer-file-name))) - (setq default (concat basename - (when extension (concat "." extension)))) - (cond - ;; Look in current directory first. - ((or (null buffer-file-name) - (file-exists-p default)) - default) - ;; Possibly search in subdirectories, next. - ((and (memq 'sub-directories search-types) - (setq candidates - (directory-files-recursively - directory (concat "^" default "$")))) - (car candidates)) - ;; Possibly search in parent directories as a last resort. - ((and (memq 'parent-directories search-types) - (setq dir (locate-dominating-file directory default))) - (concat dir default)) - ((and (memq 'project search-types) - (setq candidates - (directory-files-recursively - (markdown--project-root) (concat "^" default "$")))) - (car candidates)) - ;; If nothing is found, return default in current directory. - (t default))))) - -(defun markdown-follow-wiki-link (name &optional other) - "Follow the wiki link NAME. -Convert the name to a file name and call `find-file'. Ensure that -the new buffer remains in `markdown-mode'. Open the link in another -window when OTHER is non-nil." - (let ((filename (markdown-convert-wiki-link-to-filename name)) - (wp (when buffer-file-name - (file-name-directory buffer-file-name)))) - (if (not wp) - (user-error "Must be visiting a file") - (when other (other-window 1)) - (let ((default-directory wp)) - (find-file filename))) - (unless (derived-mode-p 'markdown-mode) - (markdown-mode)))) - -(defun markdown-follow-wiki-link-at-point (&optional arg) - "Find Wiki Link at point. -With prefix argument ARG, open the file in other window. -See `markdown-wiki-link-p' and `markdown-follow-wiki-link'." - (interactive "P") - (if (markdown-wiki-link-p) - (markdown-follow-wiki-link (markdown-wiki-link-link) arg) - (user-error "Point is not at a Wiki Link"))) - -(defun markdown-highlight-wiki-link (from to face) - "Highlight the wiki link in the region between FROM and TO using FACE." - (put-text-property from to 'font-lock-face face)) - -(defun markdown-unfontify-region-wiki-links (from to) - "Remove wiki link faces from the region specified by FROM and TO." - (interactive "*r") - (let ((modified (buffer-modified-p))) - (remove-text-properties from to '(font-lock-face markdown-link-face)) - (remove-text-properties from to '(font-lock-face markdown-missing-link-face)) - ;; remove-text-properties marks the buffer modified in emacs 24.3, - ;; undo that if it wasn't originally marked modified - (set-buffer-modified-p modified))) - -(defun markdown-fontify-region-wiki-links (from to) - "Search region given by FROM and TO for wiki links and fontify them. -If a wiki link is found check to see if the backing file exists -and highlight accordingly." - (goto-char from) - (save-match-data - (while (re-search-forward markdown-regex-wiki-link to t) - (when (not (markdown-code-block-at-point-p)) - (let ((highlight-beginning (match-beginning 1)) - (highlight-end (match-end 1)) - (file-name - (markdown-convert-wiki-link-to-filename - (markdown-wiki-link-link)))) - (if (condition-case nil (file-exists-p file-name) (error nil)) - (markdown-highlight-wiki-link - highlight-beginning highlight-end 'markdown-link-face) - (markdown-highlight-wiki-link - highlight-beginning highlight-end 'markdown-missing-link-face))))))) - -(defun markdown-extend-changed-region (from to) - "Extend region given by FROM and TO so that we can fontify all links. -The region is extended to the first newline before and the first -newline after." - ;; start looking for the first new line before 'from - (goto-char from) - (re-search-backward "\n" nil t) - (let ((new-from (point-min)) - (new-to (point-max))) - (if (not (= (point) from)) - (setq new-from (point))) - ;; do the same thing for the first new line after 'to - (goto-char to) - (re-search-forward "\n" nil t) - (if (not (= (point) to)) - (setq new-to (point))) - (cl-values new-from new-to))) - -(defun markdown-check-change-for-wiki-link (from to) - "Check region between FROM and TO for wiki links and re-fontify as needed." - (interactive "*r") - (let* ((modified (buffer-modified-p)) - (buffer-undo-list t) - (inhibit-read-only t) - deactivate-mark - buffer-file-truename) - (unwind-protect - (save-excursion - (save-match-data - (save-restriction - (cursor-intangible-mode +1) ;; inhibit-point-motion-hooks is obsoleted since Emacs 29 - ;; Extend the region to fontify so that it starts - ;; and ends at safe places. - (cl-multiple-value-bind (new-from new-to) - (markdown-extend-changed-region from to) - (goto-char new-from) - ;; Only refontify when the range contains text with a - ;; wiki link face or if the wiki link regexp matches. - (when (or (markdown-range-property-any - new-from new-to 'font-lock-face - '(markdown-link-face markdown-missing-link-face)) - (re-search-forward - markdown-regex-wiki-link new-to t)) - ;; Unfontify existing fontification (start from scratch) - (markdown-unfontify-region-wiki-links new-from new-to) - ;; Now do the fontification. - (markdown-fontify-region-wiki-links new-from new-to)))))) - (cursor-intangible-mode -1) - (and (not modified) - (buffer-modified-p) - (set-buffer-modified-p nil))))) - -(defun markdown-check-change-for-wiki-link-after-change (from to _) - "Check region between FROM and TO for wiki links and re-fontify as needed. -Designed to be used with the `after-change-functions' hook." - (markdown-check-change-for-wiki-link from to)) - -(defun markdown-fontify-buffer-wiki-links () - "Refontify all wiki links in the buffer." - (interactive) - (markdown-check-change-for-wiki-link (point-min) (point-max))) - -(defun markdown-toggle-wiki-links (&optional arg) - "Toggle support for wiki links. -With a prefix argument ARG, enable wiki link support if ARG is positive, -and disable it otherwise." - (interactive (list (or current-prefix-arg 'toggle))) - (setq markdown-enable-wiki-links - (if (eq arg 'toggle) - (not markdown-enable-wiki-links) - (> (prefix-numeric-value arg) 0))) - (when (called-interactively-p 'interactive) - (message "markdown-mode wiki link support %s" (if markdown-enable-wiki-links "enabled" "disabled"))) - (markdown-reload-extensions)) - -(defun markdown-setup-wiki-link-hooks () - "Add or remove hooks for fontifying wiki links. -These are only enabled when `markdown-wiki-link-fontify-missing' is non-nil." - ;; Anytime text changes make sure it gets fontified correctly - (if (and markdown-enable-wiki-links - markdown-wiki-link-fontify-missing) - (add-hook 'after-change-functions - #'markdown-check-change-for-wiki-link-after-change t t) - (remove-hook 'after-change-functions - #'markdown-check-change-for-wiki-link-after-change t)) - ;; If we left the buffer there is a really good chance we were - ;; creating one of the wiki link documents. Make sure we get - ;; refontified when we come back. - (if (and markdown-enable-wiki-links - markdown-wiki-link-fontify-missing) - (progn - (add-hook 'window-configuration-change-hook - #'markdown-fontify-buffer-wiki-links t t) - (markdown-fontify-buffer-wiki-links)) - (remove-hook 'window-configuration-change-hook - #'markdown-fontify-buffer-wiki-links t) - (markdown-unfontify-region-wiki-links (point-min) (point-max)))) - - -;;; Following & Doing ========================================================= - -(defun markdown-follow-thing-at-point (arg) - "Follow thing at point if possible, such as a reference link or wiki link. -Opens inline and reference links in a browser. Opens wiki links -to other files in the current window, or the another window if -ARG is non-nil. -See `markdown-follow-link-at-point' and -`markdown-follow-wiki-link-at-point'." - (interactive "P") - (cond ((markdown-link-p) - (markdown-follow-link-at-point)) - ((markdown-wiki-link-p) - (markdown-follow-wiki-link-at-point arg)) - (t - (let* ((values (markdown-link-at-pos (point))) - (url (nth 3 values))) - (unless url - (user-error "Nothing to follow at point")) - (markdown--browse-url url))))) - -(defun markdown-do () - "Do something sensible based on context at point. -Jumps between reference links and definitions; between footnote -markers and footnote text." - (interactive) - (cond - ;; Footnote definition - ((markdown-footnote-text-positions) - (markdown-footnote-return)) - ;; Footnote marker - ((markdown-footnote-marker-positions) - (markdown-footnote-goto-text)) - ;; Reference link - ((thing-at-point-looking-at markdown-regex-link-reference) - (markdown-reference-goto-definition)) - ;; Reference definition - ((thing-at-point-looking-at markdown-regex-reference-definition) - (markdown-reference-goto-link (match-string-no-properties 2))) - ;; Link - ((or (markdown-link-p) (markdown-wiki-link-p)) - (markdown-follow-thing-at-point nil)) - ;; GFM task list item - ((markdown-gfm-task-list-item-at-point) - (markdown-toggle-gfm-checkbox)) - ;; Align table - ((markdown-table-at-point-p) - (call-interactively #'markdown-table-align)) - ;; Otherwise - (t - (markdown-insert-gfm-checkbox)))) - - -;;; Miscellaneous ============================================================= - -(defun markdown-compress-whitespace-string (str) - "Compress whitespace in STR and return result. -Leading and trailing whitespace is removed. Sequences of multiple -spaces, tabs, and newlines are replaced with single spaces." - (replace-regexp-in-string "\\(^[ \t\n]+\\|[ \t\n]+$\\)" "" - (replace-regexp-in-string "[ \t\n]+" " " str))) - -(defun markdown--substitute-command-keys (string) - "Like `substitute-command-keys' but, but prefers control characters. -First pass STRING to `substitute-command-keys' and then -substitute `C-i` for `TAB` and `C-m` for `RET`." - (replace-regexp-in-string - "\\<TAB\\>" "C-i" - (replace-regexp-in-string - "\\<RET\\>" "C-m" (substitute-command-keys string) t) t)) - -(defun markdown-line-number-at-pos (&optional pos) - "Return (narrowed) buffer line number at position POS. -If POS is nil, use current buffer location. -This is an exact copy of `line-number-at-pos' for use in emacs21." - (let ((opoint (or pos (point))) start) - (save-excursion - (goto-char (point-min)) - (setq start (point)) - (goto-char opoint) - (forward-line 0) - (1+ (count-lines start (point)))))) - -(defun markdown-inside-link-p () - "Return t if point is within a link." - (save-match-data - (thing-at-point-looking-at (markdown-make-regex-link-generic)))) - -(defun markdown-line-is-reference-definition-p () - "Return whether the current line is a (non-footnote) reference definition." - (save-excursion - (move-beginning-of-line 1) - (and (looking-at-p markdown-regex-reference-definition) - (not (looking-at-p "[ \t]*\\[^"))))) - -(defun markdown-adaptive-fill-function () - "Return prefix for filling paragraph or nil if not determined." - (cond - ;; List item inside blockquote - ((looking-at "^[ \t]*>[ \t]*\\(\\(?:[0-9]+\\|#\\)\\.\\|[*+:-]\\)[ \t]+") - (replace-regexp-in-string - "[0-9\\.*+-]" " " (match-string-no-properties 0))) - ;; Blockquote - ((looking-at markdown-regex-blockquote) - (buffer-substring-no-properties (match-beginning 0) (match-end 2))) - ;; List items - ((looking-at markdown-regex-list) - (match-string-no-properties 0)) - ;; Footnote definition - ((looking-at-p markdown-regex-footnote-definition) - " ") ; four spaces - ;; No match - (t nil))) - -(defun markdown-fill-paragraph (&optional justify) - "Fill paragraph at or after point. -This function is like \\[fill-paragraph], but it skips Markdown -code blocks. If the point is in a code block, or just before one, -do not fill. Otherwise, call `fill-paragraph' as usual. If -JUSTIFY is non-nil, justify text as well. Since this function -handles filling itself, it always returns t so that -`fill-paragraph' doesn't run." - (interactive "P") - (unless (or (markdown-code-block-at-point-p) - (save-excursion - (back-to-indentation) - (skip-syntax-forward "-") - (markdown-code-block-at-point-p))) - (let ((fill-prefix (save-excursion - (goto-char (line-beginning-position)) - (when (looking-at "\\([ \t]*>[ \t]*\\(?:>[ \t]*\\)+\\)") - (match-string-no-properties 1))))) - (fill-paragraph justify))) - t) - -(defun markdown-fill-forward-paragraph (&optional arg) - "Function used by `fill-paragraph' to move over ARG paragraphs. -This is a `fill-forward-paragraph-function' for `markdown-mode'. -It is called with a single argument specifying the number of -paragraphs to move. Just like `forward-paragraph', it should -return the number of paragraphs left to move." - (or arg (setq arg 1)) - (if (> arg 0) - ;; With positive ARG, move across ARG non-code-block paragraphs, - ;; one at a time. When passing a code block, don't decrement ARG. - (while (and (not (eobp)) - (> arg 0) - (= (forward-paragraph 1) 0) - (or (markdown-code-block-at-pos (line-beginning-position 0)) - (setq arg (1- arg))))) - ;; Move backward by one paragraph with negative ARG (always -1). - (let ((start (point))) - (setq arg (forward-paragraph arg)) - (while (and (not (eobp)) - (progn (move-to-left-margin) (not (eobp))) - (looking-at-p paragraph-separate)) - (forward-line 1)) - (cond - ;; Move point past whitespace following list marker. - ((looking-at markdown-regex-list) - (goto-char (match-end 0))) - ;; Move point past whitespace following pipe at beginning of line - ;; to handle Pandoc line blocks. - ((looking-at "^|\\s-*") - (goto-char (match-end 0))) - ;; Return point if the paragraph passed was a code block. - ((markdown-code-block-at-pos (line-beginning-position 2)) - (goto-char start))))) - arg) - -(defun markdown--inhibit-electric-quote () - "Function added to `electric-quote-inhibit-functions'. -Return non-nil if the quote has been inserted inside a code block -or span." - (let ((pos (1- (point)))) - (or (markdown-inline-code-at-pos pos) - (markdown-code-block-at-pos pos)))) - - -;;; Extension Framework ======================================================= - -(defun markdown-reload-extensions () - "Check settings, update font-lock keywords and hooks, and re-fontify buffer." - (interactive) - (when (derived-mode-p 'markdown-mode) - ;; Refontify buffer - (font-lock-flush) - ;; Add or remove hooks related to extensions - (markdown-setup-wiki-link-hooks))) - -(defun markdown-handle-local-variables () - "Run in `hack-local-variables-hook' to update font lock rules. -Checks to see if there is actually a ‘markdown-mode’ file local variable -before regenerating font-lock rules for extensions." - (when (or (assoc 'markdown-enable-wiki-links file-local-variables-alist) - (assoc 'markdown-enable-math file-local-variables-alist)) - (when (assoc 'markdown-enable-math file-local-variables-alist) - (markdown-toggle-math markdown-enable-math)) - (markdown-reload-extensions))) - - -;;; Math Support ============================================================== - -(defconst markdown-mode-font-lock-keywords-math - (list - ;; Equation reference (eq:foo) - '("\\((eq:\\)\\([[:alnum:]:_]+\\)\\()\\)" . ((1 markdown-markup-face) - (2 markdown-reference-face) - (3 markdown-markup-face))) - ;; Equation reference \eqref{foo} - '("\\(\\\\eqref{\\)\\([[:alnum:]:_]+\\)\\(}\\)" . ((1 markdown-markup-face) - (2 markdown-reference-face) - (3 markdown-markup-face)))) - "Font lock keywords to add and remove when toggling math support.") - -(defun markdown-toggle-math (&optional arg) - "Toggle support for inline and display LaTeX math expressions. -With a prefix argument ARG, enable math mode if ARG is positive, -and disable it otherwise. If called from Lisp, enable the mode -if ARG is omitted or nil." - (interactive (list (or current-prefix-arg 'toggle))) - (setq markdown-enable-math - (if (eq arg 'toggle) - (not markdown-enable-math) - (> (prefix-numeric-value arg) 0))) - (if markdown-enable-math - (font-lock-add-keywords - 'markdown-mode markdown-mode-font-lock-keywords-math) - (font-lock-remove-keywords - 'markdown-mode markdown-mode-font-lock-keywords-math)) - (when (called-interactively-p 'interactive) - (message "markdown-mode math support %s" (if markdown-enable-math "enabled" "disabled"))) - (markdown-reload-extensions)) - - -;;; GFM Checkboxes ============================================================ - -(define-button-type 'markdown-gfm-checkbox-button - 'follow-link t - 'face 'markdown-gfm-checkbox-face - 'mouse-face 'markdown-highlight-face - 'action #'markdown-toggle-gfm-checkbox-button) - -(defun markdown-gfm-task-list-item-at-point (&optional bounds) - "Return non-nil if there is a GFM task list item at the point. -Optionally, the list item BOUNDS may be given if available, as -returned by `markdown-cur-list-item-bounds'. When a task list item -is found, the return value is the same value returned by -`markdown-cur-list-item-bounds'." - (unless bounds - (setq bounds (markdown-cur-list-item-bounds))) - (> (length (nth 5 bounds)) 0)) - -(defun markdown-insert-gfm-checkbox () - "Add GFM checkbox at point. -Returns t if added. -Returns nil if non-applicable." - (interactive) - (let ((bounds (markdown-cur-list-item-bounds))) - (if bounds - (unless (cl-sixth bounds) - (let ((pos (+ (cl-first bounds) (cl-fourth bounds))) - (markup "[ ] ")) - (if (< pos (point)) - (save-excursion - (goto-char pos) - (insert markup)) - (goto-char pos) - (insert markup)) - (syntax-propertize (+ (cl-second bounds) 4)) - t)) - (unless (save-excursion - (back-to-indentation) - (or (markdown-list-item-at-point-p) - (markdown-heading-at-point) - (markdown-in-comment-p) - (markdown-code-block-at-point-p))) - (let ((pos (save-excursion - (back-to-indentation) - (point))) - (markup (concat (or (save-excursion - (beginning-of-line 0) - (cl-fifth (markdown-cur-list-item-bounds))) - markdown-unordered-list-item-prefix) - "[ ] "))) - (if (< pos (point)) - (save-excursion - (goto-char pos) - (insert markup)) - (goto-char pos) - (insert markup)) - (syntax-propertize (line-end-position)) - t))))) - -(defun markdown-toggle-gfm-checkbox () - "Toggle GFM checkbox at point. -Returns the resulting status as a string, either \"[x]\" or \"[ ]\". -Returns nil if there is no task list item at the point." - (interactive) - (save-match-data - (save-excursion - (let ((bounds (markdown-cur-list-item-bounds))) - (when bounds - ;; Move to beginning of task list item - (goto-char (cl-first bounds)) - ;; Advance to column of first non-whitespace after marker - (forward-char (cl-fourth bounds)) - (cond ((looking-at "\\[ \\]") - (replace-match - (if markdown-gfm-uppercase-checkbox "[X]" "[x]") - nil t) - (match-string-no-properties 0)) - ((looking-at "\\[[xX]\\]") - (replace-match "[ ]" nil t) - (match-string-no-properties 0)))))))) - -(defun markdown-toggle-gfm-checkbox-button (button) - "Toggle GFM checkbox BUTTON on click." - (save-match-data - (save-excursion - (goto-char (button-start button)) - (markdown-toggle-gfm-checkbox)))) - -(defun markdown-make-gfm-checkboxes-buttons (start end) - "Make GFM checkboxes buttons in region between START and END." - (save-excursion - (goto-char start) - (let ((case-fold-search t)) - (save-excursion - (while (re-search-forward markdown-regex-gfm-checkbox end t) - (make-button (match-beginning 1) (match-end 1) - :type 'markdown-gfm-checkbox-button)))))) - -;; Called when any modification is made to buffer text. -(defun markdown-gfm-checkbox-after-change-function (beg end _) - "Add to `after-change-functions' to setup GFM checkboxes as buttons. -BEG and END are the limits of scanned region." - (save-excursion - (save-match-data - ;; Rescan between start of line from `beg' and start of line after `end'. - (markdown-make-gfm-checkboxes-buttons - (progn (goto-char beg) (beginning-of-line) (point)) - (progn (goto-char end) (forward-line 1) (point)))))) - -(defun markdown-remove-gfm-checkbox-overlays () - "Remove all GFM checkbox overlays in buffer." - (save-excursion - (save-restriction - (widen) - (remove-overlays nil nil 'face 'markdown-gfm-checkbox-face)))) - - -;;; Display inline image ====================================================== - -(defvar-local markdown-inline-image-overlays nil) - -(defun markdown-remove-inline-images () - "Remove inline image overlays from image links in the buffer. -This can be toggled with `markdown-toggle-inline-images' -or \\[markdown-toggle-inline-images]." - (interactive) - (mapc #'delete-overlay markdown-inline-image-overlays) - (setq markdown-inline-image-overlays nil) - (when (fboundp 'clear-image-cache) (clear-image-cache))) - -(defcustom markdown-display-remote-images nil - "If non-nil, download and display remote images. -See also `markdown-inline-image-overlays'. - -Only image URLs specified with a protocol listed in -`markdown-remote-image-protocols' are displayed." - :group 'markdown - :type 'boolean) - -(defcustom markdown-remote-image-protocols '("https") - "List of protocols to use to download remote images. -See also `markdown-display-remote-images'." - :group 'markdown - :type '(repeat string)) - -(defvar markdown--remote-image-cache - (make-hash-table :test 'equal) - "A map from URLs to image paths.") - -(defun markdown--get-remote-image (url) - "Retrieve the image path for a given URL." - (or (gethash url markdown--remote-image-cache) - (let ((dl-path (make-temp-file "markdown-mode--image"))) - (require 'url) - (url-copy-file url dl-path t) - (puthash url dl-path markdown--remote-image-cache)))) - -(defun markdown-display-inline-images () - "Add inline image overlays to image links in the buffer. -This can be toggled with `markdown-toggle-inline-images' -or \\[markdown-toggle-inline-images]." - (interactive) - (unless (display-images-p) - (error "Cannot show images")) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (while (re-search-forward markdown-regex-link-inline nil t) - (let* ((start (match-beginning 0)) - (imagep (match-beginning 1)) - (end (match-end 0)) - (file (match-string-no-properties 6))) - (when (and imagep - (not (zerop (length file)))) - (unless (file-exists-p file) - (let* ((download-file (funcall markdown-translate-filename-function file)) - (valid-url (ignore-errors - (member (downcase (url-type (url-generic-parse-url download-file))) - markdown-remote-image-protocols)))) - (if (and markdown-display-remote-images valid-url) - (setq file (markdown--get-remote-image download-file)) - (when (not valid-url) - ;; strip query parameter - (setq file (replace-regexp-in-string "?.+\\'" "" file)) - (unless (file-exists-p file) - (setq file (url-unhex-string file))))))) - (when (file-exists-p file) - (let* ((abspath (if (file-name-absolute-p file) - file - (concat default-directory file))) - (image - (cond ((and markdown-max-image-size - (image-type-available-p 'imagemagick)) - (create-image - abspath 'imagemagick nil - :max-width (car markdown-max-image-size) - :max-height (cdr markdown-max-image-size))) - (markdown-max-image-size - (create-image abspath nil nil - :max-width (car markdown-max-image-size) - :max-height (cdr markdown-max-image-size))) - (t (create-image abspath))))) - (when image - (let ((ov (make-overlay start end))) - (overlay-put ov 'display image) - (overlay-put ov 'face 'default) - (push ov markdown-inline-image-overlays))))))))))) - -(defun markdown-toggle-inline-images () - "Toggle inline image overlays in the buffer." - (interactive) - (if markdown-inline-image-overlays - (markdown-remove-inline-images) - (markdown-display-inline-images))) - - -;;; GFM Code Block Fontification ============================================== - -(defcustom markdown-fontify-code-blocks-natively nil - "When non-nil, fontify code in code blocks using the native major mode. -This only works for fenced code blocks where the language is -specified where we can automatically determine the appropriate -mode to use. The language to mode mapping may be customized by -setting the variable `markdown-code-lang-modes'." - :group 'markdown - :type 'boolean - :safe #'booleanp - :package-version '(markdown-mode . "2.3")) - -(defcustom markdown-fontify-code-block-default-mode nil - "Default mode to use to fontify code blocks. -This mode is used when automatic detection fails, such as for GFM -code blocks with no language specified." - :group 'markdown - :type '(choice function (const :tag "None" nil)) - :package-version '(markdown-mode . "2.4")) - -(defun markdown-toggle-fontify-code-blocks-natively (&optional arg) - "Toggle the native fontification of code blocks. -With a prefix argument ARG, enable if ARG is positive, -and disable otherwise." - (interactive (list (or current-prefix-arg 'toggle))) - (setq markdown-fontify-code-blocks-natively - (if (eq arg 'toggle) - (not markdown-fontify-code-blocks-natively) - (> (prefix-numeric-value arg) 0))) - (when (called-interactively-p 'interactive) - (message "markdown-mode native code block fontification %s" - (if markdown-fontify-code-blocks-natively "enabled" "disabled"))) - (markdown-reload-extensions)) - -;; This is based on `org-src-lang-modes' from org-src.el -(defcustom markdown-code-lang-modes - '(("ocaml" . tuareg-mode) ("elisp" . emacs-lisp-mode) ("ditaa" . artist-mode) - ("asymptote" . asy-mode) ("dot" . fundamental-mode) ("sqlite" . sql-mode) - ("calc" . fundamental-mode) ("C" . c-mode) ("cpp" . c++-mode) - ("C++" . c++-mode) ("screen" . shell-script-mode) ("shell" . sh-mode) - ("bash" . sh-mode)) - "Alist mapping languages to their major mode. -The key is the language name, the value is the major mode. For -many languages this is simple, but for language where this is not -the case, this variable provides a way to simplify things on the -user side. For example, there is no ocaml-mode in Emacs, but the -mode to use is `tuareg-mode'." - :group 'markdown - :type '(repeat - (cons - (string "Language name") - (symbol "Major mode"))) - :package-version '(markdown-mode . "2.3")) - -(defun markdown-get-lang-mode (lang) - "Return major mode that should be used for LANG. -LANG is a string, and the returned major mode is a symbol." - (cl-find-if - #'markdown--lang-mode-predicate - (nconc (list (cdr (assoc lang markdown-code-lang-modes)) - (cdr (assoc (downcase lang) markdown-code-lang-modes))) - (and (fboundp 'treesit-language-available-p) - (list (and (treesit-language-available-p (intern lang)) - (intern (concat lang "-ts-mode"))) - (and (treesit-language-available-p (intern (downcase lang))) - (intern (concat (downcase lang) "-ts-mode"))))) - (list - (intern (concat lang "-mode")) - (intern (concat (downcase lang) "-mode")))))) - -(defun markdown--lang-mode-predicate (mode) - (and mode - (fboundp mode) - (or - ;; https://github.com/jrblevin/markdown-mode/issues/787 - ;; major-mode-remap-alist was introduced at Emacs 29.1 - (cl-loop for pair in (bound-and-true-p major-mode-remap-alist) - for func = (cdr pair) - thereis (and (atom func) (eq mode func))) - ;; https://github.com/jrblevin/markdown-mode/issues/761 - (cl-loop for pair in auto-mode-alist - for func = (cdr pair) - thereis (and (atom func) (eq mode func)))))) - -(defun markdown-fontify-code-blocks-generic (matcher last) - "Add text properties to next code block from point to LAST. -Use matching function MATCHER." - (when (funcall matcher last) - (save-excursion - (save-match-data - (let* ((start (match-beginning 0)) - (end (match-end 0)) - ;; Find positions outside opening and closing backquotes. - (bol-prev (progn (goto-char start) - (if (bolp) (line-beginning-position 0) (line-beginning-position)))) - (eol-next (progn (goto-char end) - (if (bolp) (line-beginning-position 2) (line-beginning-position 3)))) - lang) - (if (and markdown-fontify-code-blocks-natively - (or (setq lang (markdown-code-block-lang)) - markdown-fontify-code-block-default-mode)) - (markdown-fontify-code-block-natively lang start end) - (add-text-properties start end '(face markdown-pre-face))) - ;; Set background for block as well as opening and closing lines. - (font-lock-append-text-property - bol-prev eol-next 'face 'markdown-code-face) - ;; Set invisible property for lines before and after, including newline. - (add-text-properties bol-prev start '(invisible markdown-markup)) - (add-text-properties end eol-next '(invisible markdown-markup))))) - t)) - -(defun markdown-fontify-gfm-code-blocks (last) - "Add text properties to next GFM code block from point to LAST." - (markdown-fontify-code-blocks-generic 'markdown-match-gfm-code-blocks last)) - -(defun markdown-fontify-fenced-code-blocks (last) - "Add text properties to next tilde fenced code block from point to LAST." - (markdown-fontify-code-blocks-generic 'markdown-match-fenced-code-blocks last)) - -;; Based on `org-src-font-lock-fontify-block' from org-src.el. -(defun markdown-fontify-code-block-natively (lang start end) - "Fontify given GFM or fenced code block. -This function is called by Emacs for automatic fontification when -`markdown-fontify-code-blocks-natively' is non-nil. LANG is the -language used in the block. START and END specify the block -position." - (let ((lang-mode (if lang (markdown-get-lang-mode lang) - markdown-fontify-code-block-default-mode))) - (when (fboundp lang-mode) - (let ((string (buffer-substring-no-properties start end)) - (modified (buffer-modified-p)) - (markdown-buffer (current-buffer)) pos next) - (remove-text-properties start end '(face nil)) - (with-current-buffer - (get-buffer-create - (concat " markdown-code-fontification:" (symbol-name lang-mode))) - ;; Make sure that modification hooks are not inhibited in - ;; the org-src-fontification buffer in case we're called - ;; from `jit-lock-function' (Bug#25132). - (let ((inhibit-modification-hooks nil)) - (delete-region (point-min) (point-max)) - (insert string " ")) ;; so there's a final property change - (unless (eq major-mode lang-mode) (funcall lang-mode)) - (font-lock-ensure) - (setq pos (point-min)) - (while (setq next (next-single-property-change pos 'face)) - (let ((val (get-text-property pos 'face))) - (when val - (put-text-property - (+ start (1- pos)) (1- (+ start next)) 'face - val markdown-buffer))) - (setq pos next))) - (add-text-properties - start end - '(font-lock-fontified t fontified t font-lock-multiline t)) - (set-buffer-modified-p modified))))) - -(require 'edit-indirect nil t) -(defvar edit-indirect-guess-mode-function) -(defvar edit-indirect-after-commit-functions) - -(defun markdown--edit-indirect-after-commit-function (beg end) - "Corrective logic run on code block content from lines BEG to END. -Restores code block indentation from BEG to END, and ensures trailing newlines -at the END of code blocks." - ;; ensure trailing newlines - (goto-char end) - (unless (eq (char-before) ?\n) - (insert "\n")) - ;; restore code block indentation - (goto-char (- beg 1)) - (let ((block-indentation (current-indentation))) - (when (> block-indentation 0) - (indent-rigidly beg end block-indentation))) - (font-lock-ensure)) - -(defun markdown-edit-code-block () - "Edit Markdown code block in an indirect buffer." - (interactive) - (save-excursion - (if (fboundp 'edit-indirect-region) - (let* ((bounds (markdown-get-enclosing-fenced-block-construct)) - (begin (and bounds (not (null (nth 0 bounds))) (goto-char (nth 0 bounds)) (line-beginning-position 2))) - (end (and bounds(not (null (nth 1 bounds))) (goto-char (nth 1 bounds)) (line-beginning-position 1)))) - (if (and begin end) - (let* ((indentation (and (goto-char (nth 0 bounds)) (current-indentation))) - (lang (markdown-code-block-lang)) - (mode (or (and lang (markdown-get-lang-mode lang)) - markdown-edit-code-block-default-mode)) - (edit-indirect-guess-mode-function - (lambda (_parent-buffer _beg _end) - (funcall mode))) - (indirect-buf (edit-indirect-region begin end 'display-buffer))) - ;; reset `sh-shell' when indirect buffer - (when (and (not (member system-type '(ms-dos windows-nt))) - (member mode '(shell-script-mode sh-mode)) - (member lang (append - (mapcar (lambda (e) (symbol-name (car e))) - sh-ancestor-alist) - '("csh" "rc" "sh")))) - (with-current-buffer indirect-buf - (sh-set-shell lang))) - (when (> indentation 0) ;; un-indent in edit-indirect buffer - (with-current-buffer indirect-buf - (indent-rigidly (point-min) (point-max) (- indentation))))) - (user-error "Not inside a GFM or tilde fenced code block"))) - (when (y-or-n-p "Package edit-indirect needed to edit code blocks. Install it now? ") - (progn (package-refresh-contents) - (package-install 'edit-indirect) - (markdown-edit-code-block)))))) - - -;;; Table Editing ============================================================= - -;; These functions were originally adapted from `org-table.el'. - -;; General helper functions - -(defmacro markdown--with-gensyms (symbols &rest body) - (declare (debug (sexp body)) (indent 1)) - `(let ,(mapcar (lambda (s) - `(,s (make-symbol (concat "--" (symbol-name ',s))))) - symbols) - ,@body)) - -(defun markdown--split-string (string &optional separators) - "Splits STRING into substrings at SEPARATORS. -SEPARATORS is a regular expression. If nil it defaults to -`split-string-default-separators'. This version returns no empty -strings if there are matches at the beginning and end of string." - (let ((start 0) notfirst list) - (while (and (string-match - (or separators split-string-default-separators) - string - (if (and notfirst - (= start (match-beginning 0)) - (< start (length string))) - (1+ start) start)) - (< (match-beginning 0) (length string))) - (setq notfirst t) - (or (eq (match-beginning 0) 0) - (and (eq (match-beginning 0) (match-end 0)) - (eq (match-beginning 0) start)) - (push (substring string start (match-beginning 0)) list)) - (setq start (match-end 0))) - (or (eq start (length string)) - (push (substring string start) list)) - (nreverse list))) - -(defun markdown--string-width (s) - "Return width of string S. -This version ignores characters with invisibility property -`markdown-markup'." - (let (b) - (when (or (eq t buffer-invisibility-spec) - (member 'markdown-markup buffer-invisibility-spec)) - (while (setq b (text-property-any - 0 (length s) - 'invisible 'markdown-markup s)) - (setq s (concat - (substring s 0 b) - (substring s (or (next-single-property-change - b 'invisible s) - (length s)))))))) - (string-width s)) - -(defun markdown--remove-invisible-markup (s) - "Remove Markdown markup from string S. -This version removes characters with invisibility property -`markdown-markup'." - (let (b) - (while (setq b (text-property-any - 0 (length s) - 'invisible 'markdown-markup s)) - (setq s (concat - (substring s 0 b) - (substring s (or (next-single-property-change - b 'invisible s) - (length s))))))) - s) - -;; Functions for maintaining tables - -(defvar markdown-table-at-point-p-function #'markdown--table-at-point-p - "Function to decide if point is inside a table. - -The indirection serves to differentiate between standard markdown -tables and gfm tables which are less strict about the markup.") - -(defconst markdown-table-line-regexp "^[ \t]*|" - "Regexp matching any line inside a table.") - -(defconst markdown-table-hline-regexp "^[ \t]*|[-:]" - "Regexp matching hline inside a table.") - -(defconst markdown-table-dline-regexp "^[ \t]*|[^-:]" - "Regexp matching dline inside a table.") - -(defun markdown-table-at-point-p () - "Return non-nil when point is inside a table." - (funcall markdown-table-at-point-p-function)) - -(defun markdown--table-at-point-p () - "Return non-nil when point is inside a table." - (save-excursion - (beginning-of-line) - (and (looking-at-p markdown-table-line-regexp) - (not (markdown-code-block-at-point-p))))) - -(defconst gfm-table-line-regexp "^.?*|" - "Regexp matching any line inside a table.") - -(defconst gfm-table-hline-regexp "^-+\\(|-\\)+" - "Regexp matching hline inside a table.") - -;; GFM simplified tables syntax is as follows: -;; - A header line for the column names, this is any text -;; separated by `|'. -;; - Followed by a string -|-|- ..., the number of dashes is optional -;; but must be higher than 1. The number of separators should match -;; the number of columns. -;; - Followed by the rows of data, which has the same format as the -;; header line. -;; Example: -;; -;; foo | bar -;; ------|--------- -;; bar | baz -;; bar | baz -(defun gfm--table-at-point-p () - "Return non-nil when point is inside a gfm-compatible table." - (or (markdown--table-at-point-p) - (save-excursion - (beginning-of-line) - (when (looking-at-p gfm-table-line-regexp) - ;; we might be at the first line of the table, check if the - ;; line below is the hline - (or (save-excursion - (forward-line 1) - (looking-at-p gfm-table-hline-regexp)) - ;; go up to find the header - (catch 'done - (while (looking-at-p gfm-table-line-regexp) - (cond - ((looking-at-p gfm-table-hline-regexp) - (throw 'done t)) - ((bobp) - (throw 'done nil))) - (forward-line -1)) - nil)))))) - -(defun markdown-table-hline-at-point-p () - "Return non-nil when point is on a hline in a table. -This function assumes point is on a table." - (save-excursion - (beginning-of-line) - (looking-at-p markdown-table-hline-regexp))) - -(defun markdown-table-begin () - "Find the beginning of the table and return its position. -This function assumes point is on a table." - (save-excursion - (while (and (not (bobp)) - (markdown-table-at-point-p)) - (forward-line -1)) - (unless (or (eobp) - (markdown-table-at-point-p)) - (forward-line 1)) - (point))) - -(defun markdown-table-end () - "Find the end of the table and return its position. -This function assumes point is on a table." - (save-excursion - (while (and (not (eobp)) - (markdown-table-at-point-p)) - (forward-line 1)) - (point))) - -(defun markdown-table-get-dline () - "Return index of the table data line at point. -This function assumes point is on a table." - (let ((pos (point)) (end (markdown-table-end)) (cnt 0)) - (save-excursion - (goto-char (markdown-table-begin)) - (while (and (re-search-forward - markdown-table-dline-regexp end t) - (setq cnt (1+ cnt)) - (< (line-end-position) pos)))) - cnt)) - -(defun markdown--thing-at-wiki-link (pos) - (when markdown-enable-wiki-links - (save-excursion - (save-match-data - (goto-char pos) - (thing-at-point-looking-at markdown-regex-wiki-link))))) - -(defun markdown-table-get-column () - "Return table column at point. -This function assumes point is on a table." - (let ((pos (point)) (cnt 0)) - (save-excursion - (beginning-of-line) - (while (search-forward "|" pos t) - (when (and (not (looking-back "\\\\|" (line-beginning-position))) - (not (markdown--thing-at-wiki-link (match-beginning 0)))) - (setq cnt (1+ cnt))))) - cnt)) - -(defun markdown-table-get-cell (&optional n) - "Return the content of the cell in column N of current row. -N defaults to column at point. This function assumes point is on -a table." - (and n (markdown-table-goto-column n)) - (skip-chars-backward "^|\n") (backward-char 1) - (if (looking-at "|[^|\r\n]*") - (let* ((pos (match-beginning 0)) - (val (buffer-substring (1+ pos) (match-end 0)))) - (goto-char (min (line-end-position) (+ 2 pos))) - ;; Trim whitespaces - (setq val (replace-regexp-in-string "\\`[ \t]+" "" val) - val (replace-regexp-in-string "[ \t]+\\'" "" val))) - (forward-char 1) "")) - -(defun markdown-table-goto-dline (n) - "Go to the Nth data line in the table at point. -Return t when the line exists, nil otherwise. This function -assumes point is on a table." - (goto-char (markdown-table-begin)) - (let ((end (markdown-table-end)) (cnt 0)) - (while (and (re-search-forward - markdown-table-dline-regexp end t) - (< (setq cnt (1+ cnt)) n))) - (= cnt n))) - -(defun markdown-table-goto-column (n &optional on-delim) - "Go to the Nth column in the table line at point. -With optional argument ON-DELIM, stop with point before the left -delimiter of the cell. If there are less than N cells, just go -beyond the last delimiter. This function assumes point is on a -table." - (beginning-of-line 1) - (when (> n 0) - (while (and (> n 0) (search-forward "|" (line-end-position) t)) - (when (and (not (looking-back "\\\\|" (line-beginning-position))) - (not (markdown--thing-at-wiki-link (match-beginning 0)))) - (cl-decf n))) - (if on-delim - (backward-char 1) - (when (looking-at " ") (forward-char 1))))) - -(defmacro markdown-table-save-cell (&rest body) - "Save cell at point, execute BODY and restore cell. -This function assumes point is on a table." - (declare (debug (body))) - (markdown--with-gensyms (line column) - `(let ((,line (copy-marker (line-beginning-position))) - (,column (markdown-table-get-column))) - (unwind-protect - (progn ,@body) - (goto-char ,line) - (markdown-table-goto-column ,column) - (set-marker ,line nil))))) - -(defun markdown-table-blank-line (s) - "Convert a table line S into a line with blank cells." - (if (string-match "^[ \t]*|-" s) - (setq s (mapconcat - (lambda (x) (if (member x '(?| ?+)) "|" " ")) - s "")) - (with-temp-buffer - (insert s) - (goto-char (point-min)) - (when (re-search-forward "|" nil t) - (let ((cur (point)) - ret) - (while (re-search-forward "|" nil t) - (when (and (not (eql (char-before (match-beginning 0)) ?\\)) - (not (markdown--thing-at-wiki-link (match-beginning 0)))) - (push (make-string (- (match-beginning 0) cur) ? ) ret) - (setq cur (match-end 0)))) - (format "|%s|" (string-join (nreverse ret) "|"))))))) - -(defun markdown-table-colfmt (fmtspec) - "Process column alignment specifier FMTSPEC for tables." - (when (stringp fmtspec) - (mapcar (lambda (x) - (cond ((string-match-p "^:.*:$" x) 'c) - ((string-match-p "^:" x) 'l) - ((string-match-p ":$" x) 'r) - (t 'd))) - (markdown--split-string fmtspec "\\s-*|\\s-*")))) - -(defun markdown--first-column-p (bar-pos) - (save-excursion - (save-match-data - (goto-char bar-pos) - (looking-back "^\\s-*" (line-beginning-position))))) - -(defun markdown--table-line-to-columns (line) - (with-temp-buffer - (insert line) - (goto-char (point-min)) - (let ((cur (point)) - ret) - (while (and (re-search-forward "\\s-*\\(|\\)\\s-*" nil t)) - (when (not (markdown--face-p (match-beginning 1) '(markdown-inline-code-face))) - (if (markdown--first-column-p (match-beginning 1)) - (setq cur (match-end 0)) - (cond ((eql (char-before (match-beginning 1)) ?\\) - ;; keep spaces - (goto-char (match-end 1))) - ((markdown--thing-at-wiki-link (match-beginning 1))) ;; do nothing - (t - (push (buffer-substring-no-properties cur (match-beginning 0)) ret) - (setq cur (match-end 0))))))) - (when (< cur (length line)) - (push (buffer-substring-no-properties cur (point-max)) ret)) - (nreverse ret)))) - -(defsubst markdown--is-delimiter-row (line) - (and (string-match-p "\\`[ \t]*|[ \t]*[-:]" line) - (cl-loop for c across line - always (member c '(?| ?- ?: ?\t ? ))))) - -(defun markdown-table-align () - "Align table at point. -This function assumes point is on a table." - (interactive) - (let ((begin (markdown-table-begin)) - (end (copy-marker (markdown-table-end)))) - (markdown-table-save-cell - (goto-char begin) - (let* (fmtspec - ;; Store table indent - (indent (progn (looking-at "[ \t]*") (match-string 0))) - ;; Split table in lines and save column format specifier - (lines (mapcar (lambda (line) - (if (markdown--is-delimiter-row line) - (progn (setq fmtspec (or fmtspec line)) nil) - line)) - (markdown--split-string (buffer-substring begin end) "\n"))) - ;; Split lines in cells - (cells (mapcar (lambda (l) (markdown--table-line-to-columns l)) - (remq nil lines))) - ;; Calculate maximum number of cells in a line - (maxcells (if cells - (apply #'max (mapcar #'length cells)) - (user-error "Empty table"))) - ;; Empty cells to fill short lines - (emptycells (make-list maxcells "")) - maxwidths) - ;; Calculate maximum width for each column - (dotimes (i maxcells) - (let ((column (mapcar (lambda (x) (or (nth i x) "")) cells))) - (push (apply #'max 1 (mapcar #'markdown--string-width column)) - maxwidths))) - (setq maxwidths (nreverse maxwidths)) - ;; Process column format specifier - (setq fmtspec (markdown-table-colfmt fmtspec)) - ;; Compute formats needed for output of table lines - (let ((hfmt (concat indent "|")) - (rfmt (concat indent "|")) - hfmt1 rfmt1 fmt) - (dolist (width maxwidths (setq hfmt (concat (substring hfmt 0 -1) "|"))) - (setq fmt (pop fmtspec)) - (cond ((equal fmt 'l) (setq hfmt1 ":%s-|" rfmt1 " %%-%ds |")) - ((equal fmt 'r) (setq hfmt1 "-%s:|" rfmt1 " %%%ds |")) - ((equal fmt 'c) (setq hfmt1 ":%s:|" rfmt1 " %%-%ds |")) - (t (setq hfmt1 "-%s-|" rfmt1 " %%-%ds |"))) - (setq rfmt (concat rfmt (format rfmt1 width))) - (setq hfmt (concat hfmt (format hfmt1 (make-string width ?-))))) - ;; Replace modified lines only - (dolist (line lines) - (let ((line (if line - (apply #'format rfmt (append (pop cells) emptycells)) - hfmt)) - (previous (buffer-substring (point) (line-end-position)))) - (if (equal previous line) - (forward-line) - (insert line "\n") - (delete-region (point) (line-beginning-position 2)))))) - (set-marker end nil))))) - -(defun markdown-table-insert-row (&optional arg) - "Insert a new row above the row at point into the table. -With optional argument ARG, insert below the current row." - (interactive "P") - (unless (markdown-table-at-point-p) - (user-error "Not at a table")) - (let* ((line (buffer-substring - (line-beginning-position) (line-end-position))) - (new (markdown-table-blank-line line))) - (beginning-of-line (if arg 2 1)) - (unless (bolp) (insert "\n")) - (insert-before-markers new "\n") - (beginning-of-line 0) - (re-search-forward "| ?" (line-end-position) t))) - -(defun markdown-table-delete-row () - "Delete row or horizontal line at point from the table." - (interactive) - (unless (markdown-table-at-point-p) - (user-error "Not at a table")) - (let ((col (current-column))) - (kill-region (line-beginning-position) - (min (1+ (line-end-position)) (point-max))) - (unless (markdown-table-at-point-p) (beginning-of-line 0)) - (move-to-column col))) - -(defun markdown-table-move-row (&optional up) - "Move table line at point down. -With optional argument UP, move it up." - (interactive "P") - (unless (markdown-table-at-point-p) - (user-error "Not at a table")) - (let* ((col (current-column)) (pos (point)) - (tonew (if up 0 2)) txt) - (beginning-of-line tonew) - (unless (markdown-table-at-point-p) - (goto-char pos) (user-error "Cannot move row further")) - (goto-char pos) (beginning-of-line 1) (setq pos (point)) - (setq txt (buffer-substring (point) (1+ (line-end-position)))) - (delete-region (point) (1+ (line-end-position))) - (beginning-of-line tonew) - (insert txt) (beginning-of-line 0) - (move-to-column col))) - -(defun markdown-table-move-row-up () - "Move table row at point up." - (interactive) - (markdown-table-move-row 'up)) - -(defun markdown-table-move-row-down () - "Move table row at point down." - (interactive) - (markdown-table-move-row nil)) - -(defun markdown-table-insert-column () - "Insert a new table column." - (interactive) - (unless (markdown-table-at-point-p) - (user-error "Not at a table")) - (let* ((col (max 1 (markdown-table-get-column))) - (begin (markdown-table-begin)) - (end (copy-marker (markdown-table-end)))) - (markdown-table-save-cell - (goto-char begin) - (while (< (point) end) - (markdown-table-goto-column col t) - (if (markdown-table-hline-at-point-p) - (insert "|---") - (insert "| ")) - (forward-line))) - (set-marker end nil) - (when markdown-table-align-p - (markdown-table-align)))) - -(defun markdown-table-delete-column () - "Delete column at point from table." - (interactive) - (unless (markdown-table-at-point-p) - (user-error "Not at a table")) - (let ((col (markdown-table-get-column)) - (begin (markdown-table-begin)) - (end (copy-marker (markdown-table-end)))) - (markdown-table-save-cell - (goto-char begin) - (while (< (point) end) - (markdown-table-goto-column col t) - (and (looking-at "|\\(?:\\\\|\\|[^|\n]\\)+|") - (replace-match "|")) - (forward-line))) - (set-marker end nil) - (markdown-table-goto-column (max 1 (1- col))) - (when markdown-table-align-p - (markdown-table-align)))) - -(defun markdown-table-move-column (&optional left) - "Move table column at point to the right. -With optional argument LEFT, move it to the left." - (interactive "P") - (unless (markdown-table-at-point-p) - (user-error "Not at a table")) - (let* ((col (markdown-table-get-column)) - (col1 (if left (1- col) col)) - (colpos (if left (1- col) (1+ col))) - (begin (markdown-table-begin)) - (end (copy-marker (markdown-table-end)))) - (when (and left (= col 1)) - (user-error "Cannot move column further left")) - (when (and (not left) (looking-at "[^|\n]*|[^|\n]*$")) - (user-error "Cannot move column further right")) - (markdown-table-save-cell - (goto-char begin) - (while (< (point) end) - (markdown-table-goto-column col1 t) - (when (looking-at "|\\(\\(?:\\\\|\\|[^|\n]\\|\\)+\\)|\\(\\(?:\\\\|\\|[^|\n]\\|\\)+\\)|") - (replace-match "|\\2|\\1|")) - (forward-line))) - (set-marker end nil) - (markdown-table-goto-column colpos) - (when markdown-table-align-p - (markdown-table-align)))) - -(defun markdown-table-move-column-left () - "Move table column at point to the left." - (interactive) - (markdown-table-move-column 'left)) - -(defun markdown-table-move-column-right () - "Move table column at point to the right." - (interactive) - (markdown-table-move-column nil)) - -(defun markdown-table-next-row () - "Go to the next row (same column) in the table. -Create new table lines if required." - (interactive) - (unless (markdown-table-at-point-p) - (user-error "Not at a table")) - (if (or (looking-at "[ \t]*$") - (save-excursion (skip-chars-backward " \t") (bolp))) - (newline) - (when markdown-table-align-p - (markdown-table-align)) - (let ((col (markdown-table-get-column))) - (beginning-of-line 2) - (if (or (not (markdown-table-at-point-p)) - (markdown-table-hline-at-point-p)) - (progn - (beginning-of-line 0) - (markdown-table-insert-row 'below))) - (markdown-table-goto-column col) - (skip-chars-backward "^|\n\r") - (when (looking-at " ") (forward-char 1))))) - -(defun markdown-table-forward-cell () - "Go to the next cell in the table. -Create new table lines if required." - (interactive) - (unless (markdown-table-at-point-p) - (user-error "Not at a table")) - (when markdown-table-align-p - (markdown-table-align)) - (let ((end (markdown-table-end))) - (when (markdown-table-hline-at-point-p) (end-of-line 1)) - (condition-case nil - (progn - (re-search-forward "\\(?:^\\|[^\\]\\)|" end) - (when (looking-at "[ \t]*$") - (re-search-forward "\\(?:^\\|[^\\]:\\)|" end)) - (when (and (looking-at "[-:]") - (re-search-forward "^\\(?:[ \t]*\\|[^\\]\\)|\\([^-:]\\)" end t)) - (goto-char (match-beginning 1))) - (if (looking-at "[-:]") - (progn - (beginning-of-line 0) - (markdown-table-insert-row 'below)) - (when (looking-at " ") (forward-char 1)))) - (error (markdown-table-insert-row 'below))))) - -(defun markdown-table-backward-cell () - "Go to the previous cell in the table." - (interactive) - (unless (markdown-table-at-point-p) - (user-error "Not at a table")) - (when markdown-table-align-p - (markdown-table-align)) - (when (markdown-table-hline-at-point-p) (beginning-of-line 1)) - (condition-case nil - (progn - (re-search-backward "\\(?:^\\|[^\\]\\)|" (markdown-table-begin)) - ;; When this function is called while in the first cell in a - ;; table, the point will now be at the beginning of a line. In - ;; this case, we need to move past one additional table - ;; boundary, the end of the table on the previous line. - (when (= (point) (line-beginning-position)) - (re-search-backward "\\(?:^\\|[^\\]\\)|" (markdown-table-begin))) - (re-search-backward "\\(?:^\\|[^\\]\\)|" (markdown-table-begin))) - (error (user-error "Cannot move to previous table cell"))) - (when (looking-at "\\(?:^\\|[^\\]\\)| ?") (goto-char (match-end 0))) - - ;; This may have dropped point on the hline. - (when (markdown-table-hline-at-point-p) - (markdown-table-backward-cell))) - -(defun markdown-table-transpose () - "Transpose table at point. -Horizontal separator lines will be eliminated." - (interactive) - (unless (markdown-table-at-point-p) - (user-error "Not at a table")) - (let* ((table (buffer-substring-no-properties - (markdown-table-begin) (markdown-table-end))) - ;; Convert table to Lisp structure - (table (delq nil - (mapcar - (lambda (x) - (unless (string-match-p - markdown-table-hline-regexp x) - (markdown--table-line-to-columns x))) - (markdown--split-string table "[ \t]*\n[ \t]*")))) - (dline_old (markdown-table-get-dline)) - (col_old (markdown-table-get-column)) - (contents (mapcar (lambda (_) - (let ((tp table)) - (mapcar - (lambda (_) - (prog1 - (pop (car tp)) - (setq tp (cdr tp)))) - table))) - (car table)))) - (goto-char (markdown-table-begin)) - (save-excursion - (re-search-forward "|") (backward-char) - (delete-region (point) (markdown-table-end)) - (insert (mapconcat - (lambda(x) - (concat "| " (mapconcat 'identity x " | " ) " |\n")) - contents ""))) - (markdown-table-goto-dline col_old) - (markdown-table-goto-column dline_old)) - (when markdown-table-align-p - (markdown-table-align))) - -(defun markdown-table-sort-lines (&optional sorting-type) - "Sort table lines according to the column at point. - -The position of point indicates the column to be used for -sorting, and the range of lines is the range between the nearest -horizontal separator lines, or the entire table of no such lines -exist. If point is before the first column, user will be prompted -for the sorting column. If there is an active region, the mark -specifies the first line and the sorting column, while point -should be in the last line to be included into the sorting. - -The command then prompts for the sorting type which can be -alphabetically or numerically. Sorting in reverse order is also -possible. - -If SORTING-TYPE is specified when this function is called from a -Lisp program, no prompting will take place. SORTING-TYPE must be -a character, any of (?a ?A ?n ?N) where the capital letters -indicate that sorting should be done in reverse order." - (interactive) - (unless (markdown-table-at-point-p) - (user-error "Not at a table")) - ;; Set sorting type and column used for sorting - (let ((column (let ((c (markdown-table-get-column))) - (cond ((> c 0) c) - ((called-interactively-p 'any) - (read-number "Use column N for sorting: ")) - (t 1)))) - (sorting-type - (or sorting-type - (progn - ;; workaround #641 - ;; Emacs < 28 hides prompt message by another message. This erases it. - (message "") - (read-char-exclusive - "Sort type: [a]lpha [n]umeric (A/N means reversed): "))))) - (save-restriction - ;; Narrow buffer to appropriate sorting area - (if (region-active-p) - (narrow-to-region - (save-excursion - (progn - (goto-char (region-beginning)) (line-beginning-position))) - (save-excursion - (progn - (goto-char (region-end)) (line-end-position)))) - (let ((start (markdown-table-begin)) - (end (markdown-table-end))) - (narrow-to-region - (save-excursion - (if (re-search-backward - markdown-table-hline-regexp start t) - (line-beginning-position 2) - start)) - (if (save-excursion (re-search-forward - markdown-table-hline-regexp end t)) - (match-beginning 0) - end)))) - ;; Determine arguments for `sort-subr' - (let* ((extract-key-from-cell - (cl-case sorting-type - ((?a ?A) #'markdown--remove-invisible-markup) ;; #'identity) - ((?n ?N) #'string-to-number) - (t (user-error "Invalid sorting type: %c" sorting-type)))) - (predicate - (cl-case sorting-type - ((?n ?N) #'<) - ((?a ?A) #'string<)))) - ;; Sort selected area - (goto-char (point-min)) - (sort-subr (memq sorting-type '(?A ?N)) - (lambda () - (forward-line) - (while (and (not (eobp)) - (not (looking-at - markdown-table-dline-regexp))) - (forward-line))) - #'end-of-line - (lambda () - (funcall extract-key-from-cell - (markdown-table-get-cell column))) - nil - predicate) - (goto-char (point-min)))))) - -(defun markdown-table-convert-region (begin end &optional separator) - "Convert region from BEGIN to END to table with SEPARATOR. - -If every line contains at least one TAB character, the function -assumes that the material is tab separated (TSV). If every line -contains a comma, comma-separated values (CSV) are assumed. If -not, lines are split at whitespace into cells. - -You can use a prefix argument to force a specific separator: -\\[universal-argument] once forces CSV, \\[universal-argument] -twice forces TAB, and \\[universal-argument] three times will -prompt for a regular expression to match the separator, and a -numeric argument N indicates that at least N consecutive -spaces, or alternatively a TAB should be used as the separator." - - (interactive "r\nP") - (let* ((begin (min begin end)) (end (max begin end)) re) - (goto-char begin) (beginning-of-line 1) - (setq begin (point-marker)) - (goto-char end) - (if (bolp) (backward-char 1) (end-of-line 1)) - (setq end (point-marker)) - (when (equal separator '(64)) - (setq separator (read-regexp "Regexp for cell separator: "))) - (unless separator - ;; Get the right cell separator - (goto-char begin) - (setq separator - (cond - ((not (re-search-forward "^[^\n\t]+$" end t)) '(16)) - ((not (re-search-forward "^[^\n,]+$" end t)) '(4)) - (t 1)))) - (goto-char begin) - (if (equal separator '(4)) - ;; Parse CSV - (while (< (point) end) - (cond - ((looking-at "^") (insert "| ")) - ((looking-at "[ \t]*$") (replace-match " |") (beginning-of-line 2)) - ((looking-at "[ \t]*\"\\([^\"\n]*\\)\"") - (replace-match "\\1") (if (looking-at "\"") (insert "\""))) - ((looking-at "[^,\n]+") (goto-char (match-end 0))) - ((looking-at "[ \t]*,") (replace-match " | ")) - (t (beginning-of-line 2)))) - (setq re - (cond - ((equal separator '(4)) "^\\|\"?[ \t]*,[ \t]*\"?") - ((equal separator '(16)) "^\\|\t") - ((integerp separator) - (if (< separator 1) - (user-error "Cell separator must contain one or more spaces") - (format "^ *\\| *\t *\\| \\{%d,\\}\\|$" separator))) - ((stringp separator) (format "^ *\\|%s" separator)) - (t (error "Invalid cell separator")))) - (let (finish) - (while (and (not finish) (re-search-forward re end t)) - (if (eolp) - (progn - (replace-match "|" t t) - (forward-line 1) - (when (eobp) - (setq finish t))) - (replace-match "| " t t))))) - (goto-char begin) - (when markdown-table-align-p - (markdown-table-align)))) - -(defun markdown-insert-table (&optional rows columns align) - "Insert an empty pipe table. -Optional arguments ROWS, COLUMNS, and ALIGN specify number of -rows and columns and the column alignment." - (interactive) - (let* ((rows (or rows (read-number "Number of Rows: "))) - (columns (or columns (read-number "Number of Columns: "))) - (align (or align (read-string "Alignment ([l]eft, [r]ight, [c]enter, or RET for default): "))) - (align (cond ((equal align "l") ":--") - ((equal align "r") "--:") - ((equal align "c") ":-:") - (t "---"))) - (pos (point)) - (indent (make-string (current-column) ?\ )) - (line (concat - (apply 'concat indent "|" - (make-list columns " |")) "\n")) - (hline (apply 'concat indent "|" - (make-list columns (concat align "|"))))) - (if (string-match - "^[ \t]*$" (buffer-substring-no-properties - (line-beginning-position) (point))) - (beginning-of-line 1) - (newline)) - (dotimes (_ rows) (insert line)) - (goto-char pos) - (if (> rows 1) - (progn - (end-of-line 1) (insert (concat "\n" hline)) (goto-char pos))) - (markdown-table-forward-cell))) - - -;;; ElDoc Support ============================================================= - -(defun markdown-eldoc-function (&rest _ignored) - "Return a helpful string when appropriate based on context. -* Report URL when point is at a hidden URL. -* Report language name when point is a code block with hidden markup." - (cond - ;; Hidden URL or reference for inline link - ((and (or (thing-at-point-looking-at markdown-regex-link-inline) - (thing-at-point-looking-at markdown-regex-link-reference)) - (or markdown-hide-urls markdown-hide-markup)) - (let* ((imagep (string-equal (match-string 1) "!")) - (referencep (string-equal (match-string 5) "[")) - (link (match-string-no-properties 6)) - (edit-keys (markdown--substitute-command-keys - (if imagep - "\\[markdown-insert-image]" - "\\[markdown-insert-link]"))) - (edit-str (propertize edit-keys 'face 'font-lock-constant-face)) - (object (if referencep "reference" "URL"))) - (format "Hidden %s (%s to edit): %s" object edit-str - (if referencep - (concat - (propertize "[" 'face 'markdown-markup-face) - (propertize link 'face 'markdown-reference-face) - (propertize "]" 'face 'markdown-markup-face)) - (propertize link 'face 'markdown-url-face))))) - ;; Hidden language name for fenced code blocks - ((and (markdown-code-block-at-point-p) - (not (get-text-property (point) 'markdown-pre)) - markdown-hide-markup) - (let ((lang (save-excursion (markdown-code-block-lang)))) - (unless lang (setq lang "[unspecified]")) - (format "Hidden code block language: %s (%s to toggle markup)" - (propertize lang 'face 'markdown-language-keyword-face) - (markdown--substitute-command-keys - "\\[markdown-toggle-markup-hiding]")))))) - -(defun markdown--image-media-handler (mimetype data) - (let* ((ext (symbol-name (mailcap-mime-type-to-extension mimetype))) - (filename (read-string "Insert filename for image: ")) - (link-text (read-string "Link text: ")) - (filepath (file-name-with-extension filename ext)) - (dir (file-name-directory filepath))) - (when (and dir (not (file-directory-p dir))) - (make-directory dir t)) - (with-temp-file filepath - (insert data)) - (when (string-match-p "\\s-" filepath) - (setq filepath (concat "<" filepath ">"))) - (markdown-insert-inline-image link-text filepath))) - -(defun markdown--file-media-handler (_mimetype data) - (let* ((data (split-string data "[\0\r\n]" t "^file://")) - (files (cdr data))) - (while (not (null files)) - (let* ((file (url-unhex-string (car files))) - (file (file-relative-name file)) - (prompt (format "Link text(%s): " (file-name-nondirectory file))) - (link-text (read-string prompt))) - (when (string-match-p "\\s-" file) - (setq file (concat "<" file ">"))) - (markdown-insert-inline-image link-text file) - (when (not (null (cdr files))) - (insert " ")) - (setq files (cdr files)))))) - -(defun markdown--dnd-local-file-handler (url _action) - (require 'mailcap) - (require 'dnd) - (let* ((filename (dnd-get-local-file-name url)) - (mimetype (mailcap-file-name-to-mime-type filename)) - (file (file-relative-name filename)) - (link-text "link text")) - (when (string-match-p "\\s-" file) - (setq file (concat "<" file ">"))) - (if (string-prefix-p "image/" mimetype) - (markdown-insert-inline-image link-text file) - (markdown-insert-inline-link link-text file)))) - - -;;; Mode Definition ========================================================== - -(defun markdown-show-version () - "Show the version number in the minibuffer." - (interactive) - (message "markdown-mode, version %s" markdown-mode-version)) - -(defun markdown-mode-info () - "Open the `markdown-mode' homepage." - (interactive) - (browse-url "https://jblevins.org/projects/markdown-mode/")) - -;;;###autoload -(define-derived-mode markdown-mode text-mode "Markdown" - "Major mode for editing Markdown files." - (when buffer-read-only - (when (or (not (buffer-file-name)) (file-writable-p (buffer-file-name))) - (setq-local buffer-read-only nil))) - ;; Natural Markdown tab width - (setq tab-width 4) - ;; Comments - (setq-local comment-start "<!-- ") - (setq-local comment-end " -->") - (setq-local comment-start-skip "<!--[ \t]*") - (setq-local comment-column 0) - (setq-local comment-auto-fill-only-comments nil) - (setq-local comment-use-syntax t) - ;; Sentence - (setq-local sentence-end-base "[.?!…‽][]\"'”’)}»›*_`~]*") - ;; Syntax - (add-hook 'syntax-propertize-extend-region-functions - #'markdown-syntax-propertize-extend-region nil t) - (add-hook 'jit-lock-after-change-extend-region-functions - #'markdown-font-lock-extend-region-function t t) - (setq-local syntax-propertize-function #'markdown-syntax-propertize) - (syntax-propertize (point-max)) ;; Propertize before hooks run, etc. - ;; Font lock. - (setq font-lock-defaults - '(markdown-mode-font-lock-keywords - nil nil nil nil - (font-lock-multiline . t) - (font-lock-syntactic-face-function . markdown-syntactic-face) - (font-lock-extra-managed-props - . (composition display invisible rear-nonsticky - keymap help-echo mouse-face)))) - (if markdown-hide-markup - (add-to-invisibility-spec 'markdown-markup) - (remove-from-invisibility-spec 'markdown-markup)) - ;; Wiki links - (markdown-setup-wiki-link-hooks) - ;; Math mode - (when markdown-enable-math (markdown-toggle-math t)) - ;; Add a buffer-local hook to reload after file-local variables are read - (add-hook 'hack-local-variables-hook #'markdown-handle-local-variables nil t) - ;; For imenu support - (setq imenu-create-index-function - (if markdown-nested-imenu-heading-index - #'markdown-imenu-create-nested-index - #'markdown-imenu-create-flat-index)) - - ;; Defun movement - (setq-local beginning-of-defun-function #'markdown-beginning-of-defun) - (setq-local end-of-defun-function #'markdown-end-of-defun) - ;; Paragraph filling - (setq-local fill-paragraph-function #'markdown-fill-paragraph) - (setq-local paragraph-start - ;; Should match start of lines that start or separate paragraphs - (mapconcat #'identity - '( - "\f" ; starts with a literal line-feed - "[ \t\f]*$" ; space-only line - "\\(?:[ \t]*>\\)+[ \t\f]*$"; empty line in blockquote - "[ \t]*[*+-][ \t]+" ; unordered list item - "[ \t]*\\(?:[0-9]+\\|#\\)\\.[ \t]+" ; ordered list item - "[ \t]*\\[\\S-*\\]:[ \t]+" ; link ref def - "[ \t]*:[ \t]+" ; definition - "^|" ; table or Pandoc line block - ) - "\\|")) - (setq-local paragraph-separate - ;; Should match lines that separate paragraphs without being - ;; part of any paragraph: - (mapconcat #'identity - '("[ \t\f]*$" ; space-only line - "\\(?:[ \t]*>\\)+[ \t\f]*$"; empty line in blockquote - ;; The following is not ideal, but the Fill customization - ;; options really only handle paragraph-starting prefixes, - ;; not paragraph-ending suffixes: - ".* $" ; line ending in two spaces - "^#+" - "^\\(?: \\)?[-=]+[ \t]*$" ;; setext - "[ \t]*\\[\\^\\S-*\\]:[ \t]*$") ; just the start of a footnote def - "\\|")) - (setq-local adaptive-fill-first-line-regexp "\\`[ \t]*[A-Z]?>[ \t]*?\\'") - (setq-local adaptive-fill-regexp "\\s-*") - (setq-local adaptive-fill-function #'markdown-adaptive-fill-function) - (setq-local fill-forward-paragraph-function #'markdown-fill-forward-paragraph) - ;; Outline mode - (setq-local outline-regexp markdown-regex-header) - (setq-local outline-level #'markdown-outline-level) - ;; Cause use of ellipses for invisible text. - (add-to-invisibility-spec '(outline . t)) - ;; ElDoc support - (if (boundp 'eldoc-documentation-functions) - (add-hook 'eldoc-documentation-functions #'markdown-eldoc-function nil t) - (add-function :before-until (local 'eldoc-documentation-function) - #'markdown-eldoc-function)) - ;; Inhibiting line-breaking: - ;; Separating out each condition into a separate function so that users can - ;; override if desired (with remove-hook) - (add-hook 'fill-nobreak-predicate - #'markdown-line-is-reference-definition-p nil t) - (add-hook 'fill-nobreak-predicate - #'markdown-pipe-at-bol-p nil t) - - ;; Indentation - (setq-local indent-line-function markdown-indent-function) - (setq-local indent-region-function #'markdown--indent-region) - - ;; Flyspell - (setq-local flyspell-generic-check-word-predicate - #'markdown-flyspell-check-word-p) - - ;; Electric quoting - (add-hook 'electric-quote-inhibit-functions - #'markdown--inhibit-electric-quote nil :local) - - ;; drag and drop handler - (setq-local dnd-protocol-alist (cons '("^file:///" . markdown--dnd-local-file-handler) - dnd-protocol-alist)) - - ;; media handler - (when (version< "29" emacs-version) - (yank-media-handler "image/.*" #'markdown--image-media-handler) - ;; TODO support other than GNOME, like KDE etc - (yank-media-handler "x-special/gnome-copied-files" #'markdown--file-media-handler)) - - ;; Make checkboxes buttons - (when markdown-make-gfm-checkboxes-buttons - (markdown-make-gfm-checkboxes-buttons (point-min) (point-max)) - (add-hook 'after-change-functions #'markdown-gfm-checkbox-after-change-function t t) - (add-hook 'change-major-mode-hook #'markdown-remove-gfm-checkbox-overlays t t)) - - ;; edit-indirect - (add-hook 'edit-indirect-after-commit-functions - #'markdown--edit-indirect-after-commit-function - nil 'local) - - ;; Marginalized headings - (when markdown-marginalize-headers - (add-hook 'window-configuration-change-hook - #'markdown-marginalize-update-current nil t)) - - ;; add live preview export hook - (add-hook 'after-save-hook #'markdown-live-preview-if-markdown t t) - (add-hook 'kill-buffer-hook #'markdown-live-preview-remove-on-kill t t) - - ;; Add a custom keymap for `visual-line-mode' so that activating - ;; this minor mode does not override markdown-mode's keybindings. - ;; FIXME: Probably `visual-line-mode' should take care of this. - (let ((oldmap (cdr (assoc 'visual-line-mode minor-mode-map-alist))) - (newmap (make-sparse-keymap))) - (set-keymap-parent newmap oldmap) - (define-key newmap [remap move-beginning-of-line] nil) - (define-key newmap [remap move-end-of-line] nil) - (make-local-variable 'minor-mode-overriding-map-alist) - (push `(visual-line-mode . ,newmap) minor-mode-overriding-map-alist))) - -;;;###autoload -(add-to-list 'auto-mode-alist - '("\\.\\(?:md\\|markdown\\|mkd\\|mdown\\|mkdn\\|mdwn\\)\\'" . markdown-mode)) - - -;;; GitHub Flavored Markdown Mode ============================================ - -(defun gfm--electric-pair-fence-code-block () - (when (and electric-pair-mode - (not markdown-gfm-use-electric-backquote) - (eql last-command-event ?`) - (let ((count 0)) - (while (eql (char-before (- (point) count)) ?`) - (cl-incf count)) - (= count 3)) - (eql (char-after) ?`)) - (save-excursion (insert (make-string 2 ?`))))) - -(defvar gfm-mode-hook nil - "Hook run when entering GFM mode.") - -;;;###autoload -(define-derived-mode gfm-mode markdown-mode "GFM" - "Major mode for editing GitHub Flavored Markdown files." - (setq markdown-link-space-sub-char "-") - (setq markdown-wiki-link-search-subdirectories t) - (setq-local markdown-table-at-point-p-function #'gfm--table-at-point-p) - (add-hook 'post-self-insert-hook #'gfm--electric-pair-fence-code-block 'append t) - (markdown-gfm-parse-buffer-for-languages)) - - -;;; Viewing modes ============================================================= - -(defcustom markdown-hide-markup-in-view-modes t - "Enable hidden markup mode in `markdown-view-mode' and `gfm-view-mode'." - :group 'markdown - :type 'boolean - :safe #'booleanp) - -(defvar markdown-view-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "p") #'markdown-outline-previous) - (define-key map (kbd "n") #'markdown-outline-next) - (define-key map (kbd "f") #'markdown-outline-next-same-level) - (define-key map (kbd "b") #'markdown-outline-previous-same-level) - (define-key map (kbd "u") #'markdown-outline-up) - (define-key map (kbd "DEL") #'scroll-down-command) - (define-key map (kbd "SPC") #'scroll-up-command) - (define-key map (kbd ">") #'end-of-buffer) - (define-key map (kbd "<") #'beginning-of-buffer) - (define-key map (kbd "q") #'kill-this-buffer) - (define-key map (kbd "?") #'describe-mode) - map) - "Keymap for `markdown-view-mode'.") - -(defun markdown--filter-visible (beg end &optional delete) - (let ((result "") - (invisible-faces '(markdown-header-delimiter-face markdown-header-rule-face))) - (while (< beg end) - (when (markdown--face-p beg invisible-faces) - (cl-incf beg) - (while (and (markdown--face-p beg invisible-faces) (< beg end)) - (cl-incf beg))) - (let ((next (next-single-char-property-change beg 'invisible))) - (unless (get-char-property beg 'invisible) - (setq result (concat result (buffer-substring beg (min end next))))) - (setq beg next))) - (prog1 result - (when delete - (let ((inhibit-read-only t)) - (delete-region beg end)))))) - -;;;###autoload -(define-derived-mode markdown-view-mode markdown-mode "Markdown-View" - "Major mode for viewing Markdown content." - (setq-local markdown-hide-markup markdown-hide-markup-in-view-modes) - (add-to-invisibility-spec 'markdown-markup) - (setq-local filter-buffer-substring-function #'markdown--filter-visible) - (read-only-mode 1)) - -(defvar gfm-view-mode-map - markdown-view-mode-map - "Keymap for `gfm-view-mode'.") - -;;;###autoload -(define-derived-mode gfm-view-mode gfm-mode "GFM-View" - "Major mode for viewing GitHub Flavored Markdown content." - (setq-local markdown-hide-markup markdown-hide-markup-in-view-modes) - (setq-local markdown-fontify-code-blocks-natively t) - (setq-local filter-buffer-substring-function #'markdown--filter-visible) - (add-to-invisibility-spec 'markdown-markup) - (read-only-mode 1)) - - -;;; Live Preview Mode ======================================================== -;;;###autoload -(define-minor-mode markdown-live-preview-mode - "Toggle native previewing on save for a specific markdown file." - :lighter " MD-Preview" - (if markdown-live-preview-mode - (if (markdown-live-preview-get-filename) - (markdown-display-buffer-other-window (markdown-live-preview-export)) - (markdown-live-preview-mode -1) - (user-error "Buffer %s does not visit a file" (current-buffer))) - (markdown-live-preview-remove))) - - -(provide 'markdown-mode) - -;; Local Variables: -;; indent-tabs-mode: nil -;; coding: utf-8 -;; End: -;;; markdown-mode.el ends here diff --git a/emacs/elpa/markdown-mode-20240501.1057/markdown-mode.elc b/emacs/elpa/markdown-mode-20240501.1057/markdown-mode.elc Binary files differ. diff --git a/emacs/elpa/markdown-mode-20240501.1057/markdown-mode-autoloads.el b/emacs/elpa/markdown-mode-20240626.826/markdown-mode-autoloads.el diff --git a/emacs/elpa/markdown-mode-20240626.826/markdown-mode-pkg.el b/emacs/elpa/markdown-mode-20240626.826/markdown-mode-pkg.el @@ -0,0 +1,14 @@ +(define-package "markdown-mode" "20240626.826" "Major mode for Markdown-formatted text" + '((emacs "27.1")) + :commit "8aab017f4790f7a1e0d8403239cce989c88412f6" :authors + '(("Jason R. Blevins" . "jblevins@xbeta.org")) + :maintainers + '(("Jason R. Blevins" . "jblevins@xbeta.org")) + :maintainer + '("Jason R. Blevins" . "jblevins@xbeta.org") + :keywords + '("markdown" "github flavored markdown" "itex") + :url "https://jblevins.org/projects/markdown-mode/") +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/emacs/elpa/markdown-mode-20240626.826/markdown-mode.el b/emacs/elpa/markdown-mode-20240626.826/markdown-mode.el @@ -0,0 +1,10367 @@ +;;; markdown-mode.el --- Major mode for Markdown-formatted text -*- lexical-binding: t; -*- + +;; Copyright (C) 2007-2023 Jason R. Blevins and markdown-mode +;; contributors (see the commit log for details). + +;; Author: Jason R. Blevins <jblevins@xbeta.org> +;; Maintainer: Jason R. Blevins <jblevins@xbeta.org> +;; Created: May 24, 2007 +;; Version: 2.7-alpha +;; Package-Requires: ((emacs "27.1")) +;; Keywords: Markdown, GitHub Flavored Markdown, itex +;; URL: https://jblevins.org/projects/markdown-mode/ + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; See the README.md file for details. + + +;;; Code: + +(require 'easymenu) +(require 'outline) +(require 'thingatpt) +(require 'cl-lib) +(require 'url-parse) +(require 'button) +(require 'color) +(require 'rx) +(require 'subr-x) + +(defvar jit-lock-start) +(defvar jit-lock-end) +(defvar flyspell-generic-check-word-predicate) +(defvar electric-pair-pairs) +(defvar sh-ancestor-alist) + +(declare-function project-roots "project") +(declare-function sh-set-shell "sh-script") +(declare-function mailcap-file-name-to-mime-type "mailcap") +(declare-function dnd-get-local-file-name "dnd") + +;; for older emacs<29 +(declare-function mailcap-mime-type-to-extension "mailcap") +(declare-function file-name-with-extension "files") +(declare-function yank-media-handler "yank-media") + + +;;; Constants ================================================================= + +(defconst markdown-mode-version "2.7-alpha" + "Markdown mode version number.") + +(defconst markdown-output-buffer-name "*markdown-output*" + "Name of temporary buffer for markdown command output.") + + +;;; Global Variables ========================================================== + +(defvar markdown-reference-label-history nil + "History of used reference labels.") + +(defvar markdown-live-preview-mode nil + "Sentinel variable for command `markdown-live-preview-mode'.") + +(defvar markdown-gfm-language-history nil + "History list of languages used in the current buffer in GFM code blocks.") + +(defvar markdown-follow-link-functions nil + "Functions used to follow a link. +Each function is called with one argument, the link's URL. It +should return non-nil if it followed the link, or nil if not. +Functions are called in order until one of them returns non-nil; +otherwise the default link-following function is used.") + + +;;; Customizable Variables ==================================================== + +(defvar markdown-mode-hook nil + "Hook run when entering Markdown mode.") + +(defvar markdown-before-export-hook nil + "Hook run before running Markdown to export XHTML output. +The hook may modify the buffer, which will be restored to it's +original state after exporting is complete.") + +(defvar markdown-after-export-hook nil + "Hook run after XHTML output has been saved. +Any changes to the output buffer made by this hook will be saved.") + +(defgroup markdown nil + "Major mode for editing text files in Markdown format." + :prefix "markdown-" + :group 'text + :link '(url-link "https://jblevins.org/projects/markdown-mode/")) + +(defcustom markdown-command (let ((command (cl-loop for cmd in '("markdown" "pandoc" "markdown_py") + when (executable-find cmd) + return (file-name-nondirectory it)))) + (or command "markdown")) + "Command to run markdown." + :group 'markdown + :type '(choice (string :tag "Shell command") (repeat (string)) function)) + +(defcustom markdown-command-needs-filename nil + "Set to non-nil if `markdown-command' does not accept input from stdin. +Instead, it will be passed a filename as the final command line +option. As a result, you will only be able to run Markdown from +buffers which are visiting a file." + :group 'markdown + :type 'boolean) + +(defcustom markdown-open-command nil + "Command used for opening Markdown files directly. +For example, a standalone Markdown previewer. This command will +be called with a single argument: the filename of the current +buffer. It can also be a function, which will be called without +arguments." + :group 'markdown + :type '(choice file function (const :tag "None" nil))) + +(defcustom markdown-open-image-command nil + "Command used for opening image files directly. +This is used at `markdown-follow-link-at-point'." + :group 'markdown + :type '(choice file function (const :tag "None" nil))) + +(defcustom markdown-hr-strings + '("-------------------------------------------------------------------------------" + "* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *" + "---------------------------------------" + "* * * * * * * * * * * * * * * * * * * *" + "---------" + "* * * * *") + "Strings to use when inserting horizontal rules. +The first string in the list will be the default when inserting a +horizontal rule. Strings should be listed in decreasing order of +prominence (as in headings from level one to six) for use with +promotion and demotion functions." + :group 'markdown + :type '(repeat string)) + +(defcustom markdown-bold-underscore nil + "Use two underscores when inserting bold text instead of two asterisks." + :group 'markdown + :type 'boolean) + +(defcustom markdown-italic-underscore nil + "Use underscores when inserting italic text instead of asterisks." + :group 'markdown + :type 'boolean) + +(defcustom markdown-marginalize-headers nil + "When non-nil, put opening atx header markup in a left margin. + +This setting goes well with `markdown-asymmetric-header'. But +sadly it conflicts with `linum-mode' since they both use the +same margin." + :group 'markdown + :type 'boolean + :safe 'booleanp + :package-version '(markdown-mode . "2.4")) + +(defcustom markdown-marginalize-headers-margin-width 6 + "Character width of margin used for marginalized headers. +The default value is based on there being six heading levels +defined by Markdown and HTML. Increasing this produces extra +whitespace on the left. Decreasing it may be preferred when +fewer than six nested heading levels are used." + :group 'markdown + :type 'integer + :safe 'natnump + :package-version '(markdown-mode . "2.4")) + +(defcustom markdown-asymmetric-header nil + "Determines if atx header style will be asymmetric. +Set to a non-nil value to use asymmetric header styling, placing +header markup only at the beginning of the line. By default, +balanced markup will be inserted at the beginning and end of the +line around the header title." + :group 'markdown + :type 'boolean) + +(defcustom markdown-indent-function 'markdown-indent-line + "Function to use to indent." + :group 'markdown + :type 'function) + +(defcustom markdown-indent-on-enter t + "Determines indentation behavior when pressing \\[newline]. +Possible settings are nil, t, and \\='indent-and-new-item. + +When non-nil, pressing \\[newline] will call `newline-and-indent' +to indent the following line according to the context using +`markdown-indent-function'. In this case, note that +\\[electric-newline-and-maybe-indent] can still be used to insert +a newline without indentation. + +When set to \\='indent-and-new-item and the point is in a list item +when \\[newline] is pressed, the list will be continued on the next +line, where a new item will be inserted. + +When set to nil, simply call `newline' as usual. In this case, +you can still indent lines using \\[markdown-cycle] and continue +lists with \\[markdown-insert-list-item]. + +Note that this assumes the variable `electric-indent-mode' is +non-nil (enabled). When it is *disabled*, the behavior of +\\[newline] and `\\[electric-newline-and-maybe-indent]' are +reversed." + :group 'markdown + :type '(choice (const :tag "Don't automatically indent" nil) + (const :tag "Automatically indent" t) + (const :tag "Automatically indent and insert new list items" indent-and-new-item))) + +(defcustom markdown-enable-wiki-links nil + "Syntax highlighting for wiki links. +Set this to a non-nil value to turn on wiki link support by default. +Support can be toggled later using the `markdown-toggle-wiki-links' +function or \\[markdown-toggle-wiki-links]." + :group 'markdown + :type 'boolean + :safe 'booleanp + :package-version '(markdown-mode . "2.2")) + +(defcustom markdown-wiki-link-alias-first t + "When non-nil, treat aliased wiki links like [[alias text|PageName]]. +Otherwise, they will be treated as [[PageName|alias text]]." + :group 'markdown + :type 'boolean + :safe 'booleanp) + +(defcustom markdown-wiki-link-search-subdirectories nil + "When non-nil, search for wiki link targets in subdirectories. +This is the default search behavior for GitHub and is +automatically set to t in `gfm-mode'." + :group 'markdown + :type 'boolean + :safe 'booleanp + :package-version '(markdown-mode . "2.2")) + +(defcustom markdown-wiki-link-search-parent-directories nil + "When non-nil, search for wiki link targets in parent directories. +This is the default search behavior of Ikiwiki." + :group 'markdown + :type 'boolean + :safe 'booleanp + :package-version '(markdown-mode . "2.2")) + +(defcustom markdown-wiki-link-search-type nil + "Searching type for markdown wiki link. + +sub-directories: search for wiki link targets in sub directories +parent-directories: search for wiki link targets in parent directories +project: search for wiki link targets under project root" + :group 'markdown + :type '(set + (const :tag "search wiki link from subdirectories" sub-directories) + (const :tag "search wiki link from parent directories" parent-directories) + (const :tag "search wiki link under project root" project)) + :package-version '(markdown-mode . "2.5")) + +(make-obsolete-variable 'markdown-wiki-link-search-subdirectories 'markdown-wiki-link-search-type "2.5") +(make-obsolete-variable 'markdown-wiki-link-search-parent-directories 'markdown-wiki-link-search-type "2.5") + +(defcustom markdown-wiki-link-fontify-missing nil + "When non-nil, change wiki link face according to existence of target files. +This is expensive because it requires checking for the file each time the buffer +changes or the user switches windows. It is disabled by default because it may +cause lag when typing on slower machines." + :group 'markdown + :type 'boolean + :safe 'booleanp + :package-version '(markdown-mode . "2.2")) + +(defcustom markdown-uri-types + '("acap" "cid" "data" "dav" "fax" "file" "ftp" + "geo" "gopher" "http" "https" "imap" "ldap" "mailto" + "mid" "message" "modem" "news" "nfs" "nntp" + "pop" "prospero" "rtsp" "service" "sip" "tel" + "telnet" "tip" "urn" "vemmi" "wais") + "Link types for syntax highlighting of URIs." + :group 'markdown + :type '(repeat (string :tag "URI scheme"))) + +(defcustom markdown-url-compose-char + '(?∞ ?… ?⋯ ?# ?★ ?⚓) + "Placeholder character for hidden URLs. +This may be a single character or a list of characters. In case +of a list, the first one that satisfies `char-displayable-p' will +be used." + :type '(choice + (character :tag "Single URL replacement character") + (repeat :tag "List of possible URL replacement characters" + character)) + :package-version '(markdown-mode . "2.3")) + +(defcustom markdown-blockquote-display-char + '("▌" "┃" ">") + "String to display when hiding blockquote markup. +This may be a single string or a list of string. In case of a +list, the first one that satisfies `char-displayable-p' will be +used." + :type '(choice + (string :tag "Single blockquote display string") + (repeat :tag "List of possible blockquote display strings" string)) + :package-version '(markdown-mode . "2.3")) + +(defcustom markdown-hr-display-char + '(?─ ?━ ?-) + "Character for hiding horizontal rule markup. +This may be a single character or a list of characters. In case +of a list, the first one that satisfies `char-displayable-p' will +be used." + :group 'markdown + :type '(choice + (character :tag "Single HR display character") + (repeat :tag "List of possible HR display characters" character)) + :package-version '(markdown-mode . "2.3")) + +(defcustom markdown-definition-display-char + '(?⁘ ?⁙ ?≡ ?⌑ ?◊ ?:) + "Character for replacing definition list markup. +This may be a single character or a list of characters. In case +of a list, the first one that satisfies `char-displayable-p' will +be used." + :type '(choice + (character :tag "Single definition list character") + (repeat :tag "List of possible definition list characters" character)) + :package-version '(markdown-mode . "2.3")) + +(defcustom markdown-enable-math nil + "Syntax highlighting for inline LaTeX and itex expressions. +Set this to a non-nil value to turn on math support by default. +Math support can be enabled, disabled, or toggled later using +`markdown-toggle-math' or \\[markdown-toggle-math]." + :group 'markdown + :type 'boolean + :safe 'booleanp) +(make-variable-buffer-local 'markdown-enable-math) + +(defcustom markdown-enable-html t + "Enable font-lock support for HTML tags and attributes." + :group 'markdown + :type 'boolean + :safe 'booleanp + :package-version '(markdown-mode . "2.4")) + +(defcustom markdown-enable-highlighting-syntax nil + "Enable highlighting syntax." + :group 'markdown + :type 'boolean + :safe 'booleanp + :package-version '(markdown-mode . "2.5")) + +(defcustom markdown-css-paths nil + "List of URLs of CSS files to link to in the output XHTML." + :group 'markdown + :type '(repeat (string :tag "CSS File Path"))) + +(defcustom markdown-content-type "text/html" + "Content type string for the http-equiv header in XHTML output. +When set to an empty string, this attribute is omitted. Defaults to +`text/html'." + :group 'markdown + :type 'string) + +(defcustom markdown-coding-system nil + "Character set string for the http-equiv header in XHTML output. +Defaults to `buffer-file-coding-system' (and falling back to +`utf-8' when not available). Common settings are `iso-8859-1' +and `iso-latin-1'. Use `list-coding-systems' for more choices." + :group 'markdown + :type 'coding-system) + +(defcustom markdown-export-kill-buffer t + "Kill output buffer after HTML export. +When non-nil, kill the HTML output buffer after +exporting with `markdown-export'." + :group 'markdown + :type 'boolean + :safe 'booleanp + :package-version '(markdown-mode . "2.4")) + +(defcustom markdown-xhtml-header-content "" + "Additional content to include in the XHTML <head> block." + :group 'markdown + :type 'string) + +(defcustom markdown-xhtml-body-preamble "" + "Content to include in the XHTML <body> block, before the output." + :group 'markdown + :type 'string + :safe 'stringp + :package-version '(markdown-mode . "2.4")) + +(defcustom markdown-xhtml-body-epilogue "" + "Content to include in the XHTML <body> block, after the output." + :group 'markdown + :type 'string + :safe 'stringp + :package-version '(markdown-mode . "2.4")) + +(defcustom markdown-xhtml-standalone-regexp + "^\\(<\\?xml\\|<!DOCTYPE\\|<html\\)" + "Regexp indicating whether `markdown-command' output is standalone XHTML." + :group 'markdown + :type 'regexp) + +(defcustom markdown-link-space-sub-char "_" + "Character to use instead of spaces when mapping wiki links to filenames." + :group 'markdown + :type 'string) + +(defcustom markdown-reference-location 'header + "Position where new reference definitions are inserted in the document." + :group 'markdown + :type '(choice (const :tag "At the end of the document" end) + (const :tag "Immediately after the current block" immediately) + (const :tag "At the end of the subtree" subtree) + (const :tag "Before next header" header))) + +(defcustom markdown-footnote-location 'end + "Position where new footnotes are inserted in the document." + :group 'markdown + :type '(choice (const :tag "At the end of the document" end) + (const :tag "Immediately after the current block" immediately) + (const :tag "At the end of the subtree" subtree) + (const :tag "Before next header" header))) + +(defcustom markdown-footnote-display '((raise 0.2) (height 0.8)) + "Display specification for footnote markers and inline footnotes. +By default, footnote text is reduced in size and raised. Set to +nil to disable this." + :group 'markdown + :type '(choice (sexp :tag "Display specification") + (const :tag "Don't set display property" nil)) + :package-version '(markdown-mode . "2.4")) + +(defcustom markdown-sub-superscript-display + '(((raise -0.3) (height 0.7)) . ((raise 0.3) (height 0.7))) + "Display specification for subscript and superscripts. +The car is used for subscript, the cdr is used for superscripts." + :group 'markdown + :type '(cons (choice (sexp :tag "Subscript form") + (const :tag "No lowering" nil)) + (choice (sexp :tag "Superscript form") + (const :tag "No raising" nil))) + :package-version '(markdown-mode . "2.4")) + +(defcustom markdown-unordered-list-item-prefix " * " + "String inserted before unordered list items." + :group 'markdown + :type 'string) + +(defcustom markdown-ordered-list-enumeration t + "When non-nil, use enumerated numbers(1. 2. 3. etc.) for ordered list marker. +While nil, always uses '1.' for the marker" + :group 'markdown + :type 'boolean + :package-version '(markdown-mode . "2.5")) + +(defcustom markdown-nested-imenu-heading-index t + "Use nested or flat imenu heading index. +A nested index may provide more natural browsing from the menu, +but a flat list may allow for faster keyboard navigation via tab +completion." + :group 'markdown + :type 'boolean + :safe 'booleanp + :package-version '(markdown-mode . "2.2")) + +(defcustom markdown-add-footnotes-to-imenu t + "Add footnotes to end of imenu heading index." + :group 'markdown + :type 'boolean + :safe 'booleanp + :package-version '(markdown-mode . "2.4")) + +(defcustom markdown-make-gfm-checkboxes-buttons t + "When non-nil, make GFM checkboxes into buttons." + :group 'markdown + :type 'boolean) + +(defcustom markdown-use-pandoc-style-yaml-metadata nil + "When non-nil, allow YAML metadata anywhere in the document." + :group 'markdown + :type 'boolean) + +(defcustom markdown-split-window-direction 'any + "Preference for splitting windows for static and live preview. +The default value is \\='any, which instructs Emacs to use +`split-window-sensibly' to automatically choose how to split +windows based on the values of `split-width-threshold' and +`split-height-threshold' and the available windows. To force +vertically split (left and right) windows, set this to \\='vertical +or \\='right. To force horizontally split (top and bottom) windows, +set this to \\='horizontal or \\='below. + +If this value is \\='any and `display-buffer-alist' is set then +`display-buffer' is used for open buffer function" + :group 'markdown + :type '(choice (const :tag "Automatic" any) + (const :tag "Right (vertical)" right) + (const :tag "Below (horizontal)" below)) + :package-version '(markdown-mode . "2.2")) + +(defcustom markdown-live-preview-window-function + #'markdown-live-preview-window-eww + "Function to display preview of Markdown output within Emacs. +Function must update the buffer containing the preview and return +the buffer." + :group 'markdown + :type 'function) + +(defcustom markdown-live-preview-delete-export 'delete-on-destroy + "Delete exported HTML file when using `markdown-live-preview-export'. +If set to \\='delete-on-export, delete on every export. When set to +\\='delete-on-destroy delete when quitting from command +`markdown-live-preview-mode'. Never delete if set to nil." + :group 'markdown + :type '(choice + (const :tag "Delete on every export" delete-on-export) + (const :tag "Delete when quitting live preview" delete-on-destroy) + (const :tag "Never delete" nil))) + +(defcustom markdown-list-indent-width 4 + "Depth of indentation for markdown lists. +Used in `markdown-demote-list-item' and +`markdown-promote-list-item'." + :group 'markdown + :type 'integer) + +(defcustom markdown-enable-prefix-prompts t + "Display prompts for certain prefix commands. +Set to nil to disable these prompts." + :group 'markdown + :type 'boolean + :safe 'booleanp + :package-version '(markdown-mode . "2.3")) + +(defcustom markdown-gfm-additional-languages nil + "Extra languages made available when inserting GFM code blocks. +Language strings must have be trimmed of whitespace and not +contain any curly braces. They may be of arbitrary +capitalization, though." + :group 'markdown + :type '(repeat (string :validate markdown-validate-language-string))) + +(defcustom markdown-gfm-use-electric-backquote t + "Use `markdown-electric-backquote' when backquote is hit three times." + :group 'markdown + :type 'boolean) + +(defcustom markdown-gfm-downcase-languages t + "If non-nil, downcase suggested languages. +This applies to insertions done with +`markdown-electric-backquote'." + :group 'markdown + :type 'boolean) + +(defcustom markdown-edit-code-block-default-mode 'normal-mode + "Default mode to use for editing code blocks. +This mode is used when automatic detection fails, such as for GFM +code blocks with no language specified." + :group 'markdown + :type '(choice function (const :tag "None" nil)) + :package-version '(markdown-mode . "2.4")) + +(defcustom markdown-gfm-uppercase-checkbox nil + "If non-nil, use [X] for completed checkboxes, [x] otherwise." + :group 'markdown + :type 'boolean + :safe 'booleanp) + +(defcustom markdown-hide-urls nil + "Hide URLs of inline links and reference tags of reference links. +Such URLs will be replaced by a single customizable +character, defined by `markdown-url-compose-char', but are still part +of the buffer. Links can be edited interactively with +\\[markdown-insert-link] or, for example, by deleting the final +parenthesis to remove the invisibility property. You can also +hover your mouse pointer over the link text to see the URL. +Set this to a non-nil value to turn this feature on by default. +You can interactively set the value of this variable by calling +`markdown-toggle-url-hiding', pressing \\[markdown-toggle-url-hiding], +or from the menu Markdown > Links & Images menu." + :group 'markdown + :type 'boolean + :safe 'booleanp + :package-version '(markdown-mode . "2.3")) +(make-variable-buffer-local 'markdown-hide-urls) + +(defcustom markdown-translate-filename-function #'identity + "Function to use to translate filenames when following links. +\\<markdown-mode-map>\\[markdown-follow-thing-at-point] and \\[markdown-follow-link-at-point] +call this function with the filename as only argument whenever +they encounter a filename (instead of a URL) to be visited and +use its return value instead of the filename in the link. For +example, if absolute filenames are actually relative to a server +root directory, you can set +`markdown-translate-filename-function' to a function that +prepends the root directory to the given filename." + :group 'markdown + :type 'function + :risky t + :package-version '(markdown-mode . "2.4")) + +(defcustom markdown-max-image-size nil + "Maximum width and height for displayed inline images. +This variable may be nil or a cons cell (MAX-WIDTH . MAX-HEIGHT). +When nil, use the actual size. Otherwise, use ImageMagick to +resize larger images to be of the given maximum dimensions. This +requires Emacs to be built with ImageMagick support." + :group 'markdown + :package-version '(markdown-mode . "2.4") + :type '(choice + (const :tag "Use actual image width" nil) + (cons (choice (sexp :tag "Maximum width in pixels") + (const :tag "No maximum width" nil)) + (choice (sexp :tag "Maximum height in pixels") + (const :tag "No maximum height" nil))))) + +(defcustom markdown-mouse-follow-link t + "Non-nil means mouse on a link will follow the link. +This variable must be set before loading markdown-mode." + :group 'markdown + :type 'boolean + :safe 'booleanp + :package-version '(markdown-mode . "2.5")) + +(defcustom markdown-table-align-p t + "Non-nil means that table is aligned after table operation." + :group 'markdown + :type 'boolean + :safe 'booleanp + :package-version '(markdown-mode . "2.5")) + +(defcustom markdown-fontify-whole-heading-line nil + "Non-nil means fontify the whole line for headings. +This is useful when setting a background color for the +markdown-header-face-* faces." + :group 'markdown + :type 'boolean + :safe 'booleanp + :package-version '(markdown-mode . "2.5")) + +(defcustom markdown-special-ctrl-a/e nil + "Non-nil means `C-a' and `C-e' behave specially in headlines and items. + +When t, `C-a' will bring back the cursor to the beginning of the +headline text. In an item, this will be the position after bullet +and check-box, if any. When the cursor is already at that +position, another `C-a' will bring it to the beginning of the +line. + +`C-e' will jump to the end of the headline, ignoring the presence +of closing tags in the headline. A second `C-e' will then jump to +the true end of the line, after closing tags. This also means +that, when this variable is non-nil, `C-e' also will never jump +beyond the end of the heading of a folded section, i.e. not after +the ellipses. + +When set to the symbol `reversed', the first `C-a' or `C-e' works +normally, going to the true line boundary first. Only a directly +following, identical keypress will bring the cursor to the +special positions. + +This may also be a cons cell where the behavior for `C-a' and +`C-e' is set separately." + :group 'markdown + :type '(choice + (const :tag "off" nil) + (const :tag "on: after hashes/bullet and before closing tags first" t) + (const :tag "reversed: true line boundary first" reversed) + (cons :tag "Set C-a and C-e separately" + (choice :tag "Special C-a" + (const :tag "off" nil) + (const :tag "on: after hashes/bullet first" t) + (const :tag "reversed: before hashes/bullet first" reversed)) + (choice :tag "Special C-e" + (const :tag "off" nil) + (const :tag "on: before closing tags first" t) + (const :tag "reversed: after closing tags first" reversed)))) + :package-version '(markdown-mode . "2.7")) + +;;; Markdown-Specific `rx' Macro ============================================== + +;; Based on python-rx from python.el. +(defmacro markdown-rx (&rest regexps) + "Markdown mode specialized rx macro. +This variant of `rx' supports common Markdown named REGEXPS." + `(rx-let ((newline "\n") + ;; Note: #405 not consider markdown-list-indent-width however this is never used + (indent (or (repeat 4 " ") "\t")) + (block-end (and (or (one-or-more (zero-or-more blank) "\n") line-end))) + (numeral (and (one-or-more (any "0-9#")) ".")) + (bullet (any "*+:-")) + (list-marker (or (and (one-or-more (any "0-9#")) ".") + (any "*+:-"))) + (checkbox (seq "[" (any " xX") "]"))) + (rx ,@regexps))) + + +;;; Regular Expressions ======================================================= + +(defconst markdown-regex-comment-start + "<!--" + "Regular expression matches HTML comment opening.") + +(defconst markdown-regex-comment-end + "--[ \t]*>" + "Regular expression matches HTML comment closing.") + +(defconst markdown-regex-link-inline + "\\(?1:!\\)?\\(?2:\\[\\)\\(?3:\\^?\\(?:\\\\\\]\\|[^]]\\)*\\|\\)\\(?4:\\]\\)\\(?5:(\\)\\s-*\\(?6:[^)]*?\\)\\(?:\\s-+\\(?7:\"[^\"]*\"\\)\\)?\\s-*\\(?8:)\\)" + "Regular expression for a [text](file) or an image link ![text](file). +Group 1 matches the leading exclamation point (optional). +Group 2 matches the opening square bracket. +Group 3 matches the text inside the square brackets. +Group 4 matches the closing square bracket. +Group 5 matches the opening parenthesis. +Group 6 matches the URL. +Group 7 matches the title (optional). +Group 8 matches the closing parenthesis.") + +(defconst markdown-regex-link-reference + "\\(?1:!\\)?\\(?2:\\[\\)\\(?3:[^]^][^]]*\\|\\)\\(?4:\\]\\)\\(?5:\\[\\)\\(?6:[^]]*?\\)\\(?7:\\]\\)" + "Regular expression for a reference link [text][id]. +Group 1 matches the leading exclamation point (optional). +Group 2 matches the opening square bracket for the link text. +Group 3 matches the text inside the square brackets. +Group 4 matches the closing square bracket for the link text. +Group 5 matches the opening square bracket for the reference label. +Group 6 matches the reference label. +Group 7 matches the closing square bracket for the reference label.") + +(defconst markdown-regex-reference-definition + "^ \\{0,3\\}\\(?1:\\[\\)\\(?2:[^]\n]+?\\)\\(?3:\\]\\)\\(?4::\\)\\s *\\(?5:.*?\\)\\s *\\(?6: \"[^\"]*\"$\\|$\\)" + "Regular expression for a reference definition. +Group 1 matches the opening square bracket. +Group 2 matches the reference label. +Group 3 matches the closing square bracket. +Group 4 matches the colon. +Group 5 matches the URL. +Group 6 matches the title attribute (optional).") + +(defconst markdown-regex-footnote + "\\(?1:\\[\\^\\)\\(?2:.+?\\)\\(?3:\\]\\)" + "Regular expression for a footnote marker [^fn]. +Group 1 matches the opening square bracket and carat. +Group 2 matches only the label, without the surrounding markup. +Group 3 matches the closing square bracket.") + +(defconst markdown-regex-header + "^\\(?:\\(?1:[^\r\n\t -].*\\)\n\\(?:\\(?2:=+\\)\\|\\(?3:-+\\)\\)\\|\\(?4:#+[ \t]+\\)\\(?5:.*?\\)\\(?6:[ \t]+#+\\)?\\)$" + "Regexp identifying Markdown headings. +Group 1 matches the text of a setext heading. +Group 2 matches the underline of a level-1 setext heading. +Group 3 matches the underline of a level-2 setext heading. +Group 4 matches the opening hash marks of an atx heading and whitespace. +Group 5 matches the text, without surrounding whitespace, of an atx heading. +Group 6 matches the closing whitespace and hash marks of an atx heading.") + +(defconst markdown-regex-header-setext + "^\\([^\r\n\t -].*\\)\n\\(=+\\|-+\\)$" + "Regular expression for generic setext-style (underline) headers.") + +(defconst markdown-regex-header-atx + "^\\(#+\\)[ \t]+\\(.*?\\)[ \t]*\\(#*\\)$" + "Regular expression for generic atx-style (hash mark) headers.") + +(defconst markdown-regex-hr + (rx line-start + (group (or (and (repeat 3 (and "*" (? " "))) (* (any "* "))) + (and (repeat 3 (and "-" (? " "))) (* (any "- "))) + (and (repeat 3 (and "_" (? " "))) (* (any "_ "))))) + line-end) + "Regular expression for matching Markdown horizontal rules.") + +(defconst markdown-regex-code + "\\(?:\\`\\|[^\\]\\)\\(?1:\\(?2:`+\\)\\(?3:\\(?:.\\|\n[^\n]\\)*?[^`]\\)\\(?4:\\2\\)\\)\\(?:[^`]\\|\\'\\)" + "Regular expression for matching inline code fragments. + +Group 1 matches the entire code fragment including the backquotes. +Group 2 matches the opening backquotes. +Group 3 matches the code fragment itself, without backquotes. +Group 4 matches the closing backquotes. + +The leading, unnumbered group ensures that the leading backquote +character is not escaped. +The last group, also unnumbered, requires that the character +following the code fragment is not a backquote. +Note that \\(?:.\\|\n[^\n]\\) matches any character, including newlines, +but not two newlines in a row.") + +(defconst markdown-regex-kbd + "\\(?1:<kbd>\\)\\(?2:\\(?:.\\|\n[^\n]\\)*?\\)\\(?3:</kbd>\\)" + "Regular expression for matching <kbd> tags. +Groups 1 and 3 match the opening and closing tags. +Group 2 matches the key sequence.") + +(defconst markdown-regex-gfm-code-block-open + "^[[:blank:]]*\\(?1:```\\)\\(?2:[[:blank:]]*{?[[:blank:]]*\\)\\(?3:[^`[:space:]]+?\\)?\\(?:[[:blank:]]+\\(?4:.+?\\)\\)?\\(?5:[[:blank:]]*}?[[:blank:]]*\\)$" + "Regular expression matching opening of GFM code blocks. +Group 1 matches the opening three backquotes and any following whitespace. +Group 2 matches the opening brace (optional) and surrounding whitespace. +Group 3 matches the language identifier (optional). +Group 4 matches the info string (optional). +Group 5 matches the closing brace (optional), whitespace, and newline. +Groups need to agree with `markdown-regex-tilde-fence-begin'.") + +(defconst markdown-regex-gfm-code-block-close + "^[[:blank:]]*\\(?1:```\\)\\(?2:\\s *?\\)$" + "Regular expression matching closing of GFM code blocks. +Group 1 matches the closing three backquotes. +Group 2 matches any whitespace and the final newline.") + +(defconst markdown-regex-pre + "^\\( \\|\t\\).*$" + "Regular expression for matching preformatted text sections.") + +(defconst markdown-regex-list + (markdown-rx line-start + ;; 1. Leading whitespace + (group (* blank)) + ;; 2. List marker: a numeral, bullet, or colon + (group list-marker) + ;; 3. Trailing whitespace + (group (+ blank)) + ;; 4. Optional checkbox for GFM task list items + (opt (group (and checkbox (* blank))))) + "Regular expression for matching list items.") + +(defconst markdown-regex-bold + "\\(?1:^\\|[^\\]\\)\\(?2:\\(?3:\\*\\*\\|__\\)\\(?4:[^ \n\t\\]\\|[^ \n\t]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?5:\\3\\)\\)" + "Regular expression for matching bold text. +Group 1 matches the character before the opening asterisk or +underscore, if any, ensuring that it is not a backslash escape. +Group 2 matches the entire expression, including delimiters. +Groups 3 and 5 matches the opening and closing delimiters. +Group 4 matches the text inside the delimiters.") + +(defconst markdown-regex-italic + "\\(?:^\\|[^\\]\\)\\(?1:\\(?2:[*_]\\)\\(?3:[^ \n\t\\]\\|[^ \n\t*]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?4:\\2\\)\\)" + "Regular expression for matching italic text. +The leading unnumbered matches the character before the opening +asterisk or underscore, if any, ensuring that it is not a +backslash escape. +Group 1 matches the entire expression, including delimiters. +Groups 2 and 4 matches the opening and closing delimiters. +Group 3 matches the text inside the delimiters.") + +(defconst markdown-regex-strike-through + "\\(?1:^\\|[^\\]\\)\\(?2:\\(?3:~~\\)\\(?4:[^ \n\t\\]\\|[^ \n\t]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?5:~~\\)\\)" + "Regular expression for matching strike-through text. +Group 1 matches the character before the opening tilde, if any, +ensuring that it is not a backslash escape. +Group 2 matches the entire expression, including delimiters. +Groups 3 and 5 matches the opening and closing delimiters. +Group 4 matches the text inside the delimiters.") + +(defconst markdown-regex-gfm-italic + "\\(?:^\\|[^\\]\\)\\(?1:\\(?2:[*_]\\)\\(?3:[^ \\]\\2\\|[^ ]\\(?:.\\|\n[^\n]\\)*?\\)\\(?4:\\2\\)\\)" + "Regular expression for matching italic text in GitHub Flavored Markdown. +Underscores in words are not treated as special. +Group 1 matches the entire expression, including delimiters. +Groups 2 and 4 matches the opening and closing delimiters. +Group 3 matches the text inside the delimiters.") + +(defconst markdown-regex-blockquote + "^[ \t]*\\(?1:[A-Z]?>\\)\\(?2:[ \t]*\\)\\(?3:.*\\)$" + "Regular expression for matching blockquote lines. +Also accounts for a potential capital letter preceding the angle +bracket, for use with Leanpub blocks (asides, warnings, info +blocks, etc.). +Group 1 matches the leading angle bracket. +Group 2 matches the separating whitespace. +Group 3 matches the text.") + +(defconst markdown-regex-line-break + "[^ \n\t][ \t]*\\( \\)\n" + "Regular expression for matching line breaks.") + +(defconst markdown-regex-escape + "\\(\\\\\\)." + "Regular expression for matching escape sequences.") + +(defconst markdown-regex-wiki-link + "\\(?:^\\|[^\\]\\)\\(?1:\\(?2:\\[\\[\\)\\(?3:[^]|]+\\)\\(?:\\(?4:|\\)\\(?5:[^]]+\\)\\)?\\(?6:\\]\\]\\)\\)" + "Regular expression for matching wiki links. +This matches typical bracketed [[WikiLinks]] as well as \\='aliased +wiki links of the form [[PageName|link text]]. +The meanings of the first and second components depend +on the value of `markdown-wiki-link-alias-first'. + +Group 1 matches the entire link. +Group 2 matches the opening square brackets. +Group 3 matches the first component of the wiki link. +Group 4 matches the pipe separator, when present. +Group 5 matches the second component of the wiki link, when present. +Group 6 matches the closing square brackets.") + +(defconst markdown-regex-uri + (concat "\\(" (regexp-opt markdown-uri-types) ":[^]\t\n\r<>; ]+\\)") + "Regular expression for matching inline URIs.") + +;; CommanMark specification says scheme length is 2-32 characters +(defconst markdown-regex-angle-uri + (concat "\\(<\\)\\([a-z][a-z0-9.+-]\\{1,31\\}:[^]\t\n\r<>,;()]+\\)\\(>\\)") + "Regular expression for matching inline URIs in angle brackets.") + +(defconst markdown-regex-email + "<\\(\\(?:\\sw\\|\\s_\\|\\s.\\)+@\\(?:\\sw\\|\\s_\\|\\s.\\)+\\)>" + "Regular expression for matching inline email addresses.") + +(defsubst markdown-make-regex-link-generic () + "Make regular expression for matching any recognized link." + (concat "\\(?:" markdown-regex-link-inline + (when markdown-enable-wiki-links + (concat "\\|" markdown-regex-wiki-link)) + "\\|" markdown-regex-link-reference + "\\|" markdown-regex-angle-uri "\\)")) + +(defconst markdown-regex-gfm-checkbox + " \\(\\[[ xX]\\]\\) " + "Regular expression for matching GFM checkboxes. +Group 1 matches the text to become a button.") + +(defconst markdown-regex-blank-line + "^[[:blank:]]*$" + "Regular expression that matches a blank line.") + +(defconst markdown-regex-block-separator + "\n[\n\t\f ]*\n" + "Regular expression for matching block boundaries.") + +(defconst markdown-regex-block-separator-noindent + (concat "\\(\\`\\|\\(" markdown-regex-block-separator "\\)[^\n\t\f ]\\)") + "Regexp for block separators before lines with no indentation.") + +(defconst markdown-regex-math-inline-single + "\\(?:^\\|[^\\]\\)\\(?1:\\$\\)\\(?2:\\(?:[^\\$]\\|\\\\.\\)*\\)\\(?3:\\$\\)" + "Regular expression for itex $..$ math mode expressions. +Groups 1 and 3 match the opening and closing dollar signs. +Group 2 matches the mathematical expression contained within.") + +(defconst markdown-regex-math-inline-double + "\\(?:^\\|[^\\]\\)\\(?1:\\$\\$\\)\\(?2:\\(?:[^\\$]\\|\\\\.\\)*\\)\\(?3:\\$\\$\\)" + "Regular expression for itex $$..$$ math mode expressions. +Groups 1 and 3 match opening and closing dollar signs. +Group 2 matches the mathematical expression contained within.") + +(defconst markdown-regex-math-display + (rx line-start (* blank) + (group (group (repeat 1 2 "\\")) "[") + (group (*? anything)) + (group (backref 2) "]") + line-end) + "Regular expression for \[..\] or \\[..\\] display math. +Groups 1 and 4 match the opening and closing markup. +Group 3 matches the mathematical expression contained within. +Group 2 matches the opening slashes, and is used internally to +match the closing slashes.") + +(defsubst markdown-make-tilde-fence-regex (num-tildes &optional end-of-line) + "Return regexp matching a tilde code fence at least NUM-TILDES long. +END-OF-LINE is the regexp construct to indicate end of line; $ if +missing." + (format "%s%d%s%s" "^[[:blank:]]*\\([~]\\{" num-tildes ",\\}\\)" + (or end-of-line "$"))) + +(defconst markdown-regex-tilde-fence-begin + (markdown-make-tilde-fence-regex + 3 "\\([[:blank:]]*{?\\)[[:blank:]]*\\([^[:space:]]+?\\)?\\(?:[[:blank:]]+\\(.+?\\)\\)?\\([[:blank:]]*}?[[:blank:]]*\\)$") + "Regular expression for matching tilde-fenced code blocks. +Group 1 matches the opening tildes. +Group 2 matches (optional) opening brace and surrounding whitespace. +Group 3 matches the language identifier (optional). +Group 4 matches the info string (optional). +Group 5 matches the closing brace (optional) and any surrounding whitespace. +Groups need to agree with `markdown-regex-gfm-code-block-open'.") + +(defconst markdown-regex-declarative-metadata + "^[ \t]*\\(?:-[ \t]*\\)?\\([[:alpha:]][[:alpha:] _-]*?\\)\\([:=][ \t]*\\)\\(.*\\)$" + "Regular expression for matching declarative metadata statements. +This matches MultiMarkdown metadata as well as YAML and TOML +assignments such as the following: + + variable: value + +or + + variable = value") + +(defconst markdown-regex-pandoc-metadata + "^\\(%\\)\\([ \t]*\\)\\(.*\\(?:\n[ \t]+.*\\)*\\)" + "Regular expression for matching Pandoc metadata.") + +(defconst markdown-regex-yaml-metadata-border + "\\(-\\{3\\}\\)$" + "Regular expression for matching YAML metadata.") + +(defconst markdown-regex-yaml-pandoc-metadata-end-border + "^\\(\\.\\{3\\}\\|\\-\\{3\\}\\)$" + "Regular expression for matching YAML metadata end borders.") + +(defsubst markdown-get-yaml-metadata-start-border () + "Return YAML metadata start border depending upon whether Pandoc is used." + (concat + (if markdown-use-pandoc-style-yaml-metadata "^" "\\`") + markdown-regex-yaml-metadata-border)) + +(defsubst markdown-get-yaml-metadata-end-border (_) + "Return YAML metadata end border depending upon whether Pandoc is used." + (if markdown-use-pandoc-style-yaml-metadata + markdown-regex-yaml-pandoc-metadata-end-border + markdown-regex-yaml-metadata-border)) + +(defconst markdown-regex-inline-attributes + "[ \t]*\\(?:{:?\\)[ \t]*\\(?:\\(?:#[[:alpha:]_.:-]+\\|\\.[[:alpha:]_.:-]+\\|\\w+=['\"]?[^\n'\"}]*['\"]?\\),?[ \t]*\\)+\\(?:}\\)[ \t]*$" + "Regular expression for matching inline identifiers or attribute lists. +Compatible with Pandoc, Python Markdown, PHP Markdown Extra, and Leanpub.") + +(defconst markdown-regex-leanpub-sections + (concat + "^\\({\\)\\(" + (regexp-opt '("frontmatter" "mainmatter" "backmatter" "appendix" "pagebreak")) + "\\)\\(}\\)[ \t]*\n") + "Regular expression for Leanpub section markers and related syntax.") + +(defconst markdown-regex-sub-superscript + "\\(?:^\\|[^\\~^]\\)\\(?1:\\(?2:[~^]\\)\\(?3:[+-\u2212]?[[:alnum:]]+\\)\\(?4:\\2\\)\\)" + "The regular expression matching a sub- or superscript. +The leading un-numbered group matches the character before the +opening tilde or carat, if any, ensuring that it is not a +backslash escape, carat, or tilde. +Group 1 matches the entire expression, including markup. +Group 2 matches the opening markup--a tilde or carat. +Group 3 matches the text inside the delimiters. +Group 4 matches the closing markup--a tilde or carat.") + +(defconst markdown-regex-include + "^\\(?1:<<\\)\\(?:\\(?2:\\[\\)\\(?3:.*\\)\\(?4:\\]\\)\\)?\\(?:\\(?5:(\\)\\(?6:.*\\)\\(?7:)\\)\\)?\\(?:\\(?8:{\\)\\(?9:.*\\)\\(?10:}\\)\\)?$" + "Regular expression matching common forms of include syntax. +Marked 2, Leanpub, and other processors support some of these forms: + +<<[sections/section1.md] +<<(folder/filename) +<<[Code title](folder/filename) +<<{folder/raw_file.html} + +Group 1 matches the opening two angle brackets. +Groups 2-4 match the opening square bracket, the text inside, +and the closing square bracket, respectively. +Groups 5-7 match the opening parenthesis, the text inside, and +the closing parenthesis. +Groups 8-10 match the opening brace, the text inside, and the brace.") + +(defconst markdown-regex-pandoc-inline-footnote + "\\(?1:\\^\\)\\(?2:\\[\\)\\(?3:\\(?:.\\|\n[^\n]\\)*?\\)\\(?4:\\]\\)" + "Regular expression for Pandoc inline footnote^[footnote text]. +Group 1 matches the opening caret. +Group 2 matches the opening square bracket. +Group 3 matches the footnote text, without the surrounding markup. +Group 4 matches the closing square bracket.") + +(defconst markdown-regex-html-attr + "\\(\\<[[:alpha:]:-]+\\>\\)\\(\\s-*\\(=\\)\\s-*\\(\".*?\"\\|'.*?'\\|[^'\">[:space:]]+\\)?\\)?" + "Regular expression for matching HTML attributes and values. +Group 1 matches the attribute name. +Group 2 matches the following whitespace, equals sign, and value, if any. +Group 3 matches the equals sign, if any. +Group 4 matches single-, double-, or un-quoted attribute values.") + +(defconst markdown-regex-html-tag + (concat "\\(</?\\)\\(\\w+\\)\\(\\(\\s-+" markdown-regex-html-attr + "\\)+\\s-*\\|\\s-*\\)\\(/?>\\)") + "Regular expression for matching HTML tags. +Groups 1 and 9 match the beginning and ending angle brackets and slashes. +Group 2 matches the tag name. +Group 3 matches all attributes and whitespace following the tag name.") + +(defconst markdown-regex-html-entity + "\\(&#?[[:alnum:]]+;\\)" + "Regular expression for matching HTML entities.") + +(defconst markdown-regex-highlighting + "\\(?1:^\\|[^\\]\\)\\(?2:\\(?3:==\\)\\(?4:[^ \n\t\\]\\|[^ \n\t]\\(?:.\\|\n[^\n]\\)*?[^\\ ]\\)\\(?5:==\\)\\)" +"Regular expression for matching highlighting text. +Group 1 matches the character before the opening equal, if any, +ensuring that it is not a backslash escape. +Group 2 matches the entire expression, including delimiters. +Groups 3 and 5 matches the opening and closing delimiters. +Group 4 matches the text inside the delimiters.") + + +;;; Syntax ==================================================================== + +(defvar markdown--syntax-properties + (list 'markdown-tilde-fence-begin nil + 'markdown-tilde-fence-end nil + 'markdown-fenced-code nil + 'markdown-yaml-metadata-begin nil + 'markdown-yaml-metadata-end nil + 'markdown-yaml-metadata-section nil + 'markdown-gfm-block-begin nil + 'markdown-gfm-block-end nil + 'markdown-gfm-code nil + 'markdown-list-item nil + 'markdown-pre nil + 'markdown-blockquote nil + 'markdown-hr nil + 'markdown-comment nil + 'markdown-heading nil + 'markdown-heading-1-setext nil + 'markdown-heading-2-setext nil + 'markdown-heading-1-atx nil + 'markdown-heading-2-atx nil + 'markdown-heading-3-atx nil + 'markdown-heading-4-atx nil + 'markdown-heading-5-atx nil + 'markdown-heading-6-atx nil + 'markdown-metadata-key nil + 'markdown-metadata-value nil + 'markdown-metadata-markup nil) + "Property list of all Markdown syntactic properties.") + +(defvar markdown-literal-faces + '(markdown-inline-code-face + markdown-pre-face + markdown-math-face + markdown-url-face + markdown-plain-url-face + markdown-language-keyword-face + markdown-language-info-face + markdown-metadata-key-face + markdown-metadata-value-face + markdown-html-entity-face + markdown-html-tag-name-face + markdown-html-tag-delimiter-face + markdown-html-attr-name-face + markdown-html-attr-value-face + markdown-reference-face + markdown-footnote-marker-face + markdown-line-break-face + markdown-comment-face) + "A list of markdown-mode faces that contain literal text. +Literal text treats backslashes literally, rather than as an +escape character (see `markdown-match-escape').") + +(defsubst markdown-in-comment-p (&optional pos) + "Return non-nil if POS is in a comment. +If POS is not given, use point instead." + (get-text-property (or pos (point)) 'markdown-comment)) + +(defun markdown--face-p (pos faces) + "Return non-nil if face of POS contain FACES." + (let ((face-prop (get-text-property pos 'face))) + (if (listp face-prop) + (cl-loop for face in face-prop + thereis (memq face faces)) + (memq face-prop faces)))) + +(defsubst markdown--math-block-p (&optional pos) + (when markdown-enable-math + (markdown--face-p (or pos (point)) '(markdown-math-face)))) + +(defun markdown-syntax-propertize-extend-region (start end) + "Extend START to END region to include an entire block of text. +This helps improve syntax analysis for block constructs. +Returns a cons (NEW-START . NEW-END) or nil if no adjustment should be made. +Function is called repeatedly until it returns nil. For details, see +`syntax-propertize-extend-region-functions'." + (save-match-data + (save-excursion + (let* ((new-start (progn (goto-char start) + (skip-chars-forward "\n") + (if (re-search-backward "\n\n" nil t) + (min start (match-end 0)) + (point-min)))) + (new-end (progn (goto-char end) + (skip-chars-backward "\n") + (if (re-search-forward "\n\n" nil t) + (max end (match-beginning 0)) + (point-max)))) + (code-match (markdown-code-block-at-pos new-start)) + ;; FIXME: The `code-match' can return bogus values + ;; when text has been inserted/deleted! + (new-start (min (or (and code-match (cl-first code-match)) + (point-max)) + new-start)) + (code-match (and (< end (point-max)) + (markdown-code-block-at-pos end))) + (new-end (max (or (and code-match (cl-second code-match)) 0) + new-end))) + + (unless (and (eq new-start start) (eq new-end end)) + (cons new-start (min new-end (point-max)))))))) + +(defun markdown-font-lock-extend-region-function (start end _) + "Used in `jit-lock-after-change-extend-region-functions'. +Delegates to `markdown-syntax-propertize-extend-region'. START +and END are the previous region to refontify." + (let ((res (markdown-syntax-propertize-extend-region start end))) + (when res + ;; syntax-propertize-function is not called when character at + ;; (point-max) is deleted, but font-lock-extend-region-functions + ;; are called. Force a syntax property update in that case. + (when (= end (point-max)) + ;; This function is called in a buffer modification hook. + ;; `markdown-syntax-propertize' doesn't save the match data, + ;; so we have to do it here. + (save-match-data + (markdown-syntax-propertize (car res) (cdr res)))) + (setq jit-lock-start (car res) + jit-lock-end (cdr res))))) + +(defun markdown--cur-list-item-bounds () + "Return a list describing the list item at point. +Assumes that match data is set for `markdown-regex-list'. See the +documentation for `markdown-cur-list-item-bounds' for the format of +the returned list." + (save-excursion + (let* ((begin (match-beginning 0)) + (indent (length (match-string-no-properties 1))) + (nonlist-indent (- (match-end 3) (match-beginning 0))) + (marker (buffer-substring-no-properties + (match-beginning 2) (match-end 3))) + (checkbox (match-string-no-properties 4)) + (match (butlast (match-data t))) + (end (markdown-cur-list-item-end nonlist-indent))) + (list begin end indent nonlist-indent marker checkbox match)))) + +(defun markdown--append-list-item-bounds (marker indent cur-bounds bounds) + "Update list item BOUNDS given list MARKER, block INDENT, and CUR-BOUNDS. +Here, MARKER is a string representing the type of list and INDENT +is an integer giving the indentation, in spaces, of the current +block. CUR-BOUNDS is a list of the form returned by +`markdown-cur-list-item-bounds' and BOUNDS is a list of bounds +values for parent list items. When BOUNDS is nil, it means we are +at baseline (not inside of a nested list)." + (let ((prev-indent (or (cl-third (car bounds)) 0))) + (cond + ;; New list item at baseline. + ((and marker (null bounds)) + (list cur-bounds)) + ;; List item with greater indentation (four or more spaces). + ;; Increase list level by consing CUR-BOUNDS onto BOUNDS. + ((and marker (>= indent (+ prev-indent markdown-list-indent-width))) + (cons cur-bounds bounds)) + ;; List item with greater or equal indentation (less than four spaces). + ;; Keep list level the same by replacing the car of BOUNDS. + ((and marker (>= indent prev-indent)) + (cons cur-bounds (cdr bounds))) + ;; Lesser indentation level. + ;; Pop appropriate number of elements off BOUNDS list (e.g., lesser + ;; indentation could move back more than one list level). Note + ;; that this block need not be the beginning of list item. + ((< indent prev-indent) + (while (and (> (length bounds) 1) + (setq prev-indent (cl-third (cadr bounds))) + (< indent (+ prev-indent markdown-list-indent-width))) + (setq bounds (cdr bounds))) + (cons cur-bounds bounds)) + ;; Otherwise, do nothing. + (t bounds)))) + +(defun markdown-syntax-propertize-list-items (start end) + "Propertize list items from START to END. +Stores nested list item information in the `markdown-list-item' +text property to make later syntax analysis easier. The value of +this property is a list with elements of the form (begin . end) +giving the bounds of the current and parent list items." + (save-excursion + (goto-char start) + (let ((prev-list-line -100) + bounds level pre-regexp) + ;; Find a baseline point with zero list indentation + (markdown-search-backward-baseline) + ;; Search for all list items between baseline and END + (while (and (< (point) end) + (re-search-forward markdown-regex-list end 'limit)) + ;; Level of list nesting + (setq level (length bounds)) + ;; Pre blocks need to be indented one level past the list level + (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" (1+ level))) + (beginning-of-line) + (cond + ;; Reset at headings, horizontal rules, and top-level blank lines. + ;; Propertize baseline when in range. + ((markdown-new-baseline) + (setq bounds nil)) + ;; Make sure this is not a line from a pre block + ((and (looking-at-p pre-regexp) + ;; too indented line is also treated as list if previous line is list + (>= (- (line-number-at-pos) prev-list-line) 2))) + ;; If not, then update levels and propertize list item when in range. + (t + (let* ((indent (current-indentation)) + (cur-bounds (markdown--cur-list-item-bounds)) + (first (cl-first cur-bounds)) + (last (cl-second cur-bounds)) + (marker (cl-fifth cur-bounds))) + (setq bounds (markdown--append-list-item-bounds + marker indent cur-bounds bounds)) + (when (and (<= start (point)) (<= (point) end)) + (setq prev-list-line (line-number-at-pos first)) + (put-text-property first last 'markdown-list-item bounds))))) + (end-of-line))))) + +(defun markdown-syntax-propertize-pre-blocks (start end) + "Match preformatted text blocks from START to END." + (save-excursion + (goto-char start) + (let (finish) + ;; Use loop for avoiding too many recursive calls + ;; https://github.com/jrblevin/markdown-mode/issues/512 + (while (not finish) + (let ((levels (markdown-calculate-list-levels)) + indent pre-regexp close-regexp open close) + (while (and (< (point) end) (not close)) + ;; Search for a region with sufficient indentation + (if (null levels) + (setq indent 1) + (setq indent (1+ (length levels)))) + (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" indent)) + (setq close-regexp (format "^\\( \\|\t\\)\\{0,%d\\}\\([^ \t]\\)" (1- indent))) + + (cond + ;; If not at the beginning of a line, move forward + ((not (bolp)) (forward-line)) + ;; Move past blank lines + ((markdown-cur-line-blank-p) (forward-line)) + ;; At headers and horizontal rules, reset levels + ((markdown-new-baseline) (forward-line) (setq levels nil)) + ;; If the current line has sufficient indentation, mark out pre block + ;; The opening should be preceded by a blank line. + ((and (markdown-prev-line-blank) (looking-at pre-regexp)) + (setq open (match-beginning 0)) + (while (and (or (looking-at-p pre-regexp) (markdown-cur-line-blank-p)) + (not (eobp))) + (forward-line)) + (skip-syntax-backward "-") + (forward-line) + (setq close (point))) + ;; If current line has a list marker, update levels, move to end of block + ((looking-at markdown-regex-list) + (setq levels (markdown-update-list-levels + (match-string 2) (current-indentation) levels)) + (markdown-end-of-text-block)) + ;; If this is the end of the indentation level, adjust levels accordingly. + ;; Only match end of indentation level if levels is not the empty list. + ((and (car levels) (looking-at-p close-regexp)) + (setq levels (markdown-update-list-levels + nil (current-indentation) levels)) + (markdown-end-of-text-block)) + (t (markdown-end-of-text-block)))) + + (if (and open close) + ;; Set text property data and continue to search + (put-text-property open close 'markdown-pre (list open close)) + (setq finish t)))) + nil))) + +(defconst markdown-fenced-block-pairs + `(((,markdown-regex-tilde-fence-begin markdown-tilde-fence-begin) + (markdown-make-tilde-fence-regex markdown-tilde-fence-end) + markdown-fenced-code) + ((markdown-get-yaml-metadata-start-border markdown-yaml-metadata-begin) + (markdown-get-yaml-metadata-end-border markdown-yaml-metadata-end) + markdown-yaml-metadata-section) + ((,markdown-regex-gfm-code-block-open markdown-gfm-block-begin) + (,markdown-regex-gfm-code-block-close markdown-gfm-block-end) + markdown-gfm-code)) + "Mapping of regular expressions to \"fenced-block\" constructs. +These constructs are distinguished by having a distinctive start +and end pattern, both of which take up an entire line of text, +but no special pattern to identify text within the fenced +blocks (unlike blockquotes and indented-code sections). + +Each element within this list takes the form: + + ((START-REGEX-OR-FUN START-PROPERTY) + (END-REGEX-OR-FUN END-PROPERTY) + MIDDLE-PROPERTY) + +Each *-REGEX-OR-FUN element can be a regular expression as a string, or a +function which evaluates to same. Functions for START-REGEX-OR-FUN accept no +arguments, but functions for END-REGEX-OR-FUN accept a single numerical argument +which is the length of the first group of the START-REGEX-OR-FUN match, which +can be ignored if unnecessary. `markdown-maybe-funcall-regexp' is used to +evaluate these into \"real\" regexps. + +The *-PROPERTY elements are the text properties applied to each part of the +block construct when it is matched using +`markdown-syntax-propertize-fenced-block-constructs'. START-PROPERTY is applied +to the text matching START-REGEX-OR-FUN, END-PROPERTY to END-REGEX-OR-FUN, and +MIDDLE-PROPERTY to the text in between the two. The value of *-PROPERTY is the +`match-data' when the regexp was matched to the text. In the case of +MIDDLE-PROPERTY, the value is a false match data of the form \\='(begin end), with +begin and end set to the edges of the \"middle\" text. This makes fontification +easier.") + +(defun markdown-text-property-at-point (prop) + (get-text-property (point) prop)) + +(defsubst markdown-maybe-funcall-regexp (object &optional arg) + (cond ((functionp object) + (if arg (funcall object arg) (funcall object))) + ((stringp object) object) + (t (error "Object cannot be turned into regex")))) + +(defsubst markdown-get-start-fence-regexp () + "Return regexp to find all \"start\" sections of fenced block constructs. +Which construct is actually contained in the match must be found separately." + (mapconcat + #'identity + (mapcar (lambda (entry) (markdown-maybe-funcall-regexp (caar entry))) + markdown-fenced-block-pairs) + "\\|")) + +(defun markdown-get-fenced-block-begin-properties () + (cl-mapcar (lambda (entry) (cl-cadar entry)) markdown-fenced-block-pairs)) + +(defun markdown-get-fenced-block-end-properties () + (cl-mapcar (lambda (entry) (cl-cadadr entry)) markdown-fenced-block-pairs)) + +(defun markdown-get-fenced-block-middle-properties () + (cl-mapcar #'cl-third markdown-fenced-block-pairs)) + +(defun markdown-find-previous-prop (prop &optional lim) + "Find previous place where property PROP is non-nil, up to LIM. +Return a cons of (pos . property). pos is point if point contains +non-nil PROP." + (let ((res + (if (get-text-property (point) prop) (point) + (previous-single-property-change + (point) prop nil (or lim (point-min)))))) + (when (and (not (get-text-property res prop)) + (> res (point-min)) + (get-text-property (1- res) prop)) + (cl-decf res)) + (when (and res (get-text-property res prop)) (cons res prop)))) + +(defun markdown-find-next-prop (prop &optional lim) + "Find next place where property PROP is non-nil, up to LIM. +Return a cons of (POS . PROPERTY) where POS is point if point +contains non-nil PROP." + (let ((res + (if (get-text-property (point) prop) (point) + (next-single-property-change + (point) prop nil (or lim (point-max)))))) + (when (and res (get-text-property res prop)) (cons res prop)))) + +(defun markdown-min-of-seq (map-fn seq) + "Apply MAP-FN to SEQ and return element of SEQ with minimum value of MAP-FN." + (cl-loop for el in seq + with min = 1.0e+INF ; infinity + with min-el = nil + do (let ((res (funcall map-fn el))) + (when (< res min) + (setq min res) + (setq min-el el))) + finally return min-el)) + +(defun markdown-max-of-seq (map-fn seq) + "Apply MAP-FN to SEQ and return element of SEQ with maximum value of MAP-FN." + (cl-loop for el in seq + with max = -1.0e+INF ; negative infinity + with max-el = nil + do (let ((res (funcall map-fn el))) + (when (and res (> res max)) + (setq max res) + (setq max-el el))) + finally return max-el)) + +(defun markdown-find-previous-block () + "Find previous block. +Detect whether `markdown-syntax-propertize-fenced-block-constructs' was +unable to propertize the entire block, but was able to propertize the beginning +of the block. If so, return a cons of (pos . property) where the beginning of +the block was propertized." + (let ((start-pt (point)) + (closest-open + (markdown-max-of-seq + #'car + (cl-remove-if + #'null + (cl-mapcar + #'markdown-find-previous-prop + (markdown-get-fenced-block-begin-properties)))))) + (when closest-open + (let* ((length-of-open-match + (let ((match-d + (get-text-property (car closest-open) (cdr closest-open)))) + (- (cl-fourth match-d) (cl-third match-d)))) + (end-regexp + (markdown-maybe-funcall-regexp + (cl-caadr + (cl-find-if + (lambda (entry) (eq (cl-cadar entry) (cdr closest-open))) + markdown-fenced-block-pairs)) + length-of-open-match)) + (end-prop-loc + (save-excursion + (save-match-data + (goto-char (car closest-open)) + (and (re-search-forward end-regexp start-pt t) + (match-beginning 0)))))) + (and (not end-prop-loc) closest-open))))) + +(defun markdown-get-fenced-block-from-start (prop) + "Return limits of an enclosing fenced block from its start, using PROP. +Return value is a list usable as `match-data'." + (catch 'no-rest-of-block + (let* ((correct-entry + (cl-find-if + (lambda (entry) (eq (cl-cadar entry) prop)) + markdown-fenced-block-pairs)) + (begin-of-begin (cl-first (markdown-text-property-at-point prop))) + (middle-prop (cl-third correct-entry)) + (end-prop (cl-cadadr correct-entry)) + (end-of-end + (save-excursion + (goto-char (match-end 0)) ; end of begin + (unless (eobp) (forward-char)) + (let ((mid-prop-v (markdown-text-property-at-point middle-prop))) + (if (not mid-prop-v) ; no middle + (progn + ;; try to find end by advancing one + (let ((end-prop-v + (markdown-text-property-at-point end-prop))) + (if end-prop-v (cl-second end-prop-v) + (throw 'no-rest-of-block nil)))) + (set-match-data mid-prop-v) + (goto-char (match-end 0)) ; end of middle + (beginning-of-line) ; into end + (cl-second (markdown-text-property-at-point end-prop))))))) + (list begin-of-begin end-of-end)))) + +(defun markdown-get-fenced-block-from-middle (prop) + "Return limits of an enclosing fenced block from its middle, using PROP. +Return value is a list usable as `match-data'." + (let* ((correct-entry + (cl-find-if + (lambda (entry) (eq (cl-third entry) prop)) + markdown-fenced-block-pairs)) + (begin-prop (cl-cadar correct-entry)) + (begin-of-begin + (save-excursion + (goto-char (match-beginning 0)) + (unless (bobp) (forward-line -1)) + (beginning-of-line) + (cl-first (markdown-text-property-at-point begin-prop)))) + (end-prop (cl-cadadr correct-entry)) + (end-of-end + (save-excursion + (goto-char (match-end 0)) + (beginning-of-line) + (cl-second (markdown-text-property-at-point end-prop))))) + (list begin-of-begin end-of-end))) + +(defun markdown-get-fenced-block-from-end (prop) + "Return limits of an enclosing fenced block from its end, using PROP. +Return value is a list usable as `match-data'." + (let* ((correct-entry + (cl-find-if + (lambda (entry) (eq (cl-cadadr entry) prop)) + markdown-fenced-block-pairs)) + (end-of-end (cl-second (markdown-text-property-at-point prop))) + (middle-prop (cl-third correct-entry)) + (begin-prop (cl-cadar correct-entry)) + (begin-of-begin + (save-excursion + (goto-char (match-beginning 0)) ; beginning of end + (unless (bobp) (backward-char)) ; into middle + (let ((mid-prop-v (markdown-text-property-at-point middle-prop))) + (if (not mid-prop-v) + (progn + (beginning-of-line) + (cl-first (markdown-text-property-at-point begin-prop))) + (set-match-data mid-prop-v) + (goto-char (match-beginning 0)) ; beginning of middle + (unless (bobp) (forward-line -1)) ; into beginning + (beginning-of-line) + (cl-first (markdown-text-property-at-point begin-prop))))))) + (list begin-of-begin end-of-end))) + +(defun markdown-get-enclosing-fenced-block-construct (&optional pos) + "Get \"fake\" match data for block enclosing POS. +Returns fake match data which encloses the start, middle, and end +of the block construct enclosing POS, if it exists. Used in +`markdown-code-block-at-pos'." + (save-excursion + (when pos (goto-char pos)) + (beginning-of-line) + (car + (cl-remove-if + #'null + (cl-mapcar + (lambda (fun-and-prop) + (cl-destructuring-bind (fun prop) fun-and-prop + (when prop + (save-match-data + (set-match-data (markdown-text-property-at-point prop)) + (funcall fun prop))))) + `((markdown-get-fenced-block-from-start + ,(cl-find-if + #'markdown-text-property-at-point + (markdown-get-fenced-block-begin-properties))) + (markdown-get-fenced-block-from-middle + ,(cl-find-if + #'markdown-text-property-at-point + (markdown-get-fenced-block-middle-properties))) + (markdown-get-fenced-block-from-end + ,(cl-find-if + #'markdown-text-property-at-point + (markdown-get-fenced-block-end-properties))))))))) + +(defun markdown-propertize-end-match (reg end fence-spec middle-begin) + "Get match for REG up to END, if exists, and propertize appropriately. +FENCE-SPEC is an entry in `markdown-fenced-block-pairs' and +MIDDLE-BEGIN is the start of the \"middle\" section of the block." + (when (re-search-forward reg end t) + (let ((close-begin (match-beginning 0)) ; Start of closing line. + (close-end (match-end 0)) ; End of closing line. + (close-data (match-data t))) ; Match data for closing line. + ;; Propertize middle section of fenced block. + (put-text-property middle-begin close-begin + (cl-third fence-spec) + (list middle-begin close-begin)) + ;; If the block is a YAML block, propertize the declarations inside + (when (< middle-begin close-begin) ;; workaround #634 + (markdown-syntax-propertize-yaml-metadata middle-begin close-begin)) + ;; Propertize closing line of fenced block. + (put-text-property close-begin close-end + (cl-cadadr fence-spec) close-data)))) + +(defun markdown--triple-quote-single-line-p (begin) + (save-excursion + (goto-char begin) + (save-match-data + (and (search-forward "```" nil t) + (search-forward "```" (line-end-position) t))))) + +(defun markdown-syntax-propertize-fenced-block-constructs (start end) + "Propertize according to `markdown-fenced-block-pairs' from START to END. +If unable to propertize an entire block (if the start of a block is within START +and END, but the end of the block is not), propertize the start section of a +block, then in a subsequent call propertize both middle and end by finding the +start which was previously propertized." + (let ((start-reg (markdown-get-start-fence-regexp))) + (save-excursion + (goto-char start) + ;; start from previous unclosed block, if exists + (let ((prev-begin-block (markdown-find-previous-block))) + (when prev-begin-block + (let* ((correct-entry + (cl-find-if (lambda (entry) + (eq (cdr prev-begin-block) (cl-cadar entry))) + markdown-fenced-block-pairs)) + (enclosed-text-start (1+ (car prev-begin-block))) + (start-length + (save-excursion + (goto-char (car prev-begin-block)) + (string-match + (markdown-maybe-funcall-regexp + (caar correct-entry)) + (buffer-substring + (line-beginning-position) (line-end-position))) + (- (match-end 1) (match-beginning 1)))) + (end-reg (markdown-maybe-funcall-regexp + (cl-caadr correct-entry) start-length))) + (markdown-propertize-end-match + end-reg end correct-entry enclosed-text-start)))) + ;; find all new blocks within region + (while (re-search-forward start-reg end t) + ;; we assume the opening constructs take up (only) an entire line, + ;; so we re-check the current line + (let* ((block-start (match-beginning 0)) + (cur-line (buffer-substring (line-beginning-position) (line-end-position))) + ;; find entry in `markdown-fenced-block-pairs' corresponding + ;; to regex which was matched + (correct-entry + (cl-find-if + (lambda (fenced-pair) + (string-match-p + (markdown-maybe-funcall-regexp (caar fenced-pair)) + cur-line)) + markdown-fenced-block-pairs)) + (enclosed-text-start + (save-excursion (1+ (line-end-position)))) + (end-reg + (markdown-maybe-funcall-regexp + (cl-caadr correct-entry) + (if (and (match-beginning 1) (match-end 1)) + (- (match-end 1) (match-beginning 1)) + 0))) + (prop (cl-cadar correct-entry))) + (when (or (not (eq prop 'markdown-gfm-block-begin)) + (not (markdown--triple-quote-single-line-p block-start))) + ;; get correct match data + (save-excursion + (beginning-of-line) + (re-search-forward + (markdown-maybe-funcall-regexp (caar correct-entry)) + (line-end-position))) + ;; mark starting, even if ending is outside of region + (put-text-property (match-beginning 0) (match-end 0) prop (match-data t)) + (markdown-propertize-end-match + end-reg end correct-entry enclosed-text-start))))))) + +(defun markdown-syntax-propertize-blockquotes (start end) + "Match blockquotes from START to END." + (save-excursion + (goto-char start) + (while (and (re-search-forward markdown-regex-blockquote end t) + (not (markdown-code-block-at-pos (match-beginning 0)))) + (put-text-property (match-beginning 0) (match-end 0) + 'markdown-blockquote + (match-data t))))) + +(defun markdown-syntax-propertize-hrs (start end) + "Match horizontal rules from START to END." + (save-excursion + (goto-char start) + (while (re-search-forward markdown-regex-hr end t) + (let ((beg (match-beginning 0)) + (end (match-end 0))) + (goto-char beg) + (unless (or (markdown-on-heading-p) + (markdown-code-block-at-point-p)) + (put-text-property beg end 'markdown-hr (match-data t))) + (goto-char end))))) + +(defun markdown-syntax-propertize-yaml-metadata (start end) + "Propertize elements inside YAML metadata blocks from START to END. +Assumes region from START and END is already known to be the interior +region of a YAML metadata block as propertized by +`markdown-syntax-propertize-fenced-block-constructs'." + (save-excursion + (goto-char start) + (cl-loop + while (re-search-forward markdown-regex-declarative-metadata end t) + do (progn + (put-text-property (match-beginning 1) (match-end 1) + 'markdown-metadata-key (match-data t)) + (put-text-property (match-beginning 2) (match-end 2) + 'markdown-metadata-markup (match-data t)) + (put-text-property (match-beginning 3) (match-end 3) + 'markdown-metadata-value (match-data t)))))) + +(defun markdown-syntax-propertize-headings (start end) + "Match headings of type SYMBOL with REGEX from START to END." + (goto-char start) + (while (re-search-forward markdown-regex-header end t) + (unless (markdown-code-block-at-pos (match-beginning 0)) + (put-text-property + (match-beginning 0) (match-end 0) 'markdown-heading + (match-data t)) + (put-text-property + (match-beginning 0) (match-end 0) + (cond ((match-string-no-properties 2) 'markdown-heading-1-setext) + ((match-string-no-properties 3) 'markdown-heading-2-setext) + (t (let ((atx-level (length (markdown-trim-whitespace + (match-string-no-properties 4))))) + (intern (format "markdown-heading-%d-atx" atx-level))))) + (match-data t))))) + +(defun markdown-syntax-propertize-comments (start end) + "Match HTML comments from the START to END." + ;; Implement by loop instead of recursive call for avoiding + ;; exceed max-lisp-eval-depth issue + ;; https://github.com/jrblevin/markdown-mode/issues/536 + (let (finish) + (goto-char start) + (while (not finish) + (let* ((in-comment (nth 4 (syntax-ppss))) + (comment-begin (nth 8 (syntax-ppss)))) + (cond + ;; Comment start + ((and (not in-comment) + (re-search-forward markdown-regex-comment-start end t) + (not (markdown-inline-code-at-point-p)) + (not (markdown-code-block-at-point-p))) + (let ((open-beg (match-beginning 0))) + (put-text-property open-beg (1+ open-beg) + 'syntax-table (string-to-syntax "<")) + (goto-char (min (1+ (match-end 0)) end (point-max))))) + ;; Comment end + ((and in-comment comment-begin + (re-search-forward markdown-regex-comment-end end t)) + (let ((comment-end (match-end 0))) + (put-text-property (1- comment-end) comment-end + 'syntax-table (string-to-syntax ">")) + ;; Remove any other text properties inside the comment + (remove-text-properties comment-begin comment-end + markdown--syntax-properties) + (put-text-property comment-begin comment-end + 'markdown-comment (list comment-begin comment-end)) + (goto-char (min comment-end end (point-max))))) + ;; Nothing found + (t (setq finish t))))) + nil)) + +(defun markdown-syntax-propertize (start end) + "Function used as `syntax-propertize-function'. +START and END delimit region to propertize." + (with-silent-modifications + (save-excursion + (remove-text-properties start end markdown--syntax-properties) + (markdown-syntax-propertize-fenced-block-constructs start end) + (markdown-syntax-propertize-list-items start end) + (markdown-syntax-propertize-pre-blocks start end) + (markdown-syntax-propertize-blockquotes start end) + (markdown-syntax-propertize-headings start end) + (markdown-syntax-propertize-hrs start end) + (markdown-syntax-propertize-comments start end)))) + + +;;; Markup Hiding ============================================================= + +(defconst markdown-markup-properties + '(face markdown-markup-face invisible markdown-markup) + "List of properties and values to apply to markup.") + +(defconst markdown-line-break-properties + '(face markdown-line-break-face invisible markdown-markup) + "List of properties and values to apply to line break markup.") + +(defconst markdown-language-keyword-properties + '(face markdown-language-keyword-face invisible markdown-markup) + "List of properties and values to apply to code block language names.") + +(defconst markdown-language-info-properties + '(face markdown-language-info-face invisible markdown-markup) + "List of properties and values to apply to code block language info strings.") + +(defconst markdown-include-title-properties + '(face markdown-link-title-face invisible markdown-markup) + "List of properties and values to apply to included code titles.") + +(defcustom markdown-hide-markup nil + "Determines whether markup in the buffer will be hidden. +When set to nil, all markup is displayed in the buffer as it +appears in the file. An exception is when `markdown-hide-urls' +is non-nil. +Set this to a non-nil value to turn this feature on by default. +You can interactively toggle the value of this variable with +`markdown-toggle-markup-hiding', \\[markdown-toggle-markup-hiding], +or from the Markdown > Show & Hide menu. + +Markup hiding works by adding text properties to positions in the +buffer---either the `invisible' property or the `display' property +in cases where alternative glyphs are used (e.g., list bullets). +This does not, however, affect printing or other output. +Functions such as `htmlfontify-buffer' and `ps-print-buffer' will +not honor these text properties. For printing, it would be better +to first convert to HTML or PDF (e.g,. using Pandoc)." + :group 'markdown + :type 'boolean + :safe 'booleanp + :package-version '(markdown-mode . "2.3")) +(make-variable-buffer-local 'markdown-hide-markup) + +(defun markdown-toggle-markup-hiding (&optional arg) + "Toggle the display or hiding of markup. +With a prefix argument ARG, enable markup hiding if ARG is positive, +and disable it otherwise. +See `markdown-hide-markup' for additional details." + (interactive (list (or current-prefix-arg 'toggle))) + (setq markdown-hide-markup + (if (eq arg 'toggle) + (not markdown-hide-markup) + (> (prefix-numeric-value arg) 0))) + (if markdown-hide-markup + (add-to-invisibility-spec 'markdown-markup) + (remove-from-invisibility-spec 'markdown-markup)) + (when (called-interactively-p 'interactive) + (message "markdown-mode markup hiding %s" (if markdown-hide-markup "enabled" "disabled"))) + (markdown-reload-extensions)) + + +;;; Font Lock ================================================================= + +(require 'font-lock) + +(defgroup markdown-faces nil + "Faces used in Markdown Mode." + :group 'markdown + :group 'faces) + +(defface markdown-italic-face + '((t (:inherit italic))) + "Face for italic text." + :group 'markdown-faces) + +(defface markdown-bold-face + '((t (:inherit bold))) + "Face for bold text." + :group 'markdown-faces) + +(defface markdown-strike-through-face + '((t (:strike-through t))) + "Face for strike-through text." + :group 'markdown-faces) + +(defface markdown-markup-face + '((t (:inherit shadow :slant normal :weight normal))) + "Face for markup elements." + :group 'markdown-faces) + +(defface markdown-header-rule-face + '((t (:inherit markdown-markup-face))) + "Base face for headers rules." + :group 'markdown-faces) + +(defface markdown-header-delimiter-face + '((t (:inherit markdown-markup-face))) + "Base face for headers hash delimiter." + :group 'markdown-faces) + +(defface markdown-list-face + '((t (:inherit markdown-markup-face))) + "Face for list item markers." + :group 'markdown-faces) + +(defface markdown-blockquote-face + '((t (:inherit font-lock-doc-face))) + "Face for blockquote sections." + :group 'markdown-faces) + +(defface markdown-code-face + '((t (:inherit fixed-pitch))) + "Face for inline code, pre blocks, and fenced code blocks. +This may be used, for example, to add a contrasting background to +inline code fragments and code blocks." + :group 'markdown-faces) + +(defface markdown-inline-code-face + '((t (:inherit (markdown-code-face font-lock-constant-face)))) + "Face for inline code." + :group 'markdown-faces) + +(defface markdown-pre-face + '((t (:inherit (markdown-code-face font-lock-constant-face)))) + "Face for preformatted text." + :group 'markdown-faces) + +(defface markdown-table-face + '((t (:inherit (markdown-code-face)))) + "Face for tables." + :group 'markdown-faces) + +(defface markdown-language-keyword-face + '((t (:inherit font-lock-type-face))) + "Face for programming language identifiers." + :group 'markdown-faces) + +(defface markdown-language-info-face + '((t (:inherit font-lock-string-face))) + "Face for programming language info strings." + :group 'markdown-faces) + +(defface markdown-link-face + '((t (:inherit link))) + "Face for links." + :group 'markdown-faces) + +(defface markdown-missing-link-face + '((t (:inherit font-lock-warning-face))) + "Face for missing links." + :group 'markdown-faces) + +(defface markdown-reference-face + '((t (:inherit markdown-markup-face))) + "Face for link references." + :group 'markdown-faces) + +(defface markdown-footnote-marker-face + '((t (:inherit markdown-markup-face))) + "Face for footnote markers." + :group 'markdown-faces) + +(defface markdown-footnote-text-face + '((t (:inherit font-lock-comment-face))) + "Face for footnote text." + :group 'markdown-faces) + +(defface markdown-url-face + '((t (:inherit font-lock-string-face))) + "Face for URLs that are part of markup. +For example, this applies to URLs in inline links: +[link text](http://example.com/)." + :group 'markdown-faces) + +(defface markdown-plain-url-face + '((t (:inherit markdown-link-face))) + "Face for URLs that are also links. +For example, this applies to plain angle bracket URLs: +<http://example.com/>." + :group 'markdown-faces) + +(defface markdown-link-title-face + '((t (:inherit font-lock-comment-face))) + "Face for reference link titles." + :group 'markdown-faces) + +(defface markdown-line-break-face + '((t (:inherit font-lock-constant-face :underline t))) + "Face for hard line breaks." + :group 'markdown-faces) + +(defface markdown-comment-face + '((t (:inherit font-lock-comment-face))) + "Face for HTML comments." + :group 'markdown-faces) + +(defface markdown-math-face + '((t (:inherit font-lock-string-face))) + "Face for LaTeX expressions." + :group 'markdown-faces) + +(defface markdown-metadata-key-face + '((t (:inherit font-lock-variable-name-face))) + "Face for metadata keys." + :group 'markdown-faces) + +(defface markdown-metadata-value-face + '((t (:inherit font-lock-string-face))) + "Face for metadata values." + :group 'markdown-faces) + +(defface markdown-gfm-checkbox-face + '((t (:inherit font-lock-builtin-face))) + "Face for GFM checkboxes." + :group 'markdown-faces) + +(defface markdown-highlight-face + '((t (:inherit highlight))) + "Face for mouse highlighting." + :group 'markdown-faces) + +(defface markdown-hr-face + '((t (:inherit markdown-markup-face))) + "Face for horizontal rules." + :group 'markdown-faces) + +(defface markdown-html-tag-name-face + '((t (:inherit font-lock-type-face))) + "Face for HTML tag names." + :group 'markdown-faces) + +(defface markdown-html-tag-delimiter-face + '((t (:inherit markdown-markup-face))) + "Face for HTML tag delimiters." + :group 'markdown-faces) + +(defface markdown-html-attr-name-face + '((t (:inherit font-lock-variable-name-face))) + "Face for HTML attribute names." + :group 'markdown-faces) + +(defface markdown-html-attr-value-face + '((t (:inherit font-lock-string-face))) + "Face for HTML attribute values." + :group 'markdown-faces) + +(defface markdown-html-entity-face + '((t (:inherit font-lock-variable-name-face))) + "Face for HTML entities." + :group 'markdown-faces) + +(defface markdown-highlighting-face + '((t (:background "yellow" :foreground "black"))) + "Face for highlighting." + :group 'markdown-faces) + +(defcustom markdown-header-scaling nil + "Whether to use variable-height faces for headers. +When non-nil, `markdown-header-face' will inherit from +`variable-pitch' and the scaling values in +`markdown-header-scaling-values' will be applied to +headers of levels one through six respectively." + :type 'boolean + :initialize #'custom-initialize-default + :set (lambda (symbol value) + (set-default symbol value) + (markdown-update-header-faces value)) + :group 'markdown-faces + :package-version '(markdown-mode . "2.2")) + +(defcustom markdown-header-scaling-values + '(2.0 1.7 1.4 1.1 1.0 1.0) + "List of scaling values for headers of level one through six. +Used when `markdown-header-scaling' is non-nil." + :type '(repeat float) + :initialize #'custom-initialize-default + :set (lambda (symbol value) + (set-default symbol value) + (markdown-update-header-faces markdown-header-scaling value))) + +(defmacro markdown--dotimes-when-compile (i-n body) + (declare (indent 1) (debug ((symbolp form) form))) + (let ((var (car i-n)) + (n (cadr i-n)) + (code ())) + (dotimes (i (eval n t)) + (push (eval body `((,var . ,i))) code)) + `(progn ,@(nreverse code)))) + +(defface markdown-header-face + `((t (:inherit (,@(when markdown-header-scaling '(variable-pitch)) + font-lock-function-name-face) + :weight bold))) + "Base face for headers.") + +(markdown--dotimes-when-compile (num 6) + (let* ((num1 (1+ num)) + (face-name (intern (format "markdown-header-face-%s" num1)))) + `(defface ,face-name + (,'\` ((t (:inherit markdown-header-face + :height + (,'\, (if markdown-header-scaling + (float (nth ,num markdown-header-scaling-values)) + 1.0)))))) + (format "Face for level %s headers. +You probably don't want to customize this face directly. Instead +you can customize the base face `markdown-header-face' or the +variable-height variable `markdown-header-scaling'." ,num1)))) + +(defun markdown-update-header-faces (&optional scaling scaling-values) + "Update header faces, depending on if header SCALING is desired. +If so, use given list of SCALING-VALUES relative to the baseline +size of `markdown-header-face'." + (dotimes (num 6) + (let* ((face-name (intern (format "markdown-header-face-%s" (1+ num)))) + (scale (cond ((not scaling) 1.0) + (scaling-values (float (nth num scaling-values))) + (t (float (nth num markdown-header-scaling-values)))))) + (unless (get face-name 'saved-face) ; Don't update customized faces + (set-face-attribute face-name nil :height scale))))) + +(defun markdown-syntactic-face (state) + "Return font-lock face for characters with given STATE. +See `font-lock-syntactic-face-function' for details." + (let ((in-comment (nth 4 state))) + (cond + (in-comment 'markdown-comment-face) + (t nil)))) + +(defcustom markdown-list-item-bullets + '("●" "◎" "○" "◆" "◇" "►" "•") + "List of bullets to use for unordered lists. +It can contain any number of symbols, which will be repeated. +Depending on your font, some reasonable choices are: +♥ ● ◇ ✚ ✜ ☯ ◆ ♠ ♣ ♦ ❀ ◆ ◖ ▶ ► • ★ ▸." + :group 'markdown + :type '(repeat (string :tag "Bullet character")) + :package-version '(markdown-mode . "2.3")) + +(defun markdown--footnote-marker-properties () + "Return a font-lock facespec expression for footnote marker text." + `(face markdown-footnote-marker-face + ,@(when markdown-hide-markup + `(display ,markdown-footnote-display)))) + +(defun markdown--pandoc-inline-footnote-properties () + "Return a font-lock facespec expression for Pandoc inline footnote text." + `(face markdown-footnote-text-face + ,@(when markdown-hide-markup + `(display ,markdown-footnote-display)))) + +(defvar markdown-mode-font-lock-keywords + `((markdown-match-yaml-metadata-begin . ((1 'markdown-markup-face))) + (markdown-match-yaml-metadata-end . ((1 'markdown-markup-face))) + (markdown-match-yaml-metadata-key . ((1 'markdown-metadata-key-face) + (2 'markdown-markup-face) + (3 'markdown-metadata-value-face))) + (markdown-match-gfm-open-code-blocks . ((1 markdown-markup-properties) + (2 markdown-markup-properties nil t) + (3 markdown-language-keyword-properties nil t) + (4 markdown-language-info-properties nil t) + (5 markdown-markup-properties nil t))) + (markdown-match-gfm-close-code-blocks . ((0 markdown-markup-properties))) + (markdown-fontify-gfm-code-blocks) + (markdown-fontify-tables) + (markdown-match-fenced-start-code-block . ((1 markdown-markup-properties) + (2 markdown-markup-properties nil t) + (3 markdown-language-keyword-properties nil t) + (4 markdown-language-info-properties nil t) + (5 markdown-markup-properties nil t))) + (markdown-match-fenced-end-code-block . ((0 markdown-markup-properties))) + (markdown-fontify-fenced-code-blocks) + (markdown-match-pre-blocks . ((0 'markdown-pre-face))) + (markdown-fontify-headings) + (markdown-match-declarative-metadata . ((1 'markdown-metadata-key-face) + (2 'markdown-markup-face) + (3 'markdown-metadata-value-face))) + (markdown-match-pandoc-metadata . ((1 'markdown-markup-face) + (2 'markdown-markup-face) + (3 'markdown-metadata-value-face))) + (markdown-fontify-hrs) + (markdown-match-code . ((1 markdown-markup-properties prepend) + (2 'markdown-inline-code-face prepend) + (3 markdown-markup-properties prepend))) + (,markdown-regex-kbd . ((1 markdown-markup-properties) + (2 'markdown-inline-code-face) + (3 markdown-markup-properties))) + (markdown-fontify-angle-uris) + (,markdown-regex-email . 'markdown-plain-url-face) + (markdown-match-html-tag . ((1 'markdown-html-tag-delimiter-face t) + (2 'markdown-html-tag-name-face t) + (3 'markdown-html-tag-delimiter-face t) + ;; Anchored matcher for HTML tag attributes + (,markdown-regex-html-attr + ;; Before searching, move past tag + ;; name; set limit at tag close. + (progn + (goto-char (match-end 2)) (match-end 3)) + nil + . ((1 'markdown-html-attr-name-face) + (3 'markdown-html-tag-delimiter-face nil t) + (4 'markdown-html-attr-value-face nil t))))) + (,markdown-regex-html-entity . 'markdown-html-entity-face) + (markdown-fontify-list-items) + (,markdown-regex-footnote . ((1 markdown-markup-properties) ; [^ + (2 (markdown--footnote-marker-properties)) ; label + (3 markdown-markup-properties))) ; ] + (,markdown-regex-pandoc-inline-footnote . ((1 markdown-markup-properties) ; ^ + (2 markdown-markup-properties) ; [ + (3 (markdown--pandoc-inline-footnote-properties)) ; text + (4 markdown-markup-properties))) ; ] + (markdown-match-includes . ((1 markdown-markup-properties) + (2 markdown-markup-properties nil t) + (3 markdown-include-title-properties nil t) + (4 markdown-markup-properties nil t) + (5 markdown-markup-properties) + (6 'markdown-url-face) + (7 markdown-markup-properties))) + (markdown-fontify-inline-links) + (markdown-fontify-reference-links) + (,markdown-regex-reference-definition . ((1 'markdown-markup-face) ; [ + (2 'markdown-reference-face) ; label + (3 'markdown-markup-face) ; ] + (4 'markdown-markup-face) ; : + (5 'markdown-url-face) ; url + (6 'markdown-link-title-face))) ; "title" (optional) + (markdown-fontify-plain-uris) + ;; Math mode $..$ + (markdown-match-math-single . ((1 'markdown-markup-face prepend) + (2 'markdown-math-face append) + (3 'markdown-markup-face prepend))) + ;; Math mode $$..$$ + (markdown-match-math-double . ((1 'markdown-markup-face prepend) + (2 'markdown-math-face append) + (3 'markdown-markup-face prepend))) + ;; Math mode \[..\] and \\[..\\] + (markdown-match-math-display . ((1 'markdown-markup-face prepend) + (3 'markdown-math-face append) + (4 'markdown-markup-face prepend))) + (markdown-match-bold . ((1 markdown-markup-properties prepend) + (2 'markdown-bold-face append) + (3 markdown-markup-properties prepend))) + (markdown-match-italic . ((1 markdown-markup-properties prepend) + (2 'markdown-italic-face append) + (3 markdown-markup-properties prepend))) + (,markdown-regex-strike-through . ((3 markdown-markup-properties) + (4 'markdown-strike-through-face) + (5 markdown-markup-properties))) + (markdown--match-highlighting . ((3 markdown-markup-properties) + (4 'markdown-highlighting-face) + (5 markdown-markup-properties))) + (,markdown-regex-line-break . (1 markdown-line-break-properties prepend)) + (markdown-match-escape . ((1 markdown-markup-properties prepend))) + (markdown-fontify-sub-superscripts) + (markdown-match-inline-attributes . ((0 markdown-markup-properties prepend))) + (markdown-match-leanpub-sections . ((0 markdown-markup-properties))) + (markdown-fontify-blockquotes) + (markdown-match-wiki-link . ((0 'markdown-link-face prepend)))) + "Syntax highlighting for Markdown files.") + +;; Footnotes +(defvar-local markdown-footnote-counter 0 + "Counter for footnote numbers.") + +(defconst markdown-footnote-chars + "[[:alnum:]-]" + "Regular expression matching any character for a footnote identifier.") + +(defconst markdown-regex-footnote-definition + (concat "^ \\{0,3\\}\\[\\(\\^" markdown-footnote-chars "*?\\)\\]:\\(?:[ \t]+\\|$\\)") + "Regular expression matching a footnote definition, capturing the label.") + + +;;; Compatibility ============================================================= + +(defun markdown--pandoc-reference-p () + (let ((bounds (bounds-of-thing-at-point 'word))) + (when (and bounds (char-before (car bounds))) + (= (char-before (car bounds)) ?@)))) + +(defun markdown-flyspell-check-word-p () + "Return t if `flyspell' should check word just before point. +Used for `flyspell-generic-check-word-predicate'." + (save-excursion + (goto-char (1- (point))) + ;; https://github.com/jrblevin/markdown-mode/issues/560 + ;; enable spell check YAML meta data + (if (or (and (markdown-code-block-at-point-p) + (not (markdown-text-property-at-point 'markdown-yaml-metadata-section))) + (markdown-inline-code-at-point-p) + (markdown-in-comment-p) + (markdown--face-p (point) '(markdown-reference-face + markdown-markup-face + markdown-plain-url-face + markdown-inline-code-face + markdown-url-face)) + (markdown--pandoc-reference-p)) + (prog1 nil + ;; If flyspell overlay is put, then remove it + (let ((bounds (bounds-of-thing-at-point 'word))) + (when bounds + (cl-loop for ov in (overlays-in (car bounds) (cdr bounds)) + when (overlay-get ov 'flyspell-overlay) + do + (delete-overlay ov))))) + t))) + + +;;; Markdown Parsing Functions ================================================ + +(defun markdown-cur-line-blank-p () + "Return t if the current line is blank and nil otherwise." + (save-excursion + (beginning-of-line) + (looking-at-p markdown-regex-blank-line))) + +(defun markdown-prev-line-blank () + "Return t if the previous line is blank and nil otherwise. +If we are at the first line, then consider the previous line to be blank." + (or (= (line-beginning-position) (point-min)) + (save-excursion + (forward-line -1) + (looking-at markdown-regex-blank-line)))) + +(defun markdown-prev-line-blank-p () + "Like `markdown-prev-line-blank', but preserve `match-data'." + (save-match-data (markdown-prev-line-blank))) + +(defun markdown-next-line-blank-p () + "Return t if the next line is blank and nil otherwise. +If we are at the last line, then consider the next line to be blank." + (or (= (line-end-position) (point-max)) + (save-excursion + (forward-line 1) + (markdown-cur-line-blank-p)))) + +(defun markdown-prev-line-indent () + "Return the number of leading whitespace characters in the previous line. +Return 0 if the current line is the first line in the buffer." + (save-excursion + (if (= (line-beginning-position) (point-min)) + 0 + (forward-line -1) + (current-indentation)))) + +(defun markdown-next-line-indent () + "Return the number of leading whitespace characters in the next line. +Return 0 if line is the last line in the buffer." + (save-excursion + (if (= (line-end-position) (point-max)) + 0 + (forward-line 1) + (current-indentation)))) + +(defun markdown-new-baseline () + "Determine if the current line begins a new baseline level. +Assume point is positioned at beginning of line." + (or (looking-at markdown-regex-header) + (looking-at markdown-regex-hr) + (and (= (current-indentation) 0) + (not (looking-at markdown-regex-list)) + (markdown-prev-line-blank)))) + +(defun markdown-search-backward-baseline () + "Search backward baseline point with no indentation and not a list item." + (end-of-line) + (let (stop) + (while (not (or stop (bobp))) + (re-search-backward markdown-regex-block-separator-noindent nil t) + (when (match-end 2) + (goto-char (match-end 2)) + (cond + ((markdown-new-baseline) + (setq stop t)) + ((looking-at-p markdown-regex-list) + (setq stop nil)) + (t (setq stop t))))))) + +(defun markdown-update-list-levels (marker indent levels) + "Update list levels given list MARKER, block INDENT, and current LEVELS. +Here, MARKER is a string representing the type of list, INDENT is an integer +giving the indentation, in spaces, of the current block, and LEVELS is a +list of the indentation levels of parent list items. When LEVELS is nil, +it means we are at baseline (not inside of a nested list)." + (cond + ;; New list item at baseline. + ((and marker (null levels)) + (setq levels (list indent))) + ;; List item with greater indentation (four or more spaces). + ;; Increase list level. + ((and marker (>= indent (+ (car levels) markdown-list-indent-width))) + (setq levels (cons indent levels))) + ;; List item with greater or equal indentation (less than four spaces). + ;; Do not increase list level. + ((and marker (>= indent (car levels))) + levels) + ;; Lesser indentation level. + ;; Pop appropriate number of elements off LEVELS list (e.g., lesser + ;; indentation could move back more than one list level). Note + ;; that this block need not be the beginning of list item. + ((< indent (car levels)) + (while (and (> (length levels) 1) + (< indent (+ (cadr levels) markdown-list-indent-width))) + (setq levels (cdr levels))) + levels) + ;; Otherwise, do nothing. + (t levels))) + +(defun markdown-calculate-list-levels () + "Calculate list levels at point. +Return a list of the form (n1 n2 n3 ...) where n1 is the +indentation of the deepest nested list item in the branch of +the list at the point, n2 is the indentation of the parent +list item, and so on. The depth of the list item is therefore +the length of the returned list. If the point is not at or +immediately after a list item, return nil." + (save-excursion + (let ((first (point)) levels indent pre-regexp) + ;; Find a baseline point with zero list indentation + (markdown-search-backward-baseline) + ;; Search for all list items between baseline and LOC + (while (and (< (point) first) + (re-search-forward markdown-regex-list first t)) + (setq pre-regexp (format "^\\( \\|\t\\)\\{%d\\}" (1+ (length levels)))) + (beginning-of-line) + (cond + ;; Make sure this is not a header or hr + ((markdown-new-baseline) (setq levels nil)) + ;; Make sure this is not a line from a pre block + ((looking-at-p pre-regexp)) + ;; If not, then update levels + (t + (setq indent (current-indentation)) + (setq levels (markdown-update-list-levels (match-string 2) + indent levels)))) + (end-of-line)) + levels))) + +(defun markdown-prev-list-item (level) + "Search backward from point for a list item with indentation LEVEL. +Set point to the beginning of the item, and return point, or nil +upon failure." + (let (bounds indent prev) + (setq prev (point)) + (forward-line -1) + (setq indent (current-indentation)) + (while + (cond + ;; List item + ((and (looking-at-p markdown-regex-list) + (setq bounds (markdown-cur-list-item-bounds))) + (cond + ;; Stop and return point at item of equal indentation + ((= (nth 3 bounds) level) + (setq prev (point)) + nil) + ;; Stop and return nil at item with lesser indentation + ((< (nth 3 bounds) level) + (setq prev nil) + nil) + ;; Stop at beginning of buffer + ((bobp) (setq prev nil)) + ;; Continue at item with greater indentation + ((> (nth 3 bounds) level) t))) + ;; Stop at beginning of buffer + ((bobp) (setq prev nil)) + ;; Continue if current line is blank + ((markdown-cur-line-blank-p) t) + ;; Continue while indentation is the same or greater + ((>= indent level) t) + ;; Stop if current indentation is less than list item + ;; and the next is blank + ((and (< indent level) + (markdown-next-line-blank-p)) + (setq prev nil)) + ;; Stop at a header + ((looking-at-p markdown-regex-header) (setq prev nil)) + ;; Stop at a horizontal rule + ((looking-at-p markdown-regex-hr) (setq prev nil)) + ;; Otherwise, continue. + (t t)) + (forward-line -1) + (setq indent (current-indentation))) + prev)) + +(defun markdown-next-list-item (level) + "Search forward from point for the next list item with indentation LEVEL. +Set point to the beginning of the item, and return point, or nil +upon failure." + (let (bounds indent next) + (setq next (point)) + (if (looking-at markdown-regex-header-setext) + (goto-char (match-end 0))) + (forward-line) + (setq indent (current-indentation)) + (while + (cond + ;; Stop at end of the buffer. + ((eobp) nil) + ;; Continue if the current line is blank + ((markdown-cur-line-blank-p) t) + ;; List item + ((and (looking-at-p markdown-regex-list) + (setq bounds (markdown-cur-list-item-bounds))) + (cond + ;; Continue at item with greater indentation + ((> (nth 3 bounds) level) t) + ;; Stop and return point at item of equal indentation + ((= (nth 3 bounds) level) + (setq next (point)) + nil) + ;; Stop and return nil at item with lesser indentation + ((< (nth 3 bounds) level) + (setq next nil) + nil))) + ;; Continue while indentation is the same or greater + ((>= indent level) t) + ;; Stop if current indentation is less than list item + ;; and the previous line was blank. + ((and (< indent level) + (markdown-prev-line-blank-p)) + (setq next nil)) + ;; Stop at a header + ((looking-at-p markdown-regex-header) (setq next nil)) + ;; Stop at a horizontal rule + ((looking-at-p markdown-regex-hr) (setq next nil)) + ;; Otherwise, continue. + (t t)) + (forward-line) + (setq indent (current-indentation))) + next)) + +(defun markdown-cur-list-item-end (level) + "Move to end of list item with pre-marker indentation LEVEL. +Return the point at the end when a list item was found at the +original point. If the point is not in a list item, do nothing." + (let (indent) + (forward-line) + (setq indent (current-indentation)) + (while + (cond + ;; Stop at end of the buffer. + ((eobp) nil) + ;; Continue while indentation is the same or greater + ((>= indent level) t) + ;; Continue if the current line is blank + ((looking-at markdown-regex-blank-line) t) + ;; Stop if current indentation is less than list item + ;; and the previous line was blank. + ((and (< indent level) + (markdown-prev-line-blank)) + nil) + ;; Stop at a new list items of the same or lesser + ;; indentation, headings, and horizontal rules. + ((looking-at (concat "\\(?:" markdown-regex-list + "\\|" markdown-regex-header + "\\|" markdown-regex-hr "\\)")) + nil) + ;; Otherwise, continue. + (t t)) + (forward-line) + (setq indent (current-indentation))) + ;; Don't skip over whitespace for empty list items (marker and + ;; whitespace only), just move to end of whitespace. + (if (save-excursion + (beginning-of-line) + (looking-at (concat markdown-regex-list "[ \t]*$"))) + (goto-char (match-end 3)) + (skip-chars-backward " \t\n")) + (end-of-line) + (point))) + +(defun markdown-cur-list-item-bounds () + "Return bounds for list item at point. +Return a list of the following form: + + (begin end indent nonlist-indent marker checkbox match) + +The named components are: + + - begin: Position of beginning of list item, including leading indentation. + - end: Position of the end of the list item, including list item text. + - indent: Number of characters of indentation before list marker (an integer). + - nonlist-indent: Number characters of indentation, list + marker, and whitespace following list marker (an integer). + - marker: String containing the list marker and following whitespace + (e.g., \"- \" or \"* \"). + - checkbox: String containing the GFM checkbox portion, if any, + including any trailing whitespace before the text + begins (e.g., \"[x] \"). + - match: match data for markdown-regex-list + +As an example, for the following unordered list item + + - item + +the returned list would be + + (1 14 3 5 \"- \" nil (1 6 1 4 4 5 5 6)) + +If the point is not inside a list item, return nil." + (car (get-text-property (line-beginning-position) 'markdown-list-item))) + +(defun markdown-list-item-at-point-p () + "Return t if there is a list item at the point and nil otherwise." + (save-match-data (markdown-cur-list-item-bounds))) + +(defun markdown-prev-list-item-bounds () + "Return bounds of previous item in the same list of any level. +The return value has the same form as that of +`markdown-cur-list-item-bounds'." + (save-excursion + (let ((cur-bounds (markdown-cur-list-item-bounds)) + (beginning-of-list (save-excursion (markdown-beginning-of-list))) + stop) + (when cur-bounds + (goto-char (nth 0 cur-bounds)) + (while (and (not stop) (not (bobp)) + (re-search-backward markdown-regex-list + beginning-of-list t)) + (unless (or (looking-at markdown-regex-hr) + (markdown-code-block-at-point-p)) + (setq stop (point)))) + (markdown-cur-list-item-bounds))))) + +(defun markdown-next-list-item-bounds () + "Return bounds of next item in the same list of any level. +The return value has the same form as that of +`markdown-cur-list-item-bounds'." + (save-excursion + (let ((cur-bounds (markdown-cur-list-item-bounds)) + (end-of-list (save-excursion (markdown-end-of-list))) + stop) + (when cur-bounds + (goto-char (nth 0 cur-bounds)) + (end-of-line) + (while (and (not stop) (not (eobp)) + (re-search-forward markdown-regex-list + end-of-list t)) + (unless (or (looking-at markdown-regex-hr) + (markdown-code-block-at-point-p)) + (setq stop (point)))) + (when stop + (markdown-cur-list-item-bounds)))))) + +(defun markdown-beginning-of-list () + "Move point to beginning of list at point, if any." + (interactive) + (let ((orig-point (point)) + (list-begin (save-excursion + (markdown-search-backward-baseline) + ;; Stop at next list item, regardless of the indentation. + (markdown-next-list-item (point-max)) + (when (looking-at markdown-regex-list) + (point))))) + (when (and list-begin (<= list-begin orig-point)) + (goto-char list-begin)))) + +(defun markdown-end-of-list () + "Move point to end of list at point, if any." + (interactive) + (let ((start (point)) + (end (save-excursion + (when (markdown-beginning-of-list) + ;; Items can't have nonlist-indent <= 1, so this + ;; moves past all list items. + (markdown-next-list-item 1) + (skip-syntax-backward "-") + (unless (eobp) (forward-char 1)) + (point))))) + (when (and end (>= end start)) + (goto-char end)))) + +(defun markdown-up-list () + "Move point to beginning of parent list item." + (interactive) + (let ((cur-bounds (markdown-cur-list-item-bounds))) + (when cur-bounds + (markdown-prev-list-item (1- (nth 3 cur-bounds))) + (let ((up-bounds (markdown-cur-list-item-bounds))) + (when (and up-bounds (< (nth 3 up-bounds) (nth 3 cur-bounds))) + (point)))))) + +(defun markdown-bounds-of-thing-at-point (thing) + "Call `bounds-of-thing-at-point' for THING with slight modifications. +Does not include trailing newlines when THING is \\='line. Handles the +end of buffer case by setting both endpoints equal to the value of +`point-max', since an empty region will trigger empty markup insertion. +Return bounds of form (beg . end) if THING is found, or nil otherwise." + (let* ((bounds (bounds-of-thing-at-point thing)) + (a (car bounds)) + (b (cdr bounds))) + (when bounds + (when (eq thing 'line) + (cond ((and (eobp) (markdown-cur-line-blank-p)) + (setq a b)) + ((char-equal (char-before b) ?\^J) + (setq b (1- b))))) + (cons a b)))) + +(defun markdown-reference-definition (reference) + "Find out whether Markdown REFERENCE is defined. +REFERENCE should not include the square brackets. +When REFERENCE is defined, return a list of the form (text start end) +containing the definition text itself followed by the start and end +locations of the text. Otherwise, return nil. +Leave match data for `markdown-regex-reference-definition' +intact additional processing." + (let ((reference (downcase reference))) + (save-excursion + (goto-char (point-min)) + (catch 'found + (while (re-search-forward markdown-regex-reference-definition nil t) + (when (string= reference (downcase (match-string-no-properties 2))) + (throw 'found + (list (match-string-no-properties 5) + (match-beginning 5) (match-end 5))))))))) + +(defun markdown-get-defined-references () + "Return all defined reference labels and their line numbers. +They does not include square brackets)." + (save-excursion + (goto-char (point-min)) + (let (refs) + (while (re-search-forward markdown-regex-reference-definition nil t) + (let ((target (match-string-no-properties 2))) + (cl-pushnew + (cons (downcase target) + (markdown-line-number-at-pos (match-beginning 2))) + refs :test #'equal :key #'car))) + (reverse refs)))) + +(defun markdown-get-used-uris () + "Return a list of all used URIs in the buffer." + (save-excursion + (goto-char (point-min)) + (let (uris) + (while (re-search-forward + (concat "\\(?:" markdown-regex-link-inline + "\\|" markdown-regex-angle-uri + "\\|" markdown-regex-uri + "\\|" markdown-regex-email + "\\)") + nil t) + (unless (or (markdown-inline-code-at-point-p) + (markdown-code-block-at-point-p)) + (cl-pushnew (or (match-string-no-properties 6) + (match-string-no-properties 10) + (match-string-no-properties 12) + (match-string-no-properties 13)) + uris :test #'equal))) + (reverse uris)))) + +(defun markdown-inline-code-at-pos (pos) + "Return non-nil if there is an inline code fragment at POS. +Return nil otherwise. Set match data according to +`markdown-match-code' upon success. +This function searches the block for a code fragment that +contains the point using `markdown-match-code'. We do this +because `thing-at-point-looking-at' does not work reliably with +`markdown-regex-code'. + +The match data is set as follows: +Group 1 matches the opening backquotes. +Group 2 matches the code fragment itself, without backquotes. +Group 3 matches the closing backquotes." + (save-excursion + (goto-char pos) + (let ((old-point (point)) + (end-of-block (progn (markdown-end-of-text-block) (point))) + found) + (markdown-beginning-of-text-block) + (while (and (markdown-match-code end-of-block) + (setq found t) + (< (match-end 0) old-point))) + (let ((match-group (if (eq (char-after (match-beginning 0)) ?`) 0 1))) + (and found ; matched something + (<= (match-beginning match-group) old-point) ; match contains old-point + (> (match-end 0) old-point)))))) + +(defun markdown-inline-code-at-pos-p (pos) + "Return non-nil if there is an inline code fragment at POS. +Like `markdown-inline-code-at-pos`, but preserves match data." + (save-match-data (markdown-inline-code-at-pos pos))) + +(defun markdown-inline-code-at-point () + "Return non-nil if the point is at an inline code fragment. +See `markdown-inline-code-at-pos' for details." + (markdown-inline-code-at-pos (point))) + +(defun markdown-inline-code-at-point-p (&optional pos) + "Return non-nil if there is inline code at the POS. +This is a predicate function counterpart to +`markdown-inline-code-at-point' which does not modify the match +data. See `markdown-code-block-at-point-p' for code blocks." + (save-match-data (markdown-inline-code-at-pos (or pos (point))))) + +(defun markdown-code-block-at-pos (pos) + "Return match data list if there is a code block at POS. +Uses text properties at the beginning of the line position. +This includes pre blocks, tilde-fenced code blocks, and GFM +quoted code blocks. Return nil otherwise." + (let ((bol (save-excursion (goto-char pos) (line-beginning-position)))) + (or (get-text-property bol 'markdown-pre) + (let* ((bounds (markdown-get-enclosing-fenced-block-construct pos)) + (second (cl-second bounds))) + (if second + ;; chunks are right open + (when (< pos second) + bounds) + bounds))))) + +;; Function was renamed to emphasize that it does not modify match-data. +(defalias 'markdown-code-block-at-point 'markdown-code-block-at-point-p) + +(defun markdown-code-block-at-point-p (&optional pos) + "Return non-nil if there is a code block at the POS. +This includes pre blocks, tilde-fenced code blocks, and GFM +quoted code blocks. This function does not modify the match +data. See `markdown-inline-code-at-point-p' for inline code." + (save-match-data (markdown-code-block-at-pos (or pos (point))))) + +(defun markdown-heading-at-point (&optional pos) + "Return non-nil if there is a heading at the POS. +Set match data for `markdown-regex-header'." + (let ((match-data (get-text-property (or pos (point)) 'markdown-heading))) + (when match-data + (set-match-data match-data) + t))) + +(defun markdown-pipe-at-bol-p () + "Return non-nil if the line begins with a pipe symbol. +This may be useful for tables and Pandoc's line_blocks extension." + (char-equal (char-after (line-beginning-position)) ?|)) + + +;;; Markdown Font Lock Matching Functions ===================================== + +(defun markdown-range-property-any (begin end prop prop-values) + "Return t if PROP from BEGIN to END is equal to one of the given PROP-VALUES. +Also returns t if PROP is a list containing one of the PROP-VALUES. +Return nil otherwise." + (let (props) + (catch 'found + (dolist (loc (number-sequence begin end)) + (when (setq props (get-text-property loc prop)) + (cond ((listp props) + ;; props is a list, check for membership + (dolist (val prop-values) + (when (memq val props) (throw 'found loc)))) + (t + ;; props is a scalar, check for equality + (dolist (val prop-values) + (when (eq val props) (throw 'found loc)))))))))) + +(defun markdown-range-properties-exist (begin end props) + (cl-loop + for loc in (number-sequence begin end) + with result = nil + while (not + (setq result + (cl-some (lambda (prop) (get-text-property loc prop)) props))) + finally return result)) + +(defun markdown-match-inline-generic (regex last &optional faceless) + "Match inline REGEX from the point to LAST. +When FACELESS is non-nil, do not return matches where faces have been applied." + (when (re-search-forward regex last t) + (let ((bounds (markdown-code-block-at-pos (match-beginning 1))) + (face (and faceless (text-property-not-all + (match-beginning 0) (match-end 0) 'face nil)))) + (cond + ;; In code block: move past it and recursively search again + (bounds + (when (< (goto-char (cl-second bounds)) last) + (markdown-match-inline-generic regex last faceless))) + ;; When faces are found in the match range, skip over the match and + ;; recursively search again. + (face + (when (< (goto-char (match-end 0)) last) + (markdown-match-inline-generic regex last faceless))) + ;; Keep match data and return t when in bounds. + (t + (<= (match-end 0) last)))))) + +(defun markdown-match-code (last) + "Match inline code fragments from point to LAST." + (unless (bobp) + (backward-char 1)) + (when (markdown-search-until-condition + (lambda () + (and + ;; Advance point in case of failure, but without exceeding last. + (goto-char (min (1+ (match-beginning 1)) last)) + (not (markdown-in-comment-p (match-beginning 1))) + (not (markdown-in-comment-p (match-end 1))) + (not (markdown-code-block-at-pos (match-beginning 1))))) + markdown-regex-code last t) + (set-match-data (list (match-beginning 1) (match-end 1) + (match-beginning 2) (match-end 2) + (match-beginning 3) (match-end 3) + (match-beginning 4) (match-end 4))) + (goto-char (min (1+ (match-end 0)) last (point-max))) + t)) + +(defun markdown--gfm-markup-underscore-p (begin end) + (let ((is-underscore (eql (char-after begin) ?_))) + (if (not is-underscore) + t + (save-excursion + (save-match-data + (goto-char begin) + (and (looking-back "\\(?:^\\|[[:blank:][:punct:]]\\)" (1- begin)) + (progn + (goto-char end) + (looking-at-p "\\(?:[[:blank:][:punct:]]\\|$\\)")))))))) + +(defun markdown-match-bold (last) + "Match inline bold from the point to LAST." + (when (markdown-match-inline-generic markdown-regex-bold last) + (let ((is-gfm (derived-mode-p 'gfm-mode)) + (begin (match-beginning 2)) + (end (match-end 2))) + (if (or (markdown-inline-code-at-pos-p begin) + (markdown-inline-code-at-pos-p end) + (markdown-in-comment-p) + (markdown-range-property-any + begin begin 'face '(markdown-url-face + markdown-plain-url-face)) + (markdown-range-property-any + begin end 'face '(markdown-hr-face + markdown-math-face)) + (and is-gfm (not (markdown--gfm-markup-underscore-p begin end)))) + (progn (goto-char (min (1+ begin) last)) + (when (< (point) last) + (markdown-match-bold last))) + (set-match-data (list (match-beginning 2) (match-end 2) + (match-beginning 3) (match-end 3) + (match-beginning 4) (match-end 4) + (match-beginning 5) (match-end 5))) + t)))) + +(defun markdown-match-italic (last) + "Match inline italics from the point to LAST." + (let* ((is-gfm (derived-mode-p 'gfm-mode)) + (regex (if is-gfm + markdown-regex-gfm-italic + markdown-regex-italic))) + (when (and (markdown-match-inline-generic regex last) + (not (markdown--face-p + (match-beginning 1) + '(markdown-html-attr-name-face markdown-html-attr-value-face)))) + (let ((begin (match-beginning 1)) + (end (match-end 1)) + (close-end (match-end 4))) + (if (or (eql (char-before begin) (char-after begin)) + (markdown-inline-code-at-pos-p begin) + (markdown-inline-code-at-pos-p (1- end)) + (markdown-in-comment-p) + (markdown-range-property-any + begin begin 'face '(markdown-url-face + markdown-plain-url-face + markdown-markup-face)) + (markdown-range-property-any + begin end 'face '(markdown-bold-face + markdown-list-face + markdown-hr-face + markdown-math-face)) + (and is-gfm + (or (char-equal (char-after begin) (char-after (1+ begin))) ;; check bold case + (not (markdown--gfm-markup-underscore-p begin close-end))))) + (progn (goto-char (min (1+ begin) last)) + (when (< (point) last) + (markdown-match-italic last))) + (set-match-data (list (match-beginning 1) (match-end 1) + (match-beginning 2) (match-end 2) + (match-beginning 3) (match-end 3) + (match-beginning 4) (match-end 4))) + t))))) + +(defun markdown--match-highlighting (last) + (when markdown-enable-highlighting-syntax + (re-search-forward markdown-regex-highlighting last t))) + +(defun markdown-match-escape (last) + "Match escape characters (backslashes) from point to LAST. +Backlashes only count as escape characters outside of literal +regions (e.g. code blocks). See `markdown-literal-faces'." + (catch 'found + (while (search-forward-regexp markdown-regex-escape last t) + (let* ((face (get-text-property (match-beginning 1) 'face)) + (face-list (if (listp face) face (list face)))) + ;; Ignore any backslashes with a literal face. + (unless (cl-intersection face-list markdown-literal-faces) + (throw 'found t)))))) + +(defun markdown-match-math-generic (regex last) + "Match REGEX from point to LAST. +REGEX is either `markdown-regex-math-inline-single' for matching +$..$ or `markdown-regex-math-inline-double' for matching $$..$$." + (when (markdown-match-inline-generic regex last) + (let ((begin (match-beginning 1)) (end (match-end 1))) + (prog1 + (if (or (markdown-range-property-any + begin end 'face + '(markdown-inline-code-face markdown-bold-face)) + (markdown-range-properties-exist + begin end + (markdown-get-fenced-block-middle-properties))) + (markdown-match-math-generic regex last) + t) + (goto-char (1+ (match-end 0))))))) + +(defun markdown-match-list-items (last) + "Match list items from point to LAST." + (let* ((first (point)) + (pos first) + (prop 'markdown-list-item) + (bounds (car (get-text-property pos prop)))) + (while + (and (or (null (setq bounds (car (get-text-property pos prop)))) + (< (cl-first bounds) pos)) + (< (point) last) + (setq pos (next-single-property-change pos prop nil last)) + (goto-char pos))) + (when bounds + (set-match-data (cl-seventh bounds)) + ;; Step at least one character beyond point. Otherwise + ;; `font-lock-fontify-keywords-region' infloops. + (goto-char (min (1+ (max (line-end-position) first)) + (point-max))) + t))) + +(defun markdown-match-math-single (last) + "Match single quoted $..$ math from point to LAST." + (when markdown-enable-math + (when (and (char-equal (char-after) ?$) + (not (bolp)) + (not (char-equal (char-before) ?\\)) + (not (char-equal (char-before) ?$))) + (forward-char -1)) + (markdown-match-math-generic markdown-regex-math-inline-single last))) + +(defun markdown-match-math-double (last) + "Match double quoted $$..$$ math from point to LAST." + (when markdown-enable-math + (when (and (< (1+ (point)) (point-max)) + (char-equal (char-after) ?$) + (char-equal (char-after (1+ (point))) ?$) + (not (bolp)) + (not (char-equal (char-before) ?\\)) + (not (char-equal (char-before) ?$))) + (forward-char -1)) + (markdown-match-math-generic markdown-regex-math-inline-double last))) + +(defun markdown-match-math-display (last) + "Match bracketed display math \[..\] and \\[..\\] from point to LAST." + (when markdown-enable-math + (markdown-match-math-generic markdown-regex-math-display last))) + +(defun markdown-match-propertized-text (property last) + "Match text with PROPERTY from point to LAST. +Restore match data previously stored in PROPERTY." + (let ((saved (get-text-property (point) property)) + pos) + (unless saved + (setq pos (next-single-property-change (point) property nil last)) + (unless (= pos last) + (setq saved (get-text-property pos property)))) + (when saved + (set-match-data saved) + ;; Step at least one character beyond point. Otherwise + ;; `font-lock-fontify-keywords-region' infloops. + (goto-char (min (1+ (max (match-end 0) (point))) + (point-max))) + saved))) + +(defun markdown-match-pre-blocks (last) + "Match preformatted blocks from point to LAST. +Use data stored in \\='markdown-pre text property during syntax +analysis." + (markdown-match-propertized-text 'markdown-pre last)) + +(defun markdown-match-gfm-code-blocks (last) + "Match GFM quoted code blocks from point to LAST. +Use data stored in \\='markdown-gfm-code text property during syntax +analysis." + (markdown-match-propertized-text 'markdown-gfm-code last)) + +(defun markdown-match-gfm-open-code-blocks (last) + (markdown-match-propertized-text 'markdown-gfm-block-begin last)) + +(defun markdown-match-gfm-close-code-blocks (last) + (markdown-match-propertized-text 'markdown-gfm-block-end last)) + +(defun markdown-match-fenced-code-blocks (last) + "Match fenced code blocks from the point to LAST." + (markdown-match-propertized-text 'markdown-fenced-code last)) + +(defun markdown-match-fenced-start-code-block (last) + (markdown-match-propertized-text 'markdown-tilde-fence-begin last)) + +(defun markdown-match-fenced-end-code-block (last) + (markdown-match-propertized-text 'markdown-tilde-fence-end last)) + +(defun markdown-match-blockquotes (last) + "Match blockquotes from point to LAST. +Use data stored in \\='markdown-blockquote text property during syntax +analysis." + (markdown-match-propertized-text 'markdown-blockquote last)) + +(defun markdown-match-hr (last) + "Match horizontal rules comments from the point to LAST." + (markdown-match-propertized-text 'markdown-hr last)) + +(defun markdown-match-comments (last) + "Match HTML comments from the point to LAST." + (when (and (skip-syntax-forward "^<" last)) + (let ((beg (point))) + (when (and (skip-syntax-forward "^>" last) (< (point) last)) + (forward-char) + (set-match-data (list beg (point))) + t)))) + +(defun markdown-match-generic-links (last ref) + "Match inline links from point to LAST. +When REF is non-nil, match reference links instead of standard +links with URLs. +This function should only be used during font-lock, as it +determines syntax based on the presence of faces for previously +processed elements." + ;; Search for the next potential link (not in a code block). + (let ((prohibited-faces '(markdown-pre-face + markdown-code-face + markdown-inline-code-face + markdown-comment-face)) + found) + (while + (and (not found) (< (point) last) + (progn + ;; Clear match data to test for a match after functions returns. + (set-match-data nil) + ;; Preliminary regular expression search so we can return + ;; quickly upon failure. This doesn't handle malformed links + ;; or nested square brackets well, so if it passes we back up + ;; continue with a more precise search. + (re-search-forward + (if ref + markdown-regex-link-reference + markdown-regex-link-inline) + last 'limit))) + ;; Keep searching if this is in a code block, inline code, or a + ;; comment, or if it is include syntax. The link text portion + ;; (group 3) may contain inline code or comments, but the + ;; markup, URL, and title should not be part of such elements. + (if (or (markdown-range-property-any + (match-beginning 0) (match-end 2) 'face prohibited-faces) + (markdown-range-property-any + (match-beginning 4) (match-end 0) 'face prohibited-faces) + (and (char-equal (char-after (line-beginning-position)) ?<) + (char-equal (char-after (1+ (line-beginning-position))) ?<))) + (set-match-data nil) + (setq found t)))) + ;; Match opening exclamation point (optional) and left bracket. + (when (match-beginning 2) + (let* ((bang (match-beginning 1)) + (first-begin (match-beginning 2)) + ;; Find end of block to prevent matching across blocks. + (end-of-block (save-excursion + (progn + (goto-char (match-beginning 2)) + (markdown-end-of-text-block) + (point)))) + ;; Move over balanced expressions to closing right bracket. + ;; Catch unbalanced expression errors and return nil. + (first-end (condition-case nil + (and (goto-char first-begin) + (scan-sexps (point) 1)) + (error nil))) + ;; Continue with point at CONT-POINT upon failure. + (cont-point (min (1+ first-begin) last)) + second-begin second-end url-begin url-end + title-begin title-end) + ;; When bracket found, in range, and followed by a left paren/bracket... + (when (and first-end (< first-end end-of-block) (goto-char first-end) + (char-equal (char-after (point)) (if ref ?\[ ?\())) + ;; Scan across balanced expressions for closing parenthesis/bracket. + (setq second-begin (point) + second-end (condition-case nil + (scan-sexps (point) 1) + (error nil))) + ;; Check that closing parenthesis/bracket is in range. + (if (and second-end (<= second-end end-of-block) (<= second-end last)) + (progn + ;; Search for (optional) title inside closing parenthesis + (when (and (not ref) (search-forward "\"" second-end t)) + (setq title-begin (1- (point)) + title-end (and (goto-char second-end) + (search-backward "\"" (1+ title-begin) t)) + title-end (and title-end (1+ title-end)))) + ;; Store URL/reference range + (setq url-begin (1+ second-begin) + url-end (1- (or title-begin second-end))) + ;; Set match data, move point beyond link, and return + (set-match-data + (list (or bang first-begin) second-end ; 0 - all + bang (and bang (1+ bang)) ; 1 - bang + first-begin (1+ first-begin) ; 2 - markup + (1+ first-begin) (1- first-end) ; 3 - link text + (1- first-end) first-end ; 4 - markup + second-begin (1+ second-begin) ; 5 - markup + url-begin url-end ; 6 - url/reference + title-begin title-end ; 7 - title + (1- second-end) second-end)) ; 8 - markup + ;; Nullify cont-point and leave point at end and + (setq cont-point nil) + (goto-char second-end)) + ;; If no closing parenthesis in range, update continuation point + (setq cont-point (min end-of-block second-begin)))) + (cond + ;; On failure, continue searching at cont-point + ((and cont-point (< cont-point last)) + (goto-char cont-point) + (markdown-match-generic-links last ref)) + ;; No more text, return nil + ((and cont-point (= cont-point last)) + nil) + ;; Return t if a match occurred + (t t))))) + +(defun markdown-match-angle-uris (last) + "Match angle bracket URIs from point to LAST." + (when (markdown-match-inline-generic markdown-regex-angle-uri last) + (goto-char (1+ (match-end 0))))) + +(defun markdown-match-plain-uris (last) + "Match plain URIs from point to LAST." + (when (markdown-match-inline-generic markdown-regex-uri last t) + (goto-char (1+ (match-end 0))))) + +(defvar markdown-conditional-search-function #'re-search-forward + "Conditional search function used in `markdown-search-until-condition'. +Made into a variable to allow for dynamic let-binding.") + +(defun markdown-search-until-condition (condition &rest args) + (let (ret) + (while (and (not ret) (apply markdown-conditional-search-function args)) + (setq ret (funcall condition))) + ret)) + +(defun markdown-metadata-line-p (pos regexp) + (save-excursion + (or (= (line-number-at-pos pos) 1) + (progn + (forward-line -1) + ;; skip multi-line metadata + (while (and (looking-at-p "^\\s-+[[:alpha:]]") + (> (line-number-at-pos (point)) 1)) + (forward-line -1)) + (looking-at-p regexp))))) + +(defun markdown-match-generic-metadata (regexp last) + "Match metadata declarations specified by REGEXP from point to LAST. +These declarations must appear inside a metadata block that begins at +the beginning of the buffer and ends with a blank line (or the end of +the buffer)." + (let* ((first (point)) + (end-re "\n[ \t]*\n\\|\n\\'\\|\\'") + (block-begin (goto-char 1)) + (block-end (re-search-forward end-re nil t))) + (if (and block-end (> first block-end)) + ;; Don't match declarations if there is no metadata block or if + ;; the point is beyond the block. Move point to point-max to + ;; prevent additional searches and return return nil since nothing + ;; was found. + (progn (goto-char (point-max)) nil) + ;; If a block was found that begins before LAST and ends after + ;; point, search for declarations inside it. If the starting is + ;; before the beginning of the block, start there. Otherwise, + ;; move back to FIRST. + (goto-char (if (< first block-begin) block-begin first)) + (if (and (re-search-forward regexp (min last block-end) t) + (markdown-metadata-line-p (point) regexp)) + ;; If a metadata declaration is found, set match-data and return t. + (let ((key-beginning (match-beginning 1)) + (key-end (match-end 1)) + (markup-begin (match-beginning 2)) + (markup-end (match-end 2)) + (value-beginning (match-beginning 3))) + (set-match-data (list key-beginning (point) ; complete metadata + key-beginning key-end ; key + markup-begin markup-end ; markup + value-beginning (point))) ; value + t) + ;; Otherwise, move the point to last and return nil + (goto-char last) + nil)))) + +(defun markdown-match-declarative-metadata (last) + "Match declarative metadata from the point to LAST." + (markdown-match-generic-metadata markdown-regex-declarative-metadata last)) + +(defun markdown-match-pandoc-metadata (last) + "Match Pandoc metadata from the point to LAST." + (markdown-match-generic-metadata markdown-regex-pandoc-metadata last)) + +(defun markdown-match-yaml-metadata-begin (last) + (markdown-match-propertized-text 'markdown-yaml-metadata-begin last)) + +(defun markdown-match-yaml-metadata-end (last) + (markdown-match-propertized-text 'markdown-yaml-metadata-end last)) + +(defun markdown-match-yaml-metadata-key (last) + (markdown-match-propertized-text 'markdown-metadata-key last)) + +(defun markdown-match-wiki-link (last) + "Match wiki links from point to LAST." + (when (and markdown-enable-wiki-links + (not markdown-wiki-link-fontify-missing) + (markdown-match-inline-generic markdown-regex-wiki-link last)) + (let ((begin (match-beginning 1)) (end (match-end 1))) + (if (or (markdown-in-comment-p begin) + (markdown-in-comment-p end) + (markdown-inline-code-at-pos-p begin) + (markdown-inline-code-at-pos-p end) + (markdown-code-block-at-pos begin)) + (progn (goto-char (min (1+ begin) last)) + (when (< (point) last) + (markdown-match-wiki-link last))) + (set-match-data (list begin end)) + t)))) + +(defun markdown-match-inline-attributes (last) + "Match inline attributes from point to LAST." + ;; #428 re-search-forward markdown-regex-inline-attributes is very slow. + ;; So use simple regex for re-search-forward and use markdown-regex-inline-attributes + ;; against matched string. + (when (markdown-match-inline-generic "[ \t]*\\({\\)\\([^\n]*\\)}[ \t]*$" last) + (if (not (string-match-p markdown-regex-inline-attributes (match-string 0))) + (markdown-match-inline-attributes last) + (unless (or (markdown-inline-code-at-pos-p (match-beginning 0)) + (markdown-inline-code-at-pos-p (match-end 0)) + (markdown-in-comment-p)) + t)))) + +(defun markdown-match-leanpub-sections (last) + "Match Leanpub section markers from point to LAST." + (when (markdown-match-inline-generic markdown-regex-leanpub-sections last) + (unless (or (markdown-inline-code-at-pos-p (match-beginning 0)) + (markdown-inline-code-at-pos-p (match-end 0)) + (markdown-in-comment-p)) + t))) + +(defun markdown-match-includes (last) + "Match include statements from point to LAST. +Sets match data for the following seven groups: +Group 1: opening two angle brackets +Group 2: opening title delimiter (optional) +Group 3: title text (optional) +Group 4: closing title delimiter (optional) +Group 5: opening filename delimiter +Group 6: filename +Group 7: closing filename delimiter" + (when (markdown-match-inline-generic markdown-regex-include last) + (let ((valid (not (or (markdown-in-comment-p (match-beginning 0)) + (markdown-in-comment-p (match-end 0)) + (markdown-code-block-at-pos (match-beginning 0)))))) + (cond + ;; Parentheses and maybe square brackets, but no curly braces: + ;; match optional title in square brackets and file in parentheses. + ((and valid (match-beginning 5) + (not (match-beginning 8))) + (set-match-data (list (match-beginning 1) (match-end 7) + (match-beginning 1) (match-end 1) + (match-beginning 2) (match-end 2) + (match-beginning 3) (match-end 3) + (match-beginning 4) (match-end 4) + (match-beginning 5) (match-end 5) + (match-beginning 6) (match-end 6) + (match-beginning 7) (match-end 7)))) + ;; Only square brackets present: match file in square brackets. + ((and valid (match-beginning 2) + (not (match-beginning 5)) + (not (match-beginning 7))) + (set-match-data (list (match-beginning 1) (match-end 4) + (match-beginning 1) (match-end 1) + nil nil + nil nil + nil nil + (match-beginning 2) (match-end 2) + (match-beginning 3) (match-end 3) + (match-beginning 4) (match-end 4)))) + ;; Only curly braces present: match file in curly braces. + ((and valid (match-beginning 8) + (not (match-beginning 2)) + (not (match-beginning 5))) + (set-match-data (list (match-beginning 1) (match-end 10) + (match-beginning 1) (match-end 1) + nil nil + nil nil + nil nil + (match-beginning 8) (match-end 8) + (match-beginning 9) (match-end 9) + (match-beginning 10) (match-end 10)))) + (t + ;; Not a valid match, move to next line and search again. + (forward-line) + (when (< (point) last) + (setq valid (markdown-match-includes last))))) + valid))) + +(defun markdown-match-html-tag (last) + "Match HTML tags from point to LAST." + (when (and markdown-enable-html + (markdown-match-inline-generic markdown-regex-html-tag last t)) + (set-match-data (list (match-beginning 0) (match-end 0) + (match-beginning 1) (match-end 1) + (match-beginning 2) (match-end 2) + (match-beginning 9) (match-end 9))) + t)) + + +;;; Markdown Font Fontification Functions ===================================== + +(defvar markdown--first-displayable-cache (make-hash-table :test #'equal)) + +(defun markdown--first-displayable (seq) + "Return the first displayable character or string in SEQ. +SEQ may be an atom or a sequence." + (let ((c (gethash seq markdown--first-displayable-cache t))) + (if (not (eq c t)) + c + (puthash seq + (let ((seq (if (listp seq) seq (list seq)))) + (cond ((stringp (car seq)) + (cl-find-if + (lambda (str) + (and (mapcar #'char-displayable-p (string-to-list str)))) + seq)) + ((characterp (car seq)) + (cl-find-if #'char-displayable-p seq)))) + markdown--first-displayable-cache)))) + +(defun markdown--marginalize-string (level) + "Generate atx markup string of given LEVEL for left margin." + (let ((margin-left-space-count + (- markdown-marginalize-headers-margin-width level))) + (concat (make-string margin-left-space-count ? ) + (make-string level ?#)))) + +(defun markdown-marginalize-update-current () + "Update the window configuration to create a left margin." + (if window-system + (let* ((header-delimiter-font-width + (window-font-width nil 'markdown-header-delimiter-face)) + (margin-pixel-width (* markdown-marginalize-headers-margin-width + header-delimiter-font-width)) + (margin-char-width (/ margin-pixel-width (default-font-width)))) + (set-window-margins nil margin-char-width)) + ;; As a fallback, simply set margin based on character count. + (set-window-margins nil (1+ markdown-marginalize-headers-margin-width)))) + +(defun markdown-fontify-headings (last) + "Add text properties to headings from point to LAST." + (when (markdown-match-propertized-text 'markdown-heading last) + (let* ((level (markdown-outline-level)) + (heading-face + (intern (format "markdown-header-face-%d" level))) + (heading-props `(face ,heading-face)) + (left-markup-props + `(face markdown-header-delimiter-face + ,@(cond + (markdown-hide-markup + `(display "")) + (markdown-marginalize-headers + `(display ((margin left-margin) + ,(markdown--marginalize-string level))))))) + (right-markup-props + `(face markdown-header-delimiter-face + ,@(when markdown-hide-markup `(display "")))) + (rule-props `(face markdown-header-rule-face + ,@(when markdown-hide-markup `(display ""))))) + (if (match-end 1) + ;; Setext heading + (progn (add-text-properties + (match-beginning 1) (match-end 1) heading-props) + (if (= level 1) + (add-text-properties + (match-beginning 2) (match-end 2) rule-props) + (add-text-properties + (match-beginning 3) (match-end 3) rule-props))) + ;; atx heading + (let ((header-end + (if markdown-fontify-whole-heading-line + (min (point-max) (1+ (match-end 0))) + (match-end 0)))) + (add-text-properties + (match-beginning 4) (match-end 4) left-markup-props) + + ;; If closing tag is present + (if (match-end 6) + (progn + (if markdown-hide-markup + (progn + (add-text-properties + (match-beginning 5) header-end heading-props) + (add-text-properties + (match-beginning 6) (match-end 6) right-markup-props)) + (add-text-properties + (match-beginning 5) (match-end 5) heading-props) + (add-text-properties + (match-beginning 6) header-end right-markup-props))) + ;; If closing tag is not present + (add-text-properties + (match-beginning 5) header-end heading-props)) + ))) + t)) + +(defun markdown-fontify-tables (last) + (when (re-search-forward "|" last t) + (when (markdown-table-at-point-p) + (font-lock-append-text-property + (line-beginning-position) (min (1+ (line-end-position)) (point-max)) + 'face 'markdown-table-face)) + (forward-line 1) + t)) + +(defun markdown-fontify-blockquotes (last) + "Apply font-lock properties to blockquotes from point to LAST." + (when (markdown-match-blockquotes last) + (let ((display-string + (markdown--first-displayable markdown-blockquote-display-char))) + (add-text-properties + (match-beginning 1) (match-end 1) + (if markdown-hide-markup + `(face markdown-blockquote-face display ,display-string) + `(face markdown-markup-face))) + (font-lock-append-text-property + (match-beginning 0) (match-end 0) 'face 'markdown-blockquote-face) + t))) + +(defun markdown-fontify-list-items (last) + "Apply font-lock properties to list markers from point to LAST." + (when (markdown-match-list-items last) + (when (not (markdown-code-block-at-point-p (match-beginning 2))) + (let* ((indent (length (match-string-no-properties 1))) + (level (/ indent markdown-list-indent-width)) ;; level = 0, 1, 2, ... + (bullet (nth (mod level (length markdown-list-item-bullets)) + markdown-list-item-bullets))) + (add-text-properties + (match-beginning 2) (match-end 2) '(face markdown-list-face)) + (when markdown-hide-markup + (cond + ;; Unordered lists + ((string-match-p "[\\*\\+-]" (match-string 2)) + (add-text-properties + (match-beginning 2) (match-end 2) `(display ,bullet))) + ;; Definition lists + ((string-equal ":" (match-string 2)) + (let ((display-string + (char-to-string (markdown--first-displayable + markdown-definition-display-char)))) + (add-text-properties (match-beginning 2) (match-end 2) + `(display ,display-string)))))))) + t)) + +(defun markdown--fontify-hrs-view-mode (hr-char) + (if (and hr-char (display-supports-face-attributes-p '(:extend t))) + (add-text-properties + (match-beginning 0) (match-end 0) + `(face + (:inherit markdown-hr-face :underline t :extend t) + font-lock-multiline t + display "\n")) + (let ((hr-len (and hr-char (/ (1- (window-body-width)) (char-width hr-char))))) + (add-text-properties + (match-beginning 0) (match-end 0) + `(face + markdown-hr-face font-lock-multiline t + display ,(make-string hr-len hr-char)))))) + +(defun markdown-fontify-hrs (last) + "Add text properties to horizontal rules from point to LAST." + (when (markdown-match-hr last) + (let ((hr-char (markdown--first-displayable markdown-hr-display-char))) + (if (and markdown-hide-markup hr-char) + (markdown--fontify-hrs-view-mode hr-char) + (add-text-properties + (match-beginning 0) (match-end 0) + `(face markdown-hr-face font-lock-multiline t))) + t))) + +(defun markdown-fontify-sub-superscripts (last) + "Apply text properties to sub- and superscripts from point to LAST." + (when (markdown-search-until-condition + (lambda () (and (not (markdown-code-block-at-point-p)) + (not (markdown-inline-code-at-point-p)) + (not (markdown-in-comment-p)) + (not (markdown--math-block-p)))) + markdown-regex-sub-superscript last t) + (let* ((subscript-p (string= (match-string 2) "~")) + (props + (if subscript-p + (car markdown-sub-superscript-display) + (cdr markdown-sub-superscript-display))) + (mp (list 'face 'markdown-markup-face + 'invisible 'markdown-markup))) + (when markdown-hide-markup + (put-text-property (match-beginning 3) (match-end 3) + 'display props)) + (add-text-properties (match-beginning 2) (match-end 2) mp) + (add-text-properties (match-beginning 4) (match-end 4) mp) + t))) + + +;;; Syntax Table ============================================================== + +(defvar markdown-mode-syntax-table + (let ((tab (make-syntax-table text-mode-syntax-table))) + (modify-syntax-entry ?\" "." tab) + tab) + "Syntax table for `markdown-mode'.") + + +;;; Element Insertion ========================================================= + +(defun markdown-ensure-blank-line-before () + "If previous line is not already blank, insert a blank line before point." + (unless (bolp) (insert "\n")) + (unless (or (bobp) (looking-back "\n\\s-*\n" nil)) (insert "\n"))) + +(defun markdown-ensure-blank-line-after () + "If following line is not already blank, insert a blank line after point. +Return the point where it was originally." + (save-excursion + (unless (eolp) (insert "\n")) + (unless (or (eobp) (looking-at-p "\n\\s-*\n")) (insert "\n")))) + +(defun markdown-wrap-or-insert (s1 s2 &optional thing beg end) + "Insert the strings S1 and S2, wrapping around region or THING. +If a region is specified by the optional BEG and END arguments, +wrap the strings S1 and S2 around that region. +If there is an active region, wrap the strings S1 and S2 around +the region. If there is not an active region but the point is at +THING, wrap that thing (which defaults to word). Otherwise, just +insert S1 and S2 and place the point in between. Return the +bounds of the entire wrapped string, or nil if nothing was wrapped +and S1 and S2 were only inserted." + (let (a b bounds new-point) + (cond + ;; Given region + ((and beg end) + (setq a beg + b end + new-point (+ (point) (length s1)))) + ;; Active region + ((use-region-p) + (setq a (region-beginning) + b (region-end) + new-point (+ (point) (length s1)))) + ;; Thing (word) at point + ((setq bounds (markdown-bounds-of-thing-at-point (or thing 'word))) + (setq a (car bounds) + b (cdr bounds) + new-point (+ (point) (length s1)))) + ;; No active region and no word + (t + (setq a (point) + b (point)))) + (goto-char b) + (insert s2) + (goto-char a) + (insert s1) + (when new-point (goto-char new-point)) + (if (= a b) + nil + (setq b (+ b (length s1) (length s2))) + (cons a b)))) + +(defun markdown-point-after-unwrap (cur prefix suffix) + "Return desired position of point after an unwrapping operation. +CUR gives the position of the point before the operation. +Additionally, two cons cells must be provided. PREFIX gives the +bounds of the prefix string and SUFFIX gives the bounds of the +suffix string." + (cond ((< cur (cdr prefix)) (car prefix)) + ((< cur (car suffix)) (- cur (- (cdr prefix) (car prefix)))) + ((<= cur (cdr suffix)) + (- cur (+ (- (cdr prefix) (car prefix)) + (- cur (car suffix))))) + (t cur))) + +(defun markdown-unwrap-thing-at-point (regexp all text) + "Remove prefix and suffix of thing at point and reposition the point. +When the thing at point matches REGEXP, replace the subexpression +ALL with the string in subexpression TEXT. Reposition the point +in an appropriate location accounting for the removal of prefix +and suffix strings. Return new bounds of string from group TEXT. +When REGEXP is nil, assumes match data is already set." + (when (or (null regexp) + (thing-at-point-looking-at regexp)) + (let ((cur (point)) + (prefix (cons (match-beginning all) (match-beginning text))) + (suffix (cons (match-end text) (match-end all))) + (bounds (cons (match-beginning text) (match-end text)))) + ;; Replace the thing at point + (replace-match (match-string text) t t nil all) + ;; Reposition the point + (goto-char (markdown-point-after-unwrap cur prefix suffix)) + ;; Adjust bounds + (setq bounds (cons (car prefix) + (- (cdr bounds) (- (cdr prefix) (car prefix)))))))) + +(defun markdown-unwrap-things-in-region (beg end regexp all text) + "Remove prefix and suffix of all things in region from BEG to END. +When a thing in the region matches REGEXP, replace the +subexpression ALL with the string in subexpression TEXT. +Return a cons cell containing updated bounds for the region." + (save-excursion + (goto-char beg) + (let ((removed 0) len-all len-text) + (while (re-search-forward regexp (- end removed) t) + (setq len-all (length (match-string-no-properties all))) + (setq len-text (length (match-string-no-properties text))) + (setq removed (+ removed (- len-all len-text))) + (replace-match (match-string text) t t nil all)) + (cons beg (- end removed))))) + +(defun markdown-insert-hr (arg) + "Insert or replace a horizontal rule. +By default, use the first element of `markdown-hr-strings'. When +ARG is non-nil, as when given a prefix, select a different +element as follows. When prefixed with \\[universal-argument], +use the last element of `markdown-hr-strings' instead. When +prefixed with an integer from 1 to the length of +`markdown-hr-strings', use the element in that position instead." + (interactive "*P") + (when (thing-at-point-looking-at markdown-regex-hr) + (delete-region (match-beginning 0) (match-end 0))) + (markdown-ensure-blank-line-before) + (cond ((equal arg '(4)) + (insert (car (reverse markdown-hr-strings)))) + ((and (integerp arg) (> arg 0) + (<= arg (length markdown-hr-strings))) + (insert (nth (1- arg) markdown-hr-strings))) + (t + (insert (car markdown-hr-strings)))) + (markdown-ensure-blank-line-after)) + +(defun markdown--insert-common (start-delim end-delim regex start-group end-group face + &optional skip-space) + (if (use-region-p) + ;; Active region + (let* ((bounds (markdown-unwrap-things-in-region + (region-beginning) (region-end) + regex start-group end-group)) + (beg (car bounds)) + (end (cdr bounds))) + (when (and beg skip-space) + (save-excursion + (goto-char beg) + (skip-chars-forward "[ \t]") + (setq beg (point)))) + (when (and end skip-space) + (save-excursion + (goto-char end) + (skip-chars-backward "[ \t]") + (setq end (point)))) + (markdown-wrap-or-insert start-delim end-delim nil beg end)) + (if (markdown--face-p (point) (list face)) + (save-excursion + (while (and (markdown--face-p (point) (list face)) (not (bobp))) + (forward-char -1)) + (forward-char (- (1- (length start-delim)))) ;; for delimiter + (unless (bolp) + (forward-char -1)) + (when (looking-at regex) + (markdown-unwrap-thing-at-point nil start-group end-group))) + (if (thing-at-point-looking-at regex) + (markdown-unwrap-thing-at-point nil start-group end-group) + (markdown-wrap-or-insert start-delim end-delim 'word nil nil))))) + +(defun markdown-insert-bold () + "Insert markup to make a region or word bold. +If there is an active region, make the region bold. If the point +is at a non-bold word, make the word bold. If the point is at a +bold word or phrase, remove the bold markup. Otherwise, simply +insert bold delimiters and place the point in between them." + (interactive) + (let ((delim (if markdown-bold-underscore "__" "**"))) + (markdown--insert-common delim delim markdown-regex-bold 2 4 'markdown-bold-face t))) + +(defun markdown-insert-italic () + "Insert markup to make a region or word italic. +If there is an active region, make the region italic. If the point +is at a non-italic word, make the word italic. If the point is at an +italic word or phrase, remove the italic markup. Otherwise, simply +insert italic delimiters and place the point in between them." + (interactive) + (let ((delim (if markdown-italic-underscore "_" "*"))) + (markdown--insert-common delim delim markdown-regex-italic 1 3 'markdown-italic-face t))) + +(defun markdown-insert-strike-through () + "Insert markup to make a region or word strikethrough. +If there is an active region, make the region strikethrough. If the point +is at a non-bold word, make the word strikethrough. If the point is at a +strikethrough word or phrase, remove the strikethrough markup. Otherwise, +simply insert bold delimiters and place the point in between them." + (interactive) + (markdown--insert-common + "~~" "~~" markdown-regex-strike-through 2 4 'markdown-strike-through-face t)) + +(defun markdown-insert-code () + "Insert markup to make a region or word an inline code fragment. +If there is an active region, make the region an inline code +fragment. If the point is at a word, make the word an inline +code fragment. Otherwise, simply insert code delimiters and +place the point in between them." + (interactive) + (if (use-region-p) + ;; Active region + (let ((bounds (markdown-unwrap-things-in-region + (region-beginning) (region-end) + markdown-regex-code 1 3))) + (markdown-wrap-or-insert "`" "`" nil (car bounds) (cdr bounds))) + ;; Code markup removal, code markup for word, or empty markup insertion + (if (markdown-inline-code-at-point) + (markdown-unwrap-thing-at-point nil 0 2) + (markdown-wrap-or-insert "`" "`" 'word nil nil)))) + +(defun markdown-insert-kbd () + "Insert markup to wrap region or word in <kbd> tags. +If there is an active region, use the region. If the point is at +a word, use the word. Otherwise, simply insert <kbd> tags and +place the point in between them." + (interactive) + (if (use-region-p) + ;; Active region + (let ((bounds (markdown-unwrap-things-in-region + (region-beginning) (region-end) + markdown-regex-kbd 0 2))) + (markdown-wrap-or-insert "<kbd>" "</kbd>" nil (car bounds) (cdr bounds))) + ;; Markup removal, markup for word, or empty markup insertion + (if (thing-at-point-looking-at markdown-regex-kbd) + (markdown-unwrap-thing-at-point nil 0 2) + (markdown-wrap-or-insert "<kbd>" "</kbd>" 'word nil nil)))) + +(defun markdown-insert-inline-link (text url &optional title) + "Insert an inline link with TEXT pointing to URL. +Optionally, the user can provide a TITLE." + (let ((cur (point))) + (setq title (and title (concat " \"" title "\""))) + (insert (concat "[" text "](" url title ")")) + (cond ((not text) (goto-char (+ 1 cur))) + ((not url) (goto-char (+ 3 (length text) cur)))))) + +(defun markdown-insert-inline-image (text url &optional title) + "Insert an inline link with alt TEXT pointing to URL. +Optionally, also provide a TITLE." + (let ((cur (point))) + (setq title (and title (concat " \"" title "\""))) + (insert (concat "![" text "](" url title ")")) + (cond ((not text) (goto-char (+ 2 cur))) + ((not url) (goto-char (+ 4 (length text) cur)))))) + +(defun markdown-insert-reference-link (text label &optional url title) + "Insert a reference link and, optionally, a reference definition. +The link TEXT will be inserted followed by the optional LABEL. +If a URL is given, also insert a definition for the reference +LABEL according to `markdown-reference-location'. If a TITLE is +given, it will be added to the end of the reference definition +and will be used to populate the title attribute when converted +to XHTML. If URL is nil, insert only the link portion (for +example, when a reference label is already defined)." + (insert (concat "[" text "][" label "]")) + (when url + (markdown-insert-reference-definition + (if (string-equal label "") text label) + url title))) + +(defun markdown-insert-reference-image (text label &optional url title) + "Insert a reference image and, optionally, a reference definition. +The alt TEXT will be inserted followed by the optional LABEL. +If a URL is given, also insert a definition for the reference +LABEL according to `markdown-reference-location'. If a TITLE is +given, it will be added to the end of the reference definition +and will be used to populate the title attribute when converted +to XHTML. If URL is nil, insert only the link portion (for +example, when a reference label is already defined)." + (insert (concat "![" text "][" label "]")) + (when url + (markdown-insert-reference-definition + (if (string-equal label "") text label) + url title))) + +(defun markdown-insert-reference-definition (label &optional url title) + "Add definition for reference LABEL with URL and TITLE. +LABEL is a Markdown reference label without square brackets. +URL and TITLE are optional. When given, the TITLE will +be used to populate the title attribute when converted to XHTML." + ;; END specifies where to leave the point upon return + (let ((end (point))) + (cl-case markdown-reference-location + (end (goto-char (point-max))) + (immediately (markdown-end-of-text-block)) + (subtree (markdown-end-of-subtree)) + (header (markdown-end-of-defun))) + ;; Skip backwards over local variables. This logic is similar to the one + ;; used in ‘hack-local-variables’. + (when (and enable-local-variables (eobp)) + (search-backward "\n\f" (max (- (point) 3000) (point-min)) :move) + (when (let ((case-fold-search t)) + (search-forward "Local Variables:" nil :move)) + (beginning-of-line 0) + (when (eq (char-before) ?\n) (backward-char)))) + (unless (or (markdown-cur-line-blank-p) + (thing-at-point-looking-at markdown-regex-reference-definition)) + (insert "\n")) + (insert "\n[" label "]: ") + (if url + (insert url) + ;; When no URL is given, leave point at END following the colon + (setq end (point))) + (when (> (length title) 0) + (insert " \"" title "\"")) + (unless (looking-at-p "\n") + (insert "\n")) + (goto-char end) + (when url + (message + (markdown--substitute-command-keys + "Reference [%s] was defined, press \\[markdown-do] to jump there") + label)))) + +(defcustom markdown-link-make-text-function nil + "Function that automatically generates a link text for a URL. + +If non-nil, this function will be called by +`markdown--insert-link-or-image' and the result will be the +default link text. The function should receive exactly one +argument that corresponds to the link URL." + :group 'markdown + :type 'function + :package-version '(markdown-mode . "2.5")) + +(defcustom markdown-disable-tooltip-prompt nil + "Disable prompt for tooltip when inserting a link or image. + +If non-nil, `markdown-insert-link' and `markdown-insert-link' +will not prompt the user to insert a tooltip text for the given +link or image." + :group 'markdown + :type 'boolean + :safe 'booleanp + :package-version '(markdown-mode . "2.5")) + +(defun markdown--insert-link-or-image (image) + "Interactively insert new or update an existing link or image. +When IMAGE is non-nil, insert an image. Otherwise, insert a link. +This is an internal function called by +`markdown-insert-link' and `markdown-insert-image'." + (cl-multiple-value-bind (begin end text uri ref title) + (if (use-region-p) + ;; Use region as either link text or URL as appropriate. + (let ((region (buffer-substring-no-properties + (region-beginning) (region-end)))) + (if (string-match markdown-regex-uri region) + ;; Region contains a URL; use it as such. + (list (region-beginning) (region-end) + nil (match-string 0 region) nil nil) + ;; Region doesn't contain a URL, so use it as text. + (list (region-beginning) (region-end) + region nil nil nil))) + ;; Extract and use properties of existing link, if any. + (markdown-link-at-pos (point))) + (let* ((ref (when ref (concat "[" ref "]"))) + (defined-refs (mapcar #'car (markdown-get-defined-references))) + (defined-ref-cands (mapcar (lambda (ref) (concat "[" ref "]")) defined-refs)) + (used-uris (markdown-get-used-uris)) + (uri-or-ref (completing-read + "URL or [reference]: " + (append defined-ref-cands used-uris) + nil nil (or uri ref))) + (ref (cond ((string-match "\\`\\[\\(.*\\)\\]\\'" uri-or-ref) + (match-string 1 uri-or-ref)) + ((string-equal "" uri-or-ref) + ""))) + (uri (unless ref uri-or-ref)) + (text-prompt (if image + "Alt text: " + (if ref + "Link text: " + "Link text (blank for plain URL): "))) + (text (or text (and markdown-link-make-text-function uri + (funcall markdown-link-make-text-function uri)))) + (text (completing-read text-prompt defined-refs nil nil text)) + (text (if (= (length text) 0) nil text)) + (plainp (and uri (not text))) + (implicitp (string-equal ref "")) + (ref (if implicitp text ref)) + (definedp (and ref (markdown-reference-definition ref))) + (ref-url (unless (or uri definedp) + (completing-read "Reference URL: " used-uris))) + (title (unless (or plainp definedp markdown-disable-tooltip-prompt) + (read-string "Title (tooltip text, optional): " title))) + (title (if (= (length title) 0) nil title))) + (when (and image implicitp) + (user-error "Reference required: implicit image references are invalid")) + (when (and begin end) + (delete-region begin end)) + (cond + ((and (not image) uri text) + (markdown-insert-inline-link text uri title)) + ((and image uri text) + (markdown-insert-inline-image text uri title)) + ((and ref text) + (if image + (markdown-insert-reference-image text (unless implicitp ref) nil title) + (markdown-insert-reference-link text (unless implicitp ref) nil title)) + (unless definedp + (markdown-insert-reference-definition ref ref-url title))) + ((and (not image) uri) + (markdown-insert-uri uri)))))) + +(defun markdown-insert-link () + "Insert new or update an existing link, with interactive prompt. +If the point is at an existing link or URL, update the link text, +URL, reference label, and/or title. Otherwise, insert a new link. +The type of link inserted (inline, reference, or plain URL) +depends on which values are provided: + +* If a URL and TEXT are given, insert an inline link: [TEXT](URL). +* If [REF] and TEXT are given, insert a reference link: [TEXT][REF]. +* If only TEXT is given, insert an implicit reference link: [TEXT][]. +* If only a URL is given, insert a plain link: <URL>. + +In other words, to create an implicit reference link, leave the +URL prompt empty and to create a plain URL link, leave the link +text empty. + +If there is an active region, use the text as the default URL, if +it seems to be a URL, or link text value otherwise. + +If a given reference is not defined, this function will +additionally prompt for the URL and optional title. In this case, +the reference definition is placed at the location determined by +`markdown-reference-location'. In addition, it is possible to +have the `markdown-link-make-text-function' function, if non-nil, +define the default link text before prompting the user for it. + +If `markdown-disable-tooltip-prompt' is non-nil, the user will +not be prompted to add or modify a tooltip text. + +Through updating the link, this function can be used to convert a +link of one type (inline, reference, or plain) to another type by +selectively adding or removing information via the prompts." + (interactive) + (markdown--insert-link-or-image nil)) + +(defun markdown-insert-image () + "Insert new or update an existing image, with interactive prompt. +If the point is at an existing image, update the alt text, URL, +reference label, and/or title. Otherwise, insert a new image. +The type of image inserted (inline or reference) depends on which +values are provided: + +* If a URL and ALT-TEXT are given, insert an inline image: + ![ALT-TEXT](URL). +* If [REF] and ALT-TEXT are given, insert a reference image: + ![ALT-TEXT][REF]. + +If there is an active region, use the text as the default URL, if +it seems to be a URL, or alt text value otherwise. + +If a given reference is not defined, this function will +additionally prompt for the URL and optional title. In this case, +the reference definition is placed at the location determined by +`markdown-reference-location'. + +Through updating the image, this function can be used to convert an +image of one type (inline or reference) to another type by +selectively adding or removing information via the prompts." + (interactive) + (markdown--insert-link-or-image t)) + +(defun markdown-insert-uri (&optional uri) + "Insert markup for an inline URI. +If there is an active region, use it as the URI. If the point is +at a URI, wrap it with angle brackets. If the point is at an +inline URI, remove the angle brackets. Otherwise, simply insert +angle brackets place the point between them." + (interactive) + (if (use-region-p) + ;; Active region + (let ((bounds (markdown-unwrap-things-in-region + (region-beginning) (region-end) + markdown-regex-angle-uri 0 2))) + (markdown-wrap-or-insert "<" ">" nil (car bounds) (cdr bounds))) + ;; Markup removal, URI at point, new URI, or empty markup insertion + (if (thing-at-point-looking-at markdown-regex-angle-uri) + (markdown-unwrap-thing-at-point nil 0 2) + (if uri + (insert "<" uri ">") + (markdown-wrap-or-insert "<" ">" 'url nil nil))))) + +(defun markdown-insert-wiki-link () + "Insert a wiki link of the form [[WikiLink]]. +If there is an active region, use the region as the link text. +If the point is at a word, use the word as the link text. If +there is no active region and the point is not at word, simply +insert link markup." + (interactive) + (if (use-region-p) + ;; Active region + (markdown-wrap-or-insert "[[" "]]" nil (region-beginning) (region-end)) + ;; Markup removal, wiki link at at point, or empty markup insertion + (if (thing-at-point-looking-at markdown-regex-wiki-link) + (if (or markdown-wiki-link-alias-first + (null (match-string 5))) + (markdown-unwrap-thing-at-point nil 1 3) + (markdown-unwrap-thing-at-point nil 1 5)) + (markdown-wrap-or-insert "[[" "]]")))) + +(defun markdown-remove-header () + "Remove header markup if point is at a header. +Return bounds of remaining header text if a header was removed +and nil otherwise." + (interactive "*") + (or (markdown-unwrap-thing-at-point markdown-regex-header-atx 0 2) + (markdown-unwrap-thing-at-point markdown-regex-header-setext 0 1))) + +(defun markdown-insert-header (&optional level text setext) + "Insert or replace header markup. +The level of the header is specified by LEVEL and header text is +given by TEXT. LEVEL must be an integer from 1 and 6, and the +default value is 1. +When TEXT is nil, the header text is obtained as follows. +If there is an active region, it is used as the header text. +Otherwise, the current line will be used as the header text. +If there is not an active region and the point is at a header, +remove the header markup and replace with level N header. +Otherwise, insert empty header markup and place the point in +between. +The style of the header will be atx (hash marks) unless +SETEXT is non-nil, in which case a setext-style (underlined) +header will be inserted." + (interactive "p\nsHeader text: ") + (setq level (min (max (or level 1) 1) (if setext 2 6))) + ;; Determine header text if not given + (when (null text) + (if (use-region-p) + ;; Active region + (setq text (delete-and-extract-region (region-beginning) (region-end))) + ;; No active region + (markdown-remove-header) + (setq text (delete-and-extract-region + (line-beginning-position) (line-end-position))) + (when (and setext (string-match-p "^[ \t]*$" text)) + (setq text (read-string "Header text: ")))) + (setq text (markdown-compress-whitespace-string text))) + ;; Insertion with given text + (markdown-ensure-blank-line-before) + (let (hdr) + (cond (setext + (setq hdr (make-string (string-width text) (if (= level 2) ?- ?=))) + (insert text "\n" hdr)) + (t + (setq hdr (make-string level ?#)) + (insert hdr " " text) + (when (null markdown-asymmetric-header) (insert " " hdr))))) + (markdown-ensure-blank-line-after) + ;; Leave point at end of text + (cond (setext + (backward-char (1+ (string-width text)))) + ((null markdown-asymmetric-header) + (backward-char (1+ level))))) + +(defun markdown-insert-header-dwim (&optional arg setext) + "Insert or replace header markup. +The level and type of the header are determined automatically by +the type and level of the previous header, unless a prefix +argument is given via ARG. +With a numeric prefix valued 1 to 6, insert a header of the given +level, with the type being determined automatically (note that +only level 1 or 2 setext headers are possible). + +With a \\[universal-argument] prefix (i.e., when ARG is (4)), +promote the heading by one level. +With two \\[universal-argument] prefixes (i.e., when ARG is (16)), +demote the heading by one level. +When SETEXT is non-nil, prefer setext-style headers when +possible (levels one and two). + +When there is an active region, use it for the header text. When +the point is at an existing header, change the type and level +according to the rules above. +Otherwise, if the line is not empty, create a header using the +text on the current line as the header text. +Finally, if the point is on a blank line, insert empty header +markup (atx) or prompt for text (setext). +See `markdown-insert-header' for more details about how the +header text is determined." + (interactive "*P") + (let (level) + (save-excursion + (when (or (thing-at-point-looking-at markdown-regex-header) + (re-search-backward markdown-regex-header nil t)) + ;; level of current or previous header + (setq level (markdown-outline-level)) + ;; match group 1 indicates a setext header + (setq setext (match-end 1)))) + ;; check prefix argument + (cond + ((and (equal arg '(4)) level (> level 1)) ;; C-u + (cl-decf level)) + ((and (equal arg '(16)) level (< level 6)) ;; C-u C-u + (cl-incf level)) + (arg ;; numeric prefix + (setq level (prefix-numeric-value arg)))) + ;; setext headers must be level one or two + (and level (setq setext (and setext (<= level 2)))) + ;; insert the heading + (markdown-insert-header level nil setext))) + +(defun markdown-insert-header-setext-dwim (&optional arg) + "Insert or replace header markup, with preference for setext. +See `markdown-insert-header-dwim' for details, including how ARG is handled." + (interactive "*P") + (markdown-insert-header-dwim arg t)) + +(defun markdown-insert-header-atx-1 () + "Insert a first level atx-style (hash mark) header. +See `markdown-insert-header'." + (interactive "*") + (markdown-insert-header 1 nil nil)) + +(defun markdown-insert-header-atx-2 () + "Insert a level two atx-style (hash mark) header. +See `markdown-insert-header'." + (interactive "*") + (markdown-insert-header 2 nil nil)) + +(defun markdown-insert-header-atx-3 () + "Insert a level three atx-style (hash mark) header. +See `markdown-insert-header'." + (interactive "*") + (markdown-insert-header 3 nil nil)) + +(defun markdown-insert-header-atx-4 () + "Insert a level four atx-style (hash mark) header. +See `markdown-insert-header'." + (interactive "*") + (markdown-insert-header 4 nil nil)) + +(defun markdown-insert-header-atx-5 () + "Insert a level five atx-style (hash mark) header. +See `markdown-insert-header'." + (interactive "*") + (markdown-insert-header 5 nil nil)) + +(defun markdown-insert-header-atx-6 () + "Insert a sixth level atx-style (hash mark) header. +See `markdown-insert-header'." + (interactive "*") + (markdown-insert-header 6 nil nil)) + +(defun markdown-insert-header-setext-1 () + "Insert a setext-style (underlined) first-level header. +See `markdown-insert-header'." + (interactive "*") + (markdown-insert-header 1 nil t)) + +(defun markdown-insert-header-setext-2 () + "Insert a setext-style (underlined) second-level header. +See `markdown-insert-header'." + (interactive "*") + (markdown-insert-header 2 nil t)) + +(defun markdown-blockquote-indentation (loc) + "Return string containing necessary indentation for a blockquote at LOC. +Also see `markdown-pre-indentation'." + (save-excursion + (goto-char loc) + (let* ((list-level (length (markdown-calculate-list-levels))) + (indent "")) + (dotimes (_ list-level indent) + (setq indent (concat indent " ")))))) + +(defun markdown-insert-blockquote () + "Start a blockquote section (or blockquote the region). +If Transient Mark mode is on and a region is active, it is used as +the blockquote text." + (interactive) + (if (use-region-p) + (markdown-blockquote-region (region-beginning) (region-end)) + (markdown-ensure-blank-line-before) + (insert (markdown-blockquote-indentation (point)) "> ") + (markdown-ensure-blank-line-after))) + +(defun markdown-block-region (beg end prefix) + "Format the region using a block prefix. +Arguments BEG and END specify the beginning and end of the +region. The characters PREFIX will appear at the beginning +of each line." + (save-excursion + (let* ((end-marker (make-marker)) + (beg-marker (make-marker)) + (prefix-without-trailing-whitespace + (replace-regexp-in-string (rx (+ blank) eos) "" prefix))) + ;; Ensure blank line after and remove extra whitespace + (goto-char end) + (skip-syntax-backward "-") + (set-marker end-marker (point)) + (delete-horizontal-space) + (markdown-ensure-blank-line-after) + ;; Ensure blank line before and remove extra whitespace + (goto-char beg) + (skip-syntax-forward "-") + (delete-horizontal-space) + (markdown-ensure-blank-line-before) + (set-marker beg-marker (point)) + ;; Insert PREFIX before each line + (goto-char beg-marker) + (while (and (< (line-beginning-position) end-marker) + (not (eobp))) + ;; Don’t insert trailing whitespace. + (insert (if (eolp) prefix-without-trailing-whitespace prefix)) + (forward-line))))) + +(defun markdown-blockquote-region (beg end) + "Blockquote the region. +Arguments BEG and END specify the beginning and end of the region." + (interactive "*r") + (markdown-block-region + beg end (concat (markdown-blockquote-indentation + (max (point-min) (1- beg))) "> "))) + +(defun markdown-pre-indentation (loc) + "Return string containing necessary whitespace for a pre block at LOC. +Also see `markdown-blockquote-indentation'." + (save-excursion + (goto-char loc) + (let* ((list-level (length (markdown-calculate-list-levels))) + indent) + (dotimes (_ (1+ list-level) indent) + (setq indent (concat indent " ")))))) + +(defun markdown-insert-pre () + "Start a preformatted section (or apply to the region). +If Transient Mark mode is on and a region is active, it is marked +as preformatted text." + (interactive) + (if (use-region-p) + (markdown-pre-region (region-beginning) (region-end)) + (markdown-ensure-blank-line-before) + (insert (markdown-pre-indentation (point))) + (markdown-ensure-blank-line-after))) + +(defun markdown-pre-region (beg end) + "Format the region as preformatted text. +Arguments BEG and END specify the beginning and end of the region." + (interactive "*r") + (let ((indent (markdown-pre-indentation (max (point-min) (1- beg))))) + (markdown-block-region beg end indent))) + +(defun markdown-electric-backquote (arg) + "Insert a backquote. +The numeric prefix argument ARG says how many times to repeat the insertion. +Call `markdown-insert-gfm-code-block' interactively +if three backquotes inserted at the beginning of line." + (interactive "*P") + (self-insert-command (prefix-numeric-value arg)) + (when (and markdown-gfm-use-electric-backquote (looking-back "^```" nil)) + (replace-match "") + (call-interactively #'markdown-insert-gfm-code-block))) + +(defconst markdown-gfm-recognized-languages + ;; To reproduce/update, evaluate the let-form in + ;; scripts/get-recognized-gfm-languages.el. that produces a single long sexp, + ;; but with appropriate use of a keyboard macro, indenting and filling it + ;; properly is pretty fast. + '("1C-Enterprise" "2-Dimensional-Array" "4D" "ABAP" "ABAP-CDS" "ABNF" + "AGS-Script" "AIDL" "AL" "AMPL" "ANTLR" "API-Blueprint" "APL" "ASL" + "ASN.1" "ASP.NET" "ATS" "ActionScript" "Ada" "Adblock-Filter-List" + "Adobe-Font-Metrics" "Agda" "Alloy" "Alpine-Abuild" "Altium-Designer" + "AngelScript" "Ant-Build-System" "Antlers" "ApacheConf" "Apex" + "Apollo-Guidance-Computer" "AppleScript" "Arc" "AsciiDoc" "AspectJ" + "Assembly" "Astro" "Asymptote" "Augeas" "AutoHotkey" "AutoIt" + "Avro-IDL" "Awk" "BASIC" "Ballerina" "Batchfile" "Beef" "Befunge" + "Berry" "BibTeX" "Bicep" "Bikeshed" "Bison" "BitBake" "Blade" + "BlitzBasic" "BlitzMax" "Bluespec" "Bluespec-BH" "Boo" "Boogie" + "Brainfuck" "BrighterScript" "Brightscript" "Browserslist" "C" "C#" + "C++" "C-ObjDump" "C2hs-Haskell" "CAP-CDS" "CIL" "CLIPS" "CMake" + "COBOL" "CODEOWNERS" "COLLADA" "CSON" "CSS" "CSV" "CUE" "CWeb" + "Cabal-Config" "Cadence" "Cairo" "CameLIGO" "Cap'n-Proto" "CartoCSS" + "Ceylon" "Chapel" "Charity" "Checksums" "ChucK" "Circom" "Cirru" + "Clarion" "Clarity" "Classic-ASP" "Clean" "Click" "Clojure" + "Closure-Templates" "Cloud-Firestore-Security-Rules" "CoNLL-U" + "CodeQL" "CoffeeScript" "ColdFusion" "ColdFusion-CFC" "Common-Lisp" + "Common-Workflow-Language" "Component-Pascal" "Cool" "Coq" + "Cpp-ObjDump" "Creole" "Crystal" "Csound" "Csound-Document" + "Csound-Score" "Cuda" "Cue-Sheet" "Curry" "Cycript" "Cypher" "Cython" + "D" "D-ObjDump" "D2" "DIGITAL-Command-Language" "DM" "DNS-Zone" + "DTrace" "Dafny" "Darcs-Patch" "Dart" "DataWeave" + "Debian-Package-Control-File" "DenizenScript" "Dhall" "Diff" + "DirectX-3D-File" "Dockerfile" "Dogescript" "Dotenv" "Dylan" "E" + "E-mail" "EBNF" "ECL" "ECLiPSe" "EJS" "EQ" "Eagle" "Earthly" + "Easybuild" "Ecere-Projects" "Ecmarkup" "Edge" "EdgeQL" + "EditorConfig" "Edje-Data-Collection" "Eiffel" "Elixir" "Elm" + "Elvish" "Elvish-Transcript" "Emacs-Lisp" "EmberScript" "Erlang" + "Euphoria" "F#" "F*" "FIGlet-Font" "FLUX" "Factor" "Fancy" "Fantom" + "Faust" "Fennel" "Filebench-WML" "Filterscript" "Fluent" "Formatted" + "Forth" "Fortran" "Fortran-Free-Form" "FreeBasic" "FreeMarker" + "Frege" "Futhark" "G-code" "GAML" "GAMS" "GAP" + "GCC-Machine-Description" "GDB" "GDScript" "GEDCOM" "GLSL" "GN" "GSC" + "Game-Maker-Language" "Gemfile.lock" "Gemini" "Genero-4gl" + "Genero-per" "Genie" "Genshi" "Gentoo-Ebuild" "Gentoo-Eclass" + "Gerber-Image" "Gettext-Catalog" "Gherkin" "Git-Attributes" + "Git-Config" "Git-Revision-List" "Gleam" "Glimmer-JS" "Glimmer-TS" + "Glyph" "Glyph-Bitmap-Distribution-Format" "Gnuplot" "Go" + "Go-Checksums" "Go-Module" "Go-Workspace" "Godot-Resource" "Golo" + "Gosu" "Grace" "Gradle" "Gradle-Kotlin-DSL" "Grammatical-Framework" + "Graph-Modeling-Language" "GraphQL" "Graphviz-(DOT)" "Groovy" + "Groovy-Server-Pages" "HAProxy" "HCL" "HLSL" "HOCON" "HTML" + "HTML+ECR" "HTML+EEX" "HTML+ERB" "HTML+PHP" "HTML+Razor" "HTTP" + "HXML" "Hack" "Haml" "Handlebars" "Harbour" "Haskell" "Haxe" "HiveQL" + "HolyC" "Hosts-File" "Hy" "HyPhy" "IDL" "IGOR-Pro" "INI" "IRC-log" + "Idris" "Ignore-List" "ImageJ-Macro" "Imba" "Inform-7" "Ink" + "Inno-Setup" "Io" "Ioke" "Isabelle" "Isabelle-ROOT" "J" + "JAR-Manifest" "JCL" "JFlex" "JSON" "JSON-with-Comments" "JSON5" + "JSONLD" "JSONiq" "Janet" "Jasmin" "Java" "Java-Properties" + "Java-Server-Pages" "JavaScript" "JavaScript+ERB" "Jest-Snapshot" + "JetBrains-MPS" "Jinja" "Jison" "Jison-Lex" "Jolie" "Jsonnet" "Julia" + "Jupyter-Notebook" "Just" "KRL" "Kaitai-Struct" "KakouneScript" + "KerboScript" "KiCad-Layout" "KiCad-Legacy-Layout" "KiCad-Schematic" + "Kickstart" "Kit" "Kotlin" "Kusto" "LFE" "LLVM" "LOLCODE" "LSL" + "LTspice-Symbol" "LabVIEW" "Lark" "Lasso" "Latte" "Lean" "Lean-4" + "Less" "Lex" "LigoLANG" "LilyPond" "Limbo" "Linker-Script" + "Linux-Kernel-Module" "Liquid" "Literate-Agda" + "Literate-CoffeeScript" "Literate-Haskell" "LiveScript" "Logos" + "Logtalk" "LookML" "LoomScript" "Lua" "M" "M4" "M4Sugar" "MATLAB" + "MAXScript" "MDX" "MLIR" "MQL4" "MQL5" "MTML" "MUF" "Macaulay2" + "Makefile" "Mako" "Markdown" "Marko" "Mask" "Mathematica" "Maven-POM" + "Max" "Mercury" "Mermaid" "Meson" "Metal" + "Microsoft-Developer-Studio-Project" + "Microsoft-Visual-Studio-Solution" "MiniD" "MiniYAML" "Mint" "Mirah" + "Modelica" "Modula-2" "Modula-3" "Module-Management-System" "Mojo" + "Monkey" "Monkey-C" "Moocode" "MoonScript" "Motoko" + "Motorola-68K-Assembly" "Move" "Muse" "Mustache" "Myghty" "NASL" + "NCL" "NEON" "NL" "NPM-Config" "NSIS" "NWScript" "Nasal" "Nearley" + "Nemerle" "NetLinx" "NetLinx+ERB" "NetLogo" "NewLisp" "Nextflow" + "Nginx" "Nim" "Ninja" "Nit" "Nix" "Nu" "NumPy" "Nunjucks" "Nushell" + "OASv2-json" "OASv2-yaml" "OASv3-json" "OASv3-yaml" "OCaml" "Oberon" + "ObjDump" "Object-Data-Instance-Notation" "ObjectScript" + "Objective-C" "Objective-C++" "Objective-J" "Odin" "Omgrofl" "Opa" + "Opal" "Open-Policy-Agent" "OpenAPI-Specification-v2" + "OpenAPI-Specification-v3" "OpenCL" "OpenEdge-ABL" "OpenQASM" + "OpenRC-runscript" "OpenSCAD" "OpenStep-Property-List" + "OpenType-Feature-File" "Option-List" "Org" "Ox" "Oxygene" "Oz" "P4" + "PDDL" "PEG.js" "PHP" "PLSQL" "PLpgSQL" "POV-Ray-SDL" "Pact" "Pan" + "Papyrus" "Parrot" "Parrot-Assembly" "Parrot-Internal-Representation" + "Pascal" "Pawn" "Pep8" "Perl" "Pic" "Pickle" "PicoLisp" "PigLatin" + "Pike" "Pip-Requirements" "PlantUML" "Pod" "Pod-6" "PogoScript" + "Polar" "Pony" "Portugol" "PostCSS" "PostScript" "PowerBuilder" + "PowerShell" "Praat" "Prisma" "Processing" "Procfile" "Proguard" + "Prolog" "Promela" "Propeller-Spin" "Protocol-Buffer" + "Protocol-Buffer-Text-Format" "Public-Key" "Pug" "Puppet" "Pure-Data" + "PureBasic" "PureScript" "Pyret" "Python" "Python-console" + "Python-traceback" "Q#" "QML" "QMake" "Qt-Script" "Quake" "R" "RAML" + "RBS" "RDoc" "REALbasic" "REXX" "RMarkdown" "RPC" "RPGLE" "RPM-Spec" + "RUNOFF" "Racket" "Ragel" "Raku" "Rascal" "Raw-token-data" "ReScript" + "Readline-Config" "Reason" "ReasonLIGO" "Rebol" "Record-Jar" "Red" + "Redcode" "Redirect-Rules" "Regular-Expression" "Ren'Py" + "RenderScript" "Rez" "Rich-Text-Format" "Ring" "Riot" + "RobotFramework" "Roc" "Roff" "Roff-Manpage" "Rouge" + "RouterOS-Script" "Ruby" "Rust" "SAS" "SCSS" "SELinux-Policy" "SMT" + "SPARQL" "SQF" "SQL" "SQLPL" "SRecode-Template" "SSH-Config" "STAR" + "STL" "STON" "SVG" "SWIG" "Sage" "SaltStack" "Sass" "Scala" "Scaml" + "Scenic" "Scheme" "Scilab" "Self" "ShaderLab" "Shell" + "ShellCheck-Config" "ShellSession" "Shen" "Sieve" + "Simple-File-Verification" "Singularity" "Slash" "Slice" "Slim" + "Slint" "SmPL" "Smali" "Smalltalk" "Smarty" "Smithy" "Snakemake" + "Solidity" "Soong" "SourcePawn" "Spline-Font-Database" "Squirrel" + "Stan" "Standard-ML" "Starlark" "Stata" "StringTemplate" "Stylus" + "SubRip-Text" "SugarSS" "SuperCollider" "Svelte" "Sway" "Sweave" + "Swift" "SystemVerilog" "TI-Program" "TL-Verilog" "TLA" "TOML" "TSQL" + "TSV" "TSX" "TXL" "Talon" "Tcl" "Tcsh" "TeX" "Tea" "Terra" + "Terraform-Template" "Texinfo" "Text" "TextGrid" + "TextMate-Properties" "Textile" "Thrift" "Toit" "Turing" "Turtle" + "Twig" "Type-Language" "TypeScript" "Typst" "Unified-Parallel-C" + "Unity3D-Asset" "Unix-Assembly" "Uno" "UnrealScript" "UrWeb" "V" + "VBA" "VBScript" "VCL" "VHDL" "Vala" "Valve-Data-Format" + "Velocity-Template-Language" "Verilog" "Vim-Help-File" "Vim-Script" + "Vim-Snippet" "Visual-Basic-.NET" "Visual-Basic-6.0" "Volt" "Vue" + "Vyper" "WDL" "WGSL" "Wavefront-Material" "Wavefront-Object" + "Web-Ontology-Language" "WebAssembly" "WebAssembly-Interface-Type" + "WebIDL" "WebVTT" "Wget-Config" "Whiley" "Wikitext" + "Win32-Message-File" "Windows-Registry-Entries" "Witcher-Script" + "Wollok" "World-of-Warcraft-Addon-Data" "Wren" "X-BitMap" + "X-Font-Directory-Index" "X-PixMap" "X10" "XC" "XCompose" "XML" + "XML-Property-List" "XPages" "XProc" "XQuery" "XS" "XSLT" "Xojo" + "Xonsh" "Xtend" "YAML" "YANG" "YARA" "YASnippet" "Yacc" "Yul" "ZAP" + "ZIL" "Zeek" "ZenScript" "Zephir" "Zig" "Zimpl" "cURL-Config" + "desktop" "dircolors" "eC" "edn" "fish" "hoon" "jq" "kvlang" + "mIRC-Script" "mcfunction" "mupad" "nanorc" "nesC" "ooc" "q" + "reStructuredText" "robots.txt" "sed" "wisp" "xBase") + "Language specifiers recognized by GitHub's syntax highlighting features.") + +(defvar-local markdown-gfm-used-languages nil + "Language names used in GFM code blocks.") + +(defun markdown-trim-whitespace (str) + (replace-regexp-in-string + "\\(?:[[:space:]\r\n]+\\'\\|\\`[[:space:]\r\n]+\\)" "" str)) + +(defun markdown-clean-language-string (str) + (replace-regexp-in-string + "{\\.?\\|}" "" (markdown-trim-whitespace str))) + +(defun markdown-validate-language-string (widget) + (let ((str (widget-value widget))) + (unless (string= str (markdown-clean-language-string str)) + (widget-put widget :error (format "Invalid language spec: '%s'" str)) + widget))) + +(defun markdown-gfm-get-corpus () + "Create corpus of recognized GFM code block languages for the given buffer." + (let ((given-corpus (append markdown-gfm-additional-languages + markdown-gfm-recognized-languages))) + (append + markdown-gfm-used-languages + (if markdown-gfm-downcase-languages (cl-mapcar #'downcase given-corpus) + given-corpus)))) + +(defun markdown-gfm-add-used-language (lang) + "Clean LANG and add to list of used languages." + (setq markdown-gfm-used-languages + (cons lang (remove lang markdown-gfm-used-languages)))) + +(defcustom markdown-spaces-after-code-fence 1 + "Number of space characters to insert after a code fence. +\\<gfm-mode-map>\\[markdown-insert-gfm-code-block] inserts this many spaces between an +opening code fence and an info string." + :group 'markdown + :type 'integer + :safe #'natnump + :package-version '(markdown-mode . "2.3")) + +(defcustom markdown-code-block-braces nil + "When non-nil, automatically insert braces for GFM code blocks." + :group 'markdown + :type 'boolean) + +(defun markdown-insert-gfm-code-block (&optional lang edit) + "Insert GFM code block for language LANG. +If LANG is nil, the language will be queried from user. If a +region is active, wrap this region with the markup instead. If +the region boundaries are not on empty lines, these are added +automatically in order to have the correct markup. When EDIT is +non-nil (e.g., when \\[universal-argument] is given), edit the +code block in an indirect buffer after insertion." + (interactive + (list (let ((completion-ignore-case nil)) + (condition-case nil + (markdown-clean-language-string + (completing-read + "Programming language: " + (markdown-gfm-get-corpus) + nil 'confirm (car markdown-gfm-used-languages) + 'markdown-gfm-language-history)) + (quit ""))) + current-prefix-arg)) + (unless (string= lang "") (markdown-gfm-add-used-language lang)) + (when (and (> (length lang) 0) + (not markdown-code-block-braces)) + (setq lang (concat (make-string markdown-spaces-after-code-fence ?\s) + lang))) + (let ((gfm-open-brace (if markdown-code-block-braces "{" "")) + (gfm-close-brace (if markdown-code-block-braces "}" ""))) + (if (use-region-p) + (let* ((b (region-beginning)) (e (region-end)) end + (indent (progn (goto-char b) (current-indentation)))) + (goto-char e) + ;; if we're on a blank line, don't newline, otherwise the ``` + ;; should go on its own line + (unless (looking-back "\n" nil) + (newline)) + (indent-to indent) + (insert "```") + (markdown-ensure-blank-line-after) + (setq end (point)) + (goto-char b) + ;; if we're on a blank line, insert the quotes here, otherwise + ;; add a new line first + (unless (looking-at-p "\n") + (newline) + (forward-line -1)) + (markdown-ensure-blank-line-before) + (indent-to indent) + (insert "```" gfm-open-brace lang gfm-close-brace) + (markdown-syntax-propertize-fenced-block-constructs (line-beginning-position) end)) + (let ((indent (current-indentation)) + start-bol) + (delete-horizontal-space :backward-only) + (markdown-ensure-blank-line-before) + (indent-to indent) + (setq start-bol (line-beginning-position)) + (insert "```" gfm-open-brace lang gfm-close-brace "\n") + (indent-to indent) + (unless edit (insert ?\n)) + (indent-to indent) + (insert "```") + (markdown-ensure-blank-line-after) + (markdown-syntax-propertize-fenced-block-constructs start-bol (point))) + (end-of-line 0) + (when edit (markdown-edit-code-block))))) + +(defun markdown-code-block-lang (&optional pos-prop) + "Return the language name for a GFM or tilde fenced code block. +The beginning of the block may be described by POS-PROP, +a cons of (pos . prop) giving the position and property +at the beginning of the block." + (or pos-prop + (setq pos-prop + (markdown-max-of-seq + #'car + (cl-remove-if + #'null + (cl-mapcar + #'markdown-find-previous-prop + (markdown-get-fenced-block-begin-properties)))))) + (when pos-prop + (goto-char (car pos-prop)) + (set-match-data (get-text-property (point) (cdr pos-prop))) + ;; Note: Hard-coded group number assumes tilde + ;; and GFM fenced code regexp groups agree. + (let ((begin (match-beginning 3)) + (end (match-end 3))) + (when (and begin end) + ;; Fix language strings beginning with periods, like ".ruby". + (when (eq (char-after begin) ?.) + (setq begin (1+ begin))) + (buffer-substring-no-properties begin end))))) + +(defun markdown-gfm-parse-buffer-for-languages (&optional buffer) + (with-current-buffer (or buffer (current-buffer)) + (save-excursion + (goto-char (point-min)) + (cl-loop + with prop = 'markdown-gfm-block-begin + for pos-prop = (markdown-find-next-prop prop) + while pos-prop + for lang = (markdown-code-block-lang pos-prop) + do (progn (when lang (markdown-gfm-add-used-language lang)) + (goto-char (next-single-property-change (point) prop))))))) + +(defun markdown-insert-foldable-block () + "Insert details disclosure element to make content foldable. +If a region is active, wrap this region with the disclosure +element. More details here https://developer.mozilla.org/en-US/docs/Web/HTML/Element/details." + (interactive) + (let ((details-open-tag "<details>") + (details-close-tag "</details>") + (summary-open-tag "<summary>") + (summary-close-tag " </summary>")) + (if (use-region-p) + (let* ((b (region-beginning)) + (e (region-end)) + (indent (progn (goto-char b) (current-indentation)))) + (goto-char e) + ;; if we're on a blank line, don't newline, otherwise the tags + ;; should go on its own line + (unless (looking-back "\n" nil) + (newline)) + (indent-to indent) + (insert details-close-tag) + (markdown-ensure-blank-line-after) + (goto-char b) + ;; if we're on a blank line, insert the quotes here, otherwise + ;; add a new line first + (unless (looking-at-p "\n") + (newline) + (forward-line -1)) + (markdown-ensure-blank-line-before) + (indent-to indent) + (insert details-open-tag "\n") + (insert summary-open-tag summary-close-tag) + (search-backward summary-close-tag)) + (let ((indent (current-indentation))) + (delete-horizontal-space :backward-only) + (markdown-ensure-blank-line-before) + (indent-to indent) + (insert details-open-tag "\n") + (insert summary-open-tag summary-close-tag "\n") + (insert details-close-tag) + (indent-to indent) + (markdown-ensure-blank-line-after) + (search-backward summary-close-tag))))) + + +;;; Footnotes ================================================================= + +(defun markdown-footnote-counter-inc () + "Increment `markdown-footnote-counter' and return the new value." + (when (= markdown-footnote-counter 0) ; hasn't been updated in this buffer yet. + (save-excursion + (goto-char (point-min)) + (while (re-search-forward (concat "^\\[\\^\\(" markdown-footnote-chars "*?\\)\\]:") + (point-max) t) + (let ((fn (string-to-number (match-string 1)))) + (when (> fn markdown-footnote-counter) + (setq markdown-footnote-counter fn)))))) + (cl-incf markdown-footnote-counter)) + +(defun markdown-insert-footnote () + "Insert footnote with a new number and move point to footnote definition." + (interactive) + (let ((fn (markdown-footnote-counter-inc))) + (insert (format "[^%d]" fn)) + (push-mark (point) t) + (markdown-footnote-text-find-new-location) + (markdown-ensure-blank-line-before) + (unless (markdown-cur-line-blank-p) + (insert "\n")) + (insert (format "[^%d]: " fn)) + (markdown-ensure-blank-line-after))) + +(defun markdown-footnote-text-find-new-location () + "Position the point at the proper location for a new footnote text." + (cond + ((eq markdown-footnote-location 'end) (goto-char (point-max))) + ((eq markdown-footnote-location 'immediately) (markdown-end-of-text-block)) + ((eq markdown-footnote-location 'subtree) (markdown-end-of-subtree)) + ((eq markdown-footnote-location 'header) (markdown-end-of-defun)))) + +(defun markdown-footnote-kill () + "Kill the footnote at point. +The footnote text is killed (and added to the kill ring), the +footnote marker is deleted. Point has to be either at the +footnote marker or in the footnote text." + (interactive) + (let ((marker-pos nil) + (skip-deleting-marker nil) + (starting-footnote-text-positions + (markdown-footnote-text-positions))) + (when starting-footnote-text-positions + ;; We're starting in footnote text, so mark our return position and jump + ;; to the marker if possible. + (let ((marker-pos (markdown-footnote-find-marker + (cl-first starting-footnote-text-positions)))) + (if marker-pos + (goto-char (1- marker-pos)) + ;; If there isn't a marker, we still want to kill the text. + (setq skip-deleting-marker t)))) + ;; Either we didn't start in the text, or we started in the text and jumped + ;; to the marker. We want to assume we're at the marker now and error if + ;; we're not. + (unless skip-deleting-marker + (let ((marker (markdown-footnote-delete-marker))) + (unless marker + (error "Not at a footnote")) + ;; Even if we knew the text position before, it changed when we deleted + ;; the label. + (setq marker-pos (cl-second marker)) + (let ((new-text-pos (markdown-footnote-find-text (cl-first marker)))) + (unless new-text-pos + (error "No text for footnote `%s'" (cl-first marker))) + (goto-char new-text-pos)))) + (let ((pos (markdown-footnote-kill-text))) + (goto-char (if starting-footnote-text-positions + pos + marker-pos))))) + +(defun markdown-footnote-delete-marker () + "Delete a footnote marker at point. +Returns a list (ID START) containing the footnote ID and the +start position of the marker before deletion. If no footnote +marker was deleted, this function returns NIL." + (let ((marker (markdown-footnote-marker-positions))) + (when marker + (delete-region (cl-second marker) (cl-third marker)) + (butlast marker)))) + +(defun markdown-footnote-kill-text () + "Kill footnote text at point. +Returns the start position of the footnote text before deletion, +or NIL if point was not inside a footnote text. + +The killed text is placed in the kill ring (without the footnote +number)." + (let ((fn (markdown-footnote-text-positions))) + (when fn + (let ((text (delete-and-extract-region (cl-second fn) (cl-third fn)))) + (string-match (concat "\\[\\" (cl-first fn) "\\]:[[:space:]]*\\(\\(.*\n?\\)*\\)") text) + (kill-new (match-string 1 text)) + (when (and (markdown-cur-line-blank-p) + (markdown-prev-line-blank-p) + (not (bobp))) + (delete-region (1- (point)) (point))) + (cl-second fn))))) + +(defun markdown-footnote-goto-text () + "Jump to the text of the footnote at point." + (interactive) + (let ((fn (car (markdown-footnote-marker-positions)))) + (unless fn + (user-error "Not at a footnote marker")) + (let ((new-pos (markdown-footnote-find-text fn))) + (unless new-pos + (error "No definition found for footnote `%s'" fn)) + (goto-char new-pos)))) + +(defun markdown-footnote-return () + "Return from a footnote to its footnote number in the main text." + (interactive) + (let ((fn (save-excursion + (car (markdown-footnote-text-positions))))) + (unless fn + (user-error "Not in a footnote")) + (let ((new-pos (markdown-footnote-find-marker fn))) + (unless new-pos + (error "Footnote marker `%s' not found" fn)) + (goto-char new-pos)))) + +(defun markdown-footnote-find-marker (id) + "Find the location of the footnote marker with ID. +The actual buffer position returned is the position directly +following the marker's closing bracket. If no marker is found, +NIL is returned." + (save-excursion + (goto-char (point-min)) + (when (re-search-forward (concat "\\[" id "\\]\\([^:]\\|\\'\\)") nil t) + (skip-chars-backward "^]") + (point)))) + +(defun markdown-footnote-find-text (id) + "Find the location of the text of footnote ID. +The actual buffer position returned is the position of the first +character of the text, after the footnote's identifier. If no +footnote text is found, NIL is returned." + (save-excursion + (goto-char (point-min)) + (when (re-search-forward (concat "^ \\{0,3\\}\\[" id "\\]:") nil t) + (skip-chars-forward "[ \t]") + (point)))) + +(defun markdown-footnote-marker-positions () + "Return the position and ID of the footnote marker point is on. +The return value is a list (ID START END). If point is not on a +footnote, NIL is returned." + ;; first make sure we're at a footnote marker + (if (or (looking-back (concat "\\[\\^" markdown-footnote-chars "*\\]?") (line-beginning-position)) + (looking-at-p (concat "\\[?\\^" markdown-footnote-chars "*?\\]"))) + (save-excursion + ;; move point between [ and ^: + (if (looking-at-p "\\[") + (forward-char 1) + (skip-chars-backward "^[")) + (looking-at (concat "\\(\\^" markdown-footnote-chars "*?\\)\\]")) + (list (match-string 1) (1- (match-beginning 1)) (1+ (match-end 1)))))) + +(defun markdown-footnote-text-positions () + "Return the start and end positions of the footnote text point is in. +The exact return value is a list of three elements: (ID START END). +The start position is the position of the opening bracket +of the footnote id. The end position is directly after the +newline that ends the footnote. If point is not in a footnote, +NIL is returned instead." + (save-excursion + (let (result) + (move-beginning-of-line 1) + ;; Try to find the label. If we haven't found the label and we're at a blank + ;; or indented line, back up if possible. + (while (and + (not (and (looking-at markdown-regex-footnote-definition) + (setq result (list (match-string 1) (point))))) + (and (not (bobp)) + (or (markdown-cur-line-blank-p) + (>= (current-indentation) 4)))) + (forward-line -1)) + (when result + ;; Advance if there is a next line that is either blank or indented. + ;; (Need to check if we're on the last line, because + ;; markdown-next-line-blank-p returns true for last line in buffer.) + (while (and (/= (line-end-position) (point-max)) + (or (markdown-next-line-blank-p) + (>= (markdown-next-line-indent) 4))) + (forward-line)) + ;; Move back while the current line is blank. + (while (markdown-cur-line-blank-p) + (forward-line -1)) + ;; Advance to capture this line and a single trailing newline (if there + ;; is one). + (forward-line) + (append result (list (point))))))) + +(defun markdown-get-defined-footnotes () + "Return a list of all defined footnotes. +Result is an alist of pairs (MARKER . LINE), where MARKER is the +footnote marker, a string, and LINE is the line number containing +the footnote definition. + +For example, suppose the following footnotes are defined at positions +448 and 475: + +\[^1]: First footnote here. +\[^marker]: Second footnote. + +Then the returned list is: ((\"^1\" . 478) (\"^marker\" . 475))" + (save-excursion + (goto-char (point-min)) + (let (footnotes) + (while (markdown-search-until-condition + (lambda () (and (not (markdown-code-block-at-point-p)) + (not (markdown-inline-code-at-point-p)) + (not (markdown-in-comment-p)))) + markdown-regex-footnote-definition nil t) + (let ((marker (match-string-no-properties 1)) + (pos (match-beginning 0))) + (unless (zerop (length marker)) + (cl-pushnew (cons marker pos) footnotes :test #'equal)))) + (reverse footnotes)))) + + +;;; Element Removal =========================================================== + +(defun markdown-kill-thing-at-point () + "Kill thing at point and add important text, without markup, to kill ring. +Possible things to kill include (roughly in order of precedence): +inline code, headers, horizontal rules, links (add link text to +kill ring), images (add alt text to kill ring), angle uri, email +addresses, bold, italics, reference definition (add URI to kill +ring), footnote markers and text (kill both marker and text, add +text to kill ring), and list items." + (interactive "*") + (let (val) + (cond + ;; Inline code + ((markdown-inline-code-at-point) + (kill-new (match-string 2)) + (delete-region (match-beginning 0) (match-end 0))) + ;; ATX header + ((thing-at-point-looking-at markdown-regex-header-atx) + (kill-new (match-string 2)) + (delete-region (match-beginning 0) (match-end 0))) + ;; Setext header + ((thing-at-point-looking-at markdown-regex-header-setext) + (kill-new (match-string 1)) + (delete-region (match-beginning 0) (match-end 0))) + ;; Horizontal rule + ((thing-at-point-looking-at markdown-regex-hr) + (kill-new (match-string 0)) + (delete-region (match-beginning 0) (match-end 0))) + ;; Inline link or image (add link or alt text to kill ring) + ((thing-at-point-looking-at markdown-regex-link-inline) + (kill-new (match-string 3)) + (delete-region (match-beginning 0) (match-end 0))) + ;; Reference link or image (add link or alt text to kill ring) + ((thing-at-point-looking-at markdown-regex-link-reference) + (kill-new (match-string 3)) + (delete-region (match-beginning 0) (match-end 0))) + ;; Angle URI (add URL to kill ring) + ((thing-at-point-looking-at markdown-regex-angle-uri) + (kill-new (match-string 2)) + (delete-region (match-beginning 0) (match-end 0))) + ;; Email address in angle brackets (add email address to kill ring) + ((thing-at-point-looking-at markdown-regex-email) + (kill-new (match-string 1)) + (delete-region (match-beginning 0) (match-end 0))) + ;; Wiki link (add alias text to kill ring) + ((and markdown-enable-wiki-links + (thing-at-point-looking-at markdown-regex-wiki-link)) + (kill-new (markdown-wiki-link-alias)) + (delete-region (match-beginning 1) (match-end 1))) + ;; Bold + ((thing-at-point-looking-at markdown-regex-bold) + (kill-new (match-string 4)) + (delete-region (match-beginning 2) (match-end 2))) + ;; Italics + ((thing-at-point-looking-at markdown-regex-italic) + (kill-new (match-string 3)) + (delete-region (match-beginning 1) (match-end 1))) + ;; Strikethrough + ((thing-at-point-looking-at markdown-regex-strike-through) + (kill-new (match-string 4)) + (delete-region (match-beginning 2) (match-end 2))) + ;; Footnote marker (add footnote text to kill ring) + ((thing-at-point-looking-at markdown-regex-footnote) + (markdown-footnote-kill)) + ;; Footnote text (add footnote text to kill ring) + ((setq val (markdown-footnote-text-positions)) + (markdown-footnote-kill)) + ;; Reference definition (add URL to kill ring) + ((thing-at-point-looking-at markdown-regex-reference-definition) + (kill-new (match-string 5)) + (delete-region (match-beginning 0) (match-end 0))) + ;; List item + ((setq val (markdown-cur-list-item-bounds)) + (kill-new (delete-and-extract-region (cl-first val) (cl-second val)))) + (t + (user-error "Nothing found at point to kill"))))) + +(defun markdown-kill-outline () + "Kill visible heading and add it to `kill-ring'." + (interactive) + (save-excursion + (markdown-outline-previous) + (kill-region (point) (progn (markdown-outline-next) (point))))) + +(defun markdown-kill-block () + "Kill visible code block, list item, or blockquote and add it to `kill-ring'." + (interactive) + (save-excursion + (markdown-backward-block) + (kill-region (point) (progn (markdown-forward-block) (point))))) + + +;;; Indentation =============================================================== + +(defun markdown-indent-find-next-position (cur-pos positions) + "Return the position after the index of CUR-POS in POSITIONS. +Positions are calculated by `markdown-calc-indents'." + (while (and positions + (not (equal cur-pos (car positions)))) + (setq positions (cdr positions))) + (or (cadr positions) 0)) + +(defun markdown-outdent-find-next-position (cur-pos positions) + "Return the maximal element that precedes CUR-POS from POSITIONS. +Positions are calculated by `markdown-calc-indents'." + (let ((result 0)) + (dolist (i positions) + (when (< i cur-pos) + (setq result (max result i)))) + result)) + +(defun markdown-indent-line () + "Indent the current line using some heuristics. +If the _previous_ command was either `markdown-enter-key' or +`markdown-cycle', then we should cycle to the next +reasonable indentation position. Otherwise, we could have been +called directly by `markdown-enter-key', by an initial call of +`markdown-cycle', or indirectly by `auto-fill-mode'. In +these cases, indent to the default position. +Positions are calculated by `markdown-calc-indents'." + (interactive) + (let ((positions (markdown-calc-indents)) + (point-pos (current-column)) + (_ (back-to-indentation)) + (cur-pos (current-column))) + (if (not (equal this-command 'markdown-cycle)) + (indent-line-to (car positions)) + (setq positions (sort (delete-dups positions) '<)) + (let* ((next-pos (markdown-indent-find-next-position cur-pos positions)) + (new-point-pos (max (+ point-pos (- next-pos cur-pos)) 0))) + (indent-line-to next-pos) + (move-to-column new-point-pos))))) + +(defun markdown-calc-indents () + "Return a list of indentation columns to cycle through. +The first element in the returned list should be considered the +default indentation level. This function does not worry about +duplicate positions, which are handled up by calling functions." + (let (pos prev-line-pos positions) + + ;; Indentation of previous line + (setq prev-line-pos (markdown-prev-line-indent)) + (setq positions (cons prev-line-pos positions)) + + ;; Indentation of previous non-list-marker text + (when (setq pos (save-excursion + (forward-line -1) + (when (looking-at markdown-regex-list) + (- (match-end 3) (match-beginning 0))))) + (setq positions (cons pos positions))) + + ;; Indentation required for a pre block in current context + (setq pos (length (markdown-pre-indentation (point)))) + (setq positions (cons pos positions)) + + ;; Indentation of the previous line + tab-width + (if prev-line-pos + (setq positions (cons (+ prev-line-pos tab-width) positions)) + (setq positions (cons tab-width positions))) + + ;; Indentation of the previous line - tab-width + (if (and prev-line-pos (> prev-line-pos tab-width)) + (setq positions (cons (- prev-line-pos tab-width) positions))) + + ;; Indentation of all preceding list markers (when in a list) + (when (setq pos (markdown-calculate-list-levels)) + (setq positions (append pos positions))) + + ;; First column + (setq positions (cons 0 positions)) + + ;; Return reversed list + (reverse positions))) + +(defun markdown-enter-key () ;FIXME: Partly obsoleted by electric-indent + "Handle RET depending on the context. +If the point is at a table, move to the next row. Otherwise, +indent according to value of `markdown-indent-on-enter'. +When it is nil, simply call `newline'. Otherwise, indent the next line +following RET using `markdown-indent-line'. Furthermore, when it +is set to \\='indent-and-new-item and the point is in a list item, +start a new item with the same indentation. If the point is in an +empty list item, remove it (so that pressing RET twice when in a +list simply adds a blank line)." + (interactive) + (cond + ;; Table + ((markdown-table-at-point-p) + (call-interactively #'markdown-table-next-row)) + ;; Indent non-table text + (markdown-indent-on-enter + (let (bounds) + (if (and (memq markdown-indent-on-enter '(indent-and-new-item)) + (setq bounds (markdown-cur-list-item-bounds))) + (let ((beg (cl-first bounds)) + (end (cl-second bounds)) + (nonlist-indent (cl-fourth bounds)) + (checkbox (cl-sixth bounds))) + ;; Point is in a list item + (if (= (- end beg) (+ nonlist-indent (length checkbox))) + ;; Delete blank list + (progn + (delete-region beg end) + (newline) + (markdown-indent-line)) + (call-interactively #'markdown-insert-list-item))) + ;; Point is not in a list + (newline) + (markdown-indent-line)))) + ;; Insert a raw newline + (t (newline)))) + +(defun markdown-outdent-or-delete (arg) + "Handle BACKSPACE by cycling through indentation points. +When BACKSPACE is pressed, if there is only whitespace +before the current point, then outdent the line one level. +Otherwise, do normal delete by repeating +`backward-delete-char-untabify' ARG times." + (interactive "*p") + (if (use-region-p) + (backward-delete-char-untabify arg) + (let ((cur-pos (current-column)) + (start-of-indention (save-excursion + (back-to-indentation) + (current-column))) + (positions (markdown-calc-indents))) + (if (and (> cur-pos 0) (= cur-pos start-of-indention)) + (indent-line-to (markdown-outdent-find-next-position cur-pos positions)) + (backward-delete-char-untabify arg))))) + +(defun markdown-find-leftmost-column (beg end) + "Find the leftmost column in the region from BEG to END." + (let ((mincol 1000)) + (save-excursion + (goto-char beg) + (while (< (point) end) + (back-to-indentation) + (unless (looking-at-p "[ \t]*$") + (setq mincol (min mincol (current-column)))) + (forward-line 1) + )) + mincol)) + +(defun markdown-indent-region (beg end arg) + "Indent the region from BEG to END using some heuristics. +When ARG is non-nil, outdent the region instead. +See `markdown-indent-line' and `markdown-indent-line'." + (interactive "*r\nP") + (let* ((positions (sort (delete-dups (markdown-calc-indents)) '<)) + (leftmostcol (markdown-find-leftmost-column beg end)) + (next-pos (if arg + (markdown-outdent-find-next-position leftmostcol positions) + (markdown-indent-find-next-position leftmostcol positions)))) + (indent-rigidly beg end (- next-pos leftmostcol)) + (setq deactivate-mark nil))) + +(defun markdown-outdent-region (beg end) + "Call `markdown-indent-region' on region from BEG to END with prefix." + (interactive "*r") + (markdown-indent-region beg end t)) + +(defun markdown--indent-region (start end) + (let ((deactivate-mark nil)) + (save-excursion + (goto-char end) + (setq end (point-marker)) + (goto-char start) + (when (bolp) + (forward-line 1)) + (while (< (point) end) + (unless (or (markdown-code-block-at-point-p) (and (bolp) (eolp))) + (indent-according-to-mode)) + (forward-line 1)) + (move-marker end nil)))) + + +;;; Markup Completion ========================================================= + +(defconst markdown-complete-alist + '((markdown-regex-header-atx . markdown-complete-atx) + (markdown-regex-header-setext . markdown-complete-setext) + (markdown-regex-hr . markdown-complete-hr)) + "Association list of form (regexp . function) for markup completion.") + +(defun markdown-incomplete-atx-p () + "Return t if ATX header markup is incomplete and nil otherwise. +Assumes match data is available for `markdown-regex-header-atx'. +Checks that the number of trailing hash marks equals the number of leading +hash marks, that there is only a single space before and after the text, +and that there is no extraneous whitespace in the text." + (or + ;; Number of starting and ending hash marks differs + (not (= (length (match-string 1)) (length (match-string 3)))) + ;; When the header text is not empty... + (and (> (length (match-string 2)) 0) + ;; ...if there are extra leading, trailing, or interior spaces + (or (not (= (match-beginning 2) (1+ (match-end 1)))) + (not (= (match-beginning 3) (1+ (match-end 2)))) + (string-match-p "[ \t\n]\\{2\\}" (match-string 2)))) + ;; When the header text is empty... + (and (= (length (match-string 2)) 0) + ;; ...if there are too many or too few spaces + (not (= (match-beginning 3) (+ (match-end 1) 2)))))) + +(defun markdown-complete-atx () + "Complete and normalize ATX headers. +Add or remove hash marks to the end of the header to match the +beginning. Ensure that there is only a single space between hash +marks and header text. Removes extraneous whitespace from header text. +Assumes match data is available for `markdown-regex-header-atx'. +Return nil if markup was complete and non-nil if markup was completed." + (when (markdown-incomplete-atx-p) + (let* ((new-marker (make-marker)) + (new-marker (set-marker new-marker (match-end 2)))) + ;; Hash marks and spacing at end + (goto-char (match-end 2)) + (delete-region (match-end 2) (match-end 3)) + (insert " " (match-string 1)) + ;; Remove extraneous whitespace from title + (replace-match (markdown-compress-whitespace-string (match-string 2)) + t t nil 2) + ;; Spacing at beginning + (goto-char (match-end 1)) + (delete-region (match-end 1) (match-beginning 2)) + (insert " ") + ;; Leave point at end of text + (goto-char new-marker)))) + +(defun markdown-incomplete-setext-p () + "Return t if setext header markup is incomplete and nil otherwise. +Assumes match data is available for `markdown-regex-header-setext'. +Checks that length of underline matches text and that there is no +extraneous whitespace in the text." + (or (not (= (length (match-string 1)) (length (match-string 2)))) + (string-match-p "[ \t\n]\\{2\\}" (match-string 1)))) + +(defun markdown-complete-setext () + "Complete and normalize setext headers. +Add or remove underline characters to match length of header +text. Removes extraneous whitespace from header text. Assumes +match data is available for `markdown-regex-header-setext'. +Return nil if markup was complete and non-nil if markup was completed." + (when (markdown-incomplete-setext-p) + (let* ((text (markdown-compress-whitespace-string (match-string 1))) + (char (char-after (match-beginning 2))) + (level (if (char-equal char ?-) 2 1))) + (goto-char (match-beginning 0)) + (delete-region (match-beginning 0) (match-end 0)) + (markdown-insert-header level text t) + t))) + +(defun markdown-incomplete-hr-p () + "Return non-nil if hr is not in `markdown-hr-strings' and nil otherwise. +Assumes match data is available for `markdown-regex-hr'." + (not (member (match-string 0) markdown-hr-strings))) + +(defun markdown-complete-hr () + "Complete horizontal rules. +If horizontal rule string is a member of `markdown-hr-strings', +do nothing. Otherwise, replace with the car of +`markdown-hr-strings'. +Assumes match data is available for `markdown-regex-hr'. +Return nil if markup was complete and non-nil if markup was completed." + (when (markdown-incomplete-hr-p) + (replace-match (car markdown-hr-strings)) + t)) + +(defun markdown-complete () + "Complete markup of object near point or in region when active. +Handle all objects in `markdown-complete-alist', in order. +See `markdown-complete-at-point' and `markdown-complete-region'." + (interactive "*") + (if (use-region-p) + (markdown-complete-region (region-beginning) (region-end)) + (markdown-complete-at-point))) + +(defun markdown-complete-at-point () + "Complete markup of object near point. +Handle all elements of `markdown-complete-alist' in order." + (interactive "*") + (let ((list markdown-complete-alist) found changed) + (while list + (let ((regexp (eval (caar list) t)) ;FIXME: Why `eval'? + (function (cdar list))) + (setq list (cdr list)) + (when (thing-at-point-looking-at regexp) + (setq found t) + (setq changed (funcall function)) + (setq list nil)))) + (if found + (or changed (user-error "Markup at point is complete")) + (user-error "Nothing to complete at point")))) + +(defun markdown-complete-region (beg end) + "Complete markup of objects in region from BEG to END. +Handle all objects in `markdown-complete-alist', in order. Each +match is checked to ensure that a previous regexp does not also +match." + (interactive "*r") + (let ((end-marker (set-marker (make-marker) end)) + previous) + (dolist (element markdown-complete-alist) + (let ((regexp (eval (car element) t)) ;FIXME: Why `eval'? + (function (cdr element))) + (goto-char beg) + (while (re-search-forward regexp end-marker 'limit) + (when (match-string 0) + ;; Make sure this is not a match for any of the preceding regexps. + ;; This prevents mistaking an HR for a Setext subheading. + (let (match) + (save-match-data + (dolist (prev-regexp previous) + (or match (setq match (looking-back prev-regexp nil))))) + (unless match + (save-excursion (funcall function)))))) + (cl-pushnew regexp previous :test #'equal))) + previous)) + +(defun markdown-complete-buffer () + "Complete markup for all objects in the current buffer." + (interactive "*") + (markdown-complete-region (point-min) (point-max))) + + +;;; Markup Cycling ============================================================ + +(defun markdown-cycle-atx (arg &optional remove) + "Cycle ATX header markup. +Promote header (decrease level) when ARG is 1 and demote +header (increase level) if arg is -1. When REMOVE is non-nil, +remove the header when the level reaches zero and stop cycling +when it reaches six. Otherwise, perform a proper cycling through +levels one through six. Assumes match data is available for +`markdown-regex-header-atx'." + (let* ((old-level (length (match-string 1))) + (new-level (+ old-level arg)) + (text (match-string 2))) + (when (not remove) + (setq new-level (% new-level 6)) + (setq new-level (cond ((= new-level 0) 6) + ((< new-level 0) (+ new-level 6)) + (t new-level)))) + (cond + ((= new-level 0) + (markdown-unwrap-thing-at-point nil 0 2)) + ((<= new-level 6) + (goto-char (match-beginning 0)) + (delete-region (match-beginning 0) (match-end 0)) + (markdown-insert-header new-level text nil))))) + +(defun markdown-cycle-setext (arg &optional remove) + "Cycle setext header markup. +Promote header (increase level) when ARG is 1 and demote +header (decrease level or remove) if arg is -1. When demoting a +level-two setext header, replace with a level-three atx header. +When REMOVE is non-nil, remove the header when the level reaches +zero. Otherwise, cycle back to a level six atx header. Assumes +match data is available for `markdown-regex-header-setext'." + (let* ((char (char-after (match-beginning 2))) + (old-level (if (char-equal char ?=) 1 2)) + (new-level (+ old-level arg))) + (when (and (not remove) (= new-level 0)) + (setq new-level 6)) + (cond + ((= new-level 0) + (markdown-unwrap-thing-at-point nil 0 1)) + ((<= new-level 2) + (markdown-insert-header new-level nil t)) + ((<= new-level 6) + (markdown-insert-header new-level nil nil))))) + +(defun markdown-cycle-hr (arg &optional remove) + "Cycle string used for horizontal rule from `markdown-hr-strings'. +When ARG is 1, cycle forward (demote), and when ARG is -1, cycle +backwards (promote). When REMOVE is non-nil, remove the hr instead +of cycling when the end of the list is reached. +Assumes match data is available for `markdown-regex-hr'." + (let* ((strings (if (= arg -1) + (reverse markdown-hr-strings) + markdown-hr-strings)) + (tail (member (match-string 0) strings)) + (new (or (cadr tail) + (if remove + (if (= arg 1) + "" + (car tail)) + (car strings))))) + (replace-match new))) + +(defun markdown-cycle-bold () + "Cycle bold markup between underscores and asterisks. +Assumes match data is available for `markdown-regex-bold'." + (save-excursion + (let* ((old-delim (match-string 3)) + (new-delim (if (string-equal old-delim "**") "__" "**"))) + (replace-match new-delim t t nil 3) + (replace-match new-delim t t nil 5)))) + +(defun markdown-cycle-italic () + "Cycle italic markup between underscores and asterisks. +Assumes match data is available for `markdown-regex-italic'." + (save-excursion + (let* ((old-delim (match-string 2)) + (new-delim (if (string-equal old-delim "*") "_" "*"))) + (replace-match new-delim t t nil 2) + (replace-match new-delim t t nil 4)))) + + +;;; Keymap ==================================================================== + +(defun markdown--style-map-prompt () + "Return a formatted prompt for Markdown markup insertion." + (when markdown-enable-prefix-prompts + (concat + "Markdown: " + (propertize "bold" 'face 'markdown-bold-face) ", " + (propertize "italic" 'face 'markdown-italic-face) ", " + (propertize "code" 'face 'markdown-inline-code-face) ", " + (propertize "C = GFM code" 'face 'markdown-code-face) ", " + (propertize "pre" 'face 'markdown-pre-face) ", " + (propertize "footnote" 'face 'markdown-footnote-text-face) ", " + (propertize "F = foldable" 'face 'markdown-bold-face) ", " + (propertize "q = blockquote" 'face 'markdown-blockquote-face) ", " + (propertize "h & 1-6 = heading" 'face 'markdown-header-face) ", " + (propertize "- = hr" 'face 'markdown-hr-face) ", " + "C-h = more"))) + +(defun markdown--command-map-prompt () + "Return prompt for Markdown buffer-wide commands." + (when markdown-enable-prefix-prompts + (concat + "Command: " + (propertize "m" 'face 'markdown-bold-face) "arkdown, " + (propertize "p" 'face 'markdown-bold-face) "review, " + (propertize "o" 'face 'markdown-bold-face) "pen, " + (propertize "e" 'face 'markdown-bold-face) "xport, " + "export & pre" (propertize "v" 'face 'markdown-bold-face) "iew, " + (propertize "c" 'face 'markdown-bold-face) "heck refs, " + (propertize "u" 'face 'markdown-bold-face) "nused refs, " + "C-h = more"))) + +(defvar markdown-mode-style-map + (let ((map (make-keymap (markdown--style-map-prompt)))) + (define-key map (kbd "1") 'markdown-insert-header-atx-1) + (define-key map (kbd "2") 'markdown-insert-header-atx-2) + (define-key map (kbd "3") 'markdown-insert-header-atx-3) + (define-key map (kbd "4") 'markdown-insert-header-atx-4) + (define-key map (kbd "5") 'markdown-insert-header-atx-5) + (define-key map (kbd "6") 'markdown-insert-header-atx-6) + (define-key map (kbd "!") 'markdown-insert-header-setext-1) + (define-key map (kbd "@") 'markdown-insert-header-setext-2) + (define-key map (kbd "b") 'markdown-insert-bold) + (define-key map (kbd "c") 'markdown-insert-code) + (define-key map (kbd "C") 'markdown-insert-gfm-code-block) + (define-key map (kbd "f") 'markdown-insert-footnote) + (define-key map (kbd "F") 'markdown-insert-foldable-block) + (define-key map (kbd "h") 'markdown-insert-header-dwim) + (define-key map (kbd "H") 'markdown-insert-header-setext-dwim) + (define-key map (kbd "i") 'markdown-insert-italic) + (define-key map (kbd "k") 'markdown-insert-kbd) + (define-key map (kbd "l") 'markdown-insert-link) + (define-key map (kbd "p") 'markdown-insert-pre) + (define-key map (kbd "P") 'markdown-pre-region) + (define-key map (kbd "q") 'markdown-insert-blockquote) + (define-key map (kbd "s") 'markdown-insert-strike-through) + (define-key map (kbd "t") 'markdown-insert-table) + (define-key map (kbd "Q") 'markdown-blockquote-region) + (define-key map (kbd "w") 'markdown-insert-wiki-link) + (define-key map (kbd "-") 'markdown-insert-hr) + (define-key map (kbd "[") 'markdown-insert-gfm-checkbox) + ;; Deprecated keys that may be removed in a future version + (define-key map (kbd "e") 'markdown-insert-italic) + map) + "Keymap for Markdown text styling commands.") + +(defvar markdown-mode-command-map + (let ((map (make-keymap (markdown--command-map-prompt)))) + (define-key map (kbd "m") 'markdown-other-window) + (define-key map (kbd "p") 'markdown-preview) + (define-key map (kbd "e") 'markdown-export) + (define-key map (kbd "v") 'markdown-export-and-preview) + (define-key map (kbd "o") 'markdown-open) + (define-key map (kbd "l") 'markdown-live-preview-mode) + (define-key map (kbd "w") 'markdown-kill-ring-save) + (define-key map (kbd "c") 'markdown-check-refs) + (define-key map (kbd "u") 'markdown-unused-refs) + (define-key map (kbd "n") 'markdown-cleanup-list-numbers) + (define-key map (kbd "]") 'markdown-complete-buffer) + (define-key map (kbd "^") 'markdown-table-sort-lines) + (define-key map (kbd "|") 'markdown-table-convert-region) + (define-key map (kbd "t") 'markdown-table-transpose) + map) + "Keymap for Markdown buffer-wide commands.") + +(defvar markdown-mode-map + (let ((map (make-keymap))) + ;; Markup insertion & removal + (define-key map (kbd "C-c C-s") markdown-mode-style-map) + (define-key map (kbd "C-c C-l") 'markdown-insert-link) + (define-key map (kbd "C-c C-k") 'markdown-kill-thing-at-point) + ;; Promotion, demotion, and cycling + (define-key map (kbd "C-c C--") 'markdown-promote) + (define-key map (kbd "C-c C-=") 'markdown-demote) + (define-key map (kbd "C-c C-]") 'markdown-complete) + ;; Following and doing things + (define-key map (kbd "C-c C-o") 'markdown-follow-thing-at-point) + (define-key map (kbd "C-c C-d") 'markdown-do) + (define-key map (kbd "C-c '") 'markdown-edit-code-block) + ;; Indentation + (define-key map (kbd "RET") 'markdown-enter-key) + (define-key map (kbd "DEL") 'markdown-outdent-or-delete) + (define-key map (kbd "C-c >") 'markdown-indent-region) + (define-key map (kbd "C-c <") 'markdown-outdent-region) + ;; Visibility cycling + (define-key map (kbd "TAB") 'markdown-cycle) + ;; S-iso-lefttab and S-tab should both be mapped to `backtab' by + ;; (local-)function-key-map. + ;;(define-key map (kbd "<S-iso-lefttab>") 'markdown-shifttab) + ;;(define-key map (kbd "<S-tab>") 'markdown-shifttab) + (define-key map (kbd "<backtab>") 'markdown-shifttab) + ;; Heading and list navigation + (define-key map (kbd "C-c C-n") 'markdown-outline-next) + (define-key map (kbd "C-c C-p") 'markdown-outline-previous) + (define-key map (kbd "C-c C-f") 'markdown-outline-next-same-level) + (define-key map (kbd "C-c C-b") 'markdown-outline-previous-same-level) + (define-key map (kbd "C-c C-u") 'markdown-outline-up) + ;; Buffer-wide commands + (define-key map (kbd "C-c C-c") markdown-mode-command-map) + ;; Subtree, list, and table editing + (define-key map (kbd "C-c <up>") 'markdown-move-up) + (define-key map (kbd "C-c <down>") 'markdown-move-down) + (define-key map (kbd "C-c <left>") 'markdown-promote) + (define-key map (kbd "C-c <right>") 'markdown-demote) + (define-key map (kbd "C-c S-<up>") 'markdown-table-delete-row) + (define-key map (kbd "C-c S-<down>") 'markdown-table-insert-row) + (define-key map (kbd "C-c S-<left>") 'markdown-table-delete-column) + (define-key map (kbd "C-c S-<right>") 'markdown-table-insert-column) + (define-key map (kbd "C-c C-M-h") 'markdown-mark-subtree) + (define-key map (kbd "C-x n s") 'markdown-narrow-to-subtree) + (define-key map (kbd "M-RET") 'markdown-insert-list-item) + (define-key map (kbd "C-c C-j") 'markdown-insert-list-item) + ;; Lines + (define-key map [remap move-beginning-of-line] 'markdown-beginning-of-line) + (define-key map [remap move-end-of-line] 'markdown-end-of-line) + ;; Paragraphs (Markdown context aware) + (define-key map [remap backward-paragraph] 'markdown-backward-paragraph) + (define-key map [remap forward-paragraph] 'markdown-forward-paragraph) + (define-key map [remap mark-paragraph] 'markdown-mark-paragraph) + ;; Blocks (one or more paragraphs) + (define-key map (kbd "C-M-{") 'markdown-backward-block) + (define-key map (kbd "C-M-}") 'markdown-forward-block) + (define-key map (kbd "C-c M-h") 'markdown-mark-block) + (define-key map (kbd "C-x n b") 'markdown-narrow-to-block) + ;; Pages (top-level sections) + (define-key map [remap backward-page] 'markdown-backward-page) + (define-key map [remap forward-page] 'markdown-forward-page) + (define-key map [remap mark-page] 'markdown-mark-page) + (define-key map [remap narrow-to-page] 'markdown-narrow-to-page) + ;; Link Movement + (define-key map (kbd "M-n") 'markdown-next-link) + (define-key map (kbd "M-p") 'markdown-previous-link) + ;; Toggling functionality + (define-key map (kbd "C-c C-x C-e") 'markdown-toggle-math) + (define-key map (kbd "C-c C-x C-f") 'markdown-toggle-fontify-code-blocks-natively) + (define-key map (kbd "C-c C-x C-i") 'markdown-toggle-inline-images) + (define-key map (kbd "C-c C-x C-l") 'markdown-toggle-url-hiding) + (define-key map (kbd "C-c C-x C-m") 'markdown-toggle-markup-hiding) + ;; Alternative keys (in case of problems with the arrow keys) + (define-key map (kbd "C-c C-x u") 'markdown-move-up) + (define-key map (kbd "C-c C-x d") 'markdown-move-down) + (define-key map (kbd "C-c C-x l") 'markdown-promote) + (define-key map (kbd "C-c C-x r") 'markdown-demote) + ;; Deprecated keys that may be removed in a future version + (define-key map (kbd "C-c C-a L") 'markdown-insert-link) ;; C-c C-l + (define-key map (kbd "C-c C-a l") 'markdown-insert-link) ;; C-c C-l + (define-key map (kbd "C-c C-a r") 'markdown-insert-link) ;; C-c C-l + (define-key map (kbd "C-c C-a u") 'markdown-insert-uri) ;; C-c C-l + (define-key map (kbd "C-c C-a f") 'markdown-insert-footnote) + (define-key map (kbd "C-c C-a w") 'markdown-insert-wiki-link) + (define-key map (kbd "C-c C-t 1") 'markdown-insert-header-atx-1) + (define-key map (kbd "C-c C-t 2") 'markdown-insert-header-atx-2) + (define-key map (kbd "C-c C-t 3") 'markdown-insert-header-atx-3) + (define-key map (kbd "C-c C-t 4") 'markdown-insert-header-atx-4) + (define-key map (kbd "C-c C-t 5") 'markdown-insert-header-atx-5) + (define-key map (kbd "C-c C-t 6") 'markdown-insert-header-atx-6) + (define-key map (kbd "C-c C-t !") 'markdown-insert-header-setext-1) + (define-key map (kbd "C-c C-t @") 'markdown-insert-header-setext-2) + (define-key map (kbd "C-c C-t h") 'markdown-insert-header-dwim) + (define-key map (kbd "C-c C-t H") 'markdown-insert-header-setext-dwim) + (define-key map (kbd "C-c C-t s") 'markdown-insert-header-setext-2) + (define-key map (kbd "C-c C-t t") 'markdown-insert-header-setext-1) + (define-key map (kbd "C-c C-i") 'markdown-insert-image) + (define-key map (kbd "C-c C-x m") 'markdown-insert-list-item) ;; C-c C-j + (define-key map (kbd "C-c C-x C-x") 'markdown-toggle-gfm-checkbox) ;; C-c C-d + (define-key map (kbd "C-c -") 'markdown-insert-hr) + map) + "Keymap for Markdown major mode.") + +(defvar markdown-mode-mouse-map + (when markdown-mouse-follow-link + (let ((map (make-sparse-keymap))) + (define-key map [follow-link] 'mouse-face) + (define-key map [mouse-2] #'markdown-follow-thing-at-point) + map)) + "Keymap for following links with mouse.") + +(defvar gfm-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map markdown-mode-map) + (define-key map (kbd "C-c C-s d") 'markdown-insert-strike-through) + (define-key map "`" 'markdown-electric-backquote) + map) + "Keymap for `gfm-mode'. +See also `markdown-mode-map'.") + + +;;; Menu ====================================================================== + +(easy-menu-define markdown-mode-menu markdown-mode-map + "Menu for Markdown mode." + '("Markdown" + "---" + ("Movement" + ["Jump" markdown-do] + ["Follow Link" markdown-follow-thing-at-point] + ["Next Link" markdown-next-link] + ["Previous Link" markdown-previous-link] + "---" + ["Next Heading or List Item" markdown-outline-next] + ["Previous Heading or List Item" markdown-outline-previous] + ["Next at Same Level" markdown-outline-next-same-level] + ["Previous at Same Level" markdown-outline-previous-same-level] + ["Up to Parent" markdown-outline-up] + "---" + ["Forward Paragraph" markdown-forward-paragraph] + ["Backward Paragraph" markdown-backward-paragraph] + ["Forward Block" markdown-forward-block] + ["Backward Block" markdown-backward-block]) + ("Show & Hide" + ["Cycle Heading Visibility" markdown-cycle + :enable (markdown-on-heading-p)] + ["Cycle Heading Visibility (Global)" markdown-shifttab] + "---" + ["Narrow to Region" narrow-to-region] + ["Narrow to Block" markdown-narrow-to-block] + ["Narrow to Section" narrow-to-defun] + ["Narrow to Subtree" markdown-narrow-to-subtree] + ["Widen" widen (buffer-narrowed-p)] + "---" + ["Toggle Markup Hiding" markdown-toggle-markup-hiding + :keys "C-c C-x C-m" + :style radio + :selected markdown-hide-markup]) + "---" + ("Headings & Structure" + ["Automatic Heading" markdown-insert-header-dwim + :keys "C-c C-s h"] + ["Automatic Heading (Setext)" markdown-insert-header-setext-dwim + :keys "C-c C-s H"] + ("Specific Heading (atx)" + ["First Level atx" markdown-insert-header-atx-1 + :keys "C-c C-s 1"] + ["Second Level atx" markdown-insert-header-atx-2 + :keys "C-c C-s 2"] + ["Third Level atx" markdown-insert-header-atx-3 + :keys "C-c C-s 3"] + ["Fourth Level atx" markdown-insert-header-atx-4 + :keys "C-c C-s 4"] + ["Fifth Level atx" markdown-insert-header-atx-5 + :keys "C-c C-s 5"] + ["Sixth Level atx" markdown-insert-header-atx-6 + :keys "C-c C-s 6"]) + ("Specific Heading (Setext)" + ["First Level Setext" markdown-insert-header-setext-1 + :keys "C-c C-s !"] + ["Second Level Setext" markdown-insert-header-setext-2 + :keys "C-c C-s @"]) + ["Horizontal Rule" markdown-insert-hr + :keys "C-c C-s -"] + "---" + ["Move Subtree Up" markdown-move-up + :keys "C-c <up>"] + ["Move Subtree Down" markdown-move-down + :keys "C-c <down>"] + ["Promote Subtree" markdown-promote + :keys "C-c <left>"] + ["Demote Subtree" markdown-demote + :keys "C-c <right>"]) + ("Region & Mark" + ["Indent Region" markdown-indent-region] + ["Outdent Region" markdown-outdent-region] + "--" + ["Mark Paragraph" mark-paragraph] + ["Mark Block" markdown-mark-block] + ["Mark Section" mark-defun] + ["Mark Subtree" markdown-mark-subtree]) + ("Tables" + ["Move Row Up" markdown-move-up + :enable (markdown-table-at-point-p) + :keys "C-c <up>"] + ["Move Row Down" markdown-move-down + :enable (markdown-table-at-point-p) + :keys "C-c <down>"] + ["Move Column Left" markdown-promote + :enable (markdown-table-at-point-p) + :keys "C-c <left>"] + ["Move Column Right" markdown-demote + :enable (markdown-table-at-point-p) + :keys "C-c <right>"] + ["Delete Row" markdown-table-delete-row + :enable (markdown-table-at-point-p)] + ["Insert Row" markdown-table-insert-row + :enable (markdown-table-at-point-p)] + ["Delete Column" markdown-table-delete-column + :enable (markdown-table-at-point-p)] + ["Insert Column" markdown-table-insert-column + :enable (markdown-table-at-point-p)] + ["Insert Table" markdown-insert-table] + "--" + ["Convert Region to Table" markdown-table-convert-region] + ["Sort Table Lines" markdown-table-sort-lines + :enable (markdown-table-at-point-p)] + ["Transpose Table" markdown-table-transpose + :enable (markdown-table-at-point-p)]) + ("Lists" + ["Insert List Item" markdown-insert-list-item] + ["Move Subtree Up" markdown-move-up + :keys "C-c <up>"] + ["Move Subtree Down" markdown-move-down + :keys "C-c <down>"] + ["Indent Subtree" markdown-demote + :keys "C-c <right>"] + ["Outdent Subtree" markdown-promote + :keys "C-c <left>"] + ["Renumber List" markdown-cleanup-list-numbers] + ["Insert Task List Item" markdown-insert-gfm-checkbox + :keys "C-c C-x ["] + ["Toggle Task List Item" markdown-toggle-gfm-checkbox + :enable (markdown-gfm-task-list-item-at-point) + :keys "C-c C-d"]) + ("Links & Images" + ["Insert Link" markdown-insert-link] + ["Insert Image" markdown-insert-image] + ["Insert Footnote" markdown-insert-footnote + :keys "C-c C-s f"] + ["Insert Wiki Link" markdown-insert-wiki-link + :keys "C-c C-s w"] + "---" + ["Check References" markdown-check-refs] + ["Find Unused References" markdown-unused-refs] + ["Toggle URL Hiding" markdown-toggle-url-hiding + :style radio + :selected markdown-hide-urls] + ["Toggle Inline Images" markdown-toggle-inline-images + :keys "C-c C-x C-i" + :style radio + :selected markdown-inline-image-overlays] + ["Toggle Wiki Links" markdown-toggle-wiki-links + :style radio + :selected markdown-enable-wiki-links]) + ("Styles" + ["Bold" markdown-insert-bold] + ["Italic" markdown-insert-italic] + ["Code" markdown-insert-code] + ["Strikethrough" markdown-insert-strike-through] + ["Keyboard" markdown-insert-kbd] + "---" + ["Blockquote" markdown-insert-blockquote] + ["Preformatted" markdown-insert-pre] + ["GFM Code Block" markdown-insert-gfm-code-block] + ["Edit Code Block" markdown-edit-code-block + :enable (markdown-code-block-at-point-p)] + ["Foldable Block" markdown-insert-foldable-block] + "---" + ["Blockquote Region" markdown-blockquote-region] + ["Preformatted Region" markdown-pre-region] + "---" + ["Fontify Code Blocks Natively" + markdown-toggle-fontify-code-blocks-natively + :style radio + :selected markdown-fontify-code-blocks-natively] + ["LaTeX Math Support" markdown-toggle-math + :style radio + :selected markdown-enable-math]) + "---" + ("Preview & Export" + ["Compile" markdown-other-window] + ["Preview" markdown-preview] + ["Export" markdown-export] + ["Export & View" markdown-export-and-preview] + ["Open" markdown-open] + ["Live Export" markdown-live-preview-mode + :style radio + :selected markdown-live-preview-mode] + ["Kill ring save" markdown-kill-ring-save]) + ("Markup Completion and Cycling" + ["Complete Markup" markdown-complete] + ["Promote Element" markdown-promote + :keys "C-c C--"] + ["Demote Element" markdown-demote + :keys "C-c C-="]) + "---" + ["Kill Element" markdown-kill-thing-at-point] + "---" + ("Documentation" + ["Version" markdown-show-version] + ["Homepage" markdown-mode-info] + ["Describe Mode" (describe-function 'markdown-mode)] + ["Guide" (browse-url "https://leanpub.com/markdown-mode")]))) + + +;;; imenu ===================================================================== + +(defun markdown-imenu-create-nested-index () + "Create and return a nested imenu index alist for the current buffer. +See `imenu-create-index-function' and `imenu--index-alist' for details." + (let* ((root (list nil)) + (min-level 9999) + hashes headers) + (save-excursion + ;; Headings + (goto-char (point-min)) + (while (re-search-forward markdown-regex-header (point-max) t) + (unless (or (markdown-code-block-at-point-p) + (and (match-beginning 3) + (get-text-property (match-beginning 3) 'markdown-yaml-metadata-end))) + (cond + ((match-string-no-properties 2) ;; level 1 setext + (setq min-level 1) + (push (list :heading (match-string-no-properties 1) + :point (match-beginning 1) + :level 1) headers)) + ((match-string-no-properties 3) ;; level 2 setext + (setq min-level (min min-level 2)) + (push (list :heading (match-string-no-properties 1) + :point (match-beginning 1) + :level (- 2 (1- min-level))) headers)) + ((setq hashes (markdown-trim-whitespace + (match-string-no-properties 4))) + (setq min-level (min min-level (length hashes))) + (push (list :heading (match-string-no-properties 5) + :point (match-beginning 4) + :level (- (length hashes) (1- min-level))) headers))))) + (cl-loop with cur-level = 0 + with cur-alist = nil + with empty-heading = "-" + with self-heading = "." + for header in (reverse headers) + for level = (plist-get header :level) + do + (let ((alist (list (cons (plist-get header :heading) (plist-get header :point))))) + (cond + ((= cur-level level) ; new sibling + (setcdr cur-alist alist) + (setq cur-alist alist)) + ((< cur-level level) ; first child + (dotimes (_ (- level cur-level 1)) + (setq alist (list (cons empty-heading alist)))) + (if cur-alist + (let* ((parent (car cur-alist)) + (self-pos (cdr parent))) + (setcdr parent (cons (cons self-heading self-pos) alist))) + (setcdr root alist)) ; primogenitor + (setq cur-alist alist) + (setq cur-level level)) + (t ; new sibling of an ancestor + (let ((sibling-alist (last (cdr root)))) + (dotimes (_ (1- level)) + (setq sibling-alist (last (cdar sibling-alist)))) + (setcdr sibling-alist alist) + (setq cur-alist alist)) + (setq cur-level level))))) + (setq root (copy-tree root)) + ;; Footnotes + (let ((fn (markdown-get-defined-footnotes))) + (if (or (zerop (length fn)) + (null markdown-add-footnotes-to-imenu)) + (cdr root) + (nconc (cdr root) (list (cons "Footnotes" fn)))))))) + +(defun markdown-imenu-create-flat-index () + "Create and return a flat imenu index alist for the current buffer. +See `imenu-create-index-function' and `imenu--index-alist' for details." + (let* ((empty-heading "-") index heading pos) + (save-excursion + ;; Headings + (goto-char (point-min)) + (while (re-search-forward markdown-regex-header (point-max) t) + (when (and (not (markdown-code-block-at-point-p (line-beginning-position))) + (not (markdown-text-property-at-point 'markdown-yaml-metadata-begin))) + (cond + ((setq heading (match-string-no-properties 1)) + (setq pos (match-beginning 1))) + ((setq heading (match-string-no-properties 5)) + (setq pos (match-beginning 4)))) + (or (> (length heading) 0) + (setq heading empty-heading)) + (setq index (append index (list (cons heading pos)))))) + ;; Footnotes + (when markdown-add-footnotes-to-imenu + (nconc index (markdown-get-defined-footnotes))) + index))) + + +;;; References ================================================================ + +(defun markdown-reference-goto-definition () + "Jump to the definition of the reference at point or create it." + (interactive) + (when (thing-at-point-looking-at markdown-regex-link-reference) + (let* ((text (match-string-no-properties 3)) + (reference (match-string-no-properties 6)) + (target (downcase (if (string= reference "") text reference))) + (loc (cadr (save-match-data (markdown-reference-definition target))))) + (if loc + (goto-char loc) + (goto-char (match-beginning 0)) + (markdown-insert-reference-definition target))))) + +(defun markdown-reference-find-links (reference) + "Return a list of all links for REFERENCE. +REFERENCE should not include the surrounding square brackets. +Elements of the list have the form (text start line), where +text is the link text, start is the location at the beginning of +the link, and line is the line number on which the link appears." + (let* ((ref-quote (regexp-quote reference)) + (regexp (format "!?\\(?:\\[\\(%s\\)\\][ ]?\\[\\]\\|\\[\\([^]]+?\\)\\][ ]?\\[%s\\]\\)" + ref-quote ref-quote)) + links) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward regexp nil t) + (let* ((text (or (match-string-no-properties 1) + (match-string-no-properties 2))) + (start (match-beginning 0)) + (line (markdown-line-number-at-pos))) + (cl-pushnew (list text start line) links :test #'equal)))) + links)) + +(defmacro markdown-for-all-refs (f) + `(let ((result)) + (save-excursion + (goto-char (point-min)) + (while + (re-search-forward markdown-regex-link-reference nil t) + (let* ((text (match-string-no-properties 3)) + (reference (match-string-no-properties 6)) + (target (downcase (if (string= reference "") text reference)))) + (,f text target result)))) + (reverse result))) + +(defmacro markdown-collect-always (_ target result) + `(cl-pushnew ,target ,result :test #'equal)) + +(defmacro markdown-collect-undefined (text target result) + `(unless (markdown-reference-definition target) + (let ((entry (assoc ,target ,result))) + (if (not entry) + (cl-pushnew + (cons ,target (list (cons ,text (markdown-line-number-at-pos)))) + ,result :test #'equal) + (setcdr entry + (append (cdr entry) (list (cons ,text (markdown-line-number-at-pos))))))))) + +(defun markdown-get-all-refs () + "Return a list of all Markdown references." + (markdown-for-all-refs markdown-collect-always)) + +(defun markdown-get-undefined-refs () + "Return a list of undefined Markdown references. +Result is an alist of pairs (reference . occurrences), where +occurrences is itself another alist of pairs (label . line-number). +For example, an alist corresponding to [Nice editor][Emacs] at line 12, +\[GNU Emacs][Emacs] at line 45 and [manual][elisp] at line 127 is +\((\"emacs\" (\"Nice editor\" . 12) (\"GNU Emacs\" . 45)) (\"elisp\" (\"manual\" . 127)))." + (markdown-for-all-refs markdown-collect-undefined)) + +(defun markdown-get-unused-refs () + (cl-sort + (cl-set-difference + (markdown-get-defined-references) (markdown-get-all-refs) + :test (lambda (e1 e2) (equal (car e1) e2))) + #'< :key #'cdr)) + +(defmacro defun-markdown-buffer (name docstring) + "Define a function to name and return a buffer. + +By convention, NAME must be a name of a string constant with +%buffer% placeholder used to name the buffer, and will also be +used as a name of the function defined. + +DOCSTRING will be used as the first part of the docstring." + `(defun ,name (&optional buffer-name) + ,(concat docstring "\n\nBUFFER-NAME is the name of the main buffer being visited.") + (or buffer-name (setq buffer-name (buffer-name))) + (let ((refbuf (get-buffer-create (replace-regexp-in-string + "%buffer%" buffer-name + ,name)))) + (with-current-buffer refbuf + (when view-mode + (View-exit-and-edit)) + (use-local-map button-buffer-map) + (erase-buffer)) + refbuf))) + +(defconst markdown-reference-check-buffer + "*Undefined references for %buffer%*" + "Pattern for name of buffer for listing undefined references. +The string %buffer% will be replaced by the corresponding +`markdown-mode' buffer name.") + +(defun-markdown-buffer + markdown-reference-check-buffer + "Name and return buffer for reference checking.") + +(defconst markdown-unused-references-buffer + "*Unused references for %buffer%*" + "Pattern for name of buffer for listing unused references. +The string %buffer% will be replaced by the corresponding +`markdown-mode' buffer name.") + +(defun-markdown-buffer + markdown-unused-references-buffer + "Name and return buffer for unused reference checking.") + +(defconst markdown-reference-links-buffer + "*Reference links for %buffer%*" + "Pattern for name of buffer for listing references. +The string %buffer% will be replaced by the corresponding buffer name.") + +(defun-markdown-buffer + markdown-reference-links-buffer + "Name, setup, and return a buffer for listing links.") + +;; Add an empty Markdown reference definition to buffer +;; specified in the 'target-buffer property. The reference name is +;; the button's label. +(define-button-type 'markdown-undefined-reference-button + 'help-echo "mouse-1, RET: create definition for undefined reference" + 'follow-link t + 'face 'bold + 'action (lambda (b) + (let ((buffer (button-get b 'target-buffer)) + (line (button-get b 'target-line)) + (label (button-label b))) + (switch-to-buffer-other-window buffer) + (goto-char (point-min)) + (forward-line line) + (markdown-insert-reference-definition label) + (markdown-check-refs t)))) + +;; Jump to line in buffer specified by 'target-buffer property. +;; Line number is button's 'target-line property. +(define-button-type 'markdown-goto-line-button + 'help-echo "mouse-1, RET: go to line" + 'follow-link t + 'face 'italic + 'action (lambda (b) + (switch-to-buffer-other-window (button-get b 'target-buffer)) + ;; use call-interactively to silence compiler + (let ((current-prefix-arg (button-get b 'target-line))) + (call-interactively 'goto-line)))) + +;; Kill a line in buffer specified by 'target-buffer property. +;; Line number is button's 'target-line property. +(define-button-type 'markdown-kill-line-button + 'help-echo "mouse-1, RET: kill line" + 'follow-link t + 'face 'italic + 'action (lambda (b) + (switch-to-buffer-other-window (button-get b 'target-buffer)) + ;; use call-interactively to silence compiler + (let ((current-prefix-arg (button-get b 'target-line))) + (call-interactively 'goto-line)) + (kill-line 1) + (markdown-unused-refs t))) + +;; Jumps to a particular link at location given by 'target-char +;; property in buffer given by 'target-buffer property. +(define-button-type 'markdown-location-button + 'help-echo "mouse-1, RET: jump to location of link" + 'follow-link t + 'face 'bold + 'action (lambda (b) + (let ((target (button-get b 'target-buffer)) + (loc (button-get b 'target-char))) + (kill-buffer-and-window) + (switch-to-buffer target) + (goto-char loc)))) + +(defun markdown-insert-undefined-reference-button (reference oldbuf) + "Insert a button for creating REFERENCE in buffer OLDBUF. +REFERENCE should be a list of the form (reference . occurrences), +as returned by `markdown-get-undefined-refs'." + (let ((label (car reference))) + ;; Create a reference button + (insert-button label + :type 'markdown-undefined-reference-button + 'target-buffer oldbuf + 'target-line (cdr (car (cdr reference)))) + (insert " (") + (dolist (occurrence (cdr reference)) + (let ((line (cdr occurrence))) + ;; Create a line number button + (insert-button (number-to-string line) + :type 'markdown-goto-line-button + 'target-buffer oldbuf + 'target-line line) + (insert " "))) + (delete-char -1) + (insert ")") + (newline))) + +(defun markdown-insert-unused-reference-button (reference oldbuf) + "Insert a button for creating REFERENCE in buffer OLDBUF. +REFERENCE must be a pair of (ref . line-number)." + (let ((label (car reference)) + (line (cdr reference))) + ;; Create a reference button + (insert-button label + :type 'markdown-goto-line-button + 'face 'bold + 'target-buffer oldbuf + 'target-line line) + (insert (format " (%d) [" line)) + (insert-button "X" + :type 'markdown-kill-line-button + 'face 'bold + 'target-buffer oldbuf + 'target-line line) + (insert "]") + (newline))) + +(defun markdown-insert-link-button (link oldbuf) + "Insert a button for jumping to LINK in buffer OLDBUF. +LINK should be a list of the form (text char line) containing +the link text, location, and line number." + (let ((label (cl-first link)) + (char (cl-second link)) + (line (cl-third link))) + ;; Create a reference button + (insert-button label + :type 'markdown-location-button + 'target-buffer oldbuf + 'target-char char) + (insert (format " (line %d)\n" line)))) + +(defun markdown-reference-goto-link (&optional reference) + "Jump to the location of the first use of REFERENCE." + (interactive) + (unless reference + (if (thing-at-point-looking-at markdown-regex-reference-definition) + (setq reference (match-string-no-properties 2)) + (user-error "No reference definition at point"))) + (let ((links (markdown-reference-find-links reference))) + (cond ((= (length links) 1) + (goto-char (cadr (car links)))) + ((> (length links) 1) + (let ((oldbuf (current-buffer)) + (linkbuf (markdown-reference-links-buffer))) + (with-current-buffer linkbuf + (insert "Links using reference " reference ":\n\n") + (dolist (link (reverse links)) + (markdown-insert-link-button link oldbuf))) + (view-buffer-other-window linkbuf) + (goto-char (point-min)) + (forward-line 2))) + (t + (error "No links for reference %s" reference))))) + +(defmacro defun-markdown-ref-checker + (name docstring checker-function buffer-function none-message buffer-header insert-reference) + "Define a function NAME acting on result of CHECKER-FUNCTION. + +DOCSTRING is used as a docstring for the defined function. + +BUFFER-FUNCTION should name and return an auxiliary buffer to put +results in. + +NONE-MESSAGE is used when CHECKER-FUNCTION returns no results. + +BUFFER-HEADER is put into the auxiliary buffer first, followed by +calling INSERT-REFERENCE for each element in the list returned by +CHECKER-FUNCTION." + `(defun ,name (&optional silent) + ,(concat + docstring + "\n\nIf SILENT is non-nil, do not message anything when no +such references found.") + (interactive "P") + (unless (derived-mode-p 'markdown-mode) + (user-error "Not available in current mode")) + (let ((oldbuf (current-buffer)) + (refs (,checker-function)) + (refbuf (,buffer-function))) + (if (null refs) + (progn + (when (not silent) + (message ,none-message)) + (kill-buffer refbuf)) + (with-current-buffer refbuf + (insert ,buffer-header) + (dolist (ref refs) + (,insert-reference ref oldbuf)) + (view-buffer-other-window refbuf) + (goto-char (point-min)) + (forward-line 2)))))) + +(defun-markdown-ref-checker + markdown-check-refs + "Show all undefined Markdown references in current `markdown-mode' buffer. + +Links which have empty reference definitions are considered to be +defined." + markdown-get-undefined-refs + markdown-reference-check-buffer + "No undefined references found" + "The following references are undefined:\n\n" + markdown-insert-undefined-reference-button) + + +(defun-markdown-ref-checker + markdown-unused-refs + "Show all unused Markdown references in current `markdown-mode' buffer." + markdown-get-unused-refs + markdown-unused-references-buffer + "No unused references found" + "The following references are unused:\n\n" + markdown-insert-unused-reference-button) + + + +;;; Lists ===================================================================== + +(defun markdown-insert-list-item (&optional arg) + "Insert a new list item. +If the point is inside unordered list, insert a bullet mark. If +the point is inside ordered list, insert the next number followed +by a period. Use the previous list item to determine the amount +of whitespace to place before and after list markers. + +With a \\[universal-argument] prefix (i.e., when ARG is (4)), +decrease the indentation by one level. + +With two \\[universal-argument] prefixes (i.e., when ARG is (16)), +increase the indentation by one level." + (interactive "p") + (let (bounds cur-indent marker indent new-indent new-loc) + (save-match-data + ;; Look for a list item on current or previous non-blank line + (save-excursion + (while (and (not (setq bounds (markdown-cur-list-item-bounds))) + (not (bobp)) + (markdown-cur-line-blank-p)) + (forward-line -1))) + (when bounds + (cond ((save-excursion + (skip-chars-backward " \t") + (looking-at-p markdown-regex-list)) + (beginning-of-line) + (insert "\n") + (forward-line -1)) + ((not (markdown-cur-line-blank-p)) + (newline))) + (setq new-loc (point))) + ;; Look ahead for a list item on next non-blank line + (unless bounds + (save-excursion + (while (and (null bounds) + (not (eobp)) + (markdown-cur-line-blank-p)) + (forward-line) + (setq bounds (markdown-cur-list-item-bounds)))) + (when bounds + (setq new-loc (point)) + (unless (markdown-cur-line-blank-p) + (newline)))) + (if (not bounds) + ;; When not in a list, start a new unordered one + (progn + (unless (markdown-cur-line-blank-p) + (insert "\n")) + (insert markdown-unordered-list-item-prefix)) + ;; Compute indentation and marker for new list item + (setq cur-indent (nth 2 bounds)) + (setq marker (nth 4 bounds)) + ;; If current item is a GFM checkbox, insert new unchecked checkbox. + (when (nth 5 bounds) + (setq marker + (concat marker + (replace-regexp-in-string "[Xx]" " " (nth 5 bounds))))) + (cond + ;; Dedent: decrement indentation, find previous marker. + ((= arg 4) + (setq indent (max (- cur-indent markdown-list-indent-width) 0)) + (let ((prev-bounds + (save-excursion + (goto-char (nth 0 bounds)) + (when (markdown-up-list) + (markdown-cur-list-item-bounds))))) + (when prev-bounds + (setq marker (nth 4 prev-bounds))))) + ;; Indent: increment indentation by 4, use same marker. + ((= arg 16) (setq indent (+ cur-indent markdown-list-indent-width))) + ;; Same level: keep current indentation and marker. + (t (setq indent cur-indent))) + (setq new-indent (make-string indent 32)) + (goto-char new-loc) + (cond + ;; Ordered list + ((string-match-p "[0-9]" marker) + (if (= arg 16) ;; starting a new column indented one more level + (insert (concat new-indent "1. ")) + ;; Don't use previous match-data + (set-match-data nil) + ;; travel up to the last item and pick the correct number. If + ;; the argument was nil, "new-indent = cur-indent" is the same, + ;; so we don't need special treatment. Neat. + (save-excursion + (while (and (not (looking-at (concat new-indent "\\([0-9]+\\)\\(\\.[ \t]*\\)"))) + (>= (forward-line -1) 0)))) + (let* ((old-prefix (match-string 1)) + (old-spacing (match-string 2)) + (new-prefix (if (and old-prefix markdown-ordered-list-enumeration) + (int-to-string (1+ (string-to-number old-prefix))) + "1")) + (space-adjust (- (length old-prefix) (length new-prefix))) + (new-spacing (if (and (match-string 2) + (not (string-match-p "\t" old-spacing)) + (< space-adjust 0) + (> space-adjust (- 1 (length (match-string 2))))) + (substring (match-string 2) 0 space-adjust) + (or old-spacing ". ")))) + (insert (concat new-indent new-prefix new-spacing))))) + ;; Unordered list, GFM task list, or ordered list with hash mark + ((string-match-p "[\\*\\+-]\\|#\\." marker) + (insert new-indent marker)))) + ;; Propertize the newly inserted list item now + (markdown-syntax-propertize-list-items (line-beginning-position) (line-end-position))))) + +(defun markdown-move-list-item-up () + "Move the current list item up in the list when possible. +In nested lists, move child items with the parent item." + (interactive) + (let (cur prev old) + (when (setq cur (markdown-cur-list-item-bounds)) + (setq old (point)) + (goto-char (nth 0 cur)) + (if (markdown-prev-list-item (nth 3 cur)) + (progn + (setq prev (markdown-cur-list-item-bounds)) + (condition-case nil + (progn + (transpose-regions (nth 0 prev) (nth 1 prev) + (nth 0 cur) (nth 1 cur) t) + (goto-char (+ (nth 0 prev) (- old (nth 0 cur))))) + ;; Catch error in case regions overlap. + (error (goto-char old)))) + (goto-char old))))) + +(defun markdown-move-list-item-down () + "Move the current list item down in the list when possible. +In nested lists, move child items with the parent item." + (interactive) + (let (cur next old) + (when (setq cur (markdown-cur-list-item-bounds)) + (setq old (point)) + (if (markdown-next-list-item (nth 3 cur)) + (progn + (setq next (markdown-cur-list-item-bounds)) + (condition-case nil + (progn + (transpose-regions (nth 0 cur) (nth 1 cur) + (nth 0 next) (nth 1 next) nil) + (goto-char (+ old (- (nth 1 next) (nth 1 cur))))) + ;; Catch error in case regions overlap. + (error (goto-char old)))) + (goto-char old))))) + +(defun markdown-demote-list-item (&optional bounds) + "Indent (or demote) the current list item. +Optionally, BOUNDS of the current list item may be provided if available. +In nested lists, demote child items as well." + (interactive) + (when (or bounds (setq bounds (markdown-cur-list-item-bounds))) + (save-excursion + (let* ((item-start (set-marker (make-marker) (nth 0 bounds))) + (item-end (set-marker (make-marker) (nth 1 bounds))) + (list-start (progn (markdown-beginning-of-list) + (set-marker (make-marker) (point)))) + (list-end (progn (markdown-end-of-list) + (set-marker (make-marker) (point))))) + (goto-char item-start) + (while (< (point) item-end) + (unless (markdown-cur-line-blank-p) + (insert (make-string markdown-list-indent-width ? ))) + (forward-line)) + (markdown-syntax-propertize-list-items list-start list-end))))) + +(defun markdown-promote-list-item (&optional bounds) + "Unindent (or promote) the current list item. +Optionally, BOUNDS of the current list item may be provided if available. +In nested lists, demote child items as well." + (interactive) + (when (or bounds (setq bounds (markdown-cur-list-item-bounds))) + (save-excursion + (save-match-data + (let ((item-start (set-marker (make-marker) (nth 0 bounds))) + (item-end (set-marker (make-marker) (nth 1 bounds))) + (list-start (progn (markdown-beginning-of-list) + (set-marker (make-marker) (point)))) + (list-end (progn (markdown-end-of-list) + (set-marker (make-marker) (point)))) + num regexp) + (goto-char item-start) + (when (looking-at (format "^[ ]\\{1,%d\\}" + markdown-list-indent-width)) + (setq num (- (match-end 0) (match-beginning 0))) + (setq regexp (format "^[ ]\\{1,%d\\}" num)) + (while (and (< (point) item-end) + (re-search-forward regexp item-end t)) + (replace-match "" nil nil) + (forward-line)) + (markdown-syntax-propertize-list-items list-start list-end))))))) + +(defun markdown-cleanup-list-numbers-level (&optional pfx prev-item) + "Update the numbering for level PFX (as a string of spaces) and PREV-ITEM. +PREV-ITEM is width of previous-indentation and list number + +Assume that the previously found match was for a numbered item in +a list." + (let ((cpfx pfx) + (cur-item nil) + (idx 0) + (continue t) + (step t) + (sep nil)) + (while (and continue (not (eobp))) + (setq step t) + (cond + ((looking-at "^\\(\\([\s-]*\\)[0-9]+\\)\\. ") + (setq cpfx (match-string-no-properties 2)) + (setq cur-item (match-string-no-properties 1)) ;; indentation and list marker + (cond + ((or (= (length cpfx) (length pfx)) + (= (length cur-item) (length prev-item))) + (save-excursion + (replace-match + (if (not markdown-ordered-list-enumeration) + (concat pfx "1. ") + (cl-incf idx) + (concat pfx (number-to-string idx) ". ")))) + (setq sep nil)) + ;; indented a level + ((< (length pfx) (length cpfx)) + (setq sep (markdown-cleanup-list-numbers-level cpfx cur-item)) + (setq step nil)) + ;; exit the loop + (t + (setq step nil) + (setq continue nil)))) + + ((looking-at "^\\([\s-]*\\)[^ \t\n\r].*$") + (setq cpfx (match-string-no-properties 1)) + (cond + ;; reset if separated before + ((string= cpfx pfx) (when sep (setq idx 0))) + ((string< cpfx pfx) + (setq step nil) + (setq continue nil)))) + (t (setq sep t))) + + (when step + (beginning-of-line) + (setq continue (= (forward-line) 0)))) + sep)) + +(defun markdown-cleanup-list-numbers () + "Update the numbering of ordered lists." + (interactive) + (save-excursion + (goto-char (point-min)) + (markdown-cleanup-list-numbers-level ""))) + + +;;; Movement ================================================================== + +;; This function was originally derived from `org-beginning-of-line' from org.el. +(defun markdown-beginning-of-line (&optional n) + "Go to the beginning of the current visible line. + +If this is a headline, and `markdown-special-ctrl-a/e' is not nil +or symbol `reversed', on the first attempt move to where the +headline text hashes, and only move to beginning of line when the +cursor is already before the hashes of the text of the headline. + +If `markdown-special-ctrl-a/e' is symbol `reversed' then go to +the hashes of the text on the second attempt. + +With argument N not nil or 1, move forward N - 1 lines first." + (interactive "^p") + (let ((origin (point)) + (special (pcase markdown-special-ctrl-a/e + (`(,C-a . ,_) C-a) (_ markdown-special-ctrl-a/e))) + deactivate-mark) + ;; First move to a visible line. + (if visual-line-mode + (beginning-of-visual-line n) + (move-beginning-of-line n) + ;; `move-beginning-of-line' may leave point after invisible + ;; characters if line starts with such of these (e.g., with + ;; a link at column 0). Really move to the beginning of the + ;; current visible line. + (forward-line 0)) + (cond + ;; No special behavior. Point is already at the beginning of + ;; a line, logical or visual. + ((not special)) + ;; `beginning-of-visual-line' left point before logical beginning + ;; of line: point is at the beginning of a visual line. Bail + ;; out. + ((and visual-line-mode (not (bolp)))) + ((looking-at markdown-regex-header-atx) + ;; At a header, special position is before the title. + (let ((refpos (match-beginning 2)) + (bol (point))) + (if (eq special 'reversed) + (when (and (= origin bol) (eq last-command this-command)) + (goto-char refpos)) + (when (or (> origin refpos) (<= origin bol)) + (goto-char refpos))) + ;; Prevent automatic cursor movement caused by the command loop. + ;; Enable disable-point-adjustment to avoid unintended cursor repositioning. + (when (and markdown-hide-markup + (equal (get-char-property (point) 'display) "")) + (setq disable-point-adjustment t)))) + ((looking-at markdown-regex-list) + ;; At a list item, special position is after the list marker or checkbox. + (let ((refpos (or (match-end 4) (match-end 3)))) + (if (eq special 'reversed) + (when (and (= (point) origin) (eq last-command this-command)) + (goto-char refpos)) + (when (or (> origin refpos) (<= origin (line-beginning-position))) + (goto-char refpos))))) + ;; No special case, already at beginning of line. + (t nil)))) + +;; This function was originally derived from `org-end-of-line' from org.el. +(defun markdown-end-of-line (&optional n) + "Go to the end of the line, but before ellipsis, if any. + +If this is a headline, and `markdown-special-ctrl-a/e' is not nil +or symbol `reversed', ignore closing tags on the first attempt, +and only move to after the closing tags when the cursor is +already beyond the end of the headline. + +If `markdown-special-ctrl-a/e' is symbol `reversed' then ignore +closing tags on the second attempt. + +With argument N not nil or 1, move forward N - 1 lines first." + (interactive "^p") + (let ((origin (point)) + (special (pcase markdown-special-ctrl-a/e + (`(,_ . ,C-e) C-e) (_ markdown-special-ctrl-a/e))) + deactivate-mark) + ;; First move to a visible line. + (if visual-line-mode + (beginning-of-visual-line n) + (move-beginning-of-line n)) + (cond + ;; At a headline, with closing tags. + ((save-excursion + (forward-line 0) + (and (looking-at markdown-regex-header-atx) (match-end 3))) + (let ((refpos (match-end 2)) + (visual-end (and visual-line-mode + (save-excursion + (end-of-visual-line) + (point))))) + ;; If `end-of-visual-line' brings us before end of line or even closing + ;; tags, i.e., the headline spans over multiple visual lines, move + ;; there. + (cond ((and visual-end + (< visual-end refpos) + (<= origin visual-end)) + (goto-char visual-end)) + ((not special) (end-of-line)) + ((eq special 'reversed) + (if (and (= origin (line-end-position)) + (eq this-command last-command)) + (goto-char refpos) + (end-of-line))) + (t + (if (or (< origin refpos) (>= origin (line-end-position))) + (goto-char refpos) + (end-of-line)))) + ;; Prevent automatic cursor movement caused by the command loop. + ;; Enable disable-point-adjustment to avoid unintended cursor repositioning. + (when (and markdown-hide-markup + (equal (get-char-property (point) 'display) "")) + (setq disable-point-adjustment t)))) + (visual-line-mode + (let ((bol (line-beginning-position))) + (end-of-visual-line) + ;; If `end-of-visual-line' gets us past the ellipsis at the + ;; end of a line, backtrack and use `end-of-line' instead. + (when (/= bol (line-beginning-position)) + (goto-char bol) + (end-of-line)))) + (t (end-of-line))))) + +(defun markdown-beginning-of-defun (&optional arg) + "`beginning-of-defun-function' for Markdown. +This is used to find the beginning of the defun and should behave +like ‘beginning-of-defun’, returning non-nil if it found the +beginning of a defun. It moves the point backward, right before a +heading which defines a defun. When ARG is non-nil, repeat that +many times. When ARG is negative, move forward to the ARG-th +following section." + (or arg (setq arg 1)) + (when (< arg 0) (end-of-line)) + ;; Adjust position for setext headings. + (when (and (thing-at-point-looking-at markdown-regex-header-setext) + (not (= (point) (match-beginning 0))) + (not (markdown-code-block-at-point-p))) + (goto-char (match-end 0))) + (let (found) + ;; Move backward with positive argument. + (while (and (not (bobp)) (> arg 0)) + (setq found nil) + (while (and (not found) + (not (bobp)) + (re-search-backward markdown-regex-header nil 'move)) + (markdown-code-block-at-pos (match-beginning 0)) + (setq found (match-beginning 0))) + (setq arg (1- arg))) + ;; Move forward with negative argument. + (while (and (not (eobp)) (< arg 0)) + (setq found nil) + (while (and (not found) + (not (eobp)) + (re-search-forward markdown-regex-header nil 'move)) + (markdown-code-block-at-pos (match-beginning 0)) + (setq found (match-beginning 0))) + (setq arg (1+ arg))) + (when found + (beginning-of-line) + t))) + +(defun markdown-end-of-defun () + "`end-of-defun-function’ for Markdown. +This is used to find the end of the defun at point. +It is called with no argument, right after calling ‘beginning-of-defun-raw’, +so it can assume that point is at the beginning of the defun body. +It should move point to the first position after the defun." + (or (eobp) (forward-char 1)) + (let (found) + (while (and (not found) + (not (eobp)) + (re-search-forward markdown-regex-header nil 'move)) + (when (not (markdown-code-block-at-pos (match-beginning 0))) + (setq found (match-beginning 0)))) + (when found + (goto-char found) + (skip-syntax-backward "-")))) + +(defun markdown-beginning-of-text-block () + "Move backward to previous beginning of a plain text block. +This function simply looks for blank lines without considering +the surrounding context in light of Markdown syntax. For that, see +`markdown-backward-block'." + (interactive) + (let ((start (point))) + (if (re-search-backward markdown-regex-block-separator nil t) + (goto-char (match-end 0)) + (goto-char (point-min))) + (when (and (= start (point)) (not (bobp))) + (forward-line -1) + (if (re-search-backward markdown-regex-block-separator nil t) + (goto-char (match-end 0)) + (goto-char (point-min)))))) + +(defun markdown-end-of-text-block () + "Move forward to next beginning of a plain text block. +This function simply looks for blank lines without considering +the surrounding context in light of Markdown syntax. For that, see +`markdown-forward-block'." + (interactive) + (beginning-of-line) + (skip-chars-forward " \t\n") + (when (= (point) (point-min)) + (forward-char)) + (if (re-search-forward markdown-regex-block-separator nil t) + (goto-char (match-end 0)) + (goto-char (point-max))) + (skip-chars-backward " \t\n") + (forward-line)) + +(defun markdown-backward-paragraph (&optional arg) + "Move the point to the start of the current paragraph. +With argument ARG, do it ARG times; a negative argument ARG = -N +means move forward N blocks." + (interactive "^p") + (or arg (setq arg 1)) + (if (< arg 0) + (markdown-forward-paragraph (- arg)) + (dotimes (_ arg) + ;; Skip over whitespace in between paragraphs when moving backward. + (skip-chars-backward " \t\n") + (beginning-of-line) + ;; Skip over code block endings. + (when (markdown-range-properties-exist + (line-beginning-position) (line-end-position) + '(markdown-gfm-block-end + markdown-tilde-fence-end)) + (forward-line -1)) + ;; Skip over blank lines inside blockquotes. + (while (and (not (eobp)) + (looking-at markdown-regex-blockquote) + (= (length (match-string 3)) 0)) + (forward-line -1)) + ;; Proceed forward based on the type of block of paragraph. + (let (bounds skip) + (cond + ;; Blockquotes + ((looking-at markdown-regex-blockquote) + (while (and (not (bobp)) + (looking-at markdown-regex-blockquote) + (> (length (match-string 3)) 0)) ;; not blank + (forward-line -1)) + (forward-line)) + ;; List items + ((setq bounds (markdown-cur-list-item-bounds)) + (goto-char (nth 0 bounds))) + ;; Other + (t + (while (and (not (bobp)) + (not skip) + (not (markdown-cur-line-blank-p)) + (not (looking-at markdown-regex-blockquote)) + (not (markdown-range-properties-exist + (line-beginning-position) (line-end-position) + '(markdown-gfm-block-end + markdown-tilde-fence-end)))) + (setq skip (markdown-range-properties-exist + (line-beginning-position) (line-end-position) + '(markdown-gfm-block-begin + markdown-tilde-fence-begin))) + (forward-line -1)) + (unless (bobp) + (forward-line 1)))))))) + +(defun markdown-forward-paragraph (&optional arg) + "Move forward to the next end of a paragraph. +With argument ARG, do it ARG times; a negative argument ARG = -N +means move backward N blocks." + (interactive "^p") + (or arg (setq arg 1)) + (if (< arg 0) + (markdown-backward-paragraph (- arg)) + (dotimes (_ arg) + ;; Skip whitespace in between paragraphs. + (when (markdown-cur-line-blank-p) + (skip-syntax-forward "-") + (beginning-of-line)) + ;; Proceed forward based on the type of block. + (let (bounds skip) + (cond + ;; Blockquotes + ((looking-at markdown-regex-blockquote) + ;; Skip over blank lines inside blockquotes. + (while (and (not (eobp)) + (looking-at markdown-regex-blockquote) + (= (length (match-string 3)) 0)) + (forward-line)) + ;; Move to end of quoted text block + (while (and (not (eobp)) + (looking-at markdown-regex-blockquote) + (> (length (match-string 3)) 0)) ;; not blank + (forward-line))) + ;; List items + ((and (markdown-cur-list-item-bounds) + (setq bounds (markdown-next-list-item-bounds))) + (goto-char (nth 0 bounds))) + ;; Other + (t + (forward-line) + (while (and (not (eobp)) + (not skip) + (not (markdown-cur-line-blank-p)) + (not (looking-at markdown-regex-blockquote)) + (not (markdown-range-properties-exist + (line-beginning-position) (line-end-position) + '(markdown-gfm-block-begin + markdown-tilde-fence-begin)))) + (setq skip (markdown-range-properties-exist + (line-beginning-position) (line-end-position) + '(markdown-gfm-block-end + markdown-tilde-fence-end))) + (forward-line)))))))) + +(defun markdown-backward-block (&optional arg) + "Move the point to the start of the current Markdown block. +Moves across complete code blocks, list items, and blockquotes, +but otherwise stops at blank lines, headers, and horizontal +rules. With argument ARG, do it ARG times; a negative argument +ARG = -N means move forward N blocks." + (interactive "^p") + (or arg (setq arg 1)) + (if (< arg 0) + (markdown-forward-block (- arg)) + (dotimes (_ arg) + ;; Skip over whitespace in between blocks when moving backward, + ;; unless at a block boundary with no whitespace. + (skip-syntax-backward "-") + (beginning-of-line) + ;; Proceed forward based on the type of block. + (cond + ;; Code blocks + ((and (markdown-code-block-at-pos (point)) ;; this line + (markdown-code-block-at-pos (line-beginning-position 0))) ;; previous line + (forward-line -1) + (while (and (markdown-code-block-at-point-p) (not (bobp))) + (forward-line -1)) + (forward-line)) + ;; Headings + ((markdown-heading-at-point) + (goto-char (match-beginning 0))) + ;; Horizontal rules + ((looking-at markdown-regex-hr)) + ;; Blockquotes + ((looking-at markdown-regex-blockquote) + (forward-line -1) + (while (and (looking-at markdown-regex-blockquote) + (not (bobp))) + (forward-line -1)) + (forward-line)) + ;; List items + ((markdown-cur-list-item-bounds) + (markdown-beginning-of-list)) + ;; Other + (t + ;; Move forward in case it is a one line regular paragraph. + (unless (markdown-next-line-blank-p) + (forward-line)) + (unless (markdown-prev-line-blank-p) + (markdown-backward-paragraph))))))) + +(defun markdown-forward-block (&optional arg) + "Move forward to the next end of a Markdown block. +Moves across complete code blocks, list items, and blockquotes, +but otherwise stops at blank lines, headers, and horizontal +rules. With argument ARG, do it ARG times; a negative argument +ARG = -N means move backward N blocks." + (interactive "^p") + (or arg (setq arg 1)) + (if (< arg 0) + (markdown-backward-block (- arg)) + (dotimes (_ arg) + ;; Skip over whitespace in between blocks when moving forward. + (if (markdown-cur-line-blank-p) + (skip-syntax-forward "-") + (beginning-of-line)) + ;; Proceed forward based on the type of block. + (cond + ;; Code blocks + ((markdown-code-block-at-point-p) + (forward-line) + (while (and (markdown-code-block-at-point-p) (not (eobp))) + (forward-line))) + ;; Headings + ((looking-at markdown-regex-header) + (goto-char (or (match-end 4) (match-end 2) (match-end 3))) + (forward-line)) + ;; Horizontal rules + ((looking-at markdown-regex-hr) + (forward-line)) + ;; Blockquotes + ((looking-at markdown-regex-blockquote) + (forward-line) + (while (and (looking-at markdown-regex-blockquote) (not (eobp))) + (forward-line))) + ;; List items + ((markdown-cur-list-item-bounds) + (markdown-end-of-list) + (forward-line)) + ;; Other + (t (markdown-forward-paragraph)))) + (skip-syntax-backward "-") + (unless (eobp) + (forward-char 1)))) + +(defun markdown-backward-page (&optional count) + "Move backward to boundary of the current toplevel section. +With COUNT, repeat, or go forward if negative." + (interactive "p") + (or count (setq count 1)) + (if (< count 0) + (markdown-forward-page (- count)) + (skip-syntax-backward "-") + (or (markdown-back-to-heading-over-code-block t t) + (goto-char (point-min))) + (when (looking-at markdown-regex-header) + (let ((level (markdown-outline-level))) + (when (> level 1) (markdown-up-heading level)) + (when (> count 1) + (condition-case nil + (markdown-backward-same-level (1- count)) + (error (goto-char (point-min))))))))) + +(defun markdown-forward-page (&optional count) + "Move forward to boundary of the current toplevel section. +With COUNT, repeat, or go backward if negative." + (interactive "p") + (or count (setq count 1)) + (if (< count 0) + (markdown-backward-page (- count)) + (if (markdown-back-to-heading-over-code-block t t) + (let ((level (markdown-outline-level))) + (when (> level 1) (markdown-up-heading level)) + (condition-case nil + (markdown-forward-same-level count) + (error (goto-char (point-max))))) + (markdown-next-visible-heading 1)))) + +(defun markdown-next-link () + "Jump to next inline, reference, or wiki link. +If successful, return point. Otherwise, return nil. +See `markdown-wiki-link-p' and `markdown-previous-wiki-link'." + (interactive) + (let ((opoint (point))) + (when (or (markdown-link-p) (markdown-wiki-link-p)) + ;; At a link already, move past it. + (goto-char (+ (match-end 0) 1))) + ;; Search for the next wiki link and move to the beginning. + (while (and (re-search-forward (markdown-make-regex-link-generic) nil t) + (markdown-code-block-at-point-p) + (< (point) (point-max)))) + (if (and (not (eq (point) opoint)) + (or (markdown-link-p) (markdown-wiki-link-p))) + ;; Group 1 will move past non-escape character in wiki link regexp. + ;; Go to beginning of group zero for all other link types. + (goto-char (or (match-beginning 1) (match-beginning 0))) + (goto-char opoint) + nil))) + +(defun markdown-previous-link () + "Jump to previous wiki link. +If successful, return point. Otherwise, return nil. +See `markdown-wiki-link-p' and `markdown-next-wiki-link'." + (interactive) + (let ((opoint (point))) + (while (and (re-search-backward (markdown-make-regex-link-generic) nil t) + (markdown-code-block-at-point-p) + (> (point) (point-min)))) + (if (and (not (eq (point) opoint)) + (or (markdown-link-p) (markdown-wiki-link-p))) + (goto-char (or (match-beginning 1) (match-beginning 0))) + (goto-char opoint) + nil))) + + +;;; Outline =================================================================== + +(defun markdown-move-heading-common (move-fn &optional arg adjust) + "Wrapper for `outline-mode' functions to skip false positives. +MOVE-FN is a function and ARG is its argument. For example, +headings inside preformatted code blocks may match +`outline-regexp' but should not be considered as headings. +When ADJUST is non-nil, adjust the point for interactive calls +to avoid leaving the point at invisible markup. This adjustment +generally should only be done for interactive calls, since other +functions may expect the point to be at the beginning of the +regular expression." + (let ((prev -1) (start (point))) + (if arg (funcall move-fn arg) (funcall move-fn)) + (while (and (/= prev (point)) (markdown-code-block-at-point-p)) + (setq prev (point)) + (if arg (funcall move-fn arg) (funcall move-fn))) + ;; Adjust point for setext headings and invisible text. + (save-match-data + (when (and adjust (thing-at-point-looking-at markdown-regex-header)) + (if markdown-hide-markup + ;; Move to beginning of heading text if markup is hidden. + (goto-char (or (match-beginning 1) (match-beginning 5))) + ;; Move to beginning of markup otherwise. + (goto-char (or (match-beginning 1) (match-beginning 4)))))) + (if (= (point) start) nil (point)))) + +(defun markdown-next-visible-heading (arg) + "Move to the next visible heading line of any level. +With argument, repeats or can move backward if negative. ARG is +passed to `outline-next-visible-heading'." + (interactive "p") + (markdown-move-heading-common #'outline-next-visible-heading arg 'adjust)) + +(defun markdown-previous-visible-heading (arg) + "Move to the previous visible heading line of any level. +With argument, repeats or can move backward if negative. ARG is +passed to `outline-previous-visible-heading'." + (interactive "p") + (markdown-move-heading-common #'outline-previous-visible-heading arg 'adjust)) + +(defun markdown-next-heading () + "Move to the next heading line of any level." + (markdown-move-heading-common #'outline-next-heading)) + +(defun markdown-previous-heading () + "Move to the previous heading line of any level." + (markdown-move-heading-common #'outline-previous-heading)) + +(defun markdown-back-to-heading-over-code-block (&optional invisible-ok no-error) + "Move back to the beginning of the previous heading. +Returns t if the point is at a heading, the location if a heading +was found, and nil otherwise. +Only visible heading lines are considered, unless INVISIBLE-OK is +non-nil. Throw an error if there is no previous heading unless +NO-ERROR is non-nil. +Leaves match data intact for `markdown-regex-header'." + (beginning-of-line) + (or (and (markdown-heading-at-point) + (not (markdown-code-block-at-point-p))) + (let (found) + (save-excursion + (while (and (not found) + (re-search-backward markdown-regex-header nil t)) + (when (and (or invisible-ok (not (outline-invisible-p))) + (not (markdown-code-block-at-point-p))) + (setq found (point)))) + (if (not found) + (unless no-error (user-error "Before first heading")) + (setq found (point)))) + (when found (goto-char found))))) + +(defun markdown-forward-same-level (arg) + "Move forward to the ARG'th heading at same level as this one. +Stop at the first and last headings of a superior heading." + (interactive "p") + (markdown-back-to-heading-over-code-block) + (markdown-move-heading-common #'outline-forward-same-level arg 'adjust)) + +(defun markdown-backward-same-level (arg) + "Move backward to the ARG'th heading at same level as this one. +Stop at the first and last headings of a superior heading." + (interactive "p") + (markdown-back-to-heading-over-code-block) + (while (> arg 0) + (let ((point-to-move-to + (save-excursion + (markdown-move-heading-common #'outline-get-last-sibling nil 'adjust)))) + (if point-to-move-to + (progn + (goto-char point-to-move-to) + (setq arg (1- arg))) + (user-error "No previous same-level heading"))))) + +(defun markdown-up-heading (arg &optional interactive) + "Move to the visible heading line of which the present line is a subheading. +With argument, move up ARG levels. When called interactively (or +INTERACTIVE is non-nil), also push the mark." + (interactive "p\np") + (and interactive (not (eq last-command 'markdown-up-heading)) + (push-mark)) + (markdown-move-heading-common #'outline-up-heading arg 'adjust)) + +(defun markdown-back-to-heading (&optional invisible-ok) + "Move to previous heading line, or beg of this line if it's a heading. +Only visible heading lines are considered, unless INVISIBLE-OK is non-nil." + (interactive) + (markdown-move-heading-common #'outline-back-to-heading invisible-ok)) + +(defalias 'markdown-end-of-heading 'outline-end-of-heading) + +(defun markdown-on-heading-p () + "Return non-nil if point is on a heading line." + (get-text-property (line-beginning-position) 'markdown-heading)) + +(defun markdown-end-of-subtree (&optional invisible-OK) + "Move to the end of the current subtree. +Only visible heading lines are considered, unless INVISIBLE-OK is +non-nil. +Derived from `org-end-of-subtree'." + (markdown-back-to-heading invisible-OK) + (let ((first t) + (level (markdown-outline-level))) + (while (and (not (eobp)) + (or first (> (markdown-outline-level) level))) + (setq first nil) + (markdown-next-heading)) + (if (memq (preceding-char) '(?\n ?\^M)) + (progn + ;; Go to end of line before heading + (forward-char -1) + (if (memq (preceding-char) '(?\n ?\^M)) + ;; leave blank line before heading + (forward-char -1))))) + (point)) + +(defun markdown-outline-fix-visibility () + "Hide any false positive headings that should not be shown. +For example, headings inside preformatted code blocks may match +`outline-regexp' but should not be shown as headings when cycling. +Also, the ending --- line in metadata blocks appears to be a +setext header, but should not be folded." + (save-excursion + (goto-char (point-min)) + ;; Unhide any false positives in metadata blocks + (when (markdown-text-property-at-point 'markdown-yaml-metadata-begin) + (let ((body (progn (forward-line) + (markdown-text-property-at-point + 'markdown-yaml-metadata-section)))) + (when body + (let ((end (progn (goto-char (cl-second body)) + (markdown-text-property-at-point + 'markdown-yaml-metadata-end)))) + (outline-flag-region (point-min) (1+ (cl-second end)) nil))))) + ;; Hide any false positives in code blocks + (unless (outline-on-heading-p) + (outline-next-visible-heading 1)) + (while (< (point) (point-max)) + (when (markdown-code-block-at-point-p) + (outline-flag-region (1- (line-beginning-position)) (line-end-position) t)) + (outline-next-visible-heading 1)))) + +(defvar markdown-cycle-global-status 1) +(defvar markdown-cycle-subtree-status nil) + +(defun markdown-next-preface () + (let (finish) + (while (and (not finish) (re-search-forward (concat "\n\\(?:" outline-regexp "\\)") + nil 'move)) + (unless (markdown-code-block-at-point-p) + (goto-char (match-beginning 0)) + (setq finish t)))) + (when (and (bolp) (or outline-blank-line (eobp)) (not (bobp))) + (forward-char -1))) + +(defun markdown-show-entry () + (save-excursion + (outline-back-to-heading t) + (outline-flag-region (1- (point)) + (progn + (markdown-next-preface) + (if (= 1 (- (point-max) (point))) + (point-max) + (point))) + nil))) + +;; This function was originally derived from `org-cycle' from org.el. +(defun markdown-cycle (&optional arg) + "Visibility cycling for Markdown mode. +This function is called with a `\\[universal-argument]' or if ARG is t, perform +global visibility cycling. If the point is at an atx-style header, cycle +visibility of the corresponding subtree. Otherwise, indent the current line + or insert a tab, as appropriate, by calling `indent-for-tab-command'." + (interactive "P") + (cond + + ;; Global cycling + (arg + (cond + ;; Move from overview to contents + ((and (eq last-command this-command) + (eq markdown-cycle-global-status 2)) + (outline-hide-sublevels 1) + (message "CONTENTS") + (setq markdown-cycle-global-status 3) + (markdown-outline-fix-visibility)) + ;; Move from contents to all + ((and (eq last-command this-command) + (eq markdown-cycle-global-status 3)) + (outline-show-all) + (message "SHOW ALL") + (setq markdown-cycle-global-status 1)) + ;; Defaults to overview + (t + (outline-hide-body) + (message "OVERVIEW") + (setq markdown-cycle-global-status 2) + (markdown-outline-fix-visibility)))) + + ;; At a heading: rotate between three different views + ((save-excursion (beginning-of-line 1) (markdown-on-heading-p)) + (markdown-back-to-heading) + (let ((goal-column 0) eoh eol eos) + ;; Determine boundaries + (save-excursion + (markdown-back-to-heading) + (save-excursion + (beginning-of-line 2) + (while (and (not (eobp)) ;; this is like `next-line' + (get-char-property (1- (point)) 'invisible)) + (beginning-of-line 2)) (setq eol (point))) + (markdown-end-of-heading) (setq eoh (point)) + (markdown-end-of-subtree t) + (skip-chars-forward " \t\n") + (beginning-of-line 1) ; in case this is an item + (setq eos (1- (point)))) + ;; Find out what to do next and set `this-command' + (cond + ;; Nothing is hidden behind this heading + ((= eos eoh) + (message "EMPTY ENTRY") + (setq markdown-cycle-subtree-status nil)) + ;; Entire subtree is hidden in one line: open it + ((>= eol eos) + (markdown-show-entry) + (outline-show-children) + (message "CHILDREN") + (setq markdown-cycle-subtree-status 'children)) + ;; We just showed the children, now show everything. + ((and (eq last-command this-command) + (eq markdown-cycle-subtree-status 'children)) + (outline-show-subtree) + (message "SUBTREE") + (setq markdown-cycle-subtree-status 'subtree)) + ;; Default action: hide the subtree. + (t + (outline-hide-subtree) + (message "FOLDED") + (setq markdown-cycle-subtree-status 'folded))))) + + ;; In a table, move forward by one cell + ((markdown-table-at-point-p) + (call-interactively #'markdown-table-forward-cell)) + + ;; Otherwise, indent as appropriate + (t + (indent-for-tab-command)))) + +(defun markdown-shifttab () + "Handle S-TAB keybinding based on context. +When in a table, move backward one cell. +Otherwise, cycle global heading visibility by calling +`markdown-cycle' with argument t." + (interactive) + (cond ((markdown-table-at-point-p) + (call-interactively #'markdown-table-backward-cell)) + (t (markdown-cycle t)))) + +(defun markdown-outline-level () + "Return the depth to which a statement is nested in the outline." + (cond + ((and (match-beginning 0) + (markdown-code-block-at-pos (match-beginning 0))) + 7) ;; Only 6 header levels are defined. + ((match-end 2) 1) + ((match-end 3) 2) + ((match-end 4) + (length (markdown-trim-whitespace (match-string-no-properties 4)))))) + +(defun markdown-promote-subtree (&optional arg) + "Promote the current subtree of ATX headings. +Note that Markdown does not support heading levels higher than +six and therefore level-six headings will not be promoted +further. If ARG is non-nil promote the heading, otherwise +demote." + (interactive "*P") + (save-excursion + (when (and (or (thing-at-point-looking-at markdown-regex-header-atx) + (re-search-backward markdown-regex-header-atx nil t)) + (not (markdown-code-block-at-point-p))) + (let ((level (length (match-string 1))) + (promote-or-demote (if arg 1 -1)) + (remove 't)) + (markdown-cycle-atx promote-or-demote remove) + (catch 'end-of-subtree + (while (and (markdown-next-heading) + (looking-at markdown-regex-header-atx)) + ;; Exit if this not a higher level heading; promote otherwise. + (if (and (looking-at markdown-regex-header-atx) + (<= (length (match-string-no-properties 1)) level)) + (throw 'end-of-subtree nil) + (markdown-cycle-atx promote-or-demote remove)))))))) + +(defun markdown-demote-subtree () + "Demote the current subtree of ATX headings." + (interactive) + (markdown-promote-subtree t)) + +(defun markdown-move-subtree-up () + "Move the current subtree of ATX headings up." + (interactive) + (outline-move-subtree-up 1)) + +(defun markdown-move-subtree-down () + "Move the current subtree of ATX headings down." + (interactive) + (outline-move-subtree-down 1)) + +(defun markdown-outline-next () + "Move to next list item, when in a list, or next visible heading." + (interactive) + (let ((bounds (markdown-next-list-item-bounds))) + (if bounds + (goto-char (nth 0 bounds)) + (markdown-next-visible-heading 1)))) + +(defun markdown-outline-previous () + "Move to previous list item, when in a list, or previous visible heading." + (interactive) + (let ((bounds (markdown-prev-list-item-bounds))) + (if bounds + (goto-char (nth 0 bounds)) + (markdown-previous-visible-heading 1)))) + +(defun markdown-outline-next-same-level () + "Move to next list item or heading of same level." + (interactive) + (let ((bounds (markdown-cur-list-item-bounds))) + (if bounds + (markdown-next-list-item (nth 3 bounds)) + (markdown-forward-same-level 1)))) + +(defun markdown-outline-previous-same-level () + "Move to previous list item or heading of same level." + (interactive) + (let ((bounds (markdown-cur-list-item-bounds))) + (if bounds + (markdown-prev-list-item (nth 3 bounds)) + (markdown-backward-same-level 1)))) + +(defun markdown-outline-up () + "Move to previous list item, when in a list, or previous heading." + (interactive) + (unless (markdown-up-list) + (markdown-up-heading 1))) + + +;;; Marking and Narrowing ===================================================== + +(defun markdown-mark-paragraph () + "Put mark at end of this block, point at beginning. +The block marked is the one that contains point or follows point. + +Interactively, if this command is repeated or (in Transient Mark +mode) if the mark is active, it marks the next block after the +ones already marked." + (interactive) + (if (or (and (eq last-command this-command) (mark t)) + (and transient-mark-mode mark-active)) + (set-mark + (save-excursion + (goto-char (mark)) + (markdown-forward-paragraph) + (point))) + (let ((beginning-of-defun-function #'markdown-backward-paragraph) + (end-of-defun-function #'markdown-forward-paragraph)) + (mark-defun)))) + +(defun markdown-mark-block () + "Put mark at end of this block, point at beginning. +The block marked is the one that contains point or follows point. + +Interactively, if this command is repeated or (in Transient Mark +mode) if the mark is active, it marks the next block after the +ones already marked." + (interactive) + (if (or (and (eq last-command this-command) (mark t)) + (and transient-mark-mode mark-active)) + (set-mark + (save-excursion + (goto-char (mark)) + (markdown-forward-block) + (point))) + (let ((beginning-of-defun-function #'markdown-backward-block) + (end-of-defun-function #'markdown-forward-block)) + (mark-defun)))) + +(defun markdown-narrow-to-block () + "Make text outside current block invisible. +The current block is the one that contains point or follows point." + (interactive) + (let ((beginning-of-defun-function #'markdown-backward-block) + (end-of-defun-function #'markdown-forward-block)) + (narrow-to-defun))) + +(defun markdown-mark-text-block () + "Put mark at end of this plain text block, point at beginning. +The block marked is the one that contains point or follows point. + +Interactively, if this command is repeated or (in Transient Mark +mode) if the mark is active, it marks the next block after the +ones already marked." + (interactive) + (if (or (and (eq last-command this-command) (mark t)) + (and transient-mark-mode mark-active)) + (set-mark + (save-excursion + (goto-char (mark)) + (markdown-end-of-text-block) + (point))) + (let ((beginning-of-defun-function #'markdown-beginning-of-text-block) + (end-of-defun-function #'markdown-end-of-text-block)) + (mark-defun)))) + +(defun markdown-mark-page () + "Put mark at end of this top level section, point at beginning. +The top level section marked is the one that contains point or +follows point. + +Interactively, if this command is repeated or (in Transient Mark +mode) if the mark is active, it marks the next page after the +ones already marked." + (interactive) + (if (or (and (eq last-command this-command) (mark t)) + (and transient-mark-mode mark-active)) + (set-mark + (save-excursion + (goto-char (mark)) + (markdown-forward-page) + (point))) + (let ((beginning-of-defun-function #'markdown-backward-page) + (end-of-defun-function #'markdown-forward-page)) + (mark-defun)))) + +(defun markdown-narrow-to-page () + "Make text outside current top level section invisible. +The current section is the one that contains point or follows point." + (interactive) + (let ((beginning-of-defun-function #'markdown-backward-page) + (end-of-defun-function #'markdown-forward-page)) + (narrow-to-defun))) + +(defun markdown-mark-subtree () + "Mark the current subtree. +This puts point at the start of the current subtree, and mark at the end." + (interactive) + (let ((beg)) + (if (markdown-heading-at-point) + (beginning-of-line) + (markdown-previous-visible-heading 1)) + (setq beg (point)) + (markdown-end-of-subtree) + (push-mark (point) nil t) + (goto-char beg))) + +(defun markdown-narrow-to-subtree () + "Narrow buffer to the current subtree." + (interactive) + (save-excursion + (save-match-data + (narrow-to-region + (progn (markdown-back-to-heading-over-code-block t) (point)) + (progn (markdown-end-of-subtree) + (if (and (markdown-heading-at-point) (not (eobp))) + (backward-char 1)) + (point)))))) + + +;;; Generic Structure Editing, Completion, and Cycling Commands =============== + +(defun markdown-move-up () + "Move thing at point up. +When in a list item, call `markdown-move-list-item-up'. +When in a table, call `markdown-table-move-row-up'. +Otherwise, move the current heading subtree up with +`markdown-move-subtree-up'." + (interactive) + (cond + ((markdown-list-item-at-point-p) + (call-interactively #'markdown-move-list-item-up)) + ((markdown-table-at-point-p) + (call-interactively #'markdown-table-move-row-up)) + (t + (call-interactively #'markdown-move-subtree-up)))) + +(defun markdown-move-down () + "Move thing at point down. +When in a list item, call `markdown-move-list-item-down'. +Otherwise, move the current heading subtree up with +`markdown-move-subtree-down'." + (interactive) + (cond + ((markdown-list-item-at-point-p) + (call-interactively #'markdown-move-list-item-down)) + ((markdown-table-at-point-p) + (call-interactively #'markdown-table-move-row-down)) + (t + (call-interactively #'markdown-move-subtree-down)))) + +(defun markdown-promote () + "Promote or move element at point to the left. +Depending on the context, this function will promote a heading or +list item at the point, move a table column to the left, or cycle +markup." + (interactive) + (let (bounds) + (cond + ;; Promote atx heading subtree + ((thing-at-point-looking-at markdown-regex-header-atx) + (markdown-promote-subtree)) + ;; Promote setext heading + ((thing-at-point-looking-at markdown-regex-header-setext) + (markdown-cycle-setext -1)) + ;; Promote horizontal rule + ((thing-at-point-looking-at markdown-regex-hr) + (markdown-cycle-hr -1)) + ;; Promote list item + ((setq bounds (markdown-cur-list-item-bounds)) + (markdown-promote-list-item bounds)) + ;; Move table column to the left + ((markdown-table-at-point-p) + (call-interactively #'markdown-table-move-column-left)) + ;; Promote bold + ((thing-at-point-looking-at markdown-regex-bold) + (markdown-cycle-bold)) + ;; Promote italic + ((thing-at-point-looking-at markdown-regex-italic) + (markdown-cycle-italic)) + (t + (user-error "Nothing to promote at point"))))) + +(defun markdown-demote () + "Demote or move element at point to the right. +Depending on the context, this function will demote a heading or +list item at the point, move a table column to the right, or cycle +or remove markup." + (interactive) + (let (bounds) + (cond + ;; Demote atx heading subtree + ((thing-at-point-looking-at markdown-regex-header-atx) + (markdown-demote-subtree)) + ;; Demote setext heading + ((thing-at-point-looking-at markdown-regex-header-setext) + (markdown-cycle-setext 1)) + ;; Demote horizontal rule + ((thing-at-point-looking-at markdown-regex-hr) + (markdown-cycle-hr 1)) + ;; Demote list item + ((setq bounds (markdown-cur-list-item-bounds)) + (markdown-demote-list-item bounds)) + ;; Move table column to the right + ((markdown-table-at-point-p) + (call-interactively #'markdown-table-move-column-right)) + ;; Demote bold + ((thing-at-point-looking-at markdown-regex-bold) + (markdown-cycle-bold)) + ;; Demote italic + ((thing-at-point-looking-at markdown-regex-italic) + (markdown-cycle-italic)) + (t + (user-error "Nothing to demote at point"))))) + + +;;; Commands ================================================================== + +(defun markdown (&optional output-buffer-name) + "Run `markdown-command' on buffer, sending output to OUTPUT-BUFFER-NAME. +The output buffer name defaults to `markdown-output-buffer-name'. +Return the name of the output buffer used." + (interactive) + (save-window-excursion + (let* ((commands (cond ((stringp markdown-command) (split-string markdown-command)) + ((listp markdown-command) markdown-command))) + (command (car-safe commands)) + (command-args (cdr-safe commands)) + begin-region end-region) + (if (use-region-p) + (setq begin-region (region-beginning) + end-region (region-end)) + (setq begin-region (point-min) + end-region (point-max))) + + (unless output-buffer-name + (setq output-buffer-name markdown-output-buffer-name)) + (when (and (stringp command) (not (executable-find command))) + (user-error "Markdown command %s is not found" command)) + (let ((exit-code + (cond + ;; Handle case when `markdown-command' does not read from stdin + ((and (stringp command) markdown-command-needs-filename) + (if (not buffer-file-name) + (user-error "Must be visiting a file") + ;; Don’t use ‘shell-command’ because it’s not guaranteed to + ;; return the exit code of the process. + (let ((command (if (listp markdown-command) + (string-join markdown-command " ") + markdown-command))) + (shell-command-on-region + ;; Pass an empty region so that stdin is empty. + (point) (point) + (concat command " " + (shell-quote-argument buffer-file-name)) + output-buffer-name)))) + ;; Pass region to `markdown-command' via stdin + (t + (let ((buf (get-buffer-create output-buffer-name))) + (with-current-buffer buf + (setq buffer-read-only nil) + (erase-buffer)) + (if (stringp command) + (if (not (null command-args)) + (apply #'call-process-region begin-region end-region command nil buf nil command-args) + (call-process-region begin-region end-region command nil buf)) + (if markdown-command-needs-filename + (if (not buffer-file-name) + (user-error "Must be visiting a file") + (funcall markdown-command begin-region end-region buf buffer-file-name)) + (funcall markdown-command begin-region end-region buf)) + ;; If the ‘markdown-command’ function didn’t signal an + ;; error, assume it succeeded by binding ‘exit-code’ to 0. + 0)))))) + ;; The exit code can be a signal description string, so don’t use ‘=’ + ;; or ‘zerop’. + (unless (eq exit-code 0) + (user-error "%s failed with exit code %s" + markdown-command exit-code)))) + output-buffer-name)) + +(defun markdown-standalone (&optional output-buffer-name) + "Special function to provide standalone HTML output. +Insert the output in the buffer named OUTPUT-BUFFER-NAME." + (interactive) + (setq output-buffer-name (markdown output-buffer-name)) + (let ((css-path markdown-css-paths)) + (with-current-buffer output-buffer-name + (set-buffer output-buffer-name) + (setq-local markdown-css-paths css-path) + (unless (markdown-output-standalone-p) + (markdown-add-xhtml-header-and-footer output-buffer-name)) + (goto-char (point-min)) + (html-mode))) + output-buffer-name) + +(defun markdown-other-window (&optional output-buffer-name) + "Run `markdown-command' on current buffer and display in other window. +When OUTPUT-BUFFER-NAME is given, insert the output in the buffer with +that name." + (interactive) + (markdown-display-buffer-other-window + (markdown-standalone output-buffer-name))) + +(defun markdown-output-standalone-p () + "Determine whether `markdown-command' output is standalone XHTML. +Standalone XHTML output is identified by an occurrence of +`markdown-xhtml-standalone-regexp' in the first five lines of output." + (save-excursion + (goto-char (point-min)) + (save-match-data + (re-search-forward + markdown-xhtml-standalone-regexp + (save-excursion (goto-char (point-min)) (forward-line 4) (point)) + t)))) + +(defun markdown-stylesheet-link-string (stylesheet-path) + (concat "<link rel=\"stylesheet\" type=\"text/css\" media=\"all\" href=\"" + (or (and (string-prefix-p "~" stylesheet-path) + (expand-file-name stylesheet-path)) + stylesheet-path) + "\" />")) + +(defun markdown-escape-title (title) + "Escape a minimum set of characters in TITLE so they don't clash with html." + (replace-regexp-in-string ">" "&gt;" + (replace-regexp-in-string "<" "&lt;" + (replace-regexp-in-string "&" "&amp;" title)))) + +(defun markdown-add-xhtml-header-and-footer (title) + "Wrap XHTML header and footer with given TITLE around current buffer." + (goto-char (point-min)) + (insert "<?xml version=\"1.0\" encoding=\"UTF-8\" ?>\n" + "<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"\n" + "\t\"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">\n\n" + "<html xmlns=\"http://www.w3.org/1999/xhtml\">\n\n" + "<head>\n<title>") + (insert (markdown-escape-title title)) + (insert "</title>\n") + (unless (= (length markdown-content-type) 0) + (insert + (format + "<meta http-equiv=\"Content-Type\" content=\"%s;charset=%s\"/>\n" + markdown-content-type + (or (and markdown-coding-system + (coding-system-get markdown-coding-system + 'mime-charset)) + (coding-system-get buffer-file-coding-system + 'mime-charset) + "utf-8")))) + (if (> (length markdown-css-paths) 0) + (insert (mapconcat #'markdown-stylesheet-link-string + markdown-css-paths "\n"))) + (when (> (length markdown-xhtml-header-content) 0) + (insert markdown-xhtml-header-content)) + (insert "\n</head>\n\n" + "<body>\n\n") + (when (> (length markdown-xhtml-body-preamble) 0) + (insert markdown-xhtml-body-preamble "\n")) + (goto-char (point-max)) + (when (> (length markdown-xhtml-body-epilogue) 0) + (insert "\n" markdown-xhtml-body-epilogue)) + (insert "\n" + "</body>\n" + "</html>\n")) + +(defun markdown-preview (&optional output-buffer-name) + "Run `markdown-command' on the current buffer and view output in browser. +When OUTPUT-BUFFER-NAME is given, insert the output in the buffer with +that name." + (interactive) + (browse-url-of-buffer + (markdown-standalone (or output-buffer-name markdown-output-buffer-name)))) + +(defun markdown-export-file-name (&optional extension) + "Attempt to generate a filename for Markdown output. +The file extension will be EXTENSION if given, or .html by default. +If the current buffer is visiting a file, we construct a new +output filename based on that filename. Otherwise, return nil." + (when (buffer-file-name) + (unless extension + (setq extension ".html")) + (let ((candidate + (concat + (cond + ((buffer-file-name) + (file-name-sans-extension (buffer-file-name))) + (t (buffer-name))) + extension))) + (cond + ((equal candidate (buffer-file-name)) + (concat candidate extension)) + (t + candidate))))) + +(defun markdown-export (&optional output-file) + "Run Markdown on the current buffer, save to file, and return the filename. +If OUTPUT-FILE is given, use that as the filename. Otherwise, use the filename +generated by `markdown-export-file-name', which will be constructed using the +current filename, but with the extension removed and replaced with .html." + (interactive) + (unless output-file + (setq output-file (markdown-export-file-name ".html"))) + (when output-file + (let* ((init-buf (current-buffer)) + (init-point (point)) + (init-buf-string (buffer-string)) + (output-buffer (find-file-noselect output-file)) + (output-buffer-name (buffer-name output-buffer))) + (run-hooks 'markdown-before-export-hook) + (markdown-standalone output-buffer-name) + (with-current-buffer output-buffer + (run-hooks 'markdown-after-export-hook) + (save-buffer) + (when markdown-export-kill-buffer (kill-buffer))) + ;; if modified, restore initial buffer + (when (buffer-modified-p init-buf) + (erase-buffer) + (insert init-buf-string) + (save-buffer) + (goto-char init-point)) + output-file))) + +(defun markdown-export-and-preview () + "Export to XHTML using `markdown-export' and browse the resulting file." + (interactive) + (browse-url-of-file (markdown-export))) + +(defvar-local markdown-live-preview-buffer nil + "Buffer used to preview markdown output in `markdown-live-preview-export'.") + +(defvar-local markdown-live-preview-source-buffer nil + "Source buffer from which current buffer was generated. +This is the inverse of `markdown-live-preview-buffer'.") + +(defvar markdown-live-preview-currently-exporting nil) + +(defun markdown-live-preview-get-filename () + "Standardize the filename exported by `markdown-live-preview-export'." + (markdown-export-file-name ".html")) + +(defun markdown-live-preview-window-eww (file) + "Preview FILE with eww. +To be used with `markdown-live-preview-window-function'." + (when (and (bound-and-true-p eww-auto-rename-buffer) + markdown-live-preview-buffer) + (kill-buffer markdown-live-preview-buffer)) + (eww-open-file file) + ;; #737 if `eww-auto-rename-buffer' is non-nil, the buffer name is not "*eww*" + ;; Try to find the buffer whose name ends with "eww*" + (if (bound-and-true-p eww-auto-rename-buffer) + (cl-loop for buf in (buffer-list) + when (string-match-p "eww\\*\\'" (buffer-name buf)) + return buf) + (get-buffer "*eww*"))) + +(defun markdown-visual-lines-between-points (beg end) + (save-excursion + (goto-char beg) + (cl-loop with count = 0 + while (progn (end-of-visual-line) + (and (< (point) end) (line-move-visual 1 t))) + do (cl-incf count) + finally return count))) + +(defun markdown-live-preview-window-serialize (buf) + "Get window point and scroll data for all windows displaying BUF." + (when (buffer-live-p buf) + (with-current-buffer buf + (mapcar + (lambda (win) + (with-selected-window win + (let* ((start (window-start)) + (pt (window-point)) + (pt-or-sym (cond ((= pt (point-min)) 'min) + ((= pt (point-max)) 'max) + (t pt))) + (diff (markdown-visual-lines-between-points + start pt))) + (list win pt-or-sym diff)))) + (get-buffer-window-list buf))))) + +(defun markdown-get-point-back-lines (pt num-lines) + (save-excursion + (goto-char pt) + (line-move-visual (- num-lines) t) + ;; in testing, can occasionally overshoot the number of lines to traverse + (let ((actual-num-lines (markdown-visual-lines-between-points (point) pt))) + (when (> actual-num-lines num-lines) + (line-move-visual (- actual-num-lines num-lines) t))) + (point))) + +(defun markdown-live-preview-window-deserialize (window-posns) + "Apply window point and scroll data from WINDOW-POSNS. +WINDOW-POSNS is provided by `markdown-live-preview-window-serialize'." + (cl-destructuring-bind (win pt-or-sym diff) window-posns + (when (window-live-p win) + (with-current-buffer markdown-live-preview-buffer + (set-window-buffer win (current-buffer)) + (cl-destructuring-bind (actual-pt actual-diff) + (cl-case pt-or-sym + (min (list (point-min) 0)) + (max (list (point-max) diff)) + (t (list pt-or-sym diff))) + (set-window-start + win (markdown-get-point-back-lines actual-pt actual-diff)) + (set-window-point win actual-pt)))))) + +(defun markdown-live-preview-export () + "Export to XHTML using `markdown-export'. +Browse the resulting file within Emacs using +`markdown-live-preview-window-function' Return the buffer +displaying the rendered output." + (interactive) + (let ((filename (markdown-live-preview-get-filename))) + (when filename + (let* ((markdown-live-preview-currently-exporting t) + (cur-buf (current-buffer)) + (export-file (markdown-export filename)) + ;; get positions in all windows currently displaying output buffer + (window-data + (markdown-live-preview-window-serialize + markdown-live-preview-buffer))) + (save-window-excursion + (let ((output-buffer + (funcall markdown-live-preview-window-function export-file))) + (with-current-buffer output-buffer + (setq markdown-live-preview-source-buffer cur-buf) + (add-hook 'kill-buffer-hook + #'markdown-live-preview-remove-on-kill t t)) + (with-current-buffer cur-buf + (setq markdown-live-preview-buffer output-buffer)))) + (with-current-buffer cur-buf + ;; reset all windows displaying output buffer to where they were, + ;; now with the new output + (mapc #'markdown-live-preview-window-deserialize window-data) + ;; delete html editing buffer + (let ((buf (get-file-buffer export-file))) (when buf (kill-buffer buf))) + (when (and export-file (file-exists-p export-file) + (eq markdown-live-preview-delete-export + 'delete-on-export)) + (delete-file export-file)) + markdown-live-preview-buffer))))) + +(defun markdown-live-preview-remove () + (when (buffer-live-p markdown-live-preview-buffer) + (kill-buffer markdown-live-preview-buffer)) + (setq markdown-live-preview-buffer nil) + ;; if set to 'delete-on-export, the output has already been deleted + (when (eq markdown-live-preview-delete-export 'delete-on-destroy) + (let ((outfile-name (markdown-live-preview-get-filename))) + (when (and outfile-name (file-exists-p outfile-name)) + (delete-file outfile-name))))) + +(defun markdown-get-other-window () + "Find another window to display preview or output content." + (cond + ((memq markdown-split-window-direction '(vertical below)) + (or (window-in-direction 'below) (split-window-vertically))) + ((memq markdown-split-window-direction '(horizontal right)) + (or (window-in-direction 'right) (split-window-horizontally))) + (t (split-window-sensibly (get-buffer-window))))) + +(defun markdown-display-buffer-other-window (buf) + "Display preview or output buffer BUF in another window." + (if (and display-buffer-alist (eq markdown-split-window-direction 'any)) + (display-buffer buf) + (let ((cur-buf (current-buffer)) + (window (markdown-get-other-window))) + (set-window-buffer window buf) + (set-buffer cur-buf)))) + +(defun markdown-live-preview-if-markdown () + (when (and (derived-mode-p 'markdown-mode) + markdown-live-preview-mode) + (unless markdown-live-preview-currently-exporting + (if (buffer-live-p markdown-live-preview-buffer) + (markdown-live-preview-export) + (markdown-display-buffer-other-window + (markdown-live-preview-export)))))) + +(defun markdown-live-preview-remove-on-kill () + (cond ((and (derived-mode-p 'markdown-mode) + markdown-live-preview-mode) + (markdown-live-preview-remove)) + (markdown-live-preview-source-buffer + (with-current-buffer markdown-live-preview-source-buffer + (setq markdown-live-preview-buffer nil)) + (setq markdown-live-preview-source-buffer nil)))) + +(defun markdown-live-preview-switch-to-output () + "Turn on `markdown-live-preview-mode' and switch to output buffer. +The output buffer is opened in another window." + (interactive) + (if markdown-live-preview-mode + (markdown-display-buffer-other-window (markdown-live-preview-export))) + (markdown-live-preview-mode)) + +(defun markdown-live-preview-re-export () + "Re-export the current live previewed content. +If the current buffer is a buffer displaying the exported version of a +`markdown-live-preview-mode' buffer, call `markdown-live-preview-export' and +update this buffer's contents." + (interactive) + (when markdown-live-preview-source-buffer + (with-current-buffer markdown-live-preview-source-buffer + (markdown-live-preview-export)))) + +(defun markdown-open () + "Open file for the current buffer with `markdown-open-command'." + (interactive) + (unless markdown-open-command + (user-error "Variable `markdown-open-command' must be set")) + (if (stringp markdown-open-command) + (if (not buffer-file-name) + (user-error "Must be visiting a file") + (save-buffer) + (let ((exit-code (call-process markdown-open-command nil nil nil + buffer-file-name))) + ;; The exit code can be a signal description string, so don’t use ‘=’ + ;; or ‘zerop’. + (unless (eq exit-code 0) + (user-error "%s failed with exit code %s" + markdown-open-command exit-code)))) + (funcall markdown-open-command)) + nil) + +(defun markdown-kill-ring-save () + "Run Markdown on file and store output in the kill ring." + (interactive) + (save-window-excursion + (markdown) + (with-current-buffer markdown-output-buffer-name + (kill-ring-save (point-min) (point-max))))) + + +;;; Links ===================================================================== + +(defun markdown-backward-to-link-start () + "Backward link start position if current position is in link title." + ;; Issue #305 + (when (eq (get-text-property (point) 'face) 'markdown-link-face) + (skip-chars-backward "^[") + (forward-char -1))) + +(defun markdown-link-p () + "Return non-nil when `point' is at a non-wiki link. +See `markdown-wiki-link-p' for more information." + (save-excursion + (let ((case-fold-search nil)) + (when (and (not (markdown-wiki-link-p)) (not (markdown-code-block-at-point-p))) + (markdown-backward-to-link-start) + (or (thing-at-point-looking-at markdown-regex-link-inline) + (thing-at-point-looking-at markdown-regex-link-reference) + (thing-at-point-looking-at markdown-regex-uri) + (thing-at-point-looking-at markdown-regex-angle-uri)))))) + +(defun markdown-link-at-pos (pos) + "Return properties of link or image at position POS. +Value is a list of elements describing the link: + 0. beginning position + 1. end position + 2. link text + 3. URL + 4. reference label + 5. title text + 6. bang (nil or \"!\")" + (save-excursion + (goto-char pos) + (markdown-backward-to-link-start) + (let (begin end text url reference title bang) + (cond + ;; Inline image or link at point. + ((thing-at-point-looking-at markdown-regex-link-inline) + (setq bang (match-string-no-properties 1) + begin (match-beginning 0) + text (match-string-no-properties 3) + url (match-string-no-properties 6)) + ;; consider nested parentheses + ;; if link target contains parentheses, (match-end 0) isn't correct end position of the link + (let* ((close-pos (scan-sexps (match-beginning 5) 1)) + (destination-part (string-trim (buffer-substring-no-properties (1+ (match-beginning 5)) (1- close-pos))))) + (setq end close-pos) + ;; A link can contain spaces if it is wrapped with angle brackets + (cond ((string-match "\\`<\\(.+\\)>\\'" destination-part) + (setq url (match-string-no-properties 1 destination-part))) + ((string-match "\\([^ ]+\\)\\s-+\\(.+\\)" destination-part) + (setq url (match-string-no-properties 1 destination-part) + title (substring (match-string-no-properties 2 destination-part) 1 -1))) + (t (setq url destination-part))) + (setq url (url-unhex-string url)))) + ;; Reference link at point. + ((thing-at-point-looking-at markdown-regex-link-reference) + (setq bang (match-string-no-properties 1) + begin (match-beginning 0) + end (match-end 0) + text (match-string-no-properties 3)) + (when (char-equal (char-after (match-beginning 5)) ?\[) + (setq reference (match-string-no-properties 6)))) + ;; Angle bracket URI at point. + ((thing-at-point-looking-at markdown-regex-angle-uri) + (setq begin (match-beginning 0) + end (match-end 0) + url (match-string-no-properties 2))) + ;; Plain URI at point. + ((thing-at-point-looking-at markdown-regex-uri) + (setq begin (match-beginning 0) + end (match-end 0) + url (match-string-no-properties 1)))) + (list begin end text url reference title bang)))) + +(defun markdown-link-url () + "Return the URL part of the regular (non-wiki) link at point. +Works with both inline and reference style links, and with images. +If point is not at a link or the link reference is not defined +returns nil." + (let* ((values (markdown-link-at-pos (point))) + (text (nth 2 values)) + (url (nth 3 values)) + (ref (nth 4 values))) + (or url (and ref (car (markdown-reference-definition + (downcase (if (string= ref "") text ref)))))))) + +(defun markdown--browse-url (url) + (let* ((struct (url-generic-parse-url url)) + (full (url-fullness struct)) + (file url)) + ;; Parse URL, determine fullness, strip query string + (setq file (car (url-path-and-query struct))) + ;; Open full URLs in browser, files in Emacs + (if full + (browse-url url) + (when (and file (> (length file) 0)) + (let ((link-file (funcall markdown-translate-filename-function file))) + (if (and markdown-open-image-command (string-match-p (image-file-name-regexp) link-file)) + (if (functionp markdown-open-image-command) + (funcall markdown-open-image-command link-file) + (process-file markdown-open-image-command nil nil nil link-file)) + (find-file link-file))))))) + +(defun markdown-follow-link-at-point (&optional event) + "Open the non-wiki link at point or EVENT. +If the link is a complete URL, open in browser with `browse-url'. +Otherwise, open with `find-file' after stripping anchor and/or query string. +Translate filenames using `markdown-filename-translate-function'." + (interactive (list last-command-event)) + (if event (posn-set-point (event-start event))) + (if (markdown-link-p) + (or (run-hook-with-args-until-success 'markdown-follow-link-functions (markdown-link-url)) + (markdown--browse-url (markdown-link-url))) + (user-error "Point is not at a Markdown link or URL"))) + +(defun markdown-fontify-inline-links (last) + "Add text properties to next inline link from point to LAST." + (when (markdown-match-generic-links last nil) + (let* ((link-start (match-beginning 3)) + (link-end (match-end 3)) + (url-start (match-beginning 6)) + (url-end (match-end 6)) + (url (match-string-no-properties 6)) + (title-start (match-beginning 7)) + (title-end (match-end 7)) + (title (match-string-no-properties 7)) + ;; Markup part + (mp (list 'invisible 'markdown-markup + 'rear-nonsticky t + 'font-lock-multiline t)) + ;; Link part (without face) + (lp (list 'keymap markdown-mode-mouse-map + 'mouse-face 'markdown-highlight-face + 'font-lock-multiline t + 'help-echo (if title (concat title "\n" url) url))) + ;; URL part + (up (list 'keymap markdown-mode-mouse-map + 'invisible 'markdown-markup + 'mouse-face 'markdown-highlight-face + 'font-lock-multiline t)) + ;; URL composition character + (url-char (markdown--first-displayable markdown-url-compose-char)) + ;; Title part + (tp (list 'invisible 'markdown-markup + 'font-lock-multiline t))) + (dolist (g '(1 2 4 5 8)) + (when (match-end g) + (add-text-properties (match-beginning g) (match-end g) mp) + (add-face-text-property (match-beginning g) (match-end g) 'markdown-markup-face))) + ;; Preserve existing faces applied to link part (e.g., inline code) + (when link-start + (add-text-properties link-start link-end lp) + (add-face-text-property link-start link-end 'markdown-link-face)) + (when url-start + (add-text-properties url-start url-end up) + (add-face-text-property url-start url-end 'markdown-url-face)) + (when title-start + (add-text-properties url-end title-end tp) + (add-face-text-property url-end title-end 'markdown-link-title-face)) + (when (and markdown-hide-urls url-start) + (compose-region url-start (or title-end url-end) url-char)) + t))) + +(defun markdown-fontify-reference-links (last) + "Add text properties to next reference link from point to LAST." + (when (markdown-match-generic-links last t) + (let* ((link-start (match-beginning 3)) + (link-end (match-end 3)) + (ref-start (match-beginning 6)) + (ref-end (match-end 6)) + ;; Markup part + (mp (list 'invisible 'markdown-markup + 'rear-nonsticky t + 'font-lock-multiline t)) + ;; Link part + (lp (list 'keymap markdown-mode-mouse-map + 'mouse-face 'markdown-highlight-face + 'font-lock-multiline t + 'help-echo (lambda (_ __ pos) + (save-match-data + (save-excursion + (goto-char pos) + (or (markdown-link-url) + "Undefined reference")))))) + ;; URL composition character + (url-char (markdown--first-displayable markdown-url-compose-char)) + ;; Reference part + (rp (list 'invisible 'markdown-markup + 'font-lock-multiline t))) + (dolist (g '(1 2 4 5 8)) + (when (match-end g) + (add-text-properties (match-beginning g) (match-end g) mp) + (add-face-text-property (match-beginning g) (match-end g) 'markdown-markup-face))) + (when link-start + (add-text-properties link-start link-end lp) + (add-face-text-property link-start link-end 'markdown-link-face)) + (when ref-start + (add-text-properties ref-start ref-end rp) + (add-face-text-property ref-start ref-end 'markdown-reference-face) + (when (and markdown-hide-urls (> (- ref-end ref-start) 2)) + (compose-region ref-start ref-end url-char))) + t))) + +(defun markdown-fontify-angle-uris (last) + "Add text properties to angle URIs from point to LAST." + (when (markdown-match-angle-uris last) + (let* ((url-start (match-beginning 2)) + (url-end (match-end 2)) + ;; Markup part + (mp (list 'face 'markdown-markup-face + 'invisible 'markdown-markup + 'rear-nonsticky t + 'font-lock-multiline t)) + ;; URI part + (up (list 'keymap markdown-mode-mouse-map + 'face 'markdown-plain-url-face + 'mouse-face 'markdown-highlight-face + 'font-lock-multiline t))) + (dolist (g '(1 3)) + (add-text-properties (match-beginning g) (match-end g) mp)) + (add-text-properties url-start url-end up) + t))) + +(defun markdown-fontify-plain-uris (last) + "Add text properties to plain URLs from point to LAST." + (when (markdown-match-plain-uris last) + (let* ((start (match-beginning 0)) + (end (match-end 0)) + (props (list 'keymap markdown-mode-mouse-map + 'face 'markdown-plain-url-face + 'mouse-face 'markdown-highlight-face + 'rear-nonsticky t + 'font-lock-multiline t))) + (add-text-properties start end props) + t))) + +(defun markdown-toggle-url-hiding (&optional arg) + "Toggle the display or hiding of URLs. +With a prefix argument ARG, enable URL hiding if ARG is positive, +and disable it otherwise." + (interactive (list (or current-prefix-arg 'toggle))) + (setq markdown-hide-urls + (if (eq arg 'toggle) + (not markdown-hide-urls) + (> (prefix-numeric-value arg) 0))) + (when (called-interactively-p 'interactive) + (message "markdown-mode URL hiding %s" (if markdown-hide-urls "enabled" "disabled"))) + (markdown-reload-extensions)) + + +;;; Wiki Links ================================================================ + +(defun markdown-wiki-link-p () + "Return non-nil if wiki links are enabled and `point' is at a true wiki link. +A true wiki link name matches `markdown-regex-wiki-link' but does +not match the current file name after conversion. This modifies +the data returned by `match-data'. Note that the potential wiki +link name must be available via `match-string'." + (when markdown-enable-wiki-links + (let ((case-fold-search nil)) + (and (thing-at-point-looking-at markdown-regex-wiki-link) + (not (markdown-code-block-at-point-p)) + (or (not buffer-file-name) + (not (string-equal (buffer-file-name) + (markdown-convert-wiki-link-to-filename + (markdown-wiki-link-link))))))))) + +(defun markdown-wiki-link-link () + "Return the link part of the wiki link using current match data. +The location of the link component depends on the value of +`markdown-wiki-link-alias-first'." + (if markdown-wiki-link-alias-first + (or (match-string-no-properties 5) (match-string-no-properties 3)) + (match-string-no-properties 3))) + +(defun markdown-wiki-link-alias () + "Return the alias or text part of the wiki link using current match data. +The location of the alias component depends on the value of +`markdown-wiki-link-alias-first'." + (if markdown-wiki-link-alias-first + (match-string-no-properties 3) + (or (match-string-no-properties 5) (match-string-no-properties 3)))) + +(defun markdown--wiki-link-search-types () + (let ((ret (and markdown-wiki-link-search-type + (cl-copy-list markdown-wiki-link-search-type)))) + (when (and markdown-wiki-link-search-subdirectories + (not (memq 'sub-directories markdown-wiki-link-search-type))) + (push 'sub-directories ret)) + (when (and markdown-wiki-link-search-parent-directories + (not (memq 'parent-directories markdown-wiki-link-search-type))) + (push 'parent-directories ret)) + ret)) + +(defun markdown--project-root () + (or (cl-loop for dir in '(".git" ".hg" ".svn") + when (locate-dominating-file default-directory dir) + return it) + (progn + (require 'project) + (let ((project (project-current t))) + (with-no-warnings + (if (fboundp 'project-root) + (project-root project) + (car (project-roots project)))))))) + +(defun markdown-convert-wiki-link-to-filename (name) + "Generate a filename from the wiki link NAME. +Spaces in NAME are replaced with `markdown-link-space-sub-char'. +When in `gfm-mode', follow GitHub's conventions where [[Test Test]] +and [[test test]] both map to Test-test.ext. Look in the current +directory first, then in subdirectories if +`markdown-wiki-link-search-subdirectories' is non-nil, and then +in parent directories if +`markdown-wiki-link-search-parent-directories' is non-nil." + (save-match-data + ;; This function must not overwrite match data(PR #590) + (let* ((basename (replace-regexp-in-string + "[[:space:]\n]" markdown-link-space-sub-char name)) + (basename (if (derived-mode-p 'gfm-mode) + (concat (upcase (substring basename 0 1)) + (downcase (substring basename 1 nil))) + basename)) + (search-types (markdown--wiki-link-search-types)) + directory extension default candidates dir) + (when buffer-file-name + (setq directory (file-name-directory buffer-file-name) + extension (file-name-extension buffer-file-name))) + (setq default (concat basename + (when extension (concat "." extension)))) + (cond + ;; Look in current directory first. + ((or (null buffer-file-name) + (file-exists-p default)) + default) + ;; Possibly search in subdirectories, next. + ((and (memq 'sub-directories search-types) + (setq candidates + (directory-files-recursively + directory (concat "^" default "$")))) + (car candidates)) + ;; Possibly search in parent directories as a last resort. + ((and (memq 'parent-directories search-types) + (setq dir (locate-dominating-file directory default))) + (concat dir default)) + ((and (memq 'project search-types) + (setq candidates + (directory-files-recursively + (markdown--project-root) (concat "^" default "$")))) + (car candidates)) + ;; If nothing is found, return default in current directory. + (t default))))) + +(defun markdown-follow-wiki-link (name &optional other) + "Follow the wiki link NAME. +Convert the name to a file name and call `find-file'. Ensure that +the new buffer remains in `markdown-mode'. Open the link in another +window when OTHER is non-nil." + (let ((filename (markdown-convert-wiki-link-to-filename name)) + (wp (when buffer-file-name + (file-name-directory buffer-file-name)))) + (if (not wp) + (user-error "Must be visiting a file") + (when other (other-window 1)) + (let ((default-directory wp)) + (find-file filename))) + (unless (derived-mode-p 'markdown-mode) + (markdown-mode)))) + +(defun markdown-follow-wiki-link-at-point (&optional arg) + "Find Wiki Link at point. +With prefix argument ARG, open the file in other window. +See `markdown-wiki-link-p' and `markdown-follow-wiki-link'." + (interactive "P") + (if (markdown-wiki-link-p) + (markdown-follow-wiki-link (markdown-wiki-link-link) arg) + (user-error "Point is not at a Wiki Link"))) + +(defun markdown-highlight-wiki-link (from to face) + "Highlight the wiki link in the region between FROM and TO using FACE." + (put-text-property from to 'font-lock-face face)) + +(defun markdown-unfontify-region-wiki-links (from to) + "Remove wiki link faces from the region specified by FROM and TO." + (interactive "*r") + (let ((modified (buffer-modified-p))) + (remove-text-properties from to '(font-lock-face markdown-link-face)) + (remove-text-properties from to '(font-lock-face markdown-missing-link-face)) + ;; remove-text-properties marks the buffer modified in emacs 24.3, + ;; undo that if it wasn't originally marked modified + (set-buffer-modified-p modified))) + +(defun markdown-fontify-region-wiki-links (from to) + "Search region given by FROM and TO for wiki links and fontify them. +If a wiki link is found check to see if the backing file exists +and highlight accordingly." + (goto-char from) + (save-match-data + (while (re-search-forward markdown-regex-wiki-link to t) + (when (not (markdown-code-block-at-point-p)) + (let ((highlight-beginning (match-beginning 1)) + (highlight-end (match-end 1)) + (file-name + (markdown-convert-wiki-link-to-filename + (markdown-wiki-link-link)))) + (if (condition-case nil (file-exists-p file-name) (error nil)) + (markdown-highlight-wiki-link + highlight-beginning highlight-end 'markdown-link-face) + (markdown-highlight-wiki-link + highlight-beginning highlight-end 'markdown-missing-link-face))))))) + +(defun markdown-extend-changed-region (from to) + "Extend region given by FROM and TO so that we can fontify all links. +The region is extended to the first newline before and the first +newline after." + ;; start looking for the first new line before 'from + (goto-char from) + (re-search-backward "\n" nil t) + (let ((new-from (point-min)) + (new-to (point-max))) + (if (not (= (point) from)) + (setq new-from (point))) + ;; do the same thing for the first new line after 'to + (goto-char to) + (re-search-forward "\n" nil t) + (if (not (= (point) to)) + (setq new-to (point))) + (cl-values new-from new-to))) + +(defun markdown-check-change-for-wiki-link (from to) + "Check region between FROM and TO for wiki links and re-fontify as needed." + (interactive "*r") + (let* ((modified (buffer-modified-p)) + (buffer-undo-list t) + (inhibit-read-only t) + deactivate-mark + buffer-file-truename) + (unwind-protect + (save-excursion + (save-match-data + (save-restriction + (cursor-intangible-mode +1) ;; inhibit-point-motion-hooks is obsoleted since Emacs 29 + ;; Extend the region to fontify so that it starts + ;; and ends at safe places. + (cl-multiple-value-bind (new-from new-to) + (markdown-extend-changed-region from to) + (goto-char new-from) + ;; Only refontify when the range contains text with a + ;; wiki link face or if the wiki link regexp matches. + (when (or (markdown-range-property-any + new-from new-to 'font-lock-face + '(markdown-link-face markdown-missing-link-face)) + (re-search-forward + markdown-regex-wiki-link new-to t)) + ;; Unfontify existing fontification (start from scratch) + (markdown-unfontify-region-wiki-links new-from new-to) + ;; Now do the fontification. + (markdown-fontify-region-wiki-links new-from new-to)))))) + (cursor-intangible-mode -1) + (and (not modified) + (buffer-modified-p) + (set-buffer-modified-p nil))))) + +(defun markdown-check-change-for-wiki-link-after-change (from to _) + "Check region between FROM and TO for wiki links and re-fontify as needed. +Designed to be used with the `after-change-functions' hook." + (markdown-check-change-for-wiki-link from to)) + +(defun markdown-fontify-buffer-wiki-links () + "Refontify all wiki links in the buffer." + (interactive) + (markdown-check-change-for-wiki-link (point-min) (point-max))) + +(defun markdown-toggle-wiki-links (&optional arg) + "Toggle support for wiki links. +With a prefix argument ARG, enable wiki link support if ARG is positive, +and disable it otherwise." + (interactive (list (or current-prefix-arg 'toggle))) + (setq markdown-enable-wiki-links + (if (eq arg 'toggle) + (not markdown-enable-wiki-links) + (> (prefix-numeric-value arg) 0))) + (when (called-interactively-p 'interactive) + (message "markdown-mode wiki link support %s" (if markdown-enable-wiki-links "enabled" "disabled"))) + (markdown-reload-extensions)) + +(defun markdown-setup-wiki-link-hooks () + "Add or remove hooks for fontifying wiki links. +These are only enabled when `markdown-wiki-link-fontify-missing' is non-nil." + ;; Anytime text changes make sure it gets fontified correctly + (if (and markdown-enable-wiki-links + markdown-wiki-link-fontify-missing) + (add-hook 'after-change-functions + #'markdown-check-change-for-wiki-link-after-change t t) + (remove-hook 'after-change-functions + #'markdown-check-change-for-wiki-link-after-change t)) + ;; If we left the buffer there is a really good chance we were + ;; creating one of the wiki link documents. Make sure we get + ;; refontified when we come back. + (if (and markdown-enable-wiki-links + markdown-wiki-link-fontify-missing) + (progn + (add-hook 'window-configuration-change-hook + #'markdown-fontify-buffer-wiki-links t t) + (markdown-fontify-buffer-wiki-links)) + (remove-hook 'window-configuration-change-hook + #'markdown-fontify-buffer-wiki-links t) + (markdown-unfontify-region-wiki-links (point-min) (point-max)))) + + +;;; Following & Doing ========================================================= + +(defun markdown-follow-thing-at-point (arg) + "Follow thing at point if possible, such as a reference link or wiki link. +Opens inline and reference links in a browser. Opens wiki links +to other files in the current window, or the another window if +ARG is non-nil. +See `markdown-follow-link-at-point' and +`markdown-follow-wiki-link-at-point'." + (interactive "P") + (cond ((markdown-link-p) + (markdown-follow-link-at-point)) + ((markdown-wiki-link-p) + (markdown-follow-wiki-link-at-point arg)) + (t + (let* ((values (markdown-link-at-pos (point))) + (url (nth 3 values))) + (unless url + (user-error "Nothing to follow at point")) + (markdown--browse-url url))))) + +(defun markdown-do () + "Do something sensible based on context at point. +Jumps between reference links and definitions; between footnote +markers and footnote text." + (interactive) + (cond + ;; Footnote definition + ((markdown-footnote-text-positions) + (markdown-footnote-return)) + ;; Footnote marker + ((markdown-footnote-marker-positions) + (markdown-footnote-goto-text)) + ;; Reference link + ((thing-at-point-looking-at markdown-regex-link-reference) + (markdown-reference-goto-definition)) + ;; Reference definition + ((thing-at-point-looking-at markdown-regex-reference-definition) + (markdown-reference-goto-link (match-string-no-properties 2))) + ;; Link + ((or (markdown-link-p) (markdown-wiki-link-p)) + (markdown-follow-thing-at-point nil)) + ;; GFM task list item + ((markdown-gfm-task-list-item-at-point) + (markdown-toggle-gfm-checkbox)) + ;; Align table + ((markdown-table-at-point-p) + (call-interactively #'markdown-table-align)) + ;; Otherwise + (t + (markdown-insert-gfm-checkbox)))) + + +;;; Miscellaneous ============================================================= + +(defun markdown-compress-whitespace-string (str) + "Compress whitespace in STR and return result. +Leading and trailing whitespace is removed. Sequences of multiple +spaces, tabs, and newlines are replaced with single spaces." + (replace-regexp-in-string "\\(^[ \t\n]+\\|[ \t\n]+$\\)" "" + (replace-regexp-in-string "[ \t\n]+" " " str))) + +(defun markdown--substitute-command-keys (string) + "Like `substitute-command-keys' but, but prefers control characters. +First pass STRING to `substitute-command-keys' and then +substitute `C-i` for `TAB` and `C-m` for `RET`." + (replace-regexp-in-string + "\\<TAB\\>" "C-i" + (replace-regexp-in-string + "\\<RET\\>" "C-m" (substitute-command-keys string) t) t)) + +(defun markdown-line-number-at-pos (&optional pos) + "Return (narrowed) buffer line number at position POS. +If POS is nil, use current buffer location. +This is an exact copy of `line-number-at-pos' for use in emacs21." + (let ((opoint (or pos (point))) start) + (save-excursion + (goto-char (point-min)) + (setq start (point)) + (goto-char opoint) + (forward-line 0) + (1+ (count-lines start (point)))))) + +(defun markdown-inside-link-p () + "Return t if point is within a link." + (save-match-data + (thing-at-point-looking-at (markdown-make-regex-link-generic)))) + +(defun markdown-line-is-reference-definition-p () + "Return whether the current line is a (non-footnote) reference definition." + (save-excursion + (move-beginning-of-line 1) + (and (looking-at-p markdown-regex-reference-definition) + (not (looking-at-p "[ \t]*\\[^"))))) + +(defun markdown-adaptive-fill-function () + "Return prefix for filling paragraph or nil if not determined." + (cond + ;; List item inside blockquote + ((looking-at "^[ \t]*>[ \t]*\\(\\(?:[0-9]+\\|#\\)\\.\\|[*+:-]\\)[ \t]+") + (replace-regexp-in-string + "[0-9\\.*+-]" " " (match-string-no-properties 0))) + ;; Blockquote + ((looking-at markdown-regex-blockquote) + (buffer-substring-no-properties (match-beginning 0) (match-end 2))) + ;; List items + ((looking-at markdown-regex-list) + (match-string-no-properties 0)) + ;; Footnote definition + ((looking-at-p markdown-regex-footnote-definition) + " ") ; four spaces + ;; No match + (t nil))) + +(defun markdown-fill-paragraph (&optional justify) + "Fill paragraph at or after point. +This function is like \\[fill-paragraph], but it skips Markdown +code blocks. If the point is in a code block, or just before one, +do not fill. Otherwise, call `fill-paragraph' as usual. If +JUSTIFY is non-nil, justify text as well. Since this function +handles filling itself, it always returns t so that +`fill-paragraph' doesn't run." + (interactive "P") + (unless (or (markdown-code-block-at-point-p) + (save-excursion + (back-to-indentation) + (skip-syntax-forward "-") + (markdown-code-block-at-point-p))) + (let ((fill-prefix (save-excursion + (goto-char (line-beginning-position)) + (when (looking-at "\\([ \t]*>[ \t]*\\(?:>[ \t]*\\)+\\)") + (match-string-no-properties 1))))) + (fill-paragraph justify))) + t) + +(defun markdown-fill-forward-paragraph (&optional arg) + "Function used by `fill-paragraph' to move over ARG paragraphs. +This is a `fill-forward-paragraph-function' for `markdown-mode'. +It is called with a single argument specifying the number of +paragraphs to move. Just like `forward-paragraph', it should +return the number of paragraphs left to move." + (or arg (setq arg 1)) + (if (> arg 0) + ;; With positive ARG, move across ARG non-code-block paragraphs, + ;; one at a time. When passing a code block, don't decrement ARG. + (while (and (not (eobp)) + (> arg 0) + (= (forward-paragraph 1) 0) + (or (markdown-code-block-at-pos (line-beginning-position 0)) + (setq arg (1- arg))))) + ;; Move backward by one paragraph with negative ARG (always -1). + (let ((start (point))) + (setq arg (forward-paragraph arg)) + (while (and (not (eobp)) + (progn (move-to-left-margin) (not (eobp))) + (looking-at-p paragraph-separate)) + (forward-line 1)) + (cond + ;; Move point past whitespace following list marker. + ((looking-at markdown-regex-list) + (goto-char (match-end 0))) + ;; Move point past whitespace following pipe at beginning of line + ;; to handle Pandoc line blocks. + ((looking-at "^|\\s-*") + (goto-char (match-end 0))) + ;; Return point if the paragraph passed was a code block. + ((markdown-code-block-at-pos (line-beginning-position 2)) + (goto-char start))))) + arg) + +(defun markdown--inhibit-electric-quote () + "Function added to `electric-quote-inhibit-functions'. +Return non-nil if the quote has been inserted inside a code block +or span." + (let ((pos (1- (point)))) + (or (markdown-inline-code-at-pos pos) + (markdown-code-block-at-pos pos)))) + + +;;; Extension Framework ======================================================= + +(defun markdown-reload-extensions () + "Check settings, update font-lock keywords and hooks, and re-fontify buffer." + (interactive) + (when (derived-mode-p 'markdown-mode) + ;; Refontify buffer + (font-lock-flush) + ;; Add or remove hooks related to extensions + (markdown-setup-wiki-link-hooks))) + +(defun markdown-handle-local-variables () + "Run in `hack-local-variables-hook' to update font lock rules. +Checks to see if there is actually a ‘markdown-mode’ file local variable +before regenerating font-lock rules for extensions." + (when (or (assoc 'markdown-enable-wiki-links file-local-variables-alist) + (assoc 'markdown-enable-math file-local-variables-alist)) + (when (assoc 'markdown-enable-math file-local-variables-alist) + (markdown-toggle-math markdown-enable-math)) + (markdown-reload-extensions))) + + +;;; Math Support ============================================================== + +(defconst markdown-mode-font-lock-keywords-math + (list + ;; Equation reference (eq:foo) + '("\\((eq:\\)\\([[:alnum:]:_]+\\)\\()\\)" . ((1 markdown-markup-face) + (2 markdown-reference-face) + (3 markdown-markup-face))) + ;; Equation reference \eqref{foo} + '("\\(\\\\eqref{\\)\\([[:alnum:]:_]+\\)\\(}\\)" . ((1 markdown-markup-face) + (2 markdown-reference-face) + (3 markdown-markup-face)))) + "Font lock keywords to add and remove when toggling math support.") + +(defun markdown-toggle-math (&optional arg) + "Toggle support for inline and display LaTeX math expressions. +With a prefix argument ARG, enable math mode if ARG is positive, +and disable it otherwise. If called from Lisp, enable the mode +if ARG is omitted or nil." + (interactive (list (or current-prefix-arg 'toggle))) + (setq markdown-enable-math + (if (eq arg 'toggle) + (not markdown-enable-math) + (> (prefix-numeric-value arg) 0))) + (if markdown-enable-math + (font-lock-add-keywords + 'markdown-mode markdown-mode-font-lock-keywords-math) + (font-lock-remove-keywords + 'markdown-mode markdown-mode-font-lock-keywords-math)) + (when (called-interactively-p 'interactive) + (message "markdown-mode math support %s" (if markdown-enable-math "enabled" "disabled"))) + (markdown-reload-extensions)) + + +;;; GFM Checkboxes ============================================================ + +(define-button-type 'markdown-gfm-checkbox-button + 'follow-link t + 'face 'markdown-gfm-checkbox-face + 'mouse-face 'markdown-highlight-face + 'action #'markdown-toggle-gfm-checkbox-button) + +(defun markdown-gfm-task-list-item-at-point (&optional bounds) + "Return non-nil if there is a GFM task list item at the point. +Optionally, the list item BOUNDS may be given if available, as +returned by `markdown-cur-list-item-bounds'. When a task list item +is found, the return value is the same value returned by +`markdown-cur-list-item-bounds'." + (unless bounds + (setq bounds (markdown-cur-list-item-bounds))) + (> (length (nth 5 bounds)) 0)) + +(defun markdown-insert-gfm-checkbox () + "Add GFM checkbox at point. +Returns t if added. +Returns nil if non-applicable." + (interactive) + (let ((bounds (markdown-cur-list-item-bounds))) + (if bounds + (unless (cl-sixth bounds) + (let ((pos (+ (cl-first bounds) (cl-fourth bounds))) + (markup "[ ] ")) + (if (< pos (point)) + (save-excursion + (goto-char pos) + (insert markup)) + (goto-char pos) + (insert markup)) + (syntax-propertize (+ (cl-second bounds) 4)) + t)) + (unless (save-excursion + (back-to-indentation) + (or (markdown-list-item-at-point-p) + (markdown-heading-at-point) + (markdown-in-comment-p) + (markdown-code-block-at-point-p))) + (let ((pos (save-excursion + (back-to-indentation) + (point))) + (markup (concat (or (save-excursion + (beginning-of-line 0) + (cl-fifth (markdown-cur-list-item-bounds))) + markdown-unordered-list-item-prefix) + "[ ] "))) + (if (< pos (point)) + (save-excursion + (goto-char pos) + (insert markup)) + (goto-char pos) + (insert markup)) + (syntax-propertize (line-end-position)) + t))))) + +(defun markdown-toggle-gfm-checkbox () + "Toggle GFM checkbox at point. +Returns the resulting status as a string, either \"[x]\" or \"[ ]\". +Returns nil if there is no task list item at the point." + (interactive) + (save-match-data + (save-excursion + (let ((bounds (markdown-cur-list-item-bounds))) + (when bounds + ;; Move to beginning of task list item + (goto-char (cl-first bounds)) + ;; Advance to column of first non-whitespace after marker + (forward-char (cl-fourth bounds)) + (cond ((looking-at "\\[ \\]") + (replace-match + (if markdown-gfm-uppercase-checkbox "[X]" "[x]") + nil t) + (match-string-no-properties 0)) + ((looking-at "\\[[xX]\\]") + (replace-match "[ ]" nil t) + (match-string-no-properties 0)))))))) + +(defun markdown-toggle-gfm-checkbox-button (button) + "Toggle GFM checkbox BUTTON on click." + (save-match-data + (save-excursion + (goto-char (button-start button)) + (markdown-toggle-gfm-checkbox)))) + +(defun markdown-make-gfm-checkboxes-buttons (start end) + "Make GFM checkboxes buttons in region between START and END." + (save-excursion + (goto-char start) + (let ((case-fold-search t)) + (save-excursion + (while (re-search-forward markdown-regex-gfm-checkbox end t) + (make-button (match-beginning 1) (match-end 1) + :type 'markdown-gfm-checkbox-button)))))) + +;; Called when any modification is made to buffer text. +(defun markdown-gfm-checkbox-after-change-function (beg end _) + "Add to `after-change-functions' to setup GFM checkboxes as buttons. +BEG and END are the limits of scanned region." + (save-excursion + (save-match-data + ;; Rescan between start of line from `beg' and start of line after `end'. + (markdown-make-gfm-checkboxes-buttons + (progn (goto-char beg) (beginning-of-line) (point)) + (progn (goto-char end) (forward-line 1) (point)))))) + +(defun markdown-remove-gfm-checkbox-overlays () + "Remove all GFM checkbox overlays in buffer." + (save-excursion + (save-restriction + (widen) + (remove-overlays nil nil 'face 'markdown-gfm-checkbox-face)))) + + +;;; Display inline image ====================================================== + +(defvar-local markdown-inline-image-overlays nil) + +(defun markdown-remove-inline-images () + "Remove inline image overlays from image links in the buffer. +This can be toggled with `markdown-toggle-inline-images' +or \\[markdown-toggle-inline-images]." + (interactive) + (mapc #'delete-overlay markdown-inline-image-overlays) + (setq markdown-inline-image-overlays nil) + (when (fboundp 'clear-image-cache) (clear-image-cache))) + +(defcustom markdown-display-remote-images nil + "If non-nil, download and display remote images. +See also `markdown-inline-image-overlays'. + +Only image URLs specified with a protocol listed in +`markdown-remote-image-protocols' are displayed." + :group 'markdown + :type 'boolean) + +(defcustom markdown-remote-image-protocols '("https") + "List of protocols to use to download remote images. +See also `markdown-display-remote-images'." + :group 'markdown + :type '(repeat string)) + +(defvar markdown--remote-image-cache + (make-hash-table :test 'equal) + "A map from URLs to image paths.") + +(defun markdown--get-remote-image (url) + "Retrieve the image path for a given URL." + (or (gethash url markdown--remote-image-cache) + (let ((dl-path (make-temp-file "markdown-mode--image"))) + (require 'url) + (url-copy-file url dl-path t) + (puthash url dl-path markdown--remote-image-cache)))) + +(defun markdown-display-inline-images () + "Add inline image overlays to image links in the buffer. +This can be toggled with `markdown-toggle-inline-images' +or \\[markdown-toggle-inline-images]." + (interactive) + (unless (display-images-p) + (error "Cannot show images")) + (save-excursion + (save-restriction + (widen) + (goto-char (point-min)) + (while (re-search-forward markdown-regex-link-inline nil t) + (let* ((start (match-beginning 0)) + (imagep (match-beginning 1)) + (end (match-end 0)) + (file (match-string-no-properties 6))) + (when (and imagep + (not (zerop (length file)))) + (unless (file-exists-p file) + (let* ((download-file (funcall markdown-translate-filename-function file)) + (valid-url (ignore-errors + (member (downcase (url-type (url-generic-parse-url download-file))) + markdown-remote-image-protocols)))) + (if (and markdown-display-remote-images valid-url) + (setq file (markdown--get-remote-image download-file)) + (when (not valid-url) + ;; strip query parameter + (setq file (replace-regexp-in-string "?.+\\'" "" file)) + (unless (file-exists-p file) + (setq file (url-unhex-string file))))))) + (when (file-exists-p file) + (let* ((abspath (if (file-name-absolute-p file) + file + (concat default-directory file))) + (image + (cond ((and markdown-max-image-size + (image-type-available-p 'imagemagick)) + (create-image + abspath 'imagemagick nil + :max-width (car markdown-max-image-size) + :max-height (cdr markdown-max-image-size))) + (markdown-max-image-size + (create-image abspath nil nil + :max-width (car markdown-max-image-size) + :max-height (cdr markdown-max-image-size))) + (t (create-image abspath))))) + (when image + (let ((ov (make-overlay start end))) + (overlay-put ov 'display image) + (overlay-put ov 'face 'default) + (push ov markdown-inline-image-overlays))))))))))) + +(defun markdown-toggle-inline-images () + "Toggle inline image overlays in the buffer." + (interactive) + (if markdown-inline-image-overlays + (markdown-remove-inline-images) + (markdown-display-inline-images))) + + +;;; GFM Code Block Fontification ============================================== + +(defcustom markdown-fontify-code-blocks-natively nil + "When non-nil, fontify code in code blocks using the native major mode. +This only works for fenced code blocks where the language is +specified where we can automatically determine the appropriate +mode to use. The language to mode mapping may be customized by +setting the variable `markdown-code-lang-modes'." + :group 'markdown + :type 'boolean + :safe #'booleanp + :package-version '(markdown-mode . "2.3")) + +(defcustom markdown-fontify-code-block-default-mode nil + "Default mode to use to fontify code blocks. +This mode is used when automatic detection fails, such as for GFM +code blocks with no language specified." + :group 'markdown + :type '(choice function (const :tag "None" nil)) + :package-version '(markdown-mode . "2.4")) + +(defun markdown-toggle-fontify-code-blocks-natively (&optional arg) + "Toggle the native fontification of code blocks. +With a prefix argument ARG, enable if ARG is positive, +and disable otherwise." + (interactive (list (or current-prefix-arg 'toggle))) + (setq markdown-fontify-code-blocks-natively + (if (eq arg 'toggle) + (not markdown-fontify-code-blocks-natively) + (> (prefix-numeric-value arg) 0))) + (when (called-interactively-p 'interactive) + (message "markdown-mode native code block fontification %s" + (if markdown-fontify-code-blocks-natively "enabled" "disabled"))) + (markdown-reload-extensions)) + +;; This is based on `org-src-lang-modes' from org-src.el +(defcustom markdown-code-lang-modes + '(("ocaml" . tuareg-mode) ("elisp" . emacs-lisp-mode) ("ditaa" . artist-mode) + ("asymptote" . asy-mode) ("dot" . fundamental-mode) ("sqlite" . sql-mode) + ("calc" . fundamental-mode) ("C" . c-mode) ("cpp" . c++-mode) + ("C++" . c++-mode) ("screen" . shell-script-mode) ("shell" . sh-mode) + ("bash" . sh-mode)) + "Alist mapping languages to their major mode. +The key is the language name, the value is the major mode. For +many languages this is simple, but for language where this is not +the case, this variable provides a way to simplify things on the +user side. For example, there is no ocaml-mode in Emacs, but the +mode to use is `tuareg-mode'." + :group 'markdown + :type '(repeat + (cons + (string "Language name") + (symbol "Major mode"))) + :package-version '(markdown-mode . "2.3")) + +(defun markdown-get-lang-mode (lang) + "Return major mode that should be used for LANG. +LANG is a string, and the returned major mode is a symbol." + (cl-find-if + #'markdown--lang-mode-predicate + (nconc (list (cdr (assoc lang markdown-code-lang-modes)) + (cdr (assoc (downcase lang) markdown-code-lang-modes))) + (and (fboundp 'treesit-language-available-p) + (list (and (treesit-language-available-p (intern lang)) + (intern (concat lang "-ts-mode"))) + (and (treesit-language-available-p (intern (downcase lang))) + (intern (concat (downcase lang) "-ts-mode"))))) + (list + (intern (concat lang "-mode")) + (intern (concat (downcase lang) "-mode")))))) + +(defun markdown--lang-mode-predicate (mode) + (and mode + (fboundp mode) + (or + ;; https://github.com/jrblevin/markdown-mode/issues/787 + ;; major-mode-remap-alist was introduced at Emacs 29.1 + (cl-loop for pair in (bound-and-true-p major-mode-remap-alist) + for func = (cdr pair) + thereis (and (atom func) (eq mode func))) + ;; https://github.com/jrblevin/markdown-mode/issues/761 + (cl-loop for pair in auto-mode-alist + for func = (cdr pair) + thereis (and (atom func) (eq mode func)))))) + +(defun markdown-fontify-code-blocks-generic (matcher last) + "Add text properties to next code block from point to LAST. +Use matching function MATCHER." + (when (funcall matcher last) + (save-excursion + (save-match-data + (let* ((start (match-beginning 0)) + (end (match-end 0)) + ;; Find positions outside opening and closing backquotes. + (bol-prev (progn (goto-char start) + (if (bolp) (line-beginning-position 0) (line-beginning-position)))) + (eol-next (progn (goto-char end) + (if (bolp) (line-beginning-position 2) (line-beginning-position 3)))) + lang) + (if (and markdown-fontify-code-blocks-natively + (or (setq lang (markdown-code-block-lang)) + markdown-fontify-code-block-default-mode)) + (markdown-fontify-code-block-natively lang start end) + (add-text-properties start end '(face markdown-pre-face))) + ;; Set background for block as well as opening and closing lines. + (font-lock-append-text-property + bol-prev eol-next 'face 'markdown-code-face) + ;; Set invisible property for lines before and after, including newline. + (add-text-properties bol-prev start '(invisible markdown-markup)) + (add-text-properties end eol-next '(invisible markdown-markup))))) + t)) + +(defun markdown-fontify-gfm-code-blocks (last) + "Add text properties to next GFM code block from point to LAST." + (markdown-fontify-code-blocks-generic 'markdown-match-gfm-code-blocks last)) + +(defun markdown-fontify-fenced-code-blocks (last) + "Add text properties to next tilde fenced code block from point to LAST." + (markdown-fontify-code-blocks-generic 'markdown-match-fenced-code-blocks last)) + +;; Based on `org-src-font-lock-fontify-block' from org-src.el. +(defun markdown-fontify-code-block-natively (lang start end) + "Fontify given GFM or fenced code block. +This function is called by Emacs for automatic fontification when +`markdown-fontify-code-blocks-natively' is non-nil. LANG is the +language used in the block. START and END specify the block +position." + (let ((lang-mode (if lang (markdown-get-lang-mode lang) + markdown-fontify-code-block-default-mode))) + (when (fboundp lang-mode) + (let ((string (buffer-substring-no-properties start end)) + (modified (buffer-modified-p)) + (markdown-buffer (current-buffer)) pos next) + (remove-text-properties start end '(face nil)) + (with-current-buffer + (get-buffer-create + (concat " markdown-code-fontification:" (symbol-name lang-mode))) + ;; Make sure that modification hooks are not inhibited in + ;; the org-src-fontification buffer in case we're called + ;; from `jit-lock-function' (Bug#25132). + (let ((inhibit-modification-hooks nil)) + (delete-region (point-min) (point-max)) + (insert string " ")) ;; so there's a final property change + (unless (eq major-mode lang-mode) (funcall lang-mode)) + (font-lock-ensure) + (setq pos (point-min)) + (while (setq next (next-single-property-change pos 'face)) + (let ((val (get-text-property pos 'face))) + (when val + (put-text-property + (+ start (1- pos)) (1- (+ start next)) 'face + val markdown-buffer))) + (setq pos next))) + (add-text-properties + start end + '(font-lock-fontified t fontified t font-lock-multiline t)) + (set-buffer-modified-p modified))))) + +(require 'edit-indirect nil t) +(defvar edit-indirect-guess-mode-function) +(defvar edit-indirect-after-commit-functions) + +(defun markdown--edit-indirect-after-commit-function (beg end) + "Corrective logic run on code block content from lines BEG to END. +Restores code block indentation from BEG to END, and ensures trailing newlines +at the END of code blocks." + ;; ensure trailing newlines + (goto-char end) + (unless (eq (char-before) ?\n) + (insert "\n")) + ;; restore code block indentation + (goto-char (- beg 1)) + (let ((block-indentation (current-indentation))) + (when (> block-indentation 0) + (indent-rigidly beg end block-indentation))) + (font-lock-ensure)) + +(defun markdown-edit-code-block () + "Edit Markdown code block in an indirect buffer." + (interactive) + (save-excursion + (if (fboundp 'edit-indirect-region) + (let* ((bounds (markdown-get-enclosing-fenced-block-construct)) + (begin (and bounds (not (null (nth 0 bounds))) (goto-char (nth 0 bounds)) (line-beginning-position 2))) + (end (and bounds(not (null (nth 1 bounds))) (goto-char (nth 1 bounds)) (line-beginning-position 1)))) + (if (and begin end) + (let* ((indentation (and (goto-char (nth 0 bounds)) (current-indentation))) + (lang (markdown-code-block-lang)) + (mode (or (and lang (markdown-get-lang-mode lang)) + markdown-edit-code-block-default-mode)) + (edit-indirect-guess-mode-function + (lambda (_parent-buffer _beg _end) + (funcall mode))) + (indirect-buf (edit-indirect-region begin end 'display-buffer))) + ;; reset `sh-shell' when indirect buffer + (when (and (not (member system-type '(ms-dos windows-nt))) + (member mode '(shell-script-mode sh-mode)) + (member lang (append + (mapcar (lambda (e) (symbol-name (car e))) + sh-ancestor-alist) + '("csh" "rc" "sh")))) + (with-current-buffer indirect-buf + (sh-set-shell lang))) + (when (> indentation 0) ;; un-indent in edit-indirect buffer + (with-current-buffer indirect-buf + (indent-rigidly (point-min) (point-max) (- indentation))))) + (user-error "Not inside a GFM or tilde fenced code block"))) + (when (y-or-n-p "Package edit-indirect needed to edit code blocks. Install it now? ") + (progn (package-refresh-contents) + (package-install 'edit-indirect) + (markdown-edit-code-block)))))) + + +;;; Table Editing ============================================================= + +;; These functions were originally adapted from `org-table.el'. + +;; General helper functions + +(defmacro markdown--with-gensyms (symbols &rest body) + (declare (debug (sexp body)) (indent 1)) + `(let ,(mapcar (lambda (s) + `(,s (make-symbol (concat "--" (symbol-name ',s))))) + symbols) + ,@body)) + +(defun markdown--split-string (string &optional separators) + "Splits STRING into substrings at SEPARATORS. +SEPARATORS is a regular expression. If nil it defaults to +`split-string-default-separators'. This version returns no empty +strings if there are matches at the beginning and end of string." + (let ((start 0) notfirst list) + (while (and (string-match + (or separators split-string-default-separators) + string + (if (and notfirst + (= start (match-beginning 0)) + (< start (length string))) + (1+ start) start)) + (< (match-beginning 0) (length string))) + (setq notfirst t) + (or (eq (match-beginning 0) 0) + (and (eq (match-beginning 0) (match-end 0)) + (eq (match-beginning 0) start)) + (push (substring string start (match-beginning 0)) list)) + (setq start (match-end 0))) + (or (eq start (length string)) + (push (substring string start) list)) + (nreverse list))) + +(defun markdown--string-width (s) + "Return width of string S. +This version ignores characters with invisibility property +`markdown-markup'." + (let (b) + (when (or (eq t buffer-invisibility-spec) + (member 'markdown-markup buffer-invisibility-spec)) + (while (setq b (text-property-any + 0 (length s) + 'invisible 'markdown-markup s)) + (setq s (concat + (substring s 0 b) + (substring s (or (next-single-property-change + b 'invisible s) + (length s)))))))) + (string-width s)) + +(defun markdown--remove-invisible-markup (s) + "Remove Markdown markup from string S. +This version removes characters with invisibility property +`markdown-markup'." + (let (b) + (while (setq b (text-property-any + 0 (length s) + 'invisible 'markdown-markup s)) + (setq s (concat + (substring s 0 b) + (substring s (or (next-single-property-change + b 'invisible s) + (length s))))))) + s) + +;; Functions for maintaining tables + +(defvar markdown-table-at-point-p-function #'markdown--table-at-point-p + "Function to decide if point is inside a table. + +The indirection serves to differentiate between standard markdown +tables and gfm tables which are less strict about the markup.") + +(defconst markdown-table-line-regexp "^[ \t]*|" + "Regexp matching any line inside a table.") + +(defconst markdown-table-hline-regexp "^[ \t]*|[-:]" + "Regexp matching hline inside a table.") + +(defconst markdown-table-dline-regexp "^[ \t]*|[^-:]" + "Regexp matching dline inside a table.") + +(defun markdown-table-at-point-p () + "Return non-nil when point is inside a table." + (funcall markdown-table-at-point-p-function)) + +(defun markdown--table-at-point-p () + "Return non-nil when point is inside a table." + (save-excursion + (beginning-of-line) + (and (looking-at-p markdown-table-line-regexp) + (not (markdown-code-block-at-point-p))))) + +(defconst gfm-table-line-regexp "^.?*|" + "Regexp matching any line inside a table.") + +(defconst gfm-table-hline-regexp "^-+\\(|-\\)+" + "Regexp matching hline inside a table.") + +;; GFM simplified tables syntax is as follows: +;; - A header line for the column names, this is any text +;; separated by `|'. +;; - Followed by a string -|-|- ..., the number of dashes is optional +;; but must be higher than 1. The number of separators should match +;; the number of columns. +;; - Followed by the rows of data, which has the same format as the +;; header line. +;; Example: +;; +;; foo | bar +;; ------|--------- +;; bar | baz +;; bar | baz +(defun gfm--table-at-point-p () + "Return non-nil when point is inside a gfm-compatible table." + (or (markdown--table-at-point-p) + (save-excursion + (beginning-of-line) + (when (looking-at-p gfm-table-line-regexp) + ;; we might be at the first line of the table, check if the + ;; line below is the hline + (or (save-excursion + (forward-line 1) + (looking-at-p gfm-table-hline-regexp)) + ;; go up to find the header + (catch 'done + (while (looking-at-p gfm-table-line-regexp) + (cond + ((looking-at-p gfm-table-hline-regexp) + (throw 'done t)) + ((bobp) + (throw 'done nil))) + (forward-line -1)) + nil)))))) + +(defun markdown-table-hline-at-point-p () + "Return non-nil when point is on a hline in a table. +This function assumes point is on a table." + (save-excursion + (beginning-of-line) + (looking-at-p markdown-table-hline-regexp))) + +(defun markdown-table-begin () + "Find the beginning of the table and return its position. +This function assumes point is on a table." + (save-excursion + (while (and (not (bobp)) + (markdown-table-at-point-p)) + (forward-line -1)) + (unless (or (eobp) + (markdown-table-at-point-p)) + (forward-line 1)) + (point))) + +(defun markdown-table-end () + "Find the end of the table and return its position. +This function assumes point is on a table." + (save-excursion + (while (and (not (eobp)) + (markdown-table-at-point-p)) + (forward-line 1)) + (point))) + +(defun markdown-table-get-dline () + "Return index of the table data line at point. +This function assumes point is on a table." + (let ((pos (point)) (end (markdown-table-end)) (cnt 0)) + (save-excursion + (goto-char (markdown-table-begin)) + (while (and (re-search-forward + markdown-table-dline-regexp end t) + (setq cnt (1+ cnt)) + (< (line-end-position) pos)))) + cnt)) + +(defun markdown--thing-at-wiki-link (pos) + (when markdown-enable-wiki-links + (save-excursion + (save-match-data + (goto-char pos) + (thing-at-point-looking-at markdown-regex-wiki-link))))) + +(defun markdown-table-get-column () + "Return table column at point. +This function assumes point is on a table." + (let ((pos (point)) (cnt 0)) + (save-excursion + (beginning-of-line) + (while (search-forward "|" pos t) + (when (and (not (looking-back "\\\\|" (line-beginning-position))) + (not (markdown--thing-at-wiki-link (match-beginning 0)))) + (setq cnt (1+ cnt))))) + cnt)) + +(defun markdown-table-get-cell (&optional n) + "Return the content of the cell in column N of current row. +N defaults to column at point. This function assumes point is on +a table." + (and n (markdown-table-goto-column n)) + (skip-chars-backward "^|\n") (backward-char 1) + (if (looking-at "|[^|\r\n]*") + (let* ((pos (match-beginning 0)) + (val (buffer-substring (1+ pos) (match-end 0)))) + (goto-char (min (line-end-position) (+ 2 pos))) + ;; Trim whitespaces + (setq val (replace-regexp-in-string "\\`[ \t]+" "" val) + val (replace-regexp-in-string "[ \t]+\\'" "" val))) + (forward-char 1) "")) + +(defun markdown-table-goto-dline (n) + "Go to the Nth data line in the table at point. +Return t when the line exists, nil otherwise. This function +assumes point is on a table." + (goto-char (markdown-table-begin)) + (let ((end (markdown-table-end)) (cnt 0)) + (while (and (re-search-forward + markdown-table-dline-regexp end t) + (< (setq cnt (1+ cnt)) n))) + (= cnt n))) + +(defun markdown-table-goto-column (n &optional on-delim) + "Go to the Nth column in the table line at point. +With optional argument ON-DELIM, stop with point before the left +delimiter of the cell. If there are less than N cells, just go +beyond the last delimiter. This function assumes point is on a +table." + (beginning-of-line 1) + (when (> n 0) + (while (and (> n 0) (search-forward "|" (line-end-position) t)) + (when (and (not (looking-back "\\\\|" (line-beginning-position))) + (not (markdown--thing-at-wiki-link (match-beginning 0)))) + (cl-decf n))) + (if on-delim + (backward-char 1) + (when (looking-at " ") (forward-char 1))))) + +(defmacro markdown-table-save-cell (&rest body) + "Save cell at point, execute BODY and restore cell. +This function assumes point is on a table." + (declare (debug (body))) + (markdown--with-gensyms (line column) + `(let ((,line (copy-marker (line-beginning-position))) + (,column (markdown-table-get-column))) + (unwind-protect + (progn ,@body) + (goto-char ,line) + (markdown-table-goto-column ,column) + (set-marker ,line nil))))) + +(defun markdown-table-blank-line (s) + "Convert a table line S into a line with blank cells." + (if (string-match "^[ \t]*|-" s) + (setq s (mapconcat + (lambda (x) (if (member x '(?| ?+)) "|" " ")) + s "")) + (with-temp-buffer + (insert s) + (goto-char (point-min)) + (when (re-search-forward "|" nil t) + (let ((cur (point)) + ret) + (while (re-search-forward "|" nil t) + (when (and (not (eql (char-before (match-beginning 0)) ?\\)) + (not (markdown--thing-at-wiki-link (match-beginning 0)))) + (push (make-string (- (match-beginning 0) cur) ? ) ret) + (setq cur (match-end 0)))) + (format "|%s|" (string-join (nreverse ret) "|"))))))) + +(defun markdown-table-colfmt (fmtspec) + "Process column alignment specifier FMTSPEC for tables." + (when (stringp fmtspec) + (mapcar (lambda (x) + (cond ((string-match-p "^:.*:$" x) 'c) + ((string-match-p "^:" x) 'l) + ((string-match-p ":$" x) 'r) + (t 'd))) + (markdown--split-string fmtspec "\\s-*|\\s-*")))) + +(defun markdown--first-column-p (bar-pos) + (save-excursion + (save-match-data + (goto-char bar-pos) + (looking-back "^\\s-*" (line-beginning-position))))) + +(defun markdown--table-line-to-columns (line) + (with-temp-buffer + (insert line) + (goto-char (point-min)) + (let ((cur (point)) + ret) + (while (and (re-search-forward "\\s-*\\(|\\)\\s-*" nil t)) + (when (not (markdown--face-p (match-beginning 1) '(markdown-inline-code-face))) + (if (markdown--first-column-p (match-beginning 1)) + (setq cur (match-end 0)) + (cond ((eql (char-before (match-beginning 1)) ?\\) + ;; keep spaces + (goto-char (match-end 1))) + ((markdown--thing-at-wiki-link (match-beginning 1))) ;; do nothing + (t + (push (buffer-substring-no-properties cur (match-beginning 0)) ret) + (setq cur (match-end 0))))))) + (when (< cur (length line)) + (push (buffer-substring-no-properties cur (point-max)) ret)) + (nreverse ret)))) + +(defsubst markdown--is-delimiter-row (line) + (and (string-match-p "\\`[ \t]*|[ \t]*[-:]" line) + (cl-loop for c across line + always (member c '(?| ?- ?: ?\t ? ))))) + +(defun markdown-table-align () + "Align table at point. +This function assumes point is on a table." + (interactive) + (let ((begin (markdown-table-begin)) + (end (copy-marker (markdown-table-end)))) + (markdown-table-save-cell + (goto-char begin) + (let* (fmtspec + ;; Store table indent + (indent (progn (looking-at "[ \t]*") (match-string 0))) + ;; Split table in lines and save column format specifier + (lines (mapcar (lambda (line) + (if (markdown--is-delimiter-row line) + (progn (setq fmtspec (or fmtspec line)) nil) + line)) + (markdown--split-string (buffer-substring begin end) "\n"))) + ;; Split lines in cells + (cells (mapcar (lambda (l) (markdown--table-line-to-columns l)) + (remq nil lines))) + ;; Calculate maximum number of cells in a line + (maxcells (if cells + (apply #'max (mapcar #'length cells)) + (user-error "Empty table"))) + ;; Empty cells to fill short lines + (emptycells (make-list maxcells "")) + maxwidths) + ;; Calculate maximum width for each column + (dotimes (i maxcells) + (let ((column (mapcar (lambda (x) (or (nth i x) "")) cells))) + (push (apply #'max 1 (mapcar #'markdown--string-width column)) + maxwidths))) + (setq maxwidths (nreverse maxwidths)) + ;; Process column format specifier + (setq fmtspec (markdown-table-colfmt fmtspec)) + ;; Compute formats needed for output of table lines + (let ((hfmt (concat indent "|")) + (rfmt (concat indent "|")) + hfmt1 rfmt1 fmt) + (dolist (width maxwidths (setq hfmt (concat (substring hfmt 0 -1) "|"))) + (setq fmt (pop fmtspec)) + (cond ((equal fmt 'l) (setq hfmt1 ":%s-|" rfmt1 " %%-%ds |")) + ((equal fmt 'r) (setq hfmt1 "-%s:|" rfmt1 " %%%ds |")) + ((equal fmt 'c) (setq hfmt1 ":%s:|" rfmt1 " %%-%ds |")) + (t (setq hfmt1 "-%s-|" rfmt1 " %%-%ds |"))) + (setq rfmt (concat rfmt (format rfmt1 width))) + (setq hfmt (concat hfmt (format hfmt1 (make-string width ?-))))) + ;; Replace modified lines only + (dolist (line lines) + (let ((line (if line + (apply #'format rfmt (append (pop cells) emptycells)) + hfmt)) + (previous (buffer-substring (point) (line-end-position)))) + (if (equal previous line) + (forward-line) + (insert line "\n") + (delete-region (point) (line-beginning-position 2)))))) + (set-marker end nil))))) + +(defun markdown-table-insert-row (&optional arg) + "Insert a new row above the row at point into the table. +With optional argument ARG, insert below the current row." + (interactive "P") + (unless (markdown-table-at-point-p) + (user-error "Not at a table")) + (let* ((line (buffer-substring + (line-beginning-position) (line-end-position))) + (new (markdown-table-blank-line line))) + (beginning-of-line (if arg 2 1)) + (unless (bolp) (insert "\n")) + (insert-before-markers new "\n") + (beginning-of-line 0) + (re-search-forward "| ?" (line-end-position) t))) + +(defun markdown-table-delete-row () + "Delete row or horizontal line at point from the table." + (interactive) + (unless (markdown-table-at-point-p) + (user-error "Not at a table")) + (let ((col (current-column))) + (kill-region (line-beginning-position) + (min (1+ (line-end-position)) (point-max))) + (unless (markdown-table-at-point-p) (beginning-of-line 0)) + (move-to-column col))) + +(defun markdown-table-move-row (&optional up) + "Move table line at point down. +With optional argument UP, move it up." + (interactive "P") + (unless (markdown-table-at-point-p) + (user-error "Not at a table")) + (let* ((col (current-column)) (pos (point)) + (tonew (if up 0 2)) txt) + (beginning-of-line tonew) + (unless (markdown-table-at-point-p) + (goto-char pos) (user-error "Cannot move row further")) + (goto-char pos) (beginning-of-line 1) (setq pos (point)) + (setq txt (buffer-substring (point) (1+ (line-end-position)))) + (delete-region (point) (1+ (line-end-position))) + (beginning-of-line tonew) + (insert txt) (beginning-of-line 0) + (move-to-column col))) + +(defun markdown-table-move-row-up () + "Move table row at point up." + (interactive) + (markdown-table-move-row 'up)) + +(defun markdown-table-move-row-down () + "Move table row at point down." + (interactive) + (markdown-table-move-row nil)) + +(defun markdown-table-insert-column () + "Insert a new table column." + (interactive) + (unless (markdown-table-at-point-p) + (user-error "Not at a table")) + (let* ((col (max 1 (markdown-table-get-column))) + (begin (markdown-table-begin)) + (end (copy-marker (markdown-table-end)))) + (markdown-table-save-cell + (goto-char begin) + (while (< (point) end) + (markdown-table-goto-column col t) + (if (markdown-table-hline-at-point-p) + (insert "|---") + (insert "| ")) + (forward-line))) + (set-marker end nil) + (when markdown-table-align-p + (markdown-table-align)))) + +(defun markdown-table-delete-column () + "Delete column at point from table." + (interactive) + (unless (markdown-table-at-point-p) + (user-error "Not at a table")) + (let ((col (markdown-table-get-column)) + (begin (markdown-table-begin)) + (end (copy-marker (markdown-table-end)))) + (markdown-table-save-cell + (goto-char begin) + (while (< (point) end) + (markdown-table-goto-column col t) + (and (looking-at "|\\(?:\\\\|\\|[^|\n]\\)+|") + (replace-match "|")) + (forward-line))) + (set-marker end nil) + (markdown-table-goto-column (max 1 (1- col))) + (when markdown-table-align-p + (markdown-table-align)))) + +(defun markdown-table-move-column (&optional left) + "Move table column at point to the right. +With optional argument LEFT, move it to the left." + (interactive "P") + (unless (markdown-table-at-point-p) + (user-error "Not at a table")) + (let* ((col (markdown-table-get-column)) + (col1 (if left (1- col) col)) + (colpos (if left (1- col) (1+ col))) + (begin (markdown-table-begin)) + (end (copy-marker (markdown-table-end)))) + (when (and left (= col 1)) + (user-error "Cannot move column further left")) + (when (and (not left) (looking-at "[^|\n]*|[^|\n]*$")) + (user-error "Cannot move column further right")) + (markdown-table-save-cell + (goto-char begin) + (while (< (point) end) + (markdown-table-goto-column col1 t) + (when (looking-at "|\\(\\(?:\\\\|\\|[^|\n]\\|\\)+\\)|\\(\\(?:\\\\|\\|[^|\n]\\|\\)+\\)|") + (replace-match "|\\2|\\1|")) + (forward-line))) + (set-marker end nil) + (markdown-table-goto-column colpos) + (when markdown-table-align-p + (markdown-table-align)))) + +(defun markdown-table-move-column-left () + "Move table column at point to the left." + (interactive) + (markdown-table-move-column 'left)) + +(defun markdown-table-move-column-right () + "Move table column at point to the right." + (interactive) + (markdown-table-move-column nil)) + +(defun markdown-table-next-row () + "Go to the next row (same column) in the table. +Create new table lines if required." + (interactive) + (unless (markdown-table-at-point-p) + (user-error "Not at a table")) + (if (or (looking-at "[ \t]*$") + (save-excursion (skip-chars-backward " \t") (bolp))) + (newline) + (when markdown-table-align-p + (markdown-table-align)) + (let ((col (markdown-table-get-column))) + (beginning-of-line 2) + (if (or (not (markdown-table-at-point-p)) + (markdown-table-hline-at-point-p)) + (progn + (beginning-of-line 0) + (markdown-table-insert-row 'below))) + (markdown-table-goto-column col) + (skip-chars-backward "^|\n\r") + (when (looking-at " ") (forward-char 1))))) + +(defun markdown-table-forward-cell () + "Go to the next cell in the table. +Create new table lines if required." + (interactive) + (unless (markdown-table-at-point-p) + (user-error "Not at a table")) + (when markdown-table-align-p + (markdown-table-align)) + (let ((end (markdown-table-end))) + (when (markdown-table-hline-at-point-p) (end-of-line 1)) + (condition-case nil + (progn + (re-search-forward "\\(?:^\\|[^\\]\\)|" end) + (when (looking-at "[ \t]*$") + (re-search-forward "\\(?:^\\|[^\\]:\\)|" end)) + (when (and (looking-at "[-:]") + (re-search-forward "^\\(?:[ \t]*\\|[^\\]\\)|\\([^-:]\\)" end t)) + (goto-char (match-beginning 1))) + (if (looking-at "[-:]") + (progn + (beginning-of-line 0) + (markdown-table-insert-row 'below)) + (when (looking-at " ") (forward-char 1)))) + (error (markdown-table-insert-row 'below))))) + +(defun markdown-table-backward-cell () + "Go to the previous cell in the table." + (interactive) + (unless (markdown-table-at-point-p) + (user-error "Not at a table")) + (when markdown-table-align-p + (markdown-table-align)) + (when (markdown-table-hline-at-point-p) (beginning-of-line 1)) + (condition-case nil + (progn + (re-search-backward "\\(?:^\\|[^\\]\\)|" (markdown-table-begin)) + ;; When this function is called while in the first cell in a + ;; table, the point will now be at the beginning of a line. In + ;; this case, we need to move past one additional table + ;; boundary, the end of the table on the previous line. + (when (= (point) (line-beginning-position)) + (re-search-backward "\\(?:^\\|[^\\]\\)|" (markdown-table-begin))) + (re-search-backward "\\(?:^\\|[^\\]\\)|" (markdown-table-begin))) + (error (user-error "Cannot move to previous table cell"))) + (when (looking-at "\\(?:^\\|[^\\]\\)| ?") (goto-char (match-end 0))) + + ;; This may have dropped point on the hline. + (when (markdown-table-hline-at-point-p) + (markdown-table-backward-cell))) + +(defun markdown-table-transpose () + "Transpose table at point. +Horizontal separator lines will be eliminated." + (interactive) + (unless (markdown-table-at-point-p) + (user-error "Not at a table")) + (let* ((table (buffer-substring-no-properties + (markdown-table-begin) (markdown-table-end))) + ;; Convert table to Lisp structure + (table (delq nil + (mapcar + (lambda (x) + (unless (string-match-p + markdown-table-hline-regexp x) + (markdown--table-line-to-columns x))) + (markdown--split-string table "[ \t]*\n[ \t]*")))) + (dline_old (markdown-table-get-dline)) + (col_old (markdown-table-get-column)) + (contents (mapcar (lambda (_) + (let ((tp table)) + (mapcar + (lambda (_) + (prog1 + (pop (car tp)) + (setq tp (cdr tp)))) + table))) + (car table)))) + (goto-char (markdown-table-begin)) + (save-excursion + (re-search-forward "|") (backward-char) + (delete-region (point) (markdown-table-end)) + (insert (mapconcat + (lambda(x) + (concat "| " (mapconcat 'identity x " | " ) " |\n")) + contents ""))) + (markdown-table-goto-dline col_old) + (markdown-table-goto-column dline_old)) + (when markdown-table-align-p + (markdown-table-align))) + +(defun markdown-table-sort-lines (&optional sorting-type) + "Sort table lines according to the column at point. + +The position of point indicates the column to be used for +sorting, and the range of lines is the range between the nearest +horizontal separator lines, or the entire table of no such lines +exist. If point is before the first column, user will be prompted +for the sorting column. If there is an active region, the mark +specifies the first line and the sorting column, while point +should be in the last line to be included into the sorting. + +The command then prompts for the sorting type which can be +alphabetically or numerically. Sorting in reverse order is also +possible. + +If SORTING-TYPE is specified when this function is called from a +Lisp program, no prompting will take place. SORTING-TYPE must be +a character, any of (?a ?A ?n ?N) where the capital letters +indicate that sorting should be done in reverse order." + (interactive) + (unless (markdown-table-at-point-p) + (user-error "Not at a table")) + ;; Set sorting type and column used for sorting + (let ((column (let ((c (markdown-table-get-column))) + (cond ((> c 0) c) + ((called-interactively-p 'any) + (read-number "Use column N for sorting: ")) + (t 1)))) + (sorting-type + (or sorting-type + (progn + ;; workaround #641 + ;; Emacs < 28 hides prompt message by another message. This erases it. + (message "") + (read-char-exclusive + "Sort type: [a]lpha [n]umeric (A/N means reversed): "))))) + (save-restriction + ;; Narrow buffer to appropriate sorting area + (if (region-active-p) + (narrow-to-region + (save-excursion + (progn + (goto-char (region-beginning)) (line-beginning-position))) + (save-excursion + (progn + (goto-char (region-end)) (line-end-position)))) + (let ((start (markdown-table-begin)) + (end (markdown-table-end))) + (narrow-to-region + (save-excursion + (if (re-search-backward + markdown-table-hline-regexp start t) + (line-beginning-position 2) + start)) + (if (save-excursion (re-search-forward + markdown-table-hline-regexp end t)) + (match-beginning 0) + end)))) + ;; Determine arguments for `sort-subr' + (let* ((extract-key-from-cell + (cl-case sorting-type + ((?a ?A) #'markdown--remove-invisible-markup) ;; #'identity) + ((?n ?N) #'string-to-number) + (t (user-error "Invalid sorting type: %c" sorting-type)))) + (predicate + (cl-case sorting-type + ((?n ?N) #'<) + ((?a ?A) #'string<)))) + ;; Sort selected area + (goto-char (point-min)) + (sort-subr (memq sorting-type '(?A ?N)) + (lambda () + (forward-line) + (while (and (not (eobp)) + (not (looking-at + markdown-table-dline-regexp))) + (forward-line))) + #'end-of-line + (lambda () + (funcall extract-key-from-cell + (markdown-table-get-cell column))) + nil + predicate) + (goto-char (point-min)))))) + +(defun markdown-table-convert-region (begin end &optional separator) + "Convert region from BEGIN to END to table with SEPARATOR. + +If every line contains at least one TAB character, the function +assumes that the material is tab separated (TSV). If every line +contains a comma, comma-separated values (CSV) are assumed. If +not, lines are split at whitespace into cells. + +You can use a prefix argument to force a specific separator: +\\[universal-argument] once forces CSV, \\[universal-argument] +twice forces TAB, and \\[universal-argument] three times will +prompt for a regular expression to match the separator, and a +numeric argument N indicates that at least N consecutive +spaces, or alternatively a TAB should be used as the separator." + + (interactive "r\nP") + (let* ((begin (min begin end)) (end (max begin end)) re) + (goto-char begin) (beginning-of-line 1) + (setq begin (point-marker)) + (goto-char end) + (if (bolp) (backward-char 1) (end-of-line 1)) + (setq end (point-marker)) + (when (equal separator '(64)) + (setq separator (read-regexp "Regexp for cell separator: "))) + (unless separator + ;; Get the right cell separator + (goto-char begin) + (setq separator + (cond + ((not (re-search-forward "^[^\n\t]+$" end t)) '(16)) + ((not (re-search-forward "^[^\n,]+$" end t)) '(4)) + (t 1)))) + (goto-char begin) + (if (equal separator '(4)) + ;; Parse CSV + (while (< (point) end) + (cond + ((looking-at "^") (insert "| ")) + ((looking-at "[ \t]*$") (replace-match " |") (beginning-of-line 2)) + ((looking-at "[ \t]*\"\\([^\"\n]*\\)\"") + (replace-match "\\1") (if (looking-at "\"") (insert "\""))) + ((looking-at "[^,\n]+") (goto-char (match-end 0))) + ((looking-at "[ \t]*,") (replace-match " | ")) + (t (beginning-of-line 2)))) + (setq re + (cond + ((equal separator '(4)) "^\\|\"?[ \t]*,[ \t]*\"?") + ((equal separator '(16)) "^\\|\t") + ((integerp separator) + (if (< separator 1) + (user-error "Cell separator must contain one or more spaces") + (format "^ *\\| *\t *\\| \\{%d,\\}\\|$" separator))) + ((stringp separator) (format "^ *\\|%s" separator)) + (t (error "Invalid cell separator")))) + (let (finish) + (while (and (not finish) (re-search-forward re end t)) + (if (eolp) + (progn + (replace-match "|" t t) + (forward-line 1) + (when (eobp) + (setq finish t))) + (replace-match "| " t t))))) + (goto-char begin) + (when markdown-table-align-p + (markdown-table-align)))) + +(defun markdown-insert-table (&optional rows columns align) + "Insert an empty pipe table. +Optional arguments ROWS, COLUMNS, and ALIGN specify number of +rows and columns and the column alignment." + (interactive) + (let* ((rows (or rows (read-number "Number of Rows: "))) + (columns (or columns (read-number "Number of Columns: "))) + (align (or align (read-string "Alignment ([l]eft, [r]ight, [c]enter, or RET for default): "))) + (align (cond ((equal align "l") ":--") + ((equal align "r") "--:") + ((equal align "c") ":-:") + (t "---"))) + (pos (point)) + (indent (make-string (current-column) ?\ )) + (line (concat + (apply 'concat indent "|" + (make-list columns " |")) "\n")) + (hline (apply 'concat indent "|" + (make-list columns (concat align "|"))))) + (if (string-match + "^[ \t]*$" (buffer-substring-no-properties + (line-beginning-position) (point))) + (beginning-of-line 1) + (newline)) + (dotimes (_ rows) (insert line)) + (goto-char pos) + (if (> rows 1) + (progn + (end-of-line 1) (insert (concat "\n" hline)) (goto-char pos))) + (markdown-table-forward-cell))) + + +;;; ElDoc Support ============================================================= + +(defun markdown-eldoc-function (&rest _ignored) + "Return a helpful string when appropriate based on context. +* Report URL when point is at a hidden URL. +* Report language name when point is a code block with hidden markup." + (cond + ;; Hidden URL or reference for inline link + ((and (or (thing-at-point-looking-at markdown-regex-link-inline) + (thing-at-point-looking-at markdown-regex-link-reference)) + (or markdown-hide-urls markdown-hide-markup)) + (let* ((imagep (string-equal (match-string 1) "!")) + (referencep (string-equal (match-string 5) "[")) + (link (match-string-no-properties 6)) + (edit-keys (markdown--substitute-command-keys + (if imagep + "\\[markdown-insert-image]" + "\\[markdown-insert-link]"))) + (edit-str (propertize edit-keys 'face 'font-lock-constant-face)) + (object (if referencep "reference" "URL"))) + (format "Hidden %s (%s to edit): %s" object edit-str + (if referencep + (concat + (propertize "[" 'face 'markdown-markup-face) + (propertize link 'face 'markdown-reference-face) + (propertize "]" 'face 'markdown-markup-face)) + (propertize link 'face 'markdown-url-face))))) + ;; Hidden language name for fenced code blocks + ((and (markdown-code-block-at-point-p) + (not (get-text-property (point) 'markdown-pre)) + markdown-hide-markup) + (let ((lang (save-excursion (markdown-code-block-lang)))) + (unless lang (setq lang "[unspecified]")) + (format "Hidden code block language: %s (%s to toggle markup)" + (propertize lang 'face 'markdown-language-keyword-face) + (markdown--substitute-command-keys + "\\[markdown-toggle-markup-hiding]")))))) + +(defun markdown--image-media-handler (mimetype data) + (let* ((ext (symbol-name (mailcap-mime-type-to-extension mimetype))) + (filename (read-string "Insert filename for image: ")) + (link-text (read-string "Link text: ")) + (filepath (file-name-with-extension filename ext)) + (dir (file-name-directory filepath))) + (when (and dir (not (file-directory-p dir))) + (make-directory dir t)) + (with-temp-file filepath + (insert data)) + (when (string-match-p "\\s-" filepath) + (setq filepath (concat "<" filepath ">"))) + (markdown-insert-inline-image link-text filepath))) + +(defun markdown--file-media-handler (_mimetype data) + (let* ((data (split-string data "[\0\r\n]" t "^file://")) + (files (cdr data))) + (while (not (null files)) + (let* ((file (url-unhex-string (car files))) + (file (file-relative-name file)) + (prompt (format "Link text(%s): " (file-name-nondirectory file))) + (link-text (read-string prompt))) + (when (string-match-p "\\s-" file) + (setq file (concat "<" file ">"))) + (markdown-insert-inline-image link-text file) + (when (not (null (cdr files))) + (insert " ")) + (setq files (cdr files)))))) + +(defun markdown--dnd-local-file-handler (url _action) + (require 'mailcap) + (require 'dnd) + (let* ((filename (dnd-get-local-file-name url)) + (mimetype (mailcap-file-name-to-mime-type filename)) + (file (file-relative-name filename)) + (link-text "link text")) + (when (string-match-p "\\s-" file) + (setq file (concat "<" file ">"))) + (if (string-prefix-p "image/" mimetype) + (markdown-insert-inline-image link-text file) + (markdown-insert-inline-link link-text file)))) + + +;;; Mode Definition ========================================================== + +(defun markdown-show-version () + "Show the version number in the minibuffer." + (interactive) + (message "markdown-mode, version %s" markdown-mode-version)) + +(defun markdown-mode-info () + "Open the `markdown-mode' homepage." + (interactive) + (browse-url "https://jblevins.org/projects/markdown-mode/")) + +;;;###autoload +(define-derived-mode markdown-mode text-mode "Markdown" + "Major mode for editing Markdown files." + (when buffer-read-only + (when (or (not (buffer-file-name)) (file-writable-p (buffer-file-name))) + (setq-local buffer-read-only nil))) + ;; Natural Markdown tab width + (setq tab-width 4) + ;; Comments + (setq-local comment-start "<!-- ") + (setq-local comment-end " -->") + (setq-local comment-start-skip "<!--[ \t]*") + (setq-local comment-column 0) + (setq-local comment-auto-fill-only-comments nil) + (setq-local comment-use-syntax t) + ;; Sentence + (setq-local sentence-end-base "[.?!…‽][]\"'”’)}»›*_`~]*") + ;; Syntax + (add-hook 'syntax-propertize-extend-region-functions + #'markdown-syntax-propertize-extend-region nil t) + (add-hook 'jit-lock-after-change-extend-region-functions + #'markdown-font-lock-extend-region-function t t) + (setq-local syntax-propertize-function #'markdown-syntax-propertize) + (syntax-propertize (point-max)) ;; Propertize before hooks run, etc. + ;; Font lock. + (setq font-lock-defaults + '(markdown-mode-font-lock-keywords + nil nil nil nil + (font-lock-multiline . t) + (font-lock-syntactic-face-function . markdown-syntactic-face) + (font-lock-extra-managed-props + . (composition display invisible rear-nonsticky + keymap help-echo mouse-face)))) + (if markdown-hide-markup + (add-to-invisibility-spec 'markdown-markup) + (remove-from-invisibility-spec 'markdown-markup)) + ;; Wiki links + (markdown-setup-wiki-link-hooks) + ;; Math mode + (when markdown-enable-math (markdown-toggle-math t)) + ;; Add a buffer-local hook to reload after file-local variables are read + (add-hook 'hack-local-variables-hook #'markdown-handle-local-variables nil t) + ;; For imenu support + (setq imenu-create-index-function + (if markdown-nested-imenu-heading-index + #'markdown-imenu-create-nested-index + #'markdown-imenu-create-flat-index)) + + ;; Defun movement + (setq-local beginning-of-defun-function #'markdown-beginning-of-defun) + (setq-local end-of-defun-function #'markdown-end-of-defun) + ;; Paragraph filling + (setq-local fill-paragraph-function #'markdown-fill-paragraph) + (setq-local paragraph-start + ;; Should match start of lines that start or separate paragraphs + (mapconcat #'identity + '( + "\f" ; starts with a literal line-feed + "[ \t\f]*$" ; space-only line + "\\(?:[ \t]*>\\)+[ \t\f]*$"; empty line in blockquote + "[ \t]*[*+-][ \t]+" ; unordered list item + "[ \t]*\\(?:[0-9]+\\|#\\)\\.[ \t]+" ; ordered list item + "[ \t]*\\[\\S-*\\]:[ \t]+" ; link ref def + "[ \t]*:[ \t]+" ; definition + "^|" ; table or Pandoc line block + ) + "\\|")) + (setq-local paragraph-separate + ;; Should match lines that separate paragraphs without being + ;; part of any paragraph: + (mapconcat #'identity + '("[ \t\f]*$" ; space-only line + "\\(?:[ \t]*>\\)+[ \t\f]*$"; empty line in blockquote + ;; The following is not ideal, but the Fill customization + ;; options really only handle paragraph-starting prefixes, + ;; not paragraph-ending suffixes: + ".* $" ; line ending in two spaces + "^#+" + "^\\(?: \\)?[-=]+[ \t]*$" ;; setext + "[ \t]*\\[\\^\\S-*\\]:[ \t]*$") ; just the start of a footnote def + "\\|")) + (setq-local adaptive-fill-first-line-regexp "\\`[ \t]*[A-Z]?>[ \t]*?\\'") + (setq-local adaptive-fill-regexp "\\s-*") + (setq-local adaptive-fill-function #'markdown-adaptive-fill-function) + (setq-local fill-forward-paragraph-function #'markdown-fill-forward-paragraph) + ;; Outline mode + (setq-local outline-regexp markdown-regex-header) + (setq-local outline-level #'markdown-outline-level) + ;; Cause use of ellipses for invisible text. + (add-to-invisibility-spec '(outline . t)) + ;; ElDoc support + (if (boundp 'eldoc-documentation-functions) + (add-hook 'eldoc-documentation-functions #'markdown-eldoc-function nil t) + (add-function :before-until (local 'eldoc-documentation-function) + #'markdown-eldoc-function)) + ;; Inhibiting line-breaking: + ;; Separating out each condition into a separate function so that users can + ;; override if desired (with remove-hook) + (add-hook 'fill-nobreak-predicate + #'markdown-line-is-reference-definition-p nil t) + (add-hook 'fill-nobreak-predicate + #'markdown-pipe-at-bol-p nil t) + + ;; Indentation + (setq-local indent-line-function markdown-indent-function) + (setq-local indent-region-function #'markdown--indent-region) + + ;; Flyspell + (setq-local flyspell-generic-check-word-predicate + #'markdown-flyspell-check-word-p) + + ;; Electric quoting + (add-hook 'electric-quote-inhibit-functions + #'markdown--inhibit-electric-quote nil :local) + + ;; drag and drop handler + (setq-local dnd-protocol-alist (cons '("^file:///" . markdown--dnd-local-file-handler) + dnd-protocol-alist)) + + ;; media handler + (when (version< "29" emacs-version) + (yank-media-handler "image/.*" #'markdown--image-media-handler) + ;; TODO support other than GNOME, like KDE etc + (yank-media-handler "x-special/gnome-copied-files" #'markdown--file-media-handler)) + + ;; Make checkboxes buttons + (when markdown-make-gfm-checkboxes-buttons + (markdown-make-gfm-checkboxes-buttons (point-min) (point-max)) + (add-hook 'after-change-functions #'markdown-gfm-checkbox-after-change-function t t) + (add-hook 'change-major-mode-hook #'markdown-remove-gfm-checkbox-overlays t t)) + + ;; edit-indirect + (add-hook 'edit-indirect-after-commit-functions + #'markdown--edit-indirect-after-commit-function + nil 'local) + + ;; Marginalized headings + (when markdown-marginalize-headers + (add-hook 'window-configuration-change-hook + #'markdown-marginalize-update-current nil t)) + + ;; add live preview export hook + (add-hook 'after-save-hook #'markdown-live-preview-if-markdown t t) + (add-hook 'kill-buffer-hook #'markdown-live-preview-remove-on-kill t t) + + ;; Add a custom keymap for `visual-line-mode' so that activating + ;; this minor mode does not override markdown-mode's keybindings. + ;; FIXME: Probably `visual-line-mode' should take care of this. + (let ((oldmap (cdr (assoc 'visual-line-mode minor-mode-map-alist))) + (newmap (make-sparse-keymap))) + (set-keymap-parent newmap oldmap) + (define-key newmap [remap move-beginning-of-line] nil) + (define-key newmap [remap move-end-of-line] nil) + (make-local-variable 'minor-mode-overriding-map-alist) + (push `(visual-line-mode . ,newmap) minor-mode-overriding-map-alist))) + +;;;###autoload +(add-to-list 'auto-mode-alist + '("\\.\\(?:md\\|markdown\\|mkd\\|mdown\\|mkdn\\|mdwn\\)\\'" . markdown-mode)) + + +;;; GitHub Flavored Markdown Mode ============================================ + +(defun gfm--electric-pair-fence-code-block () + (when (and electric-pair-mode + (not markdown-gfm-use-electric-backquote) + (eql last-command-event ?`) + (let ((count 0)) + (while (eql (char-before (- (point) count)) ?`) + (cl-incf count)) + (= count 3)) + (eql (char-after) ?`)) + (save-excursion (insert (make-string 2 ?`))))) + +(defvar gfm-mode-hook nil + "Hook run when entering GFM mode.") + +;;;###autoload +(define-derived-mode gfm-mode markdown-mode "GFM" + "Major mode for editing GitHub Flavored Markdown files." + (setq markdown-link-space-sub-char "-") + (setq markdown-wiki-link-search-subdirectories t) + (setq-local markdown-table-at-point-p-function #'gfm--table-at-point-p) + (add-hook 'post-self-insert-hook #'gfm--electric-pair-fence-code-block 'append t) + (markdown-gfm-parse-buffer-for-languages)) + + +;;; Viewing modes ============================================================= + +(defcustom markdown-hide-markup-in-view-modes t + "Enable hidden markup mode in `markdown-view-mode' and `gfm-view-mode'." + :group 'markdown + :type 'boolean + :safe #'booleanp) + +(defvar markdown-view-mode-map + (let ((map (make-sparse-keymap))) + (define-key map (kbd "p") #'markdown-outline-previous) + (define-key map (kbd "n") #'markdown-outline-next) + (define-key map (kbd "f") #'markdown-outline-next-same-level) + (define-key map (kbd "b") #'markdown-outline-previous-same-level) + (define-key map (kbd "u") #'markdown-outline-up) + (define-key map (kbd "DEL") #'scroll-down-command) + (define-key map (kbd "SPC") #'scroll-up-command) + (define-key map (kbd ">") #'end-of-buffer) + (define-key map (kbd "<") #'beginning-of-buffer) + (define-key map (kbd "q") #'kill-this-buffer) + (define-key map (kbd "?") #'describe-mode) + map) + "Keymap for `markdown-view-mode'.") + +(defun markdown--filter-visible (beg end &optional delete) + (let ((result "") + (invisible-faces '(markdown-header-delimiter-face markdown-header-rule-face))) + (while (< beg end) + (when (markdown--face-p beg invisible-faces) + (cl-incf beg) + (while (and (markdown--face-p beg invisible-faces) (< beg end)) + (cl-incf beg))) + (let ((next (next-single-char-property-change beg 'invisible))) + (unless (get-char-property beg 'invisible) + (setq result (concat result (buffer-substring beg (min end next))))) + (setq beg next))) + (prog1 result + (when delete + (let ((inhibit-read-only t)) + (delete-region beg end)))))) + +;;;###autoload +(define-derived-mode markdown-view-mode markdown-mode "Markdown-View" + "Major mode for viewing Markdown content." + (setq-local markdown-hide-markup markdown-hide-markup-in-view-modes) + (add-to-invisibility-spec 'markdown-markup) + (setq-local filter-buffer-substring-function #'markdown--filter-visible) + (read-only-mode 1)) + +(defvar gfm-view-mode-map + markdown-view-mode-map + "Keymap for `gfm-view-mode'.") + +;;;###autoload +(define-derived-mode gfm-view-mode gfm-mode "GFM-View" + "Major mode for viewing GitHub Flavored Markdown content." + (setq-local markdown-hide-markup markdown-hide-markup-in-view-modes) + (setq-local markdown-fontify-code-blocks-natively t) + (setq-local filter-buffer-substring-function #'markdown--filter-visible) + (add-to-invisibility-spec 'markdown-markup) + (read-only-mode 1)) + + +;;; Live Preview Mode ======================================================== +;;;###autoload +(define-minor-mode markdown-live-preview-mode + "Toggle native previewing on save for a specific markdown file." + :lighter " MD-Preview" + (if markdown-live-preview-mode + (if (markdown-live-preview-get-filename) + (markdown-display-buffer-other-window (markdown-live-preview-export)) + (markdown-live-preview-mode -1) + (user-error "Buffer %s does not visit a file" (current-buffer))) + (markdown-live-preview-remove))) + + +(provide 'markdown-mode) + +;; Local Variables: +;; indent-tabs-mode: nil +;; coding: utf-8 +;; End: +;;; markdown-mode.el ends here diff --git a/emacs/elpa/markdown-mode-20240626.826/markdown-mode.elc b/emacs/elpa/markdown-mode-20240626.826/markdown-mode.elc Binary files differ. diff --git a/emacs/elpa/transient-20240607.1832/transient-autoloads.el b/emacs/elpa/transient-20240607.1832/transient-autoloads.el @@ -1,78 +0,0 @@ -;;; transient-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*- -;; Generated by the `loaddefs-generate' function. - -;; This file is part of GNU Emacs. - -;;; Code: - -(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path))) - - - -;;; Generated autoloads from transient.el - -(autoload 'transient-insert-suffix "transient" "\ -Insert a SUFFIX into PREFIX before LOC. -PREFIX is a prefix command, a symbol. -SUFFIX is a suffix command or a group specification (of - the same forms as expected by `transient-define-prefix'). -LOC is a command, a key vector, a key description (a string - as returned by `key-description'), or a coordination list - (whose last element may also be a command or key). -Remove a conflicting binding unless optional KEEP-OTHER is - non-nil. -See info node `(transient)Modifying Existing Transients'. - -(fn PREFIX LOC SUFFIX &optional KEEP-OTHER)") -(function-put 'transient-insert-suffix 'lisp-indent-function 'defun) -(autoload 'transient-append-suffix "transient" "\ -Insert a SUFFIX into PREFIX after LOC. -PREFIX is a prefix command, a symbol. -SUFFIX is a suffix command or a group specification (of - the same forms as expected by `transient-define-prefix'). -LOC is a command, a key vector, a key description (a string - as returned by `key-description'), or a coordination list - (whose last element may also be a command or key). -Remove a conflicting binding unless optional KEEP-OTHER is - non-nil. -See info node `(transient)Modifying Existing Transients'. - -(fn PREFIX LOC SUFFIX &optional KEEP-OTHER)") -(function-put 'transient-append-suffix 'lisp-indent-function 'defun) -(autoload 'transient-replace-suffix "transient" "\ -Replace the suffix at LOC in PREFIX with SUFFIX. -PREFIX is a prefix command, a symbol. -SUFFIX is a suffix command or a group specification (of - the same forms as expected by `transient-define-prefix'). -LOC is a command, a key vector, a key description (a string - as returned by `key-description'), or a coordination list - (whose last element may also be a command or key). -See info node `(transient)Modifying Existing Transients'. - -(fn PREFIX LOC SUFFIX)") -(function-put 'transient-replace-suffix 'lisp-indent-function 'defun) -(autoload 'transient-remove-suffix "transient" "\ -Remove the suffix or group at LOC in PREFIX. -PREFIX is a prefix command, a symbol. -LOC is a command, a key vector, a key description (a string - as returned by `key-description'), or a coordination list - (whose last element may also be a command or key). -See info node `(transient)Modifying Existing Transients'. - -(fn PREFIX LOC)") -(function-put 'transient-remove-suffix 'lisp-indent-function 'defun) -(register-definition-prefixes "transient" '("static-if" "transient")) - -;;; End of scraped data - -(provide 'transient-autoloads) - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; no-native-compile: t -;; coding: utf-8-emacs-unix -;; End: - -;;; transient-autoloads.el ends here diff --git a/emacs/elpa/transient-20240607.1832/transient-pkg.el b/emacs/elpa/transient-20240607.1832/transient-pkg.el @@ -1,16 +0,0 @@ -(define-package "transient" "20240607.1832" "Transient commands" - '((emacs "26.1") - (compat "29.1.4.4") - (seq "2.24")) - :commit "872b19b062653797e997db4907da59315ed16c5b" :authors - '(("Jonas Bernoulli" . "emacs.transient@jonas.bernoulli.dev")) - :maintainers - '(("Jonas Bernoulli" . "emacs.transient@jonas.bernoulli.dev")) - :maintainer - '("Jonas Bernoulli" . "emacs.transient@jonas.bernoulli.dev") - :keywords - '("extensions") - :url "https://github.com/magit/transient") -;; Local Variables: -;; no-byte-compile: t -;; End: diff --git a/emacs/elpa/transient-20240607.1832/transient.el b/emacs/elpa/transient-20240607.1832/transient.el @@ -1,4508 +0,0 @@ -;;; transient.el --- Transient commands -*- lexical-binding:t -*- - -;; Copyright (C) 2018-2024 Free Software Foundation, Inc. - -;; Author: Jonas Bernoulli <emacs.transient@jonas.bernoulli.dev> -;; Homepage: https://github.com/magit/transient -;; Keywords: extensions - -;; Package-Version: 0.6.0 -;; Package-Requires: ((emacs "26.1") (compat "29.1.4.4") (seq "2.24")) - -;; SPDX-License-Identifier: GPL-3.0-or-later - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published -;; by the Free Software Foundation, either version 3 of the License, -;; or (at your option) any later version. -;; -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <https://www.gnu.org/licenses/>. - -;;; Commentary: - -;; Transient is the library used to implement the keyboard-driven menus -;; in Magit. It is distributed as a separate package, so that it can be -;; used to implement similar menus in other packages. - -;;; Code: - -(require 'cl-lib) -(require 'compat) -(require 'eieio) -(require 'edmacro) -(require 'format-spec) - -(eval-and-compile - (when (and (featurep' seq) - (not (fboundp 'seq-keep))) - (unload-feature 'seq 'force))) -(require 'seq) -(unless (fboundp 'seq-keep) - (display-warning 'transient (substitute-command-keys "\ -Transient requires `seq' >= 2.24, -but due to bad defaults, Emacs' package manager, refuses to -upgrade this and other built-in packages to higher releases -from GNU Elpa, when a package specifies that this is needed. - -To fix this, you have to add this to your init file: - - (setq package-install-upgrade-built-in t) - -Then evaluate that expression by placing the cursor after it -and typing \\[eval-last-sexp]. - -Once you have done that, you have to explicitly upgrade `seq': - - \\[package-upgrade] seq \\`RET' - -Then you also must make sure the updated version is loaded, -by evaluating this form: - - (progn (unload-feature 'seq t) (require 'seq)) - -Until you do this, you will get random errors about `seq-keep' -being undefined while using Transient. - -If you don't use the `package' package manager but still get -this warning, then your chosen package manager likely has a -similar defect.") :emergency)) - -(eval-when-compile (require 'subr-x)) - -(declare-function info "info" (&optional file-or-node buffer)) -(declare-function Man-find-section "man" (section)) -(declare-function Man-next-section "man" (n)) -(declare-function Man-getpage-in-background "man" (topic)) - -(defvar Man-notify-method) -(defvar pp-default-function) ; since Emacs 29.1 - -(defmacro static-if (condition then-form &rest else-forms) - "A conditional compilation macro. -Evaluate CONDITION at macro-expansion time. If it is non-nil, -expand the macro to THEN-FORM. Otherwise expand it to ELSE-FORMS -enclosed in a `progn' form. ELSE-FORMS may be empty." - (declare (indent 2) - (debug (sexp sexp &rest sexp))) - (if (eval condition lexical-binding) - then-form - (cons 'progn else-forms))) - -(defmacro transient--with-emergency-exit (id &rest body) - (declare (indent defun)) - (unless (keywordp id) - (setq body (cons id body)) - (setq id nil)) - `(condition-case err - (let ((debugger #'transient--exit-and-debug)) - ,(macroexp-progn body)) - ((debug error) - (transient--emergency-exit ,id) - (signal (car err) (cdr err))))) - -(defun transient--exit-and-debug (&rest args) - (transient--emergency-exit :debugger) - (apply #'debug args)) - -;;; Options - -(defgroup transient nil - "Transient commands." - :group 'extensions) - -(defcustom transient-show-popup t - "Whether to show the current transient in a popup buffer. -\\<transient-map> -- If t, then show the popup as soon as a transient prefix command - is invoked. - -- If nil, then do not show the popup unless the user explicitly - requests it, by pressing \\[transient-show] or a prefix key. - -- If a number, then delay displaying the popup and instead show - a brief one-line summary. If zero or negative, then suppress - even showing that summary and display the pressed key only. - - Show the popup when the user explicitly requests it by pressing - \\[transient-show] or a prefix key. Unless zero, then also show the popup - after that many seconds of inactivity (using the absolute value)." - :package-version '(transient . "0.1.0") - :group 'transient - :type '(choice (const :tag "instantly" t) - (const :tag "on demand" nil) - (const :tag "on demand (no summary)" 0) - (number :tag "after delay" 1))) - -(defcustom transient-enable-popup-navigation t - "Whether navigation commands are enabled in the transient popup. - -While a transient is active the transient popup buffer is not the -current buffer, making it necessary to use dedicated commands to -act on that buffer itself. If this is non-nil, then the following -bindings are available: - -\\<transient-popup-navigation-map>\ -- \\[transient-backward-button] moves the cursor to the previous suffix. -- \\[transient-forward-button] moves the cursor to the next suffix. -- \\[transient-push-button] invokes the suffix the cursor is on. -\\<transient-button-map>\ -- \\`<mouse-1>' and \\`<mouse-2>' invoke the clicked on suffix. -\\<transient-popup-navigation-map>\ -- \\[transient-isearch-backward]\ - and \\[transient-isearch-forward] start isearch in the popup buffer. - -\\`<mouse-1>' and \\`<mouse-2>' are bound in `transient-push-button'. -All other bindings are in `transient-popup-navigation-map'. - -By default \\`M-RET' is bound to `transient-push-button', instead of -\\`RET', because if a transient allows the invocation of non-suffixes -then it is likely that you would want \\`RET' to do what it would do -if no transient were active." - :package-version '(transient . "0.4.0") - :group 'transient - :type 'boolean) - -(defcustom transient-display-buffer-action - '(display-buffer-in-side-window - (side . bottom) - (dedicated . t) - (inhibit-same-window . t) - (window-parameters (no-other-window . t))) - "The action used to display the transient popup buffer. - -The transient popup buffer is displayed in a window using - - (display-buffer BUFFER transient-display-buffer-action) - -The value of this option has the form (FUNCTION . ALIST), -where FUNCTION is a function or a list of functions. Each such -function should accept two arguments: a buffer to display and an -alist of the same form as ALIST. See info node `(elisp)Choosing -Window' for details. - -The default is: - - (display-buffer-in-side-window - (side . bottom) - (dedicated . t) - (inhibit-same-window . t) - (window-parameters (no-other-window . t))) - -This displays the window at the bottom of the selected frame. -Another useful FUNCTION is `display-buffer-below-selected', which -is what `magit-popup' used by default. For more alternatives see -info node `(elisp)Display Action Functions' and info node -`(elisp)Buffer Display Action Alists'. - -Note that the buffer that was current before the transient buffer -is shown should remain the current buffer. Many suffix commands -act on the thing at point, if appropriate, and if the transient -buffer became the current buffer, then that would change what is -at point. To that effect `inhibit-same-window' ensures that the -selected window is not used to show the transient buffer. - -It may be possible to display the window in another frame, but -whether that works in practice depends on the window-manager. -If the window manager selects the new window (Emacs frame), -then that unfortunately changes which buffer is current. - -If you change the value of this option, then you might also -want to change the value of `transient-mode-line-format'." - :package-version '(transient . "0.3.0") - :group 'transient - :type '(cons (choice function (repeat :tag "Functions" function)) - alist)) - -(defcustom transient-mode-line-format 'line - "The mode-line format for the transient popup buffer. - -If nil, then the buffer has no mode-line. If the buffer is not -displayed right above the echo area, then this probably is not -a good value. - -If `line' (the default) or a natural number, then the buffer -has no mode-line, but a line is drawn is drawn in its place. -If a number is used, that specifies the thickness of the line. -On termcap frames we cannot draw lines, so there `line' and -numbers are synonyms for nil. - -The color of the line is used to indicate if non-suffixes are -allowed and whether they exit the transient. The foreground -color of `transient-key-noop' (if non-suffix are disallowed), -`transient-key-stay' (if allowed and transient stays active), or -`transient-key-exit' (if allowed and they exit the transient) is -used to draw the line. - -Otherwise this can be any mode-line format. -See `mode-line-format' for details." - :package-version '(transient . "0.2.0") - :group 'transient - :type '(choice (const :tag "hide mode-line" nil) - (const :tag "substitute thin line" line) - (number :tag "substitute line with thickness") - (const :tag "name of prefix command" - ("%e" mode-line-front-space - mode-line-buffer-identification)) - (sexp :tag "custom mode-line format"))) - -(defcustom transient-show-common-commands nil - "Whether to show common transient suffixes in the popup buffer. - -These commands are always shown after typing the prefix key -\"C-x\" when a transient command is active. To toggle the value -of this variable use \"C-x t\" when a transient is active." - :package-version '(transient . "0.1.0") - :group 'transient - :type 'boolean) - -(defcustom transient-read-with-initial-input nil - "Whether to use the last history element as initial minibuffer input." - :package-version '(transient . "0.2.0") - :group 'transient - :type 'boolean) - -(defcustom transient-highlight-mismatched-keys nil - "Whether to highlight keys that do not match their argument. - -This only affects infix arguments that represent command-line -arguments. When this option is non-nil, then the key binding -for infix argument are highlighted when only a long argument -\(e.g., \"--verbose\") is specified but no shorthand (e.g., \"-v\"). -In the rare case that a short-hand is specified but does not -match the key binding, then it is highlighted differently. - -The highlighting is done using `transient-mismatched-key' -and `transient-nonstandard-key'." - :package-version '(transient . "0.1.0") - :group 'transient - :type 'boolean) - -(defcustom transient-highlight-higher-levels nil - "Whether to highlight suffixes on higher levels. - -This is primarily intended for package authors. - -When non-nil then highlight the description of suffixes whose -level is above 4, the default of `transient-default-level'. -Assuming you have set that variable to 7, this highlights all -suffixes that won't be available to users without them making -the same customization." - :package-version '(transient . "0.3.6") - :group 'transient - :type 'boolean) - -(defcustom transient-substitute-key-function nil - "Function used to modify key bindings. - -This function is called with one argument, the prefix object, -and must return a key binding description, either the existing -key description it finds in the `key' slot, or a substitution. - -This is intended to let users replace certain prefix keys. It -could also be used to make other substitutions, but that is -discouraged. - -For example, \"=\" is hard to reach using my custom keyboard -layout, so I substitute \"(\" for that, which is easy to reach -using a layout optimized for Lisp. - - (setq transient-substitute-key-function - (lambda (obj) - (let ((key (oref obj key))) - (if (string-match \"\\\\`\\\\(=\\\\)[a-zA-Z]\" key) - (replace-match \"(\" t t key 1) - key)))))" - :package-version '(transient . "0.1.0") - :group 'transient - :type '(choice (const :tag "Transform no keys (nil)" nil) function)) - -(defcustom transient-semantic-coloring t - "Whether to use colors to indicate transient behavior. - -If non-nil, then the key binding of each suffix is colorized to -indicate whether it exits the transient state or not, and the -line that is drawn below the transient popup buffer is used to -indicate the behavior of non-suffix commands." - :package-version '(transient . "0.5.0") - :group 'transient - :type 'boolean) - -(defcustom transient-detect-key-conflicts nil - "Whether to detect key binding conflicts. - -Conflicts are detected when a transient prefix command is invoked -and results in an error, which prevents the transient from being -used." - :package-version '(transient . "0.1.0") - :group 'transient - :type 'boolean) - -(defcustom transient-align-variable-pitch nil - "Whether to align columns pixel-wise in the popup buffer. - -If this is non-nil, then columns are aligned pixel-wise to -support variable-pitch fonts. Keys are not aligned, so you -should use a fixed-pitch font for the `transient-key' face. -Other key faces inherit from that face unless a theme is -used that breaks that relationship. - -This option is intended for users who use a variable-pitch -font for the `default' face. - -Also see `transient-force-fixed-pitch'." - :package-version '(transient . "0.4.0") - :group 'transient - :type 'boolean) - -(defcustom transient-force-fixed-pitch nil - "Whether to force use of monospaced font in the popup buffer. - -Even if you use a proportional font for the `default' face, -you might still want to use a monospaced font in transient's -popup buffer. Setting this option to t causes `default' to -be remapped to `fixed-pitch' in that buffer. - -Also see `transient-align-variable-pitch'." - :package-version '(transient . "0.2.0") - :group 'transient - :type 'boolean) - -(defcustom transient-force-single-column nil - "Whether to force use of a single column to display suffixes. - -This might be useful for users with low vision who use large -text and might otherwise have to scroll in two dimensions." - :package-version '(transient . "0.3.6") - :group 'transient - :type 'boolean) - -(defcustom transient-hide-during-minibuffer-read nil - "Whether to hide the transient buffer while reading in the minibuffer." - :package-version '(transient . "0.4.0") - :group 'transient - :type 'boolean) - -(defconst transient--max-level 7) -(defconst transient--default-child-level 1) -(defconst transient--default-prefix-level 4) - -(defcustom transient-default-level transient--default-prefix-level - "Control what suffix levels are made available by default. - -Each suffix command is placed on a level and each prefix command -has a level, which controls which suffix commands are available. -Integers between 1 and 7 (inclusive) are valid levels. - -The levels of individual transients and/or their individual -suffixes can be changed individually, by invoking the prefix and -then pressing \"C-x l\". - -The default level for both transients and their suffixes is 4. -This option only controls the default for transients. The default -suffix level is always 4. The author of a transient should place -certain suffixes on a higher level if they expect that it won't be -of use to most users, and they should place very important suffixes -on a lower level so that they remain available even if the user -lowers the transient level. - -\(Magit currently places nearly all suffixes on level 4 and lower -levels are not used at all yet. So for the time being you should -not set a lower level here and using a higher level might not -give you as many additional suffixes as you hoped.)" - :package-version '(transient . "0.1.0") - :group 'transient - :type '(choice (const :tag "1 - fewest suffixes" 1) - (const 2) - (const 3) - (const :tag "4 - default" 4) - (const 5) - (const 6) - (const :tag "7 - most suffixes" 7))) - -(defcustom transient-levels-file - (locate-user-emacs-file "transient/levels.el") - "File used to save levels of transients and their suffixes." - :package-version '(transient . "0.1.0") - :group 'transient - :type 'file) - -(defcustom transient-values-file - (locate-user-emacs-file "transient/values.el") - "File used to save values of transients." - :package-version '(transient . "0.1.0") - :group 'transient - :type 'file) - -(defcustom transient-history-file - (locate-user-emacs-file "transient/history.el") - "File used to save history of transients and their infixes." - :package-version '(transient . "0.1.0") - :group 'transient - :type 'file) - -(defcustom transient-history-limit 10 - "Number of history elements to keep when saving to file." - :package-version '(transient . "0.1.0") - :group 'transient - :type 'integer) - -(defcustom transient-save-history t - "Whether to save history of transient commands when exiting Emacs." - :package-version '(transient . "0.1.0") - :group 'transient - :type 'boolean) - -;;; Faces - -(defgroup transient-faces nil - "Faces used by Transient." - :group 'transient) - -(defface transient-heading '((t :inherit font-lock-keyword-face)) - "Face used for headings." - :group 'transient-faces) - -(defface transient-argument '((t :inherit font-lock-string-face :weight bold)) - "Face used for enabled arguments." - :group 'transient-faces) - -(defface transient-inactive-argument '((t :inherit shadow)) - "Face used for inactive arguments." - :group 'transient-faces) - -(defface transient-value '((t :inherit font-lock-string-face :weight bold)) - "Face used for values." - :group 'transient-faces) - -(defface transient-inactive-value '((t :inherit shadow)) - "Face used for inactive values." - :group 'transient-faces) - -(defface transient-unreachable '((t :inherit shadow)) - "Face used for suffixes unreachable from the current prefix sequence." - :group 'transient-faces) - -(defface transient-inapt-suffix '((t :inherit shadow :italic t)) - "Face used for suffixes that are inapt at this time." - :group 'transient-faces) - -(defface transient-active-infix '((t :inherit highlight)) - "Face used for the infix for which the value is being read." - :group 'transient-faces) - -(defface transient-enabled-suffix - '((t :background "green" :foreground "black" :weight bold)) - "Face used for enabled levels while editing suffix levels. -See info node `(transient)Enabling and Disabling Suffixes'." - :group 'transient-faces) - -(defface transient-disabled-suffix - '((t :background "red" :foreground "black" :weight bold)) - "Face used for disabled levels while editing suffix levels. -See info node `(transient)Enabling and Disabling Suffixes'." - :group 'transient-faces) - -(defface transient-higher-level - `((t :box ( :line-width ,(if (>= emacs-major-version 28) (cons -1 -1) -1) - :color ,(let ((color (face-attribute 'shadow :foreground nil t))) - (or (and (not (eq color 'unspecified)) color) - "grey60"))))) - "Face optionally used to highlight suffixes on higher levels. -Also see option `transient-highlight-higher-levels'." - :group 'transient-faces) - -(defface transient-delimiter '((t :inherit shadow)) - "Face used for delimiters and separators. -This includes the parentheses around values and the pipe -character used to separate possible values from each other." - :group 'transient-faces) - -(defface transient-key '((t :inherit font-lock-builtin-face)) - "Face used for keys." - :group 'transient-faces) - -(defface transient-key-stay - `((((class color) (background light)) - :inherit transient-key - :foreground "#22aa22") - (((class color) (background dark)) - :inherit transient-key - :foreground "#ddffdd")) - "Face used for keys of suffixes that don't exit transient state." - :group 'transient-faces) - -(defface transient-key-noop - `((((class color) (background light)) - :inherit transient-key - :foreground "grey80") - (((class color) (background dark)) - :inherit transient-key - :foreground "grey30")) - "Face used for keys of suffixes that currently cannot be invoked." - :group 'transient-faces) - -(defface transient-key-return - `((((class color) (background light)) - :inherit transient-key - :foreground "#aaaa11") - (((class color) (background dark)) - :inherit transient-key - :foreground "#ffffcc")) - "Face used for keys of suffixes that return to the parent transient." - :group 'transient-faces) - -(defface transient-key-exit - `((((class color) (background light)) - :inherit transient-key - :foreground "#aa2222") - (((class color) (background dark)) - :inherit transient-key - :foreground "#ffdddd")) - "Face used for keys of suffixes that exit transient state." - :group 'transient-faces) - -(defface transient-unreachable-key - '((t :inherit (shadow transient-key) :weight normal)) - "Face used for keys unreachable from the current prefix sequence." - :group 'transient-faces) - -(defface transient-nonstandard-key - `((t :box ( :line-width ,(if (>= emacs-major-version 28) (cons -1 -1) -1) - :color "cyan"))) - "Face optionally used to highlight keys conflicting with short-argument. -Also see option `transient-highlight-mismatched-keys'." - :group 'transient-faces) - -(defface transient-mismatched-key - `((t :box ( :line-width ,(if (>= emacs-major-version 28) (cons -1 -1) -1) - :color "magenta"))) - "Face optionally used to highlight keys without a short-argument. -Also see option `transient-highlight-mismatched-keys'." - :group 'transient-faces) - -;;; Persistence - -(defun transient--read-file-contents (file) - (with-demoted-errors "Transient error: %S" - (and (file-exists-p file) - (with-temp-buffer - (insert-file-contents file) - (read (current-buffer)))))) - -(defun transient--pp-to-file (list file) - (make-directory (file-name-directory file) t) - (setq list (cl-sort (copy-sequence list) #'string< :key #'car)) - (with-temp-file file - (let ((print-level nil) - (print-length nil) - (pp-default-function 'pp-28) - (fill-column 999)) - (pp list (current-buffer))))) - -(defvar transient-values - (transient--read-file-contents transient-values-file) - "Values of transient commands. -The value of this variable persists between Emacs sessions -and you usually should not change it manually.") - -(defun transient-save-values () - (transient--pp-to-file transient-values transient-values-file)) - -(defvar transient-levels - (transient--read-file-contents transient-levels-file) - "Levels of transient commands. -The value of this variable persists between Emacs sessions -and you usually should not change it manually.") - -(defun transient-save-levels () - (transient--pp-to-file transient-levels transient-levels-file)) - -(defvar transient-history - (transient--read-file-contents transient-history-file) - "History of transient commands and infix arguments. -The value of this variable persists between Emacs sessions -\(unless `transient-save-history' is nil) and you usually -should not change it manually.") - -(defun transient-save-history () - (setq transient-history - (cl-sort (mapcar (pcase-lambda (`(,key . ,val)) - (cons key (seq-take (delete-dups val) - transient-history-limit))) - transient-history) - #'string< :key #'car)) - (transient--pp-to-file transient-history transient-history-file)) - -(defun transient-maybe-save-history () - "Save the value of `transient-history'. -If `transient-save-history' is nil, then do nothing." - (when transient-save-history - (transient-save-history))) - -(unless noninteractive - (add-hook 'kill-emacs-hook #'transient-maybe-save-history)) - -;;; Classes -;;;; Prefix - -(defclass transient-prefix () - ((prototype :initarg :prototype) - (command :initarg :command) - (level :initarg :level) - (variable :initarg :variable :initform nil) - (init-value :initarg :init-value) - (value) (default-value :initarg :value) - (scope :initarg :scope :initform nil) - (history :initarg :history :initform nil) - (history-pos :initarg :history-pos :initform 0) - (history-key :initarg :history-key :initform nil) - (show-help :initarg :show-help :initform nil) - (info-manual :initarg :info-manual :initform nil) - (man-page :initarg :man-page :initform nil) - (transient-suffix :initarg :transient-suffix :initform nil) - (transient-non-suffix :initarg :transient-non-suffix :initform nil) - (transient-switch-frame :initarg :transient-switch-frame) - (refresh-suffixes :initarg :refresh-suffixes :initform nil) - (incompatible :initarg :incompatible :initform nil) - (suffix-description :initarg :suffix-description) - (variable-pitch :initarg :variable-pitch :initform nil) - (column-widths :initarg :column-widths :initform nil) - (unwind-suffix :documentation "Internal use." :initform nil)) - "Transient prefix command. - -Each transient prefix command consists of a command, which is -stored in a symbol's function slot and an object, which is -stored in the `transient--prefix' property of the same symbol. - -When a transient prefix command is invoked, then a clone of that -object is stored in the global variable `transient--prefix' and -the prototype is stored in the clone's `prototype' slot.") - -;;;; Suffix - -(defclass transient-child () - ((level - :initarg :level - :initform (symbol-value 'transient--default-child-level) - :documentation "Enable if level of prefix is equal or greater.") - (if - :initarg :if - :initform nil - :documentation "Enable if predicate returns non-nil.") - (if-not - :initarg :if-not - :initform nil - :documentation "Enable if predicate returns nil.") - (if-non-nil - :initarg :if-non-nil - :initform nil - :documentation "Enable if variable's value is non-nil.") - (if-nil - :initarg :if-nil - :initform nil - :documentation "Enable if variable's value is nil.") - (if-mode - :initarg :if-mode - :initform nil - :documentation "Enable if major-mode matches value.") - (if-not-mode - :initarg :if-not-mode - :initform nil - :documentation "Enable if major-mode does not match value.") - (if-derived - :initarg :if-derived - :initform nil - :documentation "Enable if major-mode derives from value.") - (if-not-derived - :initarg :if-not-derived - :initform nil - :documentation "Enable if major-mode does not derive from value.") - (inapt - :initform nil) - (inapt-face - :initarg :inapt-face - :initform 'transient-inapt-suffix) - (inapt-if - :initarg :inapt-if - :initform nil - :documentation "Inapt if predicate returns non-nil.") - (inapt-if-not - :initarg :inapt-if-not - :initform nil - :documentation "Inapt if predicate returns nil.") - (inapt-if-non-nil - :initarg :inapt-if-non-nil - :initform nil - :documentation "Inapt if variable's value is non-nil.") - (inapt-if-nil - :initarg :inapt-if-nil - :initform nil - :documentation "Inapt if variable's value is nil.") - (inapt-if-mode - :initarg :inapt-if-mode - :initform nil - :documentation "Inapt if major-mode matches value.") - (inapt-if-not-mode - :initarg :inapt-if-not-mode - :initform nil - :documentation "Inapt if major-mode does not match value.") - (inapt-if-derived - :initarg :inapt-if-derived - :initform nil - :documentation "Inapt if major-mode derives from value.") - (inapt-if-not-derived - :initarg :inapt-if-not-derived - :initform nil - :documentation "Inapt if major-mode does not derive from value.")) - "Abstract superclass for group and suffix classes. - -It is undefined what happens if more than one `if*' predicate -slot is non-nil." - :abstract t) - -(defclass transient-suffix (transient-child) - ((definition :allocation :class :initform nil) - (key :initarg :key) - (command :initarg :command) - (transient :initarg :transient) - (format :initarg :format :initform " %k %d") - (description :initarg :description :initform nil) - (face :initarg :face :initform nil) - (show-help :initarg :show-help :initform nil)) - "Superclass for suffix command.") - -(defclass transient-information (transient-suffix) - ((format :initform " %k %d") - (key :initform " ")) - "Display-only information, aligned with suffix keys. -Technically a suffix object with no associated command.") - -(defclass transient-information* (transient-information) - ((format :initform " %d")) - "Display-only information, aligned with suffix descriptions. -Technically a suffix object with no associated command.") - -(defclass transient-infix (transient-suffix) - ((transient :initform t) - (argument :initarg :argument) - (shortarg :initarg :shortarg) - (value :initform nil) - (init-value :initarg :init-value) - (unsavable :initarg :unsavable :initform nil) - (multi-value :initarg :multi-value :initform nil) - (always-read :initarg :always-read :initform nil) - (allow-empty :initarg :allow-empty :initform nil) - (history-key :initarg :history-key :initform nil) - (reader :initarg :reader :initform nil) - (prompt :initarg :prompt :initform nil) - (choices :initarg :choices :initform nil) - (format :initform " %k %d (%v)")) - "Transient infix command." - :abstract t) - -(defclass transient-argument (transient-infix) () - "Abstract superclass for infix arguments." - :abstract t) - -(defclass transient-switch (transient-argument) () - "Class used for command-line argument that can be turned on and off.") - -(defclass transient-option (transient-argument) () - "Class used for command-line argument that can take a value.") - -(defclass transient-variable (transient-infix) - ((variable :initarg :variable) - (format :initform " %k %d %v")) - "Abstract superclass for infix commands that set a variable." - :abstract t) - -(defclass transient-switches (transient-argument) - ((argument-format :initarg :argument-format) - (argument-regexp :initarg :argument-regexp)) - "Class used for sets of mutually exclusive command-line switches.") - -(defclass transient-files (transient-option) () - ((key :initform "--") - (argument :initform "--") - (multi-value :initform rest) - (reader :initform transient-read-files)) - "Class used for the \"--\" argument or similar. -All remaining arguments are treated as files. -They become the value of this argument.") - -;;;; Group - -(defclass transient-group (transient-child) - ((suffixes :initarg :suffixes :initform nil) - (hide :initarg :hide :initform nil) - (description :initarg :description :initform nil) - (pad-keys :initarg :pad-keys :initform nil) - (info-format :initarg :info-format :initform nil) - (setup-children :initarg :setup-children)) - "Abstract superclass of all group classes." - :abstract t) - -(defclass transient-column (transient-group) () - "Group class that displays each element on a separate line.") - -(defclass transient-row (transient-group) () - "Group class that displays all elements on a single line.") - -(defclass transient-columns (transient-group) () - "Group class that displays elements organized in columns. -Direct elements have to be groups whose elements have to be -commands or strings. Each subgroup represents a column. -This class takes care of inserting the subgroups' elements.") - -(defclass transient-subgroups (transient-group) () - "Group class that wraps other groups. - -Direct elements have to be groups whose elements have to be -commands or strings. This group inserts an empty line between -subgroups. The subgroups are responsible for displaying their -elements themselves.") - -;;; Define - -(defmacro transient-define-prefix (name arglist &rest args) - "Define NAME as a transient prefix command. - -ARGLIST are the arguments that command takes. -DOCSTRING is the documentation string and is optional. - -These arguments can optionally be followed by key-value pairs. -Each key has to be a keyword symbol, either `:class' or a keyword -argument supported by the constructor of that class. The -`transient-prefix' class is used if the class is not specified -explicitly. - -GROUPs add key bindings for infix and suffix commands and specify -how these bindings are presented in the popup buffer. At least -one GROUP has to be specified. See info node `(transient)Binding -Suffix and Infix Commands'. - -The BODY is optional. If it is omitted, then ARGLIST is also -ignored and the function definition becomes: - - (lambda () - (interactive) - (transient-setup \\='NAME)) - -If BODY is specified, then it must begin with an `interactive' -form that matches ARGLIST, and it must call `transient-setup'. -It may however call that function only when some condition is -satisfied; that is one of the reason why you might want to use -an explicit BODY. - -All transients have a (possibly nil) value, which is exported -when suffix commands are called, so that they can consume that -value. For some transients it might be necessary to have a sort -of secondary value, called a scope. Such a scope would usually -be set in the commands `interactive' form and has to be passed -to the setup function: - - (transient-setup \\='NAME nil nil :scope SCOPE) - -\(fn NAME ARGLIST [DOCSTRING] [KEYWORD VALUE]... GROUP... [BODY...])" - (declare (debug ( &define name lambda-list - [&optional lambda-doc] - [&rest keywordp sexp] - [&rest vectorp] - [&optional ("interactive" interactive) def-body])) - (indent defun) - (doc-string 3)) - (pcase-let ((`(,class ,slots ,suffixes ,docstr ,body ,interactive-only) - (transient--expand-define-args args arglist))) - `(progn - (defalias ',name - ,(if body - `(lambda ,arglist ,@body) - `(lambda () - (interactive) - (transient-setup ',name)))) - (put ',name 'interactive-only ,interactive-only) - (put ',name 'function-documentation ,docstr) - (put ',name 'transient--prefix - (,(or class 'transient-prefix) :command ',name ,@slots)) - (put ',name 'transient--layout - (list ,@(cl-mapcan (lambda (s) (transient--parse-child name s)) - suffixes)))))) - -(defmacro transient-define-suffix (name arglist &rest args) - "Define NAME as a transient suffix command. - -ARGLIST are the arguments that the command takes. -DOCSTRING is the documentation string and is optional. - -These arguments can optionally be followed by key-value pairs. -Each key has to be a keyword symbol, either `:class' or a -keyword argument supported by the constructor of that class. -The `transient-suffix' class is used if the class is not -specified explicitly. - -The BODY must begin with an `interactive' form that matches -ARGLIST. The infix arguments are usually accessed by using -`transient-args' inside `interactive'. - -\(fn NAME ARGLIST [DOCSTRING] [KEYWORD VALUE]... [BODY...])" - (declare (debug ( &define name lambda-list - [&optional lambda-doc] - [&rest keywordp sexp] - [&optional ("interactive" interactive) def-body])) - (indent defun) - (doc-string 3)) - (pcase-let ((`(,class ,slots ,_ ,docstr ,body ,interactive-only) - (transient--expand-define-args args arglist))) - `(progn - (defalias ',name - ,(if (and (not body) class (oref-default class definition)) - `(oref-default ',class definition) - `(lambda ,arglist ,@body))) - (put ',name 'interactive-only ,interactive-only) - (put ',name 'function-documentation ,docstr) - (put ',name 'transient--suffix - (,(or class 'transient-suffix) :command ',name ,@slots))))) - -(defmacro transient-define-infix (name arglist &rest args) - "Define NAME as a transient infix command. - -ARGLIST is always ignored and reserved for future use. -DOCSTRING is the documentation string and is optional. - -At least one key-value pair is required. All transient infix -commands are equal to each other (but not eq). It is meaning- -less to define an infix command, without providing at least one -keyword argument (usually `:argument' or `:variable', depending -on the class). The suffix class defaults to `transient-switch' -and can be set using the `:class' keyword. - -The function definitions is always: - - (lambda () - (interactive) - (let ((obj (transient-suffix-object))) - (transient-infix-set obj (transient-infix-read obj))) - (transient--show)) - -`transient-infix-read' and `transient-infix-set' are generic -functions. Different infix commands behave differently because -the concrete methods are different for different infix command -classes. In rare case the above command function might not be -suitable, even if you define your own infix command class. In -that case you have to use `transient-define-suffix' to define -the infix command and use t as the value of the `:transient' -keyword. - -\(fn NAME ARGLIST [DOCSTRING] KEYWORD VALUE [KEYWORD VALUE]...)" - (declare (debug ( &define name lambda-list - [&optional lambda-doc] - keywordp sexp - [&rest keywordp sexp])) - (indent defun) - (doc-string 3)) - (pcase-let ((`(,class ,slots ,_ ,docstr ,_ ,interactive-only) - (transient--expand-define-args args arglist t))) - `(progn - (defalias ',name #'transient--default-infix-command) - (put ',name 'interactive-only ,interactive-only) - (put ',name 'completion-predicate #'transient--suffix-only) - (put ',name 'function-documentation ,docstr) - (put ',name 'transient--suffix - (,(or class 'transient-switch) :command ',name ,@slots))))) - -(defalias 'transient-define-argument #'transient-define-infix - "Define NAME as a transient infix command. - -Only use this alias to define an infix command that actually -sets an infix argument. To define a infix command that, for -example, sets a variable, use `transient-define-infix' instead. - -\(fn NAME ARGLIST [DOCSTRING] [KEYWORD VALUE]...)") - -(defun transient--default-infix-command () - ;; Most infix commands are but an alias for this command. - "Cannot show any documentation for this transient infix command. - -When you request help for an infix command using `transient-help', that -usually shows the respective man-page and tries to jump to the location -where the respective argument is being described. - -If no man-page is specified for the containing transient menu, then the -docstring is displayed instead, if any. - -If the infix command doesn't have a docstring, as is the case here, then -this docstring is displayed instead, because technically infix commands -are aliases for `transient--default-infix-command'. - -`describe-function' also shows the docstring of the infix command, -falling back to that of the same aliased command." - (interactive) - (let ((obj (transient-suffix-object))) - (transient-infix-set obj (transient-infix-read obj))) - (transient--show)) -(put 'transient--default-infix-command 'interactive-only t) -(put 'transient--default-infix-command 'completion-predicate - #'transient--suffix-only) - -(defun transient--find-function-advised-original (fn func) - "Return nil instead of `transient--default-infix-command'. -When using `find-function' to jump to the definition of a transient -infix command/argument, then we want to actually jump to that, not to -the definition of `transient--default-infix-command', which all infix -commands are aliases for." - (let ((val (funcall fn func))) - (and val (not (eq val 'transient--default-infix-command)) val))) -(advice-add 'find-function-advised-original :around - #'transient--find-function-advised-original) - -(eval-and-compile - (defun transient--expand-define-args (args &optional arglist nobody) - (unless (listp arglist) - (error "Mandatory ARGLIST is missing")) - (let (class keys suffixes docstr declare (interactive-only t)) - (when (stringp (car args)) - (setq docstr (pop args))) - (while (keywordp (car args)) - (let ((k (pop args)) - (v (pop args))) - (if (eq k :class) - (setq class v) - (push k keys) - (push v keys)))) - (while (let ((arg (car args))) - (or (vectorp arg) - (and arg (symbolp arg)))) - (push (pop args) suffixes)) - (when (eq (car-safe (car args)) 'declare) - (setq declare (car args)) - (setq args (cdr args)) - (when-let ((int (assq 'interactive-only declare))) - (setq interactive-only (cadr int)) - (delq int declare)) - (unless (cdr declare) - (setq declare nil))) - (cond - ((not args)) - (nobody - (error "transient-define-infix: No function body allowed")) - ((not (eq (car-safe (nth (if declare 1 0) args)) 'interactive)) - (error "transient-define-*: Interactive form missing"))) - (list (if (eq (car-safe class) 'quote) - (cadr class) - class) - (nreverse keys) - (nreverse suffixes) - docstr - (if declare (cons declare args) args) - interactive-only)))) - -(defun transient--parse-child (prefix spec) - (cl-typecase spec - (null (error "Invalid transient--parse-child spec: %s" spec)) - (symbol (let ((value (symbol-value spec))) - (if (and (listp value) - (or (listp (car value)) - (vectorp (car value)))) - (cl-mapcan (lambda (s) (transient--parse-child prefix s)) value) - (transient--parse-child prefix value)))) - (vector (and-let* ((c (transient--parse-group prefix spec))) (list c))) - (list (and-let* ((c (transient--parse-suffix prefix spec))) (list c))) - (string (list spec)) - (t (error "Invalid transient--parse-child spec: %s" spec)))) - -(defun transient--parse-group (prefix spec) - (setq spec (append spec nil)) - (cl-symbol-macrolet - ((car (car spec)) - (pop (pop spec))) - (let (level class args) - (when (integerp car) - (setq level pop)) - (when (stringp car) - (setq args (plist-put args :description pop))) - (while (keywordp car) - (let ((key pop) - (val pop)) - (cond ((eq key :class) - (setq class (macroexp-quote val))) - ((or (symbolp val) - (and (listp val) (not (eq (car val) 'lambda)))) - (setq args (plist-put args key (macroexp-quote val)))) - ((setq args (plist-put args key val)))))) - (unless (or spec class (not (plist-get args :setup-children))) - (message "WARNING: %s: When %s is used, %s must also be specified" - 'transient-define-prefix :setup-children :class)) - (list 'vector - (or level transient--default-child-level) - (cond (class) - ((or (vectorp car) - (and car (symbolp car))) - (quote 'transient-columns)) - ((quote 'transient-column))) - (and args (cons 'list args)) - (cons 'list - (cl-mapcan (lambda (s) (transient--parse-child prefix s)) - spec)))))) - -(defun transient--parse-suffix (prefix spec) - (let (level class args) - (cl-symbol-macrolet - ((car (car spec)) - (pop (pop spec))) - (when (integerp car) - (setq level pop)) - (when (or (stringp car) - (vectorp car)) - (setq args (plist-put args :key pop))) - (cond - ((or (stringp car) - (and (eq (car-safe car) 'lambda) - (not (commandp car)))) - (setq args (plist-put args :description pop))) - ((and (symbolp car) - (not (keywordp car)) - (not (commandp car)) - (commandp (cadr spec))) - (setq args (plist-put args :description (macroexp-quote pop))))) - (cond - ((memq car '(:info :info*))) - ((keywordp car) - (error "Need command, `:info' or `:info*', got `%s'" car)) - ((symbolp car) - (setq args (plist-put args :command (macroexp-quote pop)))) - ((and (commandp car) - (not (stringp car))) - (let ((cmd pop) - (sym (intern - (format "transient:%s:%s" - prefix - (let ((desc (plist-get args :description))) - (if (and (stringp desc) - (length< desc 16)) - desc - (plist-get args :key))))))) - (setq args (plist-put - args :command - `(prog1 ',sym - (put ',sym 'interactive-only t) - (put ',sym 'completion-predicate #'transient--suffix-only) - (defalias ',sym - ,(if (eq (car-safe cmd) 'lambda) - cmd - (macroexp-quote cmd)))))))) - ((or (stringp car) - (and car (listp car))) - (let ((arg pop) - (sym nil)) - (cl-typecase arg - (list - (setq args (plist-put args :shortarg (car arg))) - (setq args (plist-put args :argument (cadr arg))) - (setq arg (cadr arg))) - (string - (when-let ((shortarg (transient--derive-shortarg arg))) - (setq args (plist-put args :shortarg shortarg))) - (setq args (plist-put args :argument arg)))) - (setq sym (intern (format "transient:%s:%s" prefix arg))) - (setq args (plist-put - args :command - `(prog1 ',sym - (put ',sym 'interactive-only t) - (put ',sym 'completion-predicate #'transient--suffix-only) - (defalias ',sym #'transient--default-infix-command)))) - (cond ((and car (not (keywordp car))) - (setq class 'transient-option) - (setq args (plist-put args :reader (macroexp-quote pop)))) - ((not (string-suffix-p "=" arg)) - (setq class 'transient-switch)) - (t - (setq class 'transient-option))))) - (t - (error "Needed command or argument, got %S" car))) - (while (keywordp car) - (let ((key pop) - (val pop)) - (cond ((eq key :class) (setq class val)) - ((eq key :level) (setq level val)) - ((eq key :info) - (setq class 'transient-information) - (setq args (plist-put args :description val))) - ((eq key :info*) - (setq class 'transient-information*) - (setq args (plist-put args :description val))) - ((eq (car-safe val) '\,) - (setq args (plist-put args key (cadr val)))) - ((or (symbolp val) - (and (listp val) (not (eq (car val) 'lambda)))) - (setq args (plist-put args key (macroexp-quote val)))) - ((setq args (plist-put args key val))))))) - (unless (plist-get args :key) - (when-let ((shortarg (plist-get args :shortarg))) - (setq args (plist-put args :key shortarg)))) - (list 'list - (or level transient--default-child-level) - (macroexp-quote (or class 'transient-suffix)) - (cons 'list args)))) - -(defun transient--derive-shortarg (arg) - (save-match-data - (and (string-match "\\`\\(-[a-zA-Z]\\)\\(\\'\\|=\\)" arg) - (match-string 1 arg)))) - -(defun transient-command-completion-not-suffix-only-p (symbol _buffer) - "Say whether SYMBOL should be offered as a completion. -If the value of SYMBOL's `completion-predicate' property is -`transient--suffix-only', then return nil, otherwise return t. -This is the case when a command should only ever be used as a -suffix of a transient prefix command (as opposed to bindings -in regular keymaps or by using `execute-extended-command')." - (not (eq (get symbol 'completion-predicate) 'transient--suffix-only))) - -(defalias 'transient--suffix-only #'ignore - "Ignore ARGUMENTS, do nothing, and return nil. -Also see `transient-command-completion-not-suffix-only-p'. -Only use this alias as the value of the `completion-predicate' -symbol property.") - -(when (and (boundp 'read-extended-command-predicate) ; since Emacs 28.1 - (not read-extended-command-predicate)) - (setq read-extended-command-predicate - #'transient-command-completion-not-suffix-only-p)) - -(defun transient-parse-suffix (prefix suffix) - "Parse SUFFIX, to be added to PREFIX. -PREFIX is a prefix command, a symbol. -SUFFIX is a suffix command or a group specification (of - the same forms as expected by `transient-define-prefix'). -Intended for use in a group's `:setup-children' function." - (cl-assert (and prefix (symbolp prefix))) - (eval (car (transient--parse-child prefix suffix)) t)) - -(defun transient-parse-suffixes (prefix suffixes) - "Parse SUFFIXES, to be added to PREFIX. -PREFIX is a prefix command, a symbol. -SUFFIXES is a list of suffix command or a group specification - (of the same forms as expected by `transient-define-prefix'). -Intended for use in a group's `:setup-children' function." - (cl-assert (and prefix (symbolp prefix))) - (mapcar (apply-partially #'transient-parse-suffix prefix) suffixes)) - -;;; Edit - -(defun transient--insert-suffix (prefix loc suffix action &optional keep-other) - (let* ((suf (cl-etypecase suffix - (vector (transient--parse-group prefix suffix)) - (list (transient--parse-suffix prefix suffix)) - (string suffix))) - (mem (transient--layout-member loc prefix)) - (elt (car mem))) - (setq suf (eval suf t)) - (cond - ((not mem) - (message "Cannot insert %S into %s; %s not found" - suffix prefix loc)) - ((or (and (vectorp suffix) (not (vectorp elt))) - (and (listp suffix) (vectorp elt)) - (and (stringp suffix) (vectorp elt))) - (message "Cannot place %S into %s at %s; %s" - suffix prefix loc - "suffixes and groups cannot be siblings")) - (t - (when-let* ((bindingp (listp suf)) - (key (transient--spec-key suf)) - (conflict (car (transient--layout-member key prefix))) - (conflictp - (and (not (and (eq action 'replace) - (eq conflict elt))) - (or (not keep-other) - (eq (plist-get (nth 2 suf) :command) - (plist-get (nth 2 conflict) :command))) - (equal (transient--suffix-predicate suf) - (transient--suffix-predicate conflict))))) - (transient-remove-suffix prefix key)) - (pcase-exhaustive action - ('insert (setcdr mem (cons elt (cdr mem))) - (setcar mem suf)) - ('append (setcdr mem (cons suf (cdr mem)))) - ('replace (setcar mem suf))))))) - -;;;###autoload -(defun transient-insert-suffix (prefix loc suffix &optional keep-other) - "Insert a SUFFIX into PREFIX before LOC. -PREFIX is a prefix command, a symbol. -SUFFIX is a suffix command or a group specification (of - the same forms as expected by `transient-define-prefix'). -LOC is a command, a key vector, a key description (a string - as returned by `key-description'), or a coordination list - (whose last element may also be a command or key). -Remove a conflicting binding unless optional KEEP-OTHER is - non-nil. -See info node `(transient)Modifying Existing Transients'." - (declare (indent defun)) - (transient--insert-suffix prefix loc suffix 'insert keep-other)) - -;;;###autoload -(defun transient-append-suffix (prefix loc suffix &optional keep-other) - "Insert a SUFFIX into PREFIX after LOC. -PREFIX is a prefix command, a symbol. -SUFFIX is a suffix command or a group specification (of - the same forms as expected by `transient-define-prefix'). -LOC is a command, a key vector, a key description (a string - as returned by `key-description'), or a coordination list - (whose last element may also be a command or key). -Remove a conflicting binding unless optional KEEP-OTHER is - non-nil. -See info node `(transient)Modifying Existing Transients'." - (declare (indent defun)) - (transient--insert-suffix prefix loc suffix 'append keep-other)) - -;;;###autoload -(defun transient-replace-suffix (prefix loc suffix) - "Replace the suffix at LOC in PREFIX with SUFFIX. -PREFIX is a prefix command, a symbol. -SUFFIX is a suffix command or a group specification (of - the same forms as expected by `transient-define-prefix'). -LOC is a command, a key vector, a key description (a string - as returned by `key-description'), or a coordination list - (whose last element may also be a command or key). -See info node `(transient)Modifying Existing Transients'." - (declare (indent defun)) - (transient--insert-suffix prefix loc suffix 'replace)) - -;;;###autoload -(defun transient-remove-suffix (prefix loc) - "Remove the suffix or group at LOC in PREFIX. -PREFIX is a prefix command, a symbol. -LOC is a command, a key vector, a key description (a string - as returned by `key-description'), or a coordination list - (whose last element may also be a command or key). -See info node `(transient)Modifying Existing Transients'." - (declare (indent defun)) - (transient--layout-member loc prefix 'remove)) - -(defun transient-get-suffix (prefix loc) - "Return the suffix or group at LOC in PREFIX. -PREFIX is a prefix command, a symbol. -LOC is a command, a key vector, a key description (a string - as returned by `key-description'), or a coordination list - (whose last element may also be a command or key). -See info node `(transient)Modifying Existing Transients'." - (if-let ((mem (transient--layout-member loc prefix))) - (car mem) - (error "%s not found in %s" loc prefix))) - -(defun transient-suffix-put (prefix loc prop value) - "Edit the suffix at LOC in PREFIX, setting PROP to VALUE. -PREFIX is a prefix command, a symbol. -SUFFIX is a suffix command or a group specification (of - the same forms as expected by `transient-define-prefix'). -LOC is a command, a key vector, a key description (a string - as returned by `key-description'), or a coordination list - (whose last element may also be a command or key). -See info node `(transient)Modifying Existing Transients'." - (let ((suf (transient-get-suffix prefix loc))) - (setf (elt suf 2) - (plist-put (elt suf 2) prop value)))) - -(defun transient--layout-member (loc prefix &optional remove) - (let ((val (or (get prefix 'transient--layout) - (error "%s is not a transient command" prefix)))) - (when (listp loc) - (while (integerp (car loc)) - (let* ((children (if (vectorp val) (aref val 3) val)) - (mem (transient--nthcdr (pop loc) children))) - (if (and remove (not loc)) - (let ((rest (delq (car mem) children))) - (if (vectorp val) - (aset val 3 rest) - (put prefix 'transient--layout rest)) - (setq val nil)) - (setq val (if loc (car mem) mem))))) - (setq loc (car loc))) - (if loc - (transient--layout-member-1 (transient--kbd loc) val remove) - val))) - -(defun transient--layout-member-1 (loc layout remove) - (cond ((listp layout) - (seq-some (lambda (elt) (transient--layout-member-1 loc elt remove)) - layout)) - ((vectorp (car (aref layout 3))) - (seq-some (lambda (elt) (transient--layout-member-1 loc elt remove)) - (aref layout 3))) - (remove - (aset layout 3 - (delq (car (transient--group-member loc layout)) - (aref layout 3))) - nil) - ((transient--group-member loc layout)))) - -(defun transient--group-member (loc group) - (cl-member-if (lambda (suffix) - (and (listp suffix) - (let* ((def (nth 2 suffix)) - (cmd (plist-get def :command))) - (if (symbolp loc) - (eq cmd loc) - (equal (transient--kbd - (or (plist-get def :key) - (transient--command-key cmd))) - loc))))) - (aref group 3))) - -(defun transient--kbd (keys) - (when (vectorp keys) - (setq keys (key-description keys))) - (when (stringp keys) - (setq keys (kbd keys))) - keys) - -(defun transient--spec-key (spec) - (let ((plist (nth 2 spec))) - (or (plist-get plist :key) - (transient--command-key - (plist-get plist :command))))) - -(defun transient--command-key (cmd) - (and-let* ((obj (transient--suffix-prototype cmd))) - (cond ((slot-boundp obj 'key) - (oref obj key)) - ((slot-exists-p obj 'shortarg) - (if (slot-boundp obj 'shortarg) - (oref obj shortarg) - (transient--derive-shortarg (oref obj argument))))))) - -(defun transient--nthcdr (n list) - (nthcdr (if (< n 0) (- (length list) (abs n)) n) list)) - -;;; Variables - -(defvar transient-current-prefix nil - "The transient from which this suffix command was invoked. -This is an object representing that transient, use -`transient-current-command' to get the respective command.") - -(defvar transient-current-command nil - "The transient from which this suffix command was invoked. -This is a symbol representing that transient, use -`transient-current-prefix' to get the respective object.") - -(defvar transient-current-suffixes nil - "The suffixes of the transient from which this suffix command was invoked. -This is a list of objects. Usually it is sufficient to instead -use the function `transient-args', which returns a list of -values. In complex cases it might be necessary to use this -variable instead.") - -(defvar transient-exit-hook nil - "Hook run after exiting a transient.") - -(defvar transient-setup-buffer-hook nil - "Hook run when setting up the transient buffer. -That buffer is current and empty when this hook runs.") - -(defvar transient--prefix nil) -(defvar transient--layout nil) -(defvar transient--suffixes nil) - -(defconst transient--stay t "Do not exit the transient.") -(defconst transient--exit nil "Do exit the transient.") - -(defvar transient--exitp nil "Whether to exit the transient.") -(defvar transient--showp nil "Whether to show the transient popup buffer.") -(defvar transient--helpp nil "Whether help-mode is active.") -(defvar transient--editp nil "Whether edit-mode is active.") - -(defvar transient--refreshp nil - "Whether to refresh the transient completely.") - -(defvar transient--all-levels-p nil - "Whether temporary display of suffixes on all levels is active.") - -(defvar transient--timer nil) - -(defvar transient--stack nil) - -(defvar transient--minibuffer-depth 0) - -(defvar transient--buffer-name " *transient*" - "Name of the transient buffer.") - -(defvar transient--buffer nil - "The transient menu buffer.") - -(defvar transient--window nil - "The window used to display the transient popup buffer.") - -(defvar transient--original-window nil - "The window that was selected before the transient was invoked. -Usually it remains selected while the transient is active.") - -(defvar transient--original-buffer nil - "The buffer that was current before the transient was invoked. -Usually it remains current while the transient is active.") - -(defvar transient--restore-winconf nil - "Window configuration to restore after exiting help.") - -(defvar transient--shadowed-buffer nil - "The buffer that is temporarily shadowed by the transient buffer. -This is bound while the suffix predicate is being evaluated and while -drawing in the transient buffer.") - -(defvar transient--pending-suffix nil - "The suffix that is currently being processed. -This is bound while the suffix predicate is being evaluated, -and while functions that return faces are being evaluated.") - -(defvar transient--pending-group nil - "The group that is currently being processed. -This is bound while the suffixes are drawn in the transient buffer.") - -(defvar transient--debug nil - "Whether to put debug information into *Messages*.") - -(defvar transient--history nil) - -(defvar transient--scroll-commands - '(transient-scroll-up - transient-scroll-down - mwheel-scroll - scroll-bar-toolkit-scroll)) - -;;; Identities - -(defun transient-prefix-object () - "Return the current prefix as an object. - -While a transient is being setup or refreshed (which involves -preparing its suffixes) the variable `transient--prefix' can be -used to access the prefix object. Thus this is what has to be -used in suffix methods such as `transient-format-description', -and in object-specific functions that are stored in suffix slots -such as `description'. - -When a suffix command is invoked (i.e., in its `interactive' form -and function body) then the variable `transient-current-prefix' -has to be used instead. - -Two distinct variables are needed, because any prefix may itself -be used as a suffix of another prefix, and such sub-prefixes have -to be able to tell themselves apart from the prefix they were -invoked from. - -Regular suffix commands, which are not prefixes, do not have to -concern themselves with this distinction, so they can use this -function instead. In the context of a plain suffix, it always -returns the value of the appropriate variable." - (or transient--prefix transient-current-prefix)) - -(defun transient-suffix-object (&optional command) - "Return the object associated with the current suffix command. - -Each suffix commands is associated with an object, which holds -additional information about the suffix, such as its value (in -the case of an infix command, which is a kind of suffix command). - -This function is intended to be called by infix commands, which -are usually aliases of `transient--default-infix-command', which -is defined like this: - - (defun transient--default-infix-command () - (interactive) - (let ((obj (transient-suffix-object))) - (transient-infix-set obj (transient-infix-read obj))) - (transient--show)) - -\(User input is read outside of `interactive' to prevent the -command from being added to `command-history'. See #23.) - -Such commands need to be able to access their associated object -to guide how `transient-infix-read' reads the new value and to -store the read value. Other suffix commands (including non-infix -commands) may also need the object to guide their behavior. - -This function attempts to return the object associated with the -current suffix command even if the suffix command was not invoked -from a transient. (For some suffix command that is a valid thing -to do, for others it is not.) In that case nil may be returned, -if the command was not defined using one of the macros intended -to define such commands. - -The optional argument COMMAND is intended for internal use. If -you are contemplating using it in your own code, then you should -probably use this instead: - - (get COMMAND \\='transient--suffix)" - (when command - (cl-check-type command command)) - (cond - (transient--pending-suffix) - ((or transient--prefix - transient-current-prefix) - (let ((suffixes - (cl-remove-if-not - (lambda (obj) - (eq (oref obj command) - (or command - (if (eq this-command 'transient-set-level) - ;; This is how it can look up for which - ;; command it is setting the level. - this-original-command - this-command)))) - (or transient--suffixes - transient-current-suffixes)))) - (or (and (cdr suffixes) - (cl-find-if - (lambda (obj) - (equal (listify-key-sequence (transient--kbd (oref obj key))) - (listify-key-sequence (this-command-keys)))) - suffixes)) - (car suffixes)))) - ((and-let* ((obj (transient--suffix-prototype (or command this-command))) - (obj (clone obj))) - (progn ; work around debbugs#31840 - (transient-init-scope obj) - (transient-init-value obj) - obj))))) - -(defun transient--suffix-prototype (command) - (or (get command 'transient--suffix) - (seq-some (lambda (cmd) (get cmd 'transient--suffix)) - (function-alias-p command)))) - -;;; Keymaps - -(defvar-keymap transient-base-map - :doc "Parent of other keymaps used by Transient. - -This is the parent keymap of all the keymaps that are used in -all transients: `transient-map' (which in turn is the parent -of the transient-specific keymaps), `transient-edit-map' and -`transient-sticky-map'. - -If you change a binding here, then you might also have to edit -`transient-sticky-map' and `transient-common-commands'. While -the latter isn't a proper transient prefix command, it can be -edited using the same functions as used for transients. - -If you add a new command here, then you must also add a binding -to `transient-predicate-map'." - "ESC ESC ESC" #'transient-quit-all - "C-g" #'transient-quit-one - "C-q" #'transient-quit-all - "C-z" #'transient-suspend - "C-v" #'transient-scroll-up - "C-M-v" #'transient-scroll-down - "<next>" #'transient-scroll-up - "<prior>" #'transient-scroll-down) - -(defvar-keymap transient-map - :doc "Top-level keymap used by all transients. - -If you add a new command here, then you must also add a binding -to `transient-predicate-map'. Also see `transient-base-map'." - :parent transient-base-map - "C-u" #'universal-argument - "C--" #'negative-argument - "C-t" #'transient-show - "?" #'transient-help - "C-h" #'transient-help - ;; Also bound to "C-x p" and "C-x n" in transient-common-commands. - "C-M-p" #'transient-history-prev - "C-M-n" #'transient-history-next) - -(defvar-keymap transient-edit-map - :doc "Keymap that is active while a transient in is in \"edit mode\"." - :parent transient-base-map - "?" #'transient-help - "C-h" #'transient-help - "C-x l" #'transient-set-level) - -(defvar-keymap transient-sticky-map - :doc "Keymap that is active while an incomplete key sequence is active." - :parent transient-base-map - "C-g" #'transient-quit-seq) - -(defvar transient--common-command-prefixes '(?\C-x)) - -(put 'transient-common-commands - 'transient--layout - (list - (eval - (car (transient--parse-child - 'transient-common-commands - (vector - :hide - (lambda () - (and (not (memq - (car (bound-and-true-p transient--redisplay-key)) - transient--common-command-prefixes)) - (not transient-show-common-commands))) - (vector - "Value commands" - (list "C-x s " "Set" #'transient-set) - (list "C-x C-s" "Save" #'transient-save) - (list "C-x C-k" "Reset" #'transient-reset) - (list "C-x p " "Previous value" #'transient-history-prev) - (list "C-x n " "Next value" #'transient-history-next)) - (vector - "Sticky commands" - ;; Like `transient-sticky-map' except that - ;; "C-g" has to be bound to a different command. - (list "C-g" "Quit prefix or transient" #'transient-quit-one) - (list "C-q" "Quit transient stack" #'transient-quit-all) - (list "C-z" "Suspend transient stack" #'transient-suspend)) - (vector - "Customize" - (list "C-x t" 'transient-toggle-common :description - (lambda () - (if transient-show-common-commands - "Hide common commands" - "Show common permanently"))) - (list "C-x l" "Show/hide suffixes" #'transient-set-level) - (list "C-x a" #'transient-toggle-level-limit))))) - t))) - -(defvar-keymap transient-popup-navigation-map - :doc "One of the keymaps used when popup navigation is enabled. -See `transient-enable-popup-navigation'." - "<down-mouse-1>" #'transient-noop - "<up>" #'transient-backward-button - "<down>" #'transient-forward-button - "C-r" #'transient-isearch-backward - "C-s" #'transient-isearch-forward - "M-RET" #'transient-push-button) - -(defvar-keymap transient-button-map - :doc "One of the keymaps used when popup navigation is enabled. -See `transient-enable-popup-navigation'." - "<mouse-1>" #'transient-push-button - "<mouse-2>" #'transient-push-button) - -(defvar-keymap transient-resume-mode-map - :doc "Keymap for `transient-resume-mode'. - -This keymap remaps every command that would usually just quit the -documentation buffer to `transient-resume', which additionally -resumes the suspended transient." - "<remap> <Man-quit>" #'transient-resume - "<remap> <Info-exit>" #'transient-resume - "<remap> <quit-window>" #'transient-resume) - -(defvar-keymap transient-predicate-map - :doc "Base keymap used to map common commands to their transient behavior. - -The \"transient behavior\" of a command controls, among other -things, whether invoking the command causes the transient to be -exited or not, and whether infix arguments are exported before -doing so. - -Each \"key\" is a command that is common to all transients and -that is bound in `transient-map', `transient-edit-map', -`transient-sticky-map' and/or `transient-common-command'. - -Each binding is a \"pre-command\", a function that controls the -transient behavior of the respective command. - -For transient commands that are bound in individual transients, -the transient behavior is specified using the `:transient' slot -of the corresponding object." - "<transient-suspend>" #'transient--do-suspend - "<transient-help>" #'transient--do-stay - "<transient-set-level>" #'transient--do-stay - "<transient-history-prev>" #'transient--do-stay - "<transient-history-next>" #'transient--do-stay - "<universal-argument>" #'transient--do-stay - "<universal-argument-more>" #'transient--do-stay - "<negative-argument>" #'transient--do-minus - "<digit-argument>" #'transient--do-stay - "<top-level>" #'transient--do-quit-all - "<transient-quit-all>" #'transient--do-quit-all - "<transient-quit-one>" #'transient--do-quit-one - "<transient-quit-seq>" #'transient--do-stay - "<transient-show>" #'transient--do-stay - "<transient-update>" #'transient--do-stay - "<transient-toggle-common>" #'transient--do-stay - "<transient-set>" #'transient--do-call - "<transient-set-and-exit>" #'transient--do-exit - "<transient-save>" #'transient--do-call - "<transient-save-and-exit>" #'transient--do-exit - "<transient-reset>" #'transient--do-call - "<describe-key-briefly>" #'transient--do-stay - "<describe-key>" #'transient--do-stay - "<transient-scroll-up>" #'transient--do-stay - "<transient-scroll-down>" #'transient--do-stay - "<mwheel-scroll>" #'transient--do-stay - "<scroll-bar-toolkit-scroll>" #'transient--do-stay - "<transient-noop>" #'transient--do-noop - "<transient-mouse-push-button>" #'transient--do-move - "<transient-push-button>" #'transient--do-push-button - "<transient-backward-button>" #'transient--do-move - "<transient-forward-button>" #'transient--do-move - "<transient-isearch-backward>" #'transient--do-move - "<transient-isearch-forward>" #'transient--do-move - ;; If a valid but incomplete prefix sequence is followed by - ;; an unbound key, then Emacs calls the `undefined' command - ;; but does not set `this-command', `this-original-command' - ;; or `real-this-command' accordingly. Instead they are nil. - "<nil>" #'transient--do-warn - ;; Bound to the `mouse-movement' event, this command is similar - ;; to `ignore'. - "<ignore-preserving-kill-region>" #'transient--do-noop) - -(defvar transient--transient-map nil) -(defvar transient--predicate-map nil) -(defvar transient--redisplay-map nil) -(defvar transient--redisplay-key nil) - -(defun transient--push-keymap (var) - (let ((map (symbol-value var))) - (transient--debug " push %s%s" var (if map "" " VOID")) - (when map - (with-demoted-errors "transient--push-keymap: %S" - (internal-push-keymap map 'overriding-terminal-local-map))))) - -(defun transient--pop-keymap (var) - (let ((map (symbol-value var))) - (when map - (transient--debug " pop %s" var) - (with-demoted-errors "transient--pop-keymap: %S" - (internal-pop-keymap map 'overriding-terminal-local-map))))) - -(defun transient--make-transient-map () - (let ((map (make-sparse-keymap))) - (set-keymap-parent map (if transient--editp - transient-edit-map - transient-map)) - (dolist (obj transient--suffixes) - (let ((key (oref obj key))) - (when (vectorp key) - (setq key (key-description key)) - (oset obj key key)) - (when transient-substitute-key-function - (setq key (save-match-data - (funcall transient-substitute-key-function obj))) - (oset obj key key)) - (let* ((kbd (kbd key)) - (cmd (oref obj command)) - (alt (transient--lookup-key map kbd))) - (cond ((not alt) - (define-key map kbd cmd)) - ((eq alt cmd)) - ((transient--inapt-suffix-p obj)) - ((and-let* ((obj (transient-suffix-object alt))) - (transient--inapt-suffix-p obj)) - (define-key map kbd cmd)) - (transient-detect-key-conflicts - (error "Cannot bind %S to %s and also %s" - (string-trim key) cmd alt)) - ((define-key map kbd cmd)))))) - (when-let ((b (keymap-lookup map "-"))) (keymap-set map "<kp-subtract>" b)) - (when-let ((b (keymap-lookup map "="))) (keymap-set map "<kp-equal>" b)) - (when-let ((b (keymap-lookup map "+"))) (keymap-set map "<kp-add>" b)) - (when transient-enable-popup-navigation - ;; `transient--make-redisplay-map' maps only over bindings that are - ;; directly in the base keymap, so that cannot be a composed keymap. - (set-keymap-parent - map (make-composed-keymap - (keymap-parent map) - transient-popup-navigation-map))) - map)) - -(defun transient--make-predicate-map () - (let* ((default (transient--resolve-pre-command - (oref transient--prefix transient-suffix))) - (return (and transient--stack (eq default t))) - (map (make-sparse-keymap))) - (set-keymap-parent map transient-predicate-map) - (when (or (and (slot-boundp transient--prefix 'transient-switch-frame) - (transient--resolve-pre-command - (not (oref transient--prefix transient-switch-frame)))) - (memq (transient--resolve-pre-command - (oref transient--prefix transient-non-suffix)) - '(nil transient--do-warn transient--do-noop))) - (define-key map [handle-switch-frame] #'transient--do-suspend)) - (dolist (obj transient--suffixes) - (let* ((cmd (oref obj command)) - (kind (cond ((get cmd 'transient--prefix) 'prefix) - ((cl-typep obj 'transient-infix) 'infix) - (t 'suffix)))) - (cond - ((oref obj inapt) - (define-key map (vector cmd) #'transient--do-warn-inapt)) - ((slot-boundp obj 'transient) - (define-key map (vector cmd) - (pcase (list kind - (transient--resolve-pre-command (oref obj transient)) - return) - (`(prefix t ,_) #'transient--do-recurse) - (`(prefix nil ,_) #'transient--do-stack) - (`(infix t ,_) #'transient--do-stay) - (`(suffix t ,_) #'transient--do-call) - ('(suffix nil t) #'transient--do-return) - (`(,_ nil ,_) #'transient--do-exit) - (`(,_ ,do ,_) do)))) - ((not (lookup-key transient-predicate-map (vector cmd))) - (define-key map (vector cmd) - (pcase (list kind default return) - (`(prefix ,(or 'transient--do-stay 'transient--do-call) ,_) - #'transient--do-recurse) - (`(prefix t ,_) #'transient--do-recurse) - (`(prefix ,_ ,_) #'transient--do-stack) - (`(infix ,_ ,_) #'transient--do-stay) - (`(suffix t ,_) #'transient--do-call) - ('(suffix nil t) #'transient--do-return) - (`(suffix nil ,_) #'transient--do-exit) - (`(suffix ,do ,_) do))))))) - map)) - -(defun transient--make-redisplay-map () - (setq transient--redisplay-key - (pcase this-command - ('transient-update - (setq transient--showp t) - (setq unread-command-events - (listify-key-sequence (this-single-command-raw-keys)))) - ('transient-quit-seq - (setq unread-command-events - (butlast (listify-key-sequence - (this-single-command-raw-keys)) - 2)) - (butlast transient--redisplay-key)) - (_ nil))) - (let ((topmap (make-sparse-keymap)) - (submap (make-sparse-keymap))) - (when transient--redisplay-key - (define-key topmap (vconcat transient--redisplay-key) submap) - (set-keymap-parent submap transient-sticky-map)) - (map-keymap-internal - (lambda (key def) - (when (and (not (eq key ?\e)) - (listp def) - (keymapp def)) - (define-key topmap (vconcat transient--redisplay-key (list key)) - #'transient-update))) - (if transient--redisplay-key - (let ((key (vconcat transient--redisplay-key))) - (or (lookup-key transient--transient-map key) - (and-let* ((regular (lookup-key local-function-key-map key))) - (lookup-key transient--transient-map (vconcat regular))))) - transient--transient-map)) - topmap)) - -;;; Setup - -(defun transient-setup (&optional name layout edit &rest params) - "Setup the transient specified by NAME. - -This function is called by transient prefix commands to setup the -transient. In that case NAME is mandatory, LAYOUT and EDIT must -be nil and PARAMS may be (but usually is not) used to set, e.g., -the \"scope\" of the transient (see `transient-define-prefix'). - -This function is also called internally in which case LAYOUT and -EDIT may be non-nil." - (transient--debug 'setup) - (transient--with-emergency-exit :setup - (cond - ((not name) - ;; Switching between regular and edit mode. - (transient--pop-keymap 'transient--transient-map) - (transient--pop-keymap 'transient--redisplay-map) - (setq name (oref transient--prefix command)) - (setq params (list :scope (oref transient--prefix scope)))) - (transient--prefix - ;; Invoked as a ":transient-non-suffix 'transient--do-{stay,call}" - ;; of an outer prefix. Unlike the usual `transient--do-stack', - ;; these predicates fail to clean up after the outer prefix. - (transient--pop-keymap 'transient--transient-map) - (transient--pop-keymap 'transient--redisplay-map)) - ((not (or layout ; resuming parent/suspended prefix - transient-current-command)) ; entering child prefix - (transient--stack-zap)) ; replace suspended prefix, if any - (edit - ;; Returning from help to edit. - (setq transient--editp t))) - (transient--init-objects name layout params) - (transient--init-keymaps) - (transient--history-init transient--prefix) - (setq transient--original-window (selected-window)) - (setq transient--original-buffer (current-buffer)) - (setq transient--minibuffer-depth (minibuffer-depth)) - (transient--redisplay) - (transient--init-transient) - (transient--suspend-which-key-mode))) - -(cl-defgeneric transient-setup-children (group children) - "Setup the CHILDREN of GROUP. -If the value of the `setup-children' slot is non-nil, then call -that function with CHILDREN as the only argument and return the -value. Otherwise return CHILDREN as is." - (if (slot-boundp group 'setup-children) - (funcall (oref group setup-children) children) - children)) - -(defun transient--init-keymaps () - (setq transient--predicate-map (transient--make-predicate-map)) - (setq transient--transient-map (transient--make-transient-map)) - (setq transient--redisplay-map (transient--make-redisplay-map))) - -(defun transient--init-objects (&optional name layout params) - (if name - (setq transient--prefix (transient--init-prefix name params)) - (setq name (oref transient--prefix command))) - (setq transient--refreshp (oref transient--prefix refresh-suffixes)) - (setq transient--layout (or layout (transient--init-suffixes name))) - (setq transient--suffixes (transient--flatten-suffixes transient--layout))) - -(defun transient--init-prefix (name &optional params) - (let ((obj (let ((proto (get name 'transient--prefix))) - (apply #'clone proto - :prototype proto - :level (or (alist-get t (alist-get name transient-levels)) - transient-default-level) - params)))) - (transient--setup-recursion obj) - (transient-init-value obj) - obj)) - -(defun transient--init-suffixes (name) - (let ((levels (alist-get name transient-levels))) - (cl-mapcan (lambda (c) (transient--init-child levels c nil)) - (append (get name 'transient--layout) - (and (not transient--editp) - (get 'transient-common-commands - 'transient--layout)))))) - -(defun transient--flatten-suffixes (layout) - (cl-labels ((s (def) - (cond - ((stringp def) nil) - ((cl-typep def 'transient-information) nil) - ((listp def) (cl-mapcan #'s def)) - ((cl-typep def 'transient-group) - (cl-mapcan #'s (oref def suffixes))) - ((cl-typep def 'transient-suffix) - (list def))))) - (cl-mapcan #'s layout))) - -(defun transient--init-child (levels spec parent) - (cl-etypecase spec - (vector (transient--init-group levels spec parent)) - (list (transient--init-suffix levels spec parent)) - (string (list spec)))) - -(defun transient--init-group (levels spec parent) - (pcase-let ((`(,level ,class ,args ,children) (append spec nil))) - (and-let* (((transient--use-level-p level)) - (obj (apply class :level level args)) - ((transient--use-suffix-p obj)) - ((prog1 t - (when (or (and parent (oref parent inapt)) - (transient--inapt-suffix-p obj)) - (oset obj inapt t)))) - (suffixes (cl-mapcan - (lambda (c) (transient--init-child levels c obj)) - (transient-setup-children obj children)))) - (progn ; work around debbugs#31840 - (oset obj suffixes suffixes) - (list obj))))) - -(defun transient--init-suffix (levels spec parent) - (pcase-let* ((`(,level ,class ,args) spec) - (cmd (plist-get args :command)) - (key (transient--kbd (plist-get args :key))) - (level (or (alist-get (cons cmd key) levels nil nil #'equal) - (alist-get cmd levels) - level))) - (let ((fn (and (symbolp cmd) - (symbol-function cmd)))) - (when (autoloadp fn) - (transient--debug " autoload %s" cmd) - (autoload-do-load fn))) - (when (transient--use-level-p level) - (let ((obj (if (child-of-class-p class 'transient-information) - (apply class :level level args) - (unless (and cmd (symbolp cmd)) - (error "BUG: Non-symbolic suffix command: %s" cmd)) - (if-let ((proto (and cmd (transient--suffix-prototype cmd)))) - (apply #'clone proto :level level args) - (apply class :command cmd :level level args))))) - (cond ((not cmd)) - ((commandp cmd)) - ((or (cl-typep obj 'transient-switch) - (cl-typep obj 'transient-option)) - ;; As a temporary special case, if the package was compiled - ;; with an older version of Transient, then we must define - ;; "anonymous" switch and option commands here. - (defalias cmd #'transient--default-infix-command)) - ((transient--use-suffix-p obj) - (error "Suffix command %s is not defined or autoloaded" cmd))) - (unless (cl-typep obj 'transient-information) - (transient--init-suffix-key obj)) - (when (transient--use-suffix-p obj) - (if (or (and parent (oref parent inapt)) - (transient--inapt-suffix-p obj)) - (oset obj inapt t) - (transient-init-scope obj) - (transient-init-value obj)) - (list obj)))))) - -(cl-defmethod transient--init-suffix-key ((obj transient-suffix)) - (unless (slot-boundp obj 'key) - (error "No key for %s" (oref obj command)))) - -(cl-defmethod transient--init-suffix-key ((obj transient-argument)) - (if (transient-switches--eieio-childp obj) - (cl-call-next-method obj) - (unless (slot-boundp obj 'shortarg) - (when-let ((shortarg (transient--derive-shortarg (oref obj argument)))) - (oset obj shortarg shortarg))) - (unless (slot-boundp obj 'key) - (if (slot-boundp obj 'shortarg) - (oset obj key (oref obj shortarg)) - (error "No key for %s" (oref obj command)))))) - -(defun transient--use-level-p (level &optional edit) - (or transient--all-levels-p - (and transient--editp (not edit)) - (and (>= level 1) - (<= level (oref transient--prefix level))))) - -(defun transient--use-suffix-p (obj) - (let ((transient--shadowed-buffer (current-buffer)) - (transient--pending-suffix obj)) - (transient--do-suffix-p - (oref obj if) - (oref obj if-not) - (oref obj if-nil) - (oref obj if-non-nil) - (oref obj if-mode) - (oref obj if-not-mode) - (oref obj if-derived) - (oref obj if-not-derived) - t))) - -(defun transient--inapt-suffix-p (obj) - (let ((transient--shadowed-buffer (current-buffer)) - (transient--pending-suffix obj)) - (transient--do-suffix-p - (oref obj inapt-if) - (oref obj inapt-if-not) - (oref obj inapt-if-nil) - (oref obj inapt-if-non-nil) - (oref obj inapt-if-mode) - (oref obj inapt-if-not-mode) - (oref obj inapt-if-derived) - (oref obj inapt-if-not-derived) - nil))) - -(defun transient--do-suffix-p - (if if-not if-nil if-non-nil if-mode if-not-mode if-derived if-not-derived - default) - (cond - (if (funcall if)) - (if-not (not (funcall if-not))) - (if-non-nil (symbol-value if-non-nil)) - (if-nil (not (symbol-value if-nil))) - (if-mode (if (atom if-mode) - (eq major-mode if-mode) - (memq major-mode if-mode))) - (if-not-mode (not (if (atom if-not-mode) - (eq major-mode if-not-mode) - (memq major-mode if-not-mode)))) - (if-derived (if (or (atom if-derived) - (>= emacs-major-version 30)) - (derived-mode-p if-derived) - (apply #'derived-mode-p if-derived))) - (if-not-derived (not (if (or (atom if-not-derived) - (>= emacs-major-version 30)) - (derived-mode-p if-not-derived) - (apply #'derived-mode-p if-not-derived)))) - (default))) - -(defun transient--suffix-predicate (spec) - (let ((plist (nth 2 spec))) - (seq-some (lambda (prop) - (and-let* ((pred (plist-get plist prop))) - (list prop pred))) - '( :if :if-not - :if-nil :if-non-nil - :if-mode :if-not-mode - :if-derived :if-not-derived - :inapt-if :inapt-if-not - :inapt-if-nil :inapt-if-non-nil - :inapt-if-mode :inapt-if-not-mode - :inapt-if-derived :inapt-if-not-derived)))) - -;;; Flow-Control - -(defun transient--init-transient () - (transient--debug 'init-transient) - (transient--push-keymap 'transient--transient-map) - (transient--push-keymap 'transient--redisplay-map) - (add-hook 'pre-command-hook #'transient--pre-command) - (add-hook 'post-command-hook #'transient--post-command) - (advice-add 'recursive-edit :around #'transient--recursive-edit) - (when transient--exitp - ;; This prefix command was invoked as the suffix of another. - ;; Prevent `transient--post-command' from removing the hooks - ;; that we just added. - (setq transient--exitp 'replace))) - -(defun transient--refresh-transient () - (transient--debug 'refresh-transient) - (transient--pop-keymap 'transient--predicate-map) - (transient--pop-keymap 'transient--transient-map) - (transient--pop-keymap 'transient--redisplay-map) - (transient--init-objects) - (transient--init-keymaps) - (transient--push-keymap 'transient--transient-map) - (transient--push-keymap 'transient--redisplay-map) - (transient--redisplay)) - -(defun transient--pre-command () - (transient--debug 'pre-command) - (transient--with-emergency-exit :pre-command - ;; The use of `overriding-terminal-local-map' does not prevent the - ;; lookup of command remappings in the overridden maps, which can - ;; lead to a suffix being remapped to a non-suffix. We have to undo - ;; the remapping in that case. However, remapping a non-suffix to - ;; another should remain possible. - (when (and (transient--get-pre-command this-original-command 'suffix) - (not (transient--get-pre-command this-command 'suffix))) - (setq this-command this-original-command)) - (cond - ((memq this-command '(transient-update transient-quit-seq)) - (transient--pop-keymap 'transient--redisplay-map)) - ((and transient--helpp - (not (memq this-command '(transient-quit-one - transient-quit-all)))) - (cond - ((transient-help) - (transient--do-suspend) - (setq this-command 'transient-suspend) - (transient--pre-exit)) - ((not (transient--edebug-command-p)) - (setq this-command 'transient-undefined)))) - ((and transient--editp - (transient-suffix-object) - (not (memq this-command '(transient-quit-one - transient-quit-all - transient-help)))) - (setq this-command 'transient-set-level) - (transient--wrap-command)) - (t - (setq transient--exitp nil) - (let ((exitp (eq (transient--call-pre-command) transient--exit))) - (transient--wrap-command) - (when exitp - (transient--pre-exit))))))) - -(defun transient--pre-exit () - (transient--debug 'pre-exit) - (transient--delete-window) - (transient--timer-cancel) - (transient--pop-keymap 'transient--transient-map) - (transient--pop-keymap 'transient--redisplay-map) - (unless transient--showp - (let ((message-log-max nil)) - (message ""))) - (setq transient--transient-map nil) - (setq transient--predicate-map nil) - (setq transient--redisplay-map nil) - (setq transient--redisplay-key nil) - (setq transient--helpp nil) - (setq transient--editp nil) - (setq transient--prefix nil) - (setq transient--layout nil) - (setq transient--suffixes nil) - (setq transient--original-window nil) - (setq transient--original-buffer nil) - (setq transient--window nil)) - -(defun transient--delete-window () - (when (window-live-p transient--window) - (let ((remain-in-minibuffer-window - (and (minibuffer-selected-window) - (selected-window)))) - ;; Only delete the window if it has never shown another buffer. - (unless (eq (car (window-parameter transient--window 'quit-restore)) - 'other) - (with-demoted-errors "Error while exiting transient: %S" - (delete-window transient--window))) - (when (buffer-live-p transient--buffer) - (kill-buffer transient--buffer)) - (setq transient--buffer nil) - (when remain-in-minibuffer-window - (select-window remain-in-minibuffer-window))))) - -(defun transient--export () - (setq transient-current-prefix transient--prefix) - (setq transient-current-command (oref transient--prefix command)) - (setq transient-current-suffixes transient--suffixes) - (transient--history-push transient--prefix)) - -(defun transient--suspend-override (&optional nohide) - (transient--debug 'suspend-override) - (transient--timer-cancel) - (cond ((and (not nohide) transient-hide-during-minibuffer-read) - (transient--delete-window)) - ((and transient--prefix transient--redisplay-key) - (setq transient--redisplay-key nil) - (when transient--showp - (if-let ((win (minibuffer-selected-window))) - (with-selected-window win - (transient--show)) - (transient--show))))) - (transient--pop-keymap 'transient--transient-map) - (transient--pop-keymap 'transient--redisplay-map) - (remove-hook 'pre-command-hook #'transient--pre-command) - (remove-hook 'post-command-hook #'transient--post-command)) - -(defun transient--resume-override (&optional _ignore) - (transient--debug 'resume-override) - (when (and transient--showp transient-hide-during-minibuffer-read) - (transient--show)) - (transient--push-keymap 'transient--transient-map) - (transient--push-keymap 'transient--redisplay-map) - (add-hook 'pre-command-hook #'transient--pre-command) - (add-hook 'post-command-hook #'transient--post-command)) - -(defun transient--recursive-edit (fn) - (transient--debug 'recursive-edit) - (if (not transient--prefix) - (funcall fn) - (transient--suspend-override (bound-and-true-p edebug-active)) - (funcall fn) ; Already unwind protected. - (cond ((memq this-command '(top-level abort-recursive-edit)) - (setq transient--exitp t) - (transient--post-exit) - (transient--delete-window)) - (transient--prefix - (transient--resume-override))))) - -(defmacro transient--with-suspended-override (&rest body) - (let ((depth (make-symbol "depth")) - (setup (make-symbol "setup")) - (exit (make-symbol "exit"))) - `(if (and transient--transient-map - (memq transient--transient-map - overriding-terminal-local-map)) - (let ((,depth (1+ (minibuffer-depth))) ,setup ,exit) - (setq ,setup - (lambda () "@transient--with-suspended-override" - (transient--debug 'minibuffer-setup) - (remove-hook 'minibuffer-setup-hook ,setup) - (transient--suspend-override))) - (setq ,exit - (lambda () "@transient--with-suspended-override" - (transient--debug 'minibuffer-exit) - (when (= (minibuffer-depth) ,depth) - (transient--resume-override)))) - (unwind-protect - (progn - (add-hook 'minibuffer-setup-hook ,setup) - (add-hook 'minibuffer-exit-hook ,exit) - ,@body) - (remove-hook 'minibuffer-setup-hook ,setup) - (remove-hook 'minibuffer-exit-hook ,exit))) - ,@body))) - -(static-if (>= emacs-major-version 30) ;transient--wrap-command - (defun transient--wrap-command () - (cl-assert - (>= emacs-major-version 30) nil - "Emacs was downgraded, making it necessary to recompile Transient") - (letrec - ((prefix transient--prefix) - (suffix this-command) - (advice - (lambda (fn &rest args) - (interactive - (lambda (spec) - (let ((abort t)) - (unwind-protect - (prog1 (let ((debugger #'transient--exit-and-debug)) - (advice-eval-interactive-spec spec)) - (setq abort nil)) - (when abort - (when-let ((unwind (oref prefix unwind-suffix))) - (transient--debug 'unwind-interactive) - (funcall unwind suffix)) - (advice-remove suffix advice) - (oset prefix unwind-suffix nil)))))) - (unwind-protect - (let ((debugger #'transient--exit-and-debug)) - (apply fn args)) - (when-let ((unwind (oref prefix unwind-suffix))) - (transient--debug 'unwind-command) - (funcall unwind suffix)) - (advice-remove suffix advice) - (oset prefix unwind-suffix nil))))) - (when (symbolp this-command) - (advice-add suffix :around advice '((depth . -99)))))) - - (defun transient--wrap-command () - (let* ((prefix transient--prefix) - (suffix this-command) - (advice nil) - (advice-interactive - (lambda (spec) - (let ((abort t)) - (unwind-protect - (prog1 (let ((debugger #'transient--exit-and-debug)) - (advice-eval-interactive-spec spec)) - (setq abort nil)) - (when abort - (when-let ((unwind (oref prefix unwind-suffix))) - (transient--debug 'unwind-interactive) - (funcall unwind suffix)) - (advice-remove suffix advice) - (oset prefix unwind-suffix nil)))))) - (advice-body - (lambda (fn &rest args) - (unwind-protect - (let ((debugger #'transient--exit-and-debug)) - (apply fn args)) - (when-let ((unwind (oref prefix unwind-suffix))) - (transient--debug 'unwind-command) - (funcall unwind suffix)) - (advice-remove suffix advice) - (oset prefix unwind-suffix nil))))) - (setq advice `(lambda (fn &rest args) - (interactive ,advice-interactive) - (apply ',advice-body fn args))) - (when (symbolp this-command) - (advice-add suffix :around advice '((depth . -99))))))) - -(defun transient--premature-post-command () - (and (equal (this-command-keys-vector) []) - (= (minibuffer-depth) - (1+ transient--minibuffer-depth)) - (progn - (transient--debug 'premature-post-command) - (transient--suspend-override) - (oset (or transient--prefix transient-current-prefix) - unwind-suffix - (if transient--exitp - #'transient--post-exit - #'transient--resume-override)) - t))) - -(defun transient--post-command () - (unless (transient--premature-post-command) - (transient--debug 'post-command) - (transient--with-emergency-exit :post-command - (cond (transient--exitp (transient--post-exit)) - ;; If `this-command' is the current transient prefix, then we - ;; have already taken care of updating the transient buffer... - ((and (eq this-command (oref transient--prefix command)) - ;; ... but if `prefix-arg' is non-nil, then the values - ;; of `this-command' and `real-this-command' are untrue - ;; because `prefix-command-preserve-state' changes them. - ;; We cannot use `current-prefix-arg' because it is set - ;; too late (in `command-execute'), and if it were set - ;; earlier, then we likely still would not be able to - ;; rely on it, and `prefix-command-preserve-state-hook' - ;; would have to be used to record that a universal - ;; argument is in effect. - (not prefix-arg))) - (transient--refreshp - (transient--refresh-transient)) - ((let ((old transient--redisplay-map) - (new (transient--make-redisplay-map))) - (unless (equal old new) - (transient--pop-keymap 'transient--redisplay-map) - (setq transient--redisplay-map new) - (transient--push-keymap 'transient--redisplay-map)) - (transient--redisplay))))))) - -(defun transient--post-exit (&optional command) - (transient--debug 'post-exit) - (unless (and (eq transient--exitp 'replace) - (or transient--prefix - ;; The current command could act as a prefix, - ;; but decided not to call `transient-setup', - ;; or it is prevented from doing so because it - ;; uses the minibuffer and the user aborted - ;; that. - (prog1 nil - (if (let ((obj (transient-suffix-object command))) - (and (slot-boundp obj 'transient) - (oref obj transient))) - ;; This sub-prefix is a transient suffix; - ;; go back to outer prefix, by calling - ;; `transient--stack-pop' further down. - (setq transient--exitp nil) - (transient--stack-zap))))) - (remove-hook 'pre-command-hook #'transient--pre-command) - (remove-hook 'post-command-hook #'transient--post-command) - (advice-remove 'recursive-edit #'transient--recursive-edit)) - (setq transient-current-prefix nil) - (setq transient-current-command nil) - (setq transient-current-suffixes nil) - (let ((resume (and transient--stack - (not (memq transient--exitp '(replace suspend)))))) - (unless (or resume (eq transient--exitp 'replace)) - (setq transient--showp nil)) - (setq transient--exitp nil) - (setq transient--helpp nil) - (setq transient--editp nil) - (setq transient--all-levels-p nil) - (setq transient--minibuffer-depth 0) - (run-hooks 'transient-exit-hook) - (when resume - (transient--stack-pop)))) - -(defun transient--stack-push () - (transient--debug 'stack-push) - (push (list (oref transient--prefix command) - transient--layout - transient--editp - :transient-suffix (oref transient--prefix transient-suffix) - :scope (oref transient--prefix scope)) - transient--stack)) - -(defun transient--stack-pop () - (transient--debug 'stack-pop) - (and transient--stack - (prog1 t (apply #'transient-setup (pop transient--stack))))) - -(defun transient--stack-zap () - (transient--debug 'stack-zap) - (setq transient--stack nil)) - -(defun transient--redisplay () - (if (or (eq transient-show-popup t) - transient--showp) - (unless - (or (memq this-command transient--scroll-commands) - (and (or (memq this-command '(mouse-drag-region - mouse-set-region)) - (equal (key-description (this-command-keys-vector)) - "<mouse-movement>")) - (and (eq (current-buffer) transient--buffer)))) - (transient--show)) - (when (and (numberp transient-show-popup) - (not (zerop transient-show-popup)) - (not transient--timer)) - (transient--timer-start)) - (transient--show-brief))) - -(defun transient--timer-start () - (setq transient--timer - (run-at-time (abs transient-show-popup) nil - (lambda () - (transient--timer-cancel) - (transient--show) - (let ((message-log-max nil)) - (message "")))))) - -(defun transient--timer-cancel () - (when transient--timer - (cancel-timer transient--timer) - (setq transient--timer nil))) - -(defun transient--debug (arg &rest args) - (when transient--debug - (let ((inhibit-message (not (eq transient--debug 'message)))) - (if (symbolp arg) - (message "-- %-22s (cmd: %s, event: %S, exit: %s%s)" - arg - (cond ((and (symbolp this-command) this-command)) - ((fboundp 'help-fns-function-name) - (help-fns-function-name this-command)) - ((byte-code-function-p this-command) - "#[...]") - (this-command)) - (key-description (this-command-keys-vector)) - transient--exitp - (cond ((keywordp (car args)) - (format ", from: %s" - (substring (symbol-name (car args)) 1))) - ((stringp (car args)) - (concat ", " (apply #'format args))) - ((functionp (car args)) - (concat ", " (apply (car args) (cdr args)))) - (""))) - (apply #'message arg args))))) - -(defun transient--emergency-exit (&optional id) - "Exit the current transient command after an error occurred. -When no transient is active (i.e., when `transient--prefix' is -nil) then do nothing. Optional ID is a keyword identifying the -exit." - (transient--debug 'emergency-exit id) - (when transient--prefix - (setq transient--stack nil) - (setq transient--exitp t) - (transient--pre-exit) - (transient--post-exit))) - -;;; Pre-Commands - -(defun transient--call-pre-command () - (if-let ((fn (transient--get-pre-command this-command))) - (let ((action (funcall fn))) - (when (eq action transient--exit) - (setq transient--exitp (or transient--exitp t))) - action) - (if (let ((keys (this-command-keys-vector))) - (eq (aref keys (1- (length keys))) ?\C-g)) - (setq this-command 'transient-noop) - (unless (transient--edebug-command-p) - (setq this-command 'transient-undefined))) - transient--stay)) - -(defun transient--get-pre-command (&optional cmd enforce-type) - (or (and (not (eq enforce-type 'non-suffix)) - (symbolp cmd) - (lookup-key transient--predicate-map (vector cmd))) - (and (not (eq enforce-type 'suffix)) - (transient--resolve-pre-command - (oref transient--prefix transient-non-suffix) - t)))) - -(defun transient--resolve-pre-command (pre &optional resolve-boolean) - (cond ((booleanp pre) - (if resolve-boolean - (if pre #'transient--do-stay #'transient--do-warn) - pre)) - ((string-match-p "--do-" (symbol-name pre)) pre) - ((let ((sym (intern (format "transient--do-%s" pre)))) - (if (functionp sym) sym pre))))) - -(defun transient--do-stay () - "Call the command without exporting variables and stay transient." - transient--stay) - -(defun transient--do-noop () - "Call `transient-noop' and stay transient." - (setq this-command 'transient-noop) - transient--stay) - -(defun transient--do-warn () - "Call `transient-undefined' and stay transient." - (setq this-command 'transient-undefined) - transient--stay) - -(defun transient--do-warn-inapt () - "Call `transient-inapt' and stay transient." - (setq this-command 'transient-inapt) - transient--stay) - -(defun transient--do-call () - "Call the command after exporting variables and stay transient." - (transient--export) - transient--stay) - -(defun transient--do-return () - "Call the command after exporting variables and return to parent prefix. -If there is no parent prefix, then behave like `transient--do-exit'." - (if (not transient--stack) - (transient--do-exit) - (transient--export) - transient--exit)) - -(defun transient--do-exit () - "Call the command after exporting variables and exit the transient." - (transient--export) - (transient--stack-zap) - transient--exit) - -(defun transient--do-leave () - "Call the command without exporting variables and exit the transient." - (transient--stack-zap) - transient--exit) - -(defun transient--do-push-button () - "Call the command represented by the activated button. -Use that command's pre-command to determine transient behavior." - (if (and (mouse-event-p last-command-event) - (not (eq (posn-window (event-start last-command-event)) - transient--window))) - transient--stay - (setq this-command - (with-selected-window transient--window - (get-text-property (if (mouse-event-p last-command-event) - (posn-point (event-start last-command-event)) - (point)) - 'command))) - (transient--call-pre-command))) - -(defun transient--do-recurse () - "Call the transient prefix command, preparing for return to active transient. -If there is no parent prefix, then just call the command." - (transient--do-stack)) - -(defun transient--setup-recursion (prefix-obj) - (when transient--stack - (let ((command (oref prefix-obj command))) - (when-let ((suffix-obj (transient-suffix-object command))) - (when (memq (if (slot-boundp suffix-obj 'transient) - (oref suffix-obj transient) - (oref transient-current-prefix transient-suffix)) - (list t #'transient--do-recurse)) - (oset prefix-obj transient-suffix t)))))) - -(defun transient--do-stack () - "Call the transient prefix command, stacking the active transient. -Push the active transient to the transient stack." - (transient--export) - (transient--stack-push) - (setq transient--exitp 'replace) - transient--exit) - -(defun transient--do-replace () - "Call the transient prefix command, replacing the active transient. -Do not push the active transient to the transient stack." - (transient--export) - (setq transient--exitp 'replace) - transient--exit) - -(defun transient--do-suspend () - "Suspend the active transient, saving the transient stack." - (transient--stack-push) - (setq transient--exitp 'suspend) - transient--exit) - -(defun transient--do-quit-one () - "If active, quit help or edit mode, else exit the active transient." - (cond (transient--helpp - (setq transient--helpp nil) - transient--stay) - (transient--editp - (setq transient--editp nil) - (transient-setup) - transient--stay) - (prefix-arg - transient--stay) - (transient--exit))) - -(defun transient--do-quit-all () - "Exit all transients without saving the transient stack." - (transient--stack-zap) - transient--exit) - -(defun transient--do-move () - "Call the command if `transient-enable-popup-navigation' is non-nil. -In that case behave like `transient--do-stay', otherwise similar -to `transient--do-warn'." - (unless transient-enable-popup-navigation - (setq this-command 'transient-inhibit-move)) - transient--stay) - -(defun transient--do-minus () - "Call `negative-argument' or pivot to `transient-update'. -If `negative-argument' is invoked using \"-\" then preserve the -prefix argument and pivot to `transient-update'." - (when (equal (this-command-keys) "-") - (setq this-command 'transient-update)) - transient--stay) - -(put 'transient--do-stay 'transient-face 'transient-key-stay) -(put 'transient--do-noop 'transient-face 'transient-key-noop) -(put 'transient--do-warn 'transient-face 'transient-key-noop) -(put 'transient--do-warn-inapt 'transient-face 'transient-key-noop) -(put 'transient--do-call 'transient-face 'transient-key-stay) -(put 'transient--do-return 'transient-face 'transient-key-return) -(put 'transient--do-exit 'transient-face 'transient-key-exit) -(put 'transient--do-leave 'transient-face 'transient-key-exit) - -(put 'transient--do-recurse 'transient-face 'transient-key-stay) -(put 'transient--do-stack 'transient-face 'transient-key-stay) -(put 'transient--do-replace 'transient-face 'transient-key-exit) -(put 'transient--do-suspend 'transient-face 'transient-key-exit) - -(put 'transient--do-quit-one 'transient-face 'transient-key-return) -(put 'transient--do-quit-all 'transient-face 'transient-key-exit) -(put 'transient--do-move 'transient-face 'transient-key-stay) -(put 'transient--do-minus 'transient-face 'transient-key-stay) - -;;; Commands -;;;; Noop - -(defun transient-noop () - "Do nothing at all." - (interactive)) - -(defun transient-undefined () - "Warn the user that the pressed key is not bound to any suffix." - (interactive) - (transient--invalid "Unbound suffix")) - -(defun transient-inapt () - "Warn the user that the invoked command is inapt." - (interactive) - (transient--invalid "Inapt command")) - -(defun transient--invalid (msg) - (ding) - (message "%s: `%s' (Use `%s' to abort, `%s' for help)%s" - msg - (propertize (key-description (this-single-command-keys)) - 'face 'font-lock-warning-face) - (propertize "C-g" 'face 'transient-key) - (propertize "?" 'face 'transient-key) - ;; `this-command' is `transient-undefined' or `transient-inapt'. - ;; Show the command (`this-original-command') the user actually - ;; tried to invoke. - (if-let ((cmd (or (ignore-errors (symbol-name this-original-command)) - (ignore-errors (symbol-name this-command))))) - (format " [%s]" (propertize cmd 'face 'font-lock-warning-face)) - "")) - (unless (and transient--transient-map - (memq transient--transient-map overriding-terminal-local-map)) - (let ((transient--prefix (or transient--prefix 'sic))) - (transient--emergency-exit)) - (view-lossage) - (other-window 1) - (display-warning 'transient "Inconsistent transient state detected. -This should never happen. -Please open an issue and post the shown command log." :error))) - -(defun transient-inhibit-move () - "Warn the user that popup navigation is disabled." - (interactive) - (message "To enable use of `%s', please customize `%s'" - this-original-command - 'transient-enable-popup-navigation)) - -;;;; Core - -(defun transient-quit-all () - "Exit all transients without saving the transient stack." - (interactive)) - -(defun transient-quit-one () - "Exit the current transients, returning to outer transient, if any." - (interactive)) - -(defun transient-quit-seq () - "Abort the current incomplete key sequence." - (interactive)) - -(defun transient-update () - "Redraw the transient's state in the popup buffer." - (interactive) - (setq prefix-arg current-prefix-arg)) - -(defun transient-show () - "Show the transient's state in the popup buffer." - (interactive) - (setq transient--showp t)) - -(defun transient-push-button () - "Invoke the suffix command represented by this button." - (interactive)) - -;;;; Suspend - -(defun transient-suspend () - "Suspend the current transient. -It can later be resumed using `transient-resume', while no other -transient is active." - (interactive)) - -(define-minor-mode transient-resume-mode - "Auxiliary minor-mode used to resume a transient after viewing help.") - -(defun transient-resume () - "Resume a previously suspended stack of transients." - (interactive) - (cond (transient--stack - (let ((winconf transient--restore-winconf)) - (kill-local-variable 'transient--restore-winconf) - (when transient-resume-mode - (transient-resume-mode -1) - (quit-window)) - (when winconf - (set-window-configuration winconf))) - (transient--stack-pop)) - (transient-resume-mode - (kill-local-variable 'transient--restore-winconf) - (transient-resume-mode -1) - (quit-window)) - (t - (message "No suspended transient command")))) - -;;;; Help - -(defun transient-help (&optional interactive) - "Show help for the active transient or one of its suffixes.\n\n(fn)" - (interactive (list t)) - (if interactive - (setq transient--helpp t) - (with-demoted-errors "transient-help: %S" - (when (lookup-key transient--transient-map - (this-single-command-raw-keys)) - (setq transient--helpp nil) - (let ((winconf (current-window-configuration))) - (transient-show-help - (if (eq this-original-command 'transient-help) - transient--prefix - (or (transient-suffix-object) - this-original-command))) - (setq-local transient--restore-winconf winconf)) - (fit-window-to-buffer nil (frame-height) (window-height)) - (transient-resume-mode) - (message (substitute-command-keys - "Type \\`q' to resume transient command.")) - t)))) - -;;;; Level - -(defun transient-set-level (&optional command level) - "Set the level of the transient or one of its suffix commands." - (interactive - (let ((command this-original-command) - (prefix (oref transient--prefix command))) - (and (or (not (eq command 'transient-set-level)) - (and transient--editp - (setq command prefix))) - (list command - (let ((keys (this-single-command-raw-keys))) - (and (lookup-key transient--transient-map keys) - (progn - (transient--show) - (string-to-number - (transient--read-number-N - (format "Set level for `%s': " command) - nil nil (not (eq command prefix))))))))))) - (cond - ((not command) - (setq transient--editp t) - (transient-setup)) - (level - (let* ((prefix (oref transient--prefix command)) - (alist (alist-get prefix transient-levels)) - (akey command)) - (cond ((eq command prefix) - (oset transient--prefix level level) - (setq akey t)) - (t - (oset (transient-suffix-object command) level level) - (when (cdr (cl-remove-if-not (lambda (obj) - (eq (oref obj command) command)) - transient--suffixes)) - (setq akey (cons command (this-command-keys)))))) - (setf (alist-get akey alist) level) - (setf (alist-get prefix transient-levels) alist)) - (transient-save-levels) - (transient--show)) - (t - (transient-undefined)))) - -(transient-define-suffix transient-toggle-level-limit () - "Toggle whether to temporarily displayed suffixes on all levels." - :description - (lambda () - (cond - ((= transient-default-level transient--max-level) - "Always displaying all levels") - (transient--all-levels-p - (format "Hide suffix %s" - (propertize - (format "levels > %s" (oref (transient-prefix-object) level)) - 'face 'transient-higher-level))) - ("Show all suffix levels"))) - :inapt-if (lambda () (= transient-default-level transient--max-level)) - :transient t - (interactive) - (setq transient--all-levels-p (not transient--all-levels-p)) - (setq transient--refreshp t)) - -;;;; Value - -(defun transient-set () - "Set active transient's value for this Emacs session." - (interactive) - (transient-set-value (transient-prefix-object))) - -(defalias 'transient-set-and-exit #'transient-set - "Set active transient's value for this Emacs session and exit.") - -(defun transient-save () - "Save active transient's value for this and future Emacs sessions." - (interactive) - (transient-save-value (transient-prefix-object))) - -(defalias 'transient-save-and-exit #'transient-save - "Save active transient's value for this and future Emacs sessions and exit.") - -(defun transient-reset () - "Clear the set and saved values of the active transient." - (interactive) - (transient-reset-value (transient-prefix-object))) - -(defun transient-history-next () - "Switch to the next value used for the active transient." - (interactive) - (let* ((obj transient--prefix) - (pos (1- (oref obj history-pos))) - (hst (oref obj history))) - (if (< pos 0) - (user-error "End of history") - (oset obj history-pos pos) - (oset obj value (nth pos hst)) - (mapc #'transient-init-value transient--suffixes)))) - -(defun transient-history-prev () - "Switch to the previous value used for the active transient." - (interactive) - (let* ((obj transient--prefix) - (pos (1+ (oref obj history-pos))) - (hst (oref obj history)) - (len (length hst))) - (if (> pos (1- len)) - (user-error "End of history") - (oset obj history-pos pos) - (oset obj value (nth pos hst)) - (mapc #'transient-init-value transient--suffixes)))) - -;;;; Auxiliary - -(defun transient-toggle-common () - "Toggle whether common commands are permanently shown." - (interactive) - (setq transient-show-common-commands (not transient-show-common-commands))) - -(defun transient-toggle-debug () - "Toggle debugging statements for transient commands." - (interactive) - (setq transient--debug (not transient--debug)) - (message "Debugging transient %s" - (if transient--debug "enabled" "disabled"))) - -(transient-define-suffix transient-echo-arguments (arguments) - "Show the transient's active ARGUMENTS in the echo area. -Intended for use in prefixes used for demonstration purposes, -such as when suggesting a new feature or reporting an issue." - :transient t - :description "Echo arguments" - :key "x" - (interactive (list (transient-args transient-current-command))) - (message "%s: %s" - (key-description (this-command-keys)) - (mapconcat (lambda (arg) - (propertize (if (string-match-p " " arg) - (format "%S" arg) - arg) - 'face 'transient-argument)) - arguments " "))) - -;;; Value -;;;; Init - -(cl-defgeneric transient-init-scope (obj) - "Set the scope of the suffix object OBJ. - -The scope is actually a property of the transient prefix, not of -individual suffixes. However it is possible to invoke a suffix -command directly instead of from a transient. In that case, if -the suffix expects a scope, then it has to determine that itself -and store it in its `scope' slot. - -This function is called for all suffix commands, but unless a -concrete method is implemented this falls through to the default -implementation, which is a noop.") - -(cl-defmethod transient-init-scope ((_ transient-suffix)) - "Noop." nil) - -(cl-defgeneric transient-init-value (_) - "Set the initial value of the object OBJ. - -This function is called for all prefix and suffix commands. - -For suffix commands (including infix argument commands) the -default implementation is a noop. Classes derived from the -abstract `transient-infix' class must implement this function. -Non-infix suffix commands usually don't have a value." - nil) - -(cl-defmethod transient-init-value :around ((obj transient-prefix)) - "If bound, then call OBJ's `init-value' function. -Otherwise call the primary method according to object's class." - (if (slot-boundp obj 'init-value) - (funcall (oref obj init-value) obj) - (cl-call-next-method obj))) - -(cl-defmethod transient-init-value :around ((obj transient-infix)) - "If bound, then call OBJ's `init-value' function. -Otherwise call the primary method according to object's class." - (if (slot-boundp obj 'init-value) - (funcall (oref obj init-value) obj) - (cl-call-next-method obj))) - -(cl-defmethod transient-init-value ((obj transient-prefix)) - (if (slot-boundp obj 'value) - (oref obj value) - (oset obj value - (if-let ((saved (assq (oref obj command) transient-values))) - (cdr saved) - (transient-default-value obj))))) - -(cl-defmethod transient-init-value ((obj transient-argument)) - (oset obj value - (let ((value (oref transient--prefix value)) - (argument (and (slot-boundp obj 'argument) - (oref obj argument))) - (multi-value (oref obj multi-value)) - (case-fold-search nil) - (regexp (if (slot-exists-p obj 'argument-regexp) - (oref obj argument-regexp) - (format "\\`%s\\(.*\\)" (oref obj argument))))) - (if (memq multi-value '(t rest)) - (cdr (assoc argument value)) - (let ((match (lambda (v) - (and (stringp v) - (string-match regexp v) - (match-string 1 v))))) - (if multi-value - (delq nil (mapcar match value)) - (cl-some match value))))))) - -(cl-defmethod transient-init-value ((obj transient-switch)) - (oset obj value - (car (member (oref obj argument) - (oref transient--prefix value))))) - -;;;; Default - -(cl-defgeneric transient-default-value (_) - "Return the default value." - nil) - -(cl-defmethod transient-default-value ((obj transient-prefix)) - (if-let ((default (and (slot-boundp obj 'default-value) - (oref obj default-value)))) - (if (functionp default) - (funcall default) - default) - nil)) - -;;;; Read - -(cl-defgeneric transient-infix-read (obj) - "Determine the new value of the infix object OBJ. - -This function merely determines the value; `transient-infix-set' -is used to actually store the new value in the object. - -For most infix classes this is done by reading a value from the -user using the reader specified by the `reader' slot (using the -`transient-infix' method described below). - -For some infix classes the value is changed without reading -anything in the minibuffer, i.e., the mere act of invoking the -infix command determines what the new value should be, based -on the previous value.") - -(cl-defmethod transient-infix-read :around ((obj transient-infix)) - "Refresh the transient buffer and call the next method. - -Also wrap `cl-call-next-method' with two macros: -- `transient--with-suspended-override' allows use of minibuffer. -- `transient--with-emergency-exit' arranges for the transient to - be exited in case of an error." - (transient--show) - (transient--with-emergency-exit :infix-read - (transient--with-suspended-override - (cl-call-next-method obj)))) - -(cl-defmethod transient-infix-read ((obj transient-infix)) - "Read a value while taking care of history. - -This method is suitable for a wide variety of infix commands, -including but not limited to inline arguments and variables. - -If you do not use this method for your own infix class, then -you should likely replicate a lot of the behavior of this -method. If you fail to do so, then users might not appreciate -the lack of history, for example. - -Only for very simple classes that toggle or cycle through a very -limited number of possible values should you replace this with a -simple method that does not handle history. (E.g., for a command -line switch the only possible values are \"use it\" and \"don't use -it\", in which case it is pointless to preserve history.)" - (with-slots (value multi-value always-read allow-empty choices) obj - (if (and value - (not multi-value) - (not always-read) - transient--prefix) - (oset obj value nil) - (let* ((enable-recursive-minibuffers t) - (reader (oref obj reader)) - (choices (if (functionp choices) (funcall choices) choices)) - (prompt (transient-prompt obj)) - (value (if multi-value (mapconcat #'identity value ",") value)) - (history-key (or (oref obj history-key) - (oref obj command))) - (transient--history (alist-get history-key transient-history)) - (transient--history (if (or (null value) - (eq value (car transient--history))) - transient--history - (cons value transient--history))) - (initial-input (and transient-read-with-initial-input - (car transient--history))) - (history (if initial-input - (cons 'transient--history 1) - 'transient--history)) - (value - (cond - (reader (funcall reader prompt initial-input history)) - (multi-value - (completing-read-multiple prompt choices nil nil - initial-input history)) - (choices - (completing-read prompt choices nil t initial-input history)) - ((read-string prompt initial-input history))))) - (cond ((and (equal value "") (not allow-empty)) - (setq value nil)) - ((and (equal value "\"\"") allow-empty) - (setq value ""))) - (when value - (when (and (bound-and-true-p ivy-mode) - (stringp (car transient--history))) - (set-text-properties 0 (length (car transient--history)) nil - (car transient--history))) - (setf (alist-get history-key transient-history) - (delete-dups transient--history))) - value)))) - -(cl-defmethod transient-infix-read ((obj transient-switch)) - "Toggle the switch on or off." - (if (oref obj value) nil (oref obj argument))) - -(cl-defmethod transient-infix-read ((obj transient-switches)) - "Cycle through the mutually exclusive switches. -The last value is \"don't use any of these switches\"." - (let ((choices (mapcar (apply-partially #'format (oref obj argument-format)) - (oref obj choices)))) - (if-let ((value (oref obj value))) - (cadr (member value choices)) - (car choices)))) - -(cl-defmethod transient-infix-read ((command symbol)) - "Elsewhere use the reader of the infix command COMMAND. -Use this if you want to share an infix's history with a regular -stand-alone command." - (if-let ((obj (transient--suffix-prototype command))) - (cl-letf (((symbol-function #'transient--show) #'ignore)) - (transient-infix-read obj)) - (error "Not a suffix command: `%s'" command))) - -;;;; Readers - -(defun transient-read-file (prompt _initial-input _history) - "Read a file." - (file-local-name (expand-file-name (read-file-name prompt)))) - -(defun transient-read-existing-file (prompt _initial-input _history) - "Read an existing file." - (file-local-name (expand-file-name (read-file-name prompt nil nil t)))) - -(defun transient-read-directory (prompt _initial-input _history) - "Read a directory." - (file-local-name (expand-file-name (read-directory-name prompt)))) - -(defun transient-read-existing-directory (prompt _initial-input _history) - "Read an existing directory." - (file-local-name (expand-file-name (read-directory-name prompt nil nil t)))) - -(defun transient-read-number-N0 (prompt initial-input history) - "Read a natural number (including zero) and return it as a string." - (transient--read-number-N prompt initial-input history t)) - -(defun transient-read-number-N+ (prompt initial-input history) - "Read a natural number (excluding zero) and return it as a string." - (transient--read-number-N prompt initial-input history nil)) - -(defun transient--read-number-N (prompt initial-input history include-zero) - (save-match-data - (cl-block nil - (while t - (let ((str (read-from-minibuffer prompt initial-input nil nil history))) - (when (or (string-equal str "") - (string-match-p (if include-zero - "\\`\\(0\\|[1-9][0-9]*\\)\\'" - "\\`[1-9][0-9]*\\'") - str)) - (cl-return str))) - (message "Please enter a natural number (%s zero)." - (if include-zero "including" "excluding")) - (sit-for 1))))) - -(defun transient-read-date (prompt default-time _history) - "Read a date using `org-read-date' (which see)." - (require 'org) - (when (fboundp 'org-read-date) - (org-read-date 'with-time nil nil prompt default-time))) - -;;;; Prompt - -(cl-defgeneric transient-prompt (obj) - "Return the prompt to be used to read infix object OBJ's value.") - -(cl-defmethod transient-prompt ((obj transient-infix)) - "Return the prompt to be used to read infix object OBJ's value. - -This implementation should be suitable for almost all infix -commands. - -If the value of OBJ's `prompt' slot is non-nil, then it must be -a string or a function. If it is a string, then use that. If -it is a function, then call that with OBJ as the only argument. -That function must return a string, which is then used as the -prompt. - -Otherwise, if the value of either the `argument' or `variable' -slot of OBJ is a string, then base the prompt on that (preferring -the former), appending either \"=\" (if it appears to be a -command-line option) or \": \". - -Finally fall through to using \"(BUG: no prompt): \" as the -prompt." - (if-let ((prompt (oref obj prompt))) - (let ((prompt (if (functionp prompt) - (funcall prompt obj) - prompt))) - (if (stringp prompt) - prompt - "(BUG: no prompt): ")) - (or (and-let* ((arg (and (slot-boundp obj 'argument) (oref obj argument)))) - (if (and (stringp arg) (string-suffix-p "=" arg)) - arg - (concat arg ": "))) - (and-let* ((var (and (slot-boundp obj 'variable) (oref obj variable)))) - (and (stringp var) - (concat var ": "))) - "(BUG: no prompt): "))) - -;;;; Set - -(cl-defgeneric transient-infix-set (obj value) - "Set the value of infix object OBJ to value.") - -(cl-defmethod transient-infix-set ((obj transient-infix) value) - "Set the value of infix object OBJ to value." - (oset obj value value)) - -(cl-defmethod transient-infix-set :after ((obj transient-argument) value) - "Unset incompatible infix arguments." - (when-let* ((value) - (val (transient-infix-value obj)) - (arg (if (slot-boundp obj 'argument) - (oref obj argument) - (oref obj argument-format))) - (spec (oref transient--prefix incompatible)) - (filter (lambda (x rule) - (and (member x rule) - (remove x rule)))) - (incomp (nconc - (cl-mapcan (apply-partially filter arg) spec) - (and (not (equal val arg)) - (cl-mapcan (apply-partially filter val) spec))))) - (dolist (obj transient--suffixes) - (when-let* (((cl-typep obj 'transient-argument)) - (val (transient-infix-value obj)) - (arg (if (slot-boundp obj 'argument) - (oref obj argument) - (oref obj argument-format))) - ((if (equal val arg) - (member arg incomp) - (or (member val incomp) - (member arg incomp))))) - (transient-infix-set obj nil))))) - -(cl-defgeneric transient-set-value (obj) - "Set the value of the transient prefix OBJ.") - -(cl-defmethod transient-set-value ((obj transient-prefix)) - (oset (oref obj prototype) value (transient-get-value)) - (transient--history-push obj)) - -;;;; Save - -(cl-defgeneric transient-save-value (obj) - "Save the value of the transient prefix OBJ.") - -(cl-defmethod transient-save-value ((obj transient-prefix)) - (let ((value (transient-get-value))) - (oset (oref obj prototype) value value) - (setf (alist-get (oref obj command) transient-values) value) - (transient-save-values)) - (transient--history-push obj)) - -;;;; Reset - -(cl-defgeneric transient-reset-value (obj) - "Clear the set and saved values of the transient prefix OBJ.") - -(cl-defmethod transient-reset-value ((obj transient-prefix)) - (let ((value (transient-default-value obj))) - (oset obj value value) - (oset (oref obj prototype) value value) - (setf (alist-get (oref obj command) transient-values nil 'remove) nil) - (transient-save-values)) - (transient--history-push obj) - (mapc #'transient-init-value transient--suffixes)) - -;;;; Get - -(defun transient-args (prefix) - "Return the value of the transient prefix command PREFIX. -If the current command was invoked from the transient prefix -command PREFIX, then return the active infix arguments. If -the current command was not invoked from PREFIX, then return -the set, saved or default value for PREFIX." - (cl-mapcan #'transient--get-wrapped-value (transient-suffixes prefix))) - -(defun transient-suffixes (prefix) - "Return the suffix objects of the transient prefix command PREFIX." - (if (eq transient-current-command prefix) - transient-current-suffixes - (let ((transient--prefix (transient--init-prefix prefix))) - (transient--flatten-suffixes - (transient--init-suffixes prefix))))) - -(defun transient-get-value () - (transient--with-emergency-exit :get-value - (cl-mapcan (lambda (obj) - (and (or (not (slot-exists-p obj 'unsavable)) - (not (oref obj unsavable))) - (transient--get-wrapped-value obj))) - transient-current-suffixes))) - -(defun transient--get-wrapped-value (obj) - (and-let* ((value (transient-infix-value obj))) - (pcase-exhaustive (and (slot-exists-p obj 'multi-value) - (oref obj multi-value)) - ('nil (list value)) - ((or 't 'rest) (list value)) - ('repeat value)))) - -(cl-defgeneric transient-infix-value (obj) - "Return the value of the suffix object OBJ. - -This function is called by `transient-args' (which see), meaning -this function is how the value of a transient is determined so -that the invoked suffix command can use it. - -Currently most values are strings, but that is not set in stone. -Nil is not a value, it means \"no value\". - -Usually only infixes have a value, but see the method for -`transient-suffix'.") - -(cl-defmethod transient-infix-value ((_ transient-suffix)) - "Return nil, which means \"no value\". - -Infix arguments contribute the transient's value while suffix -commands consume it. This function is called for suffixes anyway -because a command that both contributes to the transient's value -and also consumes it is not completely unconceivable. - -If you define such a command, then you must define a derived -class and implement this function because this default method -does nothing." nil) - -(cl-defmethod transient-infix-value ((obj transient-infix)) - "Return the value of OBJ's `value' slot." - (oref obj value)) - -(cl-defmethod transient-infix-value ((obj transient-option)) - "Return ARGUMENT and VALUE as a unit or nil if the latter is nil." - (and-let* ((value (oref obj value))) - (let ((arg (oref obj argument))) - (pcase-exhaustive (oref obj multi-value) - ('nil (concat arg value)) - ((or 't 'rest) (cons arg value)) - ('repeat (mapcar (lambda (v) (concat arg v)) value)))))) - -(cl-defmethod transient-infix-value ((_ transient-variable)) - "Return nil, which means \"no value\". - -Setting the value of a variable is done by, well, setting the -value of the variable. I.e., this is a side-effect and does -not contribute to the value of the transient." - nil) - -;;;; Utilities - -(defun transient-arg-value (arg args) - "Return the value of ARG as it appears in ARGS. - -For a switch return a boolean. For an option return the value as -a string, using the empty string for the empty value, or nil if -the option does not appear in ARGS." - (if (string-suffix-p "=" arg) - (save-match-data - (and-let* ((match (let ((case-fold-search nil) - (re (format "\\`%s\\(?:=\\(.+\\)\\)?\\'" - (substring arg 0 -1)))) - (cl-find-if (lambda (a) - (and (stringp a) - (string-match re a))) - args)))) - (or (match-string 1 match) ""))) - (and (member arg args) t))) - -(defun transient-scope () - "Return the value of the `scope' slot of the current prefix." - (oref (transient-prefix-object) scope)) - -;;; History - -(cl-defgeneric transient--history-key (obj) - "Return OBJ's history key. -If the value of the `history-key' slot is non-nil, then return -that. Otherwise return the value of the `command' slot." - (or (oref obj history-key) - (oref obj command))) - -(cl-defgeneric transient--history-push (obj) - "Push the current value of OBJ to its entry in `transient-history'." - (let ((key (transient--history-key obj))) - (setf (alist-get key transient-history) - (let ((args (transient-get-value))) - (cons args (delete args (alist-get key transient-history))))))) - -(cl-defgeneric transient--history-init (obj) - "Initialize OBJ's `history' slot. -This is the transient-wide history; many individual infixes also -have a history of their own.") - -(cl-defmethod transient--history-init ((obj transient-prefix)) - "Initialize OBJ's `history' slot from the variable `transient-history'." - (let ((val (oref obj value))) - (oset obj history - (cons val (delete val (alist-get (transient--history-key obj) - transient-history)))))) - -;;; Draw - -(defun transient--show-brief () - (let ((message-log-max nil)) - (if (and transient-show-popup (<= transient-show-popup 0)) - (message "%s-" (key-description (this-command-keys))) - (message - "%s- [%s] %s" - (key-description (this-command-keys)) - (oref transient--prefix command) - (mapconcat - #'identity - (sort - (cl-mapcan - (lambda (suffix) - (let ((key (kbd (oref suffix key)))) - ;; Don't list any common commands. - (and (not (memq (oref suffix command) - `(,(lookup-key transient-map key) - ,(lookup-key transient-sticky-map key) - ;; From transient-common-commands: - transient-set - transient-save - transient-history-prev - transient-history-next - transient-quit-one - transient-toggle-common - transient-set-level))) - (list (propertize (oref suffix key) 'face 'transient-key))))) - transient--suffixes) - #'string<) - (propertize "|" 'face 'transient-delimiter)))))) - -(defun transient--show () - (transient--timer-cancel) - (setq transient--showp t) - (let ((transient--shadowed-buffer (current-buffer)) - (focus nil)) - (setq transient--buffer (get-buffer-create transient--buffer-name)) - (with-current-buffer transient--buffer - (when transient-enable-popup-navigation - (setq focus (or (button-get (point) 'command) - (and (not (bobp)) - (button-get (1- (point)) 'command)) - (transient--heading-at-point)))) - (erase-buffer) - (run-hooks 'transient-setup-buffer-hook) - (when transient-force-fixed-pitch - (transient--force-fixed-pitch)) - (setq window-size-fixed t) - (when (bound-and-true-p tab-line-format) - (setq tab-line-format nil)) - (setq header-line-format nil) - (setq mode-line-format - (if (or (natnump transient-mode-line-format) - (eq transient-mode-line-format 'line)) - nil - transient-mode-line-format)) - (setq mode-line-buffer-identification - (symbol-name (oref transient--prefix command))) - (if transient-enable-popup-navigation - (setq-local cursor-in-non-selected-windows 'box) - (setq cursor-type nil)) - (setq display-line-numbers nil) - (setq show-trailing-whitespace nil) - (transient--insert-groups) - (when (or transient--helpp transient--editp) - (transient--insert-help)) - (when-let ((line (transient--separator-line))) - (insert line))) - (unless (window-live-p transient--window) - (setq transient--window - (display-buffer transient--buffer - transient-display-buffer-action))) - (when (window-live-p transient--window) - (with-selected-window transient--window - (goto-char (point-min)) - (when transient-enable-popup-navigation - (transient--goto-button focus)) - (transient--fit-window-to-buffer transient--window))))) - -(defun transient--fit-window-to-buffer (window) - (let ((window-resize-pixelwise t) - (window-size-fixed nil)) - (if (eq (car (window-parameter window 'quit-restore)) 'other) - ;; Grow but never shrink window that previously displayed - ;; another buffer and is going to display that again. - (fit-window-to-buffer window nil (window-height window)) - (fit-window-to-buffer window nil 1)))) - -(defun transient--separator-line () - (and-let* ((height (cond ((not window-system) nil) - ((natnump transient-mode-line-format) - transient-mode-line-format) - ((eq transient-mode-line-format 'line) 1))) - (face `(,@(and (>= emacs-major-version 27) '(:extend t)) - :background - ,(or (face-foreground (transient--key-face nil 'non-suffix) - nil t) - "#gray60")))) - (concat (propertize "__" 'face face 'display `(space :height (,height))) - (propertize "\n" 'face face 'line-height t)))) - -(defmacro transient-with-shadowed-buffer (&rest body) - "While in the transient buffer, temporarly make the shadowed buffer current." - (declare (indent 0) (debug t)) - `(with-current-buffer (or transient--shadowed-buffer (current-buffer)) - ,@body)) - -(defun transient--insert-groups () - (let ((groups (cl-mapcan (lambda (group) - (let ((hide (oref group hide))) - (and (not (and (functionp hide) - (transient-with-shadowed-buffer - (funcall hide)))) - (list group)))) - transient--layout))) - (while-let ((group (pop groups))) - (transient--insert-group group) - (when groups - (insert ?\n))))) - -(defvar transient--max-group-level 1) - -(cl-defgeneric transient--insert-group (group) - "Format GROUP and its elements and insert the result.") - -(cl-defmethod transient--insert-group :around ((group transient-group)) - "Insert GROUP's description, if any." - (when-let ((desc (transient-with-shadowed-buffer - (transient-format-description group)))) - (insert desc ?\n)) - (let ((transient--max-group-level - (max (oref group level) transient--max-group-level)) - (transient--pending-group group)) - (cl-call-next-method group))) - -(cl-defmethod transient--insert-group ((group transient-row)) - (transient--maybe-pad-keys group) - (dolist (suffix (oref group suffixes)) - (insert (transient-with-shadowed-buffer (transient-format suffix))) - (insert " ")) - (insert ?\n)) - -(cl-defmethod transient--insert-group ((group transient-column)) - (transient--maybe-pad-keys group) - (dolist (suffix (oref group suffixes)) - (let ((str (transient-with-shadowed-buffer (transient-format suffix)))) - (insert str) - (unless (string-match-p ".\n\\'" str) - (insert ?\n))))) - -(cl-defmethod transient--insert-group ((group transient-columns)) - (let* ((columns - (mapcar - (lambda (column) - (transient--maybe-pad-keys column group) - (transient-with-shadowed-buffer - (let* ((transient--pending-group column) - (rows (mapcar #'transient-format (oref column suffixes)))) - (if-let ((desc (transient-format-description column))) - (cons desc rows) - rows)))) - (oref group suffixes))) - (vp (or (oref transient--prefix variable-pitch) - transient-align-variable-pitch)) - (rs (apply #'max (mapcar #'length columns))) - (cs (length columns)) - (cw (mapcar (let ((widths (oref transient--prefix column-widths))) - (lambda (col) - (apply - #'max - (if-let ((min (pop widths))) - (if vp (* min (transient--pixel-width " ")) min) - 0) - (mapcar (if vp #'transient--pixel-width #'length) - col)))) - columns)) - (cc (transient--seq-reductions-from - (apply-partially #'+ (* 2 (if vp (transient--pixel-width " ") 1))) - cw 0))) - (if transient-force-single-column - (dotimes (c cs) - (dotimes (r rs) - (when-let ((cell (nth r (nth c columns)))) - (unless (equal cell "") - (insert cell ?\n)))) - (unless (= c (1- cs)) - (insert ?\n))) - (dotimes (r rs) - (dotimes (c cs) - (if vp - (progn - (when-let ((cell (nth r (nth c columns)))) - (insert cell)) - (if (= c (1- cs)) - (insert ?\n) - (insert (propertize " " 'display - `(space :align-to (,(nth (1+ c) cc))))))) - (when (> c 0) - (insert (make-string (max 1 (- (nth c cc) (current-column))) - ?\s))) - (when-let ((cell (nth r (nth c columns)))) - (insert cell)) - (when (= c (1- cs)) - (insert ?\n)))))))) - -(cl-defmethod transient--insert-group ((group transient-subgroups)) - (let ((subgroups (oref group suffixes))) - (while-let ((subgroup (pop subgroups))) - (transient--maybe-pad-keys subgroup group) - (transient--insert-group subgroup) - (when subgroups - (insert ?\n))))) - -(cl-defgeneric transient-format (obj) - "Format and return OBJ for display. - -When this function is called, then the current buffer is some -temporary buffer. If you need the buffer from which the prefix -command was invoked to be current, then do so by temporarily -making `transient--original-buffer' current.") - -(cl-defmethod transient-format ((arg string)) - "Return the string ARG after applying the `transient-heading' face." - (propertize arg 'face 'transient-heading)) - -(cl-defmethod transient-format ((_ null)) - "Return a string containing just the newline character." - "\n") - -(cl-defmethod transient-format ((arg integer)) - "Return a string containing just the ARG character." - (char-to-string arg)) - -(cl-defmethod transient-format :around ((obj transient-suffix)) - "Add additional formatting if appropriate. -When reading user input for this infix, then highlight it. -When edit-mode is enabled, then prepend the level information. -When `transient-enable-popup-navigation' is non-nil then format -as a button." - (let ((str (cl-call-next-method obj))) - (when (and (cl-typep obj 'transient-infix) - (eq (oref obj command) this-original-command) - (active-minibuffer-window)) - (setq str (transient--add-face str 'transient-active-infix))) - (when transient--editp - (setq str (concat (let ((level (oref obj level))) - (propertize (format " %s " level) - 'face (if (transient--use-level-p level t) - 'transient-enabled-suffix - 'transient-disabled-suffix))) - str))) - (when (and transient-enable-popup-navigation - (slot-boundp obj 'command)) - (setq str (make-text-button str nil - 'type 'transient - 'command (oref obj command)))) - str)) - -(cl-defmethod transient-format ((obj transient-infix)) - "Return a string generated using OBJ's `format'. -%k is formatted using `transient-format-key'. -%d is formatted using `transient-format-description'. -%v is formatted using `transient-format-value'." - (format-spec (oref obj format) - `((?k . ,(transient-format-key obj)) - (?d . ,(transient-format-description obj)) - (?v . ,(transient-format-value obj))))) - -(cl-defmethod transient-format ((obj transient-suffix)) - "Return a string generated using OBJ's `format'. -%k is formatted using `transient-format-key'. -%d is formatted using `transient-format-description'." - (format-spec (oref obj format) - `((?k . ,(transient-format-key obj)) - (?d . ,(transient-format-description obj))))) - -(cl-defgeneric transient-format-key (obj) - "Format OBJ's `key' for display and return the result.") - -(cl-defmethod transient-format-key :around ((obj transient-suffix)) - "Add `transient-inapt-suffix' face if suffix is inapt." - (let ((str (cl-call-next-method))) - (if (oref obj inapt) - (transient--add-face str 'transient-inapt-suffix) - str))) - -(cl-defmethod transient-format-key ((obj transient-suffix)) - "Format OBJ's `key' for display and return the result." - (let ((key (if (slot-boundp obj 'key) (oref obj key) "")) - (cmd (and (slot-boundp obj 'command) (oref obj command)))) - (when-let ((width (oref transient--pending-group pad-keys))) - (setq key (truncate-string-to-width key width nil ?\s))) - (if transient--redisplay-key - (let ((len (length transient--redisplay-key)) - (seq (cl-coerce (edmacro-parse-keys key t) 'list))) - (cond - ((member (seq-take seq len) - (list transient--redisplay-key - (thread-last transient--redisplay-key - (cl-substitute ?- 'kp-subtract) - (cl-substitute ?= 'kp-equal) - (cl-substitute ?+ 'kp-add)))) - (let ((pre (key-description (vconcat (seq-take seq len)))) - (suf (key-description (vconcat (seq-drop seq len))))) - (setq pre (string-replace "RET" "C-m" pre)) - (setq pre (string-replace "TAB" "C-i" pre)) - (setq suf (string-replace "RET" "C-m" suf)) - (setq suf (string-replace "TAB" "C-i" suf)) - ;; We use e.g., "-k" instead of the more correct "- k", - ;; because the former is prettier. If we did that in - ;; the definition, then we want to drop the space that - ;; is reinserted above. False-positives are possible - ;; for silly bindings like "-C-c C-c". - (unless (string-search " " key) - (setq pre (string-replace " " "" pre)) - (setq suf (string-replace " " "" suf))) - (concat (propertize pre 'face 'transient-unreachable-key) - (and (string-prefix-p (concat pre " ") key) " ") - (propertize suf 'face (transient--key-face cmd)) - (save-excursion - (and (string-match " +\\'" key) - (propertize (match-string 0 key) - 'face 'fixed-pitch)))))) - ((transient--lookup-key transient-sticky-map (kbd key)) - (propertize key 'face (transient--key-face cmd))) - (t - (propertize key 'face 'transient-unreachable-key)))) - (propertize key 'face (transient--key-face cmd))))) - -(cl-defmethod transient-format-key :around ((obj transient-argument)) - "Handle `transient-highlight-mismatched-keys'." - (let ((key (cl-call-next-method obj))) - (cond - ((not transient-highlight-mismatched-keys) key) - ((not (slot-boundp obj 'shortarg)) - (transient--add-face key 'transient-nonstandard-key)) - ((not (string-equal key (oref obj shortarg))) - (transient--add-face key 'transient-mismatched-key)) - (key)))) - -(cl-defgeneric transient-format-description (obj) - "Format OBJ's `description' for display and return the result.") - -(cl-defmethod transient-format-description ((obj transient-suffix)) - "The `description' slot may be a function, in which case that is -called inside the correct buffer (see `transient--insert-group') -and its value is returned to the caller." - (transient--get-description obj)) - -(cl-defmethod transient-format-description ((obj transient-group)) - "Format the description by calling the next method. If the result -doesn't use the `face' property at all, then apply the face -`transient-heading' to the complete string." - (and-let* ((desc (transient--get-description obj))) - (cond ((oref obj inapt) - (propertize desc 'face 'transient-inapt-suffix)) - ((text-property-not-all 0 (length desc) 'face nil desc) - desc) - ((propertize desc 'face 'transient-heading))))) - -(cl-defmethod transient-format-description :around ((obj transient-suffix)) - "Format the description by calling the next method. If the result -is nil, then use \"(BUG: no description)\" as the description. -If the OBJ's `key' is currently unreachable, then apply the face -`transient-unreachable' to the complete string." - (let ((desc (or (cl-call-next-method obj) - (and (slot-boundp transient--prefix 'suffix-description) - (funcall (oref transient--prefix suffix-description) - obj))))) - (if desc - (when-let ((face (transient--get-face obj 'face))) - (setq desc (transient--add-face desc face t))) - (setq desc (propertize "(BUG: no description)" 'face 'error))) - (when (if transient--all-levels-p - (> (oref obj level) transient--default-prefix-level) - (and transient-highlight-higher-levels - (> (max (oref obj level) transient--max-group-level) - transient--default-prefix-level))) - (setq desc (transient--add-face desc 'transient-higher-level))) - (when-let ((inapt-face (and (oref obj inapt) - (transient--get-face obj 'inapt-face)))) - (setq desc (transient--add-face desc inapt-face))) - (when (and (slot-boundp obj 'key) - (transient--key-unreachable-p obj)) - (setq desc (transient--add-face desc 'transient-unreachable))) - desc)) - -(cl-defgeneric transient-format-value (obj) - "Format OBJ's value for display and return the result.") - -(cl-defmethod transient-format-value ((obj transient-suffix)) - (propertize (oref obj argument) - 'face (if (oref obj value) - 'transient-argument - 'transient-inactive-argument))) - -(cl-defmethod transient-format-value ((obj transient-option)) - (let ((argument (oref obj argument))) - (if-let ((value (oref obj value))) - (pcase-exhaustive (oref obj multi-value) - ('nil - (concat (propertize argument 'face 'transient-argument) - (propertize value 'face 'transient-value))) - ((or 't 'rest) - (concat (propertize (if (string-suffix-p " " argument) - argument - (concat argument " ")) - 'face 'transient-argument) - (propertize (mapconcat #'prin1-to-string value " ") - 'face 'transient-value))) - ('repeat - (mapconcat (lambda (value) - (concat (propertize argument 'face 'transient-argument) - (propertize value 'face 'transient-value))) - value " "))) - (propertize argument 'face 'transient-inactive-argument)))) - -(cl-defmethod transient-format-value ((obj transient-switches)) - (with-slots (value argument-format choices) obj - (format (propertize argument-format - 'face (if value - 'transient-argument - 'transient-inactive-argument)) - (format - (propertize "[%s]" 'face 'transient-delimiter) - (mapconcat - (lambda (choice) - (propertize choice 'face - (if (equal (format argument-format choice) value) - 'transient-value - 'transient-inactive-value))) - choices - (propertize "|" 'face 'transient-delimiter)))))) - -(cl-defmethod transient--get-description ((obj transient-child)) - (and-let* ((desc (oref obj description))) - (if (functionp desc) - (if (= (car (transient--func-arity desc)) 1) - (funcall desc obj) - (funcall desc)) - desc))) - -(cl-defmethod transient--get-face ((obj transient-suffix) slot) - (and-let* (((slot-boundp obj slot)) - (face (slot-value obj slot))) - (if (and (not (facep face)) - (functionp face)) - (let ((transient--pending-suffix obj)) - (if (= (car (transient--func-arity face)) 1) - (funcall face obj) - (funcall face))) - face))) - -(defun transient--add-face (string face &optional append beg end) - (let ((str (copy-sequence string))) - (add-face-text-property (or beg 0) (or end (length str)) face append str) - str)) - -(defun transient--key-face (&optional cmd enforce-type) - (or (and transient-semantic-coloring - (not transient--helpp) - (not transient--editp) - (or (and cmd (get cmd 'transient-face)) - (get (transient--get-pre-command cmd enforce-type) - 'transient-face))) - (if cmd 'transient-key 'transient-key-noop))) - -(defun transient--key-unreachable-p (obj) - (and transient--redisplay-key - (let ((key (oref obj key))) - (not (or (equal (seq-take (cl-coerce (edmacro-parse-keys key t) 'list) - (length transient--redisplay-key)) - transient--redisplay-key) - (transient--lookup-key transient-sticky-map (kbd key))))))) - -(defun transient--lookup-key (keymap key) - (let ((val (lookup-key keymap key))) - (and val (not (integerp val)) val))) - -(defun transient--maybe-pad-keys (group &optional parent) - (when-let ((pad (or (oref group pad-keys) - (and parent (oref parent pad-keys))))) - (oset group pad-keys - (apply #'max - (if (integerp pad) pad 0) - (seq-keep (lambda (suffix) - (and (eieio-object-p suffix) - (slot-boundp suffix 'key) - (length (oref suffix key)))) - (oref group suffixes)))))) - -(defun transient--pixel-width (string) - (save-window-excursion - (with-temp-buffer - (insert string) - (set-window-dedicated-p nil nil) - (set-window-buffer nil (current-buffer)) - (car (window-text-pixel-size - nil (line-beginning-position) (point)))))) - -(defun transient-command-summary-or-name (obj) - "Return the summary or name of the command represented by OBJ. - -If the command has a doc-string, then return the first line of -that, else its name. - -Intended to be temporarily used as the `:suffix-description' of -a prefix command, while porting a regular keymap to a transient." - (let ((command (oref obj command))) - (if-let ((doc (documentation command))) - (propertize (car (split-string doc "\n")) 'face 'font-lock-doc-face) - (propertize (symbol-name command) 'face 'font-lock-function-name-face)))) - -;;; Help - -(cl-defgeneric transient-show-help (obj) - "Show documentation for the command represented by OBJ.") - -(cl-defmethod transient-show-help ((obj transient-prefix)) - "Call `show-help' if non-nil, else show `info-manual', -if non-nil, else show the `man-page' if non-nil, else use -`describe-function'." - (with-slots (show-help info-manual man-page command) obj - (cond (show-help (funcall show-help obj)) - (info-manual (transient--show-manual info-manual)) - (man-page (transient--show-manpage man-page)) - ((transient--describe-function command))))) - -(cl-defmethod transient-show-help ((obj transient-suffix)) - "Call `show-help' if non-nil, else use `describe-function'. -Also used to dispatch showing documentation for the current -prefix. If the suffix is a sub-prefix, then also call the -prefix method." - (cond - ((eq this-command 'transient-help) - (transient-show-help transient--prefix)) - ((let ((prefix (get (oref obj command) - 'transient--prefix))) - (and prefix (not (eq (oref transient--prefix command) this-command)) - (prog1 t (transient-show-help prefix))))) - ((if-let ((show-help (oref obj show-help))) - (funcall show-help obj) - (transient--describe-function this-command))))) - -(cl-defmethod transient-show-help ((obj transient-infix)) - "Call `show-help' if non-nil, else show the `man-page' -if non-nil, else use `describe-function'. When showing the -manpage, then try to jump to the correct location." - (if-let ((show-help (oref obj show-help))) - (funcall show-help obj) - (if-let ((man-page (oref transient--prefix man-page)) - (argument (and (slot-boundp obj 'argument) - (oref obj argument)))) - (transient--show-manpage man-page argument) - (transient--describe-function this-command)))) - -;; `cl-generic-generalizers' doesn't support `command' et al. -(cl-defmethod transient-show-help (cmd) - "Show the command doc-string." - (transient--describe-function cmd)) - -(defun transient--describe-function (fn) - (describe-function fn) - (unless (derived-mode-p 'help-mode) - (when-let* ((buf (get-buffer "*Help*")) - (win (or (and buf (get-buffer-window buf)) - (cl-find-if (lambda (win) - (with-current-buffer (window-buffer win) - (derived-mode-p 'help-mode))) - (window-list))))) - (select-window win)))) - -(defun transient--show-manual (manual) - (info manual)) - -(defun transient--show-manpage (manpage &optional argument) - (require 'man) - (let* ((Man-notify-method 'meek) - (buf (Man-getpage-in-background manpage)) - (proc (get-buffer-process buf))) - (while (and proc (eq (process-status proc) 'run)) - (accept-process-output proc)) - (switch-to-buffer buf) - (when argument - (transient--goto-argument-description argument)))) - -(defun transient--goto-argument-description (arg) - (goto-char (point-min)) - (let ((case-fold-search nil) - ;; This matches preceding/proceeding options. Options - ;; such as "-a", "-S[<keyid>]", and "--grep=<pattern>" - ;; are matched by this regex without the shy group. - ;; The ". " in the shy group is for options such as - ;; "-m parent-number", and the "-[^[:space:]]+ " is - ;; for options such as "--mainline parent-number" - (others "-\\(?:. \\|-[^[:space:]]+ \\)?[^[:space:]]+")) - (when (re-search-forward - (if (equal arg "--") - ;; Special case. - "^[\t\s]+\\(--\\(?: \\|$\\)\\|\\[--\\]\\)" - ;; Should start with whitespace and may have - ;; any number of options before and/or after. - (format - "^[\t\s]+\\(?:%s, \\)*?\\(?1:%s\\)%s\\(?:, %s\\)*$" - others - ;; Options don't necessarily end in an "=" - ;; (e.g., "--gpg-sign[=<keyid>]") - (string-remove-suffix "=" arg) - ;; Simple options don't end in an "=". Splitting this - ;; into 2 cases should make getting false positives - ;; less likely. - (if (string-suffix-p "=" arg) - ;; "[^[:space:]]*[^.[:space:]]" matches the option - ;; value, which is usually after the option name - ;; and either '=' or '[='. The value can't end in - ;; a period, as that means it's being used at the - ;; end of a sentence. The space is for options - ;; such as '--mainline parent-number'. - "\\(?: \\|\\[?=\\)[^[:space:]]*[^.[:space:]]" - ;; Either this doesn't match anything (e.g., "-a"), - ;; or the option is followed by a value delimited - ;; by a "[", "<", or ":". A space might appear - ;; before this value, as in "-f <file>". The - ;; space alternative is for options such as - ;; "-m parent-number". - "\\(?:\\(?: \\| ?[\\[<:]\\)[^[:space:]]*[^.[:space:]]\\)?") - others)) - nil t) - (goto-char (match-beginning 1))))) - -(defun transient--insert-help () - (unless (looking-back "\n\n" 2) - (insert "\n")) - (when transient--helpp - (insert - (format (propertize "\ -Type a %s to show help for that suffix command, or %s to show manual. -Type %s to exit help.\n" - 'face 'transient-heading) - (propertize "<KEY>" 'face 'transient-key) - (propertize "?" 'face 'transient-key) - (propertize "C-g" 'face 'transient-key)))) - (when transient--editp - (unless transient--helpp - (insert - (format (propertize "\ -Type a %s to set level for that suffix command. -Type %s to set what levels are available for this prefix command.\n" - 'face 'transient-heading) - (propertize "<KEY>" 'face 'transient-key) - (propertize "C-x l" 'face 'transient-key)))) - (with-slots (level) transient--prefix - (insert - (format (propertize " -Suffixes on levels %s are available. -Suffixes on levels %s and %s are unavailable.\n" - 'face 'transient-heading) - (propertize (format "1-%s" level) - 'face 'transient-enabled-suffix) - (propertize " 0 " - 'face 'transient-disabled-suffix) - (propertize (format ">=%s" (1+ level)) - 'face 'transient-disabled-suffix)))))) - -;;; Popup Navigation - -(defun transient-scroll-up (&optional arg) - "Scroll text of transient popup window upward ARG lines. -If ARG is nil scroll near full screen. This is a wrapper -around `scroll-up-command' (which see)." - (interactive "^P") - (with-selected-window transient--window - (scroll-up-command arg))) - -(defun transient-scroll-down (&optional arg) - "Scroll text of transient popup window down ARG lines. -If ARG is nil scroll near full screen. This is a wrapper -around `scroll-down-command' (which see)." - (interactive "^P") - (with-selected-window transient--window - (scroll-down-command arg))) - -(defun transient-backward-button (n) - "Move to the previous button in the transient popup buffer. -See `backward-button' for information about N." - (interactive "p") - (with-selected-window transient--window - (backward-button n t))) - -(defun transient-forward-button (n) - "Move to the next button in the transient popup buffer. -See `forward-button' for information about N." - (interactive "p") - (with-selected-window transient--window - (forward-button n t))) - -(define-button-type 'transient - 'face nil - 'keymap transient-button-map) - -(defun transient--goto-button (command) - (cond - ((stringp command) - (when (re-search-forward (concat "^" (regexp-quote command)) nil t) - (goto-char (match-beginning 0)))) - (command - (while (and (ignore-errors (forward-button 1)) - (not (eq (button-get (button-at (point)) 'command) command)))) - (unless (eq (button-get (button-at (point)) 'command) command) - (goto-char (point-min)) - (forward-button 1))))) - -(defun transient--heading-at-point () - (and (eq (get-text-property (point) 'face) 'transient-heading) - (let ((beg (line-beginning-position))) - (buffer-substring-no-properties - beg (next-single-property-change - beg 'face nil (line-end-position)))))) - -;;; Compatibility -;;;; Popup Isearch - -(defvar-keymap transient--isearch-mode-map - :parent isearch-mode-map - "<remap> <isearch-exit>" #'transient-isearch-exit - "<remap> <isearch-cancel>" #'transient-isearch-cancel - "<remap> <isearch-abort>" #'transient-isearch-abort) - -(defun transient-isearch-backward (&optional regexp-p) - "Do incremental search backward. -With a prefix argument, do an incremental regular expression -search instead." - (interactive "P") - (transient--isearch-setup) - (let ((isearch-mode-map transient--isearch-mode-map)) - (isearch-mode nil regexp-p))) - -(defun transient-isearch-forward (&optional regexp-p) - "Do incremental search forward. -With a prefix argument, do an incremental regular expression -search instead." - (interactive "P") - (transient--isearch-setup) - (let ((isearch-mode-map transient--isearch-mode-map)) - (isearch-mode t regexp-p))) - -(defun transient-isearch-exit () - "Like `isearch-exit' but adapted for `transient'." - (interactive) - (isearch-exit) - (transient--isearch-exit)) - -(defun transient-isearch-cancel () - "Like `isearch-cancel' but adapted for `transient'." - (interactive) - (condition-case nil (isearch-cancel) (quit)) - (transient--isearch-exit)) - -(defun transient-isearch-abort () - "Like `isearch-abort' but adapted for `transient'." - (interactive) - (let ((around (lambda (fn) - (condition-case nil (funcall fn) (quit)) - (transient--isearch-exit)))) - (advice-add 'isearch-cancel :around around) - (unwind-protect - (isearch-abort) - (advice-remove 'isearch-cancel around)))) - -(defun transient--isearch-setup () - (select-window transient--window) - (transient--suspend-override t)) - -(defun transient--isearch-exit () - (select-window transient--original-window) - (transient--resume-override)) - -;;;; Edebug - -(defun transient--edebug-command-p () - (and (bound-and-true-p edebug-active) - (or (memq this-command '(top-level abort-recursive-edit)) - (string-prefix-p "edebug" (symbol-name this-command))))) - -;;;; Miscellaneous - -(cl-pushnew (list nil (concat "^\\s-*(" - (eval-when-compile - (regexp-opt - '("transient-define-prefix" - "transient-define-suffix" - "transient-define-infix" - "transient-define-argument") - t)) - "\\s-+\\(" lisp-mode-symbol-regexp "\\)") - 2) - lisp-imenu-generic-expression :test #'equal) - -(declare-function which-key-mode "which-key" (&optional arg)) - -(defun transient--suspend-which-key-mode () - (when (bound-and-true-p which-key-mode) - (which-key-mode -1) - (add-hook 'transient-exit-hook #'transient--resume-which-key-mode))) - -(defun transient--resume-which-key-mode () - (unless transient--prefix - (which-key-mode 1) - (remove-hook 'transient-exit-hook #'transient--resume-which-key-mode))) - -(defun transient-bind-q-to-quit () - "Modify some keymaps to bind \"q\" to the appropriate quit command. - -\"C-g\" is the default binding for such commands now, but Transient's -predecessor Magit-Popup used \"q\" instead. If you would like to get -that binding back, then call this function in your init file like so: - - (with-eval-after-load \\='transient - (transient-bind-q-to-quit)) - -Individual transients may already bind \"q\" to something else -and such a binding would shadow the quit binding. If that is the -case then \"Q\" is bound to whatever \"q\" would have been bound -to by setting `transient-substitute-key-function' to a function -that does that. Of course \"Q\" may already be bound to something -else, so that function binds \"M-q\" to that command instead. -Of course \"M-q\" may already be bound to something else, but -we stop there." - (keymap-set transient-base-map "q" #'transient-quit-one) - (keymap-set transient-sticky-map "q" #'transient-quit-seq) - (setq transient-substitute-key-function - #'transient-rebind-quit-commands)) - -(defun transient-rebind-quit-commands (obj) - "See `transient-bind-q-to-quit'." - (let ((key (oref obj key))) - (cond ((string-equal key "q") "Q") - ((string-equal key "Q") "M-q") - (key)))) - -(defun transient--force-fixed-pitch () - (require 'face-remap) - (face-remap-reset-base 'default) - (face-remap-add-relative 'default 'fixed-pitch)) - -(defun transient--func-arity (fn) - (func-arity (advice--cd*r (if (symbolp fn) (symbol-function fn) fn)))) - -(defun transient--seq-reductions-from (function sequence initial-value) - (let ((acc (list initial-value))) - (seq-doseq (elt sequence) - (push (funcall function (car acc) elt) acc)) - (nreverse acc))) - -;;; Font-Lock - -(defconst transient-font-lock-keywords - (eval-when-compile - `((,(concat "(" - (regexp-opt (list "transient-define-prefix" - "transient-define-infix" - "transient-define-argument" - "transient-define-suffix") - t) - "\\_>[ \t'(]*" - "\\(\\(?:\\sw\\|\\s_\\)+\\)?") - (1 'font-lock-keyword-face) - (2 'font-lock-function-name-face nil t))))) - -(font-lock-add-keywords 'emacs-lisp-mode transient-font-lock-keywords) - -;;; Auxiliary Classes -;;;; `transient-lisp-variable' - -(defclass transient-lisp-variable (transient-variable) - ((reader :initform #'transient-lisp-variable--reader) - (always-read :initform t) - (set-value :initarg :set-value :initform #'set)) - "[Experimental] Class used for Lisp variables.") - -(cl-defmethod transient-init-value ((obj transient-lisp-variable)) - (oset obj value (symbol-value (oref obj variable)))) - -(cl-defmethod transient-infix-set ((obj transient-lisp-variable) value) - (funcall (oref obj set-value) - (oref obj variable) - (oset obj value value))) - -(cl-defmethod transient-format-description ((obj transient-lisp-variable)) - (or (cl-call-next-method obj) - (symbol-name (oref obj variable)))) - -(cl-defmethod transient-format-value ((obj transient-lisp-variable)) - (propertize (prin1-to-string (oref obj value)) - 'face 'transient-value)) - -(cl-defmethod transient-prompt ((obj transient-lisp-variable)) - (if (and (slot-boundp obj 'prompt) - (oref obj prompt)) - (cl-call-next-method obj) - (format "Set %s: " (oref obj variable)))) - -(defun transient-lisp-variable--reader (prompt initial-input _history) - (read--expression prompt initial-input)) - -;;; _ -(provide 'transient) -;; Local Variables: -;; indent-tabs-mode: nil -;; checkdoc-symbol-words: ("command-line" "edit-mode" "help-mode") -;; End: -;;; transient.el ends here diff --git a/emacs/elpa/transient-20240607.1832/transient.elc b/emacs/elpa/transient-20240607.1832/transient.elc Binary files differ. diff --git a/emacs/elpa/transient-20240607.1832/transient.info b/emacs/elpa/transient-20240607.1832/transient.info @@ -1,3273 +0,0 @@ -This is transient.info, produced by makeinfo version 6.7 from -transient.texi. - - Copyright (C) 2018–2024 Free Software Foundation, Inc. - - 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 misc features -START-INFO-DIR-ENTRY -* Transient: (transient). Transient Commands. -END-INFO-DIR-ENTRY - - -File: transient.info, Node: Top, Next: Introduction, Up: (dir) - -Transient User and Developer Manual -*********************************** - -Transient is the library used to implement the keyboard-driven “menus” -in Magit. It is distributed as a separate package, so that it can be -used to implement similar menus in other packages. - - This manual can be bit hard to digest when getting started. A useful -resource to get over that hurdle is Psionic K’s interactive tutorial, -available at <https://github.com/positron-solutions/transient-showcase>. - -This manual is for Transient version 0.6.0. - - Copyright (C) 2018–2024 Free Software Foundation, Inc. - - 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:: -* Usage:: -* Modifying Existing Transients:: -* Defining New Commands:: -* Classes and Methods:: -* FAQ:: -* Keystroke Index:: -* Command and Function Index:: -* Variable Index:: -* Concept Index:: -* GNU General Public License:: - -— The Detailed Node Listing — - -Usage - -* Invoking Transients:: -* Aborting and Resuming Transients:: -* Common Suffix Commands:: -* Saving Values:: -* Using History:: -* Getting Help for Suffix Commands:: -* Enabling and Disabling Suffixes:: -* Other Commands:: -* Configuration:: - -Defining New Commands - -* Technical Introduction:: -* Defining Transients:: -* Binding Suffix and Infix Commands:: -* Defining Suffix and Infix Commands:: -* Using Infix Arguments:: -* Transient State:: - -Binding Suffix and Infix Commands - -* Group Specifications:: -* Suffix Specifications:: - - -Classes and Methods - -* Group Classes:: -* Group Methods:: -* Prefix Classes:: -* Suffix Classes:: -* Suffix Methods:: -* Prefix Slots:: -* Suffix Slots:: -* Predicate Slots:: - -Suffix Methods - -* Suffix Value Methods:: -* Suffix Format Methods:: - - - - -File: transient.info, Node: Introduction, Next: Usage, Prev: Top, Up: Top - -1 Introduction -************** - -Transient is the library used to implement the keyboard-driven “menus” -in Magit. It is distributed as a separate package, so that it can be -used to implement similar menus in other packages. - - This manual can be bit hard to digest when getting started. A useful -resource to get over that hurdle is Psionic K’s interactive tutorial, -available at <https://github.com/positron-solutions/transient-showcase>. - -Some things that Transient can do -================================= - - • Display current state of arguments - • Display and manage lifecycle of modal bindings - • Contextual user interface - • Flow control for wizard-like composition of interactive forms - • History & persistence - • Rendering arguments for controlling CLI programs - -Complexity in CLI programs -========================== - -Complexity tends to grow with time. How do you manage the complexity of -commands? Consider the humble shell command ‘ls’. It now has over -_fifty_ command line options. Some of these are boolean flags (‘ls --l’). Some take arguments (‘ls --sort=s’). Some have no effect unless -paired with other flags (‘ls -lh’). Some are mutually exclusive. Some -shell commands even have so many options that they introduce -_subcommands_ (‘git branch’, ‘git commit’), each with their own rich set -of options (‘git branch -f’). - -Using Transient for composing interactive commands -================================================== - -What about Emacs commands used interactively? How do these handle -options? One solution is to make many versions of the same command, so -you don’t need to! Consider: ‘delete-other-windows’ vs. -‘delete-other-windows-vertically’ (among many similar examples). - - Some Emacs commands will simply prompt you for the next "argument" -(‘M-x switch-to-buffer’). Another common solution is to use prefix -arguments which usually start with ‘C-u’. Sometimes these are sensibly -numerical in nature (‘C-u 4 M-x forward-paragraph’ to move forward 4 -paragraphs). But sometimes they function instead as boolean "switches" -(‘C-u C-SPACE’ to jump to the last mark instead of just setting it, ‘C-u -C-u C-SPACE’ to unconditionally set the mark). Since there aren’t many -standards for the use of prefix options, you have to read the command’s -documentation to find out what the possibilities are. - - But when an Emacs command grows to have a truly large set of options -and arguments, with dependencies between them, lots of option values, -etc., these simple approaches just don’t scale. Transient is designed -to solve this issue. Think of it as the humble prefix argument ‘C-u’, -_raised to the power of 10_. Like ‘C-u’, it is key driven. Like the -shell, it supports boolean "flag" options, options that take arguments, -and even "sub-commands", with their own options. But instead of -searching through a man page or command documentation, well-designed -transients _guide_ their users to the relevant set of options (and even -their possible values!) directly, taking into account any important -pre-existing Emacs settings. And while for shell commands like ‘ls’, -there is only one way to "execute" (hit ‘Return’!), transients can -"execute" using multiple different keys tied to one of many -self-documenting _actions_ (imagine having 5 different colored return -keys on your keyboard!). Transients make navigating and setting large, -complex groups of command options and arguments easy. Fun even. Once -you’ve tried it, it’s hard to go back to the ‘C-u what can I do here -again?’ way. - - -File: transient.info, Node: Usage, Next: Modifying Existing Transients, Prev: Introduction, Up: Top - -2 Usage -******* - -* Menu: - -* Invoking Transients:: -* Aborting and Resuming Transients:: -* Common Suffix Commands:: -* Saving Values:: -* Using History:: -* Getting Help for Suffix Commands:: -* Enabling and Disabling Suffixes:: -* Other Commands:: -* Configuration:: - - -File: transient.info, Node: Invoking Transients, Next: Aborting and Resuming Transients, Up: Usage - -2.1 Invoking Transients -======================= - -A transient prefix command is invoked like any other command by pressing -the key that is bound to that command. The main difference to other -commands is that a transient prefix command activates a transient -keymap, which temporarily binds the transient’s infix and suffix -commands. Bindings from other keymaps may, or may not, be disabled -while the transient state is in effect. - - There are two kinds of commands that are available after invoking a -transient prefix command; infix and suffix commands. Infix commands set -some value (which is then shown in a popup buffer), without leaving the -transient. Suffix commands, on the other hand, usually quit the -transient and they may use the values set by the infix commands, i.e., -the infix *arguments*. - - Instead of setting arguments to be used by a suffix command, infix -commands may also set some value by side-effect, e.g., by setting the -value of some variable. - - -File: transient.info, Node: Aborting and Resuming Transients, Next: Common Suffix Commands, Prev: Invoking Transients, Up: Usage - -2.2 Aborting and Resuming Transients -==================================== - -To quit the transient without invoking a suffix command press ‘C-g’. - - Key bindings in transient keymaps may be longer than a single event. -After pressing a valid prefix key, all commands whose bindings do not -begin with that prefix key are temporarily unavailable and grayed out. -To abort the prefix key press ‘C-g’ (which in this case only quits the -prefix key, but not the complete transient). - - A transient prefix command can be bound as a suffix of another -transient. Invoking such a suffix replaces the current transient state -with a new transient state, i.e., the available bindings change and the -information displayed in the popup buffer is updated accordingly. -Pressing ‘C-g’ while a nested transient is active only quits the -innermost transient, causing a return to the previous transient. - - ‘C-q’ or ‘C-z’ on the other hand always exits all transients. If you -use the latter, then you can later resume the stack of transients using -‘M-x transient-resume’. - -‘C-g’ (‘transient-quit-seq’) -‘C-g’ (‘transient-quit-one’) - This key quits the currently active incomplete key sequence, if - any, or else the current transient. When quitting the current - transient, it returns to the previous transient, if any. - - Transient’s predecessor bound ‘q’ instead of ‘C-g’ to the quit -command. To learn how to get that binding back see -‘transient-bind-q-to-quit’’s documentation string. - -‘C-q’ (‘transient-quit-all’) - This command quits the currently active incomplete key sequence, if - any, and all transients, including the active transient and all - suspended transients, if any. - -‘C-z’ (‘transient-suspend’) - Like ‘transient-quit-all’, this command quits an incomplete key - sequence, if any, and all transients. Additionally, it saves the - stack of transients so that it can easily be resumed (which is - particularly useful if you quickly need to do “something else” and - the stack is deeper than a single transient, and/or you have - already changed the values of some infix arguments). - - Note that only a single stack of transients can be saved at a time. - If another stack is already saved, then saving a new stack discards - the previous stack. - -‘M-x transient-resume’ - This command resumes the previously suspended stack of transients, - if any. - - -File: transient.info, Node: Common Suffix Commands, Next: Saving Values, Prev: Aborting and Resuming Transients, Up: Usage - -2.3 Common Suffix Commands -========================== - -A few shared suffix commands are available in all transients. These -suffix commands are not shown in the popup buffer by default. - - This includes the aborting commands mentioned in the previous -section, as well as some other commands that are all bound to ‘C-x KEY’. -After ‘C-x’ is pressed, a section featuring all these common commands is -temporarily shown in the popup buffer. After invoking one of them, the -section disappears again. Note, however, that one of these commands is -described as “Show common permanently”; invoke that if you want the -common commands to always be shown for all transients. - -‘C-x t’ (‘transient-toggle-common’) - This command toggles whether the generic commands that are common - to all transients are always displayed or only after typing the - incomplete prefix key sequence ‘C-x’. This only affects the - current Emacs session. - - -- User Option: transient-show-common-commands - This option controls whether shared suffix commands are shown - alongside the transient-specific infix and suffix commands. By - default, the shared commands are not shown to avoid overwhelming - the user with too many options. - - While a transient is active, pressing ‘C-x’ always shows the common - commands. The value of this option can be changed for the current - Emacs session by typing ‘C-x t’ while a transient is active. - - The other common commands are described in either the previous or in -one of the following sections. - - Some of Transient’s key bindings differ from the respective bindings -of Magit-Popup; see *note FAQ:: for more information. - - -File: transient.info, Node: Saving Values, Next: Using History, Prev: Common Suffix Commands, Up: Usage - -2.4 Saving Values -================= - -After setting the infix arguments in a transient, the user can save -those arguments for future invocations. - - Most transients will start out with the saved arguments when they are -invoked. There are a few exceptions, though. Some transients are -designed so that the value that they use is stored externally as the -buffer-local value of some variable. Invoking such a transient again -uses the buffer-local value. (1) - - If the user does not save the value and just exits using a regular -suffix command, then the value is merely saved to the transient’s -history. That value won’t be used when the transient is next invoked, -but it is easily accessible (see *note Using History::). - -‘C-x s’ (‘transient-set’) - This command saves the value of the active transient for this Emacs - session. - -‘C-x C-s’ (‘transient-save’) - Save the value of the active transient persistently across Emacs - sessions. - -‘C-x C-k’ (‘transient-reset’) - Clear the set and saved values of the active transient. - - -- User Option: transient-values-file - This option names the file that is used to persist the values of - transients between Emacs sessions. - - ---------- Footnotes ---------- - - (1) ‘magit-diff’ and ‘magit-log’ are two prominent examples, and -their handling of buffer-local values is actually a bit more complicated -than outlined above and even customizable. - - -File: transient.info, Node: Using History, Next: Getting Help for Suffix Commands, Prev: Saving Values, Up: Usage - -2.5 Using History -================= - -Every time the user invokes a suffix command the transient’s current -value is saved to its history. These values can be cycled through the -same way one can cycle through the history of commands that read -user-input in the minibuffer. - -‘C-M-p’ (‘transient-history-prev’) -‘C-x p’ - This command switches to the previous value used for the active - transient. - -‘C-M-n’ (‘transient-history-next’) -‘C-x n’ - This command switches to the next value used for the active - transient. - - In addition to the transient-wide history, Transient of course -supports per-infix history. When an infix reads user-input using the -minibuffer, the user can use the regular minibuffer history commands to -cycle through previously used values. Usually the same keys as those -mentioned above are bound to those commands. - - Authors of transients should arrange for different infix commands -that read the same kind of value to also use the same history key (see -*note Suffix Slots::). - - Both kinds of history are saved to a file when Emacs is exited. - - -- User Option: transient-history-file - This option names the file that is used to persist the history of - transients and their infixes between Emacs sessions. - - -- User Option: transient-history-limit - This option controls how many history elements are kept at the time - the history is saved in ‘transient-history-file’. - - -File: transient.info, Node: Getting Help for Suffix Commands, Next: Enabling and Disabling Suffixes, Prev: Using History, Up: Usage - -2.6 Getting Help for Suffix Commands -==================================== - -Transients can have many suffixes and infixes that the user might not be -familiar with. To make it trivial to get help for these, Transient -provides access to the documentation directly from the active transient. - -‘C-h’ (‘transient-help’) - This command enters help mode. When help mode is active, typing a - key shows information about the suffix command that the key - normally is bound to (instead of invoking it). Pressing ‘C-h’ a - second time shows information about the _prefix_ command. - - After typing a key, the stack of transient states is suspended and - information about the suffix command is shown instead. Typing ‘q’ - in the help buffer buries that buffer and resumes the transient - state. - - What sort of documentation is shown depends on how the transient was -defined. For infix commands that represent command-line arguments this -ideally shows the appropriate manpage. ‘transient-help’ then tries to -jump to the correct location within that. Info manuals are also -supported. The fallback is to show the command’s documentation string, -for non-infix suffixes this is usually appropriate. - - -File: transient.info, Node: Enabling and Disabling Suffixes, Next: Other Commands, Prev: Getting Help for Suffix Commands, Up: Usage - -2.7 Enabling and Disabling Suffixes -=================================== - -The user base of a package that uses transients can be very diverse. -This is certainly the case for Magit; some users have been using it and -Git for a decade, while others are just getting started now. - - For that reason a mechanism is needed that authors can use to -classify a transient’s infixes and suffixes along the -essentials...everything spectrum. We use the term “levels” to describe -that mechanism. - - Each suffix command is placed on a level and each transient has a -level (called “transient-level”), which controls which suffix commands -are available. Integers between 1 and 7 (inclusive) are valid levels. -For suffixes, 0 is also valid; it means that the suffix is not displayed -at any level. - - The levels of individual transients and/or their individual suffixes -can be changed interactively, by invoking the transient and then -pressing ‘C-x l’ to enter the “edit” mode, see below. - - The default level for both transients and their suffixes is 4. The -‘transient-default-level’ option only controls the default for -transients. The default suffix level is always 4. The authors of -transients should place certain suffixes on a higher level, if they -expect that it won’t be of use to most users, and they should place very -important suffixes on a lower level, so that they remain available even -if the user lowers the transient level. - - -- User Option: transient-default-level - This option controls which suffix levels are made available by - default. It sets the transient-level for transients for which the - user has not set that individually. - - -- User Option: transient-levels-file - This option names the file that is used to persist the levels of - transients and their suffixes between Emacs sessions. - -‘C-x l’ (‘transient-set-level’) - This command enters edit mode. When edit mode is active, then all - infixes and suffixes that are currently usable are displayed along - with their levels. The colors of the levels indicate whether they - are enabled or not. The level of the transient is also displayed - along with some usage information. - - In edit mode, pressing the key that would usually invoke a certain - suffix instead prompts the user for the level that suffix should be - placed on. - - Help mode is available in edit mode. - - To change the transient level press ‘C-x l’ again. - - To exit edit mode press ‘C-g’. - - Note that edit mode does not display any suffixes that are not - currently usable. ‘magit-rebase’, for example, shows different - suffixes depending on whether a rebase is already in progress or - not. The predicates also apply in edit mode. - - Therefore, to control which suffixes are available given a certain - state, you have to make sure that that state is currently active. - -‘C-x a’ (‘transient-toggle-level-limit’) - This command toggle whether suffixes that are on levels higher than - the level specified by ‘transient-default-level’ are temporarily - available anyway. - - -File: transient.info, Node: Other Commands, Next: Configuration, Prev: Enabling and Disabling Suffixes, Up: Usage - -2.8 Other Commands -================== - -When invoking a transient in a small frame, the transient window may not -show the complete buffer, making it necessary to scroll, using the -following commands. These commands are never shown in the transient -window, and the key bindings are the same as for ‘scroll-up-command’ and -‘scroll-down-command’ in other buffers. - - -- Command: transient-scroll-up arg - This command scrolls text of transient popup window upward ARG - lines. If ARG is ‘nil’, then it scrolls near full screen. This is - a wrapper around ‘scroll-up-command’ (which see). - - -- Command: transient-scroll-down arg - This command scrolls text of transient popup window down ARG lines. - If ARG is ‘nil’, then it scrolls near full screen. This is a - wrapper around ‘scroll-down-command’ (which see). - - -File: transient.info, Node: Configuration, Prev: Other Commands, Up: Usage - -2.9 Configuration -================= - -More options are described in *note Common Suffix Commands::, in *note -Saving Values::, in *note Using History:: and in *note Enabling and -Disabling Suffixes::. - -Essential Options ------------------ - -Also see *note Common Suffix Commands::. - - -- User Option: transient-show-popup - This option controls whether the current transient’s infix and - suffix commands are shown in the popup buffer. - - • If ‘t’ (the default) then the popup buffer is shown as soon as - a transient prefix command is invoked. - - • If ‘nil’, then the popup buffer is not shown unless the user - explicitly requests it, by pressing an incomplete prefix key - sequence. - - • If a number, then the a brief one-line summary is shown - instead of the popup buffer. If zero or negative, then not - even that summary is shown; only the pressed key itself is - shown. - - The popup is shown when the user explicitly requests it by - pressing an incomplete prefix key sequence. Unless this is - zero, the popup is shown after that many seconds of inactivity - (using the absolute value). - - -- User Option: transient-enable-popup-navigation - This option controls whether navigation commands are enabled in the - transient popup buffer. - - While a transient is active the transient popup buffer is not the - current buffer, making it necessary to use dedicated commands to - act on that buffer itself. This is disabled by default. If this - option is non-‘nil’, then the following features are available: - - • ‘<UP>’ moves the cursor to the previous suffix. - • ‘<DOWN>’ moves the cursor to the next suffix. - • ‘<RET>’ invokes the suffix the cursor is on. - • ‘mouse-1’ invokes the clicked on suffix. - • ‘C-s’ and ‘C-r’ start isearch in the popup buffer. - - -- User Option: transient-display-buffer-action - This option specifies the action used to display the transient - popup buffer. The transient popup buffer is displayed in a window - using ‘(display-buffer BUFFER transient-display-buffer-action)’. - - The value of this option has the form ‘(FUNCTION . ALIST)’, where - FUNCTION is a function or a list of functions. Each such function - should accept two arguments: a buffer to display and an alist of - the same form as ALIST. See *note (elisp)Choosing Window::, for - details. - - The default is: - - (display-buffer-in-side-window - (side . bottom) - (inhibit-same-window . t) - (window-parameters (no-other-window . t))) - - This displays the window at the bottom of the selected frame. - Another useful FUNCTION is ‘display-buffer-below-selected’, which - is what ‘magit-popup’ used by default. For more alternatives see - *note (elisp)Buffer Display Action Functions::, and *note - (elisp)Buffer Display Action Alists::. - - Note that the buffer that was current before the transient buffer - is shown should remain the current buffer. Many suffix commands - act on the thing at point, if appropriate, and if the transient - buffer became the current buffer, then that would change what is at - point. To that effect ‘inhibit-same-window’ ensures that the - selected window is not used to show the transient buffer. - - It may be possible to display the window in another frame, but - whether that works in practice depends on the window-manager. If - the window manager selects the new window (Emacs frame), then that - unfortunately changes which buffer is current. - - If you change the value of this option, then you might also want to - change the value of ‘transient-mode-line-format’. - -Accessibility Options ---------------------- - - -- User Option: transient-force-single-column - This option controls whether the use of a single column to display - suffixes is enforced. This might be useful for users with low - vision who use large text and might otherwise have to scroll in two - dimensions. - -Auxiliary Options ------------------ - - -- User Option: transient-mode-line-format - This option controls whether the transient popup buffer has a - mode-line, separator line, or neither. - - If ‘nil’, then the buffer has no mode-line. If the buffer is not - displayed right above the echo area, then this probably is not a - good value. - - If ‘line’ (the default) or a natural number, then the buffer has no - mode-line, but a line is drawn is drawn in its place. If a number - is used, that specifies the thickness of the line. On termcap - frames we cannot draw lines, so there ‘line’ and numbers are - synonyms for ‘nil’. - - The color of the line is used to indicate if non-suffixes are - allowed and whether they exit the transient. The foreground color - of ‘transient-key-noop’ (if non-suffix are disallowed), - ‘transient-key-stay’ (if allowed and transient stays active), or - ‘transient-key-exit’ (if allowed and they exit the transient) is - used to draw the line. - - Otherwise this can be any mode-line format. See *note (elisp)Mode - Line Format::, for details. - - -- User Option: transient-semantic-coloring - This option controls whether colors are used to indicate the - transient behavior of commands. - - If non-‘nil’, then the key binding of each suffix is colorized to - indicate whether it exits the transient state or not. The color of - the prefix is indicated using the line that is drawn when the value - of ‘transient-mode-line-format’ is ‘line’. - - -- User Option: transient-highlight-mismatched-keys - This option controls whether key bindings of infix commands that do - not match the respective command-line argument should be - highlighted. For other infix commands this option has no effect. - - When this option is non-‘nil’, the key binding for an infix - argument is highlighted when only a long argument (e.g., - ‘--verbose’) is specified but no shorthand (e.g., ‘-v’). In the - rare case that a shorthand is specified but the key binding does - not match, then it is highlighted differently. - - Highlighting mismatched key bindings is useful when learning the - arguments of the underlying command-line tool; you wouldn’t want to - learn any short-hands that do not actually exist. - - The highlighting is done using one of the faces - ‘transient-mismatched-key’ and ‘transient-nonstandard-key’. - - -- User Option: transient-substitute-key-function - This function is used to modify key bindings. If the value of this - option is ‘nil’ (the default), then no substitution is performed. - - This function is called with one argument, the prefix object, and - must return a key binding description, either the existing key - description it finds in the ‘key’ slot, or the key description that - replaces the prefix key. It could be used to make other - substitutions, but that is discouraged. - - For example, ‘=’ is hard to reach using my custom keyboard layout, - so I substitute ‘(’ for that, which is easy to reach using a layout - optimized for lisp. - - (setq transient-substitute-key-function - (lambda (obj) - (let ((key (oref obj key))) - (if (string-match "\\`\\(=\\)[a-zA-Z]" key) - (replace-match "(" t t key 1) - key)))) - - -- User Option: transient-read-with-initial-input - This option controls whether the last history element is used as - the initial minibuffer input when reading the value of an infix - argument from the user. If ‘nil’, there is no initial input and - the first element has to be accessed the same way as the older - elements. - - -- User Option: transient-hide-during-minibuffer-read - This option controls whether the transient buffer is hidden while - user input is being read in the minibuffer. - - -- User Option: transient-align-variable-pitch - This option controls whether columns are aligned pixel-wise in the - popup buffer. - - If this is non-‘nil’, then columns are aligned pixel-wise to - support variable-pitch fonts. Keys are not aligned, so you should - use a fixed-pitch font for the ‘transient-key’ face. Other key - faces inherit from that face unless a theme is used that breaks - that relationship. - - This option is intended for users who use a variable-pitch font for - the ‘default’ face. - - -- User Option: transient-force-fixed-pitch - This option controls whether to force the use of a monospaced font - in popup buffer. Even if you use a proportional font for the - ‘default’ face, you might still want to use a monospaced font in - transient’s popup buffer. Setting this option to ‘t’ causes - ‘default’ to be remapped to ‘fixed-pitch’ in that buffer. - -Developer Options ------------------ - -These options are mainly intended for developers. - - -- User Option: transient-detect-key-conflicts - This option controls whether key binding conflicts should be - detected at the time the transient is invoked. If so, this results - in an error, which prevents the transient from being used. Because - of that, conflicts are ignored by default. - - Conflicts cannot be determined earlier, i.e., when the transient is - being defined and when new suffixes are being added, because at - that time there can be false-positives. It is actually valid for - multiple suffixes to share a common key binding, provided the - predicates of those suffixes prevent that more than one of them is - enabled at a time. - - -- User Option: transient-highlight-higher-levels - This option controls whether suffixes that would not be available - by default are highlighted. - - When non-‘nil’ then the descriptions of suffixes are highlighted if - their level is above 4, the default of ‘transient-default-level’. - Assuming you have set that variable to 7, this highlights all - suffixes that won’t be available to users without them making the - same customization. - - -File: transient.info, Node: Modifying Existing Transients, Next: Defining New Commands, Prev: Usage, Up: Top - -3 Modifying Existing Transients -******************************* - -To an extent, transients can be customized interactively, see *note -Enabling and Disabling Suffixes::. This section explains how existing -transients can be further modified non-interactively. Let’s begin with -an example: - - (transient-append-suffix 'magit-patch-apply "-3" - '("-R" "Apply in reverse" "--reverse")) - - This inserts a new infix argument to toggle the ‘--reverse’ argument -after the infix argument that toggles ‘-3’ in ‘magit-patch-apply’. - - The following functions share a few arguments: - - • PREFIX is a transient prefix command, a symbol. - - • SUFFIX is a transient infix or suffix specification in the same - form as expected by ‘transient-define-prefix’. Note that an infix - is a special kind of suffix. Depending on context “suffixes” means - “suffixes (including infixes)” or “non-infix suffixes”. Here it - means the former. See *note Suffix Specifications::. - - SUFFIX may also be a group in the same form as expected by - ‘transient-define-prefix’. See *note Group Specifications::. - - • LOC is a command, a key vector, a key description (a string as - returned by ‘key-description’), or a list specifying coordinates - (the last element may also be a command or key). For example ‘(1 0 - -1)’ identifies the last suffix (‘-1’) of the first subgroup (‘0’) - of the second group (‘1’). - - If LOC is a list of coordinates, then it can be used to identify a - group, not just an individual suffix command. - - The function ‘transient-get-suffix’ can be useful to determine - whether a certain coordination list identifies the suffix or group - that you expect it to identify. In hairy cases it may be necessary - to look at the definition of the transient prefix command. - - These functions operate on the information stored in the -‘transient--layout’ property of the PREFIX symbol. Suffix entries in -that tree are not objects but have the form ‘(LEVEL CLASS PLIST)’, where -PLIST should set at least ‘:key’, ‘:description’ and ‘:command’. - - -- Function: transient-insert-suffix prefix loc suffix &optional - keep-other - -- Function: transient-append-suffix prefix loc suffix &optional - keep-other - These functions insert the suffix or group SUFFIX into PREFIX - before or after LOC. - - Conceptually adding a binding to a transient prefix is similar to - adding a binding to a keymap, but this is complicated by the fact - that multiple suffix commands can be bound to the same key, - provided they are never active at the same time, see *note - Predicate Slots::. - - Unfortunately both false-positives and false-negatives are - possible. To deal with the former use non-‘nil’ KEEP-OTHER. To - deal with the latter remove the conflicting binding explicitly. - - -- Function: transient-replace-suffix prefix loc suffix - This function replaces the suffix or group at LOC in PREFIX with - suffix or group SUFFIX. - - -- Function: transient-remove-suffix prefix loc - This function removes the suffix or group at LOC in PREFIX. - - -- Function: transient-get-suffix prefix loc - This function returns the suffix or group at LOC in PREFIX. The - returned value has the form mentioned above. - - -- Function: transient-suffix-put prefix loc prop value - This function edits the suffix or group at LOC in PREFIX, by - setting the PROP of its plist to VALUE. - - Most of these functions do not signal an error if they cannot perform -the requested modification. The functions that insert new suffixes show -a warning if LOC cannot be found in PREFIX without signaling an error. -The reason for doing it like this is that establishing a key binding -(and that is what we essentially are trying to do here) should not -prevent the rest of the configuration from loading. Among these -functions only ‘transient-get-suffix’ and ‘transient-suffix-put’ may -signal an error. - - -File: transient.info, Node: Defining New Commands, Next: Classes and Methods, Prev: Modifying Existing Transients, Up: Top - -4 Defining New Commands -*********************** - -* Menu: - -* Technical Introduction:: -* Defining Transients:: -* Binding Suffix and Infix Commands:: -* Defining Suffix and Infix Commands:: -* Using Infix Arguments:: -* Transient State:: - - -File: transient.info, Node: Technical Introduction, Next: Defining Transients, Up: Defining New Commands - -4.1 Technical Introduction -========================== - -Taking inspiration from prefix keys and prefix arguments, Transient -implements a similar abstraction involving a prefix command, infix -arguments and suffix commands. - - When the user calls a transient prefix command, a transient -(temporary) keymap is activated, which binds the transient’s infix and -suffix commands, and functions that control the transient state are -added to ‘pre-command-hook’ and ‘post-command-hook’. The available -suffix and infix commands and their state are shown in a popup buffer -until the transient state is exited by invoking a suffix command. - - Calling an infix command causes its value to be changed. How that is -done depends on the type of the infix command. The simplest case is an -infix command that represents a command-line argument that does not take -a value. Invoking such an infix command causes the switch to be toggled -on or off. More complex infix commands may read a value from the user, -using the minibuffer. - - Calling a suffix command usually causes the transient to be exited; -the transient keymaps and hook functions are removed, the popup buffer -no longer shows information about the (no longer bound) suffix commands, -the values of some public global variables are set, while some internal -global variables are unset, and finally the command is actually called. -Suffix commands can also be configured to not exit the transient. - - A suffix command can, but does not have to, use the infix arguments -in much the same way any command can choose to use or ignore the prefix -arguments. For a suffix command that was invoked from a transient, the -variable ‘transient-current-suffixes’ and the function ‘transient-args’ -serve about the same purpose as the variables ‘prefix-arg’ and -‘current-prefix-arg’ do for any command that was called after the prefix -arguments have been set using a command such as ‘universal-argument’. - - Transient can be used to implement simple “command dispatchers”. The -main benefit then is that the user can see all the available commands in -a popup buffer, which can be thought of as a “menus”. That is useful by -itself because it frees the user from having to remember all the keys -that are valid after a certain prefix key or command. Magit’s -‘magit-dispatch’ (on ‘C-x M-g’) command is an example of using Transient -to merely implement a command dispatcher. - - In addition to that, Transient also allows users to interactively -pass arguments to commands. These arguments can be much more complex -than what is reasonable when using prefix arguments. There is a limit -to how many aspects of a command can be controlled using prefix -arguments. Furthermore, what a certain prefix argument means for -different commands can be completely different, and users have to read -documentation to learn and then commit to memory what a certain prefix -argument means to a certain command. - - Transient suffix commands, on the other hand, can accept dozens of -different arguments without the user having to remember anything. When -using Transient, one can call a command with arguments that are just as -complex as when calling the same function non-interactively from Lisp. - - Invoking a transient suffix command with arguments is similar to -invoking a command in a shell with command-line completion and history -enabled. One benefit of the Transient interface is that it remembers -history not only on a global level (“this command was invoked using -these arguments, and previously it was invoked using those other -arguments”), but also remembers the values of individual arguments -independently. See *note Using History::. - - After a transient prefix command is invoked, ‘C-h KEY’ can be used to -show the documentation for the infix or suffix command that ‘KEY’ is -bound to (see *note Getting Help for Suffix Commands::), and infixes and -suffixes can be removed from the transient using ‘C-x l KEY’. Infixes -and suffixes that are disabled by default can be enabled the same way. -See *note Enabling and Disabling Suffixes::. - - Transient ships with support for a few different types of specialized -infix commands. A command that sets a command line option, for example, -has different needs than a command that merely toggles a boolean flag. -Additionally, Transient provides abstractions for defining new types, -which the author of Transient did not anticipate (or didn’t get around -to implementing yet). - - Note that suffix commands also support regular prefix arguments. A -suffix command may even be called with both infix and prefix arguments -at the same time. If you invoke a command as a suffix of a transient -prefix command, but also want to pass prefix arguments to it, then first -invoke the prefix command, and only after doing that invoke the prefix -arguments, before finally invoking the suffix command. If you instead -began by providing the prefix arguments, then those would apply to the -prefix command, not the suffix command. Likewise, if you want to change -infix arguments before invoking a suffix command with prefix arguments, -then change the infix arguments before invoking the prefix arguments. -In other words, regular prefix arguments always apply to the next -command, and since transient prefix, infix and suffix commands are just -regular commands, the same applies to them. (Regular prefix keys behave -differently because they are not commands at all, instead they are just -incomplete key sequences, and those cannot be interrupted with prefix -commands.) - - -File: transient.info, Node: Defining Transients, Next: Binding Suffix and Infix Commands, Prev: Technical Introduction, Up: Defining New Commands - -4.2 Defining Transients -======================= - -A transient consists of a prefix command and at least one suffix -command, though usually a transient has several infix and suffix -commands. The below macro defines the transient prefix command *and* -binds the transient’s infix and suffix commands. In other words, it -defines the complete transient, not just the transient prefix command -that is used to invoke that transient. - - -- Macro: transient-define-prefix name arglist [docstring] [keyword - value]... group... [body...] - This macro defines NAME as a transient prefix command and binds the - transient’s infix and suffix commands. - - ARGLIST are the arguments that the prefix command takes. DOCSTRING - is the documentation string and is optional. - - These arguments can optionally be followed by keyword-value pairs. - Each key has to be a keyword symbol, either ‘:class’ or a keyword - argument supported by the constructor of that class. The - ‘transient-prefix’ class is used if the class is not specified - explicitly. - - GROUPs add key bindings for infix and suffix commands and specify - how these bindings are presented in the popup buffer. At least one - GROUP has to be specified. See *note Binding Suffix and Infix - Commands::. - - The BODY is optional. If it is omitted, then ARGLIST is ignored - and the function definition becomes: - - (lambda () - (interactive) - (transient-setup 'NAME)) - - If BODY is specified, then it must begin with an ‘interactive’ form - that matches ARGLIST, and it must call ‘transient-setup’. It may, - however, call that function only when some condition is satisfied. - - All transients have a (possibly ‘nil’) value, which is exported - when suffix commands are called, so that they can consume that - value. For some transients it might be necessary to have a sort of - secondary value, called a “scope”. Such a scope would usually be - set in the command’s ‘interactive’ form and has to be passed to the - setup function: - - (transient-setup 'NAME nil nil :scope SCOPE) - - For example, the scope of the ‘magit-branch-configure’ transient is - the branch whose variables are being configured. - - -File: transient.info, Node: Binding Suffix and Infix Commands, Next: Defining Suffix and Infix Commands, Prev: Defining Transients, Up: Defining New Commands - -4.3 Binding Suffix and Infix Commands -===================================== - -The macro ‘transient-define-prefix’ is used to define a transient. This -defines the actual transient prefix command (see *note Defining -Transients::) and adds the transient’s infix and suffix bindings, as -described below. - - Users and third-party packages can add additional bindings using -functions such as ‘transient-insert-suffix’ (see *note Modifying -Existing Transients::). These functions take a “suffix specification” -as one of their arguments, which has the same form as the specifications -used in ‘transient-define-prefix’. - -* Menu: - -* Group Specifications:: -* Suffix Specifications:: - - -File: transient.info, Node: Group Specifications, Next: Suffix Specifications, Up: Binding Suffix and Infix Commands - -4.3.1 Group Specifications --------------------------- - -The suffix and infix commands of a transient are organized in groups. -The grouping controls how the descriptions of the suffixes are outlined -visually but also makes it possible to set certain properties for a set -of suffixes. - - Several group classes exist, some of which organize suffixes in -subgroups. In most cases the class does not have to be specified -explicitly, but see *note Group Classes::. - - Groups are specified in the call to ‘transient-define-prefix’, using -vectors. Because groups are represented using vectors, we cannot use -square brackets to indicate an optional element and instead use curly -brackets to do the latter. - - Group specifications then have this form: - - [{LEVEL} {DESCRIPTION} {KEYWORD VALUE}... ELEMENT...] - - The LEVEL is optional and defaults to 4. See *note Enabling and -Disabling Suffixes::. - - The DESCRIPTION is optional. If present, it is used as the heading -of the group. - - The KEYWORD-VALUE pairs are optional. Each keyword has to be a -keyword symbol, either ‘:class’ or a keyword argument supported by the -constructor of that class. - - • One of these keywords, ‘:description’, is equivalent to specifying - DESCRIPTION at the very beginning of the vector. The - recommendation is to use ‘:description’ if some other keyword is - also used, for consistency, or DESCRIPTION otherwise, because it - looks better. - - • Likewise ‘:level’ is equivalent to LEVEL. - - • Other important keywords include the ‘:if...’ keywords. These - keywords control whether the group is available in a certain - situation. - - For example, one group of the ‘magit-rebase’ transient uses ‘:if - magit-rebase-in-progress-p’, which contains the suffixes that are - useful while rebase is already in progress; and another that uses - ‘:if-not magit-rebase-in-progress-p’, which contains the suffixes - that initiate a rebase. - - These predicates can also be used on individual suffixes and are - only documented once, see *note Predicate Slots::. - - • The value of ‘:hide’, if non-‘nil’, is a predicate that controls - whether the group is hidden by default. The key bindings for - suffixes of a hidden group should all use the same prefix key. - Pressing that prefix key should temporarily show the group and its - suffixes, which assumes that a predicate like this is used: - - (lambda () - (eq (car transient--redisplay-key) - ?\C-c)) ; the prefix key shared by all bindings - - • The value of ‘:setup-children’, if non-‘nil’, is a function that - takes one argument, a potentially list of children, and must return - a list of children or an empty list. This can either be used to - somehow transform the group’s children that were defined the normal - way, or to dynamically create the children from scratch. - - The returned children must have the same form as stored in the - prefix’s ‘transient--layout’ property, but it is often more - convenient to use the same form as understood by - ‘transient-define-prefix’, described below. If you use the latter - approach, you can use the ‘transient-parse-suffixes’ and - ‘transient-parse-suffix’ functions to transform them from the - convenient to the expected form. - - If you explicitly specify children and then transform them using - ‘:setup-chilren’, then the class of the group is determined as - usual, based on explicitly specified children. - - If you do not explicitly specify children and thus rely solely on - ‘:setup-children’, then you must specify the class using ‘:class’. - For backward compatibility, if you fail to do so, - ‘transient-column’ is used and a warning is displayed. This - warning will eventually be replaced with an error. - - • The boolean ‘:pad-keys’ argument controls whether keys of all - suffixes contained in a group are right padded, effectively - aligning the descriptions. - - The ELEMENTs are either all subgroups, or all suffixes and strings. -(At least currently no group type exists that would allow mixing -subgroups with commands at the same level, though in principle there is -nothing that prevents that.) - - If the ELEMENTs are not subgroups, then they can be a mixture of -lists, which specify commands, and strings. Strings are inserted -verbatim into the buffer. The empty string can be used to insert gaps -between suffixes, which is particularly useful if the suffixes are -outlined as a table. - - Inside group specifications, including inside contained suffix -specifications, nothing has to be quoted and quoting anyway is invalid. -The value following a keyword, can be explicitly unquoted using ‘,’. -This feature is experimental and should be avoided. - - The form of suffix specifications is documented in the next node. - - -File: transient.info, Node: Suffix Specifications, Prev: Group Specifications, Up: Binding Suffix and Infix Commands - -4.3.2 Suffix Specifications ---------------------------- - -A transient’s suffix and infix commands are bound when the transient -prefix command is defined using ‘transient-define-prefix’, see *note -Defining Transients::. The commands are organized into groups, see -*note Group Specifications::. Here we describe the form used to bind an -individual suffix command. - - The same form is also used when later binding additional commands -using functions such as ‘transient-insert-suffix’, see *note Modifying -Existing Transients::. - - Note that an infix is a special kind of suffix. Depending on context -“suffixes” means “suffixes (including infixes)” or “non-infix suffixes”. -Here it means the former. - - Suffix specifications have this form: - - ([LEVEL] [KEY [DESCRIPTION]] COMMAND|ARGUMENT [KEYWORD VALUE]...) - - LEVEL, KEY and DESCRIPTION can also be specified using the KEYWORDs -‘:level’, ‘:key’ and ‘:description’. If the object that is associated -with COMMAND sets these properties, then they do not have to be -specified here. You can however specify them here anyway, possibly -overriding the object’s values just for the binding inside this -transient. - - • LEVEL is the suffix level, an integer between 1 and 7. See *note - Enabling and Disabling Suffixes::. - - • KEY is the key binding, either a vector or key description string. - - • DESCRIPTION is the description, either a string or a function that - takes zero or one arguments (the suffix object) and returns a - string. The function should be a lambda expression to avoid - ambiguity. In some cases a symbol that is bound as a function - would also work but to be safe you should use ‘:description’ in - that case. - - The next element is either a command or an argument. This is the -only argument that is mandatory in all cases. - - • COMMAND should be a symbol that is bound as a function, which has - to be defined or at least autoloaded as a command by the time the - containing prefix command is invoked. - - Any command will do; it does not need to have an object associated - with it (as would be the case if ‘transient-define-suffix’ or - ‘transient-define-infix’ were used to define it). - - COMMAND can also be a ‘lambda’ expression. - - As mentioned above, the object that is associated with a command - can be used to set the default for certain values that otherwise - have to be set in the suffix specification. Therefore if there is - no object, then you have to make sure to specify the KEY and the - DESCRIPTION. - - As a special case, if you want to add a command that might be - neither defined nor autoloaded, you can use a workaround like: - - (transient-insert-suffix 'some-prefix "k" - '("!" "Ceci n'est pas une commande" no-command - :if (lambda () (featurep 'no-library)))) - - Instead of ‘featurep’ you could also use ‘require’ with a non-‘nil’ - value for NOERROR. - - • The mandatory argument can also be a command-line argument, a - string. In that case an anonymous command is defined and bound. - - Instead of a string, this can also be a list of two strings, in - which case the first string is used as the short argument (which - can also be specified using ‘:shortarg’) and the second as the long - argument (which can also be specified using ‘:argument’). - - Only the long argument is displayed in the popup buffer. See - ‘transient-detect-key-conflicts’ for how the short argument may be - used. - - Unless the class is specified explicitly, the appropriate class is - guessed based on the long argument. If the argument ends with ‘=’ - (e.g., ‘--format=’) then ‘transient-option’ is used, otherwise - ‘transient-switch’. - - Finally, details can be specified using optional KEYWORD-VALUE pairs. -Each keyword has to be a keyword symbol, either ‘:class’ or a keyword -argument supported by the constructor of that class. See *note Suffix -Slots::. - - -File: transient.info, Node: Defining Suffix and Infix Commands, Next: Using Infix Arguments, Prev: Binding Suffix and Infix Commands, Up: Defining New Commands - -4.4 Defining Suffix and Infix Commands -====================================== - -Note that an infix is a special kind of suffix. Depending on context -“suffixes” means “suffixes (including infixes)” or “non-infix suffixes”. - - -- Macro: transient-define-suffix name arglist [docstring] [keyword - value]... body... - This macro defines NAME as a transient suffix command. - - ARGLIST are the arguments that the command takes. DOCSTRING is the - documentation string and is optional. - - These arguments can optionally be followed by keyword-value pairs. - Each keyword has to be a keyword symbol, either ‘:class’ or a - keyword argument supported by the constructor of that class. The - ‘transient-suffix’ class is used if the class is not specified - explicitly. - - The BODY must begin with an ‘interactive’ form that matches - ARGLIST. The infix arguments are usually accessed by using - ‘transient-args’ inside ‘interactive’. - - -- Macro: transient-define-infix name arglist [docstring] [keyword - value]... - This macro defines NAME as a transient infix command. - - ARGLIST is always ignored (but mandatory never-the-less) and - reserved for future use. DOCSTRING is the documentation string and - is optional. - - At least one key-value pair is required. All transient infix - commands are ‘equal’ to each other (but not ‘eq’). It is - meaningless to define an infix command, without providing at least - one keyword argument (usually ‘:argument’ or ‘:variable’, depending - on the class). The suffix class defaults to ‘transient-switch’ and - can be set using the ‘:class’ keyword. - - The function definition is always: - - (lambda () - (interactive) - (let ((obj (transient-suffix-object))) - (transient-infix-set obj (transient-infix-read obj))) - (transient--show)) - - ‘transient-infix-read’ and ‘transient-infix-set’ are generic - functions. Different infix commands behave differently because the - concrete methods are different for different infix command classes. - In rare cases the above command function might not be suitable, - even if you define your own infix command class. In that case you - have to use ‘transient-define-suffix’ to define the infix command - and use ‘t’ as the value of the ‘:transient’ keyword. - - -- Macro: transient-define-argument name arglist [docstring] [keyword - value]... - This macro defines NAME as a transient infix command. - - This is an alias for ‘transient-define-infix’. Only use this alias - to define an infix command that actually sets an infix argument. - To define an infix command that, for example, sets a variable, use - ‘transient-define-infix’ instead. - - -File: transient.info, Node: Using Infix Arguments, Next: Transient State, Prev: Defining Suffix and Infix Commands, Up: Defining New Commands - -4.5 Using Infix Arguments -========================= - -The functions and the variables described below allow suffix commands to -access the value of the transient from which they were invoked; which is -the value of its infix arguments. These variables are set when the user -invokes a suffix command that exits the transient, but before actually -calling the command. - - When returning to the command-loop after calling the suffix command, -the arguments are reset to ‘nil’ (which causes the function to return -‘nil’ too). - - Like for Emacs’ prefix arguments, it is advisable, but not mandatory, -to access the infix arguments inside the command’s ‘interactive’ form. -The preferred way of doing that is to call the ‘transient-args’ -function, which for infix arguments serves about the same purpose as -‘prefix-arg’ serves for prefix arguments. - - -- Function: transient-args prefix - This function returns the value of the transient prefix command - PREFIX. - - If the current command was invoked from the transient prefix - command PREFIX, then it returns the active infix arguments. If the - current command was not invoked from PREFIX, then it returns the - set, saved or default value for PREFIX. - - -- Function: transient-arg-value arg args - This function return the value of ARG as it appears in ARGS. - - For a switch a boolean is returned. For an option the value is - returned as a string, using the empty string for the empty value, - or ‘nil’ if the option does not appear in ARGS. - - -- Function: transient-suffixes prefix - This function returns the suffixes of the transient prefix command - PREFIX. This is a list of objects. This function should only be - used if you need the objects (as opposed to just their values) and - if the current command is not being invoked from PREFIX. - - -- Variable: transient-current-suffixes - The suffixes of the transient from which this suffix command was - invoked. This is a list of objects. Usually it is sufficient to - instead use the function ‘transient-args’, which returns a list of - values. In complex cases it might be necessary to use this - variable instead, i.e., if you need access to information beside - the value. - - -- Variable: transient-current-prefix - The transient from which this suffix command was invoked. The - returned value is a ‘transient-prefix’ object, which holds - information associated with the transient prefix command. - - -- Variable: transient-current-command - The transient from which this suffix command was invoked. The - returned value is a symbol, the transient prefix command. - - -File: transient.info, Node: Transient State, Prev: Using Infix Arguments, Up: Defining New Commands - -4.6 Transient State -=================== - -Invoking a transient prefix command “activates” the respective -transient, i.e., it puts a transient keymap into effect, which binds the -transient’s infix and suffix commands. - - The default behavior while a transient is active is as follows: - - • Invoking an infix command does not affect the transient state; the - transient remains active. - - • Invoking a (non-infix) suffix command “deactivates” the transient - state by removing the transient keymap and performing some - additional cleanup. - - • Invoking a command that is bound in a keymap other than the - transient keymap is disallowed and trying to do so results in a - warning. This does not “deactivate” the transient. - - The behavior can be changed for all suffixes of a particular prefix -and/or for individual suffixes. The values should nearly always be -booleans, but certain functions, called “pre-commands”, can also be -used. These functions are named ‘transient--do-VERB’, and the symbol -‘VERB’ can be used as a shorthand. - - A boolean is interpreted as answering the question "does the -transient stay active, when this command is invoked?" ‘t’ means that -the transient stays active, while ‘nil’ means that invoking the command -exits the transient. - - Note that when the suffix is a “sub-prefix”, invoking that command -always activates that sub-prefix, causing the outer prefix to no longer -be active and displayed. Here ‘t’ means that when you exit the inner -prefix, then the outer prefix becomes active again, while ‘nil’ means -that all outer prefixes are exited at once. - - • The behavior for non-suffixes can be set for a particular prefix, - by the prefix’s ‘transient-non-suffix’ slot to a boolean, a - suitable pre-command function, or a shorthand for such a function. - See *note Pre-commands for Non-Suffixes::. - - • The common behavior for the suffixes of a particular prefix can be - set using the prefix’s ‘transient-suffixes’ slot. - - The value specified in this slot does *not* affect infixes. - Because it affects both regular suffixes as well as sub-prefixes, - which have different needs, it is best to avoid explicitly - specifying a function. - - • The behavior of an individual suffix can be changed using its - ‘transient’ slot. While it is usually best to use a boolean, for - this slot it can occasionally make sense to specify a function - explicitly. - - Note that this slot can be set when defining a suffix command using - ‘transient-define-suffix’ and/or in the definition of the prefix. - If set in both places, then the latter takes precedence, as usual. - - The available pre-command functions are documented in the following -sub-sections. They are called by ‘transient--pre-command’, a function -on ‘pre-command-hook’, and the value that they return determines whether -the transient is exited. To do so the value of one of the constants -‘transient--exit’ or ‘transient--stay’ is used (that way we don’t have -to remember if ‘t’ means “exit” or “stay”). - - Additionally, these functions may change the value of ‘this-command’ -(which explains why they have to be called using ‘pre-command-hook’), -call ‘transient-export’, ‘transient--stack-zap’ or -‘transient--stack-push’; and set the values of ‘transient--exitp’, -‘transient--helpp’ or ‘transient--editp’. - - For completeness sake, some notes about complications: - - • The transient-ness of certain built-in suffix commands is specified - using ‘transient-predicate-map’. This is a special keymap, which - binds commands to pre-commands (as opposed to keys to commands) and - takes precedence over the prefix’s ‘transient-suffix’ slot, but not - the suffix’s ‘transient’ slot. - - • While a sub-prefix is active we nearly always want ‘C-g’ to take - the user back to the “super-prefix”, even when the other suffixes - don’t do that. However, in rare cases this may not be desirable, - and that makes the following complication necessary: - - For ‘transient-suffix’ objects the ‘transient’ slot is unbound. We - can ignore that for the most part because ‘nil’ and the slot being - unbound are treated as equivalent, and mean “do exit”. That isn’t - actually true for suffixes that are sub-prefixes though. For such - suffixes unbound means “do exit but allow going back”, which is the - default, while ‘nil’ means “do exit permanently”, which requires - that slot to be explicitly set to that value. - -Pre-commands for Infixes ------------------------- - -The default for infixes is ‘transient--do-stay’. This is also the only -function that makes sense for infixes, which is why this predicate is -used even if the value of the prefix’s ‘transient-suffix’ slot is ‘t’. -In extremely rare cases, one might want to use something else, which can -be done by setting the infix’s ‘transient’ slot directly. - - -- Function: transient--do-stay - Call the command without exporting variables and stay transient. - -Pre-commands for Suffixes -------------------------- - -By default, invoking a suffix causes the transient to be exited. - - The behavior for an individual suffix command can be changed by -setting its ‘transient’ slot to a boolean (which is highly recommended), -or to one of the following pre-commands. - - -- Function: transient--do-exit - Call the command after exporting variables and exit the transient. - - -- Function: transient--do-return - Call the command after exporting variables and return to the parent - prefix. If there is no parent prefix, then call - ‘transient--do-exit’. - - -- Function: transient--do-call - Call the command after exporting variables and stay transient. - - The following pre-commands are only suitable for sub-prefixes. It is -not necessary to explicitly use these predicates because the correct -predicate is automatically picked based on the value of the ‘transient’ -slot for the sub-prefix itself. - - -- Function: transient--do-recurse - Call the transient prefix command, preparing for return to active - transient. - - Whether we actually return to the parent transient is ultimately - under the control of each invoked suffix. The difference between - this pre-command and ‘transient--do-stack’ is that it changes the - value of the ‘transient-suffix’ slot to ‘t’. - - If there is no parent transient, then only call this command and - skip the second step. - - -- Function: transient--do-stack - Call the transient prefix command, stacking the active transient. - Push the active transient to the transient stack. - - Unless ‘transient--do-recurse’ is explicitly used, this pre-command - is automatically used for suffixes that are prefixes themselves, - i.e., for sub-prefixes. - - -- Function: transient--do-replace - Call the transient prefix command, replacing the active transient. - Do not push the active transient to the transient stack. - - Unless ‘transient--do-recurse’ is explicitly used, this pre-command - is automatically used for suffixes that are prefixes themselves, - i.e., for sub-prefixes. - - -- Function: transient--do-suspend - Suspend the active transient, saving the transient stack. - - This is used by the command ‘transient-suspend’ and optionally also - by “external events” such as ‘handle-switch-frame’. Such bindings - should be added to ‘transient-predicate-map’. - -Pre-commands for Non-Suffixes ------------------------------ - -By default, non-suffixes (commands that are bound in other keymaps -beside the transient keymap) cannot be invoked. Trying to invoke such a -command results in a warning and the transient stays active. - - If you want a different behavior, then set the ‘transient-non-suffix’ -slot of the transient prefix command. The value should be a boolean, -answering the question, "is it allowed to invoke non-suffix commands?, a -pre-command function, or a shorthand for such a function. - - If the value is ‘t’, then non-suffixes can be invoked, when it is -‘nil’ (the default) then they cannot be invoked. - - The only other recommended value is ‘leave’. If that is used, then -non-suffixes can be invoked, but if one is invoked, then that exits the -transient. - - -- Function: transient--do-warn - Call ‘transient-undefined’ and stay transient. - - -- Function: transient--do-stay - Call the command without exporting variables and stay transient. - - -- Function: transient--do-leave - Call the command without exporting variables and exit the - transient. - -Special Pre-Commands --------------------- - - -- Function: transient--do-quit-one - If active, quit help or edit mode, else exit the active transient. - - This is used when the user pressed ‘C-g’. - - -- Function: transient--do-quit-all - Exit all transients without saving the transient stack. - - This is used when the user pressed ‘C-q’. - - -- Function: transient--do-suspend - Suspend the active transient, saving the transient stack. - - This is used when the user pressed ‘C-z’. - - -File: transient.info, Node: Classes and Methods, Next: FAQ, Prev: Defining New Commands, Up: Top - -5 Classes and Methods -********************* - -Transient uses classes and generic functions to make it possible to -define new types of suffix commands that are similar to existing types, -but behave differently in some aspects. It does the same for groups and -prefix commands, though at least for prefix commands that *currently* -appears to be less important. - - Every prefix, infix and suffix command is associated with an object, -which holds information that controls certain aspects of its behavior. -This happens in two ways. - - • Associating a command with a certain class gives the command a - type. This makes it possible to use generic functions to do - certain things that have to be done differently depending on what - type of command it acts on. - - That in turn makes it possible for third-parties to add new types - without having to convince the maintainer of Transient that that - new type is important enough to justify adding a special case to a - dozen or so functions. - - • Associating a command with an object makes it possible to easily - store information that is specific to that particular command. - - Two commands may have the same type, but obviously their key - bindings and descriptions still have to be different, for example. - - The values of some slots are functions. The ‘reader’ slot for - example holds a function that is used to read a new value for an - infix command. The values of such slots are regular functions. - - Generic functions are used when a function should do something - different based on the type of the command, i.e., when all commands - of a certain type should behave the same way but different from the - behavior for other types. Object slots that hold a regular - function as value are used when the task that they perform is - likely to differ even between different commands of the same type. - -* Menu: - -* Group Classes:: -* Group Methods:: -* Prefix Classes:: -* Suffix Classes:: -* Suffix Methods:: -* Prefix Slots:: -* Suffix Slots:: -* Predicate Slots:: - - -File: transient.info, Node: Group Classes, Next: Group Methods, Up: Classes and Methods - -5.1 Group Classes -================= - -The type of a group can be specified using the ‘:class’ property at the -beginning of the class specification, e.g., ‘[:class transient-columns -...]’ in a call to ‘transient-define-prefix’. - - • The abstract ‘transient-child’ class is the base class of both - ‘transient-group’ (and therefore all groups) as well as of - ‘transient-suffix’ (and therefore all suffix and infix commands). - - This class exists because the elements (or “children”) of certain - groups can be other groups instead of suffix and infix commands. - - • The abstract ‘transient-group’ class is the superclass of all other - group classes. - - • The ‘transient-column’ class is the simplest group. - - This is the default “flat” group. If the class is not specified - explicitly and the first element is not a vector (i.e., not a - group), then this class is used. - - This class displays each element on a separate line. - - • The ‘transient-row’ class displays all elements on a single line. - - • The ‘transient-columns’ class displays commands organized in - columns. - - Direct elements have to be groups whose elements have to be - commands or strings. Each subgroup represents a column. This - class takes care of inserting the subgroups’ elements. - - This is the default “nested” group. If the class is not specified - explicitly and the first element is a vector (i.e., a group), then - this class is used. - - • The ‘transient-subgroups’ class wraps other groups. - - Direct elements have to be groups whose elements have to be - commands or strings. This group inserts an empty line between - subgroups. The subgroups themselves are responsible for displaying - their elements. - - -File: transient.info, Node: Group Methods, Next: Prefix Classes, Prev: Group Classes, Up: Classes and Methods - -5.2 Group Methods -================= - - -- Function: transient-setup-children group children - This generic function can be used to setup the children or a group. - - The default implementation usually just returns the children - unchanged, but if the ‘setup-children’ slot of GROUP is non-‘nil’, - then it calls that function with CHILDREN as the only argument and - returns the value. - - The children are given as a (potentially empty) list consisting of - either group or suffix specifications. These functions can make - arbitrary changes to the children including constructing new - children from scratch. - - -- Function: transient--insert-group group - This generic function formats the group and its elements and - inserts the result into the current buffer, which is a temporary - buffer. The contents of that buffer are later inserted into the - popup buffer. - - Functions that are called by this function may need to operate in - the buffer from which the transient was called. To do so they can - temporarily make the ‘transient--source-buffer’ the current buffer. - - -File: transient.info, Node: Prefix Classes, Next: Suffix Classes, Prev: Group Methods, Up: Classes and Methods - -5.3 Prefix Classes -================== - -Currently the ‘transient-prefix’ class is being used for all prefix -commands and there is only a single generic function that can be -specialized based on the class of a prefix command. - - -- Function: transient--history-init obj - This generic function is called while setting up the transient and - is responsible for initializing the ‘history’ slot. This is the - transient-wide history; many individual infixes also have a history - of their own. - - The default (and currently only) method extracts the value from the - global variable ‘transient-history’. - - A transient prefix command’s object is stored in the -‘transient--prefix’ property of the command symbol. While a transient -is active, a clone of that object is stored in the variable -‘transient--prefix’. A clone is used because some changes that are made -to the active transient’s object should not affect later invocations. - - -File: transient.info, Node: Suffix Classes, Next: Suffix Methods, Prev: Prefix Classes, Up: Classes and Methods - -5.4 Suffix Classes -================== - - • All suffix and infix classes derive from ‘transient-suffix’, which - in turn derives from ‘transient-child’, from which - ‘transient-group’ also derives (see *note Group Classes::). - - • All infix classes derive from the abstract ‘transient-infix’ class, - which in turn derives from the ‘transient-suffix’ class. - - Infixes are a special type of suffixes. The primary difference is - that infixes always use the ‘transient--do-stay’ pre-command, while - non-infix suffixes use a variety of pre-commands (see *note - Transient State::). Doing that is most easily achieved by using - this class, though theoretically it would be possible to define an - infix class that does not do so. If you do that then you get to - implement many methods. - - Also, infixes and non-infix suffixes are usually defined using - different macros (see *note Defining Suffix and Infix Commands::). - - • Classes used for infix commands that represent arguments should be - derived from the abstract ‘transient-argument’ class. - - • The ‘transient-switch’ class (or a derived class) is used for infix - arguments that represent command-line switches (arguments that do - not take a value). - - • The ‘transient-option’ class (or a derived class) is used for infix - arguments that represent command-line options (arguments that do - take a value). - - • The ‘transient-switches’ class can be used for a set of mutually - exclusive command-line switches. - - • The ‘transient-files’ class can be used for a ‘--’ argument that - indicates that all remaining arguments are files. - - • Classes used for infix commands that represent variables should - derived from the abstract ‘transient-variable’ class. - - • The ‘transient-information’ class is special in that suffixes that - use this class are not associated with a command and thus also not - with any key binding. Such suffixes are only used to display - arbitrary information, and that anywhere a suffix can appear. - Display-only suffix specifications take this form: - - ([LEVEL] :info DESCRIPTION [KEYWORD VALUE]...) - - The ‘:info’ keyword argument replaces the ‘:description’ keyword - used for other suffix classes. Other keyword arguments that you - might want to set, include ‘:face’, predicate keywords (such as - ‘:if’), and ‘:format’. By default the value of ‘:format’ includes - ‘%k’, which for this class is replaced with the empty string or - spaces, if keys are being padded in the containing group. - - Magit defines additional classes, which can serve as examples for the -fancy things you can do without modifying Transient. Some of these -classes will likely get generalized and added to Transient. For now -they are very much subject to change and not documented. - - -File: transient.info, Node: Suffix Methods, Next: Prefix Slots, Prev: Suffix Classes, Up: Classes and Methods - -5.5 Suffix Methods -================== - -To get information about the methods implementing these generic -functions use ‘describe-function’. - -* Menu: - -* Suffix Value Methods:: -* Suffix Format Methods:: - - -File: transient.info, Node: Suffix Value Methods, Next: Suffix Format Methods, Up: Suffix Methods - -5.5.1 Suffix Value Methods --------------------------- - - -- Function: transient-init-value obj - This generic function sets the initial value of the object OBJ. - - This function is called for all suffix commands, but unless a - concrete method is implemented this falls through to the default - implementation, which is a noop. In other words this usually only - does something for infix commands, but note that this is not - implemented for the abstract class ‘transient-infix’, so if your - class derives from that directly, then you must implement a method. - - -- Function: transient-infix-read obj - This generic function determines the new value of the infix object - OBJ. - - This function merely determines the value; ‘transient-infix-set’ is - used to actually store the new value in the object. - - For most infix classes this is done by reading a value from the - user using the reader specified by the ‘reader’ slot (using the - ‘transient-infix-value’ method described below). - - For some infix classes the value is changed without reading - anything in the minibuffer, i.e., the mere act of invoking the - infix command determines what the new value should be, based on the - previous value. - - -- Function: transient-prompt obj - This generic function returns the prompt to be used to read infix - object OBJ’s value. - - -- Function: transient-infix-set obj value - This generic function sets the value of infix object OBJ to VALUE. - - -- Function: transient-infix-value obj - This generic function returns the value of the suffix object OBJ. - - This function is called by ‘transient-args’ (which see), meaning - this function is how the value of a transient is determined so that - the invoked suffix command can use it. - - Currently most values are strings, but that is not set in stone. - ‘nil’ is not a value, it means “no value”. - - Usually only infixes have a value, but see the method for - ‘transient-suffix’. - - -- Function: transient-init-scope obj - This generic function sets the scope of the suffix object OBJ. - - The scope is actually a property of the transient prefix, not of - individual suffixes. However it is possible to invoke a suffix - command directly instead of from a transient. In that case, if the - suffix expects a scope, then it has to determine that itself and - store it in its ‘scope’ slot. - - This function is called for all suffix commands, but unless a - concrete method is implemented this falls through to the default - implementation, which is a noop. - - -File: transient.info, Node: Suffix Format Methods, Prev: Suffix Value Methods, Up: Suffix Methods - -5.5.2 Suffix Format Methods ---------------------------- - - -- Function: transient-format obj - This generic function formats and returns OBJ for display. - - When this function is called, then the current buffer is some - temporary buffer. If you need the buffer from which the prefix - command was invoked to be current, then do so by temporarily making - ‘transient--source-buffer’ current. - - -- Function: transient-format-key obj - This generic function formats OBJ’s ‘key’ for display and returns - the result. - - -- Function: transient-format-description obj - This generic function formats OBJ’s ‘description’ for display and - returns the result. - - -- Function: transient-format-value obj - This generic function formats OBJ’s value for display and returns - the result. - - -- Function: transient-show-help obj - Show help for the prefix, infix or suffix command represented by - OBJ. - - For prefixes, show the info manual, if that is specified using the - ‘info-manual’ slot. Otherwise, show the manpage if that is - specified using the ‘man-page’ slot. Otherwise, show the command’s - documentation string. - - For suffixes, show the command’s documentation string. - - For infixes, show the manpage if that is specified. Otherwise show - the command’s documentation string. - - -File: transient.info, Node: Prefix Slots, Next: Suffix Slots, Prev: Suffix Methods, Up: Classes and Methods - -5.6 Prefix Slots -================ - - • ‘show-help’, ‘man-page’ or ‘info-manual’ can be used to specify the - documentation for the prefix and its suffixes. The command - ‘transient-help’ uses the method ‘transient-show-help’ (which see) - to lookup and use these values. - - • ‘history-key’ If multiple prefix commands should share a single - value, then this slot has to be set to the same value for all of - them. You probably don’t want that. - - • ‘transient-suffix’ and ‘transient-non-suffix’ play a part when - determining whether the currently active transient prefix command - remains active/transient when a suffix or arbitrary non-suffix - command is invoked. See *note Transient State::. - - • ‘refresh-suffixes’ Normally suffix objects and keymaps are only - setup once, when the prefix is invoked. Setting this to ‘t’, - causes them to be recreated after every command. This is useful - when using ‘:if...’ predicates, and those need to be rerun for some - reason. Doing this is somewhat costly, and there is a risk of - losing state, so this is disabled by default and still considered - experimental. - - • ‘incompatible’ A list of lists. Each sub-list specifies a set of - mutually exclusive arguments. Enabling one of these arguments - causes the others to be disabled. An argument may appear in - multiple sub-lists. Arguments must me given in the same form as - used in the ‘argument’ or ‘argument-format’ slot of the respective - suffix objects, usually something like ‘--switch’ or ‘--option=%s’. - For options and ‘transient-switches’ suffixes it is also possible - to match against a specific value, as returned by - ‘transient-infix-value’, for example, ‘--option=one’. - - • ‘scope’ For some transients it might be necessary to have a sort of - secondary value, called a “scope”. See ‘transient-define-prefix’. - -Internal Prefix Slots ---------------------- - -These slots are mostly intended for internal use. They should not be -set in calls to ‘transient-define-prefix’. - - • ‘prototype’ When a transient prefix command is invoked, then a - clone of that object is stored in the global variable - ‘transient--prefix’ and the prototype is stored in the clone’s - ‘prototype’ slot. - - • ‘command’ The command, a symbol. Each transient prefix command - consists of a command, which is stored in a symbol’s function slot - and an object, which is stored in the ‘transient--prefix’ property - of the same symbol. - - • ‘level’ The level of the prefix commands. The suffix commands - whose layer is equal or lower are displayed. See *note Enabling - and Disabling Suffixes::. - - • ‘value’ The likely outdated value of the prefix. Instead of - accessing this slot directly you should use the function - ‘transient-get-value’, which is guaranteed to return the up-to-date - value. - - • ‘history’ and ‘history-pos’ are used to keep track of historic - values. Unless you implement your own ‘transient-infix-read’ - method you should not have to deal with these slots. - - -File: transient.info, Node: Suffix Slots, Next: Predicate Slots, Prev: Prefix Slots, Up: Classes and Methods - -5.7 Suffix Slots -================ - -Here we document most of the slots that are only available for suffix -objects. Some slots are shared by suffix and group objects, they are -documented in *note Predicate Slots::. - - Also see *note Suffix Classes::. - -Slots of ‘transient-suffix’ ---------------------------- - - • ‘key’ The key, a key vector or a key description string. - - • ‘command’ The command, a symbol. - - • ‘transient’ Whether to stay transient. See *note Transient - State::. - - • ‘format’ The format used to display the suffix in the popup buffer. - It must contain the following %-placeholders: - - • ‘%k’ For the key. - • ‘%d’ For the description. - • ‘%v’ For the infix value. Non-infix suffixes don’t have a - value. - - • ‘description’ The description, either a string or a function, which - is called with zero or one argument (the suffix object), and - returns a string. - - • ‘face’ Face used for the description. In simple cases it is easier - to use this instead of using a function as ‘description’ and adding - the styling there. ‘face’ is appended using - ‘add-face-text-property’. - - • ‘show-help’ A function used to display help for the suffix. If - unspecified, the prefix controls how help is displayed for its - suffixes. - -Slots of ‘transient-infix’ --------------------------- - -Some of these slots are only meaningful for some of the subclasses. -They are defined here anyway to allow sharing certain methods. - - • ‘argument’ The long argument, e.g., ‘--verbose’. - - • ‘shortarg’ The short argument, e.g., ‘-v’. - - • ‘value’ The value. Should not be accessed directly. - - • ‘init-value’ Function that is responsible for setting the object’s - value. If bound, then this is called with the object as the only - argument. Usually this is not bound, in which case the object’s - primary ‘transient-init-value’ method is called instead. - - • ‘unsavable’ Whether the value of the suffix is not saved as part of - the prefixes. - - • ‘multi-value’ For options, whether the option can have multiple - values. If this is non-‘nil’, then the values are read using - ‘completing-read-multiple’ by default and if you specify your own - reader, then it should read the values using that function or - similar. - - Supported non-‘nil’ values are: - - • Use ‘rest’ for an option that can have multiple values. This - is useful e.g., for an ‘--’ argument that indicates that all - remaining arguments are files (such as ‘git log -- file1 - file2’). - - In the list returned by ‘transient-args’ such an option and - its values are represented by a single list of the form - ‘(ARGUMENT . VALUES)’. - - • Use ‘repeat’ for an option that can be specified multiple - times. - - In the list returned by ‘transient-args’ each instance of the - option and its value appears separately in the usual from, for - example: ‘("--another-argument" "--option=first" - "--option=second")’. - - In both cases the option’s values have to be specified in the - default value of a prefix using the same format as returned by - ‘transient-args’, e.g., ‘("--other" "--o=1" "--o=2" ("--" "f1" - "f2"))’. - - • ‘always-read’ For options, whether to read a value on every - invocation. If this is ‘nil’, then options that have a value are - simply unset and have to be invoked a second time to set a new - value. - - • ‘allow-empty’ For options, whether the empty string is a valid - value. - - • ‘history-key’ The key used to store the history. This defaults to - the command name. This is useful when multiple infixes should - share the same history because their values are of the same kind. - - • ‘reader’ The function used to read the value of an infix. Not used - for switches. The function takes three arguments, PROMPT, - INITIAL-INPUT and HISTORY, and must return a string. - - • ‘prompt’ The prompt used when reading the value, either a string or - a function that takes the object as the only argument and which - returns a prompt string. - - • ‘choices’ A list of valid values, or a function that returns such a - list. The latter is not implemented for ‘transient-switches’, - because I couldn’t think of a use-case. How exactly the choices - are used varies depending on the class of the suffix. - -Slots of ‘transient-variable’ ------------------------------ - - • ‘variable’ The variable. - -Slots of ‘transient-switches’ ------------------------------ - - • ‘argument-format’ The display format. Must contain ‘%s’, one of - the ‘choices’ is substituted for that. E.g., ‘--%s-order’. - - • ‘argument-regexp’ The regexp used to match any one of the switches. - E.g., ‘\\(--\\(topo\\|author-date\\|date\\)-order\\)’. - - -File: transient.info, Node: Predicate Slots, Prev: Suffix Slots, Up: Classes and Methods - -5.8 Predicate Slots -=================== - -Suffix and group objects share some predicate slots that control whether -a group or suffix should be available depending on some state. Only one -of these slots can be used at the same time. It is undefined what -happens if you use more than one. - - • ‘if’ Enable if predicate returns non-‘nil’. - • ‘if-not’ Enable if predicate returns ‘nil’. - • ‘if-non-nil’ Enable if variable’s value is non-‘nil’. - • ‘if-nil’ Enable if variable’s value is ‘nil’. - • ‘if-mode’ Enable if major-mode matches value. - • ‘if-not-mode’ Enable if major-mode does not match value. - • ‘if-derived’ Enable if major-mode derives from value. - • ‘if-not-derived’ Enable if major-mode does not derive from value. - - By default these predicates run when the prefix command is invoked, -but this can be changes, using the ‘refresh-suffixes’ prefix slot. See -*note Prefix Slots::. - - One more slot is shared between group and suffix classes, ‘level’. -Like the slots documented above, it is a predicate, but it is used for a -different purpose. The value has to be an integer between 1 and 7. -‘level’ controls whether a suffix or a group should be available -depending on user preference. See *note Enabling and Disabling -Suffixes::. - - -File: transient.info, Node: FAQ, Next: Keystroke Index, Prev: Classes and Methods, Up: Top - -Appendix A FAQ -************** - -A.1 Can I control how the popup buffer is displayed? -==================================================== - -Yes, see ‘transient-display-buffer-action’ in *note Configuration::. - -A.2 How can I copy text from the popup buffer? -============================================== - -To be able to mark text in Transient’s popup buffer using the mouse, you -have to add the below binding. Note that for technical reasons, the -region won’t be visualized, while doing so. After you have quit the -transient popup, you will be able to yank it in another buffer. - - (keymap-set transient-predicate-map - "<mouse-set-region>" - #'transient--do-stay) - -A.3 How can I autoload prefix and suffix commands? -================================================== - -If your package only supports Emacs 30, just prefix the definition with -‘;;;###autoload’. If your package supports released versions of Emacs, -you unfortunately have to use a long form autoload comment as described -in *note (elisp)Autoload::. - - ;;;###autoload (autoload 'magit-dispatch "magit" nil t) - (transient-define-prefix magit-dispatch () - ...) - -A.4 How does Transient compare to prefix keys and universal arguments? -====================================================================== - -See -<https://github.com/magit/transient/wiki/Comparison-with-prefix-keys-and-universal-arguments>. - -A.5 How does Transient compare to Magit-Popup and Hydra? -======================================================== - -See -<https://github.com/magit/transient/wiki/Comparison-with-other-packages>. - -A.6 Why did some of the key bindings change? -============================================ - -You may have noticed that the bindings for some of the common commands -do *not* have the prefix ‘C-x’ and that furthermore some of these -commands are grayed out while others are not. That unfortunately is a -bit confusing if the section of common commands is not shown -permanently, making the following explanation necessary. - - The purpose of usually hiding that section but showing it after the -user pressed the respective prefix key is to conserve space and not -overwhelm users with too much noise, while allowing the user to quickly -list common bindings on demand. - - That however should not keep us from using the best possible key -bindings. The bindings that do use a prefix do so to avoid wasting too -many non-prefix bindings, keeping them available for use in individual -transients. The bindings that do not use a prefix and that are *not* -grayed out are very important bindings that are *always* available, even -when invoking the “common command key prefix” or *any other* -transient-specific prefix. The non-prefix keys that *are* grayed out -however, are not available when any incomplete prefix key sequence is -active. They do not use the “common command key prefix” because it is -likely that users want to invoke them several times in a row and e.g., -‘M-p M-p M-p’ is much more convenient than ‘C-x M-p C-x M-p C-x M-p’. - - You may also have noticed that the “Set” command is bound to ‘C-x s’, -while Magit-Popup used to bind ‘C-c C-c’ instead. I have seen several -users praise the latter binding (sic), so I did not change it -willy-nilly. The reason that I changed it is that using different -prefix keys for different common commands, would have made the temporary -display of the common commands even more confusing, i.e., after pressing -‘C-c’ all the bindings that begin with the ‘C-x’ prefix would be grayed -out. - - Using a single prefix for common commands key means that all other -potential prefix keys can be used for transient-specific commands -*without* the section of common commands also popping up. ‘C-c’ in -particular is a prefix that I want to (and already do) use for Magit, -and also using that for a common command would prevent me from doing so. - - (Also see the next question.) - -A.7 Why does ‘q’ not quit popups anymore? -========================================= - -I agree that ‘q’ is a good binding for commands that quit something. -This includes quitting whatever transient is currently active, but it -also includes quitting whatever it is that some specific transient is -controlling. The transient ‘magit-blame’ for example binds ‘q’ to the -command that turns ‘magit-blame-mode’ off. - - So I had to decide if ‘q’ should quit the active transient (like -Magit-Popup used to) or whether ‘C-g’ should do that instead, so that -‘q’ could be bound in individual transient to whatever commands make -sense for them. Because all other letters are already reserved for use -by individual transients, I have decided to no longer make an exception -for ‘q’. - - If you want to get ‘q’’s old binding back then you can do so. Doing -that is a bit more complicated than changing a single key binding, so I -have implemented a function, ‘transient-bind-q-to-quit’ that makes the -necessary changes. See its documentation string for more information. - - -File: transient.info, Node: Keystroke Index, Next: Command and Function Index, Prev: FAQ, Up: Top - -Appendix B Keystroke Index -************************** - - -* Menu: - -* C-g: Aborting and Resuming Transients. - (line 27) -* C-g <1>: Aborting and Resuming Transients. - (line 27) -* C-h: Getting Help for Suffix Commands. - (line 11) -* C-M-n: Using History. (line 18) -* C-M-p: Using History. (line 13) -* C-q: Aborting and Resuming Transients. - (line 36) -* C-x a: Enabling and Disabling Suffixes. - (line 68) -* C-x C-k: Saving Values. (line 29) -* C-x C-s: Saving Values. (line 25) -* C-x l: Enabling and Disabling Suffixes. - (line 43) -* C-x n: Using History. (line 18) -* C-x p: Using History. (line 13) -* C-x s: Saving Values. (line 21) -* C-x t: Common Suffix Commands. - (line 18) -* C-z: Aborting and Resuming Transients. - (line 41) - - -File: transient.info, Node: Command and Function Index, Next: Variable Index, Prev: Keystroke Index, Up: Top - -Appendix C Command and Function Index -************************************* - - -* Menu: - -* transient--do-call: Transient State. (line 125) -* transient--do-exit: Transient State. (line 117) -* transient--do-leave: Transient State. (line 193) -* transient--do-quit-all: Transient State. (line 205) -* transient--do-quit-one: Transient State. (line 200) -* transient--do-recurse: Transient State. (line 133) -* transient--do-replace: Transient State. (line 153) -* transient--do-return: Transient State. (line 120) -* transient--do-stack: Transient State. (line 145) -* transient--do-stay: Transient State. (line 105) -* transient--do-stay <1>: Transient State. (line 190) -* transient--do-suspend: Transient State. (line 161) -* transient--do-suspend <1>: Transient State. (line 210) -* transient--do-warn: Transient State. (line 187) -* transient--history-init: Prefix Classes. (line 10) -* transient--insert-group: Group Methods. (line 19) -* transient-append-suffix: Modifying Existing Transients. - (line 51) -* transient-arg-value: Using Infix Arguments. - (line 31) -* transient-args: Using Infix Arguments. - (line 22) -* transient-define-argument: Defining Suffix and Infix Commands. - (line 57) -* transient-define-infix: Defining Suffix and Infix Commands. - (line 26) -* transient-define-prefix: Defining Transients. (line 13) -* transient-define-suffix: Defining Suffix and Infix Commands. - (line 9) -* transient-format: Suffix Format Methods. - (line 6) -* transient-format-description: Suffix Format Methods. - (line 18) -* transient-format-key: Suffix Format Methods. - (line 14) -* transient-format-value: Suffix Format Methods. - (line 22) -* transient-get-suffix: Modifying Existing Transients. - (line 73) -* transient-help: Getting Help for Suffix Commands. - (line 11) -* transient-history-next: Using History. (line 18) -* transient-history-prev: Using History. (line 13) -* transient-infix-read: Suffix Value Methods. - (line 16) -* transient-infix-set: Suffix Value Methods. - (line 36) -* transient-infix-value: Suffix Value Methods. - (line 39) -* transient-init-scope: Suffix Value Methods. - (line 52) -* transient-init-value: Suffix Value Methods. - (line 6) -* transient-insert-suffix: Modifying Existing Transients. - (line 49) -* transient-prompt: Suffix Value Methods. - (line 32) -* transient-quit-all: Aborting and Resuming Transients. - (line 36) -* transient-quit-one: Aborting and Resuming Transients. - (line 27) -* transient-quit-seq: Aborting and Resuming Transients. - (line 27) -* transient-remove-suffix: Modifying Existing Transients. - (line 70) -* transient-replace-suffix: Modifying Existing Transients. - (line 66) -* transient-reset: Saving Values. (line 29) -* transient-resume: Aborting and Resuming Transients. - (line 53) -* transient-save: Saving Values. (line 25) -* transient-scroll-down: Other Commands. (line 17) -* transient-scroll-up: Other Commands. (line 12) -* transient-set: Saving Values. (line 21) -* transient-set-level: Enabling and Disabling Suffixes. - (line 43) -* transient-setup-children: Group Methods. (line 6) -* transient-show-help: Suffix Format Methods. - (line 26) -* transient-suffix-put: Modifying Existing Transients. - (line 77) -* transient-suffixes: Using Infix Arguments. - (line 38) -* transient-suspend: Aborting and Resuming Transients. - (line 41) -* transient-toggle-common: Common Suffix Commands. - (line 18) -* transient-toggle-level-limit: Enabling and Disabling Suffixes. - (line 68) - - -File: transient.info, Node: Variable Index, Next: Concept Index, Prev: Command and Function Index, Up: Top - -Appendix D Variable Index -************************* - - -* Menu: - -* transient-align-variable-pitch: Configuration. (line 185) -* transient-current-command: Using Infix Arguments. - (line 57) -* transient-current-prefix: Using Infix Arguments. - (line 52) -* transient-current-suffixes: Using Infix Arguments. - (line 44) -* transient-default-level: Enabling and Disabling Suffixes. - (line 33) -* transient-detect-key-conflicts: Configuration. (line 210) -* transient-display-buffer-action: Configuration. (line 51) -* transient-enable-popup-navigation: Configuration. (line 36) -* transient-force-fixed-pitch: Configuration. (line 198) -* transient-force-single-column: Configuration. (line 93) -* transient-hide-during-minibuffer-read: Configuration. (line 181) -* transient-highlight-higher-levels: Configuration. (line 223) -* transient-highlight-mismatched-keys: Configuration. (line 135) -* transient-history-file: Using History. (line 33) -* transient-history-limit: Using History. (line 37) -* transient-levels-file: Enabling and Disabling Suffixes. - (line 38) -* transient-mode-line-format: Configuration. (line 102) -* transient-read-with-initial-input: Configuration. (line 174) -* transient-semantic-coloring: Configuration. (line 126) -* transient-show-common-commands: Common Suffix Commands. - (line 23) -* transient-show-popup: Configuration. (line 15) -* transient-substitute-key-function: Configuration. (line 153) -* transient-values-file: Saving Values. (line 31) - - -File: transient.info, Node: Concept Index, Next: GNU General Public License, Prev: Variable Index, Up: Top - -Appendix E Concept Index -************************ - - -* Menu: - -* aborting transients: Aborting and Resuming Transients. - (line 6) -* classes and methods: Classes and Methods. (line 6) -* command dispatchers: Technical Introduction. - (line 39) -* common suffix commands: Common Suffix Commands. - (line 6) -* defining infix commands: Defining Suffix and Infix Commands. - (line 6) -* defining suffix commands: Defining Suffix and Infix Commands. - (line 6) -* disabling suffixes: Enabling and Disabling Suffixes. - (line 6) -* enabling suffixes: Enabling and Disabling Suffixes. - (line 6) -* getting help: Getting Help for Suffix Commands. - (line 6) -* group specifications: Group Specifications. (line 6) -* invoking transients: Invoking Transients. (line 6) -* levels: Enabling and Disabling Suffixes. - (line 10) -* modifying existing transients: Modifying Existing Transients. - (line 6) -* quit transient: Aborting and Resuming Transients. - (line 6) -* resuming transients: Aborting and Resuming Transients. - (line 6) -* saving values of arguments: Saving Values. (line 6) -* scope of a transient: Defining Transients. (line 43) -* suffix specifications: Suffix Specifications. - (line 6) -* transient state: Transient State. (line 6) -* transient-level: Enabling and Disabling Suffixes. - (line 15) -* value history: Using History. (line 6) - - -File: transient.info, Node: GNU General Public License, Prev: Concept Index, Up: Top - -Appendix F GNU General Public License -************************************* - - Version 3, 29 June 2007 - - Copyright © 2007 Free Software Foundation, Inc. <https://fsf.org/> - - Everyone is permitted to copy and distribute verbatim copies of this - license document, but changing it is not allowed. - -Preamble -======== - -The GNU General Public License is a free, copyleft license for software -and other kinds of works. - - The licenses for most software and other practical works are designed -to take away your freedom to share and change the works. By contrast, -the GNU General Public License is intended to guarantee your freedom to -share and change all versions of a program—to make sure it remains free -software for all its users. We, the Free Software Foundation, use the -GNU General Public License for most of our software; it applies also to -any other work released this way by its authors. You can apply it to -your programs, too. - - When we speak of free software, we are referring to freedom, not -price. Our General Public Licenses are designed to make sure that you -have the freedom to distribute copies of free software (and charge for -them if you wish), that you receive source code or can get it if you -want it, that you can change the software or use pieces of it in new -free programs, and that you know you can do these things. - - To protect your rights, we need to prevent others from denying you -these rights or asking you to surrender the rights. Therefore, you have -certain responsibilities if you distribute copies of the software, or if -you modify it: responsibilities to respect the freedom of others. - - For example, if you distribute copies of such a program, whether -gratis or for a fee, you must pass on to the recipients the same -freedoms that you received. You must make sure that they, too, receive -or can get the source code. And you must show them these terms so they -know their rights. - - Developers that use the GNU GPL protect your rights with two steps: -(1) assert copyright on the software, and (2) offer you this License -giving you legal permission to copy, distribute and/or modify it. - - For the developers’ and authors’ protection, the GPL clearly explains -that there is no warranty for this free software. For both users’ and -authors’ sake, the GPL requires that modified versions be marked as -changed, so that their problems will not be attributed erroneously to -authors of previous versions. - - Some devices are designed to deny users access to install or run -modified versions of the software inside them, although the manufacturer -can do so. This is fundamentally incompatible with the aim of -protecting users’ freedom to change the software. The systematic -pattern of such abuse occurs in the area of products for individuals to -use, which is precisely where it is most unacceptable. Therefore, we -have designed this version of the GPL to prohibit the practice for those -products. If such problems arise substantially in other domains, we -stand ready to extend this provision to those domains in future versions -of the GPL, as needed to protect the freedom of users. - - Finally, every program is threatened constantly by software patents. -States should not allow patents to restrict development and use of -software on general-purpose computers, but in those that do, we wish to -avoid the special danger that patents applied to a free program could -make it effectively proprietary. To prevent this, the GPL assures that -patents cannot be used to render the program non-free. - - The precise terms and conditions for copying, distribution and -modification follow. - -TERMS AND CONDITIONS -==================== - - 0. Definitions. - - “This License” refers to version 3 of the GNU General Public - License. - - “Copyright” also means copyright-like laws that apply to other - kinds of works, such as semiconductor masks. - - “The Program” refers to any copyrightable work licensed under this - License. Each licensee is addressed as “you”. “Licensees” and - “recipients” may be individuals or organizations. - - To “modify” a work means to copy from or adapt all or part of the - work in a fashion requiring copyright permission, other than the - making of an exact copy. The resulting work is called a “modified - version” of the earlier work or a work “based on” the earlier work. - - A “covered work” means either the unmodified Program or a work - based on the Program. - - To “propagate” a work means to do anything with it that, without - permission, would make you directly or secondarily liable for - infringement under applicable copyright law, except executing it on - a computer or modifying a private copy. Propagation includes - copying, distribution (with or without modification), making - available to the public, and in some countries other activities as - well. - - To “convey” a work means any kind of propagation that enables other - parties to make or receive copies. Mere interaction with a user - through a computer network, with no transfer of a copy, is not - conveying. - - An interactive user interface displays “Appropriate Legal Notices” - to the extent that it includes a convenient and prominently visible - feature that (1) displays an appropriate copyright notice, and (2) - tells the user that there is no warranty for the work (except to - the extent that warranties are provided), that licensees may convey - the work under this License, and how to view a copy of this - License. If the interface presents a list of user commands or - options, such as a menu, a prominent item in the list meets this - criterion. - - 1. Source Code. - - The “source code” for a work means the preferred form of the work - for making modifications to it. “Object code” means any non-source - form of a work. - - A “Standard Interface” means an interface that either is an - official standard defined by a recognized standards body, or, in - the case of interfaces specified for a particular programming - language, one that is widely used among developers working in that - language. - - The “System Libraries” of an executable work include anything, - other than the work as a whole, that (a) is included in the normal - form of packaging a Major Component, but which is not part of that - Major Component, and (b) serves only to enable use of the work with - that Major Component, or to implement a Standard Interface for - which an implementation is available to the public in source code - form. A “Major Component”, in this context, means a major - essential component (kernel, window system, and so on) of the - specific operating system (if any) on which the executable work - runs, or a compiler used to produce the work, or an object code - interpreter used to run it. - - The “Corresponding Source” for a work in object code form means all - the source code needed to generate, install, and (for an executable - work) run the object code and to modify the work, including scripts - to control those activities. However, it does not include the - work’s System Libraries, or general-purpose tools or generally - available free programs which are used unmodified in performing - those activities but which are not part of the work. For example, - Corresponding Source includes interface definition files associated - with source files for the work, and the source code for shared - libraries and dynamically linked subprograms that the work is - specifically designed to require, such as by intimate data - communication or control flow between those subprograms and other - parts of the work. - - The Corresponding Source need not include anything that users can - regenerate automatically from other parts of the Corresponding - Source. - - The Corresponding Source for a work in source code form is that - same work. - - 2. Basic Permissions. - - All rights granted under this License are granted for the term of - copyright on the Program, and are irrevocable provided the stated - conditions are met. This License explicitly affirms your unlimited - permission to run the unmodified Program. The output from running - a covered work is covered by this License only if the output, given - its content, constitutes a covered work. This License acknowledges - your rights of fair use or other equivalent, as provided by - copyright law. - - You may make, run and propagate covered works that you do not - convey, without conditions so long as your license otherwise - remains in force. You may convey covered works to others for the - sole purpose of having them make modifications exclusively for you, - or provide you with facilities for running those works, provided - that you comply with the terms of this License in conveying all - material for which you do not control copyright. Those thus making - or running the covered works for you must do so exclusively on your - behalf, under your direction and control, on terms that prohibit - them from making any copies of your copyrighted material outside - their relationship with you. - - Conveying under any other circumstances is permitted solely under - the conditions stated below. Sublicensing is not allowed; section - 10 makes it unnecessary. - - 3. Protecting Users’ Legal Rights From Anti-Circumvention Law. - - No covered work shall be deemed part of an effective technological - measure under any applicable law fulfilling obligations under - article 11 of the WIPO copyright treaty adopted on 20 December - 1996, or similar laws prohibiting or restricting circumvention of - such measures. - - When you convey a covered work, you waive any legal power to forbid - circumvention of technological measures to the extent such - circumvention is effected by exercising rights under this License - with respect to the covered work, and you disclaim any intention to - limit operation or modification of the work as a means of - enforcing, against the work’s users, your or third parties’ legal - rights to forbid circumvention of technological measures. - - 4. Conveying Verbatim Copies. - - You may convey verbatim copies of the Program’s source code as you - receive it, in any medium, provided that you conspicuously and - appropriately publish on each copy an appropriate copyright notice; - keep intact all notices stating that this License and any - non-permissive terms added in accord with section 7 apply to the - code; keep intact all notices of the absence of any warranty; and - give all recipients a copy of this License along with the Program. - - You may charge any price or no price for each copy that you convey, - and you may offer support or warranty protection for a fee. - - 5. Conveying Modified Source Versions. - - You may convey a work based on the Program, or the modifications to - produce it from the Program, in the form of source code under the - terms of section 4, provided that you also meet all of these - conditions: - - a. The work must carry prominent notices stating that you - modified it, and giving a relevant date. - - b. The work must carry prominent notices stating that it is - released under this License and any conditions added under - section 7. This requirement modifies the requirement in - section 4 to “keep intact all notices”. - - c. You must license the entire work, as a whole, under this - License to anyone who comes into possession of a copy. This - License will therefore apply, along with any applicable - section 7 additional terms, to the whole of the work, and all - its parts, regardless of how they are packaged. This License - gives no permission to license the work in any other way, but - it does not invalidate such permission if you have separately - received it. - - d. If the work has interactive user interfaces, each must display - Appropriate Legal Notices; however, if the Program has - interactive interfaces that do not display Appropriate Legal - Notices, your work need not make them do so. - - A compilation of a covered work with other separate and independent - works, which are not by their nature extensions of the covered - work, and which are not combined with it such as to form a larger - program, in or on a volume of a storage or distribution medium, is - called an “aggregate” if the compilation and its resulting - copyright are not used to limit the access or legal rights of the - compilation’s users beyond what the individual works permit. - Inclusion of a covered work in an aggregate does not cause this - License to apply to the other parts of the aggregate. - - 6. Conveying Non-Source Forms. - - You may convey a covered work in object code form under the terms - of sections 4 and 5, provided that you also convey the - machine-readable Corresponding Source under the terms of this - License, in one of these ways: - - a. Convey the object code in, or embodied in, a physical product - (including a physical distribution medium), accompanied by the - Corresponding Source fixed on a durable physical medium - customarily used for software interchange. - - b. Convey the object code in, or embodied in, a physical product - (including a physical distribution medium), accompanied by a - written offer, valid for at least three years and valid for as - long as you offer spare parts or customer support for that - product model, to give anyone who possesses the object code - either (1) a copy of the Corresponding Source for all the - software in the product that is covered by this License, on a - durable physical medium customarily used for software - interchange, for a price no more than your reasonable cost of - physically performing this conveying of source, or (2) access - to copy the Corresponding Source from a network server at no - charge. - - c. Convey individual copies of the object code with a copy of the - written offer to provide the Corresponding Source. This - alternative is allowed only occasionally and noncommercially, - and only if you received the object code with such an offer, - in accord with subsection 6b. - - d. Convey the object code by offering access from a designated - place (gratis or for a charge), and offer equivalent access to - the Corresponding Source in the same way through the same - place at no further charge. You need not require recipients - to copy the Corresponding Source along with the object code. - If the place to copy the object code is a network server, the - Corresponding Source may be on a different server (operated by - you or a third party) that supports equivalent copying - facilities, provided you maintain clear directions next to the - object code saying where to find the Corresponding Source. - Regardless of what server hosts the Corresponding Source, you - remain obligated to ensure that it is available for as long as - needed to satisfy these requirements. - - e. Convey the object code using peer-to-peer transmission, - provided you inform other peers where the object code and - Corresponding Source of the work are being offered to the - general public at no charge under subsection 6d. - - A separable portion of the object code, whose source code is - excluded from the Corresponding Source as a System Library, need - not be included in conveying the object code work. - - A “User Product” is either (1) a “consumer product”, which means - any tangible personal property which is normally used for personal, - family, or household purposes, or (2) anything designed or sold for - incorporation into a dwelling. In determining whether a product is - a consumer product, doubtful cases shall be resolved in favor of - coverage. For a particular product received by a particular user, - “normally used” refers to a typical or common use of that class of - product, regardless of the status of the particular user or of the - way in which the particular user actually uses, or expects or is - expected to use, the product. A product is a consumer product - regardless of whether the product has substantial commercial, - industrial or non-consumer uses, unless such uses represent the - only significant mode of use of the product. - - “Installation Information” for a User Product means any methods, - procedures, authorization keys, or other information required to - install and execute modified versions of a covered work in that - User Product from a modified version of its Corresponding Source. - The information must suffice to ensure that the continued - functioning of the modified object code is in no case prevented or - interfered with solely because modification has been made. - - If you convey an object code work under this section in, or with, - or specifically for use in, a User Product, and the conveying - occurs as part of a transaction in which the right of possession - and use of the User Product is transferred to the recipient in - perpetuity or for a fixed term (regardless of how the transaction - is characterized), the Corresponding Source conveyed under this - section must be accompanied by the Installation Information. But - this requirement does not apply if neither you nor any third party - retains the ability to install modified object code on the User - Product (for example, the work has been installed in ROM). - - The requirement to provide Installation Information does not - include a requirement to continue to provide support service, - warranty, or updates for a work that has been modified or installed - by the recipient, or for the User Product in which it has been - modified or installed. Access to a network may be denied when the - modification itself materially and adversely affects the operation - of the network or violates the rules and protocols for - communication across the network. - - Corresponding Source conveyed, and Installation Information - provided, in accord with this section must be in a format that is - publicly documented (and with an implementation available to the - public in source code form), and must require no special password - or key for unpacking, reading or copying. - - 7. Additional Terms. - - “Additional permissions” are terms that supplement the terms of - this License by making exceptions from one or more of its - conditions. Additional permissions that are applicable to the - entire Program shall be treated as though they were included in - this License, to the extent that they are valid under applicable - law. If additional permissions apply only to part of the Program, - that part may be used separately under those permissions, but the - entire Program remains governed by this License without regard to - the additional permissions. - - When you convey a copy of a covered work, you may at your option - remove any additional permissions from that copy, or from any part - of it. (Additional permissions may be written to require their own - removal in certain cases when you modify the work.) You may place - additional permissions on material, added by you to a covered work, - for which you have or can give appropriate copyright permission. - - Notwithstanding any other provision of this License, for material - you add to a covered work, you may (if authorized by the copyright - holders of that material) supplement the terms of this License with - terms: - - a. Disclaiming warranty or limiting liability differently from - the terms of sections 15 and 16 of this License; or - - b. Requiring preservation of specified reasonable legal notices - or author attributions in that material or in the Appropriate - Legal Notices displayed by works containing it; or - - c. Prohibiting misrepresentation of the origin of that material, - or requiring that modified versions of such material be marked - in reasonable ways as different from the original version; or - - d. Limiting the use for publicity purposes of names of licensors - or authors of the material; or - - e. Declining to grant rights under trademark law for use of some - trade names, trademarks, or service marks; or - - f. Requiring indemnification of licensors and authors of that - material by anyone who conveys the material (or modified - versions of it) with contractual assumptions of liability to - the recipient, for any liability that these contractual - assumptions directly impose on those licensors and authors. - - All other non-permissive additional terms are considered “further - restrictions” within the meaning of section 10. If the Program as - you received it, or any part of it, contains a notice stating that - it is governed by this License along with a term that is a further - restriction, you may remove that term. If a license document - contains a further restriction but permits relicensing or conveying - under this License, you may add to a covered work material governed - by the terms of that license document, provided that the further - restriction does not survive such relicensing or conveying. - - If you add terms to a covered work in accord with this section, you - must place, in the relevant source files, a statement of the - additional terms that apply to those files, or a notice indicating - where to find the applicable terms. - - Additional terms, permissive or non-permissive, may be stated in - the form of a separately written license, or stated as exceptions; - the above requirements apply either way. - - 8. Termination. - - You may not propagate or modify a covered work except as expressly - provided under this License. Any attempt otherwise to propagate or - modify it is void, and will automatically terminate your rights - under this License (including any patent licenses granted under the - third paragraph of section 11). - - However, if you cease all violation of this License, then your - license from a particular copyright holder is reinstated (a) - provisionally, unless and until the copyright holder explicitly and - finally terminates your license, and (b) permanently, if the - copyright holder fails to notify you of the violation by some - reasonable means prior to 60 days after the cessation. - - Moreover, your license from a particular copyright holder is - reinstated permanently if the copyright holder notifies you of the - violation by some reasonable means, this is the first time you have - received notice of violation of this License (for any work) from - that copyright holder, and you cure the violation prior to 30 days - after your receipt of the notice. - - Termination of your rights under this section does not terminate - the licenses of parties who have received copies or rights from you - under this License. If your rights have been terminated and not - permanently reinstated, you do not qualify to receive new licenses - for the same material under section 10. - - 9. Acceptance Not Required for Having Copies. - - You are not required to accept this License in order to receive or - run a copy of the Program. Ancillary propagation of a covered work - occurring solely as a consequence of using peer-to-peer - transmission to receive a copy likewise does not require - acceptance. However, nothing other than this License grants you - permission to propagate or modify any covered work. These actions - infringe copyright if you do not accept this License. Therefore, - by modifying or propagating a covered work, you indicate your - acceptance of this License to do so. - - 10. Automatic Licensing of Downstream Recipients. - - Each time you convey a covered work, the recipient automatically - receives a license from the original licensors, to run, modify and - propagate that work, subject to this License. You are not - responsible for enforcing compliance by third parties with this - License. - - An “entity transaction” is a transaction transferring control of an - organization, or substantially all assets of one, or subdividing an - organization, or merging organizations. If propagation of a - covered work results from an entity transaction, each party to that - transaction who receives a copy of the work also receives whatever - licenses to the work the party’s predecessor in interest had or - could give under the previous paragraph, plus a right to possession - of the Corresponding Source of the work from the predecessor in - interest, if the predecessor has it or can get it with reasonable - efforts. - - You may not impose any further restrictions on the exercise of the - rights granted or affirmed under this License. For example, you - may not impose a license fee, royalty, or other charge for exercise - of rights granted under this License, and you may not initiate - litigation (including a cross-claim or counterclaim in a lawsuit) - alleging that any patent claim is infringed by making, using, - selling, offering for sale, or importing the Program or any portion - of it. - - 11. Patents. - - A “contributor” is a copyright holder who authorizes use under this - License of the Program or a work on which the Program is based. - The work thus licensed is called the contributor’s “contributor - version”. - - A contributor’s “essential patent claims” are all patent claims - owned or controlled by the contributor, whether already acquired or - hereafter acquired, that would be infringed by some manner, - permitted by this License, of making, using, or selling its - contributor version, but do not include claims that would be - infringed only as a consequence of further modification of the - contributor version. For purposes of this definition, “control” - includes the right to grant patent sublicenses in a manner - consistent with the requirements of this License. - - Each contributor grants you a non-exclusive, worldwide, - royalty-free patent license under the contributor’s essential - patent claims, to make, use, sell, offer for sale, import and - otherwise run, modify and propagate the contents of its contributor - version. - - In the following three paragraphs, a “patent license” is any - express agreement or commitment, however denominated, not to - enforce a patent (such as an express permission to practice a - patent or covenant not to sue for patent infringement). To “grant” - such a patent license to a party means to make such an agreement or - commitment not to enforce a patent against the party. - - If you convey a covered work, knowingly relying on a patent - license, and the Corresponding Source of the work is not available - for anyone to copy, free of charge and under the terms of this - License, through a publicly available network server or other - readily accessible means, then you must either (1) cause the - Corresponding Source to be so available, or (2) arrange to deprive - yourself of the benefit of the patent license for this particular - work, or (3) arrange, in a manner consistent with the requirements - of this License, to extend the patent license to downstream - recipients. “Knowingly relying” means you have actual knowledge - that, but for the patent license, your conveying the covered work - in a country, or your recipient’s use of the covered work in a - country, would infringe one or more identifiable patents in that - country that you have reason to believe are valid. - - If, pursuant to or in connection with a single transaction or - arrangement, you convey, or propagate by procuring conveyance of, a - covered work, and grant a patent license to some of the parties - receiving the covered work authorizing them to use, propagate, - modify or convey a specific copy of the covered work, then the - patent license you grant is automatically extended to all - recipients of the covered work and works based on it. - - A patent license is “discriminatory” if it does not include within - the scope of its coverage, prohibits the exercise of, or is - conditioned on the non-exercise of one or more of the rights that - are specifically granted under this License. You may not convey a - covered work if you are a party to an arrangement with a third - party that is in the business of distributing software, under which - you make payment to the third party based on the extent of your - activity of conveying the work, and under which the third party - grants, to any of the parties who would receive the covered work - from you, a discriminatory patent license (a) in connection with - copies of the covered work conveyed by you (or copies made from - those copies), or (b) primarily for and in connection with specific - products or compilations that contain the covered work, unless you - entered into that arrangement, or that patent license was granted, - prior to 28 March 2007. - - Nothing in this License shall be construed as excluding or limiting - any implied license or other defenses to infringement that may - otherwise be available to you under applicable patent law. - - 12. No Surrender of Others’ Freedom. - - If conditions are imposed on you (whether by court order, agreement - or otherwise) that contradict the conditions of this License, they - do not excuse you from the conditions of this License. If you - cannot convey a covered work so as to satisfy simultaneously your - obligations under this License and any other pertinent obligations, - then as a consequence you may not convey it at all. For example, - if you agree to terms that obligate you to collect a royalty for - further conveying from those to whom you convey the Program, the - only way you could satisfy both those terms and this License would - be to refrain entirely from conveying the Program. - - 13. Use with the GNU Affero General Public License. - - Notwithstanding any other provision of this License, you have - permission to link or combine any covered work with a work licensed - under version 3 of the GNU Affero General Public License into a - single combined work, and to convey the resulting work. The terms - of this License will continue to apply to the part which is the - covered work, but the special requirements of the GNU Affero - General Public License, section 13, concerning interaction through - a network will apply to the combination as such. - - 14. Revised Versions of this License. - - The Free Software Foundation may publish revised and/or new - versions of the GNU General Public License from time to time. Such - new versions will be similar in spirit to the present version, but - may differ in detail to address new problems or concerns. - - Each version is given a distinguishing version number. If the - Program specifies that a certain numbered version of the GNU - General Public License “or any later version” applies to it, you - have the option of following the terms and conditions either of - that numbered version or of any later version published by the Free - Software Foundation. If the Program does not specify a version - number of the GNU General Public License, you may choose any - version ever published by the Free Software Foundation. - - If the Program specifies that a proxy can decide which future - versions of the GNU General Public License can be used, that - proxy’s public statement of acceptance of a version permanently - authorizes you to choose that version for the Program. - - Later license versions may give you additional or different - permissions. However, no additional obligations are imposed on any - author or copyright holder as a result of your choosing to follow a - later version. - - 15. Disclaimer of Warranty. - - THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY - APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE - COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM “AS IS” - WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, - INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF - MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE - RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. - SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL - NECESSARY SERVICING, REPAIR OR CORRECTION. - - 16. Limitation of Liability. - - IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN - WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES - AND/OR CONVEYS THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR - DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR - CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE - THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA - BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD - PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER - PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF - THE POSSIBILITY OF SUCH DAMAGES. - - 17. Interpretation of Sections 15 and 16. - - If the disclaimer of warranty and limitation of liability provided - above cannot be given local legal effect according to their terms, - reviewing courts shall apply local law that most closely - approximates an absolute waiver of all civil liability in - connection with the Program, unless a warranty or assumption of - liability accompanies a copy of the Program in return for a fee. - -END OF TERMS AND CONDITIONS -=========================== - -How to Apply These Terms to Your New Programs -============================================= - -If you develop a new program, and you want it to be of the greatest -possible use to the public, the best way to achieve this is to make it -free software which everyone can redistribute and change under these -terms. - - To do so, attach the following notices to the program. It is safest -to attach them to the start of each source file to most effectively -state the exclusion of warranty; and each file should have at least the -“copyright” line and a pointer to where the full notice is found. - - ONE LINE TO GIVE THE PROGRAM'S NAME AND A BRIEF IDEA OF WHAT IT DOES. - Copyright (C) YEAR NAME OF AUTHOR - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or (at - your option) any later version. - - This program is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see <https://www.gnu.org/licenses/>. - - Also add information on how to contact you by electronic and paper -mail. - - If the program does terminal interaction, make it output a short -notice like this when it starts in an interactive mode: - - PROGRAM Copyright (C) YEAR NAME OF AUTHOR - This program comes with ABSOLUTELY NO WARRANTY; for details type ‘show w’. - This is free software, and you are welcome to redistribute it - under certain conditions; type ‘show c’ for details. - - The hypothetical commands ‘show w’ and ‘show c’ should show the -appropriate parts of the General Public License. Of course, your -program’s commands might be different; for a GUI interface, you would -use an “about box”. - - You should also get your employer (if you work as a programmer) or -school, if any, to sign a “copyright disclaimer” for the program, if -necessary. For more information on this, and how to apply and follow -the GNU GPL, see <https://www.gnu.org/licenses/>. - - The GNU General Public License does not permit incorporating your -program into proprietary programs. If your program is a subroutine -library, you may consider it more useful to permit linking proprietary -applications with the library. If this is what you want to do, use the -GNU Lesser General Public License instead of this License. But first, -please read <https://www.gnu.org/licenses/why-not-lgpl.html>. - - - -Tag Table: -Node: Top763 -Node: Introduction2976 -Ref: Some things that Transient can do3504 -Ref: Complexity in CLI programs3857 -Ref: Using Transient for composing interactive commands4458 -Node: Usage6700 -Node: Invoking Transients7068 -Node: Aborting and Resuming Transients8147 -Node: Common Suffix Commands10768 -Node: Saving Values12604 -Ref: Saving Values-Footnote-113975 -Node: Using History14168 -Node: Getting Help for Suffix Commands15742 -Node: Enabling and Disabling Suffixes17120 -Node: Other Commands20408 -Node: Configuration21384 -Ref: Essential Options21664 -Ref: Accessibility Options25325 -Ref: Auxiliary Options25648 -Ref: Developer Options30611 -Node: Modifying Existing Transients31859 -Node: Defining New Commands36051 -Node: Technical Introduction36414 -Node: Defining Transients42115 -Node: Binding Suffix and Infix Commands44582 -Node: Group Specifications45440 -Node: Suffix Specifications50541 -Node: Defining Suffix and Infix Commands54754 -Node: Using Infix Arguments57802 -Node: Transient State60636 -Ref: Pre-commands for Infixes65451 -Ref: Pre-commands for Suffixes65971 -Ref: Pre-commands for Non-Suffixes68425 -Ref: Special Pre-Commands69561 -Node: Classes and Methods70069 -Node: Group Classes72253 -Node: Group Methods74180 -Node: Prefix Classes75433 -Node: Suffix Classes76524 -Node: Suffix Methods79611 -Node: Suffix Value Methods79932 -Node: Suffix Format Methods82690 -Node: Prefix Slots84169 -Ref: Internal Prefix Slots86304 -Node: Suffix Slots87561 -Ref: Slots of transient-suffix87929 -Ref: Slots of transient-infix89066 -Ref: Slots of transient-variable92362 -Ref: Slots of transient-switches92464 -Node: Predicate Slots92827 -Node: FAQ94262 -Ref: Can I control how the popup buffer is displayed?94391 -Ref: How can I copy text from the popup buffer?94572 -Ref: How can I autoload prefix and suffix commands?95066 -Ref: How does Transient compare to prefix keys and universal arguments?95540 -Ref: How does Transient compare to Magit-Popup and Hydra?95783 -Ref: Why did some of the key bindings change?95977 -Ref: Why does q not quit popups anymore?98330 -Node: Keystroke Index99433 -Node: Command and Function Index101298 -Node: Variable Index107890 -Node: Concept Index110163 -Node: GNU General Public License112899 - -End Tag Table - - -Local Variables: -coding: utf-8 -End: diff --git a/emacs/elpa/transient-20240622.1240/dir b/emacs/elpa/transient-20240622.1240/dir @@ -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<Return>" 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 misc features -* Transient: (transient). Transient Commands. diff --git a/emacs/elpa/transient-20240622.1240/gpl.info b/emacs/elpa/transient-20240622.1240/gpl.info @@ -1,721 +0,0 @@ -This is gpl.info, produced by makeinfo version 6.7 from gpl.texi. - - Version 3, 29 June 2007 - - Copyright (C) 2007 Free Software Foundation, Inc. <https://fsf.org/> - - Everyone is permitted to copy and distribute verbatim copies of this - license document, but changing it is not allowed. - -Preamble -======== - -The GNU General Public License is a free, copyleft license for software -and other kinds of works. - - The licenses for most software and other practical works are designed -to take away your freedom to share and change the works. By contrast, -the GNU General Public License is intended to guarantee your freedom to -share and change all versions of a program--to make sure it remains free -software for all its users. We, the Free Software Foundation, use the -GNU General Public License for most of our software; it applies also to -any other work released this way by its authors. You can apply it to -your programs, too. - - When we speak of free software, we are referring to freedom, not -price. Our General Public Licenses are designed to make sure that you -have the freedom to distribute copies of free software (and charge for -them if you wish), that you receive source code or can get it if you -want it, that you can change the software or use pieces of it in new -free programs, and that you know you can do these things. - - To protect your rights, we need to prevent others from denying you -these rights or asking you to surrender the rights. Therefore, you have -certain responsibilities if you distribute copies of the software, or if -you modify it: responsibilities to respect the freedom of others. - - For example, if you distribute copies of such a program, whether -gratis or for a fee, you must pass on to the recipients the same -freedoms that you received. You must make sure that they, too, receive -or can get the source code. And you must show them these terms so they -know their rights. - - Developers that use the GNU GPL protect your rights with two steps: -(1) assert copyright on the software, and (2) offer you this License -giving you legal permission to copy, distribute and/or modify it. - - For the developers' and authors' protection, the GPL clearly explains -that there is no warranty for this free software. For both users' and -authors' sake, the GPL requires that modified versions be marked as -changed, so that their problems will not be attributed erroneously to -authors of previous versions. - - Some devices are designed to deny users access to install or run -modified versions of the software inside them, although the manufacturer -can do so. This is fundamentally incompatible with the aim of -protecting users' freedom to change the software. The systematic -pattern of such abuse occurs in the area of products for individuals to -use, which is precisely where it is most unacceptable. Therefore, we -have designed this version of the GPL to prohibit the practice for those -products. If such problems arise substantially in other domains, we -stand ready to extend this provision to those domains in future versions -of the GPL, as needed to protect the freedom of users. - - Finally, every program is threatened constantly by software patents. -States should not allow patents to restrict development and use of -software on general-purpose computers, but in those that do, we wish to -avoid the special danger that patents applied to a free program could -make it effectively proprietary. To prevent this, the GPL assures that -patents cannot be used to render the program non-free. - - The precise terms and conditions for copying, distribution and -modification follow. - -TERMS AND CONDITIONS -==================== - - 0. Definitions. - - "This License" refers to version 3 of the GNU General Public - License. - - "Copyright" also means copyright-like laws that apply to other - kinds of works, such as semiconductor masks. - - "The Program" refers to any copyrightable work licensed under this - License. Each licensee is addressed as "you". "Licensees" and - "recipients" may be individuals or organizations. - - To "modify" a work means to copy from or adapt all or part of the - work in a fashion requiring copyright permission, other than the - making of an exact copy. The resulting work is called a "modified - version" of the earlier work or a work "based on" the earlier work. - - A "covered work" means either the unmodified Program or a work - based on the Program. - - To "propagate" a work means to do anything with it that, without - permission, would make you directly or secondarily liable for - infringement under applicable copyright law, except executing it on - a computer or modifying a private copy. Propagation includes - copying, distribution (with or without modification), making - available to the public, and in some countries other activities as - well. - - To "convey" a work means any kind of propagation that enables other - parties to make or receive copies. Mere interaction with a user - through a computer network, with no transfer of a copy, is not - conveying. - - An interactive user interface displays "Appropriate Legal Notices" - to the extent that it includes a convenient and prominently visible - feature that (1) displays an appropriate copyright notice, and (2) - tells the user that there is no warranty for the work (except to - the extent that warranties are provided), that licensees may convey - the work under this License, and how to view a copy of this - License. If the interface presents a list of user commands or - options, such as a menu, a prominent item in the list meets this - criterion. - - 1. Source Code. - - The "source code" for a work means the preferred form of the work - for making modifications to it. "Object code" means any non-source - form of a work. - - A "Standard Interface" means an interface that either is an - official standard defined by a recognized standards body, or, in - the case of interfaces specified for a particular programming - language, one that is widely used among developers working in that - language. - - The "System Libraries" of an executable work include anything, - other than the work as a whole, that (a) is included in the normal - form of packaging a Major Component, but which is not part of that - Major Component, and (b) serves only to enable use of the work with - that Major Component, or to implement a Standard Interface for - which an implementation is available to the public in source code - form. A "Major Component", in this context, means a major - essential component (kernel, window system, and so on) of the - specific operating system (if any) on which the executable work - runs, or a compiler used to produce the work, or an object code - interpreter used to run it. - - The "Corresponding Source" for a work in object code form means all - the source code needed to generate, install, and (for an executable - work) run the object code and to modify the work, including scripts - to control those activities. However, it does not include the - work's System Libraries, or general-purpose tools or generally - available free programs which are used unmodified in performing - those activities but which are not part of the work. For example, - Corresponding Source includes interface definition files associated - with source files for the work, and the source code for shared - libraries and dynamically linked subprograms that the work is - specifically designed to require, such as by intimate data - communication or control flow between those subprograms and other - parts of the work. - - The Corresponding Source need not include anything that users can - regenerate automatically from other parts of the Corresponding - Source. - - The Corresponding Source for a work in source code form is that - same work. - - 2. Basic Permissions. - - All rights granted under this License are granted for the term of - copyright on the Program, and are irrevocable provided the stated - conditions are met. This License explicitly affirms your unlimited - permission to run the unmodified Program. The output from running - a covered work is covered by this License only if the output, given - its content, constitutes a covered work. This License acknowledges - your rights of fair use or other equivalent, as provided by - copyright law. - - You may make, run and propagate covered works that you do not - convey, without conditions so long as your license otherwise - remains in force. You may convey covered works to others for the - sole purpose of having them make modifications exclusively for you, - or provide you with facilities for running those works, provided - that you comply with the terms of this License in conveying all - material for which you do not control copyright. Those thus making - or running the covered works for you must do so exclusively on your - behalf, under your direction and control, on terms that prohibit - them from making any copies of your copyrighted material outside - their relationship with you. - - Conveying under any other circumstances is permitted solely under - the conditions stated below. Sublicensing is not allowed; section - 10 makes it unnecessary. - - 3. Protecting Users' Legal Rights From Anti-Circumvention Law. - - No covered work shall be deemed part of an effective technological - measure under any applicable law fulfilling obligations under - article 11 of the WIPO copyright treaty adopted on 20 December - 1996, or similar laws prohibiting or restricting circumvention of - such measures. - - When you convey a covered work, you waive any legal power to forbid - circumvention of technological measures to the extent such - circumvention is effected by exercising rights under this License - with respect to the covered work, and you disclaim any intention to - limit operation or modification of the work as a means of - enforcing, against the work's users, your or third parties' legal - rights to forbid circumvention of technological measures. - - 4. Conveying Verbatim Copies. - - You may convey verbatim copies of the Program's source code as you - receive it, in any medium, provided that you conspicuously and - appropriately publish on each copy an appropriate copyright notice; - keep intact all notices stating that this License and any - non-permissive terms added in accord with section 7 apply to the - code; keep intact all notices of the absence of any warranty; and - give all recipients a copy of this License along with the Program. - - You may charge any price or no price for each copy that you convey, - and you may offer support or warranty protection for a fee. - - 5. Conveying Modified Source Versions. - - You may convey a work based on the Program, or the modifications to - produce it from the Program, in the form of source code under the - terms of section 4, provided that you also meet all of these - conditions: - - a. The work must carry prominent notices stating that you - modified it, and giving a relevant date. - - b. The work must carry prominent notices stating that it is - released under this License and any conditions added under - section 7. This requirement modifies the requirement in - section 4 to "keep intact all notices". - - c. You must license the entire work, as a whole, under this - License to anyone who comes into possession of a copy. This - License will therefore apply, along with any applicable - section 7 additional terms, to the whole of the work, and all - its parts, regardless of how they are packaged. This License - gives no permission to license the work in any other way, but - it does not invalidate such permission if you have separately - received it. - - d. If the work has interactive user interfaces, each must display - Appropriate Legal Notices; however, if the Program has - interactive interfaces that do not display Appropriate Legal - Notices, your work need not make them do so. - - A compilation of a covered work with other separate and independent - works, which are not by their nature extensions of the covered - work, and which are not combined with it such as to form a larger - program, in or on a volume of a storage or distribution medium, is - called an "aggregate" if the compilation and its resulting - copyright are not used to limit the access or legal rights of the - compilation's users beyond what the individual works permit. - Inclusion of a covered work in an aggregate does not cause this - License to apply to the other parts of the aggregate. - - 6. Conveying Non-Source Forms. - - You may convey a covered work in object code form under the terms - of sections 4 and 5, provided that you also convey the - machine-readable Corresponding Source under the terms of this - License, in one of these ways: - - a. Convey the object code in, or embodied in, a physical product - (including a physical distribution medium), accompanied by the - Corresponding Source fixed on a durable physical medium - customarily used for software interchange. - - b. Convey the object code in, or embodied in, a physical product - (including a physical distribution medium), accompanied by a - written offer, valid for at least three years and valid for as - long as you offer spare parts or customer support for that - product model, to give anyone who possesses the object code - either (1) a copy of the Corresponding Source for all the - software in the product that is covered by this License, on a - durable physical medium customarily used for software - interchange, for a price no more than your reasonable cost of - physically performing this conveying of source, or (2) access - to copy the Corresponding Source from a network server at no - charge. - - c. Convey individual copies of the object code with a copy of the - written offer to provide the Corresponding Source. This - alternative is allowed only occasionally and noncommercially, - and only if you received the object code with such an offer, - in accord with subsection 6b. - - d. Convey the object code by offering access from a designated - place (gratis or for a charge), and offer equivalent access to - the Corresponding Source in the same way through the same - place at no further charge. You need not require recipients - to copy the Corresponding Source along with the object code. - If the place to copy the object code is a network server, the - Corresponding Source may be on a different server (operated by - you or a third party) that supports equivalent copying - facilities, provided you maintain clear directions next to the - object code saying where to find the Corresponding Source. - Regardless of what server hosts the Corresponding Source, you - remain obligated to ensure that it is available for as long as - needed to satisfy these requirements. - - e. Convey the object code using peer-to-peer transmission, - provided you inform other peers where the object code and - Corresponding Source of the work are being offered to the - general public at no charge under subsection 6d. - - A separable portion of the object code, whose source code is - excluded from the Corresponding Source as a System Library, need - not be included in conveying the object code work. - - A "User Product" is either (1) a "consumer product", which means - any tangible personal property which is normally used for personal, - family, or household purposes, or (2) anything designed or sold for - incorporation into a dwelling. In determining whether a product is - a consumer product, doubtful cases shall be resolved in favor of - coverage. For a particular product received by a particular user, - "normally used" refers to a typical or common use of that class of - product, regardless of the status of the particular user or of the - way in which the particular user actually uses, or expects or is - expected to use, the product. A product is a consumer product - regardless of whether the product has substantial commercial, - industrial or non-consumer uses, unless such uses represent the - only significant mode of use of the product. - - "Installation Information" for a User Product means any methods, - procedures, authorization keys, or other information required to - install and execute modified versions of a covered work in that - User Product from a modified version of its Corresponding Source. - The information must suffice to ensure that the continued - functioning of the modified object code is in no case prevented or - interfered with solely because modification has been made. - - If you convey an object code work under this section in, or with, - or specifically for use in, a User Product, and the conveying - occurs as part of a transaction in which the right of possession - and use of the User Product is transferred to the recipient in - perpetuity or for a fixed term (regardless of how the transaction - is characterized), the Corresponding Source conveyed under this - section must be accompanied by the Installation Information. But - this requirement does not apply if neither you nor any third party - retains the ability to install modified object code on the User - Product (for example, the work has been installed in ROM). - - The requirement to provide Installation Information does not - include a requirement to continue to provide support service, - warranty, or updates for a work that has been modified or installed - by the recipient, or for the User Product in which it has been - modified or installed. Access to a network may be denied when the - modification itself materially and adversely affects the operation - of the network or violates the rules and protocols for - communication across the network. - - Corresponding Source conveyed, and Installation Information - provided, in accord with this section must be in a format that is - publicly documented (and with an implementation available to the - public in source code form), and must require no special password - or key for unpacking, reading or copying. - - 7. Additional Terms. - - "Additional permissions" are terms that supplement the terms of - this License by making exceptions from one or more of its - conditions. Additional permissions that are applicable to the - entire Program shall be treated as though they were included in - this License, to the extent that they are valid under applicable - law. If additional permissions apply only to part of the Program, - that part may be used separately under those permissions, but the - entire Program remains governed by this License without regard to - the additional permissions. - - When you convey a copy of a covered work, you may at your option - remove any additional permissions from that copy, or from any part - of it. (Additional permissions may be written to require their own - removal in certain cases when you modify the work.) You may place - additional permissions on material, added by you to a covered work, - for which you have or can give appropriate copyright permission. - - Notwithstanding any other provision of this License, for material - you add to a covered work, you may (if authorized by the copyright - holders of that material) supplement the terms of this License with - terms: - - a. Disclaiming warranty or limiting liability differently from - the terms of sections 15 and 16 of this License; or - - b. Requiring preservation of specified reasonable legal notices - or author attributions in that material or in the Appropriate - Legal Notices displayed by works containing it; or - - c. Prohibiting misrepresentation of the origin of that material, - or requiring that modified versions of such material be marked - in reasonable ways as different from the original version; or - - d. Limiting the use for publicity purposes of names of licensors - or authors of the material; or - - e. Declining to grant rights under trademark law for use of some - trade names, trademarks, or service marks; or - - f. Requiring indemnification of licensors and authors of that - material by anyone who conveys the material (or modified - versions of it) with contractual assumptions of liability to - the recipient, for any liability that these contractual - assumptions directly impose on those licensors and authors. - - All other non-permissive additional terms are considered "further - restrictions" within the meaning of section 10. If the Program as - you received it, or any part of it, contains a notice stating that - it is governed by this License along with a term that is a further - restriction, you may remove that term. If a license document - contains a further restriction but permits relicensing or conveying - under this License, you may add to a covered work material governed - by the terms of that license document, provided that the further - restriction does not survive such relicensing or conveying. - - If you add terms to a covered work in accord with this section, you - must place, in the relevant source files, a statement of the - additional terms that apply to those files, or a notice indicating - where to find the applicable terms. - - Additional terms, permissive or non-permissive, may be stated in - the form of a separately written license, or stated as exceptions; - the above requirements apply either way. - - 8. Termination. - - You may not propagate or modify a covered work except as expressly - provided under this License. Any attempt otherwise to propagate or - modify it is void, and will automatically terminate your rights - under this License (including any patent licenses granted under the - third paragraph of section 11). - - However, if you cease all violation of this License, then your - license from a particular copyright holder is reinstated (a) - provisionally, unless and until the copyright holder explicitly and - finally terminates your license, and (b) permanently, if the - copyright holder fails to notify you of the violation by some - reasonable means prior to 60 days after the cessation. - - Moreover, your license from a particular copyright holder is - reinstated permanently if the copyright holder notifies you of the - violation by some reasonable means, this is the first time you have - received notice of violation of this License (for any work) from - that copyright holder, and you cure the violation prior to 30 days - after your receipt of the notice. - - Termination of your rights under this section does not terminate - the licenses of parties who have received copies or rights from you - under this License. If your rights have been terminated and not - permanently reinstated, you do not qualify to receive new licenses - for the same material under section 10. - - 9. Acceptance Not Required for Having Copies. - - You are not required to accept this License in order to receive or - run a copy of the Program. Ancillary propagation of a covered work - occurring solely as a consequence of using peer-to-peer - transmission to receive a copy likewise does not require - acceptance. However, nothing other than this License grants you - permission to propagate or modify any covered work. These actions - infringe copyright if you do not accept this License. Therefore, - by modifying or propagating a covered work, you indicate your - acceptance of this License to do so. - - 10. Automatic Licensing of Downstream Recipients. - - Each time you convey a covered work, the recipient automatically - receives a license from the original licensors, to run, modify and - propagate that work, subject to this License. You are not - responsible for enforcing compliance by third parties with this - License. - - An "entity transaction" is a transaction transferring control of an - organization, or substantially all assets of one, or subdividing an - organization, or merging organizations. If propagation of a - covered work results from an entity transaction, each party to that - transaction who receives a copy of the work also receives whatever - licenses to the work the party's predecessor in interest had or - could give under the previous paragraph, plus a right to possession - of the Corresponding Source of the work from the predecessor in - interest, if the predecessor has it or can get it with reasonable - efforts. - - You may not impose any further restrictions on the exercise of the - rights granted or affirmed under this License. For example, you - may not impose a license fee, royalty, or other charge for exercise - of rights granted under this License, and you may not initiate - litigation (including a cross-claim or counterclaim in a lawsuit) - alleging that any patent claim is infringed by making, using, - selling, offering for sale, or importing the Program or any portion - of it. - - 11. Patents. - - A "contributor" is a copyright holder who authorizes use under this - License of the Program or a work on which the Program is based. - The work thus licensed is called the contributor's "contributor - version". - - A contributor's "essential patent claims" are all patent claims - owned or controlled by the contributor, whether already acquired or - hereafter acquired, that would be infringed by some manner, - permitted by this License, of making, using, or selling its - contributor version, but do not include claims that would be - infringed only as a consequence of further modification of the - contributor version. For purposes of this definition, "control" - includes the right to grant patent sublicenses in a manner - consistent with the requirements of this License. - - Each contributor grants you a non-exclusive, worldwide, - royalty-free patent license under the contributor's essential - patent claims, to make, use, sell, offer for sale, import and - otherwise run, modify and propagate the contents of its contributor - version. - - In the following three paragraphs, a "patent license" is any - express agreement or commitment, however denominated, not to - enforce a patent (such as an express permission to practice a - patent or covenant not to sue for patent infringement). To "grant" - such a patent license to a party means to make such an agreement or - commitment not to enforce a patent against the party. - - If you convey a covered work, knowingly relying on a patent - license, and the Corresponding Source of the work is not available - for anyone to copy, free of charge and under the terms of this - License, through a publicly available network server or other - readily accessible means, then you must either (1) cause the - Corresponding Source to be so available, or (2) arrange to deprive - yourself of the benefit of the patent license for this particular - work, or (3) arrange, in a manner consistent with the requirements - of this License, to extend the patent license to downstream - recipients. "Knowingly relying" means you have actual knowledge - that, but for the patent license, your conveying the covered work - in a country, or your recipient's use of the covered work in a - country, would infringe one or more identifiable patents in that - country that you have reason to believe are valid. - - If, pursuant to or in connection with a single transaction or - arrangement, you convey, or propagate by procuring conveyance of, a - covered work, and grant a patent license to some of the parties - receiving the covered work authorizing them to use, propagate, - modify or convey a specific copy of the covered work, then the - patent license you grant is automatically extended to all - recipients of the covered work and works based on it. - - A patent license is "discriminatory" if it does not include within - the scope of its coverage, prohibits the exercise of, or is - conditioned on the non-exercise of one or more of the rights that - are specifically granted under this License. You may not convey a - covered work if you are a party to an arrangement with a third - party that is in the business of distributing software, under which - you make payment to the third party based on the extent of your - activity of conveying the work, and under which the third party - grants, to any of the parties who would receive the covered work - from you, a discriminatory patent license (a) in connection with - copies of the covered work conveyed by you (or copies made from - those copies), or (b) primarily for and in connection with specific - products or compilations that contain the covered work, unless you - entered into that arrangement, or that patent license was granted, - prior to 28 March 2007. - - Nothing in this License shall be construed as excluding or limiting - any implied license or other defenses to infringement that may - otherwise be available to you under applicable patent law. - - 12. No Surrender of Others' Freedom. - - If conditions are imposed on you (whether by court order, agreement - or otherwise) that contradict the conditions of this License, they - do not excuse you from the conditions of this License. If you - cannot convey a covered work so as to satisfy simultaneously your - obligations under this License and any other pertinent obligations, - then as a consequence you may not convey it at all. For example, - if you agree to terms that obligate you to collect a royalty for - further conveying from those to whom you convey the Program, the - only way you could satisfy both those terms and this License would - be to refrain entirely from conveying the Program. - - 13. Use with the GNU Affero General Public License. - - Notwithstanding any other provision of this License, you have - permission to link or combine any covered work with a work licensed - under version 3 of the GNU Affero General Public License into a - single combined work, and to convey the resulting work. The terms - of this License will continue to apply to the part which is the - covered work, but the special requirements of the GNU Affero - General Public License, section 13, concerning interaction through - a network will apply to the combination as such. - - 14. Revised Versions of this License. - - The Free Software Foundation may publish revised and/or new - versions of the GNU General Public License from time to time. Such - new versions will be similar in spirit to the present version, but - may differ in detail to address new problems or concerns. - - Each version is given a distinguishing version number. If the - Program specifies that a certain numbered version of the GNU - General Public License "or any later version" applies to it, you - have the option of following the terms and conditions either of - that numbered version or of any later version published by the Free - Software Foundation. If the Program does not specify a version - number of the GNU General Public License, you may choose any - version ever published by the Free Software Foundation. - - If the Program specifies that a proxy can decide which future - versions of the GNU General Public License can be used, that - proxy's public statement of acceptance of a version permanently - authorizes you to choose that version for the Program. - - Later license versions may give you additional or different - permissions. However, no additional obligations are imposed on any - author or copyright holder as a result of your choosing to follow a - later version. - - 15. Disclaimer of Warranty. - - THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY - APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE - COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" - WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, - INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF - MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE - RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. - SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL - NECESSARY SERVICING, REPAIR OR CORRECTION. - - 16. Limitation of Liability. - - IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN - WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES - AND/OR CONVEYS THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR - DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR - CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE - THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA - BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD - PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER - PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF - THE POSSIBILITY OF SUCH DAMAGES. - - 17. Interpretation of Sections 15 and 16. - - If the disclaimer of warranty and limitation of liability provided - above cannot be given local legal effect according to their terms, - reviewing courts shall apply local law that most closely - approximates an absolute waiver of all civil liability in - connection with the Program, unless a warranty or assumption of - liability accompanies a copy of the Program in return for a fee. - -END OF TERMS AND CONDITIONS -=========================== - -How to Apply These Terms to Your New Programs -============================================= - -If you develop a new program, and you want it to be of the greatest -possible use to the public, the best way to achieve this is to make it -free software which everyone can redistribute and change under these -terms. - - To do so, attach the following notices to the program. It is safest -to attach them to the start of each source file to most effectively -state the exclusion of warranty; and each file should have at least the -"copyright" line and a pointer to where the full notice is found. - - ONE LINE TO GIVE THE PROGRAM'S NAME AND A BRIEF IDEA OF WHAT IT DOES. - Copyright (C) YEAR NAME OF AUTHOR - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or (at - your option) any later version. - - This program is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see <https://www.gnu.org/licenses/>. - - Also add information on how to contact you by electronic and paper -mail. - - If the program does terminal interaction, make it output a short -notice like this when it starts in an interactive mode: - - PROGRAM Copyright (C) YEAR NAME OF AUTHOR - This program comes with ABSOLUTELY NO WARRANTY; for details type 'show w'. - This is free software, and you are welcome to redistribute it - under certain conditions; type 'show c' for details. - - The hypothetical commands 'show w' and 'show c' should show the -appropriate parts of the General Public License. Of course, your -program's commands might be different; for a GUI interface, you would -use an "about box". - - You should also get your employer (if you work as a programmer) or -school, if any, to sign a "copyright disclaimer" for the program, if -necessary. For more information on this, and how to apply and follow -the GNU GPL, see <https://www.gnu.org/licenses/>. - - The GNU General Public License does not permit incorporating your -program into proprietary programs. If your program is a subroutine -library, you may consider it more useful to permit linking proprietary -applications with the library. If this is what you want to do, use the -GNU Lesser General Public License instead of this License. But first, -please read <https://www.gnu.org/licenses/why-not-lgpl.html>. - - -Tag Table: - -End Tag Table - - -Local Variables: -coding: utf-8 -End: diff --git a/emacs/elpa/transient-20240622.1240/transient-pkg.el b/emacs/elpa/transient-20240622.1240/transient-pkg.el @@ -1,16 +0,0 @@ -(define-package "transient" "20240622.1240" "Transient commands" - '((emacs "26.1") - (compat "29.1.4.5") - (seq "2.24")) - :commit "06a87bd0f39dced6fc892fe7f710f008a1dde308" :authors - '(("Jonas Bernoulli" . "emacs.transient@jonas.bernoulli.dev")) - :maintainers - '(("Jonas Bernoulli" . "emacs.transient@jonas.bernoulli.dev")) - :maintainer - '("Jonas Bernoulli" . "emacs.transient@jonas.bernoulli.dev") - :keywords - '("extensions") - :url "https://github.com/magit/transient") -;; Local Variables: -;; no-byte-compile: t -;; End: diff --git a/emacs/elpa/transient-20240622.1240/transient.el b/emacs/elpa/transient-20240622.1240/transient.el @@ -1,4568 +0,0 @@ -;;; transient.el --- Transient commands -*- lexical-binding:t -*- - -;; Copyright (C) 2018-2024 Free Software Foundation, Inc. - -;; Author: Jonas Bernoulli <emacs.transient@jonas.bernoulli.dev> -;; Homepage: https://github.com/magit/transient -;; Keywords: extensions - -;; Package-Version: 0.7.1 -;; Package-Requires: ((emacs "26.1") (compat "29.1.4.5") (seq "2.24")) - -;; SPDX-License-Identifier: GPL-3.0-or-later - -;; This file is part of GNU Emacs. - -;; GNU Emacs is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published -;; by the Free Software Foundation, either version 3 of the License, -;; or (at your option) any later version. -;; -;; GNU Emacs is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <https://www.gnu.org/licenses/>. - -;;; Commentary: - -;; Transient is the library used to implement the keyboard-driven menus -;; in Magit. It is distributed as a separate package, so that it can be -;; used to implement similar menus in other packages. - -;;; Code: - -(require 'cl-lib) -(require 'compat) -(require 'eieio) -(require 'edmacro) -(require 'format-spec) - -(eval-and-compile - (when (and (featurep 'seq) - (not (fboundp 'seq-keep))) - (unload-feature 'seq 'force))) -(require 'seq) -(unless (fboundp 'seq-keep) - (display-warning 'transient (substitute-command-keys "\ -Transient requires `seq' >= 2.24, -but due to bad defaults, Emacs' package manager, refuses to -upgrade this and other built-in packages to higher releases -from GNU Elpa, when a package specifies that this is needed. - -To fix this, you have to add this to your init file: - - (setq package-install-upgrade-built-in t) - -Then evaluate that expression by placing the cursor after it -and typing \\[eval-last-sexp]. - -Once you have done that, you have to explicitly upgrade `seq': - - \\[package-upgrade] seq \\`RET' - -Then you also must make sure the updated version is loaded, -by evaluating this form: - - (progn (unload-feature 'seq t) (require 'seq)) - -Until you do this, you will get random errors about `seq-keep' -being undefined while using Transient. - -If you don't use the `package' package manager but still get -this warning, then your chosen package manager likely has a -similar defect.") :emergency)) - -(eval-when-compile (require 'subr-x)) - -(declare-function info "info" (&optional file-or-node buffer)) -(declare-function Man-find-section "man" (section)) -(declare-function Man-next-section "man" (n)) -(declare-function Man-getpage-in-background "man" (topic)) - -(defvar Man-notify-method) -(defvar pp-default-function) ; since Emacs 29.1 - -(defmacro static-if (condition then-form &rest else-forms) - "A conditional compilation macro. -Evaluate CONDITION at macro-expansion time. If it is non-nil, -expand the macro to THEN-FORM. Otherwise expand it to ELSE-FORMS -enclosed in a `progn' form. ELSE-FORMS may be empty." - (declare (indent 2) - (debug (sexp sexp &rest sexp))) - (if (eval condition lexical-binding) - then-form - (cons 'progn else-forms))) - -(defmacro transient--with-emergency-exit (id &rest body) - (declare (indent defun)) - (unless (keywordp id) - (setq body (cons id body)) - (setq id nil)) - `(condition-case err - (let ((debugger #'transient--exit-and-debug)) - ,(macroexp-progn body)) - ((debug error) - (transient--emergency-exit ,id) - (signal (car err) (cdr err))))) - -(defun transient--exit-and-debug (&rest args) - (transient--emergency-exit :debugger) - (apply #'debug args)) - -;;; Options - -(defgroup transient nil - "Transient commands." - :group 'extensions) - -(defcustom transient-show-popup t - "Whether to show the current transient in a popup buffer. -\\<transient-map> -- If t, then show the popup as soon as a transient prefix command - is invoked. - -- If nil, then do not show the popup unless the user explicitly - requests it, by pressing \\[transient-show] or a prefix key. - -- If a number, then delay displaying the popup and instead show - a brief one-line summary. If zero or negative, then suppress - even showing that summary and display the pressed key only. - - Show the popup when the user explicitly requests it by pressing - \\[transient-show] or a prefix key. Unless zero, then also show the popup - after that many seconds of inactivity (using the absolute value)." - :package-version '(transient . "0.1.0") - :group 'transient - :type '(choice (const :tag "instantly" t) - (const :tag "on demand" nil) - (const :tag "on demand (no summary)" 0) - (number :tag "after delay" 1))) - -(defcustom transient-enable-popup-navigation t - "Whether navigation commands are enabled in the transient popup. - -While a transient is active the transient popup buffer is not the -current buffer, making it necessary to use dedicated commands to -act on that buffer itself. If this is non-nil, then the following -bindings are available: - -\\<transient-popup-navigation-map>\ -- \\[transient-backward-button] moves the cursor to the previous suffix. -- \\[transient-forward-button] moves the cursor to the next suffix. -- \\[transient-push-button] invokes the suffix the cursor is on. -\\<transient-button-map>\ -- \\`<mouse-1>' and \\`<mouse-2>' invoke the clicked on suffix. -\\<transient-popup-navigation-map>\ -- \\[transient-isearch-backward]\ - and \\[transient-isearch-forward] start isearch in the popup buffer. - -\\`<mouse-1>' and \\`<mouse-2>' are bound in `transient-push-button'. -All other bindings are in `transient-popup-navigation-map'. - -By default \\`M-RET' is bound to `transient-push-button', instead of -\\`RET', because if a transient allows the invocation of non-suffixes -then it is likely that you would want \\`RET' to do what it would do -if no transient were active." - :package-version '(transient . "0.4.0") - :group 'transient - :type 'boolean) - -(defcustom transient-display-buffer-action - '(display-buffer-in-side-window - (side . bottom) - (dedicated . t) - (inhibit-same-window . t) - (window-parameters (no-other-window . t))) - "The action used to display the transient popup buffer. - -The transient popup buffer is displayed in a window using - - (display-buffer BUFFER transient-display-buffer-action) - -The value of this option has the form (FUNCTION . ALIST), -where FUNCTION is a function or a list of functions. Each such -function should accept two arguments: a buffer to display and an -alist of the same form as ALIST. See info node `(elisp)Choosing -Window' for details. - -The default is: - - (display-buffer-in-side-window - (side . bottom) - (dedicated . t) - (inhibit-same-window . t) - (window-parameters (no-other-window . t))) - -This displays the window at the bottom of the selected frame. -Another useful FUNCTION is `display-buffer-below-selected', which -is what `magit-popup' used by default. For more alternatives see -info node `(elisp)Display Action Functions' and info node -`(elisp)Buffer Display Action Alists'. - -Note that the buffer that was current before the transient buffer -is shown should remain the current buffer. Many suffix commands -act on the thing at point, if appropriate, and if the transient -buffer became the current buffer, then that would change what is -at point. To that effect `inhibit-same-window' ensures that the -selected window is not used to show the transient buffer. - -It may be possible to display the window in another frame, but -whether that works in practice depends on the window-manager. -If the window manager selects the new window (Emacs frame), -then that unfortunately changes which buffer is current. - -If you change the value of this option, then you might also -want to change the value of `transient-mode-line-format'." - :package-version '(transient . "0.3.0") - :group 'transient - :type '(cons (choice function (repeat :tag "Functions" function)) - alist)) - -(defcustom transient-mode-line-format 'line - "The mode-line format for the transient popup buffer. - -If nil, then the buffer has no mode-line. If the buffer is not -displayed right above the echo area, then this probably is not -a good value. - -If `line' (the default) or a natural number, then the buffer -has no mode-line, but a line is drawn is drawn in its place. -If a number is used, that specifies the thickness of the line. -On termcap frames we cannot draw lines, so there `line' and -numbers are synonyms for nil. - -The color of the line is used to indicate if non-suffixes are -allowed and whether they exit the transient. The foreground -color of `transient-key-noop' (if non-suffix are disallowed), -`transient-key-stay' (if allowed and transient stays active), or -`transient-key-exit' (if allowed and they exit the transient) is -used to draw the line. - -Otherwise this can be any mode-line format. -See `mode-line-format' for details." - :package-version '(transient . "0.2.0") - :group 'transient - :type '(choice (const :tag "hide mode-line" nil) - (const :tag "substitute thin line" line) - (number :tag "substitute line with thickness") - (const :tag "name of prefix command" - ("%e" mode-line-front-space - mode-line-buffer-identification)) - (sexp :tag "custom mode-line format"))) - -(defcustom transient-show-common-commands nil - "Whether to show common transient suffixes in the popup buffer. - -These commands are always shown after typing the prefix key -\"C-x\" when a transient command is active. To toggle the value -of this variable use \"C-x t\" when a transient is active." - :package-version '(transient . "0.1.0") - :group 'transient - :type 'boolean) - -(defcustom transient-read-with-initial-input nil - "Whether to use the last history element as initial minibuffer input." - :package-version '(transient . "0.2.0") - :group 'transient - :type 'boolean) - -(defcustom transient-highlight-mismatched-keys nil - "Whether to highlight keys that do not match their argument. - -This only affects infix arguments that represent command-line -arguments. When this option is non-nil, then the key binding -for infix argument are highlighted when only a long argument -\(e.g., \"--verbose\") is specified but no shorthand (e.g., \"-v\"). -In the rare case that a short-hand is specified but does not -match the key binding, then it is highlighted differently. - -The highlighting is done using `transient-mismatched-key' -and `transient-nonstandard-key'." - :package-version '(transient . "0.1.0") - :group 'transient - :type 'boolean) - -(defcustom transient-highlight-higher-levels nil - "Whether to highlight suffixes on higher levels. - -This is primarily intended for package authors. - -When non-nil then highlight the description of suffixes whose -level is above 4, the default of `transient-default-level'. -Assuming you have set that variable to 7, this highlights all -suffixes that won't be available to users without them making -the same customization." - :package-version '(transient . "0.3.6") - :group 'transient - :type 'boolean) - -(defcustom transient-substitute-key-function nil - "Function used to modify key bindings. - -This function is called with one argument, the prefix object, -and must return a key binding description, either the existing -key description it finds in the `key' slot, or a substitution. - -This is intended to let users replace certain prefix keys. It -could also be used to make other substitutions, but that is -discouraged. - -For example, \"=\" is hard to reach using my custom keyboard -layout, so I substitute \"(\" for that, which is easy to reach -using a layout optimized for Lisp. - - (setq transient-substitute-key-function - (lambda (obj) - (let ((key (oref obj key))) - (if (string-match \"\\\\`\\\\(=\\\\)[a-zA-Z]\" key) - (replace-match \"(\" t t key 1) - key)))))" - :package-version '(transient . "0.1.0") - :group 'transient - :type '(choice (const :tag "Transform no keys (nil)" nil) function)) - -(defcustom transient-semantic-coloring t - "Whether to use colors to indicate transient behavior. - -If non-nil, then the key binding of each suffix is colorized to -indicate whether it exits the transient state or not, and the -line that is drawn below the transient popup buffer is used to -indicate the behavior of non-suffix commands." - :package-version '(transient . "0.5.0") - :group 'transient - :type 'boolean) - -(defcustom transient-detect-key-conflicts nil - "Whether to detect key binding conflicts. - -Conflicts are detected when a transient prefix command is invoked -and results in an error, which prevents the transient from being -used." - :package-version '(transient . "0.1.0") - :group 'transient - :type 'boolean) - -(defcustom transient-align-variable-pitch nil - "Whether to align columns pixel-wise in the popup buffer. - -If this is non-nil, then columns are aligned pixel-wise to -support variable-pitch fonts. Keys are not aligned, so you -should use a fixed-pitch font for the `transient-key' face. -Other key faces inherit from that face unless a theme is -used that breaks that relationship. - -This option is intended for users who use a variable-pitch -font for the `default' face. - -Also see `transient-force-fixed-pitch'." - :package-version '(transient . "0.4.0") - :group 'transient - :type 'boolean) - -(defcustom transient-force-fixed-pitch nil - "Whether to force use of monospaced font in the popup buffer. - -Even if you use a proportional font for the `default' face, -you might still want to use a monospaced font in transient's -popup buffer. Setting this option to t causes `default' to -be remapped to `fixed-pitch' in that buffer. - -Also see `transient-align-variable-pitch'." - :package-version '(transient . "0.2.0") - :group 'transient - :type 'boolean) - -(defcustom transient-force-single-column nil - "Whether to force use of a single column to display suffixes. - -This might be useful for users with low vision who use large -text and might otherwise have to scroll in two dimensions." - :package-version '(transient . "0.3.6") - :group 'transient - :type 'boolean) - -(defcustom transient-hide-during-minibuffer-read nil - "Whether to hide the transient buffer while reading in the minibuffer." - :package-version '(transient . "0.4.0") - :group 'transient - :type 'boolean) - -(defconst transient--max-level 7) -(defconst transient--default-child-level 1) -(defconst transient--default-prefix-level 4) - -(defcustom transient-default-level transient--default-prefix-level - "Control what suffix levels are made available by default. - -Each suffix command is placed on a level and each prefix command -has a level, which controls which suffix commands are available. -Integers between 1 and 7 (inclusive) are valid levels. - -The levels of individual transients and/or their individual -suffixes can be changed individually, by invoking the prefix and -then pressing \"C-x l\". - -The default level for both transients and their suffixes is 4. -This option only controls the default for transients. The default -suffix level is always 4. The author of a transient should place -certain suffixes on a higher level if they expect that it won't be -of use to most users, and they should place very important suffixes -on a lower level so that they remain available even if the user -lowers the transient level. - -\(Magit currently places nearly all suffixes on level 4 and lower -levels are not used at all yet. So for the time being you should -not set a lower level here and using a higher level might not -give you as many additional suffixes as you hoped.)" - :package-version '(transient . "0.1.0") - :group 'transient - :type '(choice (const :tag "1 - fewest suffixes" 1) - (const 2) - (const 3) - (const :tag "4 - default" 4) - (const 5) - (const 6) - (const :tag "7 - most suffixes" 7))) - -(defcustom transient-levels-file - (locate-user-emacs-file "transient/levels.el") - "File used to save levels of transients and their suffixes." - :package-version '(transient . "0.1.0") - :group 'transient - :type 'file) - -(defcustom transient-values-file - (locate-user-emacs-file "transient/values.el") - "File used to save values of transients." - :package-version '(transient . "0.1.0") - :group 'transient - :type 'file) - -(defcustom transient-history-file - (locate-user-emacs-file "transient/history.el") - "File used to save history of transients and their infixes." - :package-version '(transient . "0.1.0") - :group 'transient - :type 'file) - -(defcustom transient-history-limit 10 - "Number of history elements to keep when saving to file." - :package-version '(transient . "0.1.0") - :group 'transient - :type 'integer) - -(defcustom transient-save-history t - "Whether to save history of transient commands when exiting Emacs." - :package-version '(transient . "0.1.0") - :group 'transient - :type 'boolean) - -;;; Faces - -(defgroup transient-faces nil - "Faces used by Transient." - :group 'transient) - -(defface transient-heading '((t :inherit font-lock-keyword-face)) - "Face used for headings." - :group 'transient-faces) - -(defface transient-argument '((t :inherit font-lock-string-face :weight bold)) - "Face used for enabled arguments." - :group 'transient-faces) - -(defface transient-inactive-argument '((t :inherit shadow)) - "Face used for inactive arguments." - :group 'transient-faces) - -(defface transient-value '((t :inherit font-lock-string-face :weight bold)) - "Face used for values." - :group 'transient-faces) - -(defface transient-inactive-value '((t :inherit shadow)) - "Face used for inactive values." - :group 'transient-faces) - -(defface transient-unreachable '((t :inherit shadow)) - "Face used for suffixes unreachable from the current prefix sequence." - :group 'transient-faces) - -(defface transient-inapt-suffix '((t :inherit shadow :italic t)) - "Face used for suffixes that are inapt at this time." - :group 'transient-faces) - -(defface transient-active-infix '((t :inherit highlight)) - "Face used for the infix for which the value is being read." - :group 'transient-faces) - -(defface transient-enabled-suffix - '((t :background "green" :foreground "black" :weight bold)) - "Face used for enabled levels while editing suffix levels. -See info node `(transient)Enabling and Disabling Suffixes'." - :group 'transient-faces) - -(defface transient-disabled-suffix - '((t :background "red" :foreground "black" :weight bold)) - "Face used for disabled levels while editing suffix levels. -See info node `(transient)Enabling and Disabling Suffixes'." - :group 'transient-faces) - -(defface transient-higher-level - `((t :box ( :line-width ,(if (>= emacs-major-version 28) (cons -1 -1) -1) - :color ,(let ((color (face-attribute 'shadow :foreground nil t))) - (or (and (not (eq color 'unspecified)) color) - "grey60"))))) - "Face optionally used to highlight suffixes on higher levels. -Also see option `transient-highlight-higher-levels'." - :group 'transient-faces) - -(defface transient-delimiter '((t :inherit shadow)) - "Face used for delimiters and separators. -This includes the parentheses around values and the pipe -character used to separate possible values from each other." - :group 'transient-faces) - -(defface transient-key '((t :inherit font-lock-builtin-face)) - "Face used for keys." - :group 'transient-faces) - -(defface transient-key-stay - `((((class color) (background light)) - :inherit transient-key - :foreground "#22aa22") - (((class color) (background dark)) - :inherit transient-key - :foreground "#ddffdd")) - "Face used for keys of suffixes that don't exit transient state." - :group 'transient-faces) - -(defface transient-key-noop - `((((class color) (background light)) - :inherit transient-key - :foreground "grey80") - (((class color) (background dark)) - :inherit transient-key - :foreground "grey30")) - "Face used for keys of suffixes that currently cannot be invoked." - :group 'transient-faces) - -(defface transient-key-return - `((((class color) (background light)) - :inherit transient-key - :foreground "#aaaa11") - (((class color) (background dark)) - :inherit transient-key - :foreground "#ffffcc")) - "Face used for keys of suffixes that return to the parent transient." - :group 'transient-faces) - -(defface transient-key-exit - `((((class color) (background light)) - :inherit transient-key - :foreground "#aa2222") - (((class color) (background dark)) - :inherit transient-key - :foreground "#ffdddd")) - "Face used for keys of suffixes that exit transient state." - :group 'transient-faces) - -(defface transient-unreachable-key - '((t :inherit (shadow transient-key) :weight normal)) - "Face used for keys unreachable from the current prefix sequence." - :group 'transient-faces) - -(defface transient-nonstandard-key - `((t :box ( :line-width ,(if (>= emacs-major-version 28) (cons -1 -1) -1) - :color "cyan"))) - "Face optionally used to highlight keys conflicting with short-argument. -Also see option `transient-highlight-mismatched-keys'." - :group 'transient-faces) - -(defface transient-mismatched-key - `((t :box ( :line-width ,(if (>= emacs-major-version 28) (cons -1 -1) -1) - :color "magenta"))) - "Face optionally used to highlight keys without a short-argument. -Also see option `transient-highlight-mismatched-keys'." - :group 'transient-faces) - -;;; Persistence - -(defun transient--read-file-contents (file) - (with-demoted-errors "Transient error: %S" - (and (file-exists-p file) - (with-temp-buffer - (insert-file-contents file) - (read (current-buffer)))))) - -(defun transient--pp-to-file (list file) - (make-directory (file-name-directory file) t) - (setq list (cl-sort (copy-sequence list) #'string< :key #'car)) - (with-temp-file file - (let ((print-level nil) - (print-length nil) - (pp-default-function 'pp-28) - (fill-column 999)) - (pp list (current-buffer))))) - -(defvar transient-values - (transient--read-file-contents transient-values-file) - "Values of transient commands. -The value of this variable persists between Emacs sessions -and you usually should not change it manually.") - -(defun transient-save-values () - (transient--pp-to-file transient-values transient-values-file)) - -(defvar transient-levels - (transient--read-file-contents transient-levels-file) - "Levels of transient commands. -The value of this variable persists between Emacs sessions -and you usually should not change it manually.") - -(defun transient-save-levels () - (transient--pp-to-file transient-levels transient-levels-file)) - -(defvar transient-history - (transient--read-file-contents transient-history-file) - "History of transient commands and infix arguments. -The value of this variable persists between Emacs sessions -\(unless `transient-save-history' is nil) and you usually -should not change it manually.") - -(defun transient-save-history () - (setq transient-history - (cl-sort (mapcar (pcase-lambda (`(,key . ,val)) - (cons key (seq-take (delete-dups val) - transient-history-limit))) - transient-history) - #'string< :key #'car)) - (transient--pp-to-file transient-history transient-history-file)) - -(defun transient-maybe-save-history () - "Save the value of `transient-history'. -If `transient-save-history' is nil, then do nothing." - (when transient-save-history - (transient-save-history))) - -(unless noninteractive - (add-hook 'kill-emacs-hook #'transient-maybe-save-history)) - -;;; Classes -;;;; Prefix - -(defclass transient-prefix () - ((prototype :initarg :prototype) - (command :initarg :command) - (level :initarg :level) - (variable :initarg :variable :initform nil) - (init-value :initarg :init-value) - (value) (default-value :initarg :value) - (scope :initarg :scope :initform nil) - (history :initarg :history :initform nil) - (history-pos :initarg :history-pos :initform 0) - (history-key :initarg :history-key :initform nil) - (show-help :initarg :show-help :initform nil) - (info-manual :initarg :info-manual :initform nil) - (man-page :initarg :man-page :initform nil) - (transient-suffix :initarg :transient-suffix :initform nil) - (transient-non-suffix :initarg :transient-non-suffix :initform nil) - (transient-switch-frame :initarg :transient-switch-frame) - (refresh-suffixes :initarg :refresh-suffixes :initform nil) - (incompatible :initarg :incompatible :initform nil) - (suffix-description :initarg :suffix-description) - (variable-pitch :initarg :variable-pitch :initform nil) - (column-widths :initarg :column-widths :initform nil) - (unwind-suffix :documentation "Internal use." :initform nil)) - "Transient prefix command. - -Each transient prefix command consists of a command, which is -stored in a symbol's function slot and an object, which is -stored in the `transient--prefix' property of the same symbol. - -When a transient prefix command is invoked, then a clone of that -object is stored in the global variable `transient--prefix' and -the prototype is stored in the clone's `prototype' slot.") - -;;;; Suffix - -(defclass transient-child () - ((level - :initarg :level - :initform (symbol-value 'transient--default-child-level) - :documentation "Enable if level of prefix is equal or greater.") - (if - :initarg :if - :initform nil - :documentation "Enable if predicate returns non-nil.") - (if-not - :initarg :if-not - :initform nil - :documentation "Enable if predicate returns nil.") - (if-non-nil - :initarg :if-non-nil - :initform nil - :documentation "Enable if variable's value is non-nil.") - (if-nil - :initarg :if-nil - :initform nil - :documentation "Enable if variable's value is nil.") - (if-mode - :initarg :if-mode - :initform nil - :documentation "Enable if major-mode matches value.") - (if-not-mode - :initarg :if-not-mode - :initform nil - :documentation "Enable if major-mode does not match value.") - (if-derived - :initarg :if-derived - :initform nil - :documentation "Enable if major-mode derives from value.") - (if-not-derived - :initarg :if-not-derived - :initform nil - :documentation "Enable if major-mode does not derive from value.") - (inapt - :initform nil) - (inapt-face - :initarg :inapt-face - :initform 'transient-inapt-suffix) - (inapt-if - :initarg :inapt-if - :initform nil - :documentation "Inapt if predicate returns non-nil.") - (inapt-if-not - :initarg :inapt-if-not - :initform nil - :documentation "Inapt if predicate returns nil.") - (inapt-if-non-nil - :initarg :inapt-if-non-nil - :initform nil - :documentation "Inapt if variable's value is non-nil.") - (inapt-if-nil - :initarg :inapt-if-nil - :initform nil - :documentation "Inapt if variable's value is nil.") - (inapt-if-mode - :initarg :inapt-if-mode - :initform nil - :documentation "Inapt if major-mode matches value.") - (inapt-if-not-mode - :initarg :inapt-if-not-mode - :initform nil - :documentation "Inapt if major-mode does not match value.") - (inapt-if-derived - :initarg :inapt-if-derived - :initform nil - :documentation "Inapt if major-mode derives from value.") - (inapt-if-not-derived - :initarg :inapt-if-not-derived - :initform nil - :documentation "Inapt if major-mode does not derive from value.")) - "Abstract superclass for group and suffix classes. - -It is undefined what happens if more than one `if*' predicate -slot is non-nil." - :abstract t) - -(defclass transient-suffix (transient-child) - ((definition :allocation :class :initform nil) - (key :initarg :key) - (command :initarg :command) - (transient :initarg :transient) - (format :initarg :format :initform " %k %d") - (description :initarg :description :initform nil) - (face :initarg :face :initform nil) - (show-help :initarg :show-help :initform nil)) - "Superclass for suffix command.") - -(defclass transient-information (transient-suffix) - ((format :initform " %k %d") - (key :initform " ")) - "Display-only information, aligned with suffix keys. -Technically a suffix object with no associated command.") - -(defclass transient-information* (transient-information) - ((format :initform " %d")) - "Display-only information, aligned with suffix descriptions. -Technically a suffix object with no associated command.") - -(defclass transient-infix (transient-suffix) - ((transient :initform t) - (argument :initarg :argument) - (shortarg :initarg :shortarg) - (value :initform nil) - (init-value :initarg :init-value) - (unsavable :initarg :unsavable :initform nil) - (multi-value :initarg :multi-value :initform nil) - (always-read :initarg :always-read :initform nil) - (allow-empty :initarg :allow-empty :initform nil) - (history-key :initarg :history-key :initform nil) - (reader :initarg :reader :initform nil) - (prompt :initarg :prompt :initform nil) - (choices :initarg :choices :initform nil) - (format :initform " %k %d (%v)")) - "Transient infix command." - :abstract t) - -(defclass transient-argument (transient-infix) () - "Abstract superclass for infix arguments." - :abstract t) - -(defclass transient-switch (transient-argument) () - "Class used for command-line argument that can be turned on and off.") - -(defclass transient-option (transient-argument) () - "Class used for command-line argument that can take a value.") - -(defclass transient-variable (transient-infix) - ((variable :initarg :variable) - (format :initform " %k %d %v")) - "Abstract superclass for infix commands that set a variable." - :abstract t) - -(defclass transient-switches (transient-argument) - ((argument-format :initarg :argument-format) - (argument-regexp :initarg :argument-regexp)) - "Class used for sets of mutually exclusive command-line switches.") - -(defclass transient-files (transient-option) () - ((key :initform "--") - (argument :initform "--") - (multi-value :initform rest) - (reader :initform transient-read-files)) - "Class used for the \"--\" argument or similar. -All remaining arguments are treated as files. -They become the value of this argument.") - -(defclass transient-value-preset (transient-suffix) - ((transient :initform t) - (set :initarg := :initform nil)) - "Class used by the `transient-preset' suffix command.") - -;;;; Group - -(defclass transient-group (transient-child) - ((suffixes :initarg :suffixes :initform nil) - (hide :initarg :hide :initform nil) - (description :initarg :description :initform nil) - (pad-keys :initarg :pad-keys :initform nil) - (info-format :initarg :info-format :initform nil) - (setup-children :initarg :setup-children)) - "Abstract superclass of all group classes." - :abstract t) - -(defclass transient-column (transient-group) () - "Group class that displays each element on a separate line.") - -(defclass transient-row (transient-group) () - "Group class that displays all elements on a single line.") - -(defclass transient-columns (transient-group) () - "Group class that displays elements organized in columns. -Direct elements have to be groups whose elements have to be -commands or strings. Each subgroup represents a column. -This class takes care of inserting the subgroups' elements.") - -(defclass transient-subgroups (transient-group) () - "Group class that wraps other groups. - -Direct elements have to be groups whose elements have to be -commands or strings. This group inserts an empty line between -subgroups. The subgroups are responsible for displaying their -elements themselves.") - -;;; Define - -(defmacro transient-define-prefix (name arglist &rest args) - "Define NAME as a transient prefix command. - -ARGLIST are the arguments that command takes. -DOCSTRING is the documentation string and is optional. - -These arguments can optionally be followed by key-value pairs. -Each key has to be a keyword symbol, either `:class' or a keyword -argument supported by the constructor of that class. The -`transient-prefix' class is used if the class is not specified -explicitly. - -GROUPs add key bindings for infix and suffix commands and specify -how these bindings are presented in the popup buffer. At least -one GROUP has to be specified. See info node `(transient)Binding -Suffix and Infix Commands'. - -The BODY is optional. If it is omitted, then ARGLIST is also -ignored and the function definition becomes: - - (lambda () - (interactive) - (transient-setup \\='NAME)) - -If BODY is specified, then it must begin with an `interactive' -form that matches ARGLIST, and it must call `transient-setup'. -It may however call that function only when some condition is -satisfied; that is one of the reason why you might want to use -an explicit BODY. - -All transients have a (possibly nil) value, which is exported -when suffix commands are called, so that they can consume that -value. For some transients it might be necessary to have a sort -of secondary value, called a scope. Such a scope would usually -be set in the commands `interactive' form and has to be passed -to the setup function: - - (transient-setup \\='NAME nil nil :scope SCOPE) - -\(fn NAME ARGLIST [DOCSTRING] [KEYWORD VALUE]... GROUP... [BODY...])" - (declare (debug ( &define name lambda-list - [&optional lambda-doc] - [&rest keywordp sexp] - [&rest vectorp] - [&optional ("interactive" interactive) def-body])) - (indent defun) - (doc-string 3)) - (pcase-let - ((`(,class ,slots ,suffixes ,docstr ,body ,interactive-only) - (transient--expand-define-args args arglist 'transient-define-prefix))) - `(progn - (defalias ',name - ,(if body - `(lambda ,arglist ,@body) - `(lambda () - (interactive) - (transient-setup ',name)))) - (put ',name 'interactive-only ,interactive-only) - (put ',name 'function-documentation ,docstr) - (put ',name 'transient--prefix - (,(or class 'transient-prefix) :command ',name ,@slots)) - (put ',name 'transient--layout - (list ,@(cl-mapcan (lambda (s) (transient--parse-child name s)) - suffixes)))))) - -(defmacro transient-define-suffix (name arglist &rest args) - "Define NAME as a transient suffix command. - -ARGLIST are the arguments that the command takes. -DOCSTRING is the documentation string and is optional. - -These arguments can optionally be followed by key-value pairs. -Each key has to be a keyword symbol, either `:class' or a -keyword argument supported by the constructor of that class. -The `transient-suffix' class is used if the class is not -specified explicitly. - -The BODY must begin with an `interactive' form that matches -ARGLIST. The infix arguments are usually accessed by using -`transient-args' inside `interactive'. - -\(fn NAME ARGLIST [DOCSTRING] [KEYWORD VALUE]... [BODY...])" - (declare (debug ( &define name lambda-list - [&optional lambda-doc] - [&rest keywordp sexp] - [&optional ("interactive" interactive) def-body])) - (indent defun) - (doc-string 3)) - (pcase-let - ((`(,class ,slots ,_ ,docstr ,body ,interactive-only) - (transient--expand-define-args args arglist 'transient-define-suffix))) - `(progn - (defalias ',name - ,(if (and (not body) class (oref-default class definition)) - `(oref-default ',class definition) - `(lambda ,arglist ,@body))) - (put ',name 'interactive-only ,interactive-only) - (put ',name 'function-documentation ,docstr) - (put ',name 'transient--suffix - (,(or class 'transient-suffix) :command ',name ,@slots))))) - -(defmacro transient-augment-suffix (name &rest args) - "Augment existing command NAME with a new transient suffix object. -Similar to `transient-define-suffix' but define a suffix object only. -\n\(fn NAME [KEYWORD VALUE]...)" - (declare (debug (&define name [&rest keywordp sexp])) - (indent defun)) - (pcase-let - ((`(,class ,slots) - (transient--expand-define-args args nil 'transient-augment-suffix t))) - `(put ',name 'transient--suffix - (,(or class 'transient-suffix) :command ',name ,@slots)))) - -(defmacro transient-define-infix (name arglist &rest args) - "Define NAME as a transient infix command. - -ARGLIST is always ignored and reserved for future use. -DOCSTRING is the documentation string and is optional. - -At least one key-value pair is required. All transient infix -commands are equal to each other (but not eq). It is meaning- -less to define an infix command, without providing at least one -keyword argument (usually `:argument' or `:variable', depending -on the class). The suffix class defaults to `transient-switch' -and can be set using the `:class' keyword. - -The function definitions is always: - - (lambda () - (interactive) - (let ((obj (transient-suffix-object))) - (transient-infix-set obj (transient-infix-read obj))) - (transient--show)) - -`transient-infix-read' and `transient-infix-set' are generic -functions. Different infix commands behave differently because -the concrete methods are different for different infix command -classes. In rare case the above command function might not be -suitable, even if you define your own infix command class. In -that case you have to use `transient-define-suffix' to define -the infix command and use t as the value of the `:transient' -keyword. - -\(fn NAME ARGLIST [DOCSTRING] KEYWORD VALUE [KEYWORD VALUE]...)" - (declare (debug ( &define name lambda-list - [&optional lambda-doc] - keywordp sexp - [&rest keywordp sexp])) - (indent defun) - (doc-string 3)) - (pcase-let - ((`(,class ,slots ,_ ,docstr ,_ ,interactive-only) - (transient--expand-define-args args arglist 'transient-define-infix t))) - `(progn - (defalias ',name #'transient--default-infix-command) - (put ',name 'interactive-only ,interactive-only) - (put ',name 'completion-predicate #'transient--suffix-only) - (put ',name 'function-documentation ,docstr) - (put ',name 'transient--suffix - (,(or class 'transient-switch) :command ',name ,@slots))))) - -(defalias 'transient-define-argument #'transient-define-infix - "Define NAME as a transient infix command. - -Only use this alias to define an infix command that actually -sets an infix argument. To define a infix command that, for -example, sets a variable, use `transient-define-infix' instead. - -\(fn NAME ARGLIST [DOCSTRING] [KEYWORD VALUE]...)") - -(defun transient--default-infix-command () - ;; Most infix commands are but an alias for this command. - "Cannot show any documentation for this transient infix command. - -When you request help for an infix command using `transient-help', that -usually shows the respective man-page and tries to jump to the location -where the respective argument is being described. - -If no man-page is specified for the containing transient menu, then the -docstring is displayed instead, if any. - -If the infix command doesn't have a docstring, as is the case here, then -this docstring is displayed instead, because technically infix commands -are aliases for `transient--default-infix-command'. - -`describe-function' also shows the docstring of the infix command, -falling back to that of the same aliased command." - (interactive) - (let ((obj (transient-suffix-object))) - (transient-infix-set obj (transient-infix-read obj))) - (transient--show)) -(put 'transient--default-infix-command 'interactive-only t) -(put 'transient--default-infix-command 'completion-predicate - #'transient--suffix-only) - -(define-advice find-function-advised-original - (:around (fn func) transient-default-infix) - "Return nil instead of `transient--default-infix-command'. -When using `find-function' to jump to the definition of a transient -infix command/argument, then we want to actually jump to that, not to -the definition of `transient--default-infix-command', which all infix -commands are aliases for." - (let ((val (funcall fn func))) - (and val (not (eq val 'transient--default-infix-command)) val))) - -(eval-and-compile ;transient--expand-define-args - (defun transient--expand-define-args (args &optional arglist form nobody) - ;; ARGLIST and FORM are only optional for backward compatibility. - ;; This is necessary because "emoji.el" from Emacs 29 calls this - ;; function directly, with just one argument. - (unless (listp arglist) - (error "Mandatory ARGLIST is missing")) - (let (class keys suffixes docstr declare (interactive-only t)) - (when (stringp (car args)) - (setq docstr (pop args))) - (while (keywordp (car args)) - (let ((k (pop args)) - (v (pop args))) - (if (eq k :class) - (setq class v) - (push k keys) - (push v keys)))) - (while (let ((arg (car args))) - (or (vectorp arg) - (and arg (symbolp arg)))) - (push (pop args) suffixes)) - (when (eq (car-safe (car args)) 'declare) - (setq declare (car args)) - (setq args (cdr args)) - (when-let ((int (assq 'interactive-only declare))) - (setq interactive-only (cadr int)) - (delq int declare)) - (unless (cdr declare) - (setq declare nil))) - (cond - ((not args)) - (nobody - (error "%s: No function body allowed" form)) - ((not (eq (car-safe (nth (if declare 1 0) args)) 'interactive)) - (error "%s: Interactive form missing" form))) - (list (if (eq (car-safe class) 'quote) - (cadr class) - class) - (nreverse keys) - (nreverse suffixes) - docstr - (if declare (cons declare args) args) - interactive-only)))) - -(defun transient--parse-child (prefix spec) - (cl-typecase spec - (null (error "Invalid transient--parse-child spec: %s" spec)) - (symbol (let ((value (symbol-value spec))) - (if (and (listp value) - (or (listp (car value)) - (vectorp (car value)))) - (cl-mapcan (lambda (s) (transient--parse-child prefix s)) value) - (transient--parse-child prefix value)))) - (vector (and-let* ((c (transient--parse-group prefix spec))) (list c))) - (list (and-let* ((c (transient--parse-suffix prefix spec))) (list c))) - (string (list spec)) - (t (error "Invalid transient--parse-child spec: %s" spec)))) - -(defun transient--parse-group (prefix spec) - (setq spec (append spec nil)) - (cl-symbol-macrolet - ((car (car spec)) - (pop (pop spec))) - (let (level class args) - (when (integerp car) - (setq level pop)) - (when (stringp car) - (setq args (plist-put args :description pop))) - (while (keywordp car) - (let ((key pop) - (val pop)) - (cond ((eq key :class) - (setq class (macroexp-quote val))) - ((or (symbolp val) - (and (listp val) (not (eq (car val) 'lambda)))) - (setq args (plist-put args key (macroexp-quote val)))) - ((setq args (plist-put args key val)))))) - (unless (or spec class (not (plist-get args :setup-children))) - (message "WARNING: %s: When %s is used, %s must also be specified" - 'transient-define-prefix :setup-children :class)) - (list 'vector - (or level transient--default-child-level) - (cond (class) - ((or (vectorp car) - (and car (symbolp car))) - (quote 'transient-columns)) - ((quote 'transient-column))) - (and args (cons 'list args)) - (cons 'list - (cl-mapcan (lambda (s) (transient--parse-child prefix s)) - spec)))))) - -(defun transient--parse-suffix (prefix spec) - (let (level class args) - (cl-symbol-macrolet - ((car (car spec)) - (pop (pop spec))) - (when (integerp car) - (setq level pop)) - (when (or (stringp car) - (vectorp car)) - (setq args (plist-put args :key pop))) - (cond - ((or (stringp car) - (and (eq (car-safe car) 'lambda) - (not (commandp car)))) - (setq args (plist-put args :description pop))) - ((and (symbolp car) - (not (keywordp car)) - (not (commandp car)) - (commandp (cadr spec))) - (setq args (plist-put args :description (macroexp-quote pop))))) - (cond - ((memq car '(:info :info*))) - ((keywordp car) - (error "Need command, `:info' or `:info*', got `%s'" car)) - ((symbolp car) - (setq args (plist-put args :command (macroexp-quote pop)))) - ((and (commandp car) - (not (stringp car))) - (let ((cmd pop) - (sym (intern - (format "transient:%s:%s" - prefix - (let ((desc (plist-get args :description))) - (if (and (stringp desc) - (length< desc 16)) - desc - (plist-get args :key))))))) - (setq args (plist-put - args :command - `(prog1 ',sym - (put ',sym 'interactive-only t) - (put ',sym 'completion-predicate #'transient--suffix-only) - (defalias ',sym - ,(if (eq (car-safe cmd) 'lambda) - cmd - (macroexp-quote cmd)))))))) - ((or (stringp car) - (and car (listp car))) - (let ((arg pop) - (sym nil)) - (cl-typecase arg - (list - (setq args (plist-put args :shortarg (car arg))) - (setq args (plist-put args :argument (cadr arg))) - (setq arg (cadr arg))) - (string - (when-let ((shortarg (transient--derive-shortarg arg))) - (setq args (plist-put args :shortarg shortarg))) - (setq args (plist-put args :argument arg)))) - (setq sym (intern (format "transient:%s:%s" prefix arg))) - (setq args (plist-put - args :command - `(prog1 ',sym - (put ',sym 'interactive-only t) - (put ',sym 'completion-predicate #'transient--suffix-only) - (defalias ',sym #'transient--default-infix-command)))) - (cond ((and car (not (keywordp car))) - (setq class 'transient-option) - (setq args (plist-put args :reader (macroexp-quote pop)))) - ((not (string-suffix-p "=" arg)) - (setq class 'transient-switch)) - (t - (setq class 'transient-option))))) - (t - (error "Needed command or argument, got %S" car))) - (while (keywordp car) - (let ((key pop) - (val pop)) - (cond ((eq key :class) (setq class val)) - ((eq key :level) (setq level val)) - ((eq key :info) - (setq class 'transient-information) - (setq args (plist-put args :description val))) - ((eq key :info*) - (setq class 'transient-information*) - (setq args (plist-put args :description val))) - ((eq (car-safe val) '\,) - (setq args (plist-put args key (cadr val)))) - ((or (symbolp val) - (and (listp val) (not (eq (car val) 'lambda)))) - (setq args (plist-put args key (macroexp-quote val)))) - ((setq args (plist-put args key val))))))) - (unless (plist-get args :key) - (when-let ((shortarg (plist-get args :shortarg))) - (setq args (plist-put args :key shortarg)))) - (list 'list - (or level transient--default-child-level) - (macroexp-quote (or class 'transient-suffix)) - (cons 'list args)))) - -(defun transient--derive-shortarg (arg) - (save-match-data - (and (string-match "\\`\\(-[a-zA-Z]\\)\\(\\'\\|=\\)" arg) - (match-string 1 arg)))) - -(defun transient-command-completion-not-suffix-only-p (symbol _buffer) - "Say whether SYMBOL should be offered as a completion. -If the value of SYMBOL's `completion-predicate' property is -`transient--suffix-only', then return nil, otherwise return t. -This is the case when a command should only ever be used as a -suffix of a transient prefix command (as opposed to bindings -in regular keymaps or by using `execute-extended-command')." - (not (eq (get symbol 'completion-predicate) 'transient--suffix-only))) - -(defalias 'transient--suffix-only #'ignore - "Ignore ARGUMENTS, do nothing, and return nil. -Also see `transient-command-completion-not-suffix-only-p'. -Only use this alias as the value of the `completion-predicate' -symbol property.") - -(when (and (boundp 'read-extended-command-predicate) ; since Emacs 28.1 - (not read-extended-command-predicate)) - (setq read-extended-command-predicate - #'transient-command-completion-not-suffix-only-p)) - -(defun transient-parse-suffix (prefix suffix) - "Parse SUFFIX, to be added to PREFIX. -PREFIX is a prefix command, a symbol. -SUFFIX is a suffix command or a group specification (of - the same forms as expected by `transient-define-prefix'). -Intended for use in a group's `:setup-children' function." - (cl-assert (and prefix (symbolp prefix))) - (eval (car (transient--parse-child prefix suffix)) t)) - -(defun transient-parse-suffixes (prefix suffixes) - "Parse SUFFIXES, to be added to PREFIX. -PREFIX is a prefix command, a symbol. -SUFFIXES is a list of suffix command or a group specification - (of the same forms as expected by `transient-define-prefix'). -Intended for use in a group's `:setup-children' function." - (cl-assert (and prefix (symbolp prefix))) - (mapcar (apply-partially #'transient-parse-suffix prefix) suffixes)) - -;;; Edit - -(defun transient--insert-suffix (prefix loc suffix action &optional keep-other) - (let* ((suf (cl-etypecase suffix - (vector (transient--parse-group prefix suffix)) - (list (transient--parse-suffix prefix suffix)) - (string suffix))) - (mem (transient--layout-member loc prefix)) - (elt (car mem))) - (setq suf (eval suf t)) - (cond - ((not mem) - (message "Cannot insert %S into %s; %s not found" - suffix prefix loc)) - ((or (and (vectorp suffix) (not (vectorp elt))) - (and (listp suffix) (vectorp elt)) - (and (stringp suffix) (vectorp elt))) - (message "Cannot place %S into %s at %s; %s" - suffix prefix loc - "suffixes and groups cannot be siblings")) - (t - (when-let* ((bindingp (listp suf)) - (key (transient--spec-key suf)) - (conflict (car (transient--layout-member key prefix))) - (conflictp - (and (not (and (eq action 'replace) - (eq conflict elt))) - (or (not keep-other) - (eq (plist-get (nth 2 suf) :command) - (plist-get (nth 2 conflict) :command))) - (equal (transient--suffix-predicate suf) - (transient--suffix-predicate conflict))))) - (transient-remove-suffix prefix key)) - (pcase-exhaustive action - ('insert (setcdr mem (cons elt (cdr mem))) - (setcar mem suf)) - ('append (setcdr mem (cons suf (cdr mem)))) - ('replace (setcar mem suf))))))) - -;;;###autoload -(defun transient-insert-suffix (prefix loc suffix &optional keep-other) - "Insert a SUFFIX into PREFIX before LOC. -PREFIX is a prefix command, a symbol. -SUFFIX is a suffix command or a group specification (of - the same forms as expected by `transient-define-prefix'). -LOC is a command, a key vector, a key description (a string - as returned by `key-description'), or a coordination list - (whose last element may also be a command or key). -Remove a conflicting binding unless optional KEEP-OTHER is - non-nil. -See info node `(transient)Modifying Existing Transients'." - (declare (indent defun)) - (transient--insert-suffix prefix loc suffix 'insert keep-other)) - -;;;###autoload -(defun transient-append-suffix (prefix loc suffix &optional keep-other) - "Insert a SUFFIX into PREFIX after LOC. -PREFIX is a prefix command, a symbol. -SUFFIX is a suffix command or a group specification (of - the same forms as expected by `transient-define-prefix'). -LOC is a command, a key vector, a key description (a string - as returned by `key-description'), or a coordination list - (whose last element may also be a command or key). -Remove a conflicting binding unless optional KEEP-OTHER is - non-nil. -See info node `(transient)Modifying Existing Transients'." - (declare (indent defun)) - (transient--insert-suffix prefix loc suffix 'append keep-other)) - -;;;###autoload -(defun transient-replace-suffix (prefix loc suffix) - "Replace the suffix at LOC in PREFIX with SUFFIX. -PREFIX is a prefix command, a symbol. -SUFFIX is a suffix command or a group specification (of - the same forms as expected by `transient-define-prefix'). -LOC is a command, a key vector, a key description (a string - as returned by `key-description'), or a coordination list - (whose last element may also be a command or key). -See info node `(transient)Modifying Existing Transients'." - (declare (indent defun)) - (transient--insert-suffix prefix loc suffix 'replace)) - -;;;###autoload -(defun transient-remove-suffix (prefix loc) - "Remove the suffix or group at LOC in PREFIX. -PREFIX is a prefix command, a symbol. -LOC is a command, a key vector, a key description (a string - as returned by `key-description'), or a coordination list - (whose last element may also be a command or key). -See info node `(transient)Modifying Existing Transients'." - (declare (indent defun)) - (transient--layout-member loc prefix 'remove)) - -(defun transient-get-suffix (prefix loc) - "Return the suffix or group at LOC in PREFIX. -PREFIX is a prefix command, a symbol. -LOC is a command, a key vector, a key description (a string - as returned by `key-description'), or a coordination list - (whose last element may also be a command or key). -See info node `(transient)Modifying Existing Transients'." - (if-let ((mem (transient--layout-member loc prefix))) - (car mem) - (error "%s not found in %s" loc prefix))) - -(defun transient-suffix-put (prefix loc prop value) - "Edit the suffix at LOC in PREFIX, setting PROP to VALUE. -PREFIX is a prefix command, a symbol. -SUFFIX is a suffix command or a group specification (of - the same forms as expected by `transient-define-prefix'). -LOC is a command, a key vector, a key description (a string - as returned by `key-description'), or a coordination list - (whose last element may also be a command or key). -See info node `(transient)Modifying Existing Transients'." - (let ((suf (transient-get-suffix prefix loc))) - (setf (elt suf 2) - (plist-put (elt suf 2) prop value)))) - -(defun transient--layout-member (loc prefix &optional remove) - (let ((val (or (get prefix 'transient--layout) - (error "%s is not a transient command" prefix)))) - (when (listp loc) - (while (integerp (car loc)) - (let* ((children (if (vectorp val) (aref val 3) val)) - (mem (transient--nthcdr (pop loc) children))) - (if (and remove (not loc)) - (let ((rest (delq (car mem) children))) - (if (vectorp val) - (aset val 3 rest) - (put prefix 'transient--layout rest)) - (setq val nil)) - (setq val (if loc (car mem) mem))))) - (setq loc (car loc))) - (if loc - (transient--layout-member-1 (transient--kbd loc) val remove) - val))) - -(defun transient--layout-member-1 (loc layout remove) - (cond ((listp layout) - (seq-some (lambda (elt) (transient--layout-member-1 loc elt remove)) - layout)) - ((vectorp (car (aref layout 3))) - (seq-some (lambda (elt) (transient--layout-member-1 loc elt remove)) - (aref layout 3))) - (remove - (aset layout 3 - (delq (car (transient--group-member loc layout)) - (aref layout 3))) - nil) - ((transient--group-member loc layout)))) - -(defun transient--group-member (loc group) - (cl-member-if (lambda (suffix) - (and (listp suffix) - (let* ((def (nth 2 suffix)) - (cmd (plist-get def :command))) - (if (symbolp loc) - (eq cmd loc) - (equal (transient--kbd - (or (plist-get def :key) - (transient--command-key cmd))) - loc))))) - (aref group 3))) - -(defun transient--kbd (keys) - (when (vectorp keys) - (setq keys (key-description keys))) - (when (stringp keys) - (setq keys (kbd keys))) - keys) - -(defun transient--spec-key (spec) - (let ((plist (nth 2 spec))) - (or (plist-get plist :key) - (transient--command-key - (plist-get plist :command))))) - -(defun transient--command-key (cmd) - (and-let* ((obj (transient--suffix-prototype cmd))) - (cond ((slot-boundp obj 'key) - (oref obj key)) - ((slot-exists-p obj 'shortarg) - (if (slot-boundp obj 'shortarg) - (oref obj shortarg) - (transient--derive-shortarg (oref obj argument))))))) - -(defun transient--nthcdr (n list) - (nthcdr (if (< n 0) (- (length list) (abs n)) n) list)) - -;;; Variables - -(defvar transient-current-prefix nil - "The transient from which this suffix command was invoked. -This is an object representing that transient, use -`transient-current-command' to get the respective command.") - -(defvar transient-current-command nil - "The transient from which this suffix command was invoked. -This is a symbol representing that transient, use -`transient-current-prefix' to get the respective object.") - -(defvar transient-current-suffixes nil - "The suffixes of the transient from which this suffix command was invoked. -This is a list of objects. Usually it is sufficient to instead -use the function `transient-args', which returns a list of -values. In complex cases it might be necessary to use this -variable instead.") - -(defvar transient-exit-hook nil - "Hook run after exiting a transient.") - -(defvar transient-setup-buffer-hook nil - "Hook run when setting up the transient buffer. -That buffer is current and empty when this hook runs.") - -(defvar transient--prefix nil) -(defvar transient--layout nil) -(defvar transient--suffixes nil) - -(defconst transient--stay t "Do not exit the transient.") -(defconst transient--exit nil "Do exit the transient.") - -(defvar transient--exitp nil "Whether to exit the transient.") -(defvar transient--showp nil "Whether to show the transient popup buffer.") -(defvar transient--helpp nil "Whether help-mode is active.") -(defvar transient--editp nil "Whether edit-mode is active.") - -(defvar transient--refreshp nil - "Whether to refresh the transient completely.") - -(defvar transient--all-levels-p nil - "Whether temporary display of suffixes on all levels is active.") - -(defvar transient--timer nil) - -(defvar transient--stack nil) - -(defvar transient--minibuffer-depth 0) - -(defvar transient--buffer-name " *transient*" - "Name of the transient buffer.") - -(defvar transient--buffer nil - "The transient menu buffer.") - -(defvar transient--window nil - "The window used to display the transient popup buffer.") - -(defvar transient--original-window nil - "The window that was selected before the transient was invoked. -Usually it remains selected while the transient is active.") - -(defvar transient--original-buffer nil - "The buffer that was current before the transient was invoked. -Usually it remains current while the transient is active.") - -(defvar transient--restore-winconf nil - "Window configuration to restore after exiting help.") - -(defvar transient--shadowed-buffer nil - "The buffer that is temporarily shadowed by the transient buffer. -This is bound while the suffix predicate is being evaluated and while -drawing in the transient buffer.") - -(defvar transient--pending-suffix nil - "The suffix that is currently being processed. -This is bound while the suffix predicate is being evaluated, -and while functions that return faces are being evaluated.") - -(defvar transient--pending-group nil - "The group that is currently being processed. -This is bound while the suffixes are drawn in the transient buffer.") - -(defvar transient--debug nil - "Whether to put debug information into *Messages*.") - -(defvar transient--history nil) - -(defvar transient--scroll-commands - '(transient-scroll-up - transient-scroll-down - mwheel-scroll - scroll-bar-toolkit-scroll)) - -;;; Identities - -(defun transient-prefix-object () - "Return the current prefix as an object. - -While a transient is being setup or refreshed (which involves -preparing its suffixes) the variable `transient--prefix' can be -used to access the prefix object. Thus this is what has to be -used in suffix methods such as `transient-format-description', -and in object-specific functions that are stored in suffix slots -such as `description'. - -When a suffix command is invoked (i.e., in its `interactive' form -and function body) then the variable `transient-current-prefix' -has to be used instead. - -Two distinct variables are needed, because any prefix may itself -be used as a suffix of another prefix, and such sub-prefixes have -to be able to tell themselves apart from the prefix they were -invoked from. - -Regular suffix commands, which are not prefixes, do not have to -concern themselves with this distinction, so they can use this -function instead. In the context of a plain suffix, it always -returns the value of the appropriate variable." - (or transient--prefix transient-current-prefix)) - -(defun transient-suffix-object (&optional command) - "Return the object associated with the current suffix command. - -Each suffix commands is associated with an object, which holds -additional information about the suffix, such as its value (in -the case of an infix command, which is a kind of suffix command). - -This function is intended to be called by infix commands, which -are usually aliases of `transient--default-infix-command', which -is defined like this: - - (defun transient--default-infix-command () - (interactive) - (let ((obj (transient-suffix-object))) - (transient-infix-set obj (transient-infix-read obj))) - (transient--show)) - -\(User input is read outside of `interactive' to prevent the -command from being added to `command-history'. See #23.) - -Such commands need to be able to access their associated object -to guide how `transient-infix-read' reads the new value and to -store the read value. Other suffix commands (including non-infix -commands) may also need the object to guide their behavior. - -This function attempts to return the object associated with the -current suffix command even if the suffix command was not invoked -from a transient. (For some suffix command that is a valid thing -to do, for others it is not.) In that case nil may be returned, -if the command was not defined using one of the macros intended -to define such commands. - -The optional argument COMMAND is intended for internal use. If -you are contemplating using it in your own code, then you should -probably use this instead: - - (get COMMAND \\='transient--suffix)" - (when command - (cl-check-type command command)) - (cond - (transient--pending-suffix) - ((or transient--prefix - transient-current-prefix) - (let ((suffixes - (cl-remove-if-not - (lambda (obj) - (eq (oref obj command) - (or command - (if (eq this-command 'transient-set-level) - ;; This is how it can look up for which - ;; command it is setting the level. - this-original-command - this-command)))) - (or transient--suffixes - transient-current-suffixes)))) - (or (and (cdr suffixes) - (cl-find-if - (lambda (obj) - (equal (listify-key-sequence (transient--kbd (oref obj key))) - (listify-key-sequence (this-command-keys)))) - suffixes)) - (car suffixes)))) - ((and-let* ((obj (transient--suffix-prototype (or command this-command))) - (obj (clone obj))) - (progn ; work around debbugs#31840 - (transient-init-scope obj) - (transient-init-value obj) - obj))))) - -(defun transient--suffix-prototype (command) - (or (get command 'transient--suffix) - (seq-some (lambda (cmd) (get cmd 'transient--suffix)) - (function-alias-p command)))) - -;;; Keymaps - -(defvar-keymap transient-base-map - :doc "Parent of other keymaps used by Transient. - -This is the parent keymap of all the keymaps that are used in -all transients: `transient-map' (which in turn is the parent -of the transient-specific keymaps), `transient-edit-map' and -`transient-sticky-map'. - -If you change a binding here, then you might also have to edit -`transient-sticky-map' and `transient-common-commands'. While -the latter isn't a proper transient prefix command, it can be -edited using the same functions as used for transients. - -If you add a new command here, then you must also add a binding -to `transient-predicate-map'." - "ESC ESC ESC" #'transient-quit-all - "C-g" #'transient-quit-one - "C-q" #'transient-quit-all - "C-z" #'transient-suspend - "C-v" #'transient-scroll-up - "C-M-v" #'transient-scroll-down - "<next>" #'transient-scroll-up - "<prior>" #'transient-scroll-down) - -(defvar-keymap transient-map - :doc "Top-level keymap used by all transients. - -If you add a new command here, then you must also add a binding -to `transient-predicate-map'. Also see `transient-base-map'." - :parent transient-base-map - "C-u" #'universal-argument - "C--" #'negative-argument - "C-t" #'transient-show - "?" #'transient-help - "C-h" #'transient-help - ;; Also bound to "C-x p" and "C-x n" in transient-common-commands. - "C-M-p" #'transient-history-prev - "C-M-n" #'transient-history-next) - -(defvar-keymap transient-edit-map - :doc "Keymap that is active while a transient in is in \"edit mode\"." - :parent transient-base-map - "?" #'transient-help - "C-h" #'transient-help - "C-x l" #'transient-set-level) - -(defvar-keymap transient-sticky-map - :doc "Keymap that is active while an incomplete key sequence is active." - :parent transient-base-map - "C-g" #'transient-quit-seq) - -(defvar transient--common-command-prefixes '(?\C-x)) - -(put 'transient-common-commands - 'transient--layout - (list - (eval - (car (transient--parse-child - 'transient-common-commands - (vector - :hide - (lambda () - (and (not (memq - (car (bound-and-true-p transient--redisplay-key)) - transient--common-command-prefixes)) - (not transient-show-common-commands))) - (vector - "Value commands" - (list "C-x s " "Set" #'transient-set) - (list "C-x C-s" "Save" #'transient-save) - (list "C-x C-k" "Reset" #'transient-reset) - (list "C-x p " "Previous value" #'transient-history-prev) - (list "C-x n " "Next value" #'transient-history-next)) - (vector - "Sticky commands" - ;; Like `transient-sticky-map' except that - ;; "C-g" has to be bound to a different command. - (list "C-g" "Quit prefix or transient" #'transient-quit-one) - (list "C-q" "Quit transient stack" #'transient-quit-all) - (list "C-z" "Suspend transient stack" #'transient-suspend)) - (vector - "Customize" - (list "C-x t" 'transient-toggle-common :description - (lambda () - (if transient-show-common-commands - "Hide common commands" - "Show common permanently"))) - (list "C-x l" "Show/hide suffixes" #'transient-set-level) - (list "C-x a" #'transient-toggle-level-limit))))) - t))) - -(defvar-keymap transient-popup-navigation-map - :doc "One of the keymaps used when popup navigation is enabled. -See `transient-enable-popup-navigation'." - "<down-mouse-1>" #'transient-noop - "<up>" #'transient-backward-button - "<down>" #'transient-forward-button - "C-r" #'transient-isearch-backward - "C-s" #'transient-isearch-forward - "M-RET" #'transient-push-button) - -(defvar-keymap transient-button-map - :doc "One of the keymaps used when popup navigation is enabled. -See `transient-enable-popup-navigation'." - "<mouse-1>" #'transient-push-button - "<mouse-2>" #'transient-push-button) - -(defvar-keymap transient-resume-mode-map - :doc "Keymap for `transient-resume-mode'. - -This keymap remaps every command that would usually just quit the -documentation buffer to `transient-resume', which additionally -resumes the suspended transient." - "<remap> <Man-quit>" #'transient-resume - "<remap> <Info-exit>" #'transient-resume - "<remap> <quit-window>" #'transient-resume) - -(defvar-keymap transient-predicate-map - :doc "Base keymap used to map common commands to their transient behavior. - -The \"transient behavior\" of a command controls, among other -things, whether invoking the command causes the transient to be -exited or not, and whether infix arguments are exported before -doing so. - -Each \"key\" is a command that is common to all transients and -that is bound in `transient-map', `transient-edit-map', -`transient-sticky-map' and/or `transient-common-command'. - -Each binding is a \"pre-command\", a function that controls the -transient behavior of the respective command. - -For transient commands that are bound in individual transients, -the transient behavior is specified using the `:transient' slot -of the corresponding object." - "<transient-suspend>" #'transient--do-suspend - "<transient-help>" #'transient--do-stay - "<transient-set-level>" #'transient--do-stay - "<transient-history-prev>" #'transient--do-stay - "<transient-history-next>" #'transient--do-stay - "<universal-argument>" #'transient--do-stay - "<universal-argument-more>" #'transient--do-stay - "<negative-argument>" #'transient--do-minus - "<digit-argument>" #'transient--do-stay - "<top-level>" #'transient--do-quit-all - "<transient-quit-all>" #'transient--do-quit-all - "<transient-quit-one>" #'transient--do-quit-one - "<transient-quit-seq>" #'transient--do-stay - "<transient-show>" #'transient--do-stay - "<transient-update>" #'transient--do-stay - "<transient-toggle-common>" #'transient--do-stay - "<transient-set>" #'transient--do-call - "<transient-set-and-exit>" #'transient--do-exit - "<transient-save>" #'transient--do-call - "<transient-save-and-exit>" #'transient--do-exit - "<transient-reset>" #'transient--do-call - "<describe-key-briefly>" #'transient--do-stay - "<describe-key>" #'transient--do-stay - "<transient-scroll-up>" #'transient--do-stay - "<transient-scroll-down>" #'transient--do-stay - "<mwheel-scroll>" #'transient--do-stay - "<scroll-bar-toolkit-scroll>" #'transient--do-stay - "<transient-noop>" #'transient--do-noop - "<transient-mouse-push-button>" #'transient--do-move - "<transient-push-button>" #'transient--do-push-button - "<transient-backward-button>" #'transient--do-move - "<transient-forward-button>" #'transient--do-move - "<transient-isearch-backward>" #'transient--do-move - "<transient-isearch-forward>" #'transient--do-move - ;; If a valid but incomplete prefix sequence is followed by - ;; an unbound key, then Emacs calls the `undefined' command - ;; but does not set `this-command', `this-original-command' - ;; or `real-this-command' accordingly. Instead they are nil. - "<nil>" #'transient--do-warn - ;; Bound to the `mouse-movement' event, this command is similar - ;; to `ignore'. - "<ignore-preserving-kill-region>" #'transient--do-noop) - -(defvar transient--transient-map nil) -(defvar transient--predicate-map nil) -(defvar transient--redisplay-map nil) -(defvar transient--redisplay-key nil) - -(defun transient--push-keymap (var) - (let ((map (symbol-value var))) - (transient--debug " push %s%s" var (if map "" " VOID")) - (when map - (with-demoted-errors "transient--push-keymap: %S" - (internal-push-keymap map 'overriding-terminal-local-map))))) - -(defun transient--pop-keymap (var) - (let ((map (symbol-value var))) - (when map - (transient--debug " pop %s" var) - (with-demoted-errors "transient--pop-keymap: %S" - (internal-pop-keymap map 'overriding-terminal-local-map))))) - -(defun transient--make-transient-map () - (let ((map (make-sparse-keymap))) - (set-keymap-parent map (if transient--editp - transient-edit-map - transient-map)) - (dolist (obj transient--suffixes) - (let ((key (oref obj key))) - (when (vectorp key) - (setq key (key-description key)) - (oset obj key key)) - (when transient-substitute-key-function - (setq key (save-match-data - (funcall transient-substitute-key-function obj))) - (oset obj key key)) - (let* ((kbd (kbd key)) - (cmd (oref obj command)) - (alt (transient--lookup-key map kbd))) - (cond ((not alt) - (define-key map kbd cmd)) - ((eq alt cmd)) - ((transient--inapt-suffix-p obj)) - ((and-let* ((obj (transient-suffix-object alt))) - (transient--inapt-suffix-p obj)) - (define-key map kbd cmd)) - (transient-detect-key-conflicts - (error "Cannot bind %S to %s and also %s" - (string-trim key) cmd alt)) - ((define-key map kbd cmd)))))) - (when-let ((b (keymap-lookup map "-"))) (keymap-set map "<kp-subtract>" b)) - (when-let ((b (keymap-lookup map "="))) (keymap-set map "<kp-equal>" b)) - (when-let ((b (keymap-lookup map "+"))) (keymap-set map "<kp-add>" b)) - (when transient-enable-popup-navigation - ;; `transient--make-redisplay-map' maps only over bindings that are - ;; directly in the base keymap, so that cannot be a composed keymap. - (set-keymap-parent - map (make-composed-keymap - (keymap-parent map) - transient-popup-navigation-map))) - map)) - -(defun transient--make-predicate-map () - (let* ((default (transient--resolve-pre-command - (oref transient--prefix transient-suffix))) - (return (and transient--stack (eq default t))) - (map (make-sparse-keymap))) - (set-keymap-parent map transient-predicate-map) - (when (or (and (slot-boundp transient--prefix 'transient-switch-frame) - (transient--resolve-pre-command - (not (oref transient--prefix transient-switch-frame)))) - (memq (transient--resolve-pre-command - (oref transient--prefix transient-non-suffix)) - '(nil transient--do-warn transient--do-noop))) - (define-key map [handle-switch-frame] #'transient--do-suspend)) - (dolist (obj transient--suffixes) - (let* ((cmd (oref obj command)) - (kind (cond ((get cmd 'transient--prefix) 'prefix) - ((cl-typep obj 'transient-infix) 'infix) - (t 'suffix)))) - (cond - ((oref obj inapt) - (define-key map (vector cmd) #'transient--do-warn-inapt)) - ((slot-boundp obj 'transient) - (define-key map (vector cmd) - (pcase (list kind - (transient--resolve-pre-command (oref obj transient)) - return) - (`(prefix t ,_) #'transient--do-recurse) - (`(prefix nil ,_) #'transient--do-stack) - (`(infix t ,_) #'transient--do-stay) - (`(suffix t ,_) #'transient--do-call) - ('(suffix nil t) #'transient--do-return) - (`(,_ nil ,_) #'transient--do-exit) - (`(,_ ,do ,_) do)))) - ((not (lookup-key transient-predicate-map (vector cmd))) - (define-key map (vector cmd) - (pcase (list kind default return) - (`(prefix ,(or 'transient--do-stay 'transient--do-call) ,_) - #'transient--do-recurse) - (`(prefix t ,_) #'transient--do-recurse) - (`(prefix ,_ ,_) #'transient--do-stack) - (`(infix ,_ ,_) #'transient--do-stay) - (`(suffix t ,_) #'transient--do-call) - ('(suffix nil t) #'transient--do-return) - (`(suffix nil ,_) #'transient--do-exit) - (`(suffix ,do ,_) do))))))) - map)) - -(defun transient--make-redisplay-map () - (setq transient--redisplay-key - (pcase this-command - ('transient-update - (setq transient--showp t) - (setq unread-command-events - (listify-key-sequence (this-single-command-raw-keys)))) - ('transient-quit-seq - (setq unread-command-events - (butlast (listify-key-sequence - (this-single-command-raw-keys)) - 2)) - (butlast transient--redisplay-key)) - (_ nil))) - (let ((topmap (make-sparse-keymap)) - (submap (make-sparse-keymap))) - (when transient--redisplay-key - (define-key topmap (vconcat transient--redisplay-key) submap) - (set-keymap-parent submap transient-sticky-map)) - (map-keymap-internal - (lambda (key def) - (when (and (not (eq key ?\e)) - (listp def) - (keymapp def)) - (define-key topmap (vconcat transient--redisplay-key (list key)) - #'transient-update))) - (if transient--redisplay-key - (let ((key (vconcat transient--redisplay-key))) - (or (lookup-key transient--transient-map key) - (and-let* ((regular (lookup-key local-function-key-map key))) - (lookup-key transient--transient-map (vconcat regular))))) - transient--transient-map)) - topmap)) - -;;; Setup - -(defun transient-setup (&optional name layout edit &rest params) - "Setup the transient specified by NAME. - -This function is called by transient prefix commands to setup the -transient. In that case NAME is mandatory, LAYOUT and EDIT must -be nil and PARAMS may be (but usually is not) used to set, e.g., -the \"scope\" of the transient (see `transient-define-prefix'). - -This function is also called internally, in which case LAYOUT and -EDIT may be non-nil." - (transient--debug 'setup) - (transient--with-emergency-exit :setup - (cond - ((not name) - ;; Switching between regular and edit mode. - (transient--pop-keymap 'transient--transient-map) - (transient--pop-keymap 'transient--redisplay-map) - (setq name (oref transient--prefix command)) - (setq params (list :scope (oref transient--prefix scope)))) - (transient--prefix - ;; Invoked as a ":transient-non-suffix 'transient--do-{stay,call}" - ;; of an outer prefix. Unlike the usual `transient--do-stack', - ;; these predicates fail to clean up after the outer prefix. - (transient--pop-keymap 'transient--transient-map) - (transient--pop-keymap 'transient--redisplay-map)) - ((not (or layout ; resuming parent/suspended prefix - transient-current-command)) ; entering child prefix - (transient--stack-zap)) ; replace suspended prefix, if any - (edit - ;; Returning from help to edit. - (setq transient--editp t))) - (transient--init-objects name layout params) - (transient--init-keymaps) - (transient--history-init transient--prefix) - (setq transient--original-window (selected-window)) - (setq transient--original-buffer (current-buffer)) - (setq transient--minibuffer-depth (minibuffer-depth)) - (transient--redisplay) - (transient--init-transient) - (transient--suspend-which-key-mode))) - -(cl-defgeneric transient-setup-children (group children) - "Setup the CHILDREN of GROUP. -If the value of the `setup-children' slot is non-nil, then call -that function with CHILDREN as the only argument and return the -value. Otherwise return CHILDREN as is." - (if (slot-boundp group 'setup-children) - (funcall (oref group setup-children) children) - children)) - -(defun transient--init-keymaps () - (setq transient--predicate-map (transient--make-predicate-map)) - (setq transient--transient-map (transient--make-transient-map)) - (setq transient--redisplay-map (transient--make-redisplay-map))) - -(defun transient--init-objects (&optional name layout params) - (if name - (setq transient--prefix (transient--init-prefix name params)) - (setq name (oref transient--prefix command))) - (setq transient--refreshp (oref transient--prefix refresh-suffixes)) - (setq transient--layout (or layout (transient--init-suffixes name))) - (setq transient--suffixes (transient--flatten-suffixes transient--layout))) - -(defun transient--init-prefix (name &optional params) - (let ((obj (let ((proto (get name 'transient--prefix))) - (apply #'clone proto - :prototype proto - :level (or (alist-get t (alist-get name transient-levels)) - transient-default-level) - params)))) - (transient--setup-recursion obj) - (transient-init-value obj) - obj)) - -(defun transient--init-suffixes (name) - (let ((levels (alist-get name transient-levels))) - (cl-mapcan (lambda (c) (transient--init-child levels c nil)) - (append (get name 'transient--layout) - (and (not transient--editp) - (get 'transient-common-commands - 'transient--layout)))))) - -(defun transient--flatten-suffixes (layout) - (cl-labels ((s (def) - (cond - ((stringp def) nil) - ((cl-typep def 'transient-information) nil) - ((listp def) (cl-mapcan #'s def)) - ((cl-typep def 'transient-group) - (cl-mapcan #'s (oref def suffixes))) - ((cl-typep def 'transient-suffix) - (list def))))) - (cl-mapcan #'s layout))) - -(defun transient--init-child (levels spec parent) - (cl-etypecase spec - (vector (transient--init-group levels spec parent)) - (list (transient--init-suffix levels spec parent)) - (string (list spec)))) - -(defun transient--init-group (levels spec parent) - (pcase-let ((`(,level ,class ,args ,children) (append spec nil))) - (and-let* (((transient--use-level-p level)) - (obj (apply class :level level args)) - ((transient--use-suffix-p obj)) - ((prog1 t - (when (or (and parent (oref parent inapt)) - (transient--inapt-suffix-p obj)) - (oset obj inapt t)))) - (suffixes (cl-mapcan - (lambda (c) (transient--init-child levels c obj)) - (transient-setup-children obj children)))) - (progn ; work around debbugs#31840 - (oset obj suffixes suffixes) - (list obj))))) - -(defun transient--init-suffix (levels spec parent) - (pcase-let* ((`(,level ,class ,args) spec) - (cmd (plist-get args :command)) - (key (transient--kbd (plist-get args :key))) - (level (or (alist-get (cons cmd key) levels nil nil #'equal) - (alist-get cmd levels) - level))) - (let ((fn (and (symbolp cmd) - (symbol-function cmd)))) - (when (autoloadp fn) - (transient--debug " autoload %s" cmd) - (autoload-do-load fn))) - (when (transient--use-level-p level) - (let ((obj (if (child-of-class-p class 'transient-information) - (apply class :level level args) - (unless (and cmd (symbolp cmd)) - (error "BUG: Non-symbolic suffix command: %s" cmd)) - (if-let ((proto (and cmd (transient--suffix-prototype cmd)))) - (apply #'clone proto :level level args) - (apply class :command cmd :level level args))))) - (cond ((not cmd)) - ((commandp cmd)) - ((or (cl-typep obj 'transient-switch) - (cl-typep obj 'transient-option)) - ;; As a temporary special case, if the package was compiled - ;; with an older version of Transient, then we must define - ;; "anonymous" switch and option commands here. - (defalias cmd #'transient--default-infix-command)) - ((transient--use-suffix-p obj) - (error "Suffix command %s is not defined or autoloaded" cmd))) - (unless (cl-typep obj 'transient-information) - (transient--init-suffix-key obj)) - (when (transient--use-suffix-p obj) - (if (or (and parent (oref parent inapt)) - (transient--inapt-suffix-p obj)) - (oset obj inapt t) - (transient-init-scope obj) - (transient-init-value obj)) - (list obj)))))) - -(cl-defmethod transient--init-suffix-key ((obj transient-suffix)) - (unless (slot-boundp obj 'key) - (error "No key for %s" (oref obj command)))) - -(cl-defmethod transient--init-suffix-key ((obj transient-argument)) - (if (transient-switches--eieio-childp obj) - (cl-call-next-method obj) - (unless (slot-boundp obj 'shortarg) - (when-let ((shortarg (transient--derive-shortarg (oref obj argument)))) - (oset obj shortarg shortarg))) - (unless (slot-boundp obj 'key) - (if (slot-boundp obj 'shortarg) - (oset obj key (oref obj shortarg)) - (error "No key for %s" (oref obj command)))))) - -(defun transient--use-level-p (level &optional edit) - (or transient--all-levels-p - (and transient--editp (not edit)) - (and (>= level 1) - (<= level (oref transient--prefix level))))) - -(defun transient--use-suffix-p (obj) - (let ((transient--shadowed-buffer (current-buffer)) - (transient--pending-suffix obj)) - (transient--do-suffix-p - (oref obj if) - (oref obj if-not) - (oref obj if-nil) - (oref obj if-non-nil) - (oref obj if-mode) - (oref obj if-not-mode) - (oref obj if-derived) - (oref obj if-not-derived) - t))) - -(defun transient--inapt-suffix-p (obj) - (let ((transient--shadowed-buffer (current-buffer)) - (transient--pending-suffix obj)) - (transient--do-suffix-p - (oref obj inapt-if) - (oref obj inapt-if-not) - (oref obj inapt-if-nil) - (oref obj inapt-if-non-nil) - (oref obj inapt-if-mode) - (oref obj inapt-if-not-mode) - (oref obj inapt-if-derived) - (oref obj inapt-if-not-derived) - nil))) - -(defun transient--do-suffix-p - (if if-not if-nil if-non-nil if-mode if-not-mode if-derived if-not-derived - default) - (cond - (if (funcall if)) - (if-not (not (funcall if-not))) - (if-non-nil (symbol-value if-non-nil)) - (if-nil (not (symbol-value if-nil))) - (if-mode (if (atom if-mode) - (eq major-mode if-mode) - (memq major-mode if-mode))) - (if-not-mode (not (if (atom if-not-mode) - (eq major-mode if-not-mode) - (memq major-mode if-not-mode)))) - (if-derived (if (or (atom if-derived) - (>= emacs-major-version 30)) - (derived-mode-p if-derived) - (apply #'derived-mode-p if-derived))) - (if-not-derived (not (if (or (atom if-not-derived) - (>= emacs-major-version 30)) - (derived-mode-p if-not-derived) - (apply #'derived-mode-p if-not-derived)))) - (default))) - -(defun transient--suffix-predicate (spec) - (let ((plist (nth 2 spec))) - (seq-some (lambda (prop) - (and-let* ((pred (plist-get plist prop))) - (list prop pred))) - '( :if :if-not - :if-nil :if-non-nil - :if-mode :if-not-mode - :if-derived :if-not-derived - :inapt-if :inapt-if-not - :inapt-if-nil :inapt-if-non-nil - :inapt-if-mode :inapt-if-not-mode - :inapt-if-derived :inapt-if-not-derived)))) - -;;; Flow-Control - -(defun transient--init-transient () - (transient--debug 'init-transient) - (transient--push-keymap 'transient--transient-map) - (transient--push-keymap 'transient--redisplay-map) - (add-hook 'pre-command-hook #'transient--pre-command) - (add-hook 'post-command-hook #'transient--post-command) - (advice-add 'recursive-edit :around #'transient--recursive-edit) - (when transient--exitp - ;; This prefix command was invoked as the suffix of another. - ;; Prevent `transient--post-command' from removing the hooks - ;; that we just added. - (setq transient--exitp 'replace))) - -(defun transient--refresh-transient () - (transient--debug 'refresh-transient) - (transient--pop-keymap 'transient--predicate-map) - (transient--pop-keymap 'transient--transient-map) - (transient--pop-keymap 'transient--redisplay-map) - (if (eq transient--refreshp 'updated-value) - ;; Preserve the prefix value this once, because the - ;; invoked suffix indicates that it has updated that. - (setq transient--refreshp (oref transient--prefix refresh-suffixes)) - ;; Otherwise update the prefix value from suffix values. - (oset transient--prefix value (transient-get-value))) - (transient--init-objects) - (transient--init-keymaps) - (transient--push-keymap 'transient--transient-map) - (transient--push-keymap 'transient--redisplay-map) - (transient--redisplay)) - -(defun transient--pre-command () - (transient--debug 'pre-command) - (transient--with-emergency-exit :pre-command - ;; The use of `overriding-terminal-local-map' does not prevent the - ;; lookup of command remappings in the overridden maps, which can - ;; lead to a suffix being remapped to a non-suffix. We have to undo - ;; the remapping in that case. However, remapping a non-suffix to - ;; another should remain possible. - (when (and (transient--get-pre-command this-original-command 'suffix) - (not (transient--get-pre-command this-command 'suffix))) - (setq this-command this-original-command)) - (cond - ((memq this-command '(transient-update transient-quit-seq)) - (transient--pop-keymap 'transient--redisplay-map)) - ((and transient--helpp - (not (memq this-command '(transient-quit-one - transient-quit-all)))) - (cond - ((transient-help) - (transient--do-suspend) - (setq this-command 'transient-suspend) - (transient--pre-exit)) - ((not (transient--edebug-command-p)) - (setq this-command 'transient-undefined)))) - ((and transient--editp - (transient-suffix-object) - (not (memq this-command '(transient-quit-one - transient-quit-all - transient-help)))) - (setq this-command 'transient-set-level) - (transient--wrap-command)) - (t - (setq transient--exitp nil) - (let ((exitp (eq (transient--call-pre-command) transient--exit))) - (transient--wrap-command) - (when exitp - (transient--pre-exit))))))) - -(defun transient--pre-exit () - (transient--debug 'pre-exit) - (transient--delete-window) - (transient--timer-cancel) - (transient--pop-keymap 'transient--transient-map) - (transient--pop-keymap 'transient--redisplay-map) - (unless transient--showp - (let ((message-log-max nil)) - (message ""))) - (setq transient--transient-map nil) - (setq transient--predicate-map nil) - (setq transient--redisplay-map nil) - (setq transient--redisplay-key nil) - (setq transient--helpp nil) - (setq transient--editp nil) - (setq transient--prefix nil) - (setq transient--layout nil) - (setq transient--suffixes nil) - (setq transient--original-window nil) - (setq transient--original-buffer nil) - (setq transient--window nil)) - -(defun transient--delete-window () - (when (window-live-p transient--window) - (let ((remain-in-minibuffer-window - (and (minibuffer-selected-window) - (selected-window)))) - ;; Only delete the window if it has never shown another buffer. - (unless (eq (car (window-parameter transient--window 'quit-restore)) - 'other) - (with-demoted-errors "Error while exiting transient: %S" - (delete-window transient--window))) - (when (buffer-live-p transient--buffer) - (kill-buffer transient--buffer)) - (setq transient--buffer nil) - (when remain-in-minibuffer-window - (select-window remain-in-minibuffer-window))))) - -(defun transient--export () - (setq transient-current-prefix transient--prefix) - (setq transient-current-command (oref transient--prefix command)) - (setq transient-current-suffixes transient--suffixes) - (transient--history-push transient--prefix)) - -(defun transient--suspend-override (&optional nohide) - (transient--debug 'suspend-override) - (transient--timer-cancel) - (cond ((and (not nohide) transient-hide-during-minibuffer-read) - (transient--delete-window)) - ((and transient--prefix transient--redisplay-key) - (setq transient--redisplay-key nil) - (when transient--showp - (if-let ((win (minibuffer-selected-window))) - (with-selected-window win - (transient--show)) - (transient--show))))) - (transient--pop-keymap 'transient--transient-map) - (transient--pop-keymap 'transient--redisplay-map) - (remove-hook 'pre-command-hook #'transient--pre-command) - (remove-hook 'post-command-hook #'transient--post-command)) - -(defun transient--resume-override (&optional _ignore) - (transient--debug 'resume-override) - (when (and transient--showp transient-hide-during-minibuffer-read) - (transient--show)) - (transient--push-keymap 'transient--transient-map) - (transient--push-keymap 'transient--redisplay-map) - (add-hook 'pre-command-hook #'transient--pre-command) - (add-hook 'post-command-hook #'transient--post-command)) - -(defun transient--recursive-edit (fn) - (transient--debug 'recursive-edit) - (if (not transient--prefix) - (funcall fn) - (transient--suspend-override (bound-and-true-p edebug-active)) - (funcall fn) ; Already unwind protected. - (cond ((memq this-command '(top-level abort-recursive-edit)) - (setq transient--exitp t) - (transient--post-exit) - (transient--delete-window)) - (transient--prefix - (transient--resume-override))))) - -(defmacro transient--with-suspended-override (&rest body) - (let ((depth (make-symbol "depth")) - (setup (make-symbol "setup")) - (exit (make-symbol "exit"))) - `(if (and transient--transient-map - (memq transient--transient-map - overriding-terminal-local-map)) - (let ((,depth (1+ (minibuffer-depth))) ,setup ,exit) - (setq ,setup - (lambda () "@transient--with-suspended-override" - (transient--debug 'minibuffer-setup) - (remove-hook 'minibuffer-setup-hook ,setup) - (transient--suspend-override))) - (setq ,exit - (lambda () "@transient--with-suspended-override" - (transient--debug 'minibuffer-exit) - (when (= (minibuffer-depth) ,depth) - (transient--resume-override)))) - (unwind-protect - (progn - (add-hook 'minibuffer-setup-hook ,setup) - (add-hook 'minibuffer-exit-hook ,exit) - ,@body) - (remove-hook 'minibuffer-setup-hook ,setup) - (remove-hook 'minibuffer-exit-hook ,exit))) - ,@body))) - -(static-if (>= emacs-major-version 30) ;transient--wrap-command - (defun transient--wrap-command () - (cl-assert - (>= emacs-major-version 30) nil - "Emacs was downgraded, making it necessary to recompile Transient") - (letrec - ((prefix transient--prefix) - (suffix this-command) - (advice - (lambda (fn &rest args) - (interactive - (lambda (spec) - (let ((abort t)) - (unwind-protect - (prog1 (let ((debugger #'transient--exit-and-debug)) - (advice-eval-interactive-spec spec)) - (setq abort nil)) - (when abort - (when-let ((unwind (oref prefix unwind-suffix))) - (transient--debug 'unwind-interactive) - (funcall unwind suffix)) - (advice-remove suffix advice) - (oset prefix unwind-suffix nil)))))) - (unwind-protect - (let ((debugger #'transient--exit-and-debug)) - (apply fn args)) - (when-let ((unwind (oref prefix unwind-suffix))) - (transient--debug 'unwind-command) - (funcall unwind suffix)) - (advice-remove suffix advice) - (oset prefix unwind-suffix nil))))) - (when (symbolp this-command) - (advice-add suffix :around advice '((depth . -99)))))) - - (defun transient--wrap-command () - (let* ((prefix transient--prefix) - (suffix this-command) - (advice nil) - (advice-interactive - (lambda (spec) - (let ((abort t)) - (unwind-protect - (prog1 (let ((debugger #'transient--exit-and-debug)) - (advice-eval-interactive-spec spec)) - (setq abort nil)) - (when abort - (when-let ((unwind (oref prefix unwind-suffix))) - (transient--debug 'unwind-interactive) - (funcall unwind suffix)) - (advice-remove suffix advice) - (oset prefix unwind-suffix nil)))))) - (advice-body - (lambda (fn &rest args) - (unwind-protect - (let ((debugger #'transient--exit-and-debug)) - (apply fn args)) - (when-let ((unwind (oref prefix unwind-suffix))) - (transient--debug 'unwind-command) - (funcall unwind suffix)) - (advice-remove suffix advice) - (oset prefix unwind-suffix nil))))) - (setq advice `(lambda (fn &rest args) - (interactive ,advice-interactive) - (apply ',advice-body fn args))) - (when (symbolp this-command) - (advice-add suffix :around advice '((depth . -99))))))) - -(defun transient--premature-post-command () - (and (equal (this-command-keys-vector) []) - (= (minibuffer-depth) - (1+ transient--minibuffer-depth)) - (progn - (transient--debug 'premature-post-command) - (transient--suspend-override) - (oset (or transient--prefix transient-current-prefix) - unwind-suffix - (if transient--exitp - #'transient--post-exit - #'transient--resume-override)) - t))) - -(defun transient--post-command () - (unless (transient--premature-post-command) - (transient--debug 'post-command) - (transient--with-emergency-exit :post-command - (cond (transient--exitp (transient--post-exit)) - ;; If `this-command' is the current transient prefix, then we - ;; have already taken care of updating the transient buffer... - ((and (eq this-command (oref transient--prefix command)) - ;; ... but if `prefix-arg' is non-nil, then the values - ;; of `this-command' and `real-this-command' are untrue - ;; because `prefix-command-preserve-state' changes them. - ;; We cannot use `current-prefix-arg' because it is set - ;; too late (in `command-execute'), and if it were set - ;; earlier, then we likely still would not be able to - ;; rely on it, and `prefix-command-preserve-state-hook' - ;; would have to be used to record that a universal - ;; argument is in effect. - (not prefix-arg))) - (transient--refreshp - (transient--refresh-transient)) - ((let ((old transient--redisplay-map) - (new (transient--make-redisplay-map))) - (unless (equal old new) - (transient--pop-keymap 'transient--redisplay-map) - (setq transient--redisplay-map new) - (transient--push-keymap 'transient--redisplay-map)) - (transient--redisplay))))))) - -(defun transient--post-exit (&optional command) - (transient--debug 'post-exit) - (unless (and (eq transient--exitp 'replace) - (or transient--prefix - ;; The current command could act as a prefix, - ;; but decided not to call `transient-setup', - ;; or it is prevented from doing so because it - ;; uses the minibuffer and the user aborted - ;; that. - (prog1 nil - (if (let ((obj (transient-suffix-object command))) - (and (slot-boundp obj 'transient) - (oref obj transient))) - ;; This sub-prefix is a transient suffix; - ;; go back to outer prefix, by calling - ;; `transient--stack-pop' further down. - (setq transient--exitp nil) - (transient--stack-zap))))) - (remove-hook 'pre-command-hook #'transient--pre-command) - (remove-hook 'post-command-hook #'transient--post-command) - (advice-remove 'recursive-edit #'transient--recursive-edit)) - (setq transient-current-prefix nil) - (setq transient-current-command nil) - (setq transient-current-suffixes nil) - (let ((resume (and transient--stack - (not (memq transient--exitp '(replace suspend)))))) - (unless (or resume (eq transient--exitp 'replace)) - (setq transient--showp nil)) - (setq transient--exitp nil) - (setq transient--helpp nil) - (setq transient--editp nil) - (setq transient--all-levels-p nil) - (setq transient--minibuffer-depth 0) - (run-hooks 'transient-exit-hook) - (when resume - (transient--stack-pop)))) - -(defun transient--stack-push () - (transient--debug 'stack-push) - (push (list (oref transient--prefix command) - transient--layout - transient--editp - :transient-suffix (oref transient--prefix transient-suffix) - :scope (oref transient--prefix scope)) - transient--stack)) - -(defun transient--stack-pop () - (transient--debug 'stack-pop) - (and transient--stack - (prog1 t (apply #'transient-setup (pop transient--stack))))) - -(defun transient--stack-zap () - (transient--debug 'stack-zap) - (setq transient--stack nil)) - -(defun transient--redisplay () - (if (or (eq transient-show-popup t) - transient--showp) - (unless - (or (memq this-command transient--scroll-commands) - (and (or (memq this-command '(mouse-drag-region - mouse-set-region)) - (equal (key-description (this-command-keys-vector)) - "<mouse-movement>")) - (and (eq (current-buffer) transient--buffer)))) - (transient--show)) - (when (and (numberp transient-show-popup) - (not (zerop transient-show-popup)) - (not transient--timer)) - (transient--timer-start)) - (transient--show-brief))) - -(defun transient--timer-start () - (setq transient--timer - (run-at-time (abs transient-show-popup) nil - (lambda () - (transient--timer-cancel) - (transient--show) - (let ((message-log-max nil)) - (message "")))))) - -(defun transient--timer-cancel () - (when transient--timer - (cancel-timer transient--timer) - (setq transient--timer nil))) - -(defun transient--debug (arg &rest args) - (when transient--debug - (let ((inhibit-message (not (eq transient--debug 'message)))) - (if (symbolp arg) - (message "-- %-22s (cmd: %s, event: %S, exit: %s%s)" - arg - (cond ((and (symbolp this-command) this-command)) - ((fboundp 'help-fns-function-name) - (help-fns-function-name this-command)) - ((byte-code-function-p this-command) - "#[...]") - (this-command)) - (key-description (this-command-keys-vector)) - transient--exitp - (cond ((keywordp (car args)) - (format ", from: %s" - (substring (symbol-name (car args)) 1))) - ((stringp (car args)) - (concat ", " (apply #'format args))) - ((functionp (car args)) - (concat ", " (apply (car args) (cdr args)))) - (""))) - (apply #'message arg args))))) - -(defun transient--emergency-exit (&optional id) - "Exit the current transient command after an error occurred. -When no transient is active (i.e., when `transient--prefix' is -nil) then do nothing. Optional ID is a keyword identifying the -exit." - (transient--debug 'emergency-exit id) - (when transient--prefix - (setq transient--stack nil) - (setq transient--exitp t) - (transient--pre-exit) - (transient--post-exit))) - -;;; Pre-Commands - -(defun transient--call-pre-command () - (if-let ((fn (transient--get-pre-command this-command))) - (let ((action (funcall fn))) - (when (eq action transient--exit) - (setq transient--exitp (or transient--exitp t))) - action) - (if (let ((keys (this-command-keys-vector))) - (eq (aref keys (1- (length keys))) ?\C-g)) - (setq this-command 'transient-noop) - (unless (transient--edebug-command-p) - (setq this-command 'transient-undefined))) - transient--stay)) - -(defun transient--get-pre-command (&optional cmd enforce-type) - (or (and (not (eq enforce-type 'non-suffix)) - (symbolp cmd) - (lookup-key transient--predicate-map (vector cmd))) - (and (not (eq enforce-type 'suffix)) - (transient--resolve-pre-command - (oref transient--prefix transient-non-suffix) - t)))) - -(defun transient--resolve-pre-command (pre &optional resolve-boolean) - (cond ((booleanp pre) - (if resolve-boolean - (if pre #'transient--do-stay #'transient--do-warn) - pre)) - ((string-match-p "--do-" (symbol-name pre)) pre) - ((let ((sym (intern (format "transient--do-%s" pre)))) - (if (functionp sym) sym pre))))) - -(defun transient--do-stay () - "Call the command without exporting variables and stay transient." - transient--stay) - -(defun transient--do-noop () - "Call `transient-noop' and stay transient." - (setq this-command 'transient-noop) - transient--stay) - -(defun transient--do-warn () - "Call `transient-undefined' and stay transient." - (setq this-command 'transient-undefined) - transient--stay) - -(defun transient--do-warn-inapt () - "Call `transient-inapt' and stay transient." - (setq this-command 'transient-inapt) - transient--stay) - -(defun transient--do-call () - "Call the command after exporting variables and stay transient." - (transient--export) - transient--stay) - -(defun transient--do-return () - "Call the command after exporting variables and return to parent prefix. -If there is no parent prefix, then behave like `transient--do-exit'." - (if (not transient--stack) - (transient--do-exit) - (transient--export) - transient--exit)) - -(defun transient--do-exit () - "Call the command after exporting variables and exit the transient." - (transient--export) - (transient--stack-zap) - transient--exit) - -(defun transient--do-leave () - "Call the command without exporting variables and exit the transient." - (transient--stack-zap) - transient--exit) - -(defun transient--do-push-button () - "Call the command represented by the activated button. -Use that command's pre-command to determine transient behavior." - (if (and (mouse-event-p last-command-event) - (not (eq (posn-window (event-start last-command-event)) - transient--window))) - transient--stay - (setq this-command - (with-selected-window transient--window - (get-text-property (if (mouse-event-p last-command-event) - (posn-point (event-start last-command-event)) - (point)) - 'command))) - (transient--call-pre-command))) - -(defun transient--do-recurse () - "Call the transient prefix command, preparing for return to active transient. -If there is no parent prefix, then just call the command." - (transient--do-stack)) - -(defun transient--setup-recursion (prefix-obj) - (when transient--stack - (let ((command (oref prefix-obj command))) - (when-let ((suffix-obj (transient-suffix-object command))) - (when (memq (if (slot-boundp suffix-obj 'transient) - (oref suffix-obj transient) - (oref transient-current-prefix transient-suffix)) - (list t #'transient--do-recurse)) - (oset prefix-obj transient-suffix t)))))) - -(defun transient--do-stack () - "Call the transient prefix command, stacking the active transient. -Push the active transient to the transient stack." - (transient--export) - (transient--stack-push) - (setq transient--exitp 'replace) - transient--exit) - -(defun transient--do-replace () - "Call the transient prefix command, replacing the active transient. -Do not push the active transient to the transient stack." - (transient--export) - (setq transient--exitp 'replace) - transient--exit) - -(defun transient--do-suspend () - "Suspend the active transient, saving the transient stack." - (transient--stack-push) - (setq transient--exitp 'suspend) - transient--exit) - -(defun transient--do-quit-one () - "If active, quit help or edit mode, else exit the active transient." - (cond (transient--helpp - (setq transient--helpp nil) - transient--stay) - (transient--editp - (setq transient--editp nil) - (transient-setup) - transient--stay) - (prefix-arg - transient--stay) - (transient--exit))) - -(defun transient--do-quit-all () - "Exit all transients without saving the transient stack." - (transient--stack-zap) - transient--exit) - -(defun transient--do-move () - "Call the command if `transient-enable-popup-navigation' is non-nil. -In that case behave like `transient--do-stay', otherwise similar -to `transient--do-warn'." - (unless transient-enable-popup-navigation - (setq this-command 'transient-inhibit-move)) - transient--stay) - -(defun transient--do-minus () - "Call `negative-argument' or pivot to `transient-update'. -If `negative-argument' is invoked using \"-\" then preserve the -prefix argument and pivot to `transient-update'." - (when (equal (this-command-keys) "-") - (setq this-command 'transient-update)) - transient--stay) - -(put 'transient--do-stay 'transient-face 'transient-key-stay) -(put 'transient--do-noop 'transient-face 'transient-key-noop) -(put 'transient--do-warn 'transient-face 'transient-key-noop) -(put 'transient--do-warn-inapt 'transient-face 'transient-key-noop) -(put 'transient--do-call 'transient-face 'transient-key-stay) -(put 'transient--do-return 'transient-face 'transient-key-return) -(put 'transient--do-exit 'transient-face 'transient-key-exit) -(put 'transient--do-leave 'transient-face 'transient-key-exit) - -(put 'transient--do-recurse 'transient-face 'transient-key-stay) -(put 'transient--do-stack 'transient-face 'transient-key-stay) -(put 'transient--do-replace 'transient-face 'transient-key-exit) -(put 'transient--do-suspend 'transient-face 'transient-key-exit) - -(put 'transient--do-quit-one 'transient-face 'transient-key-return) -(put 'transient--do-quit-all 'transient-face 'transient-key-exit) -(put 'transient--do-move 'transient-face 'transient-key-stay) -(put 'transient--do-minus 'transient-face 'transient-key-stay) - -;;; Commands -;;;; Noop - -(defun transient-noop () - "Do nothing at all." - (interactive)) - -(defun transient-undefined () - "Warn the user that the pressed key is not bound to any suffix." - (interactive) - (transient--invalid "Unbound suffix")) - -(defun transient-inapt () - "Warn the user that the invoked command is inapt." - (interactive) - (transient--invalid "Inapt command")) - -(defun transient--invalid (msg) - (ding) - (message "%s: `%s' (Use `%s' to abort, `%s' for help)%s" - msg - (propertize (key-description (this-single-command-keys)) - 'face 'font-lock-warning-face) - (propertize "C-g" 'face 'transient-key) - (propertize "?" 'face 'transient-key) - ;; `this-command' is `transient-undefined' or `transient-inapt'. - ;; Show the command (`this-original-command') the user actually - ;; tried to invoke. - (if-let ((cmd (or (ignore-errors (symbol-name this-original-command)) - (ignore-errors (symbol-name this-command))))) - (format " [%s]" (propertize cmd 'face 'font-lock-warning-face)) - "")) - (unless (and transient--transient-map - (memq transient--transient-map overriding-terminal-local-map)) - (let ((transient--prefix (or transient--prefix 'sic))) - (transient--emergency-exit)) - (view-lossage) - (other-window 1) - (display-warning 'transient "Inconsistent transient state detected. -This should never happen. -Please open an issue and post the shown command log." :error))) - -(defun transient-inhibit-move () - "Warn the user that popup navigation is disabled." - (interactive) - (message "To enable use of `%s', please customize `%s'" - this-original-command - 'transient-enable-popup-navigation)) - -;;;; Core - -(defun transient-quit-all () - "Exit all transients without saving the transient stack." - (interactive)) - -(defun transient-quit-one () - "Exit the current transients, returning to outer transient, if any." - (interactive)) - -(defun transient-quit-seq () - "Abort the current incomplete key sequence." - (interactive)) - -(defun transient-update () - "Redraw the transient's state in the popup buffer." - (interactive) - (setq prefix-arg current-prefix-arg)) - -(defun transient-show () - "Show the transient's state in the popup buffer." - (interactive) - (setq transient--showp t)) - -(defun transient-push-button () - "Invoke the suffix command represented by this button." - (interactive)) - -;;;; Suspend - -(defun transient-suspend () - "Suspend the current transient. -It can later be resumed using `transient-resume', while no other -transient is active." - (interactive)) - -(define-minor-mode transient-resume-mode - "Auxiliary minor-mode used to resume a transient after viewing help.") - -(defun transient-resume () - "Resume a previously suspended stack of transients." - (interactive) - (cond (transient--stack - (let ((winconf transient--restore-winconf)) - (kill-local-variable 'transient--restore-winconf) - (when transient-resume-mode - (transient-resume-mode -1) - (quit-window)) - (when winconf - (set-window-configuration winconf))) - (transient--stack-pop)) - (transient-resume-mode - (kill-local-variable 'transient--restore-winconf) - (transient-resume-mode -1) - (quit-window)) - (t - (message "No suspended transient command")))) - -;;;; Help - -(defun transient-help (&optional interactive) - "Show help for the active transient or one of its suffixes.\n\n(fn)" - (interactive (list t)) - (if interactive - (setq transient--helpp t) - (with-demoted-errors "transient-help: %S" - (when (lookup-key transient--transient-map - (this-single-command-raw-keys)) - (setq transient--helpp nil) - (let ((winconf (current-window-configuration))) - (transient-show-help - (if (eq this-original-command 'transient-help) - transient--prefix - (or (transient-suffix-object) - this-original-command))) - (setq-local transient--restore-winconf winconf)) - (fit-window-to-buffer nil (frame-height) (window-height)) - (transient-resume-mode) - (message (substitute-command-keys - "Type \\`q' to resume transient command.")) - t)))) - -;;;; Level - -(defun transient-set-level (&optional command level) - "Set the level of the transient or one of its suffix commands." - (interactive - (let ((command this-original-command) - (prefix (oref transient--prefix command))) - (and (or (not (eq command 'transient-set-level)) - (and transient--editp - (setq command prefix))) - (list command - (let ((keys (this-single-command-raw-keys))) - (and (lookup-key transient--transient-map keys) - (progn - (transient--show) - (string-to-number - (transient--read-number-N - (format "Set level for `%s': " command) - nil nil (not (eq command prefix))))))))))) - (cond - ((not command) - (setq transient--editp t) - (transient-setup)) - (level - (let* ((prefix (oref transient--prefix command)) - (alist (alist-get prefix transient-levels)) - (akey command)) - (cond ((eq command prefix) - (oset transient--prefix level level) - (setq akey t)) - (t - (oset (transient-suffix-object command) level level) - (when (cdr (cl-remove-if-not (lambda (obj) - (eq (oref obj command) command)) - transient--suffixes)) - (setq akey (cons command (this-command-keys)))))) - (setf (alist-get akey alist) level) - (setf (alist-get prefix transient-levels) alist)) - (transient-save-levels) - (transient--show)) - (t - (transient-undefined)))) - -(transient-define-suffix transient-toggle-level-limit () - "Toggle whether to temporarily displayed suffixes on all levels." - :description - (lambda () - (cond - ((= transient-default-level transient--max-level) - "Always displaying all levels") - (transient--all-levels-p - (format "Hide suffix %s" - (propertize - (format "levels > %s" (oref (transient-prefix-object) level)) - 'face 'transient-higher-level))) - ("Show all suffix levels"))) - :inapt-if (lambda () (= transient-default-level transient--max-level)) - :transient t - (interactive) - (setq transient--all-levels-p (not transient--all-levels-p)) - (setq transient--refreshp t)) - -;;;; Value - -(defun transient-set () - "Set active transient's value for this Emacs session." - (interactive) - (transient-set-value (transient-prefix-object))) - -(defalias 'transient-set-and-exit #'transient-set - "Set active transient's value for this Emacs session and exit.") - -(defun transient-save () - "Save active transient's value for this and future Emacs sessions." - (interactive) - (transient-save-value (transient-prefix-object))) - -(defalias 'transient-save-and-exit #'transient-save - "Save active transient's value for this and future Emacs sessions and exit.") - -(defun transient-reset () - "Clear the set and saved values of the active transient." - (interactive) - (transient-reset-value (transient-prefix-object))) - -(defun transient-history-next () - "Switch to the next value used for the active transient." - (interactive) - (let* ((obj transient--prefix) - (pos (1- (oref obj history-pos))) - (hst (oref obj history))) - (if (< pos 0) - (user-error "End of history") - (oset obj history-pos pos) - (oset obj value (nth pos hst)) - (mapc #'transient-init-value transient--suffixes)))) - -(defun transient-history-prev () - "Switch to the previous value used for the active transient." - (interactive) - (let* ((obj transient--prefix) - (pos (1+ (oref obj history-pos))) - (hst (oref obj history)) - (len (length hst))) - (if (> pos (1- len)) - (user-error "End of history") - (oset obj history-pos pos) - (oset obj value (nth pos hst)) - (mapc #'transient-init-value transient--suffixes)))) - -(transient-define-suffix transient-preset () - "Put this preset into action." - :class transient-value-preset - (interactive) - (transient-prefix-set (oref (transient-suffix-object) set))) - -;;;; Auxiliary - -(defun transient-toggle-common () - "Toggle whether common commands are permanently shown." - (interactive) - (setq transient-show-common-commands (not transient-show-common-commands))) - -(defun transient-toggle-debug () - "Toggle debugging statements for transient commands." - (interactive) - (setq transient--debug (not transient--debug)) - (message "Debugging transient %s" - (if transient--debug "enabled" "disabled"))) - -(transient-define-suffix transient-echo-arguments (arguments) - "Show the transient's active ARGUMENTS in the echo area. -Intended for use in prefixes used for demonstration purposes, -such as when suggesting a new feature or reporting an issue." - :transient t - :description "Echo arguments" - :key "x" - (interactive (list (transient-args transient-current-command))) - (message "%s: %s" - (key-description (this-command-keys)) - (mapconcat (lambda (arg) - (propertize (if (string-match-p " " arg) - (format "%S" arg) - arg) - 'face 'transient-argument)) - arguments " "))) - -;;; Value -;;;; Init - -(cl-defgeneric transient-init-scope (obj) - "Set the scope of the suffix object OBJ. - -The scope is actually a property of the transient prefix, not of -individual suffixes. However it is possible to invoke a suffix -command directly instead of from a transient. In that case, if -the suffix expects a scope, then it has to determine that itself -and store it in its `scope' slot. - -This function is called for all suffix commands, but unless a -concrete method is implemented this falls through to the default -implementation, which is a noop.") - -(cl-defmethod transient-init-scope ((_ transient-suffix)) - "Noop." nil) - -(cl-defgeneric transient-init-value (_) - "Set the initial value of the object OBJ. - -This function is called for all prefix and suffix commands. - -For suffix commands (including infix argument commands) the -default implementation is a noop. Classes derived from the -abstract `transient-infix' class must implement this function. -Non-infix suffix commands usually don't have a value." - nil) - -(cl-defmethod transient-init-value :around ((obj transient-prefix)) - "If bound, then call OBJ's `init-value' function. -Otherwise call the primary method according to object's class." - (if (slot-boundp obj 'init-value) - (funcall (oref obj init-value) obj) - (cl-call-next-method obj))) - -(cl-defmethod transient-init-value :around ((obj transient-infix)) - "If bound, then call OBJ's `init-value' function. -Otherwise call the primary method according to object's class." - (if (slot-boundp obj 'init-value) - (funcall (oref obj init-value) obj) - (cl-call-next-method obj))) - -(cl-defmethod transient-init-value ((obj transient-prefix)) - (if (slot-boundp obj 'value) - (oref obj value) - (oset obj value - (if-let ((saved (assq (oref obj command) transient-values))) - (cdr saved) - (transient-default-value obj))))) - -(cl-defmethod transient-init-value ((obj transient-argument)) - (oset obj value - (let ((value (oref transient--prefix value)) - (argument (and (slot-boundp obj 'argument) - (oref obj argument))) - (multi-value (oref obj multi-value)) - (case-fold-search nil) - (regexp (if (slot-exists-p obj 'argument-regexp) - (oref obj argument-regexp) - (format "\\`%s\\(.*\\)" (oref obj argument))))) - (if (memq multi-value '(t rest)) - (cdr (assoc argument value)) - (let ((match (lambda (v) - (and (stringp v) - (string-match regexp v) - (match-string 1 v))))) - (if multi-value - (delq nil (mapcar match value)) - (cl-some match value))))))) - -(cl-defmethod transient-init-value ((obj transient-switch)) - (oset obj value - (car (member (oref obj argument) - (oref transient--prefix value))))) - -;;;; Default - -(cl-defgeneric transient-default-value (_) - "Return the default value." - nil) - -(cl-defmethod transient-default-value ((obj transient-prefix)) - (if-let ((default (and (slot-boundp obj 'default-value) - (oref obj default-value)))) - (if (functionp default) - (funcall default) - default) - nil)) - -;;;; Read - -(cl-defgeneric transient-infix-read (obj) - "Determine the new value of the infix object OBJ. - -This function merely determines the value; `transient-infix-set' -is used to actually store the new value in the object. - -For most infix classes this is done by reading a value from the -user using the reader specified by the `reader' slot (using the -`transient-infix' method described below). - -For some infix classes the value is changed without reading -anything in the minibuffer, i.e., the mere act of invoking the -infix command determines what the new value should be, based -on the previous value.") - -(cl-defmethod transient-infix-read :around ((obj transient-infix)) - "Refresh the transient buffer and call the next method. - -Also wrap `cl-call-next-method' with two macros: -- `transient--with-suspended-override' allows use of minibuffer. -- `transient--with-emergency-exit' arranges for the transient to - be exited in case of an error." - (transient--show) - (transient--with-emergency-exit :infix-read - (transient--with-suspended-override - (cl-call-next-method obj)))) - -(cl-defmethod transient-infix-read ((obj transient-infix)) - "Read a value while taking care of history. - -This method is suitable for a wide variety of infix commands, -including but not limited to inline arguments and variables. - -If you do not use this method for your own infix class, then -you should likely replicate a lot of the behavior of this -method. If you fail to do so, then users might not appreciate -the lack of history, for example. - -Only for very simple classes that toggle or cycle through a very -limited number of possible values should you replace this with a -simple method that does not handle history. (E.g., for a command -line switch the only possible values are \"use it\" and \"don't use -it\", in which case it is pointless to preserve history.)" - (with-slots (value multi-value always-read allow-empty choices) obj - (if (and value - (not multi-value) - (not always-read) - transient--prefix) - (oset obj value nil) - (let* ((enable-recursive-minibuffers t) - (reader (oref obj reader)) - (choices (if (functionp choices) (funcall choices) choices)) - (prompt (transient-prompt obj)) - (value (if multi-value (mapconcat #'identity value ",") value)) - (history-key (or (oref obj history-key) - (oref obj command))) - (transient--history (alist-get history-key transient-history)) - (transient--history (if (or (null value) - (eq value (car transient--history))) - transient--history - (cons value transient--history))) - (initial-input (and transient-read-with-initial-input - (car transient--history))) - (history (if initial-input - (cons 'transient--history 1) - 'transient--history)) - (value - (cond - (reader (funcall reader prompt initial-input history)) - (multi-value - (completing-read-multiple prompt choices nil nil - initial-input history)) - (choices - (completing-read prompt choices nil t initial-input history)) - ((read-string prompt initial-input history))))) - (cond ((and (equal value "") (not allow-empty)) - (setq value nil)) - ((and (equal value "\"\"") allow-empty) - (setq value ""))) - (when value - (when (and (bound-and-true-p ivy-mode) - (stringp (car transient--history))) - (set-text-properties 0 (length (car transient--history)) nil - (car transient--history))) - (setf (alist-get history-key transient-history) - (delete-dups transient--history))) - value)))) - -(cl-defmethod transient-infix-read ((obj transient-switch)) - "Toggle the switch on or off." - (if (oref obj value) nil (oref obj argument))) - -(cl-defmethod transient-infix-read ((obj transient-switches)) - "Cycle through the mutually exclusive switches. -The last value is \"don't use any of these switches\"." - (let ((choices (mapcar (apply-partially #'format (oref obj argument-format)) - (oref obj choices)))) - (if-let ((value (oref obj value))) - (cadr (member value choices)) - (car choices)))) - -(cl-defmethod transient-infix-read ((command symbol)) - "Elsewhere use the reader of the infix command COMMAND. -Use this if you want to share an infix's history with a regular -stand-alone command." - (if-let ((obj (transient--suffix-prototype command))) - (cl-letf (((symbol-function #'transient--show) #'ignore)) - (transient-infix-read obj)) - (error "Not a suffix command: `%s'" command))) - -;;;; Readers - -(defun transient-read-file (prompt _initial-input _history) - "Read a file." - (file-local-name (expand-file-name (read-file-name prompt)))) - -(defun transient-read-existing-file (prompt _initial-input _history) - "Read an existing file." - (file-local-name (expand-file-name (read-file-name prompt nil nil t)))) - -(defun transient-read-directory (prompt _initial-input _history) - "Read a directory." - (file-local-name (expand-file-name (read-directory-name prompt)))) - -(defun transient-read-existing-directory (prompt _initial-input _history) - "Read an existing directory." - (file-local-name (expand-file-name (read-directory-name prompt nil nil t)))) - -(defun transient-read-number-N0 (prompt initial-input history) - "Read a natural number (including zero) and return it as a string." - (transient--read-number-N prompt initial-input history t)) - -(defun transient-read-number-N+ (prompt initial-input history) - "Read a natural number (excluding zero) and return it as a string." - (transient--read-number-N prompt initial-input history nil)) - -(defun transient--read-number-N (prompt initial-input history include-zero) - (save-match-data - (cl-block nil - (while t - (let ((str (read-from-minibuffer prompt initial-input nil nil history))) - (when (or (string-equal str "") - (string-match-p (if include-zero - "\\`\\(0\\|[1-9][0-9]*\\)\\'" - "\\`[1-9][0-9]*\\'") - str)) - (cl-return str))) - (message "Please enter a natural number (%s zero)." - (if include-zero "including" "excluding")) - (sit-for 1))))) - -(defun transient-read-date (prompt default-time _history) - "Read a date using `org-read-date' (which see)." - (require 'org) - (when (fboundp 'org-read-date) - (org-read-date 'with-time nil nil prompt default-time))) - -;;;; Prompt - -(cl-defgeneric transient-prompt (obj) - "Return the prompt to be used to read infix object OBJ's value.") - -(cl-defmethod transient-prompt ((obj transient-infix)) - "Return the prompt to be used to read infix object OBJ's value. - -This implementation should be suitable for almost all infix -commands. - -If the value of OBJ's `prompt' slot is non-nil, then it must be -a string or a function. If it is a string, then use that. If -it is a function, then call that with OBJ as the only argument. -That function must return a string, which is then used as the -prompt. - -Otherwise, if the value of either the `argument' or `variable' -slot of OBJ is a string, then base the prompt on that (preferring -the former), appending either \"=\" (if it appears to be a -command-line option) or \": \". - -Finally fall through to using \"(BUG: no prompt): \" as the -prompt." - (if-let ((prompt (oref obj prompt))) - (let ((prompt (if (functionp prompt) - (funcall prompt obj) - prompt))) - (if (stringp prompt) - prompt - "(BUG: no prompt): ")) - (or (and-let* ((arg (and (slot-boundp obj 'argument) (oref obj argument)))) - (if (and (stringp arg) (string-suffix-p "=" arg)) - arg - (concat arg ": "))) - (and-let* ((var (and (slot-boundp obj 'variable) (oref obj variable)))) - (and (stringp var) - (concat var ": "))) - "(BUG: no prompt): "))) - -;;;; Set - -(cl-defgeneric transient-infix-set (obj value) - "Set the value of infix object OBJ to VALUE.") - -(cl-defmethod transient-infix-set ((obj transient-infix) value) - "Set the value of infix object OBJ to VALUE." - (oset obj value value)) - -(cl-defmethod transient-infix-set :after ((obj transient-argument) value) - "Unset incompatible infix arguments." - (when-let* ((value) - (val (transient-infix-value obj)) - (arg (if (slot-boundp obj 'argument) - (oref obj argument) - (oref obj argument-format))) - (spec (oref transient--prefix incompatible)) - (filter (lambda (x rule) - (and (member x rule) - (remove x rule)))) - (incomp (nconc - (cl-mapcan (apply-partially filter arg) spec) - (and (not (equal val arg)) - (cl-mapcan (apply-partially filter val) spec))))) - (dolist (obj transient--suffixes) - (when-let* (((cl-typep obj 'transient-argument)) - (val (transient-infix-value obj)) - (arg (if (slot-boundp obj 'argument) - (oref obj argument) - (oref obj argument-format))) - ((if (equal val arg) - (member arg incomp) - (or (member val incomp) - (member arg incomp))))) - (transient-infix-set obj nil))))) - -(defun transient-prefix-set (value) - "Set the value of the active transient prefix to VALUE. -Intended for use by transient suffix commands." - (oset transient--prefix value value) - (setq transient--refreshp 'updated-value)) - -(cl-defgeneric transient-set-value (obj) - "Persist the value of the transient prefix OBJ. -Only intended for use by `transient-set'. -Also see `transient-prefix-set'.") - -(cl-defmethod transient-set-value ((obj transient-prefix)) - (oset (oref obj prototype) value (transient-get-value)) - (transient--history-push obj)) - -;;;; Save - -(cl-defgeneric transient-save-value (obj) - "Save the value of the transient prefix OBJ.") - -(cl-defmethod transient-save-value ((obj transient-prefix)) - (let ((value (transient-get-value))) - (oset (oref obj prototype) value value) - (setf (alist-get (oref obj command) transient-values) value) - (transient-save-values)) - (transient--history-push obj)) - -;;;; Reset - -(cl-defgeneric transient-reset-value (obj) - "Clear the set and saved values of the transient prefix OBJ.") - -(cl-defmethod transient-reset-value ((obj transient-prefix)) - (let ((value (transient-default-value obj))) - (oset obj value value) - (oset (oref obj prototype) value value) - (setf (alist-get (oref obj command) transient-values nil 'remove) nil) - (transient-save-values)) - (transient--history-push obj) - (mapc #'transient-init-value transient--suffixes)) - -;;;; Get - -(defun transient-args (prefix) - "Return the value of the transient prefix command PREFIX. -If the current command was invoked from the transient prefix -command PREFIX, then return the active infix arguments. If -the current command was not invoked from PREFIX, then return -the set, saved or default value for PREFIX." - (cl-mapcan #'transient--get-wrapped-value (transient-suffixes prefix))) - -(defun transient-suffixes (prefix) - "Return the suffix objects of the transient prefix command PREFIX." - (if (eq transient-current-command prefix) - transient-current-suffixes - (let ((transient--prefix (transient--init-prefix prefix))) - (transient--flatten-suffixes - (transient--init-suffixes prefix))))) - -(defun transient-get-value () - (transient--with-emergency-exit :get-value - (cl-mapcan (lambda (obj) - (and (or (not (slot-exists-p obj 'unsavable)) - (not (oref obj unsavable))) - (transient--get-wrapped-value obj))) - (or transient--suffixes transient-current-suffixes)))) - -(defun transient--get-wrapped-value (obj) - (and-let* ((value (transient-infix-value obj))) - (pcase-exhaustive (and (slot-exists-p obj 'multi-value) - (oref obj multi-value)) - ('nil (list value)) - ((or 't 'rest) (list value)) - ('repeat value)))) - -(cl-defgeneric transient-infix-value (obj) - "Return the value of the suffix object OBJ. - -This function is called by `transient-args' (which see), meaning -this function is how the value of a transient is determined so -that the invoked suffix command can use it. - -Currently most values are strings, but that is not set in stone. -Nil is not a value, it means \"no value\". - -Usually only infixes have a value, but see the method for -`transient-suffix'.") - -(cl-defmethod transient-infix-value ((_ transient-suffix)) - "Return nil, which means \"no value\". - -Infix arguments contribute the transient's value while suffix -commands consume it. This function is called for suffixes anyway -because a command that both contributes to the transient's value -and also consumes it is not completely unconceivable. - -If you define such a command, then you must define a derived -class and implement this function because this default method -does nothing." nil) - -(cl-defmethod transient-infix-value ((obj transient-infix)) - "Return the value of OBJ's `value' slot." - (oref obj value)) - -(cl-defmethod transient-infix-value ((obj transient-option)) - "Return ARGUMENT and VALUE as a unit or nil if the latter is nil." - (and-let* ((value (oref obj value))) - (let ((arg (oref obj argument))) - (pcase-exhaustive (oref obj multi-value) - ('nil (concat arg value)) - ((or 't 'rest) (cons arg value)) - ('repeat (mapcar (lambda (v) (concat arg v)) value)))))) - -(cl-defmethod transient-infix-value ((_ transient-variable)) - "Return nil, which means \"no value\". - -Setting the value of a variable is done by, well, setting the -value of the variable. I.e., this is a side-effect and does -not contribute to the value of the transient." - nil) - -;;;; Utilities - -(defun transient-arg-value (arg args) - "Return the value of ARG as it appears in ARGS. - -For a switch return a boolean. For an option return the value as -a string, using the empty string for the empty value, or nil if -the option does not appear in ARGS." - (if (string-suffix-p "=" arg) - (save-match-data - (and-let* ((match (let ((case-fold-search nil) - (re (format "\\`%s\\(?:=\\(.+\\)\\)?\\'" - (substring arg 0 -1)))) - (cl-find-if (lambda (a) - (and (stringp a) - (string-match re a))) - args)))) - (or (match-string 1 match) ""))) - (and (member arg args) t))) - -(defun transient-scope () - "Return the value of the `scope' slot of the current prefix." - (oref (transient-prefix-object) scope)) - -;;; History - -(cl-defgeneric transient--history-key (obj) - "Return OBJ's history key. -If the value of the `history-key' slot is non-nil, then return -that. Otherwise return the value of the `command' slot." - (or (oref obj history-key) - (oref obj command))) - -(cl-defgeneric transient--history-push (obj) - "Push the current value of OBJ to its entry in `transient-history'." - (let ((key (transient--history-key obj))) - (setf (alist-get key transient-history) - (let ((args (transient-get-value))) - (cons args (delete args (alist-get key transient-history))))))) - -(cl-defgeneric transient--history-init (obj) - "Initialize OBJ's `history' slot. -This is the transient-wide history; many individual infixes also -have a history of their own.") - -(cl-defmethod transient--history-init ((obj transient-prefix)) - "Initialize OBJ's `history' slot from the variable `transient-history'." - (let ((val (oref obj value))) - (oset obj history - (cons val (delete val (alist-get (transient--history-key obj) - transient-history)))))) - -;;; Draw - -(defun transient--show-brief () - (let ((message-log-max nil)) - (if (and transient-show-popup (<= transient-show-popup 0)) - (message "%s-" (key-description (this-command-keys))) - (message - "%s- [%s] %s" - (key-description (this-command-keys)) - (oref transient--prefix command) - (mapconcat - #'identity - (sort - (cl-mapcan - (lambda (suffix) - (let ((key (kbd (oref suffix key)))) - ;; Don't list any common commands. - (and (not (memq (oref suffix command) - `(,(lookup-key transient-map key) - ,(lookup-key transient-sticky-map key) - ;; From transient-common-commands: - transient-set - transient-save - transient-history-prev - transient-history-next - transient-quit-one - transient-toggle-common - transient-set-level))) - (list (propertize (oref suffix key) 'face 'transient-key))))) - transient--suffixes) - #'string<) - (propertize "|" 'face 'transient-delimiter)))))) - -(defun transient--show () - (transient--timer-cancel) - (setq transient--showp t) - (let ((transient--shadowed-buffer (current-buffer)) - (focus nil)) - (setq transient--buffer (get-buffer-create transient--buffer-name)) - (with-current-buffer transient--buffer - (when transient-enable-popup-navigation - (setq focus (or (button-get (point) 'command) - (and (not (bobp)) - (button-get (1- (point)) 'command)) - (transient--heading-at-point)))) - (erase-buffer) - (run-hooks 'transient-setup-buffer-hook) - (when transient-force-fixed-pitch - (transient--force-fixed-pitch)) - (setq window-size-fixed t) - (when (bound-and-true-p tab-line-format) - (setq tab-line-format nil)) - (setq header-line-format nil) - (setq mode-line-format - (if (or (natnump transient-mode-line-format) - (eq transient-mode-line-format 'line)) - nil - transient-mode-line-format)) - (setq mode-line-buffer-identification - (symbol-name (oref transient--prefix command))) - (if transient-enable-popup-navigation - (setq-local cursor-in-non-selected-windows 'box) - (setq cursor-type nil)) - (setq display-line-numbers nil) - (setq show-trailing-whitespace nil) - (transient--insert-groups) - (when (or transient--helpp transient--editp) - (transient--insert-help)) - (when-let ((line (transient--separator-line))) - (insert line))) - (unless (window-live-p transient--window) - (setq transient--window - (display-buffer transient--buffer - transient-display-buffer-action))) - (when (window-live-p transient--window) - (with-selected-window transient--window - (goto-char (point-min)) - (when transient-enable-popup-navigation - (transient--goto-button focus)) - (transient--fit-window-to-buffer transient--window))))) - -(defun transient--fit-window-to-buffer (window) - (let ((window-resize-pixelwise t) - (window-size-fixed nil)) - (if (eq (car (window-parameter window 'quit-restore)) 'other) - ;; Grow but never shrink window that previously displayed - ;; another buffer and is going to display that again. - (fit-window-to-buffer window nil (window-height window)) - (fit-window-to-buffer window nil 1)))) - -(defun transient--separator-line () - (and-let* ((height (cond ((not window-system) nil) - ((natnump transient-mode-line-format) - transient-mode-line-format) - ((eq transient-mode-line-format 'line) 1))) - (face `(,@(and (>= emacs-major-version 27) '(:extend t)) - :background - ,(or (face-foreground (transient--key-face nil 'non-suffix) - nil t) - "#gray60")))) - (concat (propertize "__" 'face face 'display `(space :height (,height))) - (propertize "\n" 'face face 'line-height t)))) - -(defmacro transient-with-shadowed-buffer (&rest body) - "While in the transient buffer, temporarily make the shadowed buffer current." - (declare (indent 0) (debug t)) - `(with-current-buffer (or transient--shadowed-buffer (current-buffer)) - ,@body)) - -(defun transient--insert-groups () - (let ((groups (cl-mapcan (lambda (group) - (let ((hide (oref group hide))) - (and (not (and (functionp hide) - (transient-with-shadowed-buffer - (funcall hide)))) - (list group)))) - transient--layout))) - (while-let ((group (pop groups))) - (transient--insert-group group) - (when groups - (insert ?\n))))) - -(defvar transient--max-group-level 1) - -(cl-defgeneric transient--insert-group (group) - "Format GROUP and its elements and insert the result.") - -(cl-defmethod transient--insert-group :around ((group transient-group)) - "Insert GROUP's description, if any." - (when-let ((desc (transient-with-shadowed-buffer - (transient-format-description group)))) - (insert desc ?\n)) - (let ((transient--max-group-level - (max (oref group level) transient--max-group-level)) - (transient--pending-group group)) - (cl-call-next-method group))) - -(cl-defmethod transient--insert-group ((group transient-row)) - (transient--maybe-pad-keys group) - (dolist (suffix (oref group suffixes)) - (insert (transient-with-shadowed-buffer (transient-format suffix))) - (insert " ")) - (insert ?\n)) - -(cl-defmethod transient--insert-group ((group transient-column)) - (transient--maybe-pad-keys group) - (dolist (suffix (oref group suffixes)) - (let ((str (transient-with-shadowed-buffer (transient-format suffix)))) - (insert str) - (unless (string-match-p ".\n\\'" str) - (insert ?\n))))) - -(cl-defmethod transient--insert-group ((group transient-columns)) - (let* ((columns - (mapcar - (lambda (column) - (transient--maybe-pad-keys column group) - (transient-with-shadowed-buffer - (let* ((transient--pending-group column) - (rows (mapcar #'transient-format (oref column suffixes)))) - (if-let ((desc (transient-format-description column))) - (cons desc rows) - rows)))) - (oref group suffixes))) - (vp (or (oref transient--prefix variable-pitch) - transient-align-variable-pitch)) - (rs (apply #'max (mapcar #'length columns))) - (cs (length columns)) - (cw (mapcar (let ((widths (oref transient--prefix column-widths))) - (lambda (col) - (apply - #'max - (if-let ((min (pop widths))) - (if vp (* min (transient--pixel-width " ")) min) - 0) - (mapcar (if vp #'transient--pixel-width #'length) - col)))) - columns)) - (cc (transient--seq-reductions-from - (apply-partially #'+ (* 2 (if vp (transient--pixel-width " ") 1))) - cw 0))) - (if transient-force-single-column - (dotimes (c cs) - (dotimes (r rs) - (when-let ((cell (nth r (nth c columns)))) - (unless (equal cell "") - (insert cell ?\n)))) - (unless (= c (1- cs)) - (insert ?\n))) - (dotimes (r rs) - (dotimes (c cs) - (if vp - (progn - (when-let ((cell (nth r (nth c columns)))) - (insert cell)) - (if (= c (1- cs)) - (insert ?\n) - (insert (propertize " " 'display - `(space :align-to (,(nth (1+ c) cc))))))) - (when (> c 0) - (insert (make-string (max 1 (- (nth c cc) (current-column))) - ?\s))) - (when-let ((cell (nth r (nth c columns)))) - (insert cell)) - (when (= c (1- cs)) - (insert ?\n)))))))) - -(cl-defmethod transient--insert-group ((group transient-subgroups)) - (let ((subgroups (oref group suffixes))) - (while-let ((subgroup (pop subgroups))) - (transient--maybe-pad-keys subgroup group) - (transient--insert-group subgroup) - (when subgroups - (insert ?\n))))) - -(cl-defgeneric transient-format (obj) - "Format and return OBJ for display. - -When this function is called, then the current buffer is some -temporary buffer. If you need the buffer from which the prefix -command was invoked to be current, then do so by temporarily -making `transient--original-buffer' current.") - -(cl-defmethod transient-format ((arg string)) - "Return the string ARG after applying the `transient-heading' face." - (propertize arg 'face 'transient-heading)) - -(cl-defmethod transient-format ((_ null)) - "Return a string containing just the newline character." - "\n") - -(cl-defmethod transient-format ((arg integer)) - "Return a string containing just the ARG character." - (char-to-string arg)) - -(cl-defmethod transient-format :around ((obj transient-suffix)) - "Add additional formatting if appropriate. -When reading user input for this infix, then highlight it. -When edit-mode is enabled, then prepend the level information. -When `transient-enable-popup-navigation' is non-nil then format -as a button." - (let ((str (cl-call-next-method obj))) - (when (and (cl-typep obj 'transient-infix) - (eq (oref obj command) this-original-command) - (active-minibuffer-window)) - (setq str (transient--add-face str 'transient-active-infix))) - (when transient--editp - (setq str (concat (let ((level (oref obj level))) - (propertize (format " %s " level) - 'face (if (transient--use-level-p level t) - 'transient-enabled-suffix - 'transient-disabled-suffix))) - str))) - (when (and transient-enable-popup-navigation - (slot-boundp obj 'command)) - (setq str (make-text-button str nil - 'type 'transient - 'command (oref obj command)))) - str)) - -(cl-defmethod transient-format ((obj transient-infix)) - "Return a string generated using OBJ's `format'. -%k is formatted using `transient-format-key'. -%d is formatted using `transient-format-description'. -%v is formatted using `transient-format-value'." - (format-spec (oref obj format) - `((?k . ,(transient-format-key obj)) - (?d . ,(transient-format-description obj)) - (?v . ,(transient-format-value obj))))) - -(cl-defmethod transient-format ((obj transient-suffix)) - "Return a string generated using OBJ's `format'. -%k is formatted using `transient-format-key'. -%d is formatted using `transient-format-description'." - (format-spec (oref obj format) - `((?k . ,(transient-format-key obj)) - (?d . ,(transient-format-description obj))))) - -(cl-defgeneric transient-format-key (obj) - "Format OBJ's `key' for display and return the result.") - -(cl-defmethod transient-format-key :around ((obj transient-suffix)) - "Add `transient-inapt-suffix' face if suffix is inapt." - (let ((str (cl-call-next-method))) - (if (oref obj inapt) - (transient--add-face str 'transient-inapt-suffix) - str))) - -(cl-defmethod transient-format-key ((obj transient-suffix)) - "Format OBJ's `key' for display and return the result." - (let ((key (if (slot-boundp obj 'key) (oref obj key) "")) - (cmd (and (slot-boundp obj 'command) (oref obj command)))) - (when-let ((width (oref transient--pending-group pad-keys))) - (setq key (truncate-string-to-width key width nil ?\s))) - (if transient--redisplay-key - (let ((len (length transient--redisplay-key)) - (seq (cl-coerce (edmacro-parse-keys key t) 'list))) - (cond - ((member (seq-take seq len) - (list transient--redisplay-key - (thread-last transient--redisplay-key - (cl-substitute ?- 'kp-subtract) - (cl-substitute ?= 'kp-equal) - (cl-substitute ?+ 'kp-add)))) - (let ((pre (key-description (vconcat (seq-take seq len)))) - (suf (key-description (vconcat (seq-drop seq len))))) - (setq pre (string-replace "RET" "C-m" pre)) - (setq pre (string-replace "TAB" "C-i" pre)) - (setq suf (string-replace "RET" "C-m" suf)) - (setq suf (string-replace "TAB" "C-i" suf)) - ;; We use e.g., "-k" instead of the more correct "- k", - ;; because the former is prettier. If we did that in - ;; the definition, then we want to drop the space that - ;; is reinserted above. False-positives are possible - ;; for silly bindings like "-C-c C-c". - (unless (string-search " " key) - (setq pre (string-replace " " "" pre)) - (setq suf (string-replace " " "" suf))) - (concat (propertize pre 'face 'transient-unreachable-key) - (and (string-prefix-p (concat pre " ") key) " ") - (propertize suf 'face (transient--key-face cmd)) - (save-excursion - (and (string-match " +\\'" key) - (propertize (match-string 0 key) - 'face 'fixed-pitch)))))) - ((transient--lookup-key transient-sticky-map (kbd key)) - (propertize key 'face (transient--key-face cmd))) - (t - (propertize key 'face 'transient-unreachable-key)))) - (propertize key 'face (transient--key-face cmd))))) - -(cl-defmethod transient-format-key :around ((obj transient-argument)) - "Handle `transient-highlight-mismatched-keys'." - (let ((key (cl-call-next-method obj))) - (cond - ((not transient-highlight-mismatched-keys) key) - ((not (slot-boundp obj 'shortarg)) - (transient--add-face key 'transient-nonstandard-key)) - ((not (string-equal key (oref obj shortarg))) - (transient--add-face key 'transient-mismatched-key)) - (key)))) - -(cl-defgeneric transient-format-description (obj) - "Format OBJ's `description' for display and return the result.") - -(cl-defmethod transient-format-description ((obj transient-suffix)) - "The `description' slot may be a function, in which case that is -called inside the correct buffer (see `transient--insert-group') -and its value is returned to the caller." - (transient--get-description obj)) - -(cl-defmethod transient-format-description ((obj transient-value-preset)) - (pcase-let* (((eieio description key set) obj) - ((eieio value) transient--prefix) - (active (seq-set-equal-p set value))) - (format - "%s %s" - (propertize (or description (format "Preset %s" key)) - 'face (and active 'transient-argument)) - (format (propertize "(%s)" 'face 'transient-delimiter) - (mapconcat (lambda (arg) - (propertize - arg 'face (cond (active 'transient-argument) - ((member arg value) - '((:weight demibold) - transient-inactive-argument)) - ('transient-inactive-argument)))) - set " "))))) - -(cl-defmethod transient-format-description ((obj transient-group)) - "Format the description by calling the next method. If the result -doesn't use the `face' property at all, then apply the face -`transient-heading' to the complete string." - (and-let* ((desc (transient--get-description obj))) - (cond ((oref obj inapt) - (propertize desc 'face 'transient-inapt-suffix)) - ((text-property-not-all 0 (length desc) 'face nil desc) - desc) - ((propertize desc 'face 'transient-heading))))) - -(cl-defmethod transient-format-description :around ((obj transient-suffix)) - "Format the description by calling the next method. If the result -is nil, then use \"(BUG: no description)\" as the description. -If the OBJ's `key' is currently unreachable, then apply the face -`transient-unreachable' to the complete string." - (let ((desc (or (cl-call-next-method obj) - (and (slot-boundp transient--prefix 'suffix-description) - (funcall (oref transient--prefix suffix-description) - obj))))) - (if desc - (when-let ((face (transient--get-face obj 'face))) - (setq desc (transient--add-face desc face t))) - (setq desc (propertize "(BUG: no description)" 'face 'error))) - (when (if transient--all-levels-p - (> (oref obj level) transient--default-prefix-level) - (and transient-highlight-higher-levels - (> (max (oref obj level) transient--max-group-level) - transient--default-prefix-level))) - (setq desc (transient--add-face desc 'transient-higher-level))) - (when-let ((inapt-face (and (oref obj inapt) - (transient--get-face obj 'inapt-face)))) - (setq desc (transient--add-face desc inapt-face))) - (when (and (slot-boundp obj 'key) - (transient--key-unreachable-p obj)) - (setq desc (transient--add-face desc 'transient-unreachable))) - desc)) - -(cl-defgeneric transient-format-value (obj) - "Format OBJ's value for display and return the result.") - -(cl-defmethod transient-format-value ((obj transient-suffix)) - (propertize (oref obj argument) - 'face (if (oref obj value) - 'transient-argument - 'transient-inactive-argument))) - -(cl-defmethod transient-format-value ((obj transient-option)) - (let ((argument (oref obj argument))) - (if-let ((value (oref obj value))) - (pcase-exhaustive (oref obj multi-value) - ('nil - (concat (propertize argument 'face 'transient-argument) - (propertize value 'face 'transient-value))) - ((or 't 'rest) - (concat (propertize (if (string-suffix-p " " argument) - argument - (concat argument " ")) - 'face 'transient-argument) - (propertize (mapconcat #'prin1-to-string value " ") - 'face 'transient-value))) - ('repeat - (mapconcat (lambda (value) - (concat (propertize argument 'face 'transient-argument) - (propertize value 'face 'transient-value))) - value " "))) - (propertize argument 'face 'transient-inactive-argument)))) - -(cl-defmethod transient-format-value ((obj transient-switches)) - (with-slots (value argument-format choices) obj - (format (propertize argument-format - 'face (if value - 'transient-argument - 'transient-inactive-argument)) - (format - (propertize "[%s]" 'face 'transient-delimiter) - (mapconcat - (lambda (choice) - (propertize choice 'face - (if (equal (format argument-format choice) value) - 'transient-value - 'transient-inactive-value))) - choices - (propertize "|" 'face 'transient-delimiter)))))) - -(cl-defmethod transient--get-description ((obj transient-child)) - (and-let* ((desc (oref obj description))) - (if (functionp desc) - (if (= (car (transient--func-arity desc)) 1) - (funcall desc obj) - (funcall desc)) - desc))) - -(cl-defmethod transient--get-face ((obj transient-suffix) slot) - (and-let* (((slot-boundp obj slot)) - (face (slot-value obj slot))) - (if (and (not (facep face)) - (functionp face)) - (let ((transient--pending-suffix obj)) - (if (= (car (transient--func-arity face)) 1) - (funcall face obj) - (funcall face))) - face))) - -(defun transient--add-face (string face &optional append beg end) - (let ((str (copy-sequence string))) - (add-face-text-property (or beg 0) (or end (length str)) face append str) - str)) - -(defun transient--key-face (&optional cmd enforce-type) - (or (and transient-semantic-coloring - (not transient--helpp) - (not transient--editp) - (or (and cmd (get cmd 'transient-face)) - (get (transient--get-pre-command cmd enforce-type) - 'transient-face))) - (if cmd 'transient-key 'transient-key-noop))) - -(defun transient--key-unreachable-p (obj) - (and transient--redisplay-key - (let ((key (oref obj key))) - (not (or (equal (seq-take (cl-coerce (edmacro-parse-keys key t) 'list) - (length transient--redisplay-key)) - transient--redisplay-key) - (transient--lookup-key transient-sticky-map (kbd key))))))) - -(defun transient--lookup-key (keymap key) - (let ((val (lookup-key keymap key))) - (and val (not (integerp val)) val))) - -(defun transient--maybe-pad-keys (group &optional parent) - (when-let ((pad (or (oref group pad-keys) - (and parent (oref parent pad-keys))))) - (oset group pad-keys - (apply #'max - (if (integerp pad) pad 0) - (seq-keep (lambda (suffix) - (and (eieio-object-p suffix) - (slot-boundp suffix 'key) - (length (oref suffix key)))) - (oref group suffixes)))))) - -(defun transient--pixel-width (string) - (save-window-excursion - (with-temp-buffer - (insert string) - (set-window-dedicated-p nil nil) - (set-window-buffer nil (current-buffer)) - (car (window-text-pixel-size - nil (line-beginning-position) (point)))))) - -(defun transient-command-summary-or-name (obj) - "Return the summary or name of the command represented by OBJ. - -If the command has a doc-string, then return the first line of -that, else its name. - -Intended to be temporarily used as the `:suffix-description' of -a prefix command, while porting a regular keymap to a transient." - (let ((command (oref obj command))) - (if-let ((doc (documentation command))) - (propertize (car (split-string doc "\n")) 'face 'font-lock-doc-face) - (propertize (symbol-name command) 'face 'font-lock-function-name-face)))) - -;;; Help - -(cl-defgeneric transient-show-help (obj) - "Show documentation for the command represented by OBJ.") - -(cl-defmethod transient-show-help ((obj transient-prefix)) - "Call `show-help' if non-nil, else show `info-manual', -if non-nil, else show the `man-page' if non-nil, else use -`describe-function'." - (with-slots (show-help info-manual man-page command) obj - (cond (show-help (funcall show-help obj)) - (info-manual (transient--show-manual info-manual)) - (man-page (transient--show-manpage man-page)) - ((transient--describe-function command))))) - -(cl-defmethod transient-show-help ((obj transient-suffix)) - "Call `show-help' if non-nil, else use `describe-function'. -Also used to dispatch showing documentation for the current -prefix. If the suffix is a sub-prefix, then also call the -prefix method." - (cond - ((eq this-command 'transient-help) - (transient-show-help transient--prefix)) - ((let ((prefix (get (oref obj command) - 'transient--prefix))) - (and prefix (not (eq (oref transient--prefix command) this-command)) - (prog1 t (transient-show-help prefix))))) - ((if-let ((show-help (oref obj show-help))) - (funcall show-help obj) - (transient--describe-function this-command))))) - -(cl-defmethod transient-show-help ((obj transient-infix)) - "Call `show-help' if non-nil, else show the `man-page' -if non-nil, else use `describe-function'. When showing the -manpage, then try to jump to the correct location." - (if-let ((show-help (oref obj show-help))) - (funcall show-help obj) - (if-let ((man-page (oref transient--prefix man-page)) - (argument (and (slot-boundp obj 'argument) - (oref obj argument)))) - (transient--show-manpage man-page argument) - (transient--describe-function this-command)))) - -;; `cl-generic-generalizers' doesn't support `command' et al. -(cl-defmethod transient-show-help (cmd) - "Show the command doc-string." - (transient--describe-function cmd)) - -(defun transient--describe-function (fn) - (describe-function fn) - (unless (derived-mode-p 'help-mode) - (when-let* ((buf (get-buffer "*Help*")) - (win (or (and buf (get-buffer-window buf)) - (cl-find-if (lambda (win) - (with-current-buffer (window-buffer win) - (derived-mode-p 'help-mode))) - (window-list))))) - (select-window win)))) - -(defun transient--show-manual (manual) - (info manual)) - -(defun transient--show-manpage (manpage &optional argument) - (require 'man) - (let* ((Man-notify-method 'meek) - (buf (Man-getpage-in-background manpage)) - (proc (get-buffer-process buf))) - (while (and proc (eq (process-status proc) 'run)) - (accept-process-output proc)) - (switch-to-buffer buf) - (when argument - (transient--goto-argument-description argument)))) - -(defun transient--goto-argument-description (arg) - (goto-char (point-min)) - (let ((case-fold-search nil) - ;; This matches preceding/proceeding options. Options - ;; such as "-a", "-S[<keyid>]", and "--grep=<pattern>" - ;; are matched by this regex without the shy group. - ;; The ". " in the shy group is for options such as - ;; "-m parent-number", and the "-[^[:space:]]+ " is - ;; for options such as "--mainline parent-number" - (others "-\\(?:. \\|-[^[:space:]]+ \\)?[^[:space:]]+")) - (when (re-search-forward - (if (equal arg "--") - ;; Special case. - "^[\t\s]+\\(--\\(?: \\|$\\)\\|\\[--\\]\\)" - ;; Should start with whitespace and may have - ;; any number of options before and/or after. - (format - "^[\t\s]+\\(?:%s, \\)*?\\(?1:%s\\)%s\\(?:, %s\\)*$" - others - ;; Options don't necessarily end in an "=" - ;; (e.g., "--gpg-sign[=<keyid>]") - (string-remove-suffix "=" arg) - ;; Simple options don't end in an "=". Splitting this - ;; into 2 cases should make getting false positives - ;; less likely. - (if (string-suffix-p "=" arg) - ;; "[^[:space:]]*[^.[:space:]]" matches the option - ;; value, which is usually after the option name - ;; and either '=' or '[='. The value can't end in - ;; a period, as that means it's being used at the - ;; end of a sentence. The space is for options - ;; such as '--mainline parent-number'. - "\\(?: \\|\\[?=\\)[^[:space:]]*[^.[:space:]]" - ;; Either this doesn't match anything (e.g., "-a"), - ;; or the option is followed by a value delimited - ;; by a "[", "<", or ":". A space might appear - ;; before this value, as in "-f <file>". The - ;; space alternative is for options such as - ;; "-m parent-number". - "\\(?:\\(?: \\| ?[\\[<:]\\)[^[:space:]]*[^.[:space:]]\\)?") - others)) - nil t) - (goto-char (match-beginning 1))))) - -(defun transient--insert-help () - (unless (looking-back "\n\n" 2) - (insert "\n")) - (when transient--helpp - (insert - (format (propertize "\ -Type a %s to show help for that suffix command, or %s to show manual. -Type %s to exit help.\n" - 'face 'transient-heading) - (propertize "<KEY>" 'face 'transient-key) - (propertize "?" 'face 'transient-key) - (propertize "C-g" 'face 'transient-key)))) - (when transient--editp - (unless transient--helpp - (insert - (format (propertize "\ -Type a %s to set level for that suffix command. -Type %s to set what levels are available for this prefix command.\n" - 'face 'transient-heading) - (propertize "<KEY>" 'face 'transient-key) - (propertize "C-x l" 'face 'transient-key)))) - (with-slots (level) transient--prefix - (insert - (format (propertize " -Suffixes on levels %s are available. -Suffixes on levels %s and %s are unavailable.\n" - 'face 'transient-heading) - (propertize (format "1-%s" level) - 'face 'transient-enabled-suffix) - (propertize " 0 " - 'face 'transient-disabled-suffix) - (propertize (format ">=%s" (1+ level)) - 'face 'transient-disabled-suffix)))))) - -;;; Popup Navigation - -(defun transient-scroll-up (&optional arg) - "Scroll text of transient popup window upward ARG lines. -If ARG is nil scroll near full screen. This is a wrapper -around `scroll-up-command' (which see)." - (interactive "^P") - (with-selected-window transient--window - (scroll-up-command arg))) - -(defun transient-scroll-down (&optional arg) - "Scroll text of transient popup window down ARG lines. -If ARG is nil scroll near full screen. This is a wrapper -around `scroll-down-command' (which see)." - (interactive "^P") - (with-selected-window transient--window - (scroll-down-command arg))) - -(defun transient-backward-button (n) - "Move to the previous button in the transient popup buffer. -See `backward-button' for information about N." - (interactive "p") - (with-selected-window transient--window - (backward-button n t))) - -(defun transient-forward-button (n) - "Move to the next button in the transient popup buffer. -See `forward-button' for information about N." - (interactive "p") - (with-selected-window transient--window - (forward-button n t))) - -(define-button-type 'transient - 'face nil - 'keymap transient-button-map) - -(defun transient--goto-button (command) - (cond - ((stringp command) - (when (re-search-forward (concat "^" (regexp-quote command)) nil t) - (goto-char (match-beginning 0)))) - (command - (while (and (ignore-errors (forward-button 1)) - (not (eq (button-get (button-at (point)) 'command) command)))) - (unless (eq (button-get (button-at (point)) 'command) command) - (goto-char (point-min)) - (forward-button 1))))) - -(defun transient--heading-at-point () - (and (eq (get-text-property (point) 'face) 'transient-heading) - (let ((beg (line-beginning-position))) - (buffer-substring-no-properties - beg (next-single-property-change - beg 'face nil (line-end-position)))))) - -;;; Compatibility -;;;; Popup Isearch - -(defvar-keymap transient--isearch-mode-map - :parent isearch-mode-map - "<remap> <isearch-exit>" #'transient-isearch-exit - "<remap> <isearch-cancel>" #'transient-isearch-cancel - "<remap> <isearch-abort>" #'transient-isearch-abort) - -(defun transient-isearch-backward (&optional regexp-p) - "Do incremental search backward. -With a prefix argument, do an incremental regular expression -search instead." - (interactive "P") - (transient--isearch-setup) - (let ((isearch-mode-map transient--isearch-mode-map)) - (isearch-mode nil regexp-p))) - -(defun transient-isearch-forward (&optional regexp-p) - "Do incremental search forward. -With a prefix argument, do an incremental regular expression -search instead." - (interactive "P") - (transient--isearch-setup) - (let ((isearch-mode-map transient--isearch-mode-map)) - (isearch-mode t regexp-p))) - -(defun transient-isearch-exit () - "Like `isearch-exit' but adapted for `transient'." - (interactive) - (isearch-exit) - (transient--isearch-exit)) - -(defun transient-isearch-cancel () - "Like `isearch-cancel' but adapted for `transient'." - (interactive) - (condition-case nil (isearch-cancel) (quit)) - (transient--isearch-exit)) - -(defun transient-isearch-abort () - "Like `isearch-abort' but adapted for `transient'." - (interactive) - (let ((around (lambda (fn) - (condition-case nil (funcall fn) (quit)) - (transient--isearch-exit)))) - (advice-add 'isearch-cancel :around around) - (unwind-protect - (isearch-abort) - (advice-remove 'isearch-cancel around)))) - -(defun transient--isearch-setup () - (select-window transient--window) - (transient--suspend-override t)) - -(defun transient--isearch-exit () - (select-window transient--original-window) - (transient--resume-override)) - -;;;; Edebug - -(defun transient--edebug-command-p () - (and (bound-and-true-p edebug-active) - (or (memq this-command '(top-level abort-recursive-edit)) - (string-prefix-p "edebug" (symbol-name this-command))))) - -;;;; Miscellaneous - -(cl-pushnew (list nil (concat "^\\s-*(" - (eval-when-compile - (regexp-opt - '("transient-define-prefix" - "transient-define-suffix" - "transient-define-infix" - "transient-define-argument") - t)) - "\\s-+\\(" lisp-mode-symbol-regexp "\\)") - 2) - lisp-imenu-generic-expression :test #'equal) - -(declare-function which-key-mode "which-key" (&optional arg)) - -(defun transient--suspend-which-key-mode () - (when (bound-and-true-p which-key-mode) - (which-key-mode -1) - (add-hook 'transient-exit-hook #'transient--resume-which-key-mode))) - -(defun transient--resume-which-key-mode () - (unless transient--prefix - (which-key-mode 1) - (remove-hook 'transient-exit-hook #'transient--resume-which-key-mode))) - -(defun transient-bind-q-to-quit () - "Modify some keymaps to bind \"q\" to the appropriate quit command. - -\"C-g\" is the default binding for such commands now, but Transient's -predecessor Magit-Popup used \"q\" instead. If you would like to get -that binding back, then call this function in your init file like so: - - (with-eval-after-load \\='transient - (transient-bind-q-to-quit)) - -Individual transients may already bind \"q\" to something else -and such a binding would shadow the quit binding. If that is the -case then \"Q\" is bound to whatever \"q\" would have been bound -to by setting `transient-substitute-key-function' to a function -that does that. Of course \"Q\" may already be bound to something -else, so that function binds \"M-q\" to that command instead. -Of course \"M-q\" may already be bound to something else, but -we stop there." - (keymap-set transient-base-map "q" #'transient-quit-one) - (keymap-set transient-sticky-map "q" #'transient-quit-seq) - (setq transient-substitute-key-function - #'transient-rebind-quit-commands)) - -(defun transient-rebind-quit-commands (obj) - "See `transient-bind-q-to-quit'." - (let ((key (oref obj key))) - (cond ((string-equal key "q") "Q") - ((string-equal key "Q") "M-q") - (key)))) - -(defun transient--force-fixed-pitch () - (require 'face-remap) - (face-remap-reset-base 'default) - (face-remap-add-relative 'default 'fixed-pitch)) - -(defun transient--func-arity (fn) - (func-arity (advice--cd*r (if (symbolp fn) (symbol-function fn) fn)))) - -(defun transient--seq-reductions-from (function sequence initial-value) - (let ((acc (list initial-value))) - (seq-doseq (elt sequence) - (push (funcall function (car acc) elt) acc)) - (nreverse acc))) - -;;; Font-Lock - -(defconst transient-font-lock-keywords - (eval-when-compile - `((,(concat "(" - (regexp-opt (list "transient-define-prefix" - "transient-define-infix" - "transient-define-argument" - "transient-define-suffix") - t) - "\\_>[ \t'(]*" - "\\(\\(?:\\sw\\|\\s_\\)+\\)?") - (1 'font-lock-keyword-face) - (2 'font-lock-function-name-face nil t))))) - -(font-lock-add-keywords 'emacs-lisp-mode transient-font-lock-keywords) - -;;; Auxiliary Classes -;;;; `transient-lisp-variable' - -(defclass transient-lisp-variable (transient-variable) - ((reader :initform #'transient-lisp-variable--reader) - (always-read :initform t) - (set-value :initarg :set-value :initform #'set)) - "[Experimental] Class used for Lisp variables.") - -(cl-defmethod transient-init-value ((obj transient-lisp-variable)) - (oset obj value (symbol-value (oref obj variable)))) - -(cl-defmethod transient-infix-set ((obj transient-lisp-variable) value) - (funcall (oref obj set-value) - (oref obj variable) - (oset obj value value))) - -(cl-defmethod transient-format-description ((obj transient-lisp-variable)) - (or (cl-call-next-method obj) - (symbol-name (oref obj variable)))) - -(cl-defmethod transient-format-value ((obj transient-lisp-variable)) - (propertize (prin1-to-string (oref obj value)) - 'face 'transient-value)) - -(cl-defmethod transient-prompt ((obj transient-lisp-variable)) - (if (and (slot-boundp obj 'prompt) - (oref obj prompt)) - (cl-call-next-method obj) - (format "Set %s: " (oref obj variable)))) - -(defun transient-lisp-variable--reader (prompt initial-input _history) - (read--expression prompt initial-input)) - -;;; _ -(provide 'transient) -;; Local Variables: -;; indent-tabs-mode: nil -;; checkdoc-symbol-words: ("command-line" "edit-mode" "help-mode") -;; End: -;;; transient.el ends here diff --git a/emacs/elpa/transient-20240622.1240/transient.elc b/emacs/elpa/transient-20240622.1240/transient.elc Binary files differ. diff --git a/emacs/elpa/transient-20240622.1240/transient.info b/emacs/elpa/transient-20240622.1240/transient.info @@ -1,3273 +0,0 @@ -This is transient.info, produced by makeinfo version 6.7 from -transient.texi. - - Copyright (C) 2018–2024 Free Software Foundation, Inc. - - 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 misc features -START-INFO-DIR-ENTRY -* Transient: (transient). Transient Commands. -END-INFO-DIR-ENTRY - - -File: transient.info, Node: Top, Next: Introduction, Up: (dir) - -Transient User and Developer Manual -*********************************** - -Transient is the library used to implement the keyboard-driven “menus” -in Magit. It is distributed as a separate package, so that it can be -used to implement similar menus in other packages. - - This manual can be bit hard to digest when getting started. A useful -resource to get over that hurdle is Psionic K’s interactive tutorial, -available at <https://github.com/positron-solutions/transient-showcase>. - -This manual is for Transient version 0.7.1. - - Copyright (C) 2018–2024 Free Software Foundation, Inc. - - 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:: -* Usage:: -* Modifying Existing Transients:: -* Defining New Commands:: -* Classes and Methods:: -* FAQ:: -* Keystroke Index:: -* Command and Function Index:: -* Variable Index:: -* Concept Index:: -* GNU General Public License:: - -— The Detailed Node Listing — - -Usage - -* Invoking Transients:: -* Aborting and Resuming Transients:: -* Common Suffix Commands:: -* Saving Values:: -* Using History:: -* Getting Help for Suffix Commands:: -* Enabling and Disabling Suffixes:: -* Other Commands:: -* Configuration:: - -Defining New Commands - -* Technical Introduction:: -* Defining Transients:: -* Binding Suffix and Infix Commands:: -* Defining Suffix and Infix Commands:: -* Using Infix Arguments:: -* Transient State:: - -Binding Suffix and Infix Commands - -* Group Specifications:: -* Suffix Specifications:: - - -Classes and Methods - -* Group Classes:: -* Group Methods:: -* Prefix Classes:: -* Suffix Classes:: -* Suffix Methods:: -* Prefix Slots:: -* Suffix Slots:: -* Predicate Slots:: - -Suffix Methods - -* Suffix Value Methods:: -* Suffix Format Methods:: - - - - -File: transient.info, Node: Introduction, Next: Usage, Prev: Top, Up: Top - -1 Introduction -************** - -Transient is the library used to implement the keyboard-driven “menus” -in Magit. It is distributed as a separate package, so that it can be -used to implement similar menus in other packages. - - This manual can be bit hard to digest when getting started. A useful -resource to get over that hurdle is Psionic K’s interactive tutorial, -available at <https://github.com/positron-solutions/transient-showcase>. - -Some things that Transient can do -================================= - - • Display current state of arguments - • Display and manage lifecycle of modal bindings - • Contextual user interface - • Flow control for wizard-like composition of interactive forms - • History & persistence - • Rendering arguments for controlling CLI programs - -Complexity in CLI programs -========================== - -Complexity tends to grow with time. How do you manage the complexity of -commands? Consider the humble shell command ‘ls’. It now has over -_fifty_ command line options. Some of these are boolean flags (‘ls --l’). Some take arguments (‘ls --sort=s’). Some have no effect unless -paired with other flags (‘ls -lh’). Some are mutually exclusive. Some -shell commands even have so many options that they introduce -_subcommands_ (‘git branch’, ‘git commit’), each with their own rich set -of options (‘git branch -f’). - -Using Transient for composing interactive commands -================================================== - -What about Emacs commands used interactively? How do these handle -options? One solution is to make many versions of the same command, so -you don’t need to! Consider: ‘delete-other-windows’ vs. -‘delete-other-windows-vertically’ (among many similar examples). - - Some Emacs commands will simply prompt you for the next "argument" -(‘M-x switch-to-buffer’). Another common solution is to use prefix -arguments which usually start with ‘C-u’. Sometimes these are sensibly -numerical in nature (‘C-u 4 M-x forward-paragraph’ to move forward 4 -paragraphs). But sometimes they function instead as boolean "switches" -(‘C-u C-SPACE’ to jump to the last mark instead of just setting it, ‘C-u -C-u C-SPACE’ to unconditionally set the mark). Since there aren’t many -standards for the use of prefix options, you have to read the command’s -documentation to find out what the possibilities are. - - But when an Emacs command grows to have a truly large set of options -and arguments, with dependencies between them, lots of option values, -etc., these simple approaches just don’t scale. Transient is designed -to solve this issue. Think of it as the humble prefix argument ‘C-u’, -_raised to the power of 10_. Like ‘C-u’, it is key driven. Like the -shell, it supports boolean "flag" options, options that take arguments, -and even "sub-commands", with their own options. But instead of -searching through a man page or command documentation, well-designed -transients _guide_ their users to the relevant set of options (and even -their possible values!) directly, taking into account any important -pre-existing Emacs settings. And while for shell commands like ‘ls’, -there is only one way to "execute" (hit ‘Return’!), transients can -"execute" using multiple different keys tied to one of many -self-documenting _actions_ (imagine having 5 different colored return -keys on your keyboard!). Transients make navigating and setting large, -complex groups of command options and arguments easy. Fun even. Once -you’ve tried it, it’s hard to go back to the ‘C-u what can I do here -again?’ way. - - -File: transient.info, Node: Usage, Next: Modifying Existing Transients, Prev: Introduction, Up: Top - -2 Usage -******* - -* Menu: - -* Invoking Transients:: -* Aborting and Resuming Transients:: -* Common Suffix Commands:: -* Saving Values:: -* Using History:: -* Getting Help for Suffix Commands:: -* Enabling and Disabling Suffixes:: -* Other Commands:: -* Configuration:: - - -File: transient.info, Node: Invoking Transients, Next: Aborting and Resuming Transients, Up: Usage - -2.1 Invoking Transients -======================= - -A transient prefix command is invoked like any other command by pressing -the key that is bound to that command. The main difference to other -commands is that a transient prefix command activates a transient -keymap, which temporarily binds the transient’s infix and suffix -commands. Bindings from other keymaps may, or may not, be disabled -while the transient state is in effect. - - There are two kinds of commands that are available after invoking a -transient prefix command; infix and suffix commands. Infix commands set -some value (which is then shown in a popup buffer), without leaving the -transient. Suffix commands, on the other hand, usually quit the -transient and they may use the values set by the infix commands, i.e., -the infix *arguments*. - - Instead of setting arguments to be used by a suffix command, infix -commands may also set some value by side-effect, e.g., by setting the -value of some variable. - - -File: transient.info, Node: Aborting and Resuming Transients, Next: Common Suffix Commands, Prev: Invoking Transients, Up: Usage - -2.2 Aborting and Resuming Transients -==================================== - -To quit the transient without invoking a suffix command press ‘C-g’. - - Key bindings in transient keymaps may be longer than a single event. -After pressing a valid prefix key, all commands whose bindings do not -begin with that prefix key are temporarily unavailable and grayed out. -To abort the prefix key press ‘C-g’ (which in this case only quits the -prefix key, but not the complete transient). - - A transient prefix command can be bound as a suffix of another -transient. Invoking such a suffix replaces the current transient state -with a new transient state, i.e., the available bindings change and the -information displayed in the popup buffer is updated accordingly. -Pressing ‘C-g’ while a nested transient is active only quits the -innermost transient, causing a return to the previous transient. - - ‘C-q’ or ‘C-z’ on the other hand always exits all transients. If you -use the latter, then you can later resume the stack of transients using -‘M-x transient-resume’. - -‘C-g’ (‘transient-quit-seq’) -‘C-g’ (‘transient-quit-one’) - This key quits the currently active incomplete key sequence, if - any, or else the current transient. When quitting the current - transient, it returns to the previous transient, if any. - - Transient’s predecessor bound ‘q’ instead of ‘C-g’ to the quit -command. To learn how to get that binding back see -‘transient-bind-q-to-quit’’s documentation string. - -‘C-q’ (‘transient-quit-all’) - This command quits the currently active incomplete key sequence, if - any, and all transients, including the active transient and all - suspended transients, if any. - -‘C-z’ (‘transient-suspend’) - Like ‘transient-quit-all’, this command quits an incomplete key - sequence, if any, and all transients. Additionally, it saves the - stack of transients so that it can easily be resumed (which is - particularly useful if you quickly need to do “something else” and - the stack is deeper than a single transient, and/or you have - already changed the values of some infix arguments). - - Note that only a single stack of transients can be saved at a time. - If another stack is already saved, then saving a new stack discards - the previous stack. - -‘M-x transient-resume’ - This command resumes the previously suspended stack of transients, - if any. - - -File: transient.info, Node: Common Suffix Commands, Next: Saving Values, Prev: Aborting and Resuming Transients, Up: Usage - -2.3 Common Suffix Commands -========================== - -A few shared suffix commands are available in all transients. These -suffix commands are not shown in the popup buffer by default. - - This includes the aborting commands mentioned in the previous -section, as well as some other commands that are all bound to ‘C-x KEY’. -After ‘C-x’ is pressed, a section featuring all these common commands is -temporarily shown in the popup buffer. After invoking one of them, the -section disappears again. Note, however, that one of these commands is -described as “Show common permanently”; invoke that if you want the -common commands to always be shown for all transients. - -‘C-x t’ (‘transient-toggle-common’) - This command toggles whether the generic commands that are common - to all transients are always displayed or only after typing the - incomplete prefix key sequence ‘C-x’. This only affects the - current Emacs session. - - -- User Option: transient-show-common-commands - This option controls whether shared suffix commands are shown - alongside the transient-specific infix and suffix commands. By - default, the shared commands are not shown to avoid overwhelming - the user with too many options. - - While a transient is active, pressing ‘C-x’ always shows the common - commands. The value of this option can be changed for the current - Emacs session by typing ‘C-x t’ while a transient is active. - - The other common commands are described in either the previous or in -one of the following sections. - - Some of Transient’s key bindings differ from the respective bindings -of Magit-Popup; see *note FAQ:: for more information. - - -File: transient.info, Node: Saving Values, Next: Using History, Prev: Common Suffix Commands, Up: Usage - -2.4 Saving Values -================= - -After setting the infix arguments in a transient, the user can save -those arguments for future invocations. - - Most transients will start out with the saved arguments when they are -invoked. There are a few exceptions, though. Some transients are -designed so that the value that they use is stored externally as the -buffer-local value of some variable. Invoking such a transient again -uses the buffer-local value. (1) - - If the user does not save the value and just exits using a regular -suffix command, then the value is merely saved to the transient’s -history. That value won’t be used when the transient is next invoked, -but it is easily accessible (see *note Using History::). - -‘C-x s’ (‘transient-set’) - This command saves the value of the active transient for this Emacs - session. - -‘C-x C-s’ (‘transient-save’) - Save the value of the active transient persistently across Emacs - sessions. - -‘C-x C-k’ (‘transient-reset’) - Clear the set and saved values of the active transient. - - -- User Option: transient-values-file - This option names the file that is used to persist the values of - transients between Emacs sessions. - - ---------- Footnotes ---------- - - (1) ‘magit-diff’ and ‘magit-log’ are two prominent examples, and -their handling of buffer-local values is actually a bit more complicated -than outlined above and even customizable. - - -File: transient.info, Node: Using History, Next: Getting Help for Suffix Commands, Prev: Saving Values, Up: Usage - -2.5 Using History -================= - -Every time the user invokes a suffix command the transient’s current -value is saved to its history. These values can be cycled through the -same way one can cycle through the history of commands that read -user-input in the minibuffer. - -‘C-M-p’ (‘transient-history-prev’) -‘C-x p’ - This command switches to the previous value used for the active - transient. - -‘C-M-n’ (‘transient-history-next’) -‘C-x n’ - This command switches to the next value used for the active - transient. - - In addition to the transient-wide history, Transient of course -supports per-infix history. When an infix reads user-input using the -minibuffer, the user can use the regular minibuffer history commands to -cycle through previously used values. Usually the same keys as those -mentioned above are bound to those commands. - - Authors of transients should arrange for different infix commands -that read the same kind of value to also use the same history key (see -*note Suffix Slots::). - - Both kinds of history are saved to a file when Emacs is exited. - - -- User Option: transient-history-file - This option names the file that is used to persist the history of - transients and their infixes between Emacs sessions. - - -- User Option: transient-history-limit - This option controls how many history elements are kept at the time - the history is saved in ‘transient-history-file’. - - -File: transient.info, Node: Getting Help for Suffix Commands, Next: Enabling and Disabling Suffixes, Prev: Using History, Up: Usage - -2.6 Getting Help for Suffix Commands -==================================== - -Transients can have many suffixes and infixes that the user might not be -familiar with. To make it trivial to get help for these, Transient -provides access to the documentation directly from the active transient. - -‘C-h’ (‘transient-help’) - This command enters help mode. When help mode is active, typing a - key shows information about the suffix command that the key - normally is bound to (instead of invoking it). Pressing ‘C-h’ a - second time shows information about the _prefix_ command. - - After typing a key, the stack of transient states is suspended and - information about the suffix command is shown instead. Typing ‘q’ - in the help buffer buries that buffer and resumes the transient - state. - - What sort of documentation is shown depends on how the transient was -defined. For infix commands that represent command-line arguments this -ideally shows the appropriate manpage. ‘transient-help’ then tries to -jump to the correct location within that. Info manuals are also -supported. The fallback is to show the command’s documentation string, -for non-infix suffixes this is usually appropriate. - - -File: transient.info, Node: Enabling and Disabling Suffixes, Next: Other Commands, Prev: Getting Help for Suffix Commands, Up: Usage - -2.7 Enabling and Disabling Suffixes -=================================== - -The user base of a package that uses transients can be very diverse. -This is certainly the case for Magit; some users have been using it and -Git for a decade, while others are just getting started now. - - For that reason a mechanism is needed that authors can use to -classify a transient’s infixes and suffixes along the -essentials...everything spectrum. We use the term “levels” to describe -that mechanism. - - Each suffix command is placed on a level and each transient has a -level (called “transient-level”), which controls which suffix commands -are available. Integers between 1 and 7 (inclusive) are valid levels. -For suffixes, 0 is also valid; it means that the suffix is not displayed -at any level. - - The levels of individual transients and/or their individual suffixes -can be changed interactively, by invoking the transient and then -pressing ‘C-x l’ to enter the “edit” mode, see below. - - The default level for both transients and their suffixes is 4. The -‘transient-default-level’ option only controls the default for -transients. The default suffix level is always 4. The authors of -transients should place certain suffixes on a higher level, if they -expect that it won’t be of use to most users, and they should place very -important suffixes on a lower level, so that they remain available even -if the user lowers the transient level. - - -- User Option: transient-default-level - This option controls which suffix levels are made available by - default. It sets the transient-level for transients for which the - user has not set that individually. - - -- User Option: transient-levels-file - This option names the file that is used to persist the levels of - transients and their suffixes between Emacs sessions. - -‘C-x l’ (‘transient-set-level’) - This command enters edit mode. When edit mode is active, then all - infixes and suffixes that are currently usable are displayed along - with their levels. The colors of the levels indicate whether they - are enabled or not. The level of the transient is also displayed - along with some usage information. - - In edit mode, pressing the key that would usually invoke a certain - suffix instead prompts the user for the level that suffix should be - placed on. - - Help mode is available in edit mode. - - To change the transient level press ‘C-x l’ again. - - To exit edit mode press ‘C-g’. - - Note that edit mode does not display any suffixes that are not - currently usable. ‘magit-rebase’, for example, shows different - suffixes depending on whether a rebase is already in progress or - not. The predicates also apply in edit mode. - - Therefore, to control which suffixes are available given a certain - state, you have to make sure that that state is currently active. - -‘C-x a’ (‘transient-toggle-level-limit’) - This command toggle whether suffixes that are on levels higher than - the level specified by ‘transient-default-level’ are temporarily - available anyway. - - -File: transient.info, Node: Other Commands, Next: Configuration, Prev: Enabling and Disabling Suffixes, Up: Usage - -2.8 Other Commands -================== - -When invoking a transient in a small frame, the transient window may not -show the complete buffer, making it necessary to scroll, using the -following commands. These commands are never shown in the transient -window, and the key bindings are the same as for ‘scroll-up-command’ and -‘scroll-down-command’ in other buffers. - - -- Command: transient-scroll-up arg - This command scrolls text of transient popup window upward ARG - lines. If ARG is ‘nil’, then it scrolls near full screen. This is - a wrapper around ‘scroll-up-command’ (which see). - - -- Command: transient-scroll-down arg - This command scrolls text of transient popup window down ARG lines. - If ARG is ‘nil’, then it scrolls near full screen. This is a - wrapper around ‘scroll-down-command’ (which see). - - -File: transient.info, Node: Configuration, Prev: Other Commands, Up: Usage - -2.9 Configuration -================= - -More options are described in *note Common Suffix Commands::, in *note -Saving Values::, in *note Using History:: and in *note Enabling and -Disabling Suffixes::. - -Essential Options ------------------ - -Also see *note Common Suffix Commands::. - - -- User Option: transient-show-popup - This option controls whether the current transient’s infix and - suffix commands are shown in the popup buffer. - - • If ‘t’ (the default) then the popup buffer is shown as soon as - a transient prefix command is invoked. - - • If ‘nil’, then the popup buffer is not shown unless the user - explicitly requests it, by pressing an incomplete prefix key - sequence. - - • If a number, then the a brief one-line summary is shown - instead of the popup buffer. If zero or negative, then not - even that summary is shown; only the pressed key itself is - shown. - - The popup is shown when the user explicitly requests it by - pressing an incomplete prefix key sequence. Unless this is - zero, the popup is shown after that many seconds of inactivity - (using the absolute value). - - -- User Option: transient-enable-popup-navigation - This option controls whether navigation commands are enabled in the - transient popup buffer. - - While a transient is active the transient popup buffer is not the - current buffer, making it necessary to use dedicated commands to - act on that buffer itself. This is disabled by default. If this - option is non-‘nil’, then the following features are available: - - • ‘<UP>’ moves the cursor to the previous suffix. - • ‘<DOWN>’ moves the cursor to the next suffix. - • ‘<RET>’ invokes the suffix the cursor is on. - • ‘mouse-1’ invokes the clicked on suffix. - • ‘C-s’ and ‘C-r’ start isearch in the popup buffer. - - -- User Option: transient-display-buffer-action - This option specifies the action used to display the transient - popup buffer. The transient popup buffer is displayed in a window - using ‘(display-buffer BUFFER transient-display-buffer-action)’. - - The value of this option has the form ‘(FUNCTION . ALIST)’, where - FUNCTION is a function or a list of functions. Each such function - should accept two arguments: a buffer to display and an alist of - the same form as ALIST. See *note (elisp)Choosing Window::, for - details. - - The default is: - - (display-buffer-in-side-window - (side . bottom) - (inhibit-same-window . t) - (window-parameters (no-other-window . t))) - - This displays the window at the bottom of the selected frame. - Another useful FUNCTION is ‘display-buffer-below-selected’, which - is what ‘magit-popup’ used by default. For more alternatives see - *note (elisp)Buffer Display Action Functions::, and *note - (elisp)Buffer Display Action Alists::. - - Note that the buffer that was current before the transient buffer - is shown should remain the current buffer. Many suffix commands - act on the thing at point, if appropriate, and if the transient - buffer became the current buffer, then that would change what is at - point. To that effect ‘inhibit-same-window’ ensures that the - selected window is not used to show the transient buffer. - - It may be possible to display the window in another frame, but - whether that works in practice depends on the window-manager. If - the window manager selects the new window (Emacs frame), then that - unfortunately changes which buffer is current. - - If you change the value of this option, then you might also want to - change the value of ‘transient-mode-line-format’. - -Accessibility Options ---------------------- - - -- User Option: transient-force-single-column - This option controls whether the use of a single column to display - suffixes is enforced. This might be useful for users with low - vision who use large text and might otherwise have to scroll in two - dimensions. - -Auxiliary Options ------------------ - - -- User Option: transient-mode-line-format - This option controls whether the transient popup buffer has a - mode-line, separator line, or neither. - - If ‘nil’, then the buffer has no mode-line. If the buffer is not - displayed right above the echo area, then this probably is not a - good value. - - If ‘line’ (the default) or a natural number, then the buffer has no - mode-line, but a line is drawn is drawn in its place. If a number - is used, that specifies the thickness of the line. On termcap - frames we cannot draw lines, so there ‘line’ and numbers are - synonyms for ‘nil’. - - The color of the line is used to indicate if non-suffixes are - allowed and whether they exit the transient. The foreground color - of ‘transient-key-noop’ (if non-suffix are disallowed), - ‘transient-key-stay’ (if allowed and transient stays active), or - ‘transient-key-exit’ (if allowed and they exit the transient) is - used to draw the line. - - Otherwise this can be any mode-line format. See *note (elisp)Mode - Line Format::, for details. - - -- User Option: transient-semantic-coloring - This option controls whether colors are used to indicate the - transient behavior of commands. - - If non-‘nil’, then the key binding of each suffix is colorized to - indicate whether it exits the transient state or not. The color of - the prefix is indicated using the line that is drawn when the value - of ‘transient-mode-line-format’ is ‘line’. - - -- User Option: transient-highlight-mismatched-keys - This option controls whether key bindings of infix commands that do - not match the respective command-line argument should be - highlighted. For other infix commands this option has no effect. - - When this option is non-‘nil’, the key binding for an infix - argument is highlighted when only a long argument (e.g., - ‘--verbose’) is specified but no shorthand (e.g., ‘-v’). In the - rare case that a shorthand is specified but the key binding does - not match, then it is highlighted differently. - - Highlighting mismatched key bindings is useful when learning the - arguments of the underlying command-line tool; you wouldn’t want to - learn any short-hands that do not actually exist. - - The highlighting is done using one of the faces - ‘transient-mismatched-key’ and ‘transient-nonstandard-key’. - - -- User Option: transient-substitute-key-function - This function is used to modify key bindings. If the value of this - option is ‘nil’ (the default), then no substitution is performed. - - This function is called with one argument, the prefix object, and - must return a key binding description, either the existing key - description it finds in the ‘key’ slot, or the key description that - replaces the prefix key. It could be used to make other - substitutions, but that is discouraged. - - For example, ‘=’ is hard to reach using my custom keyboard layout, - so I substitute ‘(’ for that, which is easy to reach using a layout - optimized for lisp. - - (setq transient-substitute-key-function - (lambda (obj) - (let ((key (oref obj key))) - (if (string-match "\\`\\(=\\)[a-zA-Z]" key) - (replace-match "(" t t key 1) - key)))) - - -- User Option: transient-read-with-initial-input - This option controls whether the last history element is used as - the initial minibuffer input when reading the value of an infix - argument from the user. If ‘nil’, there is no initial input and - the first element has to be accessed the same way as the older - elements. - - -- User Option: transient-hide-during-minibuffer-read - This option controls whether the transient buffer is hidden while - user input is being read in the minibuffer. - - -- User Option: transient-align-variable-pitch - This option controls whether columns are aligned pixel-wise in the - popup buffer. - - If this is non-‘nil’, then columns are aligned pixel-wise to - support variable-pitch fonts. Keys are not aligned, so you should - use a fixed-pitch font for the ‘transient-key’ face. Other key - faces inherit from that face unless a theme is used that breaks - that relationship. - - This option is intended for users who use a variable-pitch font for - the ‘default’ face. - - -- User Option: transient-force-fixed-pitch - This option controls whether to force the use of a monospaced font - in popup buffer. Even if you use a proportional font for the - ‘default’ face, you might still want to use a monospaced font in - transient’s popup buffer. Setting this option to ‘t’ causes - ‘default’ to be remapped to ‘fixed-pitch’ in that buffer. - -Developer Options ------------------ - -These options are mainly intended for developers. - - -- User Option: transient-detect-key-conflicts - This option controls whether key binding conflicts should be - detected at the time the transient is invoked. If so, this results - in an error, which prevents the transient from being used. Because - of that, conflicts are ignored by default. - - Conflicts cannot be determined earlier, i.e., when the transient is - being defined and when new suffixes are being added, because at - that time there can be false-positives. It is actually valid for - multiple suffixes to share a common key binding, provided the - predicates of those suffixes prevent that more than one of them is - enabled at a time. - - -- User Option: transient-highlight-higher-levels - This option controls whether suffixes that would not be available - by default are highlighted. - - When non-‘nil’ then the descriptions of suffixes are highlighted if - their level is above 4, the default of ‘transient-default-level’. - Assuming you have set that variable to 7, this highlights all - suffixes that won’t be available to users without them making the - same customization. - - -File: transient.info, Node: Modifying Existing Transients, Next: Defining New Commands, Prev: Usage, Up: Top - -3 Modifying Existing Transients -******************************* - -To an extent, transients can be customized interactively, see *note -Enabling and Disabling Suffixes::. This section explains how existing -transients can be further modified non-interactively. Let’s begin with -an example: - - (transient-append-suffix 'magit-patch-apply "-3" - '("-R" "Apply in reverse" "--reverse")) - - This inserts a new infix argument to toggle the ‘--reverse’ argument -after the infix argument that toggles ‘-3’ in ‘magit-patch-apply’. - - The following functions share a few arguments: - - • PREFIX is a transient prefix command, a symbol. - - • SUFFIX is a transient infix or suffix specification in the same - form as expected by ‘transient-define-prefix’. Note that an infix - is a special kind of suffix. Depending on context “suffixes” means - “suffixes (including infixes)” or “non-infix suffixes”. Here it - means the former. See *note Suffix Specifications::. - - SUFFIX may also be a group in the same form as expected by - ‘transient-define-prefix’. See *note Group Specifications::. - - • LOC is a command, a key vector, a key description (a string as - returned by ‘key-description’), or a list specifying coordinates - (the last element may also be a command or key). For example ‘(1 0 - -1)’ identifies the last suffix (‘-1’) of the first subgroup (‘0’) - of the second group (‘1’). - - If LOC is a list of coordinates, then it can be used to identify a - group, not just an individual suffix command. - - The function ‘transient-get-suffix’ can be useful to determine - whether a certain coordination list identifies the suffix or group - that you expect it to identify. In hairy cases it may be necessary - to look at the definition of the transient prefix command. - - These functions operate on the information stored in the -‘transient--layout’ property of the PREFIX symbol. Suffix entries in -that tree are not objects but have the form ‘(LEVEL CLASS PLIST)’, where -PLIST should set at least ‘:key’, ‘:description’ and ‘:command’. - - -- Function: transient-insert-suffix prefix loc suffix &optional - keep-other - -- Function: transient-append-suffix prefix loc suffix &optional - keep-other - These functions insert the suffix or group SUFFIX into PREFIX - before or after LOC. - - Conceptually adding a binding to a transient prefix is similar to - adding a binding to a keymap, but this is complicated by the fact - that multiple suffix commands can be bound to the same key, - provided they are never active at the same time, see *note - Predicate Slots::. - - Unfortunately both false-positives and false-negatives are - possible. To deal with the former use non-‘nil’ KEEP-OTHER. To - deal with the latter remove the conflicting binding explicitly. - - -- Function: transient-replace-suffix prefix loc suffix - This function replaces the suffix or group at LOC in PREFIX with - suffix or group SUFFIX. - - -- Function: transient-remove-suffix prefix loc - This function removes the suffix or group at LOC in PREFIX. - - -- Function: transient-get-suffix prefix loc - This function returns the suffix or group at LOC in PREFIX. The - returned value has the form mentioned above. - - -- Function: transient-suffix-put prefix loc prop value - This function edits the suffix or group at LOC in PREFIX, by - setting the PROP of its plist to VALUE. - - Most of these functions do not signal an error if they cannot perform -the requested modification. The functions that insert new suffixes show -a warning if LOC cannot be found in PREFIX without signaling an error. -The reason for doing it like this is that establishing a key binding -(and that is what we essentially are trying to do here) should not -prevent the rest of the configuration from loading. Among these -functions only ‘transient-get-suffix’ and ‘transient-suffix-put’ may -signal an error. - - -File: transient.info, Node: Defining New Commands, Next: Classes and Methods, Prev: Modifying Existing Transients, Up: Top - -4 Defining New Commands -*********************** - -* Menu: - -* Technical Introduction:: -* Defining Transients:: -* Binding Suffix and Infix Commands:: -* Defining Suffix and Infix Commands:: -* Using Infix Arguments:: -* Transient State:: - - -File: transient.info, Node: Technical Introduction, Next: Defining Transients, Up: Defining New Commands - -4.1 Technical Introduction -========================== - -Taking inspiration from prefix keys and prefix arguments, Transient -implements a similar abstraction involving a prefix command, infix -arguments and suffix commands. - - When the user calls a transient prefix command, a transient -(temporary) keymap is activated, which binds the transient’s infix and -suffix commands, and functions that control the transient state are -added to ‘pre-command-hook’ and ‘post-command-hook’. The available -suffix and infix commands and their state are shown in a popup buffer -until the transient state is exited by invoking a suffix command. - - Calling an infix command causes its value to be changed. How that is -done depends on the type of the infix command. The simplest case is an -infix command that represents a command-line argument that does not take -a value. Invoking such an infix command causes the switch to be toggled -on or off. More complex infix commands may read a value from the user, -using the minibuffer. - - Calling a suffix command usually causes the transient to be exited; -the transient keymaps and hook functions are removed, the popup buffer -no longer shows information about the (no longer bound) suffix commands, -the values of some public global variables are set, while some internal -global variables are unset, and finally the command is actually called. -Suffix commands can also be configured to not exit the transient. - - A suffix command can, but does not have to, use the infix arguments -in much the same way any command can choose to use or ignore the prefix -arguments. For a suffix command that was invoked from a transient, the -variable ‘transient-current-suffixes’ and the function ‘transient-args’ -serve about the same purpose as the variables ‘prefix-arg’ and -‘current-prefix-arg’ do for any command that was called after the prefix -arguments have been set using a command such as ‘universal-argument’. - - Transient can be used to implement simple “command dispatchers”. The -main benefit then is that the user can see all the available commands in -a popup buffer, which can be thought of as a “menus”. That is useful by -itself because it frees the user from having to remember all the keys -that are valid after a certain prefix key or command. Magit’s -‘magit-dispatch’ (on ‘C-x M-g’) command is an example of using Transient -to merely implement a command dispatcher. - - In addition to that, Transient also allows users to interactively -pass arguments to commands. These arguments can be much more complex -than what is reasonable when using prefix arguments. There is a limit -to how many aspects of a command can be controlled using prefix -arguments. Furthermore, what a certain prefix argument means for -different commands can be completely different, and users have to read -documentation to learn and then commit to memory what a certain prefix -argument means to a certain command. - - Transient suffix commands, on the other hand, can accept dozens of -different arguments without the user having to remember anything. When -using Transient, one can call a command with arguments that are just as -complex as when calling the same function non-interactively from Lisp. - - Invoking a transient suffix command with arguments is similar to -invoking a command in a shell with command-line completion and history -enabled. One benefit of the Transient interface is that it remembers -history not only on a global level (“this command was invoked using -these arguments, and previously it was invoked using those other -arguments”), but also remembers the values of individual arguments -independently. See *note Using History::. - - After a transient prefix command is invoked, ‘C-h KEY’ can be used to -show the documentation for the infix or suffix command that ‘KEY’ is -bound to (see *note Getting Help for Suffix Commands::), and infixes and -suffixes can be removed from the transient using ‘C-x l KEY’. Infixes -and suffixes that are disabled by default can be enabled the same way. -See *note Enabling and Disabling Suffixes::. - - Transient ships with support for a few different types of specialized -infix commands. A command that sets a command line option, for example, -has different needs than a command that merely toggles a boolean flag. -Additionally, Transient provides abstractions for defining new types, -which the author of Transient did not anticipate (or didn’t get around -to implementing yet). - - Note that suffix commands also support regular prefix arguments. A -suffix command may even be called with both infix and prefix arguments -at the same time. If you invoke a command as a suffix of a transient -prefix command, but also want to pass prefix arguments to it, then first -invoke the prefix command, and only after doing that invoke the prefix -arguments, before finally invoking the suffix command. If you instead -began by providing the prefix arguments, then those would apply to the -prefix command, not the suffix command. Likewise, if you want to change -infix arguments before invoking a suffix command with prefix arguments, -then change the infix arguments before invoking the prefix arguments. -In other words, regular prefix arguments always apply to the next -command, and since transient prefix, infix and suffix commands are just -regular commands, the same applies to them. (Regular prefix keys behave -differently because they are not commands at all, instead they are just -incomplete key sequences, and those cannot be interrupted with prefix -commands.) - - -File: transient.info, Node: Defining Transients, Next: Binding Suffix and Infix Commands, Prev: Technical Introduction, Up: Defining New Commands - -4.2 Defining Transients -======================= - -A transient consists of a prefix command and at least one suffix -command, though usually a transient has several infix and suffix -commands. The below macro defines the transient prefix command *and* -binds the transient’s infix and suffix commands. In other words, it -defines the complete transient, not just the transient prefix command -that is used to invoke that transient. - - -- Macro: transient-define-prefix name arglist [docstring] [keyword - value]... group... [body...] - This macro defines NAME as a transient prefix command and binds the - transient’s infix and suffix commands. - - ARGLIST are the arguments that the prefix command takes. DOCSTRING - is the documentation string and is optional. - - These arguments can optionally be followed by keyword-value pairs. - Each key has to be a keyword symbol, either ‘:class’ or a keyword - argument supported by the constructor of that class. The - ‘transient-prefix’ class is used if the class is not specified - explicitly. - - GROUPs add key bindings for infix and suffix commands and specify - how these bindings are presented in the popup buffer. At least one - GROUP has to be specified. See *note Binding Suffix and Infix - Commands::. - - The BODY is optional. If it is omitted, then ARGLIST is ignored - and the function definition becomes: - - (lambda () - (interactive) - (transient-setup 'NAME)) - - If BODY is specified, then it must begin with an ‘interactive’ form - that matches ARGLIST, and it must call ‘transient-setup’. It may, - however, call that function only when some condition is satisfied. - - All transients have a (possibly ‘nil’) value, which is exported - when suffix commands are called, so that they can consume that - value. For some transients it might be necessary to have a sort of - secondary value, called a “scope”. Such a scope would usually be - set in the command’s ‘interactive’ form and has to be passed to the - setup function: - - (transient-setup 'NAME nil nil :scope SCOPE) - - For example, the scope of the ‘magit-branch-configure’ transient is - the branch whose variables are being configured. - - -File: transient.info, Node: Binding Suffix and Infix Commands, Next: Defining Suffix and Infix Commands, Prev: Defining Transients, Up: Defining New Commands - -4.3 Binding Suffix and Infix Commands -===================================== - -The macro ‘transient-define-prefix’ is used to define a transient. This -defines the actual transient prefix command (see *note Defining -Transients::) and adds the transient’s infix and suffix bindings, as -described below. - - Users and third-party packages can add additional bindings using -functions such as ‘transient-insert-suffix’ (see *note Modifying -Existing Transients::). These functions take a “suffix specification” -as one of their arguments, which has the same form as the specifications -used in ‘transient-define-prefix’. - -* Menu: - -* Group Specifications:: -* Suffix Specifications:: - - -File: transient.info, Node: Group Specifications, Next: Suffix Specifications, Up: Binding Suffix and Infix Commands - -4.3.1 Group Specifications --------------------------- - -The suffix and infix commands of a transient are organized in groups. -The grouping controls how the descriptions of the suffixes are outlined -visually but also makes it possible to set certain properties for a set -of suffixes. - - Several group classes exist, some of which organize suffixes in -subgroups. In most cases the class does not have to be specified -explicitly, but see *note Group Classes::. - - Groups are specified in the call to ‘transient-define-prefix’, using -vectors. Because groups are represented using vectors, we cannot use -square brackets to indicate an optional element and instead use curly -brackets to do the latter. - - Group specifications then have this form: - - [{LEVEL} {DESCRIPTION} {KEYWORD VALUE}... ELEMENT...] - - The LEVEL is optional and defaults to 4. See *note Enabling and -Disabling Suffixes::. - - The DESCRIPTION is optional. If present, it is used as the heading -of the group. - - The KEYWORD-VALUE pairs are optional. Each keyword has to be a -keyword symbol, either ‘:class’ or a keyword argument supported by the -constructor of that class. - - • One of these keywords, ‘:description’, is equivalent to specifying - DESCRIPTION at the very beginning of the vector. The - recommendation is to use ‘:description’ if some other keyword is - also used, for consistency, or DESCRIPTION otherwise, because it - looks better. - - • Likewise ‘:level’ is equivalent to LEVEL. - - • Other important keywords include the ‘:if...’ keywords. These - keywords control whether the group is available in a certain - situation. - - For example, one group of the ‘magit-rebase’ transient uses ‘:if - magit-rebase-in-progress-p’, which contains the suffixes that are - useful while rebase is already in progress; and another that uses - ‘:if-not magit-rebase-in-progress-p’, which contains the suffixes - that initiate a rebase. - - These predicates can also be used on individual suffixes and are - only documented once, see *note Predicate Slots::. - - • The value of ‘:hide’, if non-‘nil’, is a predicate that controls - whether the group is hidden by default. The key bindings for - suffixes of a hidden group should all use the same prefix key. - Pressing that prefix key should temporarily show the group and its - suffixes, which assumes that a predicate like this is used: - - (lambda () - (eq (car transient--redisplay-key) - ?\C-c)) ; the prefix key shared by all bindings - - • The value of ‘:setup-children’, if non-‘nil’, is a function that - takes one argument, a potentially list of children, and must return - a list of children or an empty list. This can either be used to - somehow transform the group’s children that were defined the normal - way, or to dynamically create the children from scratch. - - The returned children must have the same form as stored in the - prefix’s ‘transient--layout’ property, but it is often more - convenient to use the same form as understood by - ‘transient-define-prefix’, described below. If you use the latter - approach, you can use the ‘transient-parse-suffixes’ and - ‘transient-parse-suffix’ functions to transform them from the - convenient to the expected form. - - If you explicitly specify children and then transform them using - ‘:setup-children’, then the class of the group is determined as - usual, based on explicitly specified children. - - If you do not explicitly specify children and thus rely solely on - ‘:setup-children’, then you must specify the class using ‘:class’. - For backward compatibility, if you fail to do so, - ‘transient-column’ is used and a warning is displayed. This - warning will eventually be replaced with an error. - - • The boolean ‘:pad-keys’ argument controls whether keys of all - suffixes contained in a group are right padded, effectively - aligning the descriptions. - - The ELEMENTs are either all subgroups, or all suffixes and strings. -(At least currently no group type exists that would allow mixing -subgroups with commands at the same level, though in principle there is -nothing that prevents that.) - - If the ELEMENTs are not subgroups, then they can be a mixture of -lists, which specify commands, and strings. Strings are inserted -verbatim into the buffer. The empty string can be used to insert gaps -between suffixes, which is particularly useful if the suffixes are -outlined as a table. - - Inside group specifications, including inside contained suffix -specifications, nothing has to be quoted and quoting anyway is invalid. -The value following a keyword, can be explicitly unquoted using ‘,’. -This feature is experimental and should be avoided. - - The form of suffix specifications is documented in the next node. - - -File: transient.info, Node: Suffix Specifications, Prev: Group Specifications, Up: Binding Suffix and Infix Commands - -4.3.2 Suffix Specifications ---------------------------- - -A transient’s suffix and infix commands are bound when the transient -prefix command is defined using ‘transient-define-prefix’, see *note -Defining Transients::. The commands are organized into groups, see -*note Group Specifications::. Here we describe the form used to bind an -individual suffix command. - - The same form is also used when later binding additional commands -using functions such as ‘transient-insert-suffix’, see *note Modifying -Existing Transients::. - - Note that an infix is a special kind of suffix. Depending on context -“suffixes” means “suffixes (including infixes)” or “non-infix suffixes”. -Here it means the former. - - Suffix specifications have this form: - - ([LEVEL] [KEY [DESCRIPTION]] COMMAND|ARGUMENT [KEYWORD VALUE]...) - - LEVEL, KEY and DESCRIPTION can also be specified using the KEYWORDs -‘:level’, ‘:key’ and ‘:description’. If the object that is associated -with COMMAND sets these properties, then they do not have to be -specified here. You can however specify them here anyway, possibly -overriding the object’s values just for the binding inside this -transient. - - • LEVEL is the suffix level, an integer between 1 and 7. See *note - Enabling and Disabling Suffixes::. - - • KEY is the key binding, either a vector or key description string. - - • DESCRIPTION is the description, either a string or a function that - takes zero or one arguments (the suffix object) and returns a - string. The function should be a lambda expression to avoid - ambiguity. In some cases a symbol that is bound as a function - would also work but to be safe you should use ‘:description’ in - that case. - - The next element is either a command or an argument. This is the -only argument that is mandatory in all cases. - - • COMMAND should be a symbol that is bound as a function, which has - to be defined or at least autoloaded as a command by the time the - containing prefix command is invoked. - - Any command will do; it does not need to have an object associated - with it (as would be the case if ‘transient-define-suffix’ or - ‘transient-define-infix’ were used to define it). - - COMMAND can also be a ‘lambda’ expression. - - As mentioned above, the object that is associated with a command - can be used to set the default for certain values that otherwise - have to be set in the suffix specification. Therefore if there is - no object, then you have to make sure to specify the KEY and the - DESCRIPTION. - - As a special case, if you want to add a command that might be - neither defined nor autoloaded, you can use a workaround like: - - (transient-insert-suffix 'some-prefix "k" - '("!" "Ceci n'est pas une commande" no-command - :if (lambda () (featurep 'no-library)))) - - Instead of ‘featurep’ you could also use ‘require’ with a non-‘nil’ - value for NOERROR. - - • The mandatory argument can also be a command-line argument, a - string. In that case an anonymous command is defined and bound. - - Instead of a string, this can also be a list of two strings, in - which case the first string is used as the short argument (which - can also be specified using ‘:shortarg’) and the second as the long - argument (which can also be specified using ‘:argument’). - - Only the long argument is displayed in the popup buffer. See - ‘transient-detect-key-conflicts’ for how the short argument may be - used. - - Unless the class is specified explicitly, the appropriate class is - guessed based on the long argument. If the argument ends with ‘=’ - (e.g., ‘--format=’) then ‘transient-option’ is used, otherwise - ‘transient-switch’. - - Finally, details can be specified using optional KEYWORD-VALUE pairs. -Each keyword has to be a keyword symbol, either ‘:class’ or a keyword -argument supported by the constructor of that class. See *note Suffix -Slots::. - - -File: transient.info, Node: Defining Suffix and Infix Commands, Next: Using Infix Arguments, Prev: Binding Suffix and Infix Commands, Up: Defining New Commands - -4.4 Defining Suffix and Infix Commands -====================================== - -Note that an infix is a special kind of suffix. Depending on context -“suffixes” means “suffixes (including infixes)” or “non-infix suffixes”. - - -- Macro: transient-define-suffix name arglist [docstring] [keyword - value]... body... - This macro defines NAME as a transient suffix command. - - ARGLIST are the arguments that the command takes. DOCSTRING is the - documentation string and is optional. - - These arguments can optionally be followed by keyword-value pairs. - Each keyword has to be a keyword symbol, either ‘:class’ or a - keyword argument supported by the constructor of that class. The - ‘transient-suffix’ class is used if the class is not specified - explicitly. - - The BODY must begin with an ‘interactive’ form that matches - ARGLIST. The infix arguments are usually accessed by using - ‘transient-args’ inside ‘interactive’. - - -- Macro: transient-define-infix name arglist [docstring] [keyword - value]... - This macro defines NAME as a transient infix command. - - ARGLIST is always ignored (but mandatory never-the-less) and - reserved for future use. DOCSTRING is the documentation string and - is optional. - - At least one key-value pair is required. All transient infix - commands are ‘equal’ to each other (but not ‘eq’). It is - meaningless to define an infix command, without providing at least - one keyword argument (usually ‘:argument’ or ‘:variable’, depending - on the class). The suffix class defaults to ‘transient-switch’ and - can be set using the ‘:class’ keyword. - - The function definition is always: - - (lambda () - (interactive) - (let ((obj (transient-suffix-object))) - (transient-infix-set obj (transient-infix-read obj))) - (transient--show)) - - ‘transient-infix-read’ and ‘transient-infix-set’ are generic - functions. Different infix commands behave differently because the - concrete methods are different for different infix command classes. - In rare cases the above command function might not be suitable, - even if you define your own infix command class. In that case you - have to use ‘transient-define-suffix’ to define the infix command - and use ‘t’ as the value of the ‘:transient’ keyword. - - -- Macro: transient-define-argument name arglist [docstring] [keyword - value]... - This macro defines NAME as a transient infix command. - - This is an alias for ‘transient-define-infix’. Only use this alias - to define an infix command that actually sets an infix argument. - To define an infix command that, for example, sets a variable, use - ‘transient-define-infix’ instead. - - -File: transient.info, Node: Using Infix Arguments, Next: Transient State, Prev: Defining Suffix and Infix Commands, Up: Defining New Commands - -4.5 Using Infix Arguments -========================= - -The functions and the variables described below allow suffix commands to -access the value of the transient from which they were invoked; which is -the value of its infix arguments. These variables are set when the user -invokes a suffix command that exits the transient, but before actually -calling the command. - - When returning to the command-loop after calling the suffix command, -the arguments are reset to ‘nil’ (which causes the function to return -‘nil’ too). - - Like for Emacs’ prefix arguments, it is advisable, but not mandatory, -to access the infix arguments inside the command’s ‘interactive’ form. -The preferred way of doing that is to call the ‘transient-args’ -function, which for infix arguments serves about the same purpose as -‘prefix-arg’ serves for prefix arguments. - - -- Function: transient-args prefix - This function returns the value of the transient prefix command - PREFIX. - - If the current command was invoked from the transient prefix - command PREFIX, then it returns the active infix arguments. If the - current command was not invoked from PREFIX, then it returns the - set, saved or default value for PREFIX. - - -- Function: transient-arg-value arg args - This function return the value of ARG as it appears in ARGS. - - For a switch a boolean is returned. For an option the value is - returned as a string, using the empty string for the empty value, - or ‘nil’ if the option does not appear in ARGS. - - -- Function: transient-suffixes prefix - This function returns the suffixes of the transient prefix command - PREFIX. This is a list of objects. This function should only be - used if you need the objects (as opposed to just their values) and - if the current command is not being invoked from PREFIX. - - -- Variable: transient-current-suffixes - The suffixes of the transient from which this suffix command was - invoked. This is a list of objects. Usually it is sufficient to - instead use the function ‘transient-args’, which returns a list of - values. In complex cases it might be necessary to use this - variable instead, i.e., if you need access to information beside - the value. - - -- Variable: transient-current-prefix - The transient from which this suffix command was invoked. The - returned value is a ‘transient-prefix’ object, which holds - information associated with the transient prefix command. - - -- Variable: transient-current-command - The transient from which this suffix command was invoked. The - returned value is a symbol, the transient prefix command. - - -File: transient.info, Node: Transient State, Prev: Using Infix Arguments, Up: Defining New Commands - -4.6 Transient State -=================== - -Invoking a transient prefix command “activates” the respective -transient, i.e., it puts a transient keymap into effect, which binds the -transient’s infix and suffix commands. - - The default behavior while a transient is active is as follows: - - • Invoking an infix command does not affect the transient state; the - transient remains active. - - • Invoking a (non-infix) suffix command “deactivates” the transient - state by removing the transient keymap and performing some - additional cleanup. - - • Invoking a command that is bound in a keymap other than the - transient keymap is disallowed and trying to do so results in a - warning. This does not “deactivate” the transient. - - The behavior can be changed for all suffixes of a particular prefix -and/or for individual suffixes. The values should nearly always be -booleans, but certain functions, called “pre-commands”, can also be -used. These functions are named ‘transient--do-VERB’, and the symbol -‘VERB’ can be used as a shorthand. - - A boolean is interpreted as answering the question "does the -transient stay active, when this command is invoked?" ‘t’ means that -the transient stays active, while ‘nil’ means that invoking the command -exits the transient. - - Note that when the suffix is a “sub-prefix”, invoking that command -always activates that sub-prefix, causing the outer prefix to no longer -be active and displayed. Here ‘t’ means that when you exit the inner -prefix, then the outer prefix becomes active again, while ‘nil’ means -that all outer prefixes are exited at once. - - • The behavior for non-suffixes can be set for a particular prefix, - by the prefix’s ‘transient-non-suffix’ slot to a boolean, a - suitable pre-command function, or a shorthand for such a function. - See *note Pre-commands for Non-Suffixes::. - - • The common behavior for the suffixes of a particular prefix can be - set using the prefix’s ‘transient-suffixes’ slot. - - The value specified in this slot does *not* affect infixes. - Because it affects both regular suffixes as well as sub-prefixes, - which have different needs, it is best to avoid explicitly - specifying a function. - - • The behavior of an individual suffix can be changed using its - ‘transient’ slot. While it is usually best to use a boolean, for - this slot it can occasionally make sense to specify a function - explicitly. - - Note that this slot can be set when defining a suffix command using - ‘transient-define-suffix’ and/or in the definition of the prefix. - If set in both places, then the latter takes precedence, as usual. - - The available pre-command functions are documented in the following -sub-sections. They are called by ‘transient--pre-command’, a function -on ‘pre-command-hook’, and the value that they return determines whether -the transient is exited. To do so the value of one of the constants -‘transient--exit’ or ‘transient--stay’ is used (that way we don’t have -to remember if ‘t’ means “exit” or “stay”). - - Additionally, these functions may change the value of ‘this-command’ -(which explains why they have to be called using ‘pre-command-hook’), -call ‘transient-export’, ‘transient--stack-zap’ or -‘transient--stack-push’; and set the values of ‘transient--exitp’, -‘transient--helpp’ or ‘transient--editp’. - - For completeness sake, some notes about complications: - - • The transient-ness of certain built-in suffix commands is specified - using ‘transient-predicate-map’. This is a special keymap, which - binds commands to pre-commands (as opposed to keys to commands) and - takes precedence over the prefix’s ‘transient-suffix’ slot, but not - the suffix’s ‘transient’ slot. - - • While a sub-prefix is active we nearly always want ‘C-g’ to take - the user back to the “super-prefix”, even when the other suffixes - don’t do that. However, in rare cases this may not be desirable, - and that makes the following complication necessary: - - For ‘transient-suffix’ objects the ‘transient’ slot is unbound. We - can ignore that for the most part because ‘nil’ and the slot being - unbound are treated as equivalent, and mean “do exit”. That isn’t - actually true for suffixes that are sub-prefixes though. For such - suffixes unbound means “do exit but allow going back”, which is the - default, while ‘nil’ means “do exit permanently”, which requires - that slot to be explicitly set to that value. - -Pre-commands for Infixes ------------------------- - -The default for infixes is ‘transient--do-stay’. This is also the only -function that makes sense for infixes, which is why this predicate is -used even if the value of the prefix’s ‘transient-suffix’ slot is ‘t’. -In extremely rare cases, one might want to use something else, which can -be done by setting the infix’s ‘transient’ slot directly. - - -- Function: transient--do-stay - Call the command without exporting variables and stay transient. - -Pre-commands for Suffixes -------------------------- - -By default, invoking a suffix causes the transient to be exited. - - The behavior for an individual suffix command can be changed by -setting its ‘transient’ slot to a boolean (which is highly recommended), -or to one of the following pre-commands. - - -- Function: transient--do-exit - Call the command after exporting variables and exit the transient. - - -- Function: transient--do-return - Call the command after exporting variables and return to the parent - prefix. If there is no parent prefix, then call - ‘transient--do-exit’. - - -- Function: transient--do-call - Call the command after exporting variables and stay transient. - - The following pre-commands are only suitable for sub-prefixes. It is -not necessary to explicitly use these predicates because the correct -predicate is automatically picked based on the value of the ‘transient’ -slot for the sub-prefix itself. - - -- Function: transient--do-recurse - Call the transient prefix command, preparing for return to active - transient. - - Whether we actually return to the parent transient is ultimately - under the control of each invoked suffix. The difference between - this pre-command and ‘transient--do-stack’ is that it changes the - value of the ‘transient-suffix’ slot to ‘t’. - - If there is no parent transient, then only call this command and - skip the second step. - - -- Function: transient--do-stack - Call the transient prefix command, stacking the active transient. - Push the active transient to the transient stack. - - Unless ‘transient--do-recurse’ is explicitly used, this pre-command - is automatically used for suffixes that are prefixes themselves, - i.e., for sub-prefixes. - - -- Function: transient--do-replace - Call the transient prefix command, replacing the active transient. - Do not push the active transient to the transient stack. - - Unless ‘transient--do-recurse’ is explicitly used, this pre-command - is automatically used for suffixes that are prefixes themselves, - i.e., for sub-prefixes. - - -- Function: transient--do-suspend - Suspend the active transient, saving the transient stack. - - This is used by the command ‘transient-suspend’ and optionally also - by “external events” such as ‘handle-switch-frame’. Such bindings - should be added to ‘transient-predicate-map’. - -Pre-commands for Non-Suffixes ------------------------------ - -By default, non-suffixes (commands that are bound in other keymaps -beside the transient keymap) cannot be invoked. Trying to invoke such a -command results in a warning and the transient stays active. - - If you want a different behavior, then set the ‘transient-non-suffix’ -slot of the transient prefix command. The value should be a boolean, -answering the question, "is it allowed to invoke non-suffix commands?, a -pre-command function, or a shorthand for such a function. - - If the value is ‘t’, then non-suffixes can be invoked, when it is -‘nil’ (the default) then they cannot be invoked. - - The only other recommended value is ‘leave’. If that is used, then -non-suffixes can be invoked, but if one is invoked, then that exits the -transient. - - -- Function: transient--do-warn - Call ‘transient-undefined’ and stay transient. - - -- Function: transient--do-stay - Call the command without exporting variables and stay transient. - - -- Function: transient--do-leave - Call the command without exporting variables and exit the - transient. - -Special Pre-Commands --------------------- - - -- Function: transient--do-quit-one - If active, quit help or edit mode, else exit the active transient. - - This is used when the user pressed ‘C-g’. - - -- Function: transient--do-quit-all - Exit all transients without saving the transient stack. - - This is used when the user pressed ‘C-q’. - - -- Function: transient--do-suspend - Suspend the active transient, saving the transient stack. - - This is used when the user pressed ‘C-z’. - - -File: transient.info, Node: Classes and Methods, Next: FAQ, Prev: Defining New Commands, Up: Top - -5 Classes and Methods -********************* - -Transient uses classes and generic functions to make it possible to -define new types of suffix commands that are similar to existing types, -but behave differently in some aspects. It does the same for groups and -prefix commands, though at least for prefix commands that *currently* -appears to be less important. - - Every prefix, infix and suffix command is associated with an object, -which holds information that controls certain aspects of its behavior. -This happens in two ways. - - • Associating a command with a certain class gives the command a - type. This makes it possible to use generic functions to do - certain things that have to be done differently depending on what - type of command it acts on. - - That in turn makes it possible for third-parties to add new types - without having to convince the maintainer of Transient that that - new type is important enough to justify adding a special case to a - dozen or so functions. - - • Associating a command with an object makes it possible to easily - store information that is specific to that particular command. - - Two commands may have the same type, but obviously their key - bindings and descriptions still have to be different, for example. - - The values of some slots are functions. The ‘reader’ slot for - example holds a function that is used to read a new value for an - infix command. The values of such slots are regular functions. - - Generic functions are used when a function should do something - different based on the type of the command, i.e., when all commands - of a certain type should behave the same way but different from the - behavior for other types. Object slots that hold a regular - function as value are used when the task that they perform is - likely to differ even between different commands of the same type. - -* Menu: - -* Group Classes:: -* Group Methods:: -* Prefix Classes:: -* Suffix Classes:: -* Suffix Methods:: -* Prefix Slots:: -* Suffix Slots:: -* Predicate Slots:: - - -File: transient.info, Node: Group Classes, Next: Group Methods, Up: Classes and Methods - -5.1 Group Classes -================= - -The type of a group can be specified using the ‘:class’ property at the -beginning of the class specification, e.g., ‘[:class transient-columns -...]’ in a call to ‘transient-define-prefix’. - - • The abstract ‘transient-child’ class is the base class of both - ‘transient-group’ (and therefore all groups) as well as of - ‘transient-suffix’ (and therefore all suffix and infix commands). - - This class exists because the elements (or “children”) of certain - groups can be other groups instead of suffix and infix commands. - - • The abstract ‘transient-group’ class is the superclass of all other - group classes. - - • The ‘transient-column’ class is the simplest group. - - This is the default “flat” group. If the class is not specified - explicitly and the first element is not a vector (i.e., not a - group), then this class is used. - - This class displays each element on a separate line. - - • The ‘transient-row’ class displays all elements on a single line. - - • The ‘transient-columns’ class displays commands organized in - columns. - - Direct elements have to be groups whose elements have to be - commands or strings. Each subgroup represents a column. This - class takes care of inserting the subgroups’ elements. - - This is the default “nested” group. If the class is not specified - explicitly and the first element is a vector (i.e., a group), then - this class is used. - - • The ‘transient-subgroups’ class wraps other groups. - - Direct elements have to be groups whose elements have to be - commands or strings. This group inserts an empty line between - subgroups. The subgroups themselves are responsible for displaying - their elements. - - -File: transient.info, Node: Group Methods, Next: Prefix Classes, Prev: Group Classes, Up: Classes and Methods - -5.2 Group Methods -================= - - -- Function: transient-setup-children group children - This generic function can be used to setup the children or a group. - - The default implementation usually just returns the children - unchanged, but if the ‘setup-children’ slot of GROUP is non-‘nil’, - then it calls that function with CHILDREN as the only argument and - returns the value. - - The children are given as a (potentially empty) list consisting of - either group or suffix specifications. These functions can make - arbitrary changes to the children including constructing new - children from scratch. - - -- Function: transient--insert-group group - This generic function formats the group and its elements and - inserts the result into the current buffer, which is a temporary - buffer. The contents of that buffer are later inserted into the - popup buffer. - - Functions that are called by this function may need to operate in - the buffer from which the transient was called. To do so they can - temporarily make the ‘transient--source-buffer’ the current buffer. - - -File: transient.info, Node: Prefix Classes, Next: Suffix Classes, Prev: Group Methods, Up: Classes and Methods - -5.3 Prefix Classes -================== - -Currently the ‘transient-prefix’ class is being used for all prefix -commands and there is only a single generic function that can be -specialized based on the class of a prefix command. - - -- Function: transient--history-init obj - This generic function is called while setting up the transient and - is responsible for initializing the ‘history’ slot. This is the - transient-wide history; many individual infixes also have a history - of their own. - - The default (and currently only) method extracts the value from the - global variable ‘transient-history’. - - A transient prefix command’s object is stored in the -‘transient--prefix’ property of the command symbol. While a transient -is active, a clone of that object is stored in the variable -‘transient--prefix’. A clone is used because some changes that are made -to the active transient’s object should not affect later invocations. - - -File: transient.info, Node: Suffix Classes, Next: Suffix Methods, Prev: Prefix Classes, Up: Classes and Methods - -5.4 Suffix Classes -================== - - • All suffix and infix classes derive from ‘transient-suffix’, which - in turn derives from ‘transient-child’, from which - ‘transient-group’ also derives (see *note Group Classes::). - - • All infix classes derive from the abstract ‘transient-infix’ class, - which in turn derives from the ‘transient-suffix’ class. - - Infixes are a special type of suffixes. The primary difference is - that infixes always use the ‘transient--do-stay’ pre-command, while - non-infix suffixes use a variety of pre-commands (see *note - Transient State::). Doing that is most easily achieved by using - this class, though theoretically it would be possible to define an - infix class that does not do so. If you do that then you get to - implement many methods. - - Also, infixes and non-infix suffixes are usually defined using - different macros (see *note Defining Suffix and Infix Commands::). - - • Classes used for infix commands that represent arguments should be - derived from the abstract ‘transient-argument’ class. - - • The ‘transient-switch’ class (or a derived class) is used for infix - arguments that represent command-line switches (arguments that do - not take a value). - - • The ‘transient-option’ class (or a derived class) is used for infix - arguments that represent command-line options (arguments that do - take a value). - - • The ‘transient-switches’ class can be used for a set of mutually - exclusive command-line switches. - - • The ‘transient-files’ class can be used for a ‘--’ argument that - indicates that all remaining arguments are files. - - • Classes used for infix commands that represent variables should - derived from the abstract ‘transient-variable’ class. - - • The ‘transient-information’ class is special in that suffixes that - use this class are not associated with a command and thus also not - with any key binding. Such suffixes are only used to display - arbitrary information, and that anywhere a suffix can appear. - Display-only suffix specifications take this form: - - ([LEVEL] :info DESCRIPTION [KEYWORD VALUE]...) - - The ‘:info’ keyword argument replaces the ‘:description’ keyword - used for other suffix classes. Other keyword arguments that you - might want to set, include ‘:face’, predicate keywords (such as - ‘:if’), and ‘:format’. By default the value of ‘:format’ includes - ‘%k’, which for this class is replaced with the empty string or - spaces, if keys are being padded in the containing group. - - Magit defines additional classes, which can serve as examples for the -fancy things you can do without modifying Transient. Some of these -classes will likely get generalized and added to Transient. For now -they are very much subject to change and not documented. - - -File: transient.info, Node: Suffix Methods, Next: Prefix Slots, Prev: Suffix Classes, Up: Classes and Methods - -5.5 Suffix Methods -================== - -To get information about the methods implementing these generic -functions use ‘describe-function’. - -* Menu: - -* Suffix Value Methods:: -* Suffix Format Methods:: - - -File: transient.info, Node: Suffix Value Methods, Next: Suffix Format Methods, Up: Suffix Methods - -5.5.1 Suffix Value Methods --------------------------- - - -- Function: transient-init-value obj - This generic function sets the initial value of the object OBJ. - - This function is called for all suffix commands, but unless a - concrete method is implemented this falls through to the default - implementation, which is a noop. In other words this usually only - does something for infix commands, but note that this is not - implemented for the abstract class ‘transient-infix’, so if your - class derives from that directly, then you must implement a method. - - -- Function: transient-infix-read obj - This generic function determines the new value of the infix object - OBJ. - - This function merely determines the value; ‘transient-infix-set’ is - used to actually store the new value in the object. - - For most infix classes this is done by reading a value from the - user using the reader specified by the ‘reader’ slot (using the - ‘transient-infix-value’ method described below). - - For some infix classes the value is changed without reading - anything in the minibuffer, i.e., the mere act of invoking the - infix command determines what the new value should be, based on the - previous value. - - -- Function: transient-prompt obj - This generic function returns the prompt to be used to read infix - object OBJ’s value. - - -- Function: transient-infix-set obj value - This generic function sets the value of infix object OBJ to VALUE. - - -- Function: transient-infix-value obj - This generic function returns the value of the suffix object OBJ. - - This function is called by ‘transient-args’ (which see), meaning - this function is how the value of a transient is determined so that - the invoked suffix command can use it. - - Currently most values are strings, but that is not set in stone. - ‘nil’ is not a value, it means “no value”. - - Usually only infixes have a value, but see the method for - ‘transient-suffix’. - - -- Function: transient-init-scope obj - This generic function sets the scope of the suffix object OBJ. - - The scope is actually a property of the transient prefix, not of - individual suffixes. However it is possible to invoke a suffix - command directly instead of from a transient. In that case, if the - suffix expects a scope, then it has to determine that itself and - store it in its ‘scope’ slot. - - This function is called for all suffix commands, but unless a - concrete method is implemented this falls through to the default - implementation, which is a noop. - - -File: transient.info, Node: Suffix Format Methods, Prev: Suffix Value Methods, Up: Suffix Methods - -5.5.2 Suffix Format Methods ---------------------------- - - -- Function: transient-format obj - This generic function formats and returns OBJ for display. - - When this function is called, then the current buffer is some - temporary buffer. If you need the buffer from which the prefix - command was invoked to be current, then do so by temporarily making - ‘transient--source-buffer’ current. - - -- Function: transient-format-key obj - This generic function formats OBJ’s ‘key’ for display and returns - the result. - - -- Function: transient-format-description obj - This generic function formats OBJ’s ‘description’ for display and - returns the result. - - -- Function: transient-format-value obj - This generic function formats OBJ’s value for display and returns - the result. - - -- Function: transient-show-help obj - Show help for the prefix, infix or suffix command represented by - OBJ. - - For prefixes, show the info manual, if that is specified using the - ‘info-manual’ slot. Otherwise, show the manpage if that is - specified using the ‘man-page’ slot. Otherwise, show the command’s - documentation string. - - For suffixes, show the command’s documentation string. - - For infixes, show the manpage if that is specified. Otherwise show - the command’s documentation string. - - -File: transient.info, Node: Prefix Slots, Next: Suffix Slots, Prev: Suffix Methods, Up: Classes and Methods - -5.6 Prefix Slots -================ - - • ‘show-help’, ‘man-page’ or ‘info-manual’ can be used to specify the - documentation for the prefix and its suffixes. The command - ‘transient-help’ uses the method ‘transient-show-help’ (which see) - to lookup and use these values. - - • ‘history-key’ If multiple prefix commands should share a single - value, then this slot has to be set to the same value for all of - them. You probably don’t want that. - - • ‘transient-suffix’ and ‘transient-non-suffix’ play a part when - determining whether the currently active transient prefix command - remains active/transient when a suffix or arbitrary non-suffix - command is invoked. See *note Transient State::. - - • ‘refresh-suffixes’ Normally suffix objects and keymaps are only - setup once, when the prefix is invoked. Setting this to ‘t’, - causes them to be recreated after every command. This is useful - when using ‘:if...’ predicates, and those need to be rerun for some - reason. Doing this is somewhat costly, and there is a risk of - losing state, so this is disabled by default and still considered - experimental. - - • ‘incompatible’ A list of lists. Each sub-list specifies a set of - mutually exclusive arguments. Enabling one of these arguments - causes the others to be disabled. An argument may appear in - multiple sub-lists. Arguments must me given in the same form as - used in the ‘argument’ or ‘argument-format’ slot of the respective - suffix objects, usually something like ‘--switch’ or ‘--option=%s’. - For options and ‘transient-switches’ suffixes it is also possible - to match against a specific value, as returned by - ‘transient-infix-value’, for example, ‘--option=one’. - - • ‘scope’ For some transients it might be necessary to have a sort of - secondary value, called a “scope”. See ‘transient-define-prefix’. - -Internal Prefix Slots ---------------------- - -These slots are mostly intended for internal use. They should not be -set in calls to ‘transient-define-prefix’. - - • ‘prototype’ When a transient prefix command is invoked, then a - clone of that object is stored in the global variable - ‘transient--prefix’ and the prototype is stored in the clone’s - ‘prototype’ slot. - - • ‘command’ The command, a symbol. Each transient prefix command - consists of a command, which is stored in a symbol’s function slot - and an object, which is stored in the ‘transient--prefix’ property - of the same symbol. - - • ‘level’ The level of the prefix commands. The suffix commands - whose layer is equal or lower are displayed. See *note Enabling - and Disabling Suffixes::. - - • ‘value’ The likely outdated value of the prefix. Instead of - accessing this slot directly you should use the function - ‘transient-get-value’, which is guaranteed to return the up-to-date - value. - - • ‘history’ and ‘history-pos’ are used to keep track of historic - values. Unless you implement your own ‘transient-infix-read’ - method you should not have to deal with these slots. - - -File: transient.info, Node: Suffix Slots, Next: Predicate Slots, Prev: Prefix Slots, Up: Classes and Methods - -5.7 Suffix Slots -================ - -Here we document most of the slots that are only available for suffix -objects. Some slots are shared by suffix and group objects, they are -documented in *note Predicate Slots::. - - Also see *note Suffix Classes::. - -Slots of ‘transient-suffix’ ---------------------------- - - • ‘key’ The key, a key vector or a key description string. - - • ‘command’ The command, a symbol. - - • ‘transient’ Whether to stay transient. See *note Transient - State::. - - • ‘format’ The format used to display the suffix in the popup buffer. - It must contain the following %-placeholders: - - • ‘%k’ For the key. - • ‘%d’ For the description. - • ‘%v’ For the infix value. Non-infix suffixes don’t have a - value. - - • ‘description’ The description, either a string or a function, which - is called with zero or one argument (the suffix object), and - returns a string. - - • ‘face’ Face used for the description. In simple cases it is easier - to use this instead of using a function as ‘description’ and adding - the styling there. ‘face’ is appended using - ‘add-face-text-property’. - - • ‘show-help’ A function used to display help for the suffix. If - unspecified, the prefix controls how help is displayed for its - suffixes. - -Slots of ‘transient-infix’ --------------------------- - -Some of these slots are only meaningful for some of the subclasses. -They are defined here anyway to allow sharing certain methods. - - • ‘argument’ The long argument, e.g., ‘--verbose’. - - • ‘shortarg’ The short argument, e.g., ‘-v’. - - • ‘value’ The value. Should not be accessed directly. - - • ‘init-value’ Function that is responsible for setting the object’s - value. If bound, then this is called with the object as the only - argument. Usually this is not bound, in which case the object’s - primary ‘transient-init-value’ method is called instead. - - • ‘unsavable’ Whether the value of the suffix is not saved as part of - the prefixes. - - • ‘multi-value’ For options, whether the option can have multiple - values. If this is non-‘nil’, then the values are read using - ‘completing-read-multiple’ by default and if you specify your own - reader, then it should read the values using that function or - similar. - - Supported non-‘nil’ values are: - - • Use ‘rest’ for an option that can have multiple values. This - is useful e.g., for an ‘--’ argument that indicates that all - remaining arguments are files (such as ‘git log -- file1 - file2’). - - In the list returned by ‘transient-args’ such an option and - its values are represented by a single list of the form - ‘(ARGUMENT . VALUES)’. - - • Use ‘repeat’ for an option that can be specified multiple - times. - - In the list returned by ‘transient-args’ each instance of the - option and its value appears separately in the usual from, for - example: ‘("--another-argument" "--option=first" - "--option=second")’. - - In both cases the option’s values have to be specified in the - default value of a prefix using the same format as returned by - ‘transient-args’, e.g., ‘("--other" "--o=1" "--o=2" ("--" "f1" - "f2"))’. - - • ‘always-read’ For options, whether to read a value on every - invocation. If this is ‘nil’, then options that have a value are - simply unset and have to be invoked a second time to set a new - value. - - • ‘allow-empty’ For options, whether the empty string is a valid - value. - - • ‘history-key’ The key used to store the history. This defaults to - the command name. This is useful when multiple infixes should - share the same history because their values are of the same kind. - - • ‘reader’ The function used to read the value of an infix. Not used - for switches. The function takes three arguments, PROMPT, - INITIAL-INPUT and HISTORY, and must return a string. - - • ‘prompt’ The prompt used when reading the value, either a string or - a function that takes the object as the only argument and which - returns a prompt string. - - • ‘choices’ A list of valid values, or a function that returns such a - list. The latter is not implemented for ‘transient-switches’, - because I couldn’t think of a use-case. How exactly the choices - are used varies depending on the class of the suffix. - -Slots of ‘transient-variable’ ------------------------------ - - • ‘variable’ The variable. - -Slots of ‘transient-switches’ ------------------------------ - - • ‘argument-format’ The display format. Must contain ‘%s’, one of - the ‘choices’ is substituted for that. E.g., ‘--%s-order’. - - • ‘argument-regexp’ The regexp used to match any one of the switches. - E.g., ‘\\(--\\(topo\\|author-date\\|date\\)-order\\)’. - - -File: transient.info, Node: Predicate Slots, Prev: Suffix Slots, Up: Classes and Methods - -5.8 Predicate Slots -=================== - -Suffix and group objects share some predicate slots that control whether -a group or suffix should be available depending on some state. Only one -of these slots can be used at the same time. It is undefined what -happens if you use more than one. - - • ‘if’ Enable if predicate returns non-‘nil’. - • ‘if-not’ Enable if predicate returns ‘nil’. - • ‘if-non-nil’ Enable if variable’s value is non-‘nil’. - • ‘if-nil’ Enable if variable’s value is ‘nil’. - • ‘if-mode’ Enable if major-mode matches value. - • ‘if-not-mode’ Enable if major-mode does not match value. - • ‘if-derived’ Enable if major-mode derives from value. - • ‘if-not-derived’ Enable if major-mode does not derive from value. - - By default these predicates run when the prefix command is invoked, -but this can be changes, using the ‘refresh-suffixes’ prefix slot. See -*note Prefix Slots::. - - One more slot is shared between group and suffix classes, ‘level’. -Like the slots documented above, it is a predicate, but it is used for a -different purpose. The value has to be an integer between 1 and 7. -‘level’ controls whether a suffix or a group should be available -depending on user preference. See *note Enabling and Disabling -Suffixes::. - - -File: transient.info, Node: FAQ, Next: Keystroke Index, Prev: Classes and Methods, Up: Top - -Appendix A FAQ -************** - -A.1 Can I control how the popup buffer is displayed? -==================================================== - -Yes, see ‘transient-display-buffer-action’ in *note Configuration::. - -A.2 How can I copy text from the popup buffer? -============================================== - -To be able to mark text in Transient’s popup buffer using the mouse, you -have to add the below binding. Note that for technical reasons, the -region won’t be visualized, while doing so. After you have quit the -transient popup, you will be able to yank it in another buffer. - - (keymap-set transient-predicate-map - "<mouse-set-region>" - #'transient--do-stay) - -A.3 How can I autoload prefix and suffix commands? -================================================== - -If your package only supports Emacs 30, just prefix the definition with -‘;;;###autoload’. If your package supports released versions of Emacs, -you unfortunately have to use a long form autoload comment as described -in *note (elisp)Autoload::. - - ;;;###autoload (autoload 'magit-dispatch "magit" nil t) - (transient-define-prefix magit-dispatch () - ...) - -A.4 How does Transient compare to prefix keys and universal arguments? -====================================================================== - -See -<https://github.com/magit/transient/wiki/Comparison-with-prefix-keys-and-universal-arguments>. - -A.5 How does Transient compare to Magit-Popup and Hydra? -======================================================== - -See -<https://github.com/magit/transient/wiki/Comparison-with-other-packages>. - -A.6 Why did some of the key bindings change? -============================================ - -You may have noticed that the bindings for some of the common commands -do *not* have the prefix ‘C-x’ and that furthermore some of these -commands are grayed out while others are not. That unfortunately is a -bit confusing if the section of common commands is not shown -permanently, making the following explanation necessary. - - The purpose of usually hiding that section but showing it after the -user pressed the respective prefix key is to conserve space and not -overwhelm users with too much noise, while allowing the user to quickly -list common bindings on demand. - - That however should not keep us from using the best possible key -bindings. The bindings that do use a prefix do so to avoid wasting too -many non-prefix bindings, keeping them available for use in individual -transients. The bindings that do not use a prefix and that are *not* -grayed out are very important bindings that are *always* available, even -when invoking the “common command key prefix” or *any other* -transient-specific prefix. The non-prefix keys that *are* grayed out -however, are not available when any incomplete prefix key sequence is -active. They do not use the “common command key prefix” because it is -likely that users want to invoke them several times in a row and e.g., -‘M-p M-p M-p’ is much more convenient than ‘C-x M-p C-x M-p C-x M-p’. - - You may also have noticed that the “Set” command is bound to ‘C-x s’, -while Magit-Popup used to bind ‘C-c C-c’ instead. I have seen several -users praise the latter binding (sic), so I did not change it -willy-nilly. The reason that I changed it is that using different -prefix keys for different common commands, would have made the temporary -display of the common commands even more confusing, i.e., after pressing -‘C-c’ all the bindings that begin with the ‘C-x’ prefix would be grayed -out. - - Using a single prefix for common commands key means that all other -potential prefix keys can be used for transient-specific commands -*without* the section of common commands also popping up. ‘C-c’ in -particular is a prefix that I want to (and already do) use for Magit, -and also using that for a common command would prevent me from doing so. - - (Also see the next question.) - -A.7 Why does ‘q’ not quit popups anymore? -========================================= - -I agree that ‘q’ is a good binding for commands that quit something. -This includes quitting whatever transient is currently active, but it -also includes quitting whatever it is that some specific transient is -controlling. The transient ‘magit-blame’ for example binds ‘q’ to the -command that turns ‘magit-blame-mode’ off. - - So I had to decide if ‘q’ should quit the active transient (like -Magit-Popup used to) or whether ‘C-g’ should do that instead, so that -‘q’ could be bound in individual transient to whatever commands make -sense for them. Because all other letters are already reserved for use -by individual transients, I have decided to no longer make an exception -for ‘q’. - - If you want to get ‘q’’s old binding back then you can do so. Doing -that is a bit more complicated than changing a single key binding, so I -have implemented a function, ‘transient-bind-q-to-quit’ that makes the -necessary changes. See its documentation string for more information. - - -File: transient.info, Node: Keystroke Index, Next: Command and Function Index, Prev: FAQ, Up: Top - -Appendix B Keystroke Index -************************** - - -* Menu: - -* C-g: Aborting and Resuming Transients. - (line 27) -* C-g <1>: Aborting and Resuming Transients. - (line 27) -* C-h: Getting Help for Suffix Commands. - (line 11) -* C-M-n: Using History. (line 18) -* C-M-p: Using History. (line 13) -* C-q: Aborting and Resuming Transients. - (line 36) -* C-x a: Enabling and Disabling Suffixes. - (line 68) -* C-x C-k: Saving Values. (line 29) -* C-x C-s: Saving Values. (line 25) -* C-x l: Enabling and Disabling Suffixes. - (line 43) -* C-x n: Using History. (line 18) -* C-x p: Using History. (line 13) -* C-x s: Saving Values. (line 21) -* C-x t: Common Suffix Commands. - (line 18) -* C-z: Aborting and Resuming Transients. - (line 41) - - -File: transient.info, Node: Command and Function Index, Next: Variable Index, Prev: Keystroke Index, Up: Top - -Appendix C Command and Function Index -************************************* - - -* Menu: - -* transient--do-call: Transient State. (line 125) -* transient--do-exit: Transient State. (line 117) -* transient--do-leave: Transient State. (line 193) -* transient--do-quit-all: Transient State. (line 205) -* transient--do-quit-one: Transient State. (line 200) -* transient--do-recurse: Transient State. (line 133) -* transient--do-replace: Transient State. (line 153) -* transient--do-return: Transient State. (line 120) -* transient--do-stack: Transient State. (line 145) -* transient--do-stay: Transient State. (line 105) -* transient--do-stay <1>: Transient State. (line 190) -* transient--do-suspend: Transient State. (line 161) -* transient--do-suspend <1>: Transient State. (line 210) -* transient--do-warn: Transient State. (line 187) -* transient--history-init: Prefix Classes. (line 10) -* transient--insert-group: Group Methods. (line 19) -* transient-append-suffix: Modifying Existing Transients. - (line 51) -* transient-arg-value: Using Infix Arguments. - (line 31) -* transient-args: Using Infix Arguments. - (line 22) -* transient-define-argument: Defining Suffix and Infix Commands. - (line 57) -* transient-define-infix: Defining Suffix and Infix Commands. - (line 26) -* transient-define-prefix: Defining Transients. (line 13) -* transient-define-suffix: Defining Suffix and Infix Commands. - (line 9) -* transient-format: Suffix Format Methods. - (line 6) -* transient-format-description: Suffix Format Methods. - (line 18) -* transient-format-key: Suffix Format Methods. - (line 14) -* transient-format-value: Suffix Format Methods. - (line 22) -* transient-get-suffix: Modifying Existing Transients. - (line 73) -* transient-help: Getting Help for Suffix Commands. - (line 11) -* transient-history-next: Using History. (line 18) -* transient-history-prev: Using History. (line 13) -* transient-infix-read: Suffix Value Methods. - (line 16) -* transient-infix-set: Suffix Value Methods. - (line 36) -* transient-infix-value: Suffix Value Methods. - (line 39) -* transient-init-scope: Suffix Value Methods. - (line 52) -* transient-init-value: Suffix Value Methods. - (line 6) -* transient-insert-suffix: Modifying Existing Transients. - (line 49) -* transient-prompt: Suffix Value Methods. - (line 32) -* transient-quit-all: Aborting and Resuming Transients. - (line 36) -* transient-quit-one: Aborting and Resuming Transients. - (line 27) -* transient-quit-seq: Aborting and Resuming Transients. - (line 27) -* transient-remove-suffix: Modifying Existing Transients. - (line 70) -* transient-replace-suffix: Modifying Existing Transients. - (line 66) -* transient-reset: Saving Values. (line 29) -* transient-resume: Aborting and Resuming Transients. - (line 53) -* transient-save: Saving Values. (line 25) -* transient-scroll-down: Other Commands. (line 17) -* transient-scroll-up: Other Commands. (line 12) -* transient-set: Saving Values. (line 21) -* transient-set-level: Enabling and Disabling Suffixes. - (line 43) -* transient-setup-children: Group Methods. (line 6) -* transient-show-help: Suffix Format Methods. - (line 26) -* transient-suffix-put: Modifying Existing Transients. - (line 77) -* transient-suffixes: Using Infix Arguments. - (line 38) -* transient-suspend: Aborting and Resuming Transients. - (line 41) -* transient-toggle-common: Common Suffix Commands. - (line 18) -* transient-toggle-level-limit: Enabling and Disabling Suffixes. - (line 68) - - -File: transient.info, Node: Variable Index, Next: Concept Index, Prev: Command and Function Index, Up: Top - -Appendix D Variable Index -************************* - - -* Menu: - -* transient-align-variable-pitch: Configuration. (line 185) -* transient-current-command: Using Infix Arguments. - (line 57) -* transient-current-prefix: Using Infix Arguments. - (line 52) -* transient-current-suffixes: Using Infix Arguments. - (line 44) -* transient-default-level: Enabling and Disabling Suffixes. - (line 33) -* transient-detect-key-conflicts: Configuration. (line 210) -* transient-display-buffer-action: Configuration. (line 51) -* transient-enable-popup-navigation: Configuration. (line 36) -* transient-force-fixed-pitch: Configuration. (line 198) -* transient-force-single-column: Configuration. (line 93) -* transient-hide-during-minibuffer-read: Configuration. (line 181) -* transient-highlight-higher-levels: Configuration. (line 223) -* transient-highlight-mismatched-keys: Configuration. (line 135) -* transient-history-file: Using History. (line 33) -* transient-history-limit: Using History. (line 37) -* transient-levels-file: Enabling and Disabling Suffixes. - (line 38) -* transient-mode-line-format: Configuration. (line 102) -* transient-read-with-initial-input: Configuration. (line 174) -* transient-semantic-coloring: Configuration. (line 126) -* transient-show-common-commands: Common Suffix Commands. - (line 23) -* transient-show-popup: Configuration. (line 15) -* transient-substitute-key-function: Configuration. (line 153) -* transient-values-file: Saving Values. (line 31) - - -File: transient.info, Node: Concept Index, Next: GNU General Public License, Prev: Variable Index, Up: Top - -Appendix E Concept Index -************************ - - -* Menu: - -* aborting transients: Aborting and Resuming Transients. - (line 6) -* classes and methods: Classes and Methods. (line 6) -* command dispatchers: Technical Introduction. - (line 39) -* common suffix commands: Common Suffix Commands. - (line 6) -* defining infix commands: Defining Suffix and Infix Commands. - (line 6) -* defining suffix commands: Defining Suffix and Infix Commands. - (line 6) -* disabling suffixes: Enabling and Disabling Suffixes. - (line 6) -* enabling suffixes: Enabling and Disabling Suffixes. - (line 6) -* getting help: Getting Help for Suffix Commands. - (line 6) -* group specifications: Group Specifications. (line 6) -* invoking transients: Invoking Transients. (line 6) -* levels: Enabling and Disabling Suffixes. - (line 10) -* modifying existing transients: Modifying Existing Transients. - (line 6) -* quit transient: Aborting and Resuming Transients. - (line 6) -* resuming transients: Aborting and Resuming Transients. - (line 6) -* saving values of arguments: Saving Values. (line 6) -* scope of a transient: Defining Transients. (line 43) -* suffix specifications: Suffix Specifications. - (line 6) -* transient state: Transient State. (line 6) -* transient-level: Enabling and Disabling Suffixes. - (line 15) -* value history: Using History. (line 6) - - -File: transient.info, Node: GNU General Public License, Prev: Concept Index, Up: Top - -Appendix F GNU General Public License -************************************* - - Version 3, 29 June 2007 - - Copyright © 2007 Free Software Foundation, Inc. <https://fsf.org/> - - Everyone is permitted to copy and distribute verbatim copies of this - license document, but changing it is not allowed. - -Preamble -======== - -The GNU General Public License is a free, copyleft license for software -and other kinds of works. - - The licenses for most software and other practical works are designed -to take away your freedom to share and change the works. By contrast, -the GNU General Public License is intended to guarantee your freedom to -share and change all versions of a program—to make sure it remains free -software for all its users. We, the Free Software Foundation, use the -GNU General Public License for most of our software; it applies also to -any other work released this way by its authors. You can apply it to -your programs, too. - - When we speak of free software, we are referring to freedom, not -price. Our General Public Licenses are designed to make sure that you -have the freedom to distribute copies of free software (and charge for -them if you wish), that you receive source code or can get it if you -want it, that you can change the software or use pieces of it in new -free programs, and that you know you can do these things. - - To protect your rights, we need to prevent others from denying you -these rights or asking you to surrender the rights. Therefore, you have -certain responsibilities if you distribute copies of the software, or if -you modify it: responsibilities to respect the freedom of others. - - For example, if you distribute copies of such a program, whether -gratis or for a fee, you must pass on to the recipients the same -freedoms that you received. You must make sure that they, too, receive -or can get the source code. And you must show them these terms so they -know their rights. - - Developers that use the GNU GPL protect your rights with two steps: -(1) assert copyright on the software, and (2) offer you this License -giving you legal permission to copy, distribute and/or modify it. - - For the developers’ and authors’ protection, the GPL clearly explains -that there is no warranty for this free software. For both users’ and -authors’ sake, the GPL requires that modified versions be marked as -changed, so that their problems will not be attributed erroneously to -authors of previous versions. - - Some devices are designed to deny users access to install or run -modified versions of the software inside them, although the manufacturer -can do so. This is fundamentally incompatible with the aim of -protecting users’ freedom to change the software. The systematic -pattern of such abuse occurs in the area of products for individuals to -use, which is precisely where it is most unacceptable. Therefore, we -have designed this version of the GPL to prohibit the practice for those -products. If such problems arise substantially in other domains, we -stand ready to extend this provision to those domains in future versions -of the GPL, as needed to protect the freedom of users. - - Finally, every program is threatened constantly by software patents. -States should not allow patents to restrict development and use of -software on general-purpose computers, but in those that do, we wish to -avoid the special danger that patents applied to a free program could -make it effectively proprietary. To prevent this, the GPL assures that -patents cannot be used to render the program non-free. - - The precise terms and conditions for copying, distribution and -modification follow. - -TERMS AND CONDITIONS -==================== - - 0. Definitions. - - “This License” refers to version 3 of the GNU General Public - License. - - “Copyright” also means copyright-like laws that apply to other - kinds of works, such as semiconductor masks. - - “The Program” refers to any copyrightable work licensed under this - License. Each licensee is addressed as “you”. “Licensees” and - “recipients” may be individuals or organizations. - - To “modify” a work means to copy from or adapt all or part of the - work in a fashion requiring copyright permission, other than the - making of an exact copy. The resulting work is called a “modified - version” of the earlier work or a work “based on” the earlier work. - - A “covered work” means either the unmodified Program or a work - based on the Program. - - To “propagate” a work means to do anything with it that, without - permission, would make you directly or secondarily liable for - infringement under applicable copyright law, except executing it on - a computer or modifying a private copy. Propagation includes - copying, distribution (with or without modification), making - available to the public, and in some countries other activities as - well. - - To “convey” a work means any kind of propagation that enables other - parties to make or receive copies. Mere interaction with a user - through a computer network, with no transfer of a copy, is not - conveying. - - An interactive user interface displays “Appropriate Legal Notices” - to the extent that it includes a convenient and prominently visible - feature that (1) displays an appropriate copyright notice, and (2) - tells the user that there is no warranty for the work (except to - the extent that warranties are provided), that licensees may convey - the work under this License, and how to view a copy of this - License. If the interface presents a list of user commands or - options, such as a menu, a prominent item in the list meets this - criterion. - - 1. Source Code. - - The “source code” for a work means the preferred form of the work - for making modifications to it. “Object code” means any non-source - form of a work. - - A “Standard Interface” means an interface that either is an - official standard defined by a recognized standards body, or, in - the case of interfaces specified for a particular programming - language, one that is widely used among developers working in that - language. - - The “System Libraries” of an executable work include anything, - other than the work as a whole, that (a) is included in the normal - form of packaging a Major Component, but which is not part of that - Major Component, and (b) serves only to enable use of the work with - that Major Component, or to implement a Standard Interface for - which an implementation is available to the public in source code - form. A “Major Component”, in this context, means a major - essential component (kernel, window system, and so on) of the - specific operating system (if any) on which the executable work - runs, or a compiler used to produce the work, or an object code - interpreter used to run it. - - The “Corresponding Source” for a work in object code form means all - the source code needed to generate, install, and (for an executable - work) run the object code and to modify the work, including scripts - to control those activities. However, it does not include the - work’s System Libraries, or general-purpose tools or generally - available free programs which are used unmodified in performing - those activities but which are not part of the work. For example, - Corresponding Source includes interface definition files associated - with source files for the work, and the source code for shared - libraries and dynamically linked subprograms that the work is - specifically designed to require, such as by intimate data - communication or control flow between those subprograms and other - parts of the work. - - The Corresponding Source need not include anything that users can - regenerate automatically from other parts of the Corresponding - Source. - - The Corresponding Source for a work in source code form is that - same work. - - 2. Basic Permissions. - - All rights granted under this License are granted for the term of - copyright on the Program, and are irrevocable provided the stated - conditions are met. This License explicitly affirms your unlimited - permission to run the unmodified Program. The output from running - a covered work is covered by this License only if the output, given - its content, constitutes a covered work. This License acknowledges - your rights of fair use or other equivalent, as provided by - copyright law. - - You may make, run and propagate covered works that you do not - convey, without conditions so long as your license otherwise - remains in force. You may convey covered works to others for the - sole purpose of having them make modifications exclusively for you, - or provide you with facilities for running those works, provided - that you comply with the terms of this License in conveying all - material for which you do not control copyright. Those thus making - or running the covered works for you must do so exclusively on your - behalf, under your direction and control, on terms that prohibit - them from making any copies of your copyrighted material outside - their relationship with you. - - Conveying under any other circumstances is permitted solely under - the conditions stated below. Sublicensing is not allowed; section - 10 makes it unnecessary. - - 3. Protecting Users’ Legal Rights From Anti-Circumvention Law. - - No covered work shall be deemed part of an effective technological - measure under any applicable law fulfilling obligations under - article 11 of the WIPO copyright treaty adopted on 20 December - 1996, or similar laws prohibiting or restricting circumvention of - such measures. - - When you convey a covered work, you waive any legal power to forbid - circumvention of technological measures to the extent such - circumvention is effected by exercising rights under this License - with respect to the covered work, and you disclaim any intention to - limit operation or modification of the work as a means of - enforcing, against the work’s users, your or third parties’ legal - rights to forbid circumvention of technological measures. - - 4. Conveying Verbatim Copies. - - You may convey verbatim copies of the Program’s source code as you - receive it, in any medium, provided that you conspicuously and - appropriately publish on each copy an appropriate copyright notice; - keep intact all notices stating that this License and any - non-permissive terms added in accord with section 7 apply to the - code; keep intact all notices of the absence of any warranty; and - give all recipients a copy of this License along with the Program. - - You may charge any price or no price for each copy that you convey, - and you may offer support or warranty protection for a fee. - - 5. Conveying Modified Source Versions. - - You may convey a work based on the Program, or the modifications to - produce it from the Program, in the form of source code under the - terms of section 4, provided that you also meet all of these - conditions: - - a. The work must carry prominent notices stating that you - modified it, and giving a relevant date. - - b. The work must carry prominent notices stating that it is - released under this License and any conditions added under - section 7. This requirement modifies the requirement in - section 4 to “keep intact all notices”. - - c. You must license the entire work, as a whole, under this - License to anyone who comes into possession of a copy. This - License will therefore apply, along with any applicable - section 7 additional terms, to the whole of the work, and all - its parts, regardless of how they are packaged. This License - gives no permission to license the work in any other way, but - it does not invalidate such permission if you have separately - received it. - - d. If the work has interactive user interfaces, each must display - Appropriate Legal Notices; however, if the Program has - interactive interfaces that do not display Appropriate Legal - Notices, your work need not make them do so. - - A compilation of a covered work with other separate and independent - works, which are not by their nature extensions of the covered - work, and which are not combined with it such as to form a larger - program, in or on a volume of a storage or distribution medium, is - called an “aggregate” if the compilation and its resulting - copyright are not used to limit the access or legal rights of the - compilation’s users beyond what the individual works permit. - Inclusion of a covered work in an aggregate does not cause this - License to apply to the other parts of the aggregate. - - 6. Conveying Non-Source Forms. - - You may convey a covered work in object code form under the terms - of sections 4 and 5, provided that you also convey the - machine-readable Corresponding Source under the terms of this - License, in one of these ways: - - a. Convey the object code in, or embodied in, a physical product - (including a physical distribution medium), accompanied by the - Corresponding Source fixed on a durable physical medium - customarily used for software interchange. - - b. Convey the object code in, or embodied in, a physical product - (including a physical distribution medium), accompanied by a - written offer, valid for at least three years and valid for as - long as you offer spare parts or customer support for that - product model, to give anyone who possesses the object code - either (1) a copy of the Corresponding Source for all the - software in the product that is covered by this License, on a - durable physical medium customarily used for software - interchange, for a price no more than your reasonable cost of - physically performing this conveying of source, or (2) access - to copy the Corresponding Source from a network server at no - charge. - - c. Convey individual copies of the object code with a copy of the - written offer to provide the Corresponding Source. This - alternative is allowed only occasionally and noncommercially, - and only if you received the object code with such an offer, - in accord with subsection 6b. - - d. Convey the object code by offering access from a designated - place (gratis or for a charge), and offer equivalent access to - the Corresponding Source in the same way through the same - place at no further charge. You need not require recipients - to copy the Corresponding Source along with the object code. - If the place to copy the object code is a network server, the - Corresponding Source may be on a different server (operated by - you or a third party) that supports equivalent copying - facilities, provided you maintain clear directions next to the - object code saying where to find the Corresponding Source. - Regardless of what server hosts the Corresponding Source, you - remain obligated to ensure that it is available for as long as - needed to satisfy these requirements. - - e. Convey the object code using peer-to-peer transmission, - provided you inform other peers where the object code and - Corresponding Source of the work are being offered to the - general public at no charge under subsection 6d. - - A separable portion of the object code, whose source code is - excluded from the Corresponding Source as a System Library, need - not be included in conveying the object code work. - - A “User Product” is either (1) a “consumer product”, which means - any tangible personal property which is normally used for personal, - family, or household purposes, or (2) anything designed or sold for - incorporation into a dwelling. In determining whether a product is - a consumer product, doubtful cases shall be resolved in favor of - coverage. For a particular product received by a particular user, - “normally used” refers to a typical or common use of that class of - product, regardless of the status of the particular user or of the - way in which the particular user actually uses, or expects or is - expected to use, the product. A product is a consumer product - regardless of whether the product has substantial commercial, - industrial or non-consumer uses, unless such uses represent the - only significant mode of use of the product. - - “Installation Information” for a User Product means any methods, - procedures, authorization keys, or other information required to - install and execute modified versions of a covered work in that - User Product from a modified version of its Corresponding Source. - The information must suffice to ensure that the continued - functioning of the modified object code is in no case prevented or - interfered with solely because modification has been made. - - If you convey an object code work under this section in, or with, - or specifically for use in, a User Product, and the conveying - occurs as part of a transaction in which the right of possession - and use of the User Product is transferred to the recipient in - perpetuity or for a fixed term (regardless of how the transaction - is characterized), the Corresponding Source conveyed under this - section must be accompanied by the Installation Information. But - this requirement does not apply if neither you nor any third party - retains the ability to install modified object code on the User - Product (for example, the work has been installed in ROM). - - The requirement to provide Installation Information does not - include a requirement to continue to provide support service, - warranty, or updates for a work that has been modified or installed - by the recipient, or for the User Product in which it has been - modified or installed. Access to a network may be denied when the - modification itself materially and adversely affects the operation - of the network or violates the rules and protocols for - communication across the network. - - Corresponding Source conveyed, and Installation Information - provided, in accord with this section must be in a format that is - publicly documented (and with an implementation available to the - public in source code form), and must require no special password - or key for unpacking, reading or copying. - - 7. Additional Terms. - - “Additional permissions” are terms that supplement the terms of - this License by making exceptions from one or more of its - conditions. Additional permissions that are applicable to the - entire Program shall be treated as though they were included in - this License, to the extent that they are valid under applicable - law. If additional permissions apply only to part of the Program, - that part may be used separately under those permissions, but the - entire Program remains governed by this License without regard to - the additional permissions. - - When you convey a copy of a covered work, you may at your option - remove any additional permissions from that copy, or from any part - of it. (Additional permissions may be written to require their own - removal in certain cases when you modify the work.) You may place - additional permissions on material, added by you to a covered work, - for which you have or can give appropriate copyright permission. - - Notwithstanding any other provision of this License, for material - you add to a covered work, you may (if authorized by the copyright - holders of that material) supplement the terms of this License with - terms: - - a. Disclaiming warranty or limiting liability differently from - the terms of sections 15 and 16 of this License; or - - b. Requiring preservation of specified reasonable legal notices - or author attributions in that material or in the Appropriate - Legal Notices displayed by works containing it; or - - c. Prohibiting misrepresentation of the origin of that material, - or requiring that modified versions of such material be marked - in reasonable ways as different from the original version; or - - d. Limiting the use for publicity purposes of names of licensors - or authors of the material; or - - e. Declining to grant rights under trademark law for use of some - trade names, trademarks, or service marks; or - - f. Requiring indemnification of licensors and authors of that - material by anyone who conveys the material (or modified - versions of it) with contractual assumptions of liability to - the recipient, for any liability that these contractual - assumptions directly impose on those licensors and authors. - - All other non-permissive additional terms are considered “further - restrictions” within the meaning of section 10. If the Program as - you received it, or any part of it, contains a notice stating that - it is governed by this License along with a term that is a further - restriction, you may remove that term. If a license document - contains a further restriction but permits relicensing or conveying - under this License, you may add to a covered work material governed - by the terms of that license document, provided that the further - restriction does not survive such relicensing or conveying. - - If you add terms to a covered work in accord with this section, you - must place, in the relevant source files, a statement of the - additional terms that apply to those files, or a notice indicating - where to find the applicable terms. - - Additional terms, permissive or non-permissive, may be stated in - the form of a separately written license, or stated as exceptions; - the above requirements apply either way. - - 8. Termination. - - You may not propagate or modify a covered work except as expressly - provided under this License. Any attempt otherwise to propagate or - modify it is void, and will automatically terminate your rights - under this License (including any patent licenses granted under the - third paragraph of section 11). - - However, if you cease all violation of this License, then your - license from a particular copyright holder is reinstated (a) - provisionally, unless and until the copyright holder explicitly and - finally terminates your license, and (b) permanently, if the - copyright holder fails to notify you of the violation by some - reasonable means prior to 60 days after the cessation. - - Moreover, your license from a particular copyright holder is - reinstated permanently if the copyright holder notifies you of the - violation by some reasonable means, this is the first time you have - received notice of violation of this License (for any work) from - that copyright holder, and you cure the violation prior to 30 days - after your receipt of the notice. - - Termination of your rights under this section does not terminate - the licenses of parties who have received copies or rights from you - under this License. If your rights have been terminated and not - permanently reinstated, you do not qualify to receive new licenses - for the same material under section 10. - - 9. Acceptance Not Required for Having Copies. - - You are not required to accept this License in order to receive or - run a copy of the Program. Ancillary propagation of a covered work - occurring solely as a consequence of using peer-to-peer - transmission to receive a copy likewise does not require - acceptance. However, nothing other than this License grants you - permission to propagate or modify any covered work. These actions - infringe copyright if you do not accept this License. Therefore, - by modifying or propagating a covered work, you indicate your - acceptance of this License to do so. - - 10. Automatic Licensing of Downstream Recipients. - - Each time you convey a covered work, the recipient automatically - receives a license from the original licensors, to run, modify and - propagate that work, subject to this License. You are not - responsible for enforcing compliance by third parties with this - License. - - An “entity transaction” is a transaction transferring control of an - organization, or substantially all assets of one, or subdividing an - organization, or merging organizations. If propagation of a - covered work results from an entity transaction, each party to that - transaction who receives a copy of the work also receives whatever - licenses to the work the party’s predecessor in interest had or - could give under the previous paragraph, plus a right to possession - of the Corresponding Source of the work from the predecessor in - interest, if the predecessor has it or can get it with reasonable - efforts. - - You may not impose any further restrictions on the exercise of the - rights granted or affirmed under this License. For example, you - may not impose a license fee, royalty, or other charge for exercise - of rights granted under this License, and you may not initiate - litigation (including a cross-claim or counterclaim in a lawsuit) - alleging that any patent claim is infringed by making, using, - selling, offering for sale, or importing the Program or any portion - of it. - - 11. Patents. - - A “contributor” is a copyright holder who authorizes use under this - License of the Program or a work on which the Program is based. - The work thus licensed is called the contributor’s “contributor - version”. - - A contributor’s “essential patent claims” are all patent claims - owned or controlled by the contributor, whether already acquired or - hereafter acquired, that would be infringed by some manner, - permitted by this License, of making, using, or selling its - contributor version, but do not include claims that would be - infringed only as a consequence of further modification of the - contributor version. For purposes of this definition, “control” - includes the right to grant patent sublicenses in a manner - consistent with the requirements of this License. - - Each contributor grants you a non-exclusive, worldwide, - royalty-free patent license under the contributor’s essential - patent claims, to make, use, sell, offer for sale, import and - otherwise run, modify and propagate the contents of its contributor - version. - - In the following three paragraphs, a “patent license” is any - express agreement or commitment, however denominated, not to - enforce a patent (such as an express permission to practice a - patent or covenant not to sue for patent infringement). To “grant” - such a patent license to a party means to make such an agreement or - commitment not to enforce a patent against the party. - - If you convey a covered work, knowingly relying on a patent - license, and the Corresponding Source of the work is not available - for anyone to copy, free of charge and under the terms of this - License, through a publicly available network server or other - readily accessible means, then you must either (1) cause the - Corresponding Source to be so available, or (2) arrange to deprive - yourself of the benefit of the patent license for this particular - work, or (3) arrange, in a manner consistent with the requirements - of this License, to extend the patent license to downstream - recipients. “Knowingly relying” means you have actual knowledge - that, but for the patent license, your conveying the covered work - in a country, or your recipient’s use of the covered work in a - country, would infringe one or more identifiable patents in that - country that you have reason to believe are valid. - - If, pursuant to or in connection with a single transaction or - arrangement, you convey, or propagate by procuring conveyance of, a - covered work, and grant a patent license to some of the parties - receiving the covered work authorizing them to use, propagate, - modify or convey a specific copy of the covered work, then the - patent license you grant is automatically extended to all - recipients of the covered work and works based on it. - - A patent license is “discriminatory” if it does not include within - the scope of its coverage, prohibits the exercise of, or is - conditioned on the non-exercise of one or more of the rights that - are specifically granted under this License. You may not convey a - covered work if you are a party to an arrangement with a third - party that is in the business of distributing software, under which - you make payment to the third party based on the extent of your - activity of conveying the work, and under which the third party - grants, to any of the parties who would receive the covered work - from you, a discriminatory patent license (a) in connection with - copies of the covered work conveyed by you (or copies made from - those copies), or (b) primarily for and in connection with specific - products or compilations that contain the covered work, unless you - entered into that arrangement, or that patent license was granted, - prior to 28 March 2007. - - Nothing in this License shall be construed as excluding or limiting - any implied license or other defenses to infringement that may - otherwise be available to you under applicable patent law. - - 12. No Surrender of Others’ Freedom. - - If conditions are imposed on you (whether by court order, agreement - or otherwise) that contradict the conditions of this License, they - do not excuse you from the conditions of this License. If you - cannot convey a covered work so as to satisfy simultaneously your - obligations under this License and any other pertinent obligations, - then as a consequence you may not convey it at all. For example, - if you agree to terms that obligate you to collect a royalty for - further conveying from those to whom you convey the Program, the - only way you could satisfy both those terms and this License would - be to refrain entirely from conveying the Program. - - 13. Use with the GNU Affero General Public License. - - Notwithstanding any other provision of this License, you have - permission to link or combine any covered work with a work licensed - under version 3 of the GNU Affero General Public License into a - single combined work, and to convey the resulting work. The terms - of this License will continue to apply to the part which is the - covered work, but the special requirements of the GNU Affero - General Public License, section 13, concerning interaction through - a network will apply to the combination as such. - - 14. Revised Versions of this License. - - The Free Software Foundation may publish revised and/or new - versions of the GNU General Public License from time to time. Such - new versions will be similar in spirit to the present version, but - may differ in detail to address new problems or concerns. - - Each version is given a distinguishing version number. If the - Program specifies that a certain numbered version of the GNU - General Public License “or any later version” applies to it, you - have the option of following the terms and conditions either of - that numbered version or of any later version published by the Free - Software Foundation. If the Program does not specify a version - number of the GNU General Public License, you may choose any - version ever published by the Free Software Foundation. - - If the Program specifies that a proxy can decide which future - versions of the GNU General Public License can be used, that - proxy’s public statement of acceptance of a version permanently - authorizes you to choose that version for the Program. - - Later license versions may give you additional or different - permissions. However, no additional obligations are imposed on any - author or copyright holder as a result of your choosing to follow a - later version. - - 15. Disclaimer of Warranty. - - THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY - APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE - COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM “AS IS” - WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, - INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF - MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE - RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. - SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL - NECESSARY SERVICING, REPAIR OR CORRECTION. - - 16. Limitation of Liability. - - IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN - WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES - AND/OR CONVEYS THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR - DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR - CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE - THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA - BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD - PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER - PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF - THE POSSIBILITY OF SUCH DAMAGES. - - 17. Interpretation of Sections 15 and 16. - - If the disclaimer of warranty and limitation of liability provided - above cannot be given local legal effect according to their terms, - reviewing courts shall apply local law that most closely - approximates an absolute waiver of all civil liability in - connection with the Program, unless a warranty or assumption of - liability accompanies a copy of the Program in return for a fee. - -END OF TERMS AND CONDITIONS -=========================== - -How to Apply These Terms to Your New Programs -============================================= - -If you develop a new program, and you want it to be of the greatest -possible use to the public, the best way to achieve this is to make it -free software which everyone can redistribute and change under these -terms. - - To do so, attach the following notices to the program. It is safest -to attach them to the start of each source file to most effectively -state the exclusion of warranty; and each file should have at least the -“copyright” line and a pointer to where the full notice is found. - - ONE LINE TO GIVE THE PROGRAM'S NAME AND A BRIEF IDEA OF WHAT IT DOES. - Copyright (C) YEAR NAME OF AUTHOR - - This program is free software: you can redistribute it and/or modify - it under the terms of the GNU General Public License as published by - the Free Software Foundation, either version 3 of the License, or (at - your option) any later version. - - This program is distributed in the hope that it will be useful, but - WITHOUT ANY WARRANTY; without even the implied warranty of - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU - General Public License for more details. - - You should have received a copy of the GNU General Public License - along with this program. If not, see <https://www.gnu.org/licenses/>. - - Also add information on how to contact you by electronic and paper -mail. - - If the program does terminal interaction, make it output a short -notice like this when it starts in an interactive mode: - - PROGRAM Copyright (C) YEAR NAME OF AUTHOR - This program comes with ABSOLUTELY NO WARRANTY; for details type ‘show w’. - This is free software, and you are welcome to redistribute it - under certain conditions; type ‘show c’ for details. - - The hypothetical commands ‘show w’ and ‘show c’ should show the -appropriate parts of the General Public License. Of course, your -program’s commands might be different; for a GUI interface, you would -use an “about box”. - - You should also get your employer (if you work as a programmer) or -school, if any, to sign a “copyright disclaimer” for the program, if -necessary. For more information on this, and how to apply and follow -the GNU GPL, see <https://www.gnu.org/licenses/>. - - The GNU General Public License does not permit incorporating your -program into proprietary programs. If your program is a subroutine -library, you may consider it more useful to permit linking proprietary -applications with the library. If this is what you want to do, use the -GNU Lesser General Public License instead of this License. But first, -please read <https://www.gnu.org/licenses/why-not-lgpl.html>. - - - -Tag Table: -Node: Top763 -Node: Introduction2976 -Ref: Some things that Transient can do3504 -Ref: Complexity in CLI programs3857 -Ref: Using Transient for composing interactive commands4458 -Node: Usage6700 -Node: Invoking Transients7068 -Node: Aborting and Resuming Transients8147 -Node: Common Suffix Commands10768 -Node: Saving Values12604 -Ref: Saving Values-Footnote-113975 -Node: Using History14168 -Node: Getting Help for Suffix Commands15742 -Node: Enabling and Disabling Suffixes17120 -Node: Other Commands20408 -Node: Configuration21384 -Ref: Essential Options21664 -Ref: Accessibility Options25325 -Ref: Auxiliary Options25648 -Ref: Developer Options30611 -Node: Modifying Existing Transients31859 -Node: Defining New Commands36051 -Node: Technical Introduction36414 -Node: Defining Transients42115 -Node: Binding Suffix and Infix Commands44582 -Node: Group Specifications45440 -Node: Suffix Specifications50542 -Node: Defining Suffix and Infix Commands54755 -Node: Using Infix Arguments57803 -Node: Transient State60637 -Ref: Pre-commands for Infixes65452 -Ref: Pre-commands for Suffixes65972 -Ref: Pre-commands for Non-Suffixes68426 -Ref: Special Pre-Commands69562 -Node: Classes and Methods70070 -Node: Group Classes72254 -Node: Group Methods74181 -Node: Prefix Classes75434 -Node: Suffix Classes76525 -Node: Suffix Methods79612 -Node: Suffix Value Methods79933 -Node: Suffix Format Methods82691 -Node: Prefix Slots84170 -Ref: Internal Prefix Slots86305 -Node: Suffix Slots87562 -Ref: Slots of transient-suffix87930 -Ref: Slots of transient-infix89067 -Ref: Slots of transient-variable92363 -Ref: Slots of transient-switches92465 -Node: Predicate Slots92828 -Node: FAQ94263 -Ref: Can I control how the popup buffer is displayed?94392 -Ref: How can I copy text from the popup buffer?94573 -Ref: How can I autoload prefix and suffix commands?95067 -Ref: How does Transient compare to prefix keys and universal arguments?95541 -Ref: How does Transient compare to Magit-Popup and Hydra?95784 -Ref: Why did some of the key bindings change?95978 -Ref: Why does q not quit popups anymore?98331 -Node: Keystroke Index99434 -Node: Command and Function Index101299 -Node: Variable Index107891 -Node: Concept Index110164 -Node: GNU General Public License112900 - -End Tag Table - - -Local Variables: -coding: utf-8 -End: diff --git a/emacs/elpa/transient-20240607.1832/dir b/emacs/elpa/transient-20240626.947/dir diff --git a/emacs/elpa/transient-20240607.1832/gpl.info b/emacs/elpa/transient-20240626.947/gpl.info diff --git a/emacs/elpa/transient-20240622.1240/transient-autoloads.el b/emacs/elpa/transient-20240626.947/transient-autoloads.el diff --git a/emacs/elpa/transient-20240626.947/transient-pkg.el b/emacs/elpa/transient-20240626.947/transient-pkg.el @@ -0,0 +1,16 @@ +(define-package "transient" "20240626.947" "Transient commands" + '((emacs "26.1") + (compat "29.1.4.5") + (seq "2.24")) + :commit "0e0ece32362bb5eed430328583018a35f44d3c7d" :authors + '(("Jonas Bernoulli" . "emacs.transient@jonas.bernoulli.dev")) + :maintainers + '(("Jonas Bernoulli" . "emacs.transient@jonas.bernoulli.dev")) + :maintainer + '("Jonas Bernoulli" . "emacs.transient@jonas.bernoulli.dev") + :keywords + '("extensions") + :url "https://github.com/magit/transient") +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/emacs/elpa/transient-20240626.947/transient.el b/emacs/elpa/transient-20240626.947/transient.el @@ -0,0 +1,4569 @@ +;;; transient.el --- Transient commands -*- lexical-binding:t -*- + +;; Copyright (C) 2018-2024 Free Software Foundation, Inc. + +;; Author: Jonas Bernoulli <emacs.transient@jonas.bernoulli.dev> +;; Homepage: https://github.com/magit/transient +;; Keywords: extensions + +;; Package-Version: 0.7.2 +;; Package-Requires: ((emacs "26.1") (compat "29.1.4.5") (seq "2.24")) + +;; SPDX-License-Identifier: GPL-3.0-or-later + +;; This file is part of GNU Emacs. + +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published +;; by the Free Software Foundation, either version 3 of the License, +;; or (at your option) any later version. +;; +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. +;; +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Transient is the library used to implement the keyboard-driven menus +;; in Magit. It is distributed as a separate package, so that it can be +;; used to implement similar menus in other packages. + +;;; Code: + +(require 'cl-lib) +(require 'compat) +(require 'eieio) +(require 'edmacro) +(require 'format-spec) + +(eval-and-compile + (when (and (featurep 'seq) + (not (fboundp 'seq-keep))) + (unload-feature 'seq 'force))) +(require 'seq) +(unless (fboundp 'seq-keep) + (display-warning 'transient (substitute-command-keys "\ +Transient requires `seq' >= 2.24, +but due to bad defaults, Emacs' package manager, refuses to +upgrade this and other built-in packages to higher releases +from GNU Elpa, when a package specifies that this is needed. + +To fix this, you have to add this to your init file: + + (setq package-install-upgrade-built-in t) + +Then evaluate that expression by placing the cursor after it +and typing \\[eval-last-sexp]. + +Once you have done that, you have to explicitly upgrade `seq': + + \\[package-upgrade] seq \\`RET' + +Then you also must make sure the updated version is loaded, +by evaluating this form: + + (progn (unload-feature 'seq t) (require 'seq)) + +Until you do this, you will get random errors about `seq-keep' +being undefined while using Transient. + +If you don't use the `package' package manager but still get +this warning, then your chosen package manager likely has a +similar defect.") :emergency)) + +(eval-when-compile (require 'subr-x)) + +(declare-function info "info" (&optional file-or-node buffer)) +(declare-function Man-find-section "man" (section)) +(declare-function Man-next-section "man" (n)) +(declare-function Man-getpage-in-background "man" (topic)) + +(defvar Man-notify-method) +(defvar pp-default-function) ; since Emacs 29.1 + +(defmacro static-if (condition then-form &rest else-forms) + "A conditional compilation macro. +Evaluate CONDITION at macro-expansion time. If it is non-nil, +expand the macro to THEN-FORM. Otherwise expand it to ELSE-FORMS +enclosed in a `progn' form. ELSE-FORMS may be empty." + (declare (indent 2) + (debug (sexp sexp &rest sexp))) + (if (eval condition lexical-binding) + then-form + (cons 'progn else-forms))) + +(defmacro transient--with-emergency-exit (id &rest body) + (declare (indent defun)) + (unless (keywordp id) + (setq body (cons id body)) + (setq id nil)) + `(condition-case err + (let ((debugger #'transient--exit-and-debug)) + ,(macroexp-progn body)) + ((debug error) + (transient--emergency-exit ,id) + (signal (car err) (cdr err))))) + +(defun transient--exit-and-debug (&rest args) + (transient--emergency-exit :debugger) + (apply #'debug args)) + +;;; Options + +(defgroup transient nil + "Transient commands." + :group 'extensions) + +(defcustom transient-show-popup t + "Whether to show the current transient in a popup buffer. +\\<transient-map> +- If t, then show the popup as soon as a transient prefix command + is invoked. + +- If nil, then do not show the popup unless the user explicitly + requests it, by pressing \\[transient-show] or a prefix key. + +- If a number, then delay displaying the popup and instead show + a brief one-line summary. If zero or negative, then suppress + even showing that summary and display the pressed key only. + + Show the popup when the user explicitly requests it by pressing + \\[transient-show] or a prefix key. Unless zero, then also show the popup + after that many seconds of inactivity (using the absolute value)." + :package-version '(transient . "0.1.0") + :group 'transient + :type '(choice (const :tag "instantly" t) + (const :tag "on demand" nil) + (const :tag "on demand (no summary)" 0) + (number :tag "after delay" 1))) + +(defcustom transient-enable-popup-navigation t + "Whether navigation commands are enabled in the transient popup. + +While a transient is active the transient popup buffer is not the +current buffer, making it necessary to use dedicated commands to +act on that buffer itself. If this is non-nil, then the following +bindings are available: + +\\<transient-popup-navigation-map>\ +- \\[transient-backward-button] moves the cursor to the previous suffix. +- \\[transient-forward-button] moves the cursor to the next suffix. +- \\[transient-push-button] invokes the suffix the cursor is on. +\\<transient-button-map>\ +- \\`<mouse-1>' and \\`<mouse-2>' invoke the clicked on suffix. +\\<transient-popup-navigation-map>\ +- \\[transient-isearch-backward]\ + and \\[transient-isearch-forward] start isearch in the popup buffer. + +\\`<mouse-1>' and \\`<mouse-2>' are bound in `transient-push-button'. +All other bindings are in `transient-popup-navigation-map'. + +By default \\`M-RET' is bound to `transient-push-button', instead of +\\`RET', because if a transient allows the invocation of non-suffixes +then it is likely that you would want \\`RET' to do what it would do +if no transient were active." + :package-version '(transient . "0.4.0") + :group 'transient + :type 'boolean) + +(defcustom transient-display-buffer-action + '(display-buffer-in-side-window + (side . bottom) + (dedicated . t) + (inhibit-same-window . t) + (window-parameters (no-other-window . t))) + "The action used to display the transient popup buffer. + +The transient popup buffer is displayed in a window using + + (display-buffer BUFFER transient-display-buffer-action) + +The value of this option has the form (FUNCTION . ALIST), +where FUNCTION is a function or a list of functions. Each such +function should accept two arguments: a buffer to display and an +alist of the same form as ALIST. See info node `(elisp)Choosing +Window' for details. + +The default is: + + (display-buffer-in-side-window + (side . bottom) + (dedicated . t) + (inhibit-same-window . t) + (window-parameters (no-other-window . t))) + +This displays the window at the bottom of the selected frame. +Another useful FUNCTION is `display-buffer-below-selected', which +is what `magit-popup' used by default. For more alternatives see +info node `(elisp)Display Action Functions' and info node +`(elisp)Buffer Display Action Alists'. + +Note that the buffer that was current before the transient buffer +is shown should remain the current buffer. Many suffix commands +act on the thing at point, if appropriate, and if the transient +buffer became the current buffer, then that would change what is +at point. To that effect `inhibit-same-window' ensures that the +selected window is not used to show the transient buffer. + +It may be possible to display the window in another frame, but +whether that works in practice depends on the window-manager. +If the window manager selects the new window (Emacs frame), +then that unfortunately changes which buffer is current. + +If you change the value of this option, then you might also +want to change the value of `transient-mode-line-format'." + :package-version '(transient . "0.3.0") + :group 'transient + :type '(cons (choice function (repeat :tag "Functions" function)) + alist)) + +(defcustom transient-mode-line-format 'line + "The mode-line format for the transient popup buffer. + +If nil, then the buffer has no mode-line. If the buffer is not +displayed right above the echo area, then this probably is not +a good value. + +If `line' (the default) or a natural number, then the buffer +has no mode-line, but a line is drawn is drawn in its place. +If a number is used, that specifies the thickness of the line. +On termcap frames we cannot draw lines, so there `line' and +numbers are synonyms for nil. + +The color of the line is used to indicate if non-suffixes are +allowed and whether they exit the transient. The foreground +color of `transient-key-noop' (if non-suffix are disallowed), +`transient-key-stay' (if allowed and transient stays active), or +`transient-key-exit' (if allowed and they exit the transient) is +used to draw the line. + +Otherwise this can be any mode-line format. +See `mode-line-format' for details." + :package-version '(transient . "0.2.0") + :group 'transient + :type '(choice (const :tag "hide mode-line" nil) + (const :tag "substitute thin line" line) + (number :tag "substitute line with thickness") + (const :tag "name of prefix command" + ("%e" mode-line-front-space + mode-line-buffer-identification)) + (sexp :tag "custom mode-line format"))) + +(defcustom transient-show-common-commands nil + "Whether to show common transient suffixes in the popup buffer. + +These commands are always shown after typing the prefix key +\"C-x\" when a transient command is active. To toggle the value +of this variable use \"C-x t\" when a transient is active." + :package-version '(transient . "0.1.0") + :group 'transient + :type 'boolean) + +(defcustom transient-read-with-initial-input nil + "Whether to use the last history element as initial minibuffer input." + :package-version '(transient . "0.2.0") + :group 'transient + :type 'boolean) + +(defcustom transient-highlight-mismatched-keys nil + "Whether to highlight keys that do not match their argument. + +This only affects infix arguments that represent command-line +arguments. When this option is non-nil, then the key binding +for infix argument are highlighted when only a long argument +\(e.g., \"--verbose\") is specified but no shorthand (e.g., \"-v\"). +In the rare case that a short-hand is specified but does not +match the key binding, then it is highlighted differently. + +The highlighting is done using `transient-mismatched-key' +and `transient-nonstandard-key'." + :package-version '(transient . "0.1.0") + :group 'transient + :type 'boolean) + +(defcustom transient-highlight-higher-levels nil + "Whether to highlight suffixes on higher levels. + +This is primarily intended for package authors. + +When non-nil then highlight the description of suffixes whose +level is above 4, the default of `transient-default-level'. +Assuming you have set that variable to 7, this highlights all +suffixes that won't be available to users without them making +the same customization." + :package-version '(transient . "0.3.6") + :group 'transient + :type 'boolean) + +(defcustom transient-substitute-key-function nil + "Function used to modify key bindings. + +This function is called with one argument, the prefix object, +and must return a key binding description, either the existing +key description it finds in the `key' slot, or a substitution. + +This is intended to let users replace certain prefix keys. It +could also be used to make other substitutions, but that is +discouraged. + +For example, \"=\" is hard to reach using my custom keyboard +layout, so I substitute \"(\" for that, which is easy to reach +using a layout optimized for Lisp. + + (setq transient-substitute-key-function + (lambda (obj) + (let ((key (oref obj key))) + (if (string-match \"\\\\`\\\\(=\\\\)[a-zA-Z]\" key) + (replace-match \"(\" t t key 1) + key)))))" + :package-version '(transient . "0.1.0") + :group 'transient + :type '(choice (const :tag "Transform no keys (nil)" nil) function)) + +(defcustom transient-semantic-coloring t + "Whether to use colors to indicate transient behavior. + +If non-nil, then the key binding of each suffix is colorized to +indicate whether it exits the transient state or not, and the +line that is drawn below the transient popup buffer is used to +indicate the behavior of non-suffix commands." + :package-version '(transient . "0.5.0") + :group 'transient + :type 'boolean) + +(defcustom transient-detect-key-conflicts nil + "Whether to detect key binding conflicts. + +Conflicts are detected when a transient prefix command is invoked +and results in an error, which prevents the transient from being +used." + :package-version '(transient . "0.1.0") + :group 'transient + :type 'boolean) + +(defcustom transient-align-variable-pitch nil + "Whether to align columns pixel-wise in the popup buffer. + +If this is non-nil, then columns are aligned pixel-wise to +support variable-pitch fonts. Keys are not aligned, so you +should use a fixed-pitch font for the `transient-key' face. +Other key faces inherit from that face unless a theme is +used that breaks that relationship. + +This option is intended for users who use a variable-pitch +font for the `default' face. + +Also see `transient-force-fixed-pitch'." + :package-version '(transient . "0.4.0") + :group 'transient + :type 'boolean) + +(defcustom transient-force-fixed-pitch nil + "Whether to force use of monospaced font in the popup buffer. + +Even if you use a proportional font for the `default' face, +you might still want to use a monospaced font in transient's +popup buffer. Setting this option to t causes `default' to +be remapped to `fixed-pitch' in that buffer. + +Also see `transient-align-variable-pitch'." + :package-version '(transient . "0.2.0") + :group 'transient + :type 'boolean) + +(defcustom transient-force-single-column nil + "Whether to force use of a single column to display suffixes. + +This might be useful for users with low vision who use large +text and might otherwise have to scroll in two dimensions." + :package-version '(transient . "0.3.6") + :group 'transient + :type 'boolean) + +(defcustom transient-hide-during-minibuffer-read nil + "Whether to hide the transient buffer while reading in the minibuffer." + :package-version '(transient . "0.4.0") + :group 'transient + :type 'boolean) + +(defconst transient--max-level 7) +(defconst transient--default-child-level 1) +(defconst transient--default-prefix-level 4) + +(defcustom transient-default-level transient--default-prefix-level + "Control what suffix levels are made available by default. + +Each suffix command is placed on a level and each prefix command +has a level, which controls which suffix commands are available. +Integers between 1 and 7 (inclusive) are valid levels. + +The levels of individual transients and/or their individual +suffixes can be changed individually, by invoking the prefix and +then pressing \"C-x l\". + +The default level for both transients and their suffixes is 4. +This option only controls the default for transients. The default +suffix level is always 4. The author of a transient should place +certain suffixes on a higher level if they expect that it won't be +of use to most users, and they should place very important suffixes +on a lower level so that they remain available even if the user +lowers the transient level. + +\(Magit currently places nearly all suffixes on level 4 and lower +levels are not used at all yet. So for the time being you should +not set a lower level here and using a higher level might not +give you as many additional suffixes as you hoped.)" + :package-version '(transient . "0.1.0") + :group 'transient + :type '(choice (const :tag "1 - fewest suffixes" 1) + (const 2) + (const 3) + (const :tag "4 - default" 4) + (const 5) + (const 6) + (const :tag "7 - most suffixes" 7))) + +(defcustom transient-levels-file + (locate-user-emacs-file "transient/levels.el") + "File used to save levels of transients and their suffixes." + :package-version '(transient . "0.1.0") + :group 'transient + :type 'file) + +(defcustom transient-values-file + (locate-user-emacs-file "transient/values.el") + "File used to save values of transients." + :package-version '(transient . "0.1.0") + :group 'transient + :type 'file) + +(defcustom transient-history-file + (locate-user-emacs-file "transient/history.el") + "File used to save history of transients and their infixes." + :package-version '(transient . "0.1.0") + :group 'transient + :type 'file) + +(defcustom transient-history-limit 10 + "Number of history elements to keep when saving to file." + :package-version '(transient . "0.1.0") + :group 'transient + :type 'integer) + +(defcustom transient-save-history t + "Whether to save history of transient commands when exiting Emacs." + :package-version '(transient . "0.1.0") + :group 'transient + :type 'boolean) + +;;; Faces + +(defgroup transient-faces nil + "Faces used by Transient." + :group 'transient) + +(defface transient-heading '((t :inherit font-lock-keyword-face)) + "Face used for headings." + :group 'transient-faces) + +(defface transient-argument '((t :inherit font-lock-string-face :weight bold)) + "Face used for enabled arguments." + :group 'transient-faces) + +(defface transient-inactive-argument '((t :inherit shadow)) + "Face used for inactive arguments." + :group 'transient-faces) + +(defface transient-value '((t :inherit font-lock-string-face :weight bold)) + "Face used for values." + :group 'transient-faces) + +(defface transient-inactive-value '((t :inherit shadow)) + "Face used for inactive values." + :group 'transient-faces) + +(defface transient-unreachable '((t :inherit shadow)) + "Face used for suffixes unreachable from the current prefix sequence." + :group 'transient-faces) + +(defface transient-inapt-suffix '((t :inherit shadow :italic t)) + "Face used for suffixes that are inapt at this time." + :group 'transient-faces) + +(defface transient-active-infix '((t :inherit highlight)) + "Face used for the infix for which the value is being read." + :group 'transient-faces) + +(defface transient-enabled-suffix + '((t :background "green" :foreground "black" :weight bold)) + "Face used for enabled levels while editing suffix levels. +See info node `(transient)Enabling and Disabling Suffixes'." + :group 'transient-faces) + +(defface transient-disabled-suffix + '((t :background "red" :foreground "black" :weight bold)) + "Face used for disabled levels while editing suffix levels. +See info node `(transient)Enabling and Disabling Suffixes'." + :group 'transient-faces) + +(defface transient-higher-level + `((t :box ( :line-width ,(if (>= emacs-major-version 28) (cons -1 -1) -1) + :color ,(let ((color (face-attribute 'shadow :foreground nil t))) + (or (and (not (eq color 'unspecified)) color) + "grey60"))))) + "Face optionally used to highlight suffixes on higher levels. +Also see option `transient-highlight-higher-levels'." + :group 'transient-faces) + +(defface transient-delimiter '((t :inherit shadow)) + "Face used for delimiters and separators. +This includes the parentheses around values and the pipe +character used to separate possible values from each other." + :group 'transient-faces) + +(defface transient-key '((t :inherit font-lock-builtin-face)) + "Face used for keys." + :group 'transient-faces) + +(defface transient-key-stay + `((((class color) (background light)) + :inherit transient-key + :foreground "#22aa22") + (((class color) (background dark)) + :inherit transient-key + :foreground "#ddffdd")) + "Face used for keys of suffixes that don't exit transient state." + :group 'transient-faces) + +(defface transient-key-noop + `((((class color) (background light)) + :inherit transient-key + :foreground "grey80") + (((class color) (background dark)) + :inherit transient-key + :foreground "grey30")) + "Face used for keys of suffixes that currently cannot be invoked." + :group 'transient-faces) + +(defface transient-key-return + `((((class color) (background light)) + :inherit transient-key + :foreground "#aaaa11") + (((class color) (background dark)) + :inherit transient-key + :foreground "#ffffcc")) + "Face used for keys of suffixes that return to the parent transient." + :group 'transient-faces) + +(defface transient-key-exit + `((((class color) (background light)) + :inherit transient-key + :foreground "#aa2222") + (((class color) (background dark)) + :inherit transient-key + :foreground "#ffdddd")) + "Face used for keys of suffixes that exit transient state." + :group 'transient-faces) + +(defface transient-unreachable-key + '((t :inherit (shadow transient-key) :weight normal)) + "Face used for keys unreachable from the current prefix sequence." + :group 'transient-faces) + +(defface transient-nonstandard-key + `((t :box ( :line-width ,(if (>= emacs-major-version 28) (cons -1 -1) -1) + :color "cyan"))) + "Face optionally used to highlight keys conflicting with short-argument. +Also see option `transient-highlight-mismatched-keys'." + :group 'transient-faces) + +(defface transient-mismatched-key + `((t :box ( :line-width ,(if (>= emacs-major-version 28) (cons -1 -1) -1) + :color "magenta"))) + "Face optionally used to highlight keys without a short-argument. +Also see option `transient-highlight-mismatched-keys'." + :group 'transient-faces) + +;;; Persistence + +(defun transient--read-file-contents (file) + (with-demoted-errors "Transient error: %S" + (and (file-exists-p file) + (with-temp-buffer + (insert-file-contents file) + (read (current-buffer)))))) + +(defun transient--pp-to-file (list file) + (make-directory (file-name-directory file) t) + (setq list (cl-sort (copy-sequence list) #'string< :key #'car)) + (with-temp-file file + (let ((print-level nil) + (print-length nil) + (pp-default-function 'pp-28) + (fill-column 999)) + (pp list (current-buffer))))) + +(defvar transient-values + (transient--read-file-contents transient-values-file) + "Values of transient commands. +The value of this variable persists between Emacs sessions +and you usually should not change it manually.") + +(defun transient-save-values () + (transient--pp-to-file transient-values transient-values-file)) + +(defvar transient-levels + (transient--read-file-contents transient-levels-file) + "Levels of transient commands. +The value of this variable persists between Emacs sessions +and you usually should not change it manually.") + +(defun transient-save-levels () + (transient--pp-to-file transient-levels transient-levels-file)) + +(defvar transient-history + (transient--read-file-contents transient-history-file) + "History of transient commands and infix arguments. +The value of this variable persists between Emacs sessions +\(unless `transient-save-history' is nil) and you usually +should not change it manually.") + +(defun transient-save-history () + (setq transient-history + (cl-sort (mapcar (pcase-lambda (`(,key . ,val)) + (cons key (seq-take (delete-dups val) + transient-history-limit))) + transient-history) + #'string< :key #'car)) + (transient--pp-to-file transient-history transient-history-file)) + +(defun transient-maybe-save-history () + "Save the value of `transient-history'. +If `transient-save-history' is nil, then do nothing." + (when transient-save-history + (transient-save-history))) + +(unless noninteractive + (add-hook 'kill-emacs-hook #'transient-maybe-save-history)) + +;;; Classes +;;;; Prefix + +(defclass transient-prefix () + ((prototype :initarg :prototype) + (command :initarg :command) + (level :initarg :level) + (variable :initarg :variable :initform nil) + (init-value :initarg :init-value) + (value) (default-value :initarg :value) + (scope :initarg :scope :initform nil) + (history :initarg :history :initform nil) + (history-pos :initarg :history-pos :initform 0) + (history-key :initarg :history-key :initform nil) + (show-help :initarg :show-help :initform nil) + (info-manual :initarg :info-manual :initform nil) + (man-page :initarg :man-page :initform nil) + (transient-suffix :initarg :transient-suffix :initform nil) + (transient-non-suffix :initarg :transient-non-suffix :initform nil) + (transient-switch-frame :initarg :transient-switch-frame) + (refresh-suffixes :initarg :refresh-suffixes :initform nil) + (incompatible :initarg :incompatible :initform nil) + (suffix-description :initarg :suffix-description) + (variable-pitch :initarg :variable-pitch :initform nil) + (column-widths :initarg :column-widths :initform nil) + (unwind-suffix :documentation "Internal use." :initform nil)) + "Transient prefix command. + +Each transient prefix command consists of a command, which is +stored in a symbol's function slot and an object, which is +stored in the `transient--prefix' property of the same symbol. + +When a transient prefix command is invoked, then a clone of that +object is stored in the global variable `transient--prefix' and +the prototype is stored in the clone's `prototype' slot.") + +;;;; Suffix + +(defclass transient-child () + ((level + :initarg :level + :initform (symbol-value 'transient--default-child-level) + :documentation "Enable if level of prefix is equal or greater.") + (if + :initarg :if + :initform nil + :documentation "Enable if predicate returns non-nil.") + (if-not + :initarg :if-not + :initform nil + :documentation "Enable if predicate returns nil.") + (if-non-nil + :initarg :if-non-nil + :initform nil + :documentation "Enable if variable's value is non-nil.") + (if-nil + :initarg :if-nil + :initform nil + :documentation "Enable if variable's value is nil.") + (if-mode + :initarg :if-mode + :initform nil + :documentation "Enable if major-mode matches value.") + (if-not-mode + :initarg :if-not-mode + :initform nil + :documentation "Enable if major-mode does not match value.") + (if-derived + :initarg :if-derived + :initform nil + :documentation "Enable if major-mode derives from value.") + (if-not-derived + :initarg :if-not-derived + :initform nil + :documentation "Enable if major-mode does not derive from value.") + (inapt + :initform nil) + (inapt-face + :initarg :inapt-face + :initform 'transient-inapt-suffix) + (inapt-if + :initarg :inapt-if + :initform nil + :documentation "Inapt if predicate returns non-nil.") + (inapt-if-not + :initarg :inapt-if-not + :initform nil + :documentation "Inapt if predicate returns nil.") + (inapt-if-non-nil + :initarg :inapt-if-non-nil + :initform nil + :documentation "Inapt if variable's value is non-nil.") + (inapt-if-nil + :initarg :inapt-if-nil + :initform nil + :documentation "Inapt if variable's value is nil.") + (inapt-if-mode + :initarg :inapt-if-mode + :initform nil + :documentation "Inapt if major-mode matches value.") + (inapt-if-not-mode + :initarg :inapt-if-not-mode + :initform nil + :documentation "Inapt if major-mode does not match value.") + (inapt-if-derived + :initarg :inapt-if-derived + :initform nil + :documentation "Inapt if major-mode derives from value.") + (inapt-if-not-derived + :initarg :inapt-if-not-derived + :initform nil + :documentation "Inapt if major-mode does not derive from value.")) + "Abstract superclass for group and suffix classes. + +It is undefined what happens if more than one `if*' predicate +slot is non-nil." + :abstract t) + +(defclass transient-suffix (transient-child) + ((definition :allocation :class :initform nil) + (key :initarg :key) + (command :initarg :command) + (transient :initarg :transient) + (format :initarg :format :initform " %k %d") + (description :initarg :description :initform nil) + (face :initarg :face :initform nil) + (show-help :initarg :show-help :initform nil)) + "Superclass for suffix command.") + +(defclass transient-information (transient-suffix) + ((format :initform " %k %d") + (key :initform " ")) + "Display-only information, aligned with suffix keys. +Technically a suffix object with no associated command.") + +(defclass transient-information* (transient-information) + ((format :initform " %d")) + "Display-only information, aligned with suffix descriptions. +Technically a suffix object with no associated command.") + +(defclass transient-infix (transient-suffix) + ((transient :initform t) + (argument :initarg :argument) + (shortarg :initarg :shortarg) + (value :initform nil) + (init-value :initarg :init-value) + (unsavable :initarg :unsavable :initform nil) + (multi-value :initarg :multi-value :initform nil) + (always-read :initarg :always-read :initform nil) + (allow-empty :initarg :allow-empty :initform nil) + (history-key :initarg :history-key :initform nil) + (reader :initarg :reader :initform nil) + (prompt :initarg :prompt :initform nil) + (choices :initarg :choices :initform nil) + (format :initform " %k %d (%v)")) + "Transient infix command." + :abstract t) + +(defclass transient-argument (transient-infix) () + "Abstract superclass for infix arguments." + :abstract t) + +(defclass transient-switch (transient-argument) () + "Class used for command-line argument that can be turned on and off.") + +(defclass transient-option (transient-argument) () + "Class used for command-line argument that can take a value.") + +(defclass transient-variable (transient-infix) + ((variable :initarg :variable) + (format :initform " %k %d %v")) + "Abstract superclass for infix commands that set a variable." + :abstract t) + +(defclass transient-switches (transient-argument) + ((argument-format :initarg :argument-format) + (argument-regexp :initarg :argument-regexp)) + "Class used for sets of mutually exclusive command-line switches.") + +(defclass transient-files (transient-option) () + ((key :initform "--") + (argument :initform "--") + (multi-value :initform rest) + (reader :initform transient-read-files)) + "Class used for the \"--\" argument or similar. +All remaining arguments are treated as files. +They become the value of this argument.") + +(defclass transient-value-preset (transient-suffix) + ((transient :initform t) + (set :initarg := :initform nil)) + "Class used by the `transient-preset' suffix command.") + +;;;; Group + +(defclass transient-group (transient-child) + ((suffixes :initarg :suffixes :initform nil) + (hide :initarg :hide :initform nil) + (description :initarg :description :initform nil) + (pad-keys :initarg :pad-keys :initform nil) + (info-format :initarg :info-format :initform nil) + (setup-children :initarg :setup-children)) + "Abstract superclass of all group classes." + :abstract t) + +(defclass transient-column (transient-group) () + "Group class that displays each element on a separate line.") + +(defclass transient-row (transient-group) () + "Group class that displays all elements on a single line.") + +(defclass transient-columns (transient-group) () + "Group class that displays elements organized in columns. +Direct elements have to be groups whose elements have to be +commands or strings. Each subgroup represents a column. +This class takes care of inserting the subgroups' elements.") + +(defclass transient-subgroups (transient-group) () + "Group class that wraps other groups. + +Direct elements have to be groups whose elements have to be +commands or strings. This group inserts an empty line between +subgroups. The subgroups are responsible for displaying their +elements themselves.") + +;;; Define + +(defmacro transient-define-prefix (name arglist &rest args) + "Define NAME as a transient prefix command. + +ARGLIST are the arguments that command takes. +DOCSTRING is the documentation string and is optional. + +These arguments can optionally be followed by key-value pairs. +Each key has to be a keyword symbol, either `:class' or a keyword +argument supported by the constructor of that class. The +`transient-prefix' class is used if the class is not specified +explicitly. + +GROUPs add key bindings for infix and suffix commands and specify +how these bindings are presented in the popup buffer. At least +one GROUP has to be specified. See info node `(transient)Binding +Suffix and Infix Commands'. + +The BODY is optional. If it is omitted, then ARGLIST is also +ignored and the function definition becomes: + + (lambda () + (interactive) + (transient-setup \\='NAME)) + +If BODY is specified, then it must begin with an `interactive' +form that matches ARGLIST, and it must call `transient-setup'. +It may however call that function only when some condition is +satisfied; that is one of the reason why you might want to use +an explicit BODY. + +All transients have a (possibly nil) value, which is exported +when suffix commands are called, so that they can consume that +value. For some transients it might be necessary to have a sort +of secondary value, called a scope. Such a scope would usually +be set in the commands `interactive' form and has to be passed +to the setup function: + + (transient-setup \\='NAME nil nil :scope SCOPE) + +\(fn NAME ARGLIST [DOCSTRING] [KEYWORD VALUE]... GROUP... [BODY...])" + (declare (debug ( &define name lambda-list + [&optional lambda-doc] + [&rest keywordp sexp] + [&rest vectorp] + [&optional ("interactive" interactive) def-body])) + (indent defun) + (doc-string 3)) + (pcase-let + ((`(,class ,slots ,suffixes ,docstr ,body ,interactive-only) + (transient--expand-define-args args arglist 'transient-define-prefix))) + `(progn + (defalias ',name + ,(if body + `(lambda ,arglist ,@body) + `(lambda () + (interactive) + (transient-setup ',name)))) + (put ',name 'interactive-only ,interactive-only) + (put ',name 'function-documentation ,docstr) + (put ',name 'transient--prefix + (,(or class 'transient-prefix) :command ',name ,@slots)) + (put ',name 'transient--layout + (list ,@(cl-mapcan (lambda (s) (transient--parse-child name s)) + suffixes)))))) + +(defmacro transient-define-suffix (name arglist &rest args) + "Define NAME as a transient suffix command. + +ARGLIST are the arguments that the command takes. +DOCSTRING is the documentation string and is optional. + +These arguments can optionally be followed by key-value pairs. +Each key has to be a keyword symbol, either `:class' or a +keyword argument supported by the constructor of that class. +The `transient-suffix' class is used if the class is not +specified explicitly. + +The BODY must begin with an `interactive' form that matches +ARGLIST. The infix arguments are usually accessed by using +`transient-args' inside `interactive'. + +\(fn NAME ARGLIST [DOCSTRING] [KEYWORD VALUE]... [BODY...])" + (declare (debug ( &define name lambda-list + [&optional lambda-doc] + [&rest keywordp sexp] + [&optional ("interactive" interactive) def-body])) + (indent defun) + (doc-string 3)) + (pcase-let + ((`(,class ,slots ,_ ,docstr ,body ,interactive-only) + (transient--expand-define-args args arglist 'transient-define-suffix))) + `(progn + (defalias ',name + ,(if (and (not body) class (oref-default class definition)) + `(oref-default ',class definition) + `(lambda ,arglist ,@body))) + (put ',name 'interactive-only ,interactive-only) + (put ',name 'function-documentation ,docstr) + (put ',name 'transient--suffix + (,(or class 'transient-suffix) :command ',name ,@slots))))) + +(defmacro transient-augment-suffix (name &rest args) + "Augment existing command NAME with a new transient suffix object. +Similar to `transient-define-suffix' but define a suffix object only. +\n\(fn NAME [KEYWORD VALUE]...)" + (declare (debug (&define name [&rest keywordp sexp])) + (indent defun)) + (pcase-let + ((`(,class ,slots) + (transient--expand-define-args args nil 'transient-augment-suffix t))) + `(put ',name 'transient--suffix + (,(or class 'transient-suffix) :command ',name ,@slots)))) + +(defmacro transient-define-infix (name arglist &rest args) + "Define NAME as a transient infix command. + +ARGLIST is always ignored and reserved for future use. +DOCSTRING is the documentation string and is optional. + +At least one key-value pair is required. All transient infix +commands are equal to each other (but not eq). It is meaning- +less to define an infix command, without providing at least one +keyword argument (usually `:argument' or `:variable', depending +on the class). The suffix class defaults to `transient-switch' +and can be set using the `:class' keyword. + +The function definitions is always: + + (lambda () + (interactive) + (let ((obj (transient-suffix-object))) + (transient-infix-set obj (transient-infix-read obj))) + (transient--show)) + +`transient-infix-read' and `transient-infix-set' are generic +functions. Different infix commands behave differently because +the concrete methods are different for different infix command +classes. In rare case the above command function might not be +suitable, even if you define your own infix command class. In +that case you have to use `transient-define-suffix' to define +the infix command and use t as the value of the `:transient' +keyword. + +\(fn NAME ARGLIST [DOCSTRING] KEYWORD VALUE [KEYWORD VALUE]...)" + (declare (debug ( &define name lambda-list + [&optional lambda-doc] + keywordp sexp + [&rest keywordp sexp])) + (indent defun) + (doc-string 3)) + (pcase-let + ((`(,class ,slots ,_ ,docstr ,_ ,interactive-only) + (transient--expand-define-args args arglist 'transient-define-infix t))) + `(progn + (defalias ',name #'transient--default-infix-command) + (put ',name 'interactive-only ,interactive-only) + (put ',name 'completion-predicate #'transient--suffix-only) + (put ',name 'function-documentation ,docstr) + (put ',name 'transient--suffix + (,(or class 'transient-switch) :command ',name ,@slots))))) + +(defalias 'transient-define-argument #'transient-define-infix + "Define NAME as a transient infix command. + +Only use this alias to define an infix command that actually +sets an infix argument. To define a infix command that, for +example, sets a variable, use `transient-define-infix' instead. + +\(fn NAME ARGLIST [DOCSTRING] [KEYWORD VALUE]...)") + +(defun transient--default-infix-command () + ;; Most infix commands are but an alias for this command. + "Cannot show any documentation for this transient infix command. + +When you request help for an infix command using `transient-help', that +usually shows the respective man-page and tries to jump to the location +where the respective argument is being described. + +If no man-page is specified for the containing transient menu, then the +docstring is displayed instead, if any. + +If the infix command doesn't have a docstring, as is the case here, then +this docstring is displayed instead, because technically infix commands +are aliases for `transient--default-infix-command'. + +`describe-function' also shows the docstring of the infix command, +falling back to that of the same aliased command." + (interactive) + (let ((obj (transient-suffix-object))) + (transient-infix-set obj (transient-infix-read obj))) + (transient--show)) +(put 'transient--default-infix-command 'interactive-only t) +(put 'transient--default-infix-command 'completion-predicate + #'transient--suffix-only) + +(define-advice find-function-advised-original + (:around (fn func) transient-default-infix) + "Return nil instead of `transient--default-infix-command'. +When using `find-function' to jump to the definition of a transient +infix command/argument, then we want to actually jump to that, not to +the definition of `transient--default-infix-command', which all infix +commands are aliases for." + (let ((val (funcall fn func))) + (and val (not (eq val 'transient--default-infix-command)) val))) + +(eval-and-compile ;transient--expand-define-args + (defun transient--expand-define-args (args &optional arglist form nobody) + ;; ARGLIST and FORM are only optional for backward compatibility. + ;; This is necessary because "emoji.el" from Emacs 29 calls this + ;; function directly, with just one argument. + (unless (listp arglist) + (error "Mandatory ARGLIST is missing")) + (let (class keys suffixes docstr declare (interactive-only t)) + (when (stringp (car args)) + (setq docstr (pop args))) + (while (keywordp (car args)) + (let ((k (pop args)) + (v (pop args))) + (if (eq k :class) + (setq class v) + (push k keys) + (push v keys)))) + (while (let ((arg (car args))) + (or (vectorp arg) + (and arg (symbolp arg)))) + (push (pop args) suffixes)) + (when (eq (car-safe (car args)) 'declare) + (setq declare (car args)) + (setq args (cdr args)) + (when-let ((int (assq 'interactive-only declare))) + (setq interactive-only (cadr int)) + (delq int declare)) + (unless (cdr declare) + (setq declare nil))) + (cond + ((not args)) + (nobody + (error "%s: No function body allowed" form)) + ((not (eq (car-safe (nth (if declare 1 0) args)) 'interactive)) + (error "%s: Interactive form missing" form))) + (list (if (eq (car-safe class) 'quote) + (cadr class) + class) + (nreverse keys) + (nreverse suffixes) + docstr + (if declare (cons declare args) args) + interactive-only)))) + +(defun transient--parse-child (prefix spec) + (cl-typecase spec + (null (error "Invalid transient--parse-child spec: %s" spec)) + (symbol (let ((value (symbol-value spec))) + (if (and (listp value) + (or (listp (car value)) + (vectorp (car value)))) + (cl-mapcan (lambda (s) (transient--parse-child prefix s)) value) + (transient--parse-child prefix value)))) + (vector (and-let* ((c (transient--parse-group prefix spec))) (list c))) + (list (and-let* ((c (transient--parse-suffix prefix spec))) (list c))) + (string (list spec)) + (t (error "Invalid transient--parse-child spec: %s" spec)))) + +(defun transient--parse-group (prefix spec) + (setq spec (append spec nil)) + (cl-symbol-macrolet + ((car (car spec)) + (pop (pop spec))) + (let (level class args) + (when (integerp car) + (setq level pop)) + (when (stringp car) + (setq args (plist-put args :description pop))) + (while (keywordp car) + (let ((key pop) + (val pop)) + (cond ((eq key :class) + (setq class (macroexp-quote val))) + ((or (symbolp val) + (and (listp val) (not (eq (car val) 'lambda)))) + (setq args (plist-put args key (macroexp-quote val)))) + ((setq args (plist-put args key val)))))) + (unless (or spec class (not (plist-get args :setup-children))) + (message "WARNING: %s: When %s is used, %s must also be specified" + 'transient-define-prefix :setup-children :class)) + (list 'vector + (or level transient--default-child-level) + (cond (class) + ((or (vectorp car) + (and car (symbolp car))) + (quote 'transient-columns)) + ((quote 'transient-column))) + (and args (cons 'list args)) + (cons 'list + (cl-mapcan (lambda (s) (transient--parse-child prefix s)) + spec)))))) + +(defun transient--parse-suffix (prefix spec) + (let (level class args) + (cl-symbol-macrolet + ((car (car spec)) + (pop (pop spec))) + (when (integerp car) + (setq level pop)) + (when (or (stringp car) + (vectorp car)) + (setq args (plist-put args :key pop))) + (cond + ((or (stringp car) + (and (eq (car-safe car) 'lambda) + (not (commandp car)))) + (setq args (plist-put args :description pop))) + ((and (symbolp car) + (not (keywordp car)) + (not (commandp car)) + (commandp (cadr spec))) + (setq args (plist-put args :description (macroexp-quote pop))))) + (cond + ((memq car '(:info :info*))) + ((keywordp car) + (error "Need command, `:info' or `:info*', got `%s'" car)) + ((symbolp car) + (setq args (plist-put args :command (macroexp-quote pop)))) + ((and (commandp car) + (not (stringp car))) + (let ((cmd pop) + (sym (intern + (format "transient:%s:%s" + prefix + (let ((desc (plist-get args :description))) + (if (and (stringp desc) + (length< desc 16)) + desc + (plist-get args :key))))))) + (setq args (plist-put + args :command + `(prog1 ',sym + (put ',sym 'interactive-only t) + (put ',sym 'completion-predicate #'transient--suffix-only) + (defalias ',sym + ,(if (eq (car-safe cmd) 'lambda) + cmd + (macroexp-quote cmd)))))))) + ((or (stringp car) + (and car (listp car))) + (let ((arg pop) + (sym nil)) + (cl-typecase arg + (list + (setq args (plist-put args :shortarg (car arg))) + (setq args (plist-put args :argument (cadr arg))) + (setq arg (cadr arg))) + (string + (when-let ((shortarg (transient--derive-shortarg arg))) + (setq args (plist-put args :shortarg shortarg))) + (setq args (plist-put args :argument arg)))) + (setq sym (intern (format "transient:%s:%s" prefix arg))) + (setq args (plist-put + args :command + `(prog1 ',sym + (put ',sym 'interactive-only t) + (put ',sym 'completion-predicate #'transient--suffix-only) + (defalias ',sym #'transient--default-infix-command)))) + (cond ((and car (not (keywordp car))) + (setq class 'transient-option) + (setq args (plist-put args :reader (macroexp-quote pop)))) + ((not (string-suffix-p "=" arg)) + (setq class 'transient-switch)) + (t + (setq class 'transient-option))))) + (t + (error "Needed command or argument, got %S" car))) + (while (keywordp car) + (let ((key pop) + (val pop)) + (cond ((eq key :class) (setq class val)) + ((eq key :level) (setq level val)) + ((eq key :info) + (setq class 'transient-information) + (setq args (plist-put args :description val))) + ((eq key :info*) + (setq class 'transient-information*) + (setq args (plist-put args :description val))) + ((eq (car-safe val) '\,) + (setq args (plist-put args key (cadr val)))) + ((or (symbolp val) + (and (listp val) (not (eq (car val) 'lambda)))) + (setq args (plist-put args key (macroexp-quote val)))) + ((setq args (plist-put args key val))))))) + (unless (plist-get args :key) + (when-let ((shortarg (plist-get args :shortarg))) + (setq args (plist-put args :key shortarg)))) + (list 'list + (or level transient--default-child-level) + (macroexp-quote (or class 'transient-suffix)) + (cons 'list args)))) + +(defun transient--derive-shortarg (arg) + (save-match-data + (and (string-match "\\`\\(-[a-zA-Z]\\)\\(\\'\\|=\\)" arg) + (match-string 1 arg)))) + +(defun transient-command-completion-not-suffix-only-p (symbol _buffer) + "Say whether SYMBOL should be offered as a completion. +If the value of SYMBOL's `completion-predicate' property is +`transient--suffix-only', then return nil, otherwise return t. +This is the case when a command should only ever be used as a +suffix of a transient prefix command (as opposed to bindings +in regular keymaps or by using `execute-extended-command')." + (not (eq (get symbol 'completion-predicate) 'transient--suffix-only))) + +(defalias 'transient--suffix-only #'ignore + "Ignore ARGUMENTS, do nothing, and return nil. +Also see `transient-command-completion-not-suffix-only-p'. +Only use this alias as the value of the `completion-predicate' +symbol property.") + +(when (and (boundp 'read-extended-command-predicate) ; since Emacs 28.1 + (not read-extended-command-predicate)) + (setq read-extended-command-predicate + #'transient-command-completion-not-suffix-only-p)) + +(defun transient-parse-suffix (prefix suffix) + "Parse SUFFIX, to be added to PREFIX. +PREFIX is a prefix command, a symbol. +SUFFIX is a suffix command or a group specification (of + the same forms as expected by `transient-define-prefix'). +Intended for use in a group's `:setup-children' function." + (cl-assert (and prefix (symbolp prefix))) + (eval (car (transient--parse-child prefix suffix)) t)) + +(defun transient-parse-suffixes (prefix suffixes) + "Parse SUFFIXES, to be added to PREFIX. +PREFIX is a prefix command, a symbol. +SUFFIXES is a list of suffix command or a group specification + (of the same forms as expected by `transient-define-prefix'). +Intended for use in a group's `:setup-children' function." + (cl-assert (and prefix (symbolp prefix))) + (mapcar (apply-partially #'transient-parse-suffix prefix) suffixes)) + +;;; Edit + +(defun transient--insert-suffix (prefix loc suffix action &optional keep-other) + (let* ((suf (cl-etypecase suffix + (vector (transient--parse-group prefix suffix)) + (list (transient--parse-suffix prefix suffix)) + (string suffix))) + (mem (transient--layout-member loc prefix)) + (elt (car mem))) + (setq suf (eval suf t)) + (cond + ((not mem) + (message "Cannot insert %S into %s; %s not found" + suffix prefix loc)) + ((or (and (vectorp suffix) (not (vectorp elt))) + (and (listp suffix) (vectorp elt)) + (and (stringp suffix) (vectorp elt))) + (message "Cannot place %S into %s at %s; %s" + suffix prefix loc + "suffixes and groups cannot be siblings")) + (t + (when-let* ((bindingp (listp suf)) + (key (transient--spec-key suf)) + (conflict (car (transient--layout-member key prefix))) + (conflictp + (and (not (and (eq action 'replace) + (eq conflict elt))) + (or (not keep-other) + (eq (plist-get (nth 2 suf) :command) + (plist-get (nth 2 conflict) :command))) + (equal (transient--suffix-predicate suf) + (transient--suffix-predicate conflict))))) + (transient-remove-suffix prefix key)) + (pcase-exhaustive action + ('insert (setcdr mem (cons elt (cdr mem))) + (setcar mem suf)) + ('append (setcdr mem (cons suf (cdr mem)))) + ('replace (setcar mem suf))))))) + +;;;###autoload +(defun transient-insert-suffix (prefix loc suffix &optional keep-other) + "Insert a SUFFIX into PREFIX before LOC. +PREFIX is a prefix command, a symbol. +SUFFIX is a suffix command or a group specification (of + the same forms as expected by `transient-define-prefix'). +LOC is a command, a key vector, a key description (a string + as returned by `key-description'), or a coordination list + (whose last element may also be a command or key). +Remove a conflicting binding unless optional KEEP-OTHER is + non-nil. +See info node `(transient)Modifying Existing Transients'." + (declare (indent defun)) + (transient--insert-suffix prefix loc suffix 'insert keep-other)) + +;;;###autoload +(defun transient-append-suffix (prefix loc suffix &optional keep-other) + "Insert a SUFFIX into PREFIX after LOC. +PREFIX is a prefix command, a symbol. +SUFFIX is a suffix command or a group specification (of + the same forms as expected by `transient-define-prefix'). +LOC is a command, a key vector, a key description (a string + as returned by `key-description'), or a coordination list + (whose last element may also be a command or key). +Remove a conflicting binding unless optional KEEP-OTHER is + non-nil. +See info node `(transient)Modifying Existing Transients'." + (declare (indent defun)) + (transient--insert-suffix prefix loc suffix 'append keep-other)) + +;;;###autoload +(defun transient-replace-suffix (prefix loc suffix) + "Replace the suffix at LOC in PREFIX with SUFFIX. +PREFIX is a prefix command, a symbol. +SUFFIX is a suffix command or a group specification (of + the same forms as expected by `transient-define-prefix'). +LOC is a command, a key vector, a key description (a string + as returned by `key-description'), or a coordination list + (whose last element may also be a command or key). +See info node `(transient)Modifying Existing Transients'." + (declare (indent defun)) + (transient--insert-suffix prefix loc suffix 'replace)) + +;;;###autoload +(defun transient-remove-suffix (prefix loc) + "Remove the suffix or group at LOC in PREFIX. +PREFIX is a prefix command, a symbol. +LOC is a command, a key vector, a key description (a string + as returned by `key-description'), or a coordination list + (whose last element may also be a command or key). +See info node `(transient)Modifying Existing Transients'." + (declare (indent defun)) + (transient--layout-member loc prefix 'remove)) + +(defun transient-get-suffix (prefix loc) + "Return the suffix or group at LOC in PREFIX. +PREFIX is a prefix command, a symbol. +LOC is a command, a key vector, a key description (a string + as returned by `key-description'), or a coordination list + (whose last element may also be a command or key). +See info node `(transient)Modifying Existing Transients'." + (if-let ((mem (transient--layout-member loc prefix))) + (car mem) + (error "%s not found in %s" loc prefix))) + +(defun transient-suffix-put (prefix loc prop value) + "Edit the suffix at LOC in PREFIX, setting PROP to VALUE. +PREFIX is a prefix command, a symbol. +SUFFIX is a suffix command or a group specification (of + the same forms as expected by `transient-define-prefix'). +LOC is a command, a key vector, a key description (a string + as returned by `key-description'), or a coordination list + (whose last element may also be a command or key). +See info node `(transient)Modifying Existing Transients'." + (let ((suf (transient-get-suffix prefix loc))) + (setf (elt suf 2) + (plist-put (elt suf 2) prop value)))) + +(defun transient--layout-member (loc prefix &optional remove) + (let ((val (or (get prefix 'transient--layout) + (error "%s is not a transient command" prefix)))) + (when (listp loc) + (while (integerp (car loc)) + (let* ((children (if (vectorp val) (aref val 3) val)) + (mem (transient--nthcdr (pop loc) children))) + (if (and remove (not loc)) + (let ((rest (delq (car mem) children))) + (if (vectorp val) + (aset val 3 rest) + (put prefix 'transient--layout rest)) + (setq val nil)) + (setq val (if loc (car mem) mem))))) + (setq loc (car loc))) + (if loc + (transient--layout-member-1 (transient--kbd loc) val remove) + val))) + +(defun transient--layout-member-1 (loc layout remove) + (cond ((listp layout) + (seq-some (lambda (elt) (transient--layout-member-1 loc elt remove)) + layout)) + ((vectorp (car (aref layout 3))) + (seq-some (lambda (elt) (transient--layout-member-1 loc elt remove)) + (aref layout 3))) + (remove + (aset layout 3 + (delq (car (transient--group-member loc layout)) + (aref layout 3))) + nil) + ((transient--group-member loc layout)))) + +(defun transient--group-member (loc group) + (cl-member-if (lambda (suffix) + (and (listp suffix) + (let* ((def (nth 2 suffix)) + (cmd (plist-get def :command))) + (if (symbolp loc) + (eq cmd loc) + (equal (transient--kbd + (or (plist-get def :key) + (transient--command-key cmd))) + loc))))) + (aref group 3))) + +(defun transient--kbd (keys) + (when (vectorp keys) + (setq keys (key-description keys))) + (when (stringp keys) + (setq keys (kbd keys))) + keys) + +(defun transient--spec-key (spec) + (let ((plist (nth 2 spec))) + (or (plist-get plist :key) + (transient--command-key + (plist-get plist :command))))) + +(defun transient--command-key (cmd) + (and-let* ((obj (transient--suffix-prototype cmd))) + (cond ((slot-boundp obj 'key) + (oref obj key)) + ((slot-exists-p obj 'shortarg) + (if (slot-boundp obj 'shortarg) + (oref obj shortarg) + (transient--derive-shortarg (oref obj argument))))))) + +(defun transient--nthcdr (n list) + (nthcdr (if (< n 0) (- (length list) (abs n)) n) list)) + +;;; Variables + +(defvar transient-current-prefix nil + "The transient from which this suffix command was invoked. +This is an object representing that transient, use +`transient-current-command' to get the respective command.") + +(defvar transient-current-command nil + "The transient from which this suffix command was invoked. +This is a symbol representing that transient, use +`transient-current-prefix' to get the respective object.") + +(defvar transient-current-suffixes nil + "The suffixes of the transient from which this suffix command was invoked. +This is a list of objects. Usually it is sufficient to instead +use the function `transient-args', which returns a list of +values. In complex cases it might be necessary to use this +variable instead.") + +(defvar transient-exit-hook nil + "Hook run after exiting a transient.") + +(defvar transient-setup-buffer-hook nil + "Hook run when setting up the transient buffer. +That buffer is current and empty when this hook runs.") + +(defvar transient--prefix nil) +(defvar transient--layout nil) +(defvar transient--suffixes nil) + +(defconst transient--stay t "Do not exit the transient.") +(defconst transient--exit nil "Do exit the transient.") + +(defvar transient--exitp nil "Whether to exit the transient.") +(defvar transient--showp nil "Whether to show the transient popup buffer.") +(defvar transient--helpp nil "Whether help-mode is active.") +(defvar transient--editp nil "Whether edit-mode is active.") + +(defvar transient--refreshp nil + "Whether to refresh the transient completely.") + +(defvar transient--all-levels-p nil + "Whether temporary display of suffixes on all levels is active.") + +(defvar transient--timer nil) + +(defvar transient--stack nil) + +(defvar transient--minibuffer-depth 0) + +(defvar transient--buffer-name " *transient*" + "Name of the transient buffer.") + +(defvar transient--buffer nil + "The transient menu buffer.") + +(defvar transient--window nil + "The window used to display the transient popup buffer.") + +(defvar transient--original-window nil + "The window that was selected before the transient was invoked. +Usually it remains selected while the transient is active.") + +(defvar transient--original-buffer nil + "The buffer that was current before the transient was invoked. +Usually it remains current while the transient is active.") + +(defvar transient--restore-winconf nil + "Window configuration to restore after exiting help.") + +(defvar transient--shadowed-buffer nil + "The buffer that is temporarily shadowed by the transient buffer. +This is bound while the suffix predicate is being evaluated and while +drawing in the transient buffer.") + +(defvar transient--pending-suffix nil + "The suffix that is currently being processed. +This is bound while the suffix predicate is being evaluated, +and while functions that return faces are being evaluated.") + +(defvar transient--pending-group nil + "The group that is currently being processed. +This is bound while the suffixes are drawn in the transient buffer.") + +(defvar transient--debug nil + "Whether to put debug information into *Messages*.") + +(defvar transient--history nil) + +(defvar transient--scroll-commands + '(transient-scroll-up + transient-scroll-down + mwheel-scroll + scroll-bar-toolkit-scroll)) + +;;; Identities + +(defun transient-prefix-object () + "Return the current prefix as an object. + +While a transient is being setup or refreshed (which involves +preparing its suffixes) the variable `transient--prefix' can be +used to access the prefix object. Thus this is what has to be +used in suffix methods such as `transient-format-description', +and in object-specific functions that are stored in suffix slots +such as `description'. + +When a suffix command is invoked (i.e., in its `interactive' form +and function body) then the variable `transient-current-prefix' +has to be used instead. + +Two distinct variables are needed, because any prefix may itself +be used as a suffix of another prefix, and such sub-prefixes have +to be able to tell themselves apart from the prefix they were +invoked from. + +Regular suffix commands, which are not prefixes, do not have to +concern themselves with this distinction, so they can use this +function instead. In the context of a plain suffix, it always +returns the value of the appropriate variable." + (or transient--prefix transient-current-prefix)) + +(defun transient-suffix-object (&optional command) + "Return the object associated with the current suffix command. + +Each suffix commands is associated with an object, which holds +additional information about the suffix, such as its value (in +the case of an infix command, which is a kind of suffix command). + +This function is intended to be called by infix commands, which +are usually aliases of `transient--default-infix-command', which +is defined like this: + + (defun transient--default-infix-command () + (interactive) + (let ((obj (transient-suffix-object))) + (transient-infix-set obj (transient-infix-read obj))) + (transient--show)) + +\(User input is read outside of `interactive' to prevent the +command from being added to `command-history'. See #23.) + +Such commands need to be able to access their associated object +to guide how `transient-infix-read' reads the new value and to +store the read value. Other suffix commands (including non-infix +commands) may also need the object to guide their behavior. + +This function attempts to return the object associated with the +current suffix command even if the suffix command was not invoked +from a transient. (For some suffix command that is a valid thing +to do, for others it is not.) In that case nil may be returned, +if the command was not defined using one of the macros intended +to define such commands. + +The optional argument COMMAND is intended for internal use. If +you are contemplating using it in your own code, then you should +probably use this instead: + + (get COMMAND \\='transient--suffix)" + (when command + (cl-check-type command command)) + (cond + (transient--pending-suffix) + ((or transient--prefix + transient-current-prefix) + (let ((suffixes + (cl-remove-if-not + (lambda (obj) + (eq (oref obj command) + (or command + (if (eq this-command 'transient-set-level) + ;; This is how it can look up for which + ;; command it is setting the level. + this-original-command + this-command)))) + (or transient--suffixes + transient-current-suffixes)))) + (or (and (cdr suffixes) + (cl-find-if + (lambda (obj) + (equal (listify-key-sequence (transient--kbd (oref obj key))) + (listify-key-sequence (this-command-keys)))) + suffixes)) + (car suffixes)))) + ((and-let* ((obj (transient--suffix-prototype (or command this-command))) + (obj (clone obj))) + (progn ; work around debbugs#31840 + (transient-init-scope obj) + (transient-init-value obj) + obj))))) + +(defun transient--suffix-prototype (command) + (or (get command 'transient--suffix) + (seq-some (lambda (cmd) (get cmd 'transient--suffix)) + (function-alias-p command)))) + +;;; Keymaps + +(defvar-keymap transient-base-map + :doc "Parent of other keymaps used by Transient. + +This is the parent keymap of all the keymaps that are used in +all transients: `transient-map' (which in turn is the parent +of the transient-specific keymaps), `transient-edit-map' and +`transient-sticky-map'. + +If you change a binding here, then you might also have to edit +`transient-sticky-map' and `transient-common-commands'. While +the latter isn't a proper transient prefix command, it can be +edited using the same functions as used for transients. + +If you add a new command here, then you must also add a binding +to `transient-predicate-map'." + "ESC ESC ESC" #'transient-quit-all + "C-g" #'transient-quit-one + "C-q" #'transient-quit-all + "C-z" #'transient-suspend + "C-v" #'transient-scroll-up + "C-M-v" #'transient-scroll-down + "<next>" #'transient-scroll-up + "<prior>" #'transient-scroll-down) + +(defvar-keymap transient-map + :doc "Top-level keymap used by all transients. + +If you add a new command here, then you must also add a binding +to `transient-predicate-map'. Also see `transient-base-map'." + :parent transient-base-map + "C-u" #'universal-argument + "C--" #'negative-argument + "C-t" #'transient-show + "?" #'transient-help + "C-h" #'transient-help + ;; Also bound to "C-x p" and "C-x n" in transient-common-commands. + "C-M-p" #'transient-history-prev + "C-M-n" #'transient-history-next) + +(defvar-keymap transient-edit-map + :doc "Keymap that is active while a transient in is in \"edit mode\"." + :parent transient-base-map + "?" #'transient-help + "C-h" #'transient-help + "C-x l" #'transient-set-level) + +(defvar-keymap transient-sticky-map + :doc "Keymap that is active while an incomplete key sequence is active." + :parent transient-base-map + "C-g" #'transient-quit-seq) + +(defvar transient--common-command-prefixes '(?\C-x)) + +(put 'transient-common-commands + 'transient--layout + (list + (eval + (car (transient--parse-child + 'transient-common-commands + (vector + :hide + (lambda () + (and (not (memq + (car (bound-and-true-p transient--redisplay-key)) + transient--common-command-prefixes)) + (not transient-show-common-commands))) + (vector + "Value commands" + (list "C-x s " "Set" #'transient-set) + (list "C-x C-s" "Save" #'transient-save) + (list "C-x C-k" "Reset" #'transient-reset) + (list "C-x p " "Previous value" #'transient-history-prev) + (list "C-x n " "Next value" #'transient-history-next)) + (vector + "Sticky commands" + ;; Like `transient-sticky-map' except that + ;; "C-g" has to be bound to a different command. + (list "C-g" "Quit prefix or transient" #'transient-quit-one) + (list "C-q" "Quit transient stack" #'transient-quit-all) + (list "C-z" "Suspend transient stack" #'transient-suspend)) + (vector + "Customize" + (list "C-x t" 'transient-toggle-common :description + (lambda () + (if transient-show-common-commands + "Hide common commands" + "Show common permanently"))) + (list "C-x l" "Show/hide suffixes" #'transient-set-level) + (list "C-x a" #'transient-toggle-level-limit))))) + t))) + +(defvar-keymap transient-popup-navigation-map + :doc "One of the keymaps used when popup navigation is enabled. +See `transient-enable-popup-navigation'." + "<down-mouse-1>" #'transient-noop + "<up>" #'transient-backward-button + "<down>" #'transient-forward-button + "C-r" #'transient-isearch-backward + "C-s" #'transient-isearch-forward + "M-RET" #'transient-push-button) + +(defvar-keymap transient-button-map + :doc "One of the keymaps used when popup navigation is enabled. +See `transient-enable-popup-navigation'." + "<mouse-1>" #'transient-push-button + "<mouse-2>" #'transient-push-button) + +(defvar-keymap transient-resume-mode-map + :doc "Keymap for `transient-resume-mode'. + +This keymap remaps every command that would usually just quit the +documentation buffer to `transient-resume', which additionally +resumes the suspended transient." + "<remap> <Man-quit>" #'transient-resume + "<remap> <Info-exit>" #'transient-resume + "<remap> <quit-window>" #'transient-resume) + +(defvar-keymap transient-predicate-map + :doc "Base keymap used to map common commands to their transient behavior. + +The \"transient behavior\" of a command controls, among other +things, whether invoking the command causes the transient to be +exited or not, and whether infix arguments are exported before +doing so. + +Each \"key\" is a command that is common to all transients and +that is bound in `transient-map', `transient-edit-map', +`transient-sticky-map' and/or `transient-common-command'. + +Each binding is a \"pre-command\", a function that controls the +transient behavior of the respective command. + +For transient commands that are bound in individual transients, +the transient behavior is specified using the `:transient' slot +of the corresponding object." + "<transient-suspend>" #'transient--do-suspend + "<transient-help>" #'transient--do-stay + "<transient-set-level>" #'transient--do-stay + "<transient-history-prev>" #'transient--do-stay + "<transient-history-next>" #'transient--do-stay + "<universal-argument>" #'transient--do-stay + "<universal-argument-more>" #'transient--do-stay + "<negative-argument>" #'transient--do-minus + "<digit-argument>" #'transient--do-stay + "<top-level>" #'transient--do-quit-all + "<transient-quit-all>" #'transient--do-quit-all + "<transient-quit-one>" #'transient--do-quit-one + "<transient-quit-seq>" #'transient--do-stay + "<transient-show>" #'transient--do-stay + "<transient-update>" #'transient--do-stay + "<transient-toggle-common>" #'transient--do-stay + "<transient-set>" #'transient--do-call + "<transient-set-and-exit>" #'transient--do-exit + "<transient-save>" #'transient--do-call + "<transient-save-and-exit>" #'transient--do-exit + "<transient-reset>" #'transient--do-call + "<describe-key-briefly>" #'transient--do-stay + "<describe-key>" #'transient--do-stay + "<transient-scroll-up>" #'transient--do-stay + "<transient-scroll-down>" #'transient--do-stay + "<mwheel-scroll>" #'transient--do-stay + "<scroll-bar-toolkit-scroll>" #'transient--do-stay + "<transient-noop>" #'transient--do-noop + "<transient-mouse-push-button>" #'transient--do-move + "<transient-push-button>" #'transient--do-push-button + "<transient-backward-button>" #'transient--do-move + "<transient-forward-button>" #'transient--do-move + "<transient-isearch-backward>" #'transient--do-move + "<transient-isearch-forward>" #'transient--do-move + ;; If a valid but incomplete prefix sequence is followed by + ;; an unbound key, then Emacs calls the `undefined' command + ;; but does not set `this-command', `this-original-command' + ;; or `real-this-command' accordingly. Instead they are nil. + "<nil>" #'transient--do-warn + ;; Bound to the `mouse-movement' event, this command is similar + ;; to `ignore'. + "<ignore-preserving-kill-region>" #'transient--do-noop) + +(defvar transient--transient-map nil) +(defvar transient--predicate-map nil) +(defvar transient--redisplay-map nil) +(defvar transient--redisplay-key nil) + +(defun transient--push-keymap (var) + (let ((map (symbol-value var))) + (transient--debug " push %s%s" var (if map "" " VOID")) + (when map + (with-demoted-errors "transient--push-keymap: %S" + (internal-push-keymap map 'overriding-terminal-local-map))))) + +(defun transient--pop-keymap (var) + (let ((map (symbol-value var))) + (when map + (transient--debug " pop %s" var) + (with-demoted-errors "transient--pop-keymap: %S" + (internal-pop-keymap map 'overriding-terminal-local-map))))) + +(defun transient--make-transient-map () + (let ((map (make-sparse-keymap))) + (set-keymap-parent map (if transient--editp + transient-edit-map + transient-map)) + (dolist (obj transient--suffixes) + (let ((key (oref obj key))) + (when (vectorp key) + (setq key (key-description key)) + (oset obj key key)) + (when transient-substitute-key-function + (setq key (save-match-data + (funcall transient-substitute-key-function obj))) + (oset obj key key)) + (let* ((kbd (kbd key)) + (cmd (oref obj command)) + (alt (transient--lookup-key map kbd))) + (cond ((not alt) + (define-key map kbd cmd)) + ((eq alt cmd)) + ((transient--inapt-suffix-p obj)) + ((and-let* ((obj (transient-suffix-object alt))) + (transient--inapt-suffix-p obj)) + (define-key map kbd cmd)) + (transient-detect-key-conflicts + (error "Cannot bind %S to %s and also %s" + (string-trim key) cmd alt)) + ((define-key map kbd cmd)))))) + (when-let ((b (keymap-lookup map "-"))) (keymap-set map "<kp-subtract>" b)) + (when-let ((b (keymap-lookup map "="))) (keymap-set map "<kp-equal>" b)) + (when-let ((b (keymap-lookup map "+"))) (keymap-set map "<kp-add>" b)) + (when transient-enable-popup-navigation + ;; `transient--make-redisplay-map' maps only over bindings that are + ;; directly in the base keymap, so that cannot be a composed keymap. + (set-keymap-parent + map (make-composed-keymap + (keymap-parent map) + transient-popup-navigation-map))) + map)) + +(defun transient--make-predicate-map () + (let* ((default (transient--resolve-pre-command + (oref transient--prefix transient-suffix))) + (return (and transient--stack (eq default t))) + (map (make-sparse-keymap))) + (set-keymap-parent map transient-predicate-map) + (when (or (and (slot-boundp transient--prefix 'transient-switch-frame) + (transient--resolve-pre-command + (not (oref transient--prefix transient-switch-frame)))) + (memq (transient--resolve-pre-command + (oref transient--prefix transient-non-suffix)) + '(nil transient--do-warn transient--do-noop))) + (define-key map [handle-switch-frame] #'transient--do-suspend)) + (dolist (obj transient--suffixes) + (let* ((cmd (oref obj command)) + (kind (cond ((get cmd 'transient--prefix) 'prefix) + ((cl-typep obj 'transient-infix) 'infix) + (t 'suffix)))) + (cond + ((oref obj inapt) + (define-key map (vector cmd) #'transient--do-warn-inapt)) + ((slot-boundp obj 'transient) + (define-key map (vector cmd) + (pcase (list kind + (transient--resolve-pre-command (oref obj transient)) + return) + (`(prefix t ,_) #'transient--do-recurse) + (`(prefix nil ,_) #'transient--do-stack) + (`(infix t ,_) #'transient--do-stay) + (`(suffix t ,_) #'transient--do-call) + ('(suffix nil t) #'transient--do-return) + (`(,_ nil ,_) #'transient--do-exit) + (`(,_ ,do ,_) do)))) + ((not (lookup-key transient-predicate-map (vector cmd))) + (define-key map (vector cmd) + (pcase (list kind default return) + (`(prefix ,(or 'transient--do-stay 'transient--do-call) ,_) + #'transient--do-recurse) + (`(prefix t ,_) #'transient--do-recurse) + (`(prefix ,_ ,_) #'transient--do-stack) + (`(infix ,_ ,_) #'transient--do-stay) + (`(suffix t ,_) #'transient--do-call) + ('(suffix nil t) #'transient--do-return) + (`(suffix nil ,_) #'transient--do-exit) + (`(suffix ,do ,_) do))))))) + map)) + +(defun transient--make-redisplay-map () + (setq transient--redisplay-key + (pcase this-command + ('transient-update + (setq transient--showp t) + (setq unread-command-events + (listify-key-sequence (this-single-command-raw-keys)))) + ('transient-quit-seq + (setq unread-command-events + (butlast (listify-key-sequence + (this-single-command-raw-keys)) + 2)) + (butlast transient--redisplay-key)) + (_ nil))) + (let ((topmap (make-sparse-keymap)) + (submap (make-sparse-keymap))) + (when transient--redisplay-key + (define-key topmap (vconcat transient--redisplay-key) submap) + (set-keymap-parent submap transient-sticky-map)) + (map-keymap-internal + (lambda (key def) + (when (and (not (eq key ?\e)) + (listp def) + (keymapp def)) + (define-key topmap (vconcat transient--redisplay-key (list key)) + #'transient-update))) + (if transient--redisplay-key + (let ((key (vconcat transient--redisplay-key))) + (or (lookup-key transient--transient-map key) + (and-let* ((regular (lookup-key local-function-key-map key))) + (lookup-key transient--transient-map (vconcat regular))))) + transient--transient-map)) + topmap)) + +;;; Setup + +(defun transient-setup (&optional name layout edit &rest params) + "Setup the transient specified by NAME. + +This function is called by transient prefix commands to setup the +transient. In that case NAME is mandatory, LAYOUT and EDIT must +be nil and PARAMS may be (but usually is not) used to set, e.g., +the \"scope\" of the transient (see `transient-define-prefix'). + +This function is also called internally, in which case LAYOUT and +EDIT may be non-nil." + (transient--debug 'setup) + (transient--with-emergency-exit :setup + (cond + ((not name) + ;; Switching between regular and edit mode. + (transient--pop-keymap 'transient--transient-map) + (transient--pop-keymap 'transient--redisplay-map) + (setq name (oref transient--prefix command)) + (setq params (list :scope (oref transient--prefix scope)))) + (transient--prefix + ;; Invoked as a ":transient-non-suffix 'transient--do-{stay,call}" + ;; of an outer prefix. Unlike the usual `transient--do-stack', + ;; these predicates fail to clean up after the outer prefix. + (transient--pop-keymap 'transient--transient-map) + (transient--pop-keymap 'transient--redisplay-map)) + ((not (or layout ; resuming parent/suspended prefix + transient-current-command)) ; entering child prefix + (transient--stack-zap)) ; replace suspended prefix, if any + (edit + ;; Returning from help to edit. + (setq transient--editp t))) + (transient--init-objects name layout params) + (transient--init-keymaps) + (transient--history-init transient--prefix) + (setq transient--original-window (selected-window)) + (setq transient--original-buffer (current-buffer)) + (setq transient--minibuffer-depth (minibuffer-depth)) + (transient--redisplay) + (transient--init-transient) + (transient--suspend-which-key-mode))) + +(cl-defgeneric transient-setup-children (group children) + "Setup the CHILDREN of GROUP. +If the value of the `setup-children' slot is non-nil, then call +that function with CHILDREN as the only argument and return the +value. Otherwise return CHILDREN as is." + (if (slot-boundp group 'setup-children) + (funcall (oref group setup-children) children) + children)) + +(defun transient--init-keymaps () + (setq transient--predicate-map (transient--make-predicate-map)) + (setq transient--transient-map (transient--make-transient-map)) + (setq transient--redisplay-map (transient--make-redisplay-map))) + +(defun transient--init-objects (&optional name layout params) + (if name + (setq transient--prefix (transient--init-prefix name params)) + (setq name (oref transient--prefix command))) + (setq transient--refreshp (oref transient--prefix refresh-suffixes)) + (setq transient--layout (or layout (transient--init-suffixes name))) + (setq transient--suffixes (transient--flatten-suffixes transient--layout))) + +(defun transient--init-prefix (name &optional params) + (let ((obj (let ((proto (get name 'transient--prefix))) + (apply #'clone proto + :prototype proto + :level (or (alist-get t (alist-get name transient-levels)) + transient-default-level) + params)))) + (transient--setup-recursion obj) + (transient-init-value obj) + obj)) + +(defun transient--init-suffixes (name) + (let ((levels (alist-get name transient-levels))) + (cl-mapcan (lambda (c) (transient--init-child levels c nil)) + (append (get name 'transient--layout) + (and (not transient--editp) + (get 'transient-common-commands + 'transient--layout)))))) + +(defun transient--flatten-suffixes (layout) + (cl-labels ((s (def) + (cond + ((stringp def) nil) + ((cl-typep def 'transient-information) nil) + ((listp def) (cl-mapcan #'s def)) + ((cl-typep def 'transient-group) + (cl-mapcan #'s (oref def suffixes))) + ((cl-typep def 'transient-suffix) + (list def))))) + (cl-mapcan #'s layout))) + +(defun transient--init-child (levels spec parent) + (cl-etypecase spec + (vector (transient--init-group levels spec parent)) + (list (transient--init-suffix levels spec parent)) + (string (list spec)))) + +(defun transient--init-group (levels spec parent) + (pcase-let ((`(,level ,class ,args ,children) (append spec nil))) + (and-let* (((transient--use-level-p level)) + (obj (apply class :level level args)) + ((transient--use-suffix-p obj)) + ((prog1 t + (when (or (and parent (oref parent inapt)) + (transient--inapt-suffix-p obj)) + (oset obj inapt t)))) + (suffixes (cl-mapcan + (lambda (c) (transient--init-child levels c obj)) + (transient-setup-children obj children)))) + (progn ; work around debbugs#31840 + (oset obj suffixes suffixes) + (list obj))))) + +(defun transient--init-suffix (levels spec parent) + (pcase-let* ((`(,level ,class ,args) spec) + (cmd (plist-get args :command)) + (key (transient--kbd (plist-get args :key))) + (level (or (alist-get (cons cmd key) levels nil nil #'equal) + (alist-get cmd levels) + level))) + (let ((fn (and (symbolp cmd) + (symbol-function cmd)))) + (when (autoloadp fn) + (transient--debug " autoload %s" cmd) + (autoload-do-load fn))) + (when (transient--use-level-p level) + (let ((obj (if (child-of-class-p class 'transient-information) + (apply class :level level args) + (unless (and cmd (symbolp cmd)) + (error "BUG: Non-symbolic suffix command: %s" cmd)) + (if-let ((proto (and cmd (transient--suffix-prototype cmd)))) + (apply #'clone proto :level level args) + (apply class :command cmd :level level args))))) + (cond ((not cmd)) + ((commandp cmd)) + ((or (cl-typep obj 'transient-switch) + (cl-typep obj 'transient-option)) + ;; As a temporary special case, if the package was compiled + ;; with an older version of Transient, then we must define + ;; "anonymous" switch and option commands here. + (defalias cmd #'transient--default-infix-command)) + ((transient--use-suffix-p obj) + (error "Suffix command %s is not defined or autoloaded" cmd))) + (unless (cl-typep obj 'transient-information) + (transient--init-suffix-key obj)) + (when (transient--use-suffix-p obj) + (if (or (and parent (oref parent inapt)) + (transient--inapt-suffix-p obj)) + (oset obj inapt t) + (transient-init-scope obj) + (transient-init-value obj)) + (list obj)))))) + +(cl-defmethod transient--init-suffix-key ((obj transient-suffix)) + (unless (slot-boundp obj 'key) + (error "No key for %s" (oref obj command)))) + +(cl-defmethod transient--init-suffix-key ((obj transient-argument)) + (if (transient-switches--eieio-childp obj) + (cl-call-next-method obj) + (unless (slot-boundp obj 'shortarg) + (when-let ((shortarg (transient--derive-shortarg (oref obj argument)))) + (oset obj shortarg shortarg))) + (unless (slot-boundp obj 'key) + (if (slot-boundp obj 'shortarg) + (oset obj key (oref obj shortarg)) + (error "No key for %s" (oref obj command)))))) + +(defun transient--use-level-p (level &optional edit) + (or transient--all-levels-p + (and transient--editp (not edit)) + (and (>= level 1) + (<= level (oref transient--prefix level))))) + +(defun transient--use-suffix-p (obj) + (let ((transient--shadowed-buffer (current-buffer)) + (transient--pending-suffix obj)) + (transient--do-suffix-p + (oref obj if) + (oref obj if-not) + (oref obj if-nil) + (oref obj if-non-nil) + (oref obj if-mode) + (oref obj if-not-mode) + (oref obj if-derived) + (oref obj if-not-derived) + t))) + +(defun transient--inapt-suffix-p (obj) + (let ((transient--shadowed-buffer (current-buffer)) + (transient--pending-suffix obj)) + (transient--do-suffix-p + (oref obj inapt-if) + (oref obj inapt-if-not) + (oref obj inapt-if-nil) + (oref obj inapt-if-non-nil) + (oref obj inapt-if-mode) + (oref obj inapt-if-not-mode) + (oref obj inapt-if-derived) + (oref obj inapt-if-not-derived) + nil))) + +(defun transient--do-suffix-p + (if if-not if-nil if-non-nil if-mode if-not-mode if-derived if-not-derived + default) + (cond + (if (funcall if)) + (if-not (not (funcall if-not))) + (if-non-nil (symbol-value if-non-nil)) + (if-nil (not (symbol-value if-nil))) + (if-mode (if (atom if-mode) + (eq major-mode if-mode) + (memq major-mode if-mode))) + (if-not-mode (not (if (atom if-not-mode) + (eq major-mode if-not-mode) + (memq major-mode if-not-mode)))) + (if-derived (if (or (atom if-derived) + (>= emacs-major-version 30)) + (derived-mode-p if-derived) + (apply #'derived-mode-p if-derived))) + (if-not-derived (not (if (or (atom if-not-derived) + (>= emacs-major-version 30)) + (derived-mode-p if-not-derived) + (apply #'derived-mode-p if-not-derived)))) + (default))) + +(defun transient--suffix-predicate (spec) + (let ((plist (nth 2 spec))) + (seq-some (lambda (prop) + (and-let* ((pred (plist-get plist prop))) + (list prop pred))) + '( :if :if-not + :if-nil :if-non-nil + :if-mode :if-not-mode + :if-derived :if-not-derived + :inapt-if :inapt-if-not + :inapt-if-nil :inapt-if-non-nil + :inapt-if-mode :inapt-if-not-mode + :inapt-if-derived :inapt-if-not-derived)))) + +;;; Flow-Control + +(defun transient--init-transient () + (transient--debug 'init-transient) + (transient--push-keymap 'transient--transient-map) + (transient--push-keymap 'transient--redisplay-map) + (add-hook 'pre-command-hook #'transient--pre-command) + (add-hook 'post-command-hook #'transient--post-command) + (advice-add 'recursive-edit :around #'transient--recursive-edit) + (when transient--exitp + ;; This prefix command was invoked as the suffix of another. + ;; Prevent `transient--post-command' from removing the hooks + ;; that we just added. + (setq transient--exitp 'replace))) + +(defun transient--refresh-transient () + (transient--debug 'refresh-transient) + (transient--pop-keymap 'transient--predicate-map) + (transient--pop-keymap 'transient--transient-map) + (transient--pop-keymap 'transient--redisplay-map) + (if (eq transient--refreshp 'updated-value) + ;; Preserve the prefix value this once, because the + ;; invoked suffix indicates that it has updated that. + (setq transient--refreshp (oref transient--prefix refresh-suffixes)) + ;; Otherwise update the prefix value from suffix values. + (oset transient--prefix value (transient-get-value))) + (transient--init-objects) + (transient--init-keymaps) + (transient--push-keymap 'transient--transient-map) + (transient--push-keymap 'transient--redisplay-map) + (transient--redisplay)) + +(defun transient--pre-command () + (transient--debug 'pre-command) + (transient--with-emergency-exit :pre-command + ;; The use of `overriding-terminal-local-map' does not prevent the + ;; lookup of command remappings in the overridden maps, which can + ;; lead to a suffix being remapped to a non-suffix. We have to undo + ;; the remapping in that case. However, remapping a non-suffix to + ;; another should remain possible. + (when (and (transient--get-pre-command this-original-command 'suffix) + (not (transient--get-pre-command this-command 'suffix))) + (setq this-command this-original-command)) + (cond + ((memq this-command '(transient-update transient-quit-seq)) + (transient--pop-keymap 'transient--redisplay-map)) + ((and transient--helpp + (not (memq this-command '(transient-quit-one + transient-quit-all)))) + (cond + ((transient-help) + (transient--do-suspend) + (setq this-command 'transient-suspend) + (transient--pre-exit)) + ((not (transient--edebug-command-p)) + (setq this-command 'transient-undefined)))) + ((and transient--editp + (transient-suffix-object) + (not (memq this-command '(transient-quit-one + transient-quit-all + transient-help)))) + (setq this-command 'transient-set-level) + (transient--wrap-command)) + (t + (setq transient--exitp nil) + (let ((exitp (eq (transient--call-pre-command) transient--exit))) + (transient--wrap-command) + (when exitp + (transient--pre-exit))))))) + +(defun transient--pre-exit () + (transient--debug 'pre-exit) + (transient--delete-window) + (transient--timer-cancel) + (transient--pop-keymap 'transient--transient-map) + (transient--pop-keymap 'transient--redisplay-map) + (unless transient--showp + (let ((message-log-max nil)) + (message ""))) + (setq transient--transient-map nil) + (setq transient--predicate-map nil) + (setq transient--redisplay-map nil) + (setq transient--redisplay-key nil) + (setq transient--helpp nil) + (setq transient--editp nil) + (setq transient--prefix nil) + (setq transient--layout nil) + (setq transient--suffixes nil) + (setq transient--original-window nil) + (setq transient--original-buffer nil) + (setq transient--window nil)) + +(defun transient--delete-window () + (when (window-live-p transient--window) + (let ((remain-in-minibuffer-window + (and (minibuffer-selected-window) + (selected-window)))) + ;; Only delete the window if it has never shown another buffer. + (unless (eq (car (window-parameter transient--window 'quit-restore)) + 'other) + (with-demoted-errors "Error while exiting transient: %S" + (delete-window transient--window))) + (when (buffer-live-p transient--buffer) + (kill-buffer transient--buffer)) + (setq transient--buffer nil) + (when remain-in-minibuffer-window + (select-window remain-in-minibuffer-window))))) + +(defun transient--export () + (setq transient-current-prefix transient--prefix) + (setq transient-current-command (oref transient--prefix command)) + (setq transient-current-suffixes transient--suffixes) + (transient--history-push transient--prefix)) + +(defun transient--suspend-override (&optional nohide) + (transient--debug 'suspend-override) + (transient--timer-cancel) + (cond ((and (not nohide) transient-hide-during-minibuffer-read) + (transient--delete-window)) + ((and transient--prefix transient--redisplay-key) + (setq transient--redisplay-key nil) + (when transient--showp + (if-let ((win (minibuffer-selected-window))) + (with-selected-window win + (transient--show)) + (transient--show))))) + (transient--pop-keymap 'transient--transient-map) + (transient--pop-keymap 'transient--redisplay-map) + (remove-hook 'pre-command-hook #'transient--pre-command) + (remove-hook 'post-command-hook #'transient--post-command)) + +(defun transient--resume-override (&optional _ignore) + (transient--debug 'resume-override) + (when (and transient--showp transient-hide-during-minibuffer-read) + (transient--show)) + (transient--push-keymap 'transient--transient-map) + (transient--push-keymap 'transient--redisplay-map) + (add-hook 'pre-command-hook #'transient--pre-command) + (add-hook 'post-command-hook #'transient--post-command)) + +(defun transient--recursive-edit (fn) + (transient--debug 'recursive-edit) + (if (not transient--prefix) + (funcall fn) + (transient--suspend-override (bound-and-true-p edebug-active)) + (funcall fn) ; Already unwind protected. + (cond ((memq this-command '(top-level abort-recursive-edit)) + (setq transient--exitp t) + (transient--post-exit) + (transient--delete-window)) + (transient--prefix + (transient--resume-override))))) + +(defmacro transient--with-suspended-override (&rest body) + (let ((depth (make-symbol "depth")) + (setup (make-symbol "setup")) + (exit (make-symbol "exit"))) + `(if (and transient--transient-map + (memq transient--transient-map + overriding-terminal-local-map)) + (let ((,depth (1+ (minibuffer-depth))) ,setup ,exit) + (setq ,setup + (lambda () "@transient--with-suspended-override" + (transient--debug 'minibuffer-setup) + (remove-hook 'minibuffer-setup-hook ,setup) + (transient--suspend-override))) + (setq ,exit + (lambda () "@transient--with-suspended-override" + (transient--debug 'minibuffer-exit) + (when (= (minibuffer-depth) ,depth) + (transient--resume-override)))) + (unwind-protect + (progn + (add-hook 'minibuffer-setup-hook ,setup) + (add-hook 'minibuffer-exit-hook ,exit) + ,@body) + (remove-hook 'minibuffer-setup-hook ,setup) + (remove-hook 'minibuffer-exit-hook ,exit))) + ,@body))) + +(static-if (>= emacs-major-version 30) ;transient--wrap-command + (defun transient--wrap-command () + (cl-assert + (>= emacs-major-version 30) nil + "Emacs was downgraded, making it necessary to recompile Transient") + (letrec + ((prefix transient--prefix) + (suffix this-command) + (advice + (lambda (fn &rest args) + (interactive + (lambda (spec) + (let ((abort t)) + (unwind-protect + (prog1 (let ((debugger #'transient--exit-and-debug)) + (advice-eval-interactive-spec spec)) + (setq abort nil)) + (when abort + (when-let ((unwind (oref prefix unwind-suffix))) + (transient--debug 'unwind-interactive) + (funcall unwind suffix)) + (advice-remove suffix advice) + (oset prefix unwind-suffix nil)))))) + (unwind-protect + (let ((debugger #'transient--exit-and-debug)) + (apply fn args)) + (when-let ((unwind (oref prefix unwind-suffix))) + (transient--debug 'unwind-command) + (funcall unwind suffix)) + (advice-remove suffix advice) + (oset prefix unwind-suffix nil))))) + (when (symbolp this-command) + (advice-add suffix :around advice '((depth . -99)))))) + + (defun transient--wrap-command () + (let* ((prefix transient--prefix) + (suffix this-command) + (advice nil) + (advice-interactive + (lambda (spec) + (let ((abort t)) + (unwind-protect + (prog1 (let ((debugger #'transient--exit-and-debug)) + (advice-eval-interactive-spec spec)) + (setq abort nil)) + (when abort + (when-let ((unwind (oref prefix unwind-suffix))) + (transient--debug 'unwind-interactive) + (funcall unwind suffix)) + (advice-remove suffix advice) + (oset prefix unwind-suffix nil)))))) + (advice-body + (lambda (fn &rest args) + (unwind-protect + (let ((debugger #'transient--exit-and-debug)) + (apply fn args)) + (when-let ((unwind (oref prefix unwind-suffix))) + (transient--debug 'unwind-command) + (funcall unwind suffix)) + (advice-remove suffix advice) + (oset prefix unwind-suffix nil))))) + (setq advice `(lambda (fn &rest args) + (interactive ,advice-interactive) + (apply ',advice-body fn args))) + (when (symbolp this-command) + (advice-add suffix :around advice '((depth . -99))))))) + +(defun transient--premature-post-command () + (and (equal (this-command-keys-vector) []) + (= (minibuffer-depth) + (1+ transient--minibuffer-depth)) + (progn + (transient--debug 'premature-post-command) + (transient--suspend-override) + (oset (or transient--prefix transient-current-prefix) + unwind-suffix + (if transient--exitp + #'transient--post-exit + #'transient--resume-override)) + t))) + +(defun transient--post-command () + (unless (transient--premature-post-command) + (transient--debug 'post-command) + (transient--with-emergency-exit :post-command + (cond (transient--exitp (transient--post-exit)) + ;; If `this-command' is the current transient prefix, then we + ;; have already taken care of updating the transient buffer... + ((and (eq this-command (oref transient--prefix command)) + ;; ... but if `prefix-arg' is non-nil, then the values + ;; of `this-command' and `real-this-command' are untrue + ;; because `prefix-command-preserve-state' changes them. + ;; We cannot use `current-prefix-arg' because it is set + ;; too late (in `command-execute'), and if it were set + ;; earlier, then we likely still would not be able to + ;; rely on it, and `prefix-command-preserve-state-hook' + ;; would have to be used to record that a universal + ;; argument is in effect. + (not prefix-arg))) + (transient--refreshp + (transient--refresh-transient)) + ((let ((old transient--redisplay-map) + (new (transient--make-redisplay-map))) + (unless (equal old new) + (transient--pop-keymap 'transient--redisplay-map) + (setq transient--redisplay-map new) + (transient--push-keymap 'transient--redisplay-map)) + (transient--redisplay)))))) + (transient--debug 'clear-current) + (setq transient-current-prefix nil) + (setq transient-current-command nil) + (setq transient-current-suffixes nil)) + +(defun transient--post-exit (&optional command) + (transient--debug 'post-exit) + (unless (and (eq transient--exitp 'replace) + (or transient--prefix + ;; The current command could act as a prefix, + ;; but decided not to call `transient-setup', + ;; or it is prevented from doing so because it + ;; uses the minibuffer and the user aborted + ;; that. + (prog1 nil + (if (let ((obj (transient-suffix-object command))) + (and (slot-boundp obj 'transient) + (oref obj transient))) + ;; This sub-prefix is a transient suffix; + ;; go back to outer prefix, by calling + ;; `transient--stack-pop' further down. + (setq transient--exitp nil) + (transient--stack-zap))))) + (remove-hook 'pre-command-hook #'transient--pre-command) + (remove-hook 'post-command-hook #'transient--post-command) + (advice-remove 'recursive-edit #'transient--recursive-edit)) + (let ((resume (and transient--stack + (not (memq transient--exitp '(replace suspend)))))) + (unless (or resume (eq transient--exitp 'replace)) + (setq transient--showp nil)) + (setq transient--exitp nil) + (setq transient--helpp nil) + (setq transient--editp nil) + (setq transient--all-levels-p nil) + (setq transient--minibuffer-depth 0) + (run-hooks 'transient-exit-hook) + (when resume + (transient--stack-pop)))) + +(defun transient--stack-push () + (transient--debug 'stack-push) + (push (list (oref transient--prefix command) + transient--layout + transient--editp + :transient-suffix (oref transient--prefix transient-suffix) + :scope (oref transient--prefix scope)) + transient--stack)) + +(defun transient--stack-pop () + (transient--debug 'stack-pop) + (and transient--stack + (prog1 t (apply #'transient-setup (pop transient--stack))))) + +(defun transient--stack-zap () + (transient--debug 'stack-zap) + (setq transient--stack nil)) + +(defun transient--redisplay () + (if (or (eq transient-show-popup t) + transient--showp) + (unless + (or (memq this-command transient--scroll-commands) + (and (or (memq this-command '(mouse-drag-region + mouse-set-region)) + (equal (key-description (this-command-keys-vector)) + "<mouse-movement>")) + (and (eq (current-buffer) transient--buffer)))) + (transient--show)) + (when (and (numberp transient-show-popup) + (not (zerop transient-show-popup)) + (not transient--timer)) + (transient--timer-start)) + (transient--show-brief))) + +(defun transient--timer-start () + (setq transient--timer + (run-at-time (abs transient-show-popup) nil + (lambda () + (transient--timer-cancel) + (transient--show) + (let ((message-log-max nil)) + (message "")))))) + +(defun transient--timer-cancel () + (when transient--timer + (cancel-timer transient--timer) + (setq transient--timer nil))) + +(defun transient--debug (arg &rest args) + (when transient--debug + (let ((inhibit-message (not (eq transient--debug 'message)))) + (if (symbolp arg) + (message "-- %-22s (cmd: %s, event: %S, exit: %s%s)" + arg + (cond ((and (symbolp this-command) this-command)) + ((fboundp 'help-fns-function-name) + (help-fns-function-name this-command)) + ((byte-code-function-p this-command) + "#[...]") + (this-command)) + (key-description (this-command-keys-vector)) + transient--exitp + (cond ((keywordp (car args)) + (format ", from: %s" + (substring (symbol-name (car args)) 1))) + ((stringp (car args)) + (concat ", " (apply #'format args))) + ((functionp (car args)) + (concat ", " (apply (car args) (cdr args)))) + (""))) + (apply #'message arg args))))) + +(defun transient--emergency-exit (&optional id) + "Exit the current transient command after an error occurred. +When no transient is active (i.e., when `transient--prefix' is +nil) then do nothing. Optional ID is a keyword identifying the +exit." + (transient--debug 'emergency-exit id) + (when transient--prefix + (setq transient--stack nil) + (setq transient--exitp t) + (transient--pre-exit) + (transient--post-exit))) + +;;; Pre-Commands + +(defun transient--call-pre-command () + (if-let ((fn (transient--get-pre-command this-command))) + (let ((action (funcall fn))) + (when (eq action transient--exit) + (setq transient--exitp (or transient--exitp t))) + action) + (if (let ((keys (this-command-keys-vector))) + (eq (aref keys (1- (length keys))) ?\C-g)) + (setq this-command 'transient-noop) + (unless (transient--edebug-command-p) + (setq this-command 'transient-undefined))) + transient--stay)) + +(defun transient--get-pre-command (&optional cmd enforce-type) + (or (and (not (eq enforce-type 'non-suffix)) + (symbolp cmd) + (lookup-key transient--predicate-map (vector cmd))) + (and (not (eq enforce-type 'suffix)) + (transient--resolve-pre-command + (oref transient--prefix transient-non-suffix) + t)))) + +(defun transient--resolve-pre-command (pre &optional resolve-boolean) + (cond ((booleanp pre) + (if resolve-boolean + (if pre #'transient--do-stay #'transient--do-warn) + pre)) + ((string-match-p "--do-" (symbol-name pre)) pre) + ((let ((sym (intern (format "transient--do-%s" pre)))) + (if (functionp sym) sym pre))))) + +(defun transient--do-stay () + "Call the command without exporting variables and stay transient." + transient--stay) + +(defun transient--do-noop () + "Call `transient-noop' and stay transient." + (setq this-command 'transient-noop) + transient--stay) + +(defun transient--do-warn () + "Call `transient-undefined' and stay transient." + (setq this-command 'transient-undefined) + transient--stay) + +(defun transient--do-warn-inapt () + "Call `transient-inapt' and stay transient." + (setq this-command 'transient-inapt) + transient--stay) + +(defun transient--do-call () + "Call the command after exporting variables and stay transient." + (transient--export) + transient--stay) + +(defun transient--do-return () + "Call the command after exporting variables and return to parent prefix. +If there is no parent prefix, then behave like `transient--do-exit'." + (if (not transient--stack) + (transient--do-exit) + (transient--export) + transient--exit)) + +(defun transient--do-exit () + "Call the command after exporting variables and exit the transient." + (transient--export) + (transient--stack-zap) + transient--exit) + +(defun transient--do-leave () + "Call the command without exporting variables and exit the transient." + (transient--stack-zap) + transient--exit) + +(defun transient--do-push-button () + "Call the command represented by the activated button. +Use that command's pre-command to determine transient behavior." + (if (and (mouse-event-p last-command-event) + (not (eq (posn-window (event-start last-command-event)) + transient--window))) + transient--stay + (setq this-command + (with-selected-window transient--window + (get-text-property (if (mouse-event-p last-command-event) + (posn-point (event-start last-command-event)) + (point)) + 'command))) + (transient--call-pre-command))) + +(defun transient--do-recurse () + "Call the transient prefix command, preparing for return to active transient. +If there is no parent prefix, then just call the command." + (transient--do-stack)) + +(defun transient--setup-recursion (prefix-obj) + (when transient--stack + (let ((command (oref prefix-obj command))) + (when-let ((suffix-obj (transient-suffix-object command))) + (when (memq (if (slot-boundp suffix-obj 'transient) + (oref suffix-obj transient) + (oref transient-current-prefix transient-suffix)) + (list t #'transient--do-recurse)) + (oset prefix-obj transient-suffix t)))))) + +(defun transient--do-stack () + "Call the transient prefix command, stacking the active transient. +Push the active transient to the transient stack." + (transient--export) + (transient--stack-push) + (setq transient--exitp 'replace) + transient--exit) + +(defun transient--do-replace () + "Call the transient prefix command, replacing the active transient. +Do not push the active transient to the transient stack." + (transient--export) + (setq transient--exitp 'replace) + transient--exit) + +(defun transient--do-suspend () + "Suspend the active transient, saving the transient stack." + (transient--stack-push) + (setq transient--exitp 'suspend) + transient--exit) + +(defun transient--do-quit-one () + "If active, quit help or edit mode, else exit the active transient." + (cond (transient--helpp + (setq transient--helpp nil) + transient--stay) + (transient--editp + (setq transient--editp nil) + (transient-setup) + transient--stay) + (prefix-arg + transient--stay) + (transient--exit))) + +(defun transient--do-quit-all () + "Exit all transients without saving the transient stack." + (transient--stack-zap) + transient--exit) + +(defun transient--do-move () + "Call the command if `transient-enable-popup-navigation' is non-nil. +In that case behave like `transient--do-stay', otherwise similar +to `transient--do-warn'." + (unless transient-enable-popup-navigation + (setq this-command 'transient-inhibit-move)) + transient--stay) + +(defun transient--do-minus () + "Call `negative-argument' or pivot to `transient-update'. +If `negative-argument' is invoked using \"-\" then preserve the +prefix argument and pivot to `transient-update'." + (when (equal (this-command-keys) "-") + (setq this-command 'transient-update)) + transient--stay) + +(put 'transient--do-stay 'transient-face 'transient-key-stay) +(put 'transient--do-noop 'transient-face 'transient-key-noop) +(put 'transient--do-warn 'transient-face 'transient-key-noop) +(put 'transient--do-warn-inapt 'transient-face 'transient-key-noop) +(put 'transient--do-call 'transient-face 'transient-key-stay) +(put 'transient--do-return 'transient-face 'transient-key-return) +(put 'transient--do-exit 'transient-face 'transient-key-exit) +(put 'transient--do-leave 'transient-face 'transient-key-exit) + +(put 'transient--do-recurse 'transient-face 'transient-key-stay) +(put 'transient--do-stack 'transient-face 'transient-key-stay) +(put 'transient--do-replace 'transient-face 'transient-key-exit) +(put 'transient--do-suspend 'transient-face 'transient-key-exit) + +(put 'transient--do-quit-one 'transient-face 'transient-key-return) +(put 'transient--do-quit-all 'transient-face 'transient-key-exit) +(put 'transient--do-move 'transient-face 'transient-key-stay) +(put 'transient--do-minus 'transient-face 'transient-key-stay) + +;;; Commands +;;;; Noop + +(defun transient-noop () + "Do nothing at all." + (interactive)) + +(defun transient-undefined () + "Warn the user that the pressed key is not bound to any suffix." + (interactive) + (transient--invalid "Unbound suffix")) + +(defun transient-inapt () + "Warn the user that the invoked command is inapt." + (interactive) + (transient--invalid "Inapt command")) + +(defun transient--invalid (msg) + (ding) + (message "%s: `%s' (Use `%s' to abort, `%s' for help)%s" + msg + (propertize (key-description (this-single-command-keys)) + 'face 'font-lock-warning-face) + (propertize "C-g" 'face 'transient-key) + (propertize "?" 'face 'transient-key) + ;; `this-command' is `transient-undefined' or `transient-inapt'. + ;; Show the command (`this-original-command') the user actually + ;; tried to invoke. + (if-let ((cmd (or (ignore-errors (symbol-name this-original-command)) + (ignore-errors (symbol-name this-command))))) + (format " [%s]" (propertize cmd 'face 'font-lock-warning-face)) + "")) + (unless (and transient--transient-map + (memq transient--transient-map overriding-terminal-local-map)) + (let ((transient--prefix (or transient--prefix 'sic))) + (transient--emergency-exit)) + (view-lossage) + (other-window 1) + (display-warning 'transient "Inconsistent transient state detected. +This should never happen. +Please open an issue and post the shown command log." :error))) + +(defun transient-inhibit-move () + "Warn the user that popup navigation is disabled." + (interactive) + (message "To enable use of `%s', please customize `%s'" + this-original-command + 'transient-enable-popup-navigation)) + +;;;; Core + +(defun transient-quit-all () + "Exit all transients without saving the transient stack." + (interactive)) + +(defun transient-quit-one () + "Exit the current transients, returning to outer transient, if any." + (interactive)) + +(defun transient-quit-seq () + "Abort the current incomplete key sequence." + (interactive)) + +(defun transient-update () + "Redraw the transient's state in the popup buffer." + (interactive) + (setq prefix-arg current-prefix-arg)) + +(defun transient-show () + "Show the transient's state in the popup buffer." + (interactive) + (setq transient--showp t)) + +(defun transient-push-button () + "Invoke the suffix command represented by this button." + (interactive)) + +;;;; Suspend + +(defun transient-suspend () + "Suspend the current transient. +It can later be resumed using `transient-resume', while no other +transient is active." + (interactive)) + +(define-minor-mode transient-resume-mode + "Auxiliary minor-mode used to resume a transient after viewing help.") + +(defun transient-resume () + "Resume a previously suspended stack of transients." + (interactive) + (cond (transient--stack + (let ((winconf transient--restore-winconf)) + (kill-local-variable 'transient--restore-winconf) + (when transient-resume-mode + (transient-resume-mode -1) + (quit-window)) + (when winconf + (set-window-configuration winconf))) + (transient--stack-pop)) + (transient-resume-mode + (kill-local-variable 'transient--restore-winconf) + (transient-resume-mode -1) + (quit-window)) + (t + (message "No suspended transient command")))) + +;;;; Help + +(defun transient-help (&optional interactive) + "Show help for the active transient or one of its suffixes.\n\n(fn)" + (interactive (list t)) + (if interactive + (setq transient--helpp t) + (with-demoted-errors "transient-help: %S" + (when (lookup-key transient--transient-map + (this-single-command-raw-keys)) + (setq transient--helpp nil) + (let ((winconf (current-window-configuration))) + (transient-show-help + (if (eq this-original-command 'transient-help) + transient--prefix + (or (transient-suffix-object) + this-original-command))) + (setq-local transient--restore-winconf winconf)) + (fit-window-to-buffer nil (frame-height) (window-height)) + (transient-resume-mode) + (message (substitute-command-keys + "Type \\`q' to resume transient command.")) + t)))) + +;;;; Level + +(defun transient-set-level (&optional command level) + "Set the level of the transient or one of its suffix commands." + (interactive + (let ((command this-original-command) + (prefix (oref transient--prefix command))) + (and (or (not (eq command 'transient-set-level)) + (and transient--editp + (setq command prefix))) + (list command + (let ((keys (this-single-command-raw-keys))) + (and (lookup-key transient--transient-map keys) + (progn + (transient--show) + (string-to-number + (transient--read-number-N + (format "Set level for `%s': " command) + nil nil (not (eq command prefix))))))))))) + (cond + ((not command) + (setq transient--editp t) + (transient-setup)) + (level + (let* ((prefix (oref transient--prefix command)) + (alist (alist-get prefix transient-levels)) + (akey command)) + (cond ((eq command prefix) + (oset transient--prefix level level) + (setq akey t)) + (t + (oset (transient-suffix-object command) level level) + (when (cdr (cl-remove-if-not (lambda (obj) + (eq (oref obj command) command)) + transient--suffixes)) + (setq akey (cons command (this-command-keys)))))) + (setf (alist-get akey alist) level) + (setf (alist-get prefix transient-levels) alist)) + (transient-save-levels) + (transient--show)) + (t + (transient-undefined)))) + +(transient-define-suffix transient-toggle-level-limit () + "Toggle whether to temporarily displayed suffixes on all levels." + :description + (lambda () + (cond + ((= transient-default-level transient--max-level) + "Always displaying all levels") + (transient--all-levels-p + (format "Hide suffix %s" + (propertize + (format "levels > %s" (oref (transient-prefix-object) level)) + 'face 'transient-higher-level))) + ("Show all suffix levels"))) + :inapt-if (lambda () (= transient-default-level transient--max-level)) + :transient t + (interactive) + (setq transient--all-levels-p (not transient--all-levels-p)) + (setq transient--refreshp t)) + +;;;; Value + +(defun transient-set () + "Set active transient's value for this Emacs session." + (interactive) + (transient-set-value (transient-prefix-object))) + +(defalias 'transient-set-and-exit #'transient-set + "Set active transient's value for this Emacs session and exit.") + +(defun transient-save () + "Save active transient's value for this and future Emacs sessions." + (interactive) + (transient-save-value (transient-prefix-object))) + +(defalias 'transient-save-and-exit #'transient-save + "Save active transient's value for this and future Emacs sessions and exit.") + +(defun transient-reset () + "Clear the set and saved values of the active transient." + (interactive) + (transient-reset-value (transient-prefix-object))) + +(defun transient-history-next () + "Switch to the next value used for the active transient." + (interactive) + (let* ((obj transient--prefix) + (pos (1- (oref obj history-pos))) + (hst (oref obj history))) + (if (< pos 0) + (user-error "End of history") + (oset obj history-pos pos) + (oset obj value (nth pos hst)) + (mapc #'transient-init-value transient--suffixes)))) + +(defun transient-history-prev () + "Switch to the previous value used for the active transient." + (interactive) + (let* ((obj transient--prefix) + (pos (1+ (oref obj history-pos))) + (hst (oref obj history)) + (len (length hst))) + (if (> pos (1- len)) + (user-error "End of history") + (oset obj history-pos pos) + (oset obj value (nth pos hst)) + (mapc #'transient-init-value transient--suffixes)))) + +(transient-define-suffix transient-preset () + "Put this preset into action." + :class transient-value-preset + (interactive) + (transient-prefix-set (oref (transient-suffix-object) set))) + +;;;; Auxiliary + +(defun transient-toggle-common () + "Toggle whether common commands are permanently shown." + (interactive) + (setq transient-show-common-commands (not transient-show-common-commands))) + +(defun transient-toggle-debug () + "Toggle debugging statements for transient commands." + (interactive) + (setq transient--debug (not transient--debug)) + (message "Debugging transient %s" + (if transient--debug "enabled" "disabled"))) + +(transient-define-suffix transient-echo-arguments (arguments) + "Show the transient's active ARGUMENTS in the echo area. +Intended for use in prefixes used for demonstration purposes, +such as when suggesting a new feature or reporting an issue." + :transient t + :description "Echo arguments" + :key "x" + (interactive (list (transient-args transient-current-command))) + (message "%s: %s" + (key-description (this-command-keys)) + (mapconcat (lambda (arg) + (propertize (if (string-match-p " " arg) + (format "%S" arg) + arg) + 'face 'transient-argument)) + arguments " "))) + +;;; Value +;;;; Init + +(cl-defgeneric transient-init-scope (obj) + "Set the scope of the suffix object OBJ. + +The scope is actually a property of the transient prefix, not of +individual suffixes. However it is possible to invoke a suffix +command directly instead of from a transient. In that case, if +the suffix expects a scope, then it has to determine that itself +and store it in its `scope' slot. + +This function is called for all suffix commands, but unless a +concrete method is implemented this falls through to the default +implementation, which is a noop.") + +(cl-defmethod transient-init-scope ((_ transient-suffix)) + "Noop." nil) + +(cl-defgeneric transient-init-value (_) + "Set the initial value of the object OBJ. + +This function is called for all prefix and suffix commands. + +For suffix commands (including infix argument commands) the +default implementation is a noop. Classes derived from the +abstract `transient-infix' class must implement this function. +Non-infix suffix commands usually don't have a value." + nil) + +(cl-defmethod transient-init-value :around ((obj transient-prefix)) + "If bound, then call OBJ's `init-value' function. +Otherwise call the primary method according to object's class." + (if (slot-boundp obj 'init-value) + (funcall (oref obj init-value) obj) + (cl-call-next-method obj))) + +(cl-defmethod transient-init-value :around ((obj transient-infix)) + "If bound, then call OBJ's `init-value' function. +Otherwise call the primary method according to object's class." + (if (slot-boundp obj 'init-value) + (funcall (oref obj init-value) obj) + (cl-call-next-method obj))) + +(cl-defmethod transient-init-value ((obj transient-prefix)) + (if (slot-boundp obj 'value) + (oref obj value) + (oset obj value + (if-let ((saved (assq (oref obj command) transient-values))) + (cdr saved) + (transient-default-value obj))))) + +(cl-defmethod transient-init-value ((obj transient-argument)) + (oset obj value + (let ((value (oref transient--prefix value)) + (argument (and (slot-boundp obj 'argument) + (oref obj argument))) + (multi-value (oref obj multi-value)) + (case-fold-search nil) + (regexp (if (slot-exists-p obj 'argument-regexp) + (oref obj argument-regexp) + (format "\\`%s\\(.*\\)" (oref obj argument))))) + (if (memq multi-value '(t rest)) + (cdr (assoc argument value)) + (let ((match (lambda (v) + (and (stringp v) + (string-match regexp v) + (match-string 1 v))))) + (if multi-value + (delq nil (mapcar match value)) + (cl-some match value))))))) + +(cl-defmethod transient-init-value ((obj transient-switch)) + (oset obj value + (car (member (oref obj argument) + (oref transient--prefix value))))) + +;;;; Default + +(cl-defgeneric transient-default-value (_) + "Return the default value." + nil) + +(cl-defmethod transient-default-value ((obj transient-prefix)) + (if-let ((default (and (slot-boundp obj 'default-value) + (oref obj default-value)))) + (if (functionp default) + (funcall default) + default) + nil)) + +;;;; Read + +(cl-defgeneric transient-infix-read (obj) + "Determine the new value of the infix object OBJ. + +This function merely determines the value; `transient-infix-set' +is used to actually store the new value in the object. + +For most infix classes this is done by reading a value from the +user using the reader specified by the `reader' slot (using the +`transient-infix' method described below). + +For some infix classes the value is changed without reading +anything in the minibuffer, i.e., the mere act of invoking the +infix command determines what the new value should be, based +on the previous value.") + +(cl-defmethod transient-infix-read :around ((obj transient-infix)) + "Refresh the transient buffer and call the next method. + +Also wrap `cl-call-next-method' with two macros: +- `transient--with-suspended-override' allows use of minibuffer. +- `transient--with-emergency-exit' arranges for the transient to + be exited in case of an error." + (transient--show) + (transient--with-emergency-exit :infix-read + (transient--with-suspended-override + (cl-call-next-method obj)))) + +(cl-defmethod transient-infix-read ((obj transient-infix)) + "Read a value while taking care of history. + +This method is suitable for a wide variety of infix commands, +including but not limited to inline arguments and variables. + +If you do not use this method for your own infix class, then +you should likely replicate a lot of the behavior of this +method. If you fail to do so, then users might not appreciate +the lack of history, for example. + +Only for very simple classes that toggle or cycle through a very +limited number of possible values should you replace this with a +simple method that does not handle history. (E.g., for a command +line switch the only possible values are \"use it\" and \"don't use +it\", in which case it is pointless to preserve history.)" + (with-slots (value multi-value always-read allow-empty choices) obj + (if (and value + (not multi-value) + (not always-read) + transient--prefix) + (oset obj value nil) + (let* ((enable-recursive-minibuffers t) + (reader (oref obj reader)) + (choices (if (functionp choices) (funcall choices) choices)) + (prompt (transient-prompt obj)) + (value (if multi-value (string-join value ",") value)) + (history-key (or (oref obj history-key) + (oref obj command))) + (transient--history (alist-get history-key transient-history)) + (transient--history (if (or (null value) + (eq value (car transient--history))) + transient--history + (cons value transient--history))) + (initial-input (and transient-read-with-initial-input + (car transient--history))) + (history (if initial-input + (cons 'transient--history 1) + 'transient--history)) + (value + (cond + (reader (funcall reader prompt initial-input history)) + (multi-value + (completing-read-multiple prompt choices nil nil + initial-input history)) + (choices + (completing-read prompt choices nil t initial-input history)) + ((read-string prompt initial-input history))))) + (cond ((and (equal value "") (not allow-empty)) + (setq value nil)) + ((and (equal value "\"\"") allow-empty) + (setq value ""))) + (when value + (when (and (bound-and-true-p ivy-mode) + (stringp (car transient--history))) + (set-text-properties 0 (length (car transient--history)) nil + (car transient--history))) + (setf (alist-get history-key transient-history) + (delete-dups transient--history))) + value)))) + +(cl-defmethod transient-infix-read ((obj transient-switch)) + "Toggle the switch on or off." + (if (oref obj value) nil (oref obj argument))) + +(cl-defmethod transient-infix-read ((obj transient-switches)) + "Cycle through the mutually exclusive switches. +The last value is \"don't use any of these switches\"." + (let ((choices (mapcar (apply-partially #'format (oref obj argument-format)) + (oref obj choices)))) + (if-let ((value (oref obj value))) + (cadr (member value choices)) + (car choices)))) + +(cl-defmethod transient-infix-read ((command symbol)) + "Elsewhere use the reader of the infix command COMMAND. +Use this if you want to share an infix's history with a regular +stand-alone command." + (if-let ((obj (transient--suffix-prototype command))) + (cl-letf (((symbol-function #'transient--show) #'ignore)) + (transient-infix-read obj)) + (error "Not a suffix command: `%s'" command))) + +;;;; Readers + +(defun transient-read-file (prompt _initial-input _history) + "Read a file." + (file-local-name (expand-file-name (read-file-name prompt)))) + +(defun transient-read-existing-file (prompt _initial-input _history) + "Read an existing file." + (file-local-name (expand-file-name (read-file-name prompt nil nil t)))) + +(defun transient-read-directory (prompt _initial-input _history) + "Read a directory." + (file-local-name (expand-file-name (read-directory-name prompt)))) + +(defun transient-read-existing-directory (prompt _initial-input _history) + "Read an existing directory." + (file-local-name (expand-file-name (read-directory-name prompt nil nil t)))) + +(defun transient-read-number-N0 (prompt initial-input history) + "Read a natural number (including zero) and return it as a string." + (transient--read-number-N prompt initial-input history t)) + +(defun transient-read-number-N+ (prompt initial-input history) + "Read a natural number (excluding zero) and return it as a string." + (transient--read-number-N prompt initial-input history nil)) + +(defun transient--read-number-N (prompt initial-input history include-zero) + (save-match-data + (cl-block nil + (while t + (let ((str (read-from-minibuffer prompt initial-input nil nil history))) + (when (or (string-equal str "") + (string-match-p (if include-zero + "\\`\\(0\\|[1-9][0-9]*\\)\\'" + "\\`[1-9][0-9]*\\'") + str)) + (cl-return str))) + (message "Please enter a natural number (%s zero)." + (if include-zero "including" "excluding")) + (sit-for 1))))) + +(defun transient-read-date (prompt default-time _history) + "Read a date using `org-read-date' (which see)." + (require 'org) + (when (fboundp 'org-read-date) + (org-read-date 'with-time nil nil prompt default-time))) + +;;;; Prompt + +(cl-defgeneric transient-prompt (obj) + "Return the prompt to be used to read infix object OBJ's value.") + +(cl-defmethod transient-prompt ((obj transient-infix)) + "Return the prompt to be used to read infix object OBJ's value. + +This implementation should be suitable for almost all infix +commands. + +If the value of OBJ's `prompt' slot is non-nil, then it must be +a string or a function. If it is a string, then use that. If +it is a function, then call that with OBJ as the only argument. +That function must return a string, which is then used as the +prompt. + +Otherwise, if the value of either the `argument' or `variable' +slot of OBJ is a string, then base the prompt on that (preferring +the former), appending either \"=\" (if it appears to be a +command-line option) or \": \". + +Finally fall through to using \"(BUG: no prompt): \" as the +prompt." + (if-let ((prompt (oref obj prompt))) + (let ((prompt (if (functionp prompt) + (funcall prompt obj) + prompt))) + (if (stringp prompt) + prompt + "(BUG: no prompt): ")) + (or (and-let* ((arg (and (slot-boundp obj 'argument) (oref obj argument)))) + (if (and (stringp arg) (string-suffix-p "=" arg)) + arg + (concat arg ": "))) + (and-let* ((var (and (slot-boundp obj 'variable) (oref obj variable)))) + (and (stringp var) + (concat var ": "))) + "(BUG: no prompt): "))) + +;;;; Set + +(cl-defgeneric transient-infix-set (obj value) + "Set the value of infix object OBJ to VALUE.") + +(cl-defmethod transient-infix-set ((obj transient-infix) value) + "Set the value of infix object OBJ to VALUE." + (oset obj value value)) + +(cl-defmethod transient-infix-set :after ((obj transient-argument) value) + "Unset incompatible infix arguments." + (when-let* ((value) + (val (transient-infix-value obj)) + (arg (if (slot-boundp obj 'argument) + (oref obj argument) + (oref obj argument-format))) + (spec (oref transient--prefix incompatible)) + (filter (lambda (x rule) + (and (member x rule) + (remove x rule)))) + (incomp (nconc + (cl-mapcan (apply-partially filter arg) spec) + (and (not (equal val arg)) + (cl-mapcan (apply-partially filter val) spec))))) + (dolist (obj transient--suffixes) + (when-let* (((cl-typep obj 'transient-argument)) + (val (transient-infix-value obj)) + (arg (if (slot-boundp obj 'argument) + (oref obj argument) + (oref obj argument-format))) + ((if (equal val arg) + (member arg incomp) + (or (member val incomp) + (member arg incomp))))) + (transient-infix-set obj nil))))) + +(defun transient-prefix-set (value) + "Set the value of the active transient prefix to VALUE. +Intended for use by transient suffix commands." + (oset transient--prefix value value) + (setq transient--refreshp 'updated-value)) + +(cl-defgeneric transient-set-value (obj) + "Persist the value of the transient prefix OBJ. +Only intended for use by `transient-set'. +Also see `transient-prefix-set'.") + +(cl-defmethod transient-set-value ((obj transient-prefix)) + (oset (oref obj prototype) value (transient-get-value)) + (transient--history-push obj)) + +;;;; Save + +(cl-defgeneric transient-save-value (obj) + "Save the value of the transient prefix OBJ.") + +(cl-defmethod transient-save-value ((obj transient-prefix)) + (let ((value (transient-get-value))) + (oset (oref obj prototype) value value) + (setf (alist-get (oref obj command) transient-values) value) + (transient-save-values)) + (transient--history-push obj)) + +;;;; Reset + +(cl-defgeneric transient-reset-value (obj) + "Clear the set and saved values of the transient prefix OBJ.") + +(cl-defmethod transient-reset-value ((obj transient-prefix)) + (let ((value (transient-default-value obj))) + (oset obj value value) + (oset (oref obj prototype) value value) + (setf (alist-get (oref obj command) transient-values nil 'remove) nil) + (transient-save-values)) + (transient--history-push obj) + (mapc #'transient-init-value transient--suffixes)) + +;;;; Get + +(defun transient-args (prefix) + "Return the value of the transient prefix command PREFIX. +If the current command was invoked from the transient prefix +command PREFIX, then return the active infix arguments. If +the current command was not invoked from PREFIX, then return +the set, saved or default value for PREFIX." + (cl-mapcan #'transient--get-wrapped-value (transient-suffixes prefix))) + +(defun transient-suffixes (prefix) + "Return the suffix objects of the transient prefix command PREFIX." + (if (eq transient-current-command prefix) + transient-current-suffixes + (let ((transient--prefix (transient--init-prefix prefix))) + (transient--flatten-suffixes + (transient--init-suffixes prefix))))) + +(defun transient-get-value () + (transient--with-emergency-exit :get-value + (cl-mapcan (lambda (obj) + (and (or (not (slot-exists-p obj 'unsavable)) + (not (oref obj unsavable))) + (transient--get-wrapped-value obj))) + (or transient--suffixes transient-current-suffixes)))) + +(defun transient--get-wrapped-value (obj) + (and-let* ((value (transient-infix-value obj))) + (pcase-exhaustive (and (slot-exists-p obj 'multi-value) + (oref obj multi-value)) + ('nil (list value)) + ((or 't 'rest) (list value)) + ('repeat value)))) + +(cl-defgeneric transient-infix-value (obj) + "Return the value of the suffix object OBJ. + +This function is called by `transient-args' (which see), meaning +this function is how the value of a transient is determined so +that the invoked suffix command can use it. + +Currently most values are strings, but that is not set in stone. +Nil is not a value, it means \"no value\". + +Usually only infixes have a value, but see the method for +`transient-suffix'.") + +(cl-defmethod transient-infix-value ((_ transient-suffix)) + "Return nil, which means \"no value\". + +Infix arguments contribute the transient's value while suffix +commands consume it. This function is called for suffixes anyway +because a command that both contributes to the transient's value +and also consumes it is not completely unconceivable. + +If you define such a command, then you must define a derived +class and implement this function because this default method +does nothing." nil) + +(cl-defmethod transient-infix-value ((obj transient-infix)) + "Return the value of OBJ's `value' slot." + (oref obj value)) + +(cl-defmethod transient-infix-value ((obj transient-option)) + "Return ARGUMENT and VALUE as a unit or nil if the latter is nil." + (and-let* ((value (oref obj value))) + (let ((arg (oref obj argument))) + (pcase-exhaustive (oref obj multi-value) + ('nil (concat arg value)) + ((or 't 'rest) (cons arg value)) + ('repeat (mapcar (lambda (v) (concat arg v)) value)))))) + +(cl-defmethod transient-infix-value ((_ transient-variable)) + "Return nil, which means \"no value\". + +Setting the value of a variable is done by, well, setting the +value of the variable. I.e., this is a side-effect and does +not contribute to the value of the transient." + nil) + +;;;; Utilities + +(defun transient-arg-value (arg args) + "Return the value of ARG as it appears in ARGS. + +For a switch return a boolean. For an option return the value as +a string, using the empty string for the empty value, or nil if +the option does not appear in ARGS." + (if (string-suffix-p "=" arg) + (save-match-data + (and-let* ((match (let ((case-fold-search nil) + (re (format "\\`%s\\(?:=\\(.+\\)\\)?\\'" + (substring arg 0 -1)))) + (cl-find-if (lambda (a) + (and (stringp a) + (string-match re a))) + args)))) + (or (match-string 1 match) ""))) + (and (member arg args) t))) + +(defun transient-scope () + "Return the value of the `scope' slot of the current prefix." + (oref (transient-prefix-object) scope)) + +;;; History + +(cl-defgeneric transient--history-key (obj) + "Return OBJ's history key. +If the value of the `history-key' slot is non-nil, then return +that. Otherwise return the value of the `command' slot." + (or (oref obj history-key) + (oref obj command))) + +(cl-defgeneric transient--history-push (obj) + "Push the current value of OBJ to its entry in `transient-history'." + (let ((key (transient--history-key obj))) + (setf (alist-get key transient-history) + (let ((args (transient-get-value))) + (cons args (delete args (alist-get key transient-history))))))) + +(cl-defgeneric transient--history-init (obj) + "Initialize OBJ's `history' slot. +This is the transient-wide history; many individual infixes also +have a history of their own.") + +(cl-defmethod transient--history-init ((obj transient-prefix)) + "Initialize OBJ's `history' slot from the variable `transient-history'." + (let ((val (oref obj value))) + (oset obj history + (cons val (delete val (alist-get (transient--history-key obj) + transient-history)))))) + +;;; Draw + +(defun transient--show-brief () + (let ((message-log-max nil)) + (if (and transient-show-popup (<= transient-show-popup 0)) + (message "%s-" (key-description (this-command-keys))) + (message + "%s- [%s] %s" + (key-description (this-command-keys)) + (oref transient--prefix command) + (mapconcat + #'identity + (sort + (cl-mapcan + (lambda (suffix) + (let ((key (kbd (oref suffix key)))) + ;; Don't list any common commands. + (and (not (memq (oref suffix command) + `(,(lookup-key transient-map key) + ,(lookup-key transient-sticky-map key) + ;; From transient-common-commands: + transient-set + transient-save + transient-history-prev + transient-history-next + transient-quit-one + transient-toggle-common + transient-set-level))) + (list (propertize (oref suffix key) 'face 'transient-key))))) + transient--suffixes) + #'string<) + (propertize "|" 'face 'transient-delimiter)))))) + +(defun transient--show () + (transient--timer-cancel) + (setq transient--showp t) + (let ((transient--shadowed-buffer (current-buffer)) + (focus nil)) + (setq transient--buffer (get-buffer-create transient--buffer-name)) + (with-current-buffer transient--buffer + (when transient-enable-popup-navigation + (setq focus (or (button-get (point) 'command) + (and (not (bobp)) + (button-get (1- (point)) 'command)) + (transient--heading-at-point)))) + (erase-buffer) + (run-hooks 'transient-setup-buffer-hook) + (when transient-force-fixed-pitch + (transient--force-fixed-pitch)) + (setq window-size-fixed t) + (when (bound-and-true-p tab-line-format) + (setq tab-line-format nil)) + (setq header-line-format nil) + (setq mode-line-format + (if (or (natnump transient-mode-line-format) + (eq transient-mode-line-format 'line)) + nil + transient-mode-line-format)) + (setq mode-line-buffer-identification + (symbol-name (oref transient--prefix command))) + (if transient-enable-popup-navigation + (setq-local cursor-in-non-selected-windows 'box) + (setq cursor-type nil)) + (setq display-line-numbers nil) + (setq show-trailing-whitespace nil) + (transient--insert-groups) + (when (or transient--helpp transient--editp) + (transient--insert-help)) + (when-let ((line (transient--separator-line))) + (insert line))) + (unless (window-live-p transient--window) + (setq transient--window + (display-buffer transient--buffer + transient-display-buffer-action))) + (when (window-live-p transient--window) + (with-selected-window transient--window + (goto-char (point-min)) + (when transient-enable-popup-navigation + (transient--goto-button focus)) + (transient--fit-window-to-buffer transient--window))))) + +(defun transient--fit-window-to-buffer (window) + (let ((window-resize-pixelwise t) + (window-size-fixed nil)) + (if (eq (car (window-parameter window 'quit-restore)) 'other) + ;; Grow but never shrink window that previously displayed + ;; another buffer and is going to display that again. + (fit-window-to-buffer window nil (window-height window)) + (fit-window-to-buffer window nil 1)))) + +(defun transient--separator-line () + (and-let* ((height (cond ((not window-system) nil) + ((natnump transient-mode-line-format) + transient-mode-line-format) + ((eq transient-mode-line-format 'line) 1))) + (face `(,@(and (>= emacs-major-version 27) '(:extend t)) + :background + ,(or (face-foreground (transient--key-face nil 'non-suffix) + nil t) + "#gray60")))) + (concat (propertize "__" 'face face 'display `(space :height (,height))) + (propertize "\n" 'face face 'line-height t)))) + +(defmacro transient-with-shadowed-buffer (&rest body) + "While in the transient buffer, temporarily make the shadowed buffer current." + (declare (indent 0) (debug t)) + `(with-current-buffer (or transient--shadowed-buffer (current-buffer)) + ,@body)) + +(defun transient--insert-groups () + (let ((groups (cl-mapcan (lambda (group) + (let ((hide (oref group hide))) + (and (not (and (functionp hide) + (transient-with-shadowed-buffer + (funcall hide)))) + (list group)))) + transient--layout))) + (while-let ((group (pop groups))) + (transient--insert-group group) + (when groups + (insert ?\n))))) + +(defvar transient--max-group-level 1) + +(cl-defgeneric transient--insert-group (group) + "Format GROUP and its elements and insert the result.") + +(cl-defmethod transient--insert-group :around ((group transient-group)) + "Insert GROUP's description, if any." + (when-let ((desc (transient-with-shadowed-buffer + (transient-format-description group)))) + (insert desc ?\n)) + (let ((transient--max-group-level + (max (oref group level) transient--max-group-level)) + (transient--pending-group group)) + (cl-call-next-method group))) + +(cl-defmethod transient--insert-group ((group transient-row)) + (transient--maybe-pad-keys group) + (dolist (suffix (oref group suffixes)) + (insert (transient-with-shadowed-buffer (transient-format suffix))) + (insert " ")) + (insert ?\n)) + +(cl-defmethod transient--insert-group ((group transient-column)) + (transient--maybe-pad-keys group) + (dolist (suffix (oref group suffixes)) + (let ((str (transient-with-shadowed-buffer (transient-format suffix)))) + (insert str) + (unless (string-match-p ".\n\\'" str) + (insert ?\n))))) + +(cl-defmethod transient--insert-group ((group transient-columns)) + (let* ((columns + (mapcar + (lambda (column) + (transient--maybe-pad-keys column group) + (transient-with-shadowed-buffer + (let* ((transient--pending-group column) + (rows (mapcar #'transient-format (oref column suffixes)))) + (if-let ((desc (transient-format-description column))) + (cons desc rows) + rows)))) + (oref group suffixes))) + (vp (or (oref transient--prefix variable-pitch) + transient-align-variable-pitch)) + (rs (apply #'max (mapcar #'length columns))) + (cs (length columns)) + (cw (mapcar (let ((widths (oref transient--prefix column-widths))) + (lambda (col) + (apply + #'max + (if-let ((min (pop widths))) + (if vp (* min (transient--pixel-width " ")) min) + 0) + (mapcar (if vp #'transient--pixel-width #'length) + col)))) + columns)) + (cc (transient--seq-reductions-from + (apply-partially #'+ (* 2 (if vp (transient--pixel-width " ") 1))) + cw 0))) + (if transient-force-single-column + (dotimes (c cs) + (dotimes (r rs) + (when-let ((cell (nth r (nth c columns)))) + (unless (equal cell "") + (insert cell ?\n)))) + (unless (= c (1- cs)) + (insert ?\n))) + (dotimes (r rs) + (dotimes (c cs) + (if vp + (progn + (when-let ((cell (nth r (nth c columns)))) + (insert cell)) + (if (= c (1- cs)) + (insert ?\n) + (insert (propertize " " 'display + `(space :align-to (,(nth (1+ c) cc))))))) + (when (> c 0) + (insert (make-string (max 1 (- (nth c cc) (current-column))) + ?\s))) + (when-let ((cell (nth r (nth c columns)))) + (insert cell)) + (when (= c (1- cs)) + (insert ?\n)))))))) + +(cl-defmethod transient--insert-group ((group transient-subgroups)) + (let ((subgroups (oref group suffixes))) + (while-let ((subgroup (pop subgroups))) + (transient--maybe-pad-keys subgroup group) + (transient--insert-group subgroup) + (when subgroups + (insert ?\n))))) + +(cl-defgeneric transient-format (obj) + "Format and return OBJ for display. + +When this function is called, then the current buffer is some +temporary buffer. If you need the buffer from which the prefix +command was invoked to be current, then do so by temporarily +making `transient--original-buffer' current.") + +(cl-defmethod transient-format ((arg string)) + "Return the string ARG after applying the `transient-heading' face." + (propertize arg 'face 'transient-heading)) + +(cl-defmethod transient-format ((_ null)) + "Return a string containing just the newline character." + "\n") + +(cl-defmethod transient-format ((arg integer)) + "Return a string containing just the ARG character." + (char-to-string arg)) + +(cl-defmethod transient-format :around ((obj transient-suffix)) + "Add additional formatting if appropriate. +When reading user input for this infix, then highlight it. +When edit-mode is enabled, then prepend the level information. +When `transient-enable-popup-navigation' is non-nil then format +as a button." + (let ((str (cl-call-next-method obj))) + (when (and (cl-typep obj 'transient-infix) + (eq (oref obj command) this-original-command) + (active-minibuffer-window)) + (setq str (transient--add-face str 'transient-active-infix))) + (when transient--editp + (setq str (concat (let ((level (oref obj level))) + (propertize (format " %s " level) + 'face (if (transient--use-level-p level t) + 'transient-enabled-suffix + 'transient-disabled-suffix))) + str))) + (when (and transient-enable-popup-navigation + (slot-boundp obj 'command)) + (setq str (make-text-button str nil + 'type 'transient + 'command (oref obj command)))) + str)) + +(cl-defmethod transient-format ((obj transient-infix)) + "Return a string generated using OBJ's `format'. +%k is formatted using `transient-format-key'. +%d is formatted using `transient-format-description'. +%v is formatted using `transient-format-value'." + (format-spec (oref obj format) + `((?k . ,(transient-format-key obj)) + (?d . ,(transient-format-description obj)) + (?v . ,(transient-format-value obj))))) + +(cl-defmethod transient-format ((obj transient-suffix)) + "Return a string generated using OBJ's `format'. +%k is formatted using `transient-format-key'. +%d is formatted using `transient-format-description'." + (format-spec (oref obj format) + `((?k . ,(transient-format-key obj)) + (?d . ,(transient-format-description obj))))) + +(cl-defgeneric transient-format-key (obj) + "Format OBJ's `key' for display and return the result.") + +(cl-defmethod transient-format-key :around ((obj transient-suffix)) + "Add `transient-inapt-suffix' face if suffix is inapt." + (let ((str (cl-call-next-method))) + (if (oref obj inapt) + (transient--add-face str 'transient-inapt-suffix) + str))) + +(cl-defmethod transient-format-key ((obj transient-suffix)) + "Format OBJ's `key' for display and return the result." + (let ((key (if (slot-boundp obj 'key) (oref obj key) "")) + (cmd (and (slot-boundp obj 'command) (oref obj command)))) + (when-let ((width (oref transient--pending-group pad-keys))) + (setq key (truncate-string-to-width key width nil ?\s))) + (if transient--redisplay-key + (let ((len (length transient--redisplay-key)) + (seq (cl-coerce (edmacro-parse-keys key t) 'list))) + (cond + ((member (seq-take seq len) + (list transient--redisplay-key + (thread-last transient--redisplay-key + (cl-substitute ?- 'kp-subtract) + (cl-substitute ?= 'kp-equal) + (cl-substitute ?+ 'kp-add)))) + (let ((pre (key-description (vconcat (seq-take seq len)))) + (suf (key-description (vconcat (seq-drop seq len))))) + (setq pre (string-replace "RET" "C-m" pre)) + (setq pre (string-replace "TAB" "C-i" pre)) + (setq suf (string-replace "RET" "C-m" suf)) + (setq suf (string-replace "TAB" "C-i" suf)) + ;; We use e.g., "-k" instead of the more correct "- k", + ;; because the former is prettier. If we did that in + ;; the definition, then we want to drop the space that + ;; is reinserted above. False-positives are possible + ;; for silly bindings like "-C-c C-c". + (unless (string-search " " key) + (setq pre (string-replace " " "" pre)) + (setq suf (string-replace " " "" suf))) + (concat (propertize pre 'face 'transient-unreachable-key) + (and (string-prefix-p (concat pre " ") key) " ") + (propertize suf 'face (transient--key-face cmd)) + (save-excursion + (and (string-match " +\\'" key) + (propertize (match-string 0 key) + 'face 'fixed-pitch)))))) + ((transient--lookup-key transient-sticky-map (kbd key)) + (propertize key 'face (transient--key-face cmd))) + (t + (propertize key 'face 'transient-unreachable-key)))) + (propertize key 'face (transient--key-face cmd))))) + +(cl-defmethod transient-format-key :around ((obj transient-argument)) + "Handle `transient-highlight-mismatched-keys'." + (let ((key (cl-call-next-method obj))) + (cond + ((not transient-highlight-mismatched-keys) key) + ((not (slot-boundp obj 'shortarg)) + (transient--add-face key 'transient-nonstandard-key)) + ((not (string-equal key (oref obj shortarg))) + (transient--add-face key 'transient-mismatched-key)) + (key)))) + +(cl-defgeneric transient-format-description (obj) + "Format OBJ's `description' for display and return the result.") + +(cl-defmethod transient-format-description ((obj transient-suffix)) + "The `description' slot may be a function, in which case that is +called inside the correct buffer (see `transient--insert-group') +and its value is returned to the caller." + (transient--get-description obj)) + +(cl-defmethod transient-format-description ((obj transient-value-preset)) + (pcase-let* (((eieio description key set) obj) + ((eieio value) transient--prefix) + (active (seq-set-equal-p set value))) + (format + "%s %s" + (propertize (or description (format "Preset %s" key)) + 'face (and active 'transient-argument)) + (format (propertize "(%s)" 'face 'transient-delimiter) + (mapconcat (lambda (arg) + (propertize + arg 'face (cond (active 'transient-argument) + ((member arg value) + '((:weight demibold) + transient-inactive-argument)) + ('transient-inactive-argument)))) + set " "))))) + +(cl-defmethod transient-format-description ((obj transient-group)) + "Format the description by calling the next method. If the result +doesn't use the `face' property at all, then apply the face +`transient-heading' to the complete string." + (and-let* ((desc (transient--get-description obj))) + (cond ((oref obj inapt) + (propertize desc 'face 'transient-inapt-suffix)) + ((text-property-not-all 0 (length desc) 'face nil desc) + desc) + ((propertize desc 'face 'transient-heading))))) + +(cl-defmethod transient-format-description :around ((obj transient-suffix)) + "Format the description by calling the next method. If the result +is nil, then use \"(BUG: no description)\" as the description. +If the OBJ's `key' is currently unreachable, then apply the face +`transient-unreachable' to the complete string." + (let ((desc (or (cl-call-next-method obj) + (and (slot-boundp transient--prefix 'suffix-description) + (funcall (oref transient--prefix suffix-description) + obj))))) + (if desc + (when-let ((face (transient--get-face obj 'face))) + (setq desc (transient--add-face desc face t))) + (setq desc (propertize "(BUG: no description)" 'face 'error))) + (when (if transient--all-levels-p + (> (oref obj level) transient--default-prefix-level) + (and transient-highlight-higher-levels + (> (max (oref obj level) transient--max-group-level) + transient--default-prefix-level))) + (setq desc (transient--add-face desc 'transient-higher-level))) + (when-let ((inapt-face (and (oref obj inapt) + (transient--get-face obj 'inapt-face)))) + (setq desc (transient--add-face desc inapt-face))) + (when (and (slot-boundp obj 'key) + (transient--key-unreachable-p obj)) + (setq desc (transient--add-face desc 'transient-unreachable))) + desc)) + +(cl-defgeneric transient-format-value (obj) + "Format OBJ's value for display and return the result.") + +(cl-defmethod transient-format-value ((obj transient-suffix)) + (propertize (oref obj argument) + 'face (if (oref obj value) + 'transient-argument + 'transient-inactive-argument))) + +(cl-defmethod transient-format-value ((obj transient-option)) + (let ((argument (oref obj argument))) + (if-let ((value (oref obj value))) + (pcase-exhaustive (oref obj multi-value) + ('nil + (concat (propertize argument 'face 'transient-argument) + (propertize value 'face 'transient-value))) + ((or 't 'rest) + (concat (propertize (if (string-suffix-p " " argument) + argument + (concat argument " ")) + 'face 'transient-argument) + (propertize (mapconcat #'prin1-to-string value " ") + 'face 'transient-value))) + ('repeat + (mapconcat (lambda (value) + (concat (propertize argument 'face 'transient-argument) + (propertize value 'face 'transient-value))) + value " "))) + (propertize argument 'face 'transient-inactive-argument)))) + +(cl-defmethod transient-format-value ((obj transient-switches)) + (with-slots (value argument-format choices) obj + (format (propertize argument-format + 'face (if value + 'transient-argument + 'transient-inactive-argument)) + (format + (propertize "[%s]" 'face 'transient-delimiter) + (mapconcat + (lambda (choice) + (propertize choice 'face + (if (equal (format argument-format choice) value) + 'transient-value + 'transient-inactive-value))) + choices + (propertize "|" 'face 'transient-delimiter)))))) + +(cl-defmethod transient--get-description ((obj transient-child)) + (and-let* ((desc (oref obj description))) + (if (functionp desc) + (if (= (car (transient--func-arity desc)) 1) + (funcall desc obj) + (funcall desc)) + desc))) + +(cl-defmethod transient--get-face ((obj transient-suffix) slot) + (and-let* (((slot-boundp obj slot)) + (face (slot-value obj slot))) + (if (and (not (facep face)) + (functionp face)) + (let ((transient--pending-suffix obj)) + (if (= (car (transient--func-arity face)) 1) + (funcall face obj) + (funcall face))) + face))) + +(defun transient--add-face (string face &optional append beg end) + (let ((str (copy-sequence string))) + (add-face-text-property (or beg 0) (or end (length str)) face append str) + str)) + +(defun transient--key-face (&optional cmd enforce-type) + (or (and transient-semantic-coloring + (not transient--helpp) + (not transient--editp) + (or (and cmd (get cmd 'transient-face)) + (get (transient--get-pre-command cmd enforce-type) + 'transient-face))) + (if cmd 'transient-key 'transient-key-noop))) + +(defun transient--key-unreachable-p (obj) + (and transient--redisplay-key + (let ((key (oref obj key))) + (not (or (equal (seq-take (cl-coerce (edmacro-parse-keys key t) 'list) + (length transient--redisplay-key)) + transient--redisplay-key) + (transient--lookup-key transient-sticky-map (kbd key))))))) + +(defun transient--lookup-key (keymap key) + (let ((val (lookup-key keymap key))) + (and val (not (integerp val)) val))) + +(defun transient--maybe-pad-keys (group &optional parent) + (when-let ((pad (or (oref group pad-keys) + (and parent (oref parent pad-keys))))) + (oset group pad-keys + (apply #'max + (if (integerp pad) pad 0) + (seq-keep (lambda (suffix) + (and (eieio-object-p suffix) + (slot-boundp suffix 'key) + (length (oref suffix key)))) + (oref group suffixes)))))) + +(defun transient--pixel-width (string) + (save-window-excursion + (with-temp-buffer + (insert string) + (set-window-dedicated-p nil nil) + (set-window-buffer nil (current-buffer)) + (car (window-text-pixel-size + nil (line-beginning-position) (point)))))) + +(defun transient-command-summary-or-name (obj) + "Return the summary or name of the command represented by OBJ. + +If the command has a doc-string, then return the first line of +that, else its name. + +Intended to be temporarily used as the `:suffix-description' of +a prefix command, while porting a regular keymap to a transient." + (let ((command (oref obj command))) + (if-let ((doc (documentation command))) + (propertize (car (split-string doc "\n")) 'face 'font-lock-doc-face) + (propertize (symbol-name command) 'face 'font-lock-function-name-face)))) + +;;; Help + +(cl-defgeneric transient-show-help (obj) + "Show documentation for the command represented by OBJ.") + +(cl-defmethod transient-show-help ((obj transient-prefix)) + "Call `show-help' if non-nil, else show `info-manual', +if non-nil, else show the `man-page' if non-nil, else use +`describe-function'." + (with-slots (show-help info-manual man-page command) obj + (cond (show-help (funcall show-help obj)) + (info-manual (transient--show-manual info-manual)) + (man-page (transient--show-manpage man-page)) + ((transient--describe-function command))))) + +(cl-defmethod transient-show-help ((obj transient-suffix)) + "Call `show-help' if non-nil, else use `describe-function'. +Also used to dispatch showing documentation for the current +prefix. If the suffix is a sub-prefix, then also call the +prefix method." + (cond + ((eq this-command 'transient-help) + (transient-show-help transient--prefix)) + ((let ((prefix (get (oref obj command) + 'transient--prefix))) + (and prefix (not (eq (oref transient--prefix command) this-command)) + (prog1 t (transient-show-help prefix))))) + ((if-let ((show-help (oref obj show-help))) + (funcall show-help obj) + (transient--describe-function this-command))))) + +(cl-defmethod transient-show-help ((obj transient-infix)) + "Call `show-help' if non-nil, else show the `man-page' +if non-nil, else use `describe-function'. When showing the +manpage, then try to jump to the correct location." + (if-let ((show-help (oref obj show-help))) + (funcall show-help obj) + (if-let ((man-page (oref transient--prefix man-page)) + (argument (and (slot-boundp obj 'argument) + (oref obj argument)))) + (transient--show-manpage man-page argument) + (transient--describe-function this-command)))) + +;; `cl-generic-generalizers' doesn't support `command' et al. +(cl-defmethod transient-show-help (cmd) + "Show the command doc-string." + (transient--describe-function cmd)) + +(defun transient--describe-function (fn) + (describe-function fn) + (unless (derived-mode-p 'help-mode) + (when-let* ((buf (get-buffer "*Help*")) + (win (or (and buf (get-buffer-window buf)) + (cl-find-if (lambda (win) + (with-current-buffer (window-buffer win) + (derived-mode-p 'help-mode))) + (window-list))))) + (select-window win)))) + +(defun transient--show-manual (manual) + (info manual)) + +(defun transient--show-manpage (manpage &optional argument) + (require 'man) + (let* ((Man-notify-method 'meek) + (buf (Man-getpage-in-background manpage)) + (proc (get-buffer-process buf))) + (while (and proc (eq (process-status proc) 'run)) + (accept-process-output proc)) + (switch-to-buffer buf) + (when argument + (transient--goto-argument-description argument)))) + +(defun transient--goto-argument-description (arg) + (goto-char (point-min)) + (let ((case-fold-search nil) + ;; This matches preceding/proceeding options. Options + ;; such as "-a", "-S[<keyid>]", and "--grep=<pattern>" + ;; are matched by this regex without the shy group. + ;; The ". " in the shy group is for options such as + ;; "-m parent-number", and the "-[^[:space:]]+ " is + ;; for options such as "--mainline parent-number" + (others "-\\(?:. \\|-[^[:space:]]+ \\)?[^[:space:]]+")) + (when (re-search-forward + (if (equal arg "--") + ;; Special case. + "^[\t\s]+\\(--\\(?: \\|$\\)\\|\\[--\\]\\)" + ;; Should start with whitespace and may have + ;; any number of options before and/or after. + (format + "^[\t\s]+\\(?:%s, \\)*?\\(?1:%s\\)%s\\(?:, %s\\)*$" + others + ;; Options don't necessarily end in an "=" + ;; (e.g., "--gpg-sign[=<keyid>]") + (string-remove-suffix "=" arg) + ;; Simple options don't end in an "=". Splitting this + ;; into 2 cases should make getting false positives + ;; less likely. + (if (string-suffix-p "=" arg) + ;; "[^[:space:]]*[^.[:space:]]" matches the option + ;; value, which is usually after the option name + ;; and either '=' or '[='. The value can't end in + ;; a period, as that means it's being used at the + ;; end of a sentence. The space is for options + ;; such as '--mainline parent-number'. + "\\(?: \\|\\[?=\\)[^[:space:]]*[^.[:space:]]" + ;; Either this doesn't match anything (e.g., "-a"), + ;; or the option is followed by a value delimited + ;; by a "[", "<", or ":". A space might appear + ;; before this value, as in "-f <file>". The + ;; space alternative is for options such as + ;; "-m parent-number". + "\\(?:\\(?: \\| ?[\\[<:]\\)[^[:space:]]*[^.[:space:]]\\)?") + others)) + nil t) + (goto-char (match-beginning 1))))) + +(defun transient--insert-help () + (unless (looking-back "\n\n" 2) + (insert "\n")) + (when transient--helpp + (insert + (format (propertize "\ +Type a %s to show help for that suffix command, or %s to show manual. +Type %s to exit help.\n" + 'face 'transient-heading) + (propertize "<KEY>" 'face 'transient-key) + (propertize "?" 'face 'transient-key) + (propertize "C-g" 'face 'transient-key)))) + (when transient--editp + (unless transient--helpp + (insert + (format (propertize "\ +Type a %s to set level for that suffix command. +Type %s to set what levels are available for this prefix command.\n" + 'face 'transient-heading) + (propertize "<KEY>" 'face 'transient-key) + (propertize "C-x l" 'face 'transient-key)))) + (with-slots (level) transient--prefix + (insert + (format (propertize " +Suffixes on levels %s are available. +Suffixes on levels %s and %s are unavailable.\n" + 'face 'transient-heading) + (propertize (format "1-%s" level) + 'face 'transient-enabled-suffix) + (propertize " 0 " + 'face 'transient-disabled-suffix) + (propertize (format ">=%s" (1+ level)) + 'face 'transient-disabled-suffix)))))) + +;;; Popup Navigation + +(defun transient-scroll-up (&optional arg) + "Scroll text of transient popup window upward ARG lines. +If ARG is nil scroll near full screen. This is a wrapper +around `scroll-up-command' (which see)." + (interactive "^P") + (with-selected-window transient--window + (scroll-up-command arg))) + +(defun transient-scroll-down (&optional arg) + "Scroll text of transient popup window down ARG lines. +If ARG is nil scroll near full screen. This is a wrapper +around `scroll-down-command' (which see)." + (interactive "^P") + (with-selected-window transient--window + (scroll-down-command arg))) + +(defun transient-backward-button (n) + "Move to the previous button in the transient popup buffer. +See `backward-button' for information about N." + (interactive "p") + (with-selected-window transient--window + (backward-button n t))) + +(defun transient-forward-button (n) + "Move to the next button in the transient popup buffer. +See `forward-button' for information about N." + (interactive "p") + (with-selected-window transient--window + (forward-button n t))) + +(define-button-type 'transient + 'face nil + 'keymap transient-button-map) + +(defun transient--goto-button (command) + (cond + ((stringp command) + (when (re-search-forward (concat "^" (regexp-quote command)) nil t) + (goto-char (match-beginning 0)))) + (command + (while (and (ignore-errors (forward-button 1)) + (not (eq (button-get (button-at (point)) 'command) command)))) + (unless (eq (button-get (button-at (point)) 'command) command) + (goto-char (point-min)) + (forward-button 1))))) + +(defun transient--heading-at-point () + (and (eq (get-text-property (point) 'face) 'transient-heading) + (let ((beg (line-beginning-position))) + (buffer-substring-no-properties + beg (next-single-property-change + beg 'face nil (line-end-position)))))) + +;;; Compatibility +;;;; Popup Isearch + +(defvar-keymap transient--isearch-mode-map + :parent isearch-mode-map + "<remap> <isearch-exit>" #'transient-isearch-exit + "<remap> <isearch-cancel>" #'transient-isearch-cancel + "<remap> <isearch-abort>" #'transient-isearch-abort) + +(defun transient-isearch-backward (&optional regexp-p) + "Do incremental search backward. +With a prefix argument, do an incremental regular expression +search instead." + (interactive "P") + (transient--isearch-setup) + (let ((isearch-mode-map transient--isearch-mode-map)) + (isearch-mode nil regexp-p))) + +(defun transient-isearch-forward (&optional regexp-p) + "Do incremental search forward. +With a prefix argument, do an incremental regular expression +search instead." + (interactive "P") + (transient--isearch-setup) + (let ((isearch-mode-map transient--isearch-mode-map)) + (isearch-mode t regexp-p))) + +(defun transient-isearch-exit () + "Like `isearch-exit' but adapted for `transient'." + (interactive) + (isearch-exit) + (transient--isearch-exit)) + +(defun transient-isearch-cancel () + "Like `isearch-cancel' but adapted for `transient'." + (interactive) + (condition-case nil (isearch-cancel) (quit)) + (transient--isearch-exit)) + +(defun transient-isearch-abort () + "Like `isearch-abort' but adapted for `transient'." + (interactive) + (let ((around (lambda (fn) + (condition-case nil (funcall fn) (quit)) + (transient--isearch-exit)))) + (advice-add 'isearch-cancel :around around) + (unwind-protect + (isearch-abort) + (advice-remove 'isearch-cancel around)))) + +(defun transient--isearch-setup () + (select-window transient--window) + (transient--suspend-override t)) + +(defun transient--isearch-exit () + (select-window transient--original-window) + (transient--resume-override)) + +;;;; Edebug + +(defun transient--edebug-command-p () + (and (bound-and-true-p edebug-active) + (or (memq this-command '(top-level abort-recursive-edit)) + (string-prefix-p "edebug" (symbol-name this-command))))) + +;;;; Miscellaneous + +(cl-pushnew (list nil (concat "^\\s-*(" + (eval-when-compile + (regexp-opt + '("transient-define-prefix" + "transient-define-suffix" + "transient-define-infix" + "transient-define-argument") + t)) + "\\s-+\\(" lisp-mode-symbol-regexp "\\)") + 2) + lisp-imenu-generic-expression :test #'equal) + +(declare-function which-key-mode "which-key" (&optional arg)) + +(defun transient--suspend-which-key-mode () + (when (bound-and-true-p which-key-mode) + (which-key-mode -1) + (add-hook 'transient-exit-hook #'transient--resume-which-key-mode))) + +(defun transient--resume-which-key-mode () + (unless transient--prefix + (which-key-mode 1) + (remove-hook 'transient-exit-hook #'transient--resume-which-key-mode))) + +(defun transient-bind-q-to-quit () + "Modify some keymaps to bind \"q\" to the appropriate quit command. + +\"C-g\" is the default binding for such commands now, but Transient's +predecessor Magit-Popup used \"q\" instead. If you would like to get +that binding back, then call this function in your init file like so: + + (with-eval-after-load \\='transient + (transient-bind-q-to-quit)) + +Individual transients may already bind \"q\" to something else +and such a binding would shadow the quit binding. If that is the +case then \"Q\" is bound to whatever \"q\" would have been bound +to by setting `transient-substitute-key-function' to a function +that does that. Of course \"Q\" may already be bound to something +else, so that function binds \"M-q\" to that command instead. +Of course \"M-q\" may already be bound to something else, but +we stop there." + (keymap-set transient-base-map "q" #'transient-quit-one) + (keymap-set transient-sticky-map "q" #'transient-quit-seq) + (setq transient-substitute-key-function + #'transient-rebind-quit-commands)) + +(defun transient-rebind-quit-commands (obj) + "See `transient-bind-q-to-quit'." + (let ((key (oref obj key))) + (cond ((string-equal key "q") "Q") + ((string-equal key "Q") "M-q") + (key)))) + +(defun transient--force-fixed-pitch () + (require 'face-remap) + (face-remap-reset-base 'default) + (face-remap-add-relative 'default 'fixed-pitch)) + +(defun transient--func-arity (fn) + (func-arity (advice--cd*r (if (symbolp fn) (symbol-function fn) fn)))) + +(defun transient--seq-reductions-from (function sequence initial-value) + (let ((acc (list initial-value))) + (seq-doseq (elt sequence) + (push (funcall function (car acc) elt) acc)) + (nreverse acc))) + +;;; Font-Lock + +(defconst transient-font-lock-keywords + (eval-when-compile + `((,(concat "(" + (regexp-opt (list "transient-define-prefix" + "transient-define-infix" + "transient-define-argument" + "transient-define-suffix") + t) + "\\_>[ \t'(]*" + "\\(\\(?:\\sw\\|\\s_\\)+\\)?") + (1 'font-lock-keyword-face) + (2 'font-lock-function-name-face nil t))))) + +(font-lock-add-keywords 'emacs-lisp-mode transient-font-lock-keywords) + +;;; Auxiliary Classes +;;;; `transient-lisp-variable' + +(defclass transient-lisp-variable (transient-variable) + ((reader :initform #'transient-lisp-variable--reader) + (always-read :initform t) + (set-value :initarg :set-value :initform #'set)) + "[Experimental] Class used for Lisp variables.") + +(cl-defmethod transient-init-value ((obj transient-lisp-variable)) + (oset obj value (symbol-value (oref obj variable)))) + +(cl-defmethod transient-infix-set ((obj transient-lisp-variable) value) + (funcall (oref obj set-value) + (oref obj variable) + (oset obj value value))) + +(cl-defmethod transient-format-description ((obj transient-lisp-variable)) + (or (cl-call-next-method obj) + (symbol-name (oref obj variable)))) + +(cl-defmethod transient-format-value ((obj transient-lisp-variable)) + (propertize (prin1-to-string (oref obj value)) + 'face 'transient-value)) + +(cl-defmethod transient-prompt ((obj transient-lisp-variable)) + (if (and (slot-boundp obj 'prompt) + (oref obj prompt)) + (cl-call-next-method obj) + (format "Set %s: " (oref obj variable)))) + +(defun transient-lisp-variable--reader (prompt initial-input _history) + (read--expression prompt initial-input)) + +;;; _ +(provide 'transient) +;; Local Variables: +;; indent-tabs-mode: nil +;; checkdoc-symbol-words: ("command-line" "edit-mode" "help-mode") +;; End: +;;; transient.el ends here diff --git a/emacs/elpa/transient-20240626.947/transient.elc b/emacs/elpa/transient-20240626.947/transient.elc Binary files differ. diff --git a/emacs/elpa/transient-20240626.947/transient.info b/emacs/elpa/transient-20240626.947/transient.info @@ -0,0 +1,3273 @@ +This is transient.info, produced by makeinfo version 6.7 from +transient.texi. + + Copyright (C) 2018–2024 Free Software Foundation, Inc. + + 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 misc features +START-INFO-DIR-ENTRY +* Transient: (transient). Transient Commands. +END-INFO-DIR-ENTRY + + +File: transient.info, Node: Top, Next: Introduction, Up: (dir) + +Transient User and Developer Manual +*********************************** + +Transient is the library used to implement the keyboard-driven “menus” +in Magit. It is distributed as a separate package, so that it can be +used to implement similar menus in other packages. + + This manual can be bit hard to digest when getting started. A useful +resource to get over that hurdle is Psionic K’s interactive tutorial, +available at <https://github.com/positron-solutions/transient-showcase>. + +This manual is for Transient version 0.7.2. + + Copyright (C) 2018–2024 Free Software Foundation, Inc. + + 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:: +* Usage:: +* Modifying Existing Transients:: +* Defining New Commands:: +* Classes and Methods:: +* FAQ:: +* Keystroke Index:: +* Command and Function Index:: +* Variable Index:: +* Concept Index:: +* GNU General Public License:: + +— The Detailed Node Listing — + +Usage + +* Invoking Transients:: +* Aborting and Resuming Transients:: +* Common Suffix Commands:: +* Saving Values:: +* Using History:: +* Getting Help for Suffix Commands:: +* Enabling and Disabling Suffixes:: +* Other Commands:: +* Configuration:: + +Defining New Commands + +* Technical Introduction:: +* Defining Transients:: +* Binding Suffix and Infix Commands:: +* Defining Suffix and Infix Commands:: +* Using Infix Arguments:: +* Transient State:: + +Binding Suffix and Infix Commands + +* Group Specifications:: +* Suffix Specifications:: + + +Classes and Methods + +* Group Classes:: +* Group Methods:: +* Prefix Classes:: +* Suffix Classes:: +* Suffix Methods:: +* Prefix Slots:: +* Suffix Slots:: +* Predicate Slots:: + +Suffix Methods + +* Suffix Value Methods:: +* Suffix Format Methods:: + + + + +File: transient.info, Node: Introduction, Next: Usage, Prev: Top, Up: Top + +1 Introduction +************** + +Transient is the library used to implement the keyboard-driven “menus” +in Magit. It is distributed as a separate package, so that it can be +used to implement similar menus in other packages. + + This manual can be bit hard to digest when getting started. A useful +resource to get over that hurdle is Psionic K’s interactive tutorial, +available at <https://github.com/positron-solutions/transient-showcase>. + +Some things that Transient can do +================================= + + • Display current state of arguments + • Display and manage lifecycle of modal bindings + • Contextual user interface + • Flow control for wizard-like composition of interactive forms + • History & persistence + • Rendering arguments for controlling CLI programs + +Complexity in CLI programs +========================== + +Complexity tends to grow with time. How do you manage the complexity of +commands? Consider the humble shell command ‘ls’. It now has over +_fifty_ command line options. Some of these are boolean flags (‘ls +-l’). Some take arguments (‘ls --sort=s’). Some have no effect unless +paired with other flags (‘ls -lh’). Some are mutually exclusive. Some +shell commands even have so many options that they introduce +_subcommands_ (‘git branch’, ‘git commit’), each with their own rich set +of options (‘git branch -f’). + +Using Transient for composing interactive commands +================================================== + +What about Emacs commands used interactively? How do these handle +options? One solution is to make many versions of the same command, so +you don’t need to! Consider: ‘delete-other-windows’ vs. +‘delete-other-windows-vertically’ (among many similar examples). + + Some Emacs commands will simply prompt you for the next "argument" +(‘M-x switch-to-buffer’). Another common solution is to use prefix +arguments which usually start with ‘C-u’. Sometimes these are sensibly +numerical in nature (‘C-u 4 M-x forward-paragraph’ to move forward 4 +paragraphs). But sometimes they function instead as boolean "switches" +(‘C-u C-SPACE’ to jump to the last mark instead of just setting it, ‘C-u +C-u C-SPACE’ to unconditionally set the mark). Since there aren’t many +standards for the use of prefix options, you have to read the command’s +documentation to find out what the possibilities are. + + But when an Emacs command grows to have a truly large set of options +and arguments, with dependencies between them, lots of option values, +etc., these simple approaches just don’t scale. Transient is designed +to solve this issue. Think of it as the humble prefix argument ‘C-u’, +_raised to the power of 10_. Like ‘C-u’, it is key driven. Like the +shell, it supports boolean "flag" options, options that take arguments, +and even "sub-commands", with their own options. But instead of +searching through a man page or command documentation, well-designed +transients _guide_ their users to the relevant set of options (and even +their possible values!) directly, taking into account any important +pre-existing Emacs settings. And while for shell commands like ‘ls’, +there is only one way to "execute" (hit ‘Return’!), transients can +"execute" using multiple different keys tied to one of many +self-documenting _actions_ (imagine having 5 different colored return +keys on your keyboard!). Transients make navigating and setting large, +complex groups of command options and arguments easy. Fun even. Once +you’ve tried it, it’s hard to go back to the ‘C-u what can I do here +again?’ way. + + +File: transient.info, Node: Usage, Next: Modifying Existing Transients, Prev: Introduction, Up: Top + +2 Usage +******* + +* Menu: + +* Invoking Transients:: +* Aborting and Resuming Transients:: +* Common Suffix Commands:: +* Saving Values:: +* Using History:: +* Getting Help for Suffix Commands:: +* Enabling and Disabling Suffixes:: +* Other Commands:: +* Configuration:: + + +File: transient.info, Node: Invoking Transients, Next: Aborting and Resuming Transients, Up: Usage + +2.1 Invoking Transients +======================= + +A transient prefix command is invoked like any other command by pressing +the key that is bound to that command. The main difference to other +commands is that a transient prefix command activates a transient +keymap, which temporarily binds the transient’s infix and suffix +commands. Bindings from other keymaps may, or may not, be disabled +while the transient state is in effect. + + There are two kinds of commands that are available after invoking a +transient prefix command; infix and suffix commands. Infix commands set +some value (which is then shown in a popup buffer), without leaving the +transient. Suffix commands, on the other hand, usually quit the +transient and they may use the values set by the infix commands, i.e., +the infix *arguments*. + + Instead of setting arguments to be used by a suffix command, infix +commands may also set some value by side-effect, e.g., by setting the +value of some variable. + + +File: transient.info, Node: Aborting and Resuming Transients, Next: Common Suffix Commands, Prev: Invoking Transients, Up: Usage + +2.2 Aborting and Resuming Transients +==================================== + +To quit the transient without invoking a suffix command press ‘C-g’. + + Key bindings in transient keymaps may be longer than a single event. +After pressing a valid prefix key, all commands whose bindings do not +begin with that prefix key are temporarily unavailable and grayed out. +To abort the prefix key press ‘C-g’ (which in this case only quits the +prefix key, but not the complete transient). + + A transient prefix command can be bound as a suffix of another +transient. Invoking such a suffix replaces the current transient state +with a new transient state, i.e., the available bindings change and the +information displayed in the popup buffer is updated accordingly. +Pressing ‘C-g’ while a nested transient is active only quits the +innermost transient, causing a return to the previous transient. + + ‘C-q’ or ‘C-z’ on the other hand always exits all transients. If you +use the latter, then you can later resume the stack of transients using +‘M-x transient-resume’. + +‘C-g’ (‘transient-quit-seq’) +‘C-g’ (‘transient-quit-one’) + This key quits the currently active incomplete key sequence, if + any, or else the current transient. When quitting the current + transient, it returns to the previous transient, if any. + + Transient’s predecessor bound ‘q’ instead of ‘C-g’ to the quit +command. To learn how to get that binding back see +‘transient-bind-q-to-quit’’s documentation string. + +‘C-q’ (‘transient-quit-all’) + This command quits the currently active incomplete key sequence, if + any, and all transients, including the active transient and all + suspended transients, if any. + +‘C-z’ (‘transient-suspend’) + Like ‘transient-quit-all’, this command quits an incomplete key + sequence, if any, and all transients. Additionally, it saves the + stack of transients so that it can easily be resumed (which is + particularly useful if you quickly need to do “something else” and + the stack is deeper than a single transient, and/or you have + already changed the values of some infix arguments). + + Note that only a single stack of transients can be saved at a time. + If another stack is already saved, then saving a new stack discards + the previous stack. + +‘M-x transient-resume’ + This command resumes the previously suspended stack of transients, + if any. + + +File: transient.info, Node: Common Suffix Commands, Next: Saving Values, Prev: Aborting and Resuming Transients, Up: Usage + +2.3 Common Suffix Commands +========================== + +A few shared suffix commands are available in all transients. These +suffix commands are not shown in the popup buffer by default. + + This includes the aborting commands mentioned in the previous +section, as well as some other commands that are all bound to ‘C-x KEY’. +After ‘C-x’ is pressed, a section featuring all these common commands is +temporarily shown in the popup buffer. After invoking one of them, the +section disappears again. Note, however, that one of these commands is +described as “Show common permanently”; invoke that if you want the +common commands to always be shown for all transients. + +‘C-x t’ (‘transient-toggle-common’) + This command toggles whether the generic commands that are common + to all transients are always displayed or only after typing the + incomplete prefix key sequence ‘C-x’. This only affects the + current Emacs session. + + -- User Option: transient-show-common-commands + This option controls whether shared suffix commands are shown + alongside the transient-specific infix and suffix commands. By + default, the shared commands are not shown to avoid overwhelming + the user with too many options. + + While a transient is active, pressing ‘C-x’ always shows the common + commands. The value of this option can be changed for the current + Emacs session by typing ‘C-x t’ while a transient is active. + + The other common commands are described in either the previous or in +one of the following sections. + + Some of Transient’s key bindings differ from the respective bindings +of Magit-Popup; see *note FAQ:: for more information. + + +File: transient.info, Node: Saving Values, Next: Using History, Prev: Common Suffix Commands, Up: Usage + +2.4 Saving Values +================= + +After setting the infix arguments in a transient, the user can save +those arguments for future invocations. + + Most transients will start out with the saved arguments when they are +invoked. There are a few exceptions, though. Some transients are +designed so that the value that they use is stored externally as the +buffer-local value of some variable. Invoking such a transient again +uses the buffer-local value. (1) + + If the user does not save the value and just exits using a regular +suffix command, then the value is merely saved to the transient’s +history. That value won’t be used when the transient is next invoked, +but it is easily accessible (see *note Using History::). + +‘C-x s’ (‘transient-set’) + This command saves the value of the active transient for this Emacs + session. + +‘C-x C-s’ (‘transient-save’) + Save the value of the active transient persistently across Emacs + sessions. + +‘C-x C-k’ (‘transient-reset’) + Clear the set and saved values of the active transient. + + -- User Option: transient-values-file + This option names the file that is used to persist the values of + transients between Emacs sessions. + + ---------- Footnotes ---------- + + (1) ‘magit-diff’ and ‘magit-log’ are two prominent examples, and +their handling of buffer-local values is actually a bit more complicated +than outlined above and even customizable. + + +File: transient.info, Node: Using History, Next: Getting Help for Suffix Commands, Prev: Saving Values, Up: Usage + +2.5 Using History +================= + +Every time the user invokes a suffix command the transient’s current +value is saved to its history. These values can be cycled through the +same way one can cycle through the history of commands that read +user-input in the minibuffer. + +‘C-M-p’ (‘transient-history-prev’) +‘C-x p’ + This command switches to the previous value used for the active + transient. + +‘C-M-n’ (‘transient-history-next’) +‘C-x n’ + This command switches to the next value used for the active + transient. + + In addition to the transient-wide history, Transient of course +supports per-infix history. When an infix reads user-input using the +minibuffer, the user can use the regular minibuffer history commands to +cycle through previously used values. Usually the same keys as those +mentioned above are bound to those commands. + + Authors of transients should arrange for different infix commands +that read the same kind of value to also use the same history key (see +*note Suffix Slots::). + + Both kinds of history are saved to a file when Emacs is exited. + + -- User Option: transient-history-file + This option names the file that is used to persist the history of + transients and their infixes between Emacs sessions. + + -- User Option: transient-history-limit + This option controls how many history elements are kept at the time + the history is saved in ‘transient-history-file’. + + +File: transient.info, Node: Getting Help for Suffix Commands, Next: Enabling and Disabling Suffixes, Prev: Using History, Up: Usage + +2.6 Getting Help for Suffix Commands +==================================== + +Transients can have many suffixes and infixes that the user might not be +familiar with. To make it trivial to get help for these, Transient +provides access to the documentation directly from the active transient. + +‘C-h’ (‘transient-help’) + This command enters help mode. When help mode is active, typing a + key shows information about the suffix command that the key + normally is bound to (instead of invoking it). Pressing ‘C-h’ a + second time shows information about the _prefix_ command. + + After typing a key, the stack of transient states is suspended and + information about the suffix command is shown instead. Typing ‘q’ + in the help buffer buries that buffer and resumes the transient + state. + + What sort of documentation is shown depends on how the transient was +defined. For infix commands that represent command-line arguments this +ideally shows the appropriate manpage. ‘transient-help’ then tries to +jump to the correct location within that. Info manuals are also +supported. The fallback is to show the command’s documentation string, +for non-infix suffixes this is usually appropriate. + + +File: transient.info, Node: Enabling and Disabling Suffixes, Next: Other Commands, Prev: Getting Help for Suffix Commands, Up: Usage + +2.7 Enabling and Disabling Suffixes +=================================== + +The user base of a package that uses transients can be very diverse. +This is certainly the case for Magit; some users have been using it and +Git for a decade, while others are just getting started now. + + For that reason a mechanism is needed that authors can use to +classify a transient’s infixes and suffixes along the +essentials...everything spectrum. We use the term “levels” to describe +that mechanism. + + Each suffix command is placed on a level and each transient has a +level (called “transient-level”), which controls which suffix commands +are available. Integers between 1 and 7 (inclusive) are valid levels. +For suffixes, 0 is also valid; it means that the suffix is not displayed +at any level. + + The levels of individual transients and/or their individual suffixes +can be changed interactively, by invoking the transient and then +pressing ‘C-x l’ to enter the “edit” mode, see below. + + The default level for both transients and their suffixes is 4. The +‘transient-default-level’ option only controls the default for +transients. The default suffix level is always 4. The authors of +transients should place certain suffixes on a higher level, if they +expect that it won’t be of use to most users, and they should place very +important suffixes on a lower level, so that they remain available even +if the user lowers the transient level. + + -- User Option: transient-default-level + This option controls which suffix levels are made available by + default. It sets the transient-level for transients for which the + user has not set that individually. + + -- User Option: transient-levels-file + This option names the file that is used to persist the levels of + transients and their suffixes between Emacs sessions. + +‘C-x l’ (‘transient-set-level’) + This command enters edit mode. When edit mode is active, then all + infixes and suffixes that are currently usable are displayed along + with their levels. The colors of the levels indicate whether they + are enabled or not. The level of the transient is also displayed + along with some usage information. + + In edit mode, pressing the key that would usually invoke a certain + suffix instead prompts the user for the level that suffix should be + placed on. + + Help mode is available in edit mode. + + To change the transient level press ‘C-x l’ again. + + To exit edit mode press ‘C-g’. + + Note that edit mode does not display any suffixes that are not + currently usable. ‘magit-rebase’, for example, shows different + suffixes depending on whether a rebase is already in progress or + not. The predicates also apply in edit mode. + + Therefore, to control which suffixes are available given a certain + state, you have to make sure that that state is currently active. + +‘C-x a’ (‘transient-toggle-level-limit’) + This command toggle whether suffixes that are on levels higher than + the level specified by ‘transient-default-level’ are temporarily + available anyway. + + +File: transient.info, Node: Other Commands, Next: Configuration, Prev: Enabling and Disabling Suffixes, Up: Usage + +2.8 Other Commands +================== + +When invoking a transient in a small frame, the transient window may not +show the complete buffer, making it necessary to scroll, using the +following commands. These commands are never shown in the transient +window, and the key bindings are the same as for ‘scroll-up-command’ and +‘scroll-down-command’ in other buffers. + + -- Command: transient-scroll-up arg + This command scrolls text of transient popup window upward ARG + lines. If ARG is ‘nil’, then it scrolls near full screen. This is + a wrapper around ‘scroll-up-command’ (which see). + + -- Command: transient-scroll-down arg + This command scrolls text of transient popup window down ARG lines. + If ARG is ‘nil’, then it scrolls near full screen. This is a + wrapper around ‘scroll-down-command’ (which see). + + +File: transient.info, Node: Configuration, Prev: Other Commands, Up: Usage + +2.9 Configuration +================= + +More options are described in *note Common Suffix Commands::, in *note +Saving Values::, in *note Using History:: and in *note Enabling and +Disabling Suffixes::. + +Essential Options +----------------- + +Also see *note Common Suffix Commands::. + + -- User Option: transient-show-popup + This option controls whether the current transient’s infix and + suffix commands are shown in the popup buffer. + + • If ‘t’ (the default) then the popup buffer is shown as soon as + a transient prefix command is invoked. + + • If ‘nil’, then the popup buffer is not shown unless the user + explicitly requests it, by pressing an incomplete prefix key + sequence. + + • If a number, then the a brief one-line summary is shown + instead of the popup buffer. If zero or negative, then not + even that summary is shown; only the pressed key itself is + shown. + + The popup is shown when the user explicitly requests it by + pressing an incomplete prefix key sequence. Unless this is + zero, the popup is shown after that many seconds of inactivity + (using the absolute value). + + -- User Option: transient-enable-popup-navigation + This option controls whether navigation commands are enabled in the + transient popup buffer. + + While a transient is active the transient popup buffer is not the + current buffer, making it necessary to use dedicated commands to + act on that buffer itself. This is disabled by default. If this + option is non-‘nil’, then the following features are available: + + • ‘<UP>’ moves the cursor to the previous suffix. + • ‘<DOWN>’ moves the cursor to the next suffix. + • ‘<RET>’ invokes the suffix the cursor is on. + • ‘mouse-1’ invokes the clicked on suffix. + • ‘C-s’ and ‘C-r’ start isearch in the popup buffer. + + -- User Option: transient-display-buffer-action + This option specifies the action used to display the transient + popup buffer. The transient popup buffer is displayed in a window + using ‘(display-buffer BUFFER transient-display-buffer-action)’. + + The value of this option has the form ‘(FUNCTION . ALIST)’, where + FUNCTION is a function or a list of functions. Each such function + should accept two arguments: a buffer to display and an alist of + the same form as ALIST. See *note (elisp)Choosing Window::, for + details. + + The default is: + + (display-buffer-in-side-window + (side . bottom) + (inhibit-same-window . t) + (window-parameters (no-other-window . t))) + + This displays the window at the bottom of the selected frame. + Another useful FUNCTION is ‘display-buffer-below-selected’, which + is what ‘magit-popup’ used by default. For more alternatives see + *note (elisp)Buffer Display Action Functions::, and *note + (elisp)Buffer Display Action Alists::. + + Note that the buffer that was current before the transient buffer + is shown should remain the current buffer. Many suffix commands + act on the thing at point, if appropriate, and if the transient + buffer became the current buffer, then that would change what is at + point. To that effect ‘inhibit-same-window’ ensures that the + selected window is not used to show the transient buffer. + + It may be possible to display the window in another frame, but + whether that works in practice depends on the window-manager. If + the window manager selects the new window (Emacs frame), then that + unfortunately changes which buffer is current. + + If you change the value of this option, then you might also want to + change the value of ‘transient-mode-line-format’. + +Accessibility Options +--------------------- + + -- User Option: transient-force-single-column + This option controls whether the use of a single column to display + suffixes is enforced. This might be useful for users with low + vision who use large text and might otherwise have to scroll in two + dimensions. + +Auxiliary Options +----------------- + + -- User Option: transient-mode-line-format + This option controls whether the transient popup buffer has a + mode-line, separator line, or neither. + + If ‘nil’, then the buffer has no mode-line. If the buffer is not + displayed right above the echo area, then this probably is not a + good value. + + If ‘line’ (the default) or a natural number, then the buffer has no + mode-line, but a line is drawn is drawn in its place. If a number + is used, that specifies the thickness of the line. On termcap + frames we cannot draw lines, so there ‘line’ and numbers are + synonyms for ‘nil’. + + The color of the line is used to indicate if non-suffixes are + allowed and whether they exit the transient. The foreground color + of ‘transient-key-noop’ (if non-suffix are disallowed), + ‘transient-key-stay’ (if allowed and transient stays active), or + ‘transient-key-exit’ (if allowed and they exit the transient) is + used to draw the line. + + Otherwise this can be any mode-line format. See *note (elisp)Mode + Line Format::, for details. + + -- User Option: transient-semantic-coloring + This option controls whether colors are used to indicate the + transient behavior of commands. + + If non-‘nil’, then the key binding of each suffix is colorized to + indicate whether it exits the transient state or not. The color of + the prefix is indicated using the line that is drawn when the value + of ‘transient-mode-line-format’ is ‘line’. + + -- User Option: transient-highlight-mismatched-keys + This option controls whether key bindings of infix commands that do + not match the respective command-line argument should be + highlighted. For other infix commands this option has no effect. + + When this option is non-‘nil’, the key binding for an infix + argument is highlighted when only a long argument (e.g., + ‘--verbose’) is specified but no shorthand (e.g., ‘-v’). In the + rare case that a shorthand is specified but the key binding does + not match, then it is highlighted differently. + + Highlighting mismatched key bindings is useful when learning the + arguments of the underlying command-line tool; you wouldn’t want to + learn any short-hands that do not actually exist. + + The highlighting is done using one of the faces + ‘transient-mismatched-key’ and ‘transient-nonstandard-key’. + + -- User Option: transient-substitute-key-function + This function is used to modify key bindings. If the value of this + option is ‘nil’ (the default), then no substitution is performed. + + This function is called with one argument, the prefix object, and + must return a key binding description, either the existing key + description it finds in the ‘key’ slot, or the key description that + replaces the prefix key. It could be used to make other + substitutions, but that is discouraged. + + For example, ‘=’ is hard to reach using my custom keyboard layout, + so I substitute ‘(’ for that, which is easy to reach using a layout + optimized for lisp. + + (setq transient-substitute-key-function + (lambda (obj) + (let ((key (oref obj key))) + (if (string-match "\\`\\(=\\)[a-zA-Z]" key) + (replace-match "(" t t key 1) + key)))) + + -- User Option: transient-read-with-initial-input + This option controls whether the last history element is used as + the initial minibuffer input when reading the value of an infix + argument from the user. If ‘nil’, there is no initial input and + the first element has to be accessed the same way as the older + elements. + + -- User Option: transient-hide-during-minibuffer-read + This option controls whether the transient buffer is hidden while + user input is being read in the minibuffer. + + -- User Option: transient-align-variable-pitch + This option controls whether columns are aligned pixel-wise in the + popup buffer. + + If this is non-‘nil’, then columns are aligned pixel-wise to + support variable-pitch fonts. Keys are not aligned, so you should + use a fixed-pitch font for the ‘transient-key’ face. Other key + faces inherit from that face unless a theme is used that breaks + that relationship. + + This option is intended for users who use a variable-pitch font for + the ‘default’ face. + + -- User Option: transient-force-fixed-pitch + This option controls whether to force the use of a monospaced font + in popup buffer. Even if you use a proportional font for the + ‘default’ face, you might still want to use a monospaced font in + transient’s popup buffer. Setting this option to ‘t’ causes + ‘default’ to be remapped to ‘fixed-pitch’ in that buffer. + +Developer Options +----------------- + +These options are mainly intended for developers. + + -- User Option: transient-detect-key-conflicts + This option controls whether key binding conflicts should be + detected at the time the transient is invoked. If so, this results + in an error, which prevents the transient from being used. Because + of that, conflicts are ignored by default. + + Conflicts cannot be determined earlier, i.e., when the transient is + being defined and when new suffixes are being added, because at + that time there can be false-positives. It is actually valid for + multiple suffixes to share a common key binding, provided the + predicates of those suffixes prevent that more than one of them is + enabled at a time. + + -- User Option: transient-highlight-higher-levels + This option controls whether suffixes that would not be available + by default are highlighted. + + When non-‘nil’ then the descriptions of suffixes are highlighted if + their level is above 4, the default of ‘transient-default-level’. + Assuming you have set that variable to 7, this highlights all + suffixes that won’t be available to users without them making the + same customization. + + +File: transient.info, Node: Modifying Existing Transients, Next: Defining New Commands, Prev: Usage, Up: Top + +3 Modifying Existing Transients +******************************* + +To an extent, transients can be customized interactively, see *note +Enabling and Disabling Suffixes::. This section explains how existing +transients can be further modified non-interactively. Let’s begin with +an example: + + (transient-append-suffix 'magit-patch-apply "-3" + '("-R" "Apply in reverse" "--reverse")) + + This inserts a new infix argument to toggle the ‘--reverse’ argument +after the infix argument that toggles ‘-3’ in ‘magit-patch-apply’. + + The following functions share a few arguments: + + • PREFIX is a transient prefix command, a symbol. + + • SUFFIX is a transient infix or suffix specification in the same + form as expected by ‘transient-define-prefix’. Note that an infix + is a special kind of suffix. Depending on context “suffixes” means + “suffixes (including infixes)” or “non-infix suffixes”. Here it + means the former. See *note Suffix Specifications::. + + SUFFIX may also be a group in the same form as expected by + ‘transient-define-prefix’. See *note Group Specifications::. + + • LOC is a command, a key vector, a key description (a string as + returned by ‘key-description’), or a list specifying coordinates + (the last element may also be a command or key). For example ‘(1 0 + -1)’ identifies the last suffix (‘-1’) of the first subgroup (‘0’) + of the second group (‘1’). + + If LOC is a list of coordinates, then it can be used to identify a + group, not just an individual suffix command. + + The function ‘transient-get-suffix’ can be useful to determine + whether a certain coordination list identifies the suffix or group + that you expect it to identify. In hairy cases it may be necessary + to look at the definition of the transient prefix command. + + These functions operate on the information stored in the +‘transient--layout’ property of the PREFIX symbol. Suffix entries in +that tree are not objects but have the form ‘(LEVEL CLASS PLIST)’, where +PLIST should set at least ‘:key’, ‘:description’ and ‘:command’. + + -- Function: transient-insert-suffix prefix loc suffix &optional + keep-other + -- Function: transient-append-suffix prefix loc suffix &optional + keep-other + These functions insert the suffix or group SUFFIX into PREFIX + before or after LOC. + + Conceptually adding a binding to a transient prefix is similar to + adding a binding to a keymap, but this is complicated by the fact + that multiple suffix commands can be bound to the same key, + provided they are never active at the same time, see *note + Predicate Slots::. + + Unfortunately both false-positives and false-negatives are + possible. To deal with the former use non-‘nil’ KEEP-OTHER. To + deal with the latter remove the conflicting binding explicitly. + + -- Function: transient-replace-suffix prefix loc suffix + This function replaces the suffix or group at LOC in PREFIX with + suffix or group SUFFIX. + + -- Function: transient-remove-suffix prefix loc + This function removes the suffix or group at LOC in PREFIX. + + -- Function: transient-get-suffix prefix loc + This function returns the suffix or group at LOC in PREFIX. The + returned value has the form mentioned above. + + -- Function: transient-suffix-put prefix loc prop value + This function edits the suffix or group at LOC in PREFIX, by + setting the PROP of its plist to VALUE. + + Most of these functions do not signal an error if they cannot perform +the requested modification. The functions that insert new suffixes show +a warning if LOC cannot be found in PREFIX without signaling an error. +The reason for doing it like this is that establishing a key binding +(and that is what we essentially are trying to do here) should not +prevent the rest of the configuration from loading. Among these +functions only ‘transient-get-suffix’ and ‘transient-suffix-put’ may +signal an error. + + +File: transient.info, Node: Defining New Commands, Next: Classes and Methods, Prev: Modifying Existing Transients, Up: Top + +4 Defining New Commands +*********************** + +* Menu: + +* Technical Introduction:: +* Defining Transients:: +* Binding Suffix and Infix Commands:: +* Defining Suffix and Infix Commands:: +* Using Infix Arguments:: +* Transient State:: + + +File: transient.info, Node: Technical Introduction, Next: Defining Transients, Up: Defining New Commands + +4.1 Technical Introduction +========================== + +Taking inspiration from prefix keys and prefix arguments, Transient +implements a similar abstraction involving a prefix command, infix +arguments and suffix commands. + + When the user calls a transient prefix command, a transient +(temporary) keymap is activated, which binds the transient’s infix and +suffix commands, and functions that control the transient state are +added to ‘pre-command-hook’ and ‘post-command-hook’. The available +suffix and infix commands and their state are shown in a popup buffer +until the transient state is exited by invoking a suffix command. + + Calling an infix command causes its value to be changed. How that is +done depends on the type of the infix command. The simplest case is an +infix command that represents a command-line argument that does not take +a value. Invoking such an infix command causes the switch to be toggled +on or off. More complex infix commands may read a value from the user, +using the minibuffer. + + Calling a suffix command usually causes the transient to be exited; +the transient keymaps and hook functions are removed, the popup buffer +no longer shows information about the (no longer bound) suffix commands, +the values of some public global variables are set, while some internal +global variables are unset, and finally the command is actually called. +Suffix commands can also be configured to not exit the transient. + + A suffix command can, but does not have to, use the infix arguments +in much the same way any command can choose to use or ignore the prefix +arguments. For a suffix command that was invoked from a transient, the +variable ‘transient-current-suffixes’ and the function ‘transient-args’ +serve about the same purpose as the variables ‘prefix-arg’ and +‘current-prefix-arg’ do for any command that was called after the prefix +arguments have been set using a command such as ‘universal-argument’. + + Transient can be used to implement simple “command dispatchers”. The +main benefit then is that the user can see all the available commands in +a popup buffer, which can be thought of as a “menus”. That is useful by +itself because it frees the user from having to remember all the keys +that are valid after a certain prefix key or command. Magit’s +‘magit-dispatch’ (on ‘C-x M-g’) command is an example of using Transient +to merely implement a command dispatcher. + + In addition to that, Transient also allows users to interactively +pass arguments to commands. These arguments can be much more complex +than what is reasonable when using prefix arguments. There is a limit +to how many aspects of a command can be controlled using prefix +arguments. Furthermore, what a certain prefix argument means for +different commands can be completely different, and users have to read +documentation to learn and then commit to memory what a certain prefix +argument means to a certain command. + + Transient suffix commands, on the other hand, can accept dozens of +different arguments without the user having to remember anything. When +using Transient, one can call a command with arguments that are just as +complex as when calling the same function non-interactively from Lisp. + + Invoking a transient suffix command with arguments is similar to +invoking a command in a shell with command-line completion and history +enabled. One benefit of the Transient interface is that it remembers +history not only on a global level (“this command was invoked using +these arguments, and previously it was invoked using those other +arguments”), but also remembers the values of individual arguments +independently. See *note Using History::. + + After a transient prefix command is invoked, ‘C-h KEY’ can be used to +show the documentation for the infix or suffix command that ‘KEY’ is +bound to (see *note Getting Help for Suffix Commands::), and infixes and +suffixes can be removed from the transient using ‘C-x l KEY’. Infixes +and suffixes that are disabled by default can be enabled the same way. +See *note Enabling and Disabling Suffixes::. + + Transient ships with support for a few different types of specialized +infix commands. A command that sets a command line option, for example, +has different needs than a command that merely toggles a boolean flag. +Additionally, Transient provides abstractions for defining new types, +which the author of Transient did not anticipate (or didn’t get around +to implementing yet). + + Note that suffix commands also support regular prefix arguments. A +suffix command may even be called with both infix and prefix arguments +at the same time. If you invoke a command as a suffix of a transient +prefix command, but also want to pass prefix arguments to it, then first +invoke the prefix command, and only after doing that invoke the prefix +arguments, before finally invoking the suffix command. If you instead +began by providing the prefix arguments, then those would apply to the +prefix command, not the suffix command. Likewise, if you want to change +infix arguments before invoking a suffix command with prefix arguments, +then change the infix arguments before invoking the prefix arguments. +In other words, regular prefix arguments always apply to the next +command, and since transient prefix, infix and suffix commands are just +regular commands, the same applies to them. (Regular prefix keys behave +differently because they are not commands at all, instead they are just +incomplete key sequences, and those cannot be interrupted with prefix +commands.) + + +File: transient.info, Node: Defining Transients, Next: Binding Suffix and Infix Commands, Prev: Technical Introduction, Up: Defining New Commands + +4.2 Defining Transients +======================= + +A transient consists of a prefix command and at least one suffix +command, though usually a transient has several infix and suffix +commands. The below macro defines the transient prefix command *and* +binds the transient’s infix and suffix commands. In other words, it +defines the complete transient, not just the transient prefix command +that is used to invoke that transient. + + -- Macro: transient-define-prefix name arglist [docstring] [keyword + value]... group... [body...] + This macro defines NAME as a transient prefix command and binds the + transient’s infix and suffix commands. + + ARGLIST are the arguments that the prefix command takes. DOCSTRING + is the documentation string and is optional. + + These arguments can optionally be followed by keyword-value pairs. + Each key has to be a keyword symbol, either ‘:class’ or a keyword + argument supported by the constructor of that class. The + ‘transient-prefix’ class is used if the class is not specified + explicitly. + + GROUPs add key bindings for infix and suffix commands and specify + how these bindings are presented in the popup buffer. At least one + GROUP has to be specified. See *note Binding Suffix and Infix + Commands::. + + The BODY is optional. If it is omitted, then ARGLIST is ignored + and the function definition becomes: + + (lambda () + (interactive) + (transient-setup 'NAME)) + + If BODY is specified, then it must begin with an ‘interactive’ form + that matches ARGLIST, and it must call ‘transient-setup’. It may, + however, call that function only when some condition is satisfied. + + All transients have a (possibly ‘nil’) value, which is exported + when suffix commands are called, so that they can consume that + value. For some transients it might be necessary to have a sort of + secondary value, called a “scope”. Such a scope would usually be + set in the command’s ‘interactive’ form and has to be passed to the + setup function: + + (transient-setup 'NAME nil nil :scope SCOPE) + + For example, the scope of the ‘magit-branch-configure’ transient is + the branch whose variables are being configured. + + +File: transient.info, Node: Binding Suffix and Infix Commands, Next: Defining Suffix and Infix Commands, Prev: Defining Transients, Up: Defining New Commands + +4.3 Binding Suffix and Infix Commands +===================================== + +The macro ‘transient-define-prefix’ is used to define a transient. This +defines the actual transient prefix command (see *note Defining +Transients::) and adds the transient’s infix and suffix bindings, as +described below. + + Users and third-party packages can add additional bindings using +functions such as ‘transient-insert-suffix’ (see *note Modifying +Existing Transients::). These functions take a “suffix specification” +as one of their arguments, which has the same form as the specifications +used in ‘transient-define-prefix’. + +* Menu: + +* Group Specifications:: +* Suffix Specifications:: + + +File: transient.info, Node: Group Specifications, Next: Suffix Specifications, Up: Binding Suffix and Infix Commands + +4.3.1 Group Specifications +-------------------------- + +The suffix and infix commands of a transient are organized in groups. +The grouping controls how the descriptions of the suffixes are outlined +visually but also makes it possible to set certain properties for a set +of suffixes. + + Several group classes exist, some of which organize suffixes in +subgroups. In most cases the class does not have to be specified +explicitly, but see *note Group Classes::. + + Groups are specified in the call to ‘transient-define-prefix’, using +vectors. Because groups are represented using vectors, we cannot use +square brackets to indicate an optional element and instead use curly +brackets to do the latter. + + Group specifications then have this form: + + [{LEVEL} {DESCRIPTION} {KEYWORD VALUE}... ELEMENT...] + + The LEVEL is optional and defaults to 4. See *note Enabling and +Disabling Suffixes::. + + The DESCRIPTION is optional. If present, it is used as the heading +of the group. + + The KEYWORD-VALUE pairs are optional. Each keyword has to be a +keyword symbol, either ‘:class’ or a keyword argument supported by the +constructor of that class. + + • One of these keywords, ‘:description’, is equivalent to specifying + DESCRIPTION at the very beginning of the vector. The + recommendation is to use ‘:description’ if some other keyword is + also used, for consistency, or DESCRIPTION otherwise, because it + looks better. + + • Likewise ‘:level’ is equivalent to LEVEL. + + • Other important keywords include the ‘:if...’ keywords. These + keywords control whether the group is available in a certain + situation. + + For example, one group of the ‘magit-rebase’ transient uses ‘:if + magit-rebase-in-progress-p’, which contains the suffixes that are + useful while rebase is already in progress; and another that uses + ‘:if-not magit-rebase-in-progress-p’, which contains the suffixes + that initiate a rebase. + + These predicates can also be used on individual suffixes and are + only documented once, see *note Predicate Slots::. + + • The value of ‘:hide’, if non-‘nil’, is a predicate that controls + whether the group is hidden by default. The key bindings for + suffixes of a hidden group should all use the same prefix key. + Pressing that prefix key should temporarily show the group and its + suffixes, which assumes that a predicate like this is used: + + (lambda () + (eq (car transient--redisplay-key) + ?\C-c)) ; the prefix key shared by all bindings + + • The value of ‘:setup-children’, if non-‘nil’, is a function that + takes one argument, a potentially list of children, and must return + a list of children or an empty list. This can either be used to + somehow transform the group’s children that were defined the normal + way, or to dynamically create the children from scratch. + + The returned children must have the same form as stored in the + prefix’s ‘transient--layout’ property, but it is often more + convenient to use the same form as understood by + ‘transient-define-prefix’, described below. If you use the latter + approach, you can use the ‘transient-parse-suffixes’ and + ‘transient-parse-suffix’ functions to transform them from the + convenient to the expected form. + + If you explicitly specify children and then transform them using + ‘:setup-children’, then the class of the group is determined as + usual, based on explicitly specified children. + + If you do not explicitly specify children and thus rely solely on + ‘:setup-children’, then you must specify the class using ‘:class’. + For backward compatibility, if you fail to do so, + ‘transient-column’ is used and a warning is displayed. This + warning will eventually be replaced with an error. + + • The boolean ‘:pad-keys’ argument controls whether keys of all + suffixes contained in a group are right padded, effectively + aligning the descriptions. + + The ELEMENTs are either all subgroups, or all suffixes and strings. +(At least currently no group type exists that would allow mixing +subgroups with commands at the same level, though in principle there is +nothing that prevents that.) + + If the ELEMENTs are not subgroups, then they can be a mixture of +lists, which specify commands, and strings. Strings are inserted +verbatim into the buffer. The empty string can be used to insert gaps +between suffixes, which is particularly useful if the suffixes are +outlined as a table. + + Inside group specifications, including inside contained suffix +specifications, nothing has to be quoted and quoting anyway is invalid. +The value following a keyword, can be explicitly unquoted using ‘,’. +This feature is experimental and should be avoided. + + The form of suffix specifications is documented in the next node. + + +File: transient.info, Node: Suffix Specifications, Prev: Group Specifications, Up: Binding Suffix and Infix Commands + +4.3.2 Suffix Specifications +--------------------------- + +A transient’s suffix and infix commands are bound when the transient +prefix command is defined using ‘transient-define-prefix’, see *note +Defining Transients::. The commands are organized into groups, see +*note Group Specifications::. Here we describe the form used to bind an +individual suffix command. + + The same form is also used when later binding additional commands +using functions such as ‘transient-insert-suffix’, see *note Modifying +Existing Transients::. + + Note that an infix is a special kind of suffix. Depending on context +“suffixes” means “suffixes (including infixes)” or “non-infix suffixes”. +Here it means the former. + + Suffix specifications have this form: + + ([LEVEL] [KEY [DESCRIPTION]] COMMAND|ARGUMENT [KEYWORD VALUE]...) + + LEVEL, KEY and DESCRIPTION can also be specified using the KEYWORDs +‘:level’, ‘:key’ and ‘:description’. If the object that is associated +with COMMAND sets these properties, then they do not have to be +specified here. You can however specify them here anyway, possibly +overriding the object’s values just for the binding inside this +transient. + + • LEVEL is the suffix level, an integer between 1 and 7. See *note + Enabling and Disabling Suffixes::. + + • KEY is the key binding, either a vector or key description string. + + • DESCRIPTION is the description, either a string or a function that + takes zero or one arguments (the suffix object) and returns a + string. The function should be a lambda expression to avoid + ambiguity. In some cases a symbol that is bound as a function + would also work but to be safe you should use ‘:description’ in + that case. + + The next element is either a command or an argument. This is the +only argument that is mandatory in all cases. + + • COMMAND should be a symbol that is bound as a function, which has + to be defined or at least autoloaded as a command by the time the + containing prefix command is invoked. + + Any command will do; it does not need to have an object associated + with it (as would be the case if ‘transient-define-suffix’ or + ‘transient-define-infix’ were used to define it). + + COMMAND can also be a ‘lambda’ expression. + + As mentioned above, the object that is associated with a command + can be used to set the default for certain values that otherwise + have to be set in the suffix specification. Therefore if there is + no object, then you have to make sure to specify the KEY and the + DESCRIPTION. + + As a special case, if you want to add a command that might be + neither defined nor autoloaded, you can use a workaround like: + + (transient-insert-suffix 'some-prefix "k" + '("!" "Ceci n'est pas une commande" no-command + :if (lambda () (featurep 'no-library)))) + + Instead of ‘featurep’ you could also use ‘require’ with a non-‘nil’ + value for NOERROR. + + • The mandatory argument can also be a command-line argument, a + string. In that case an anonymous command is defined and bound. + + Instead of a string, this can also be a list of two strings, in + which case the first string is used as the short argument (which + can also be specified using ‘:shortarg’) and the second as the long + argument (which can also be specified using ‘:argument’). + + Only the long argument is displayed in the popup buffer. See + ‘transient-detect-key-conflicts’ for how the short argument may be + used. + + Unless the class is specified explicitly, the appropriate class is + guessed based on the long argument. If the argument ends with ‘=’ + (e.g., ‘--format=’) then ‘transient-option’ is used, otherwise + ‘transient-switch’. + + Finally, details can be specified using optional KEYWORD-VALUE pairs. +Each keyword has to be a keyword symbol, either ‘:class’ or a keyword +argument supported by the constructor of that class. See *note Suffix +Slots::. + + +File: transient.info, Node: Defining Suffix and Infix Commands, Next: Using Infix Arguments, Prev: Binding Suffix and Infix Commands, Up: Defining New Commands + +4.4 Defining Suffix and Infix Commands +====================================== + +Note that an infix is a special kind of suffix. Depending on context +“suffixes” means “suffixes (including infixes)” or “non-infix suffixes”. + + -- Macro: transient-define-suffix name arglist [docstring] [keyword + value]... body... + This macro defines NAME as a transient suffix command. + + ARGLIST are the arguments that the command takes. DOCSTRING is the + documentation string and is optional. + + These arguments can optionally be followed by keyword-value pairs. + Each keyword has to be a keyword symbol, either ‘:class’ or a + keyword argument supported by the constructor of that class. The + ‘transient-suffix’ class is used if the class is not specified + explicitly. + + The BODY must begin with an ‘interactive’ form that matches + ARGLIST. The infix arguments are usually accessed by using + ‘transient-args’ inside ‘interactive’. + + -- Macro: transient-define-infix name arglist [docstring] [keyword + value]... + This macro defines NAME as a transient infix command. + + ARGLIST is always ignored (but mandatory never-the-less) and + reserved for future use. DOCSTRING is the documentation string and + is optional. + + At least one key-value pair is required. All transient infix + commands are ‘equal’ to each other (but not ‘eq’). It is + meaningless to define an infix command, without providing at least + one keyword argument (usually ‘:argument’ or ‘:variable’, depending + on the class). The suffix class defaults to ‘transient-switch’ and + can be set using the ‘:class’ keyword. + + The function definition is always: + + (lambda () + (interactive) + (let ((obj (transient-suffix-object))) + (transient-infix-set obj (transient-infix-read obj))) + (transient--show)) + + ‘transient-infix-read’ and ‘transient-infix-set’ are generic + functions. Different infix commands behave differently because the + concrete methods are different for different infix command classes. + In rare cases the above command function might not be suitable, + even if you define your own infix command class. In that case you + have to use ‘transient-define-suffix’ to define the infix command + and use ‘t’ as the value of the ‘:transient’ keyword. + + -- Macro: transient-define-argument name arglist [docstring] [keyword + value]... + This macro defines NAME as a transient infix command. + + This is an alias for ‘transient-define-infix’. Only use this alias + to define an infix command that actually sets an infix argument. + To define an infix command that, for example, sets a variable, use + ‘transient-define-infix’ instead. + + +File: transient.info, Node: Using Infix Arguments, Next: Transient State, Prev: Defining Suffix and Infix Commands, Up: Defining New Commands + +4.5 Using Infix Arguments +========================= + +The functions and the variables described below allow suffix commands to +access the value of the transient from which they were invoked; which is +the value of its infix arguments. These variables are set when the user +invokes a suffix command that exits the transient, but before actually +calling the command. + + When returning to the command-loop after calling the suffix command, +the arguments are reset to ‘nil’ (which causes the function to return +‘nil’ too). + + Like for Emacs’ prefix arguments, it is advisable, but not mandatory, +to access the infix arguments inside the command’s ‘interactive’ form. +The preferred way of doing that is to call the ‘transient-args’ +function, which for infix arguments serves about the same purpose as +‘prefix-arg’ serves for prefix arguments. + + -- Function: transient-args prefix + This function returns the value of the transient prefix command + PREFIX. + + If the current command was invoked from the transient prefix + command PREFIX, then it returns the active infix arguments. If the + current command was not invoked from PREFIX, then it returns the + set, saved or default value for PREFIX. + + -- Function: transient-arg-value arg args + This function return the value of ARG as it appears in ARGS. + + For a switch a boolean is returned. For an option the value is + returned as a string, using the empty string for the empty value, + or ‘nil’ if the option does not appear in ARGS. + + -- Function: transient-suffixes prefix + This function returns the suffixes of the transient prefix command + PREFIX. This is a list of objects. This function should only be + used if you need the objects (as opposed to just their values) and + if the current command is not being invoked from PREFIX. + + -- Variable: transient-current-suffixes + The suffixes of the transient from which this suffix command was + invoked. This is a list of objects. Usually it is sufficient to + instead use the function ‘transient-args’, which returns a list of + values. In complex cases it might be necessary to use this + variable instead, i.e., if you need access to information beside + the value. + + -- Variable: transient-current-prefix + The transient from which this suffix command was invoked. The + returned value is a ‘transient-prefix’ object, which holds + information associated with the transient prefix command. + + -- Variable: transient-current-command + The transient from which this suffix command was invoked. The + returned value is a symbol, the transient prefix command. + + +File: transient.info, Node: Transient State, Prev: Using Infix Arguments, Up: Defining New Commands + +4.6 Transient State +=================== + +Invoking a transient prefix command “activates” the respective +transient, i.e., it puts a transient keymap into effect, which binds the +transient’s infix and suffix commands. + + The default behavior while a transient is active is as follows: + + • Invoking an infix command does not affect the transient state; the + transient remains active. + + • Invoking a (non-infix) suffix command “deactivates” the transient + state by removing the transient keymap and performing some + additional cleanup. + + • Invoking a command that is bound in a keymap other than the + transient keymap is disallowed and trying to do so results in a + warning. This does not “deactivate” the transient. + + The behavior can be changed for all suffixes of a particular prefix +and/or for individual suffixes. The values should nearly always be +booleans, but certain functions, called “pre-commands”, can also be +used. These functions are named ‘transient--do-VERB’, and the symbol +‘VERB’ can be used as a shorthand. + + A boolean is interpreted as answering the question "does the +transient stay active, when this command is invoked?" ‘t’ means that +the transient stays active, while ‘nil’ means that invoking the command +exits the transient. + + Note that when the suffix is a “sub-prefix”, invoking that command +always activates that sub-prefix, causing the outer prefix to no longer +be active and displayed. Here ‘t’ means that when you exit the inner +prefix, then the outer prefix becomes active again, while ‘nil’ means +that all outer prefixes are exited at once. + + • The behavior for non-suffixes can be set for a particular prefix, + by the prefix’s ‘transient-non-suffix’ slot to a boolean, a + suitable pre-command function, or a shorthand for such a function. + See *note Pre-commands for Non-Suffixes::. + + • The common behavior for the suffixes of a particular prefix can be + set using the prefix’s ‘transient-suffixes’ slot. + + The value specified in this slot does *not* affect infixes. + Because it affects both regular suffixes as well as sub-prefixes, + which have different needs, it is best to avoid explicitly + specifying a function. + + • The behavior of an individual suffix can be changed using its + ‘transient’ slot. While it is usually best to use a boolean, for + this slot it can occasionally make sense to specify a function + explicitly. + + Note that this slot can be set when defining a suffix command using + ‘transient-define-suffix’ and/or in the definition of the prefix. + If set in both places, then the latter takes precedence, as usual. + + The available pre-command functions are documented in the following +sub-sections. They are called by ‘transient--pre-command’, a function +on ‘pre-command-hook’, and the value that they return determines whether +the transient is exited. To do so the value of one of the constants +‘transient--exit’ or ‘transient--stay’ is used (that way we don’t have +to remember if ‘t’ means “exit” or “stay”). + + Additionally, these functions may change the value of ‘this-command’ +(which explains why they have to be called using ‘pre-command-hook’), +call ‘transient-export’, ‘transient--stack-zap’ or +‘transient--stack-push’; and set the values of ‘transient--exitp’, +‘transient--helpp’ or ‘transient--editp’. + + For completeness sake, some notes about complications: + + • The transient-ness of certain built-in suffix commands is specified + using ‘transient-predicate-map’. This is a special keymap, which + binds commands to pre-commands (as opposed to keys to commands) and + takes precedence over the prefix’s ‘transient-suffix’ slot, but not + the suffix’s ‘transient’ slot. + + • While a sub-prefix is active we nearly always want ‘C-g’ to take + the user back to the “super-prefix”, even when the other suffixes + don’t do that. However, in rare cases this may not be desirable, + and that makes the following complication necessary: + + For ‘transient-suffix’ objects the ‘transient’ slot is unbound. We + can ignore that for the most part because ‘nil’ and the slot being + unbound are treated as equivalent, and mean “do exit”. That isn’t + actually true for suffixes that are sub-prefixes though. For such + suffixes unbound means “do exit but allow going back”, which is the + default, while ‘nil’ means “do exit permanently”, which requires + that slot to be explicitly set to that value. + +Pre-commands for Infixes +------------------------ + +The default for infixes is ‘transient--do-stay’. This is also the only +function that makes sense for infixes, which is why this predicate is +used even if the value of the prefix’s ‘transient-suffix’ slot is ‘t’. +In extremely rare cases, one might want to use something else, which can +be done by setting the infix’s ‘transient’ slot directly. + + -- Function: transient--do-stay + Call the command without exporting variables and stay transient. + +Pre-commands for Suffixes +------------------------- + +By default, invoking a suffix causes the transient to be exited. + + The behavior for an individual suffix command can be changed by +setting its ‘transient’ slot to a boolean (which is highly recommended), +or to one of the following pre-commands. + + -- Function: transient--do-exit + Call the command after exporting variables and exit the transient. + + -- Function: transient--do-return + Call the command after exporting variables and return to the parent + prefix. If there is no parent prefix, then call + ‘transient--do-exit’. + + -- Function: transient--do-call + Call the command after exporting variables and stay transient. + + The following pre-commands are only suitable for sub-prefixes. It is +not necessary to explicitly use these predicates because the correct +predicate is automatically picked based on the value of the ‘transient’ +slot for the sub-prefix itself. + + -- Function: transient--do-recurse + Call the transient prefix command, preparing for return to active + transient. + + Whether we actually return to the parent transient is ultimately + under the control of each invoked suffix. The difference between + this pre-command and ‘transient--do-stack’ is that it changes the + value of the ‘transient-suffix’ slot to ‘t’. + + If there is no parent transient, then only call this command and + skip the second step. + + -- Function: transient--do-stack + Call the transient prefix command, stacking the active transient. + Push the active transient to the transient stack. + + Unless ‘transient--do-recurse’ is explicitly used, this pre-command + is automatically used for suffixes that are prefixes themselves, + i.e., for sub-prefixes. + + -- Function: transient--do-replace + Call the transient prefix command, replacing the active transient. + Do not push the active transient to the transient stack. + + Unless ‘transient--do-recurse’ is explicitly used, this pre-command + is automatically used for suffixes that are prefixes themselves, + i.e., for sub-prefixes. + + -- Function: transient--do-suspend + Suspend the active transient, saving the transient stack. + + This is used by the command ‘transient-suspend’ and optionally also + by “external events” such as ‘handle-switch-frame’. Such bindings + should be added to ‘transient-predicate-map’. + +Pre-commands for Non-Suffixes +----------------------------- + +By default, non-suffixes (commands that are bound in other keymaps +beside the transient keymap) cannot be invoked. Trying to invoke such a +command results in a warning and the transient stays active. + + If you want a different behavior, then set the ‘transient-non-suffix’ +slot of the transient prefix command. The value should be a boolean, +answering the question, "is it allowed to invoke non-suffix commands?, a +pre-command function, or a shorthand for such a function. + + If the value is ‘t’, then non-suffixes can be invoked, when it is +‘nil’ (the default) then they cannot be invoked. + + The only other recommended value is ‘leave’. If that is used, then +non-suffixes can be invoked, but if one is invoked, then that exits the +transient. + + -- Function: transient--do-warn + Call ‘transient-undefined’ and stay transient. + + -- Function: transient--do-stay + Call the command without exporting variables and stay transient. + + -- Function: transient--do-leave + Call the command without exporting variables and exit the + transient. + +Special Pre-Commands +-------------------- + + -- Function: transient--do-quit-one + If active, quit help or edit mode, else exit the active transient. + + This is used when the user pressed ‘C-g’. + + -- Function: transient--do-quit-all + Exit all transients without saving the transient stack. + + This is used when the user pressed ‘C-q’. + + -- Function: transient--do-suspend + Suspend the active transient, saving the transient stack. + + This is used when the user pressed ‘C-z’. + + +File: transient.info, Node: Classes and Methods, Next: FAQ, Prev: Defining New Commands, Up: Top + +5 Classes and Methods +********************* + +Transient uses classes and generic functions to make it possible to +define new types of suffix commands that are similar to existing types, +but behave differently in some aspects. It does the same for groups and +prefix commands, though at least for prefix commands that *currently* +appears to be less important. + + Every prefix, infix and suffix command is associated with an object, +which holds information that controls certain aspects of its behavior. +This happens in two ways. + + • Associating a command with a certain class gives the command a + type. This makes it possible to use generic functions to do + certain things that have to be done differently depending on what + type of command it acts on. + + That in turn makes it possible for third-parties to add new types + without having to convince the maintainer of Transient that that + new type is important enough to justify adding a special case to a + dozen or so functions. + + • Associating a command with an object makes it possible to easily + store information that is specific to that particular command. + + Two commands may have the same type, but obviously their key + bindings and descriptions still have to be different, for example. + + The values of some slots are functions. The ‘reader’ slot for + example holds a function that is used to read a new value for an + infix command. The values of such slots are regular functions. + + Generic functions are used when a function should do something + different based on the type of the command, i.e., when all commands + of a certain type should behave the same way but different from the + behavior for other types. Object slots that hold a regular + function as value are used when the task that they perform is + likely to differ even between different commands of the same type. + +* Menu: + +* Group Classes:: +* Group Methods:: +* Prefix Classes:: +* Suffix Classes:: +* Suffix Methods:: +* Prefix Slots:: +* Suffix Slots:: +* Predicate Slots:: + + +File: transient.info, Node: Group Classes, Next: Group Methods, Up: Classes and Methods + +5.1 Group Classes +================= + +The type of a group can be specified using the ‘:class’ property at the +beginning of the class specification, e.g., ‘[:class transient-columns +...]’ in a call to ‘transient-define-prefix’. + + • The abstract ‘transient-child’ class is the base class of both + ‘transient-group’ (and therefore all groups) as well as of + ‘transient-suffix’ (and therefore all suffix and infix commands). + + This class exists because the elements (or “children”) of certain + groups can be other groups instead of suffix and infix commands. + + • The abstract ‘transient-group’ class is the superclass of all other + group classes. + + • The ‘transient-column’ class is the simplest group. + + This is the default “flat” group. If the class is not specified + explicitly and the first element is not a vector (i.e., not a + group), then this class is used. + + This class displays each element on a separate line. + + • The ‘transient-row’ class displays all elements on a single line. + + • The ‘transient-columns’ class displays commands organized in + columns. + + Direct elements have to be groups whose elements have to be + commands or strings. Each subgroup represents a column. This + class takes care of inserting the subgroups’ elements. + + This is the default “nested” group. If the class is not specified + explicitly and the first element is a vector (i.e., a group), then + this class is used. + + • The ‘transient-subgroups’ class wraps other groups. + + Direct elements have to be groups whose elements have to be + commands or strings. This group inserts an empty line between + subgroups. The subgroups themselves are responsible for displaying + their elements. + + +File: transient.info, Node: Group Methods, Next: Prefix Classes, Prev: Group Classes, Up: Classes and Methods + +5.2 Group Methods +================= + + -- Function: transient-setup-children group children + This generic function can be used to setup the children or a group. + + The default implementation usually just returns the children + unchanged, but if the ‘setup-children’ slot of GROUP is non-‘nil’, + then it calls that function with CHILDREN as the only argument and + returns the value. + + The children are given as a (potentially empty) list consisting of + either group or suffix specifications. These functions can make + arbitrary changes to the children including constructing new + children from scratch. + + -- Function: transient--insert-group group + This generic function formats the group and its elements and + inserts the result into the current buffer, which is a temporary + buffer. The contents of that buffer are later inserted into the + popup buffer. + + Functions that are called by this function may need to operate in + the buffer from which the transient was called. To do so they can + temporarily make the ‘transient--source-buffer’ the current buffer. + + +File: transient.info, Node: Prefix Classes, Next: Suffix Classes, Prev: Group Methods, Up: Classes and Methods + +5.3 Prefix Classes +================== + +Currently the ‘transient-prefix’ class is being used for all prefix +commands and there is only a single generic function that can be +specialized based on the class of a prefix command. + + -- Function: transient--history-init obj + This generic function is called while setting up the transient and + is responsible for initializing the ‘history’ slot. This is the + transient-wide history; many individual infixes also have a history + of their own. + + The default (and currently only) method extracts the value from the + global variable ‘transient-history’. + + A transient prefix command’s object is stored in the +‘transient--prefix’ property of the command symbol. While a transient +is active, a clone of that object is stored in the variable +‘transient--prefix’. A clone is used because some changes that are made +to the active transient’s object should not affect later invocations. + + +File: transient.info, Node: Suffix Classes, Next: Suffix Methods, Prev: Prefix Classes, Up: Classes and Methods + +5.4 Suffix Classes +================== + + • All suffix and infix classes derive from ‘transient-suffix’, which + in turn derives from ‘transient-child’, from which + ‘transient-group’ also derives (see *note Group Classes::). + + • All infix classes derive from the abstract ‘transient-infix’ class, + which in turn derives from the ‘transient-suffix’ class. + + Infixes are a special type of suffixes. The primary difference is + that infixes always use the ‘transient--do-stay’ pre-command, while + non-infix suffixes use a variety of pre-commands (see *note + Transient State::). Doing that is most easily achieved by using + this class, though theoretically it would be possible to define an + infix class that does not do so. If you do that then you get to + implement many methods. + + Also, infixes and non-infix suffixes are usually defined using + different macros (see *note Defining Suffix and Infix Commands::). + + • Classes used for infix commands that represent arguments should be + derived from the abstract ‘transient-argument’ class. + + • The ‘transient-switch’ class (or a derived class) is used for infix + arguments that represent command-line switches (arguments that do + not take a value). + + • The ‘transient-option’ class (or a derived class) is used for infix + arguments that represent command-line options (arguments that do + take a value). + + • The ‘transient-switches’ class can be used for a set of mutually + exclusive command-line switches. + + • The ‘transient-files’ class can be used for a ‘--’ argument that + indicates that all remaining arguments are files. + + • Classes used for infix commands that represent variables should + derived from the abstract ‘transient-variable’ class. + + • The ‘transient-information’ class is special in that suffixes that + use this class are not associated with a command and thus also not + with any key binding. Such suffixes are only used to display + arbitrary information, and that anywhere a suffix can appear. + Display-only suffix specifications take this form: + + ([LEVEL] :info DESCRIPTION [KEYWORD VALUE]...) + + The ‘:info’ keyword argument replaces the ‘:description’ keyword + used for other suffix classes. Other keyword arguments that you + might want to set, include ‘:face’, predicate keywords (such as + ‘:if’), and ‘:format’. By default the value of ‘:format’ includes + ‘%k’, which for this class is replaced with the empty string or + spaces, if keys are being padded in the containing group. + + Magit defines additional classes, which can serve as examples for the +fancy things you can do without modifying Transient. Some of these +classes will likely get generalized and added to Transient. For now +they are very much subject to change and not documented. + + +File: transient.info, Node: Suffix Methods, Next: Prefix Slots, Prev: Suffix Classes, Up: Classes and Methods + +5.5 Suffix Methods +================== + +To get information about the methods implementing these generic +functions use ‘describe-function’. + +* Menu: + +* Suffix Value Methods:: +* Suffix Format Methods:: + + +File: transient.info, Node: Suffix Value Methods, Next: Suffix Format Methods, Up: Suffix Methods + +5.5.1 Suffix Value Methods +-------------------------- + + -- Function: transient-init-value obj + This generic function sets the initial value of the object OBJ. + + This function is called for all suffix commands, but unless a + concrete method is implemented this falls through to the default + implementation, which is a noop. In other words this usually only + does something for infix commands, but note that this is not + implemented for the abstract class ‘transient-infix’, so if your + class derives from that directly, then you must implement a method. + + -- Function: transient-infix-read obj + This generic function determines the new value of the infix object + OBJ. + + This function merely determines the value; ‘transient-infix-set’ is + used to actually store the new value in the object. + + For most infix classes this is done by reading a value from the + user using the reader specified by the ‘reader’ slot (using the + ‘transient-infix-value’ method described below). + + For some infix classes the value is changed without reading + anything in the minibuffer, i.e., the mere act of invoking the + infix command determines what the new value should be, based on the + previous value. + + -- Function: transient-prompt obj + This generic function returns the prompt to be used to read infix + object OBJ’s value. + + -- Function: transient-infix-set obj value + This generic function sets the value of infix object OBJ to VALUE. + + -- Function: transient-infix-value obj + This generic function returns the value of the suffix object OBJ. + + This function is called by ‘transient-args’ (which see), meaning + this function is how the value of a transient is determined so that + the invoked suffix command can use it. + + Currently most values are strings, but that is not set in stone. + ‘nil’ is not a value, it means “no value”. + + Usually only infixes have a value, but see the method for + ‘transient-suffix’. + + -- Function: transient-init-scope obj + This generic function sets the scope of the suffix object OBJ. + + The scope is actually a property of the transient prefix, not of + individual suffixes. However it is possible to invoke a suffix + command directly instead of from a transient. In that case, if the + suffix expects a scope, then it has to determine that itself and + store it in its ‘scope’ slot. + + This function is called for all suffix commands, but unless a + concrete method is implemented this falls through to the default + implementation, which is a noop. + + +File: transient.info, Node: Suffix Format Methods, Prev: Suffix Value Methods, Up: Suffix Methods + +5.5.2 Suffix Format Methods +--------------------------- + + -- Function: transient-format obj + This generic function formats and returns OBJ for display. + + When this function is called, then the current buffer is some + temporary buffer. If you need the buffer from which the prefix + command was invoked to be current, then do so by temporarily making + ‘transient--source-buffer’ current. + + -- Function: transient-format-key obj + This generic function formats OBJ’s ‘key’ for display and returns + the result. + + -- Function: transient-format-description obj + This generic function formats OBJ’s ‘description’ for display and + returns the result. + + -- Function: transient-format-value obj + This generic function formats OBJ’s value for display and returns + the result. + + -- Function: transient-show-help obj + Show help for the prefix, infix or suffix command represented by + OBJ. + + For prefixes, show the info manual, if that is specified using the + ‘info-manual’ slot. Otherwise, show the manpage if that is + specified using the ‘man-page’ slot. Otherwise, show the command’s + documentation string. + + For suffixes, show the command’s documentation string. + + For infixes, show the manpage if that is specified. Otherwise show + the command’s documentation string. + + +File: transient.info, Node: Prefix Slots, Next: Suffix Slots, Prev: Suffix Methods, Up: Classes and Methods + +5.6 Prefix Slots +================ + + • ‘show-help’, ‘man-page’ or ‘info-manual’ can be used to specify the + documentation for the prefix and its suffixes. The command + ‘transient-help’ uses the method ‘transient-show-help’ (which see) + to lookup and use these values. + + • ‘history-key’ If multiple prefix commands should share a single + value, then this slot has to be set to the same value for all of + them. You probably don’t want that. + + • ‘transient-suffix’ and ‘transient-non-suffix’ play a part when + determining whether the currently active transient prefix command + remains active/transient when a suffix or arbitrary non-suffix + command is invoked. See *note Transient State::. + + • ‘refresh-suffixes’ Normally suffix objects and keymaps are only + setup once, when the prefix is invoked. Setting this to ‘t’, + causes them to be recreated after every command. This is useful + when using ‘:if...’ predicates, and those need to be rerun for some + reason. Doing this is somewhat costly, and there is a risk of + losing state, so this is disabled by default and still considered + experimental. + + • ‘incompatible’ A list of lists. Each sub-list specifies a set of + mutually exclusive arguments. Enabling one of these arguments + causes the others to be disabled. An argument may appear in + multiple sub-lists. Arguments must me given in the same form as + used in the ‘argument’ or ‘argument-format’ slot of the respective + suffix objects, usually something like ‘--switch’ or ‘--option=%s’. + For options and ‘transient-switches’ suffixes it is also possible + to match against a specific value, as returned by + ‘transient-infix-value’, for example, ‘--option=one’. + + • ‘scope’ For some transients it might be necessary to have a sort of + secondary value, called a “scope”. See ‘transient-define-prefix’. + +Internal Prefix Slots +--------------------- + +These slots are mostly intended for internal use. They should not be +set in calls to ‘transient-define-prefix’. + + • ‘prototype’ When a transient prefix command is invoked, then a + clone of that object is stored in the global variable + ‘transient--prefix’ and the prototype is stored in the clone’s + ‘prototype’ slot. + + • ‘command’ The command, a symbol. Each transient prefix command + consists of a command, which is stored in a symbol’s function slot + and an object, which is stored in the ‘transient--prefix’ property + of the same symbol. + + • ‘level’ The level of the prefix commands. The suffix commands + whose layer is equal or lower are displayed. See *note Enabling + and Disabling Suffixes::. + + • ‘value’ The likely outdated value of the prefix. Instead of + accessing this slot directly you should use the function + ‘transient-get-value’, which is guaranteed to return the up-to-date + value. + + • ‘history’ and ‘history-pos’ are used to keep track of historic + values. Unless you implement your own ‘transient-infix-read’ + method you should not have to deal with these slots. + + +File: transient.info, Node: Suffix Slots, Next: Predicate Slots, Prev: Prefix Slots, Up: Classes and Methods + +5.7 Suffix Slots +================ + +Here we document most of the slots that are only available for suffix +objects. Some slots are shared by suffix and group objects, they are +documented in *note Predicate Slots::. + + Also see *note Suffix Classes::. + +Slots of ‘transient-suffix’ +--------------------------- + + • ‘key’ The key, a key vector or a key description string. + + • ‘command’ The command, a symbol. + + • ‘transient’ Whether to stay transient. See *note Transient + State::. + + • ‘format’ The format used to display the suffix in the popup buffer. + It must contain the following %-placeholders: + + • ‘%k’ For the key. + • ‘%d’ For the description. + • ‘%v’ For the infix value. Non-infix suffixes don’t have a + value. + + • ‘description’ The description, either a string or a function, which + is called with zero or one argument (the suffix object), and + returns a string. + + • ‘face’ Face used for the description. In simple cases it is easier + to use this instead of using a function as ‘description’ and adding + the styling there. ‘face’ is appended using + ‘add-face-text-property’. + + • ‘show-help’ A function used to display help for the suffix. If + unspecified, the prefix controls how help is displayed for its + suffixes. + +Slots of ‘transient-infix’ +-------------------------- + +Some of these slots are only meaningful for some of the subclasses. +They are defined here anyway to allow sharing certain methods. + + • ‘argument’ The long argument, e.g., ‘--verbose’. + + • ‘shortarg’ The short argument, e.g., ‘-v’. + + • ‘value’ The value. Should not be accessed directly. + + • ‘init-value’ Function that is responsible for setting the object’s + value. If bound, then this is called with the object as the only + argument. Usually this is not bound, in which case the object’s + primary ‘transient-init-value’ method is called instead. + + • ‘unsavable’ Whether the value of the suffix is not saved as part of + the prefixes. + + • ‘multi-value’ For options, whether the option can have multiple + values. If this is non-‘nil’, then the values are read using + ‘completing-read-multiple’ by default and if you specify your own + reader, then it should read the values using that function or + similar. + + Supported non-‘nil’ values are: + + • Use ‘rest’ for an option that can have multiple values. This + is useful e.g., for an ‘--’ argument that indicates that all + remaining arguments are files (such as ‘git log -- file1 + file2’). + + In the list returned by ‘transient-args’ such an option and + its values are represented by a single list of the form + ‘(ARGUMENT . VALUES)’. + + • Use ‘repeat’ for an option that can be specified multiple + times. + + In the list returned by ‘transient-args’ each instance of the + option and its value appears separately in the usual from, for + example: ‘("--another-argument" "--option=first" + "--option=second")’. + + In both cases the option’s values have to be specified in the + default value of a prefix using the same format as returned by + ‘transient-args’, e.g., ‘("--other" "--o=1" "--o=2" ("--" "f1" + "f2"))’. + + • ‘always-read’ For options, whether to read a value on every + invocation. If this is ‘nil’, then options that have a value are + simply unset and have to be invoked a second time to set a new + value. + + • ‘allow-empty’ For options, whether the empty string is a valid + value. + + • ‘history-key’ The key used to store the history. This defaults to + the command name. This is useful when multiple infixes should + share the same history because their values are of the same kind. + + • ‘reader’ The function used to read the value of an infix. Not used + for switches. The function takes three arguments, PROMPT, + INITIAL-INPUT and HISTORY, and must return a string. + + • ‘prompt’ The prompt used when reading the value, either a string or + a function that takes the object as the only argument and which + returns a prompt string. + + • ‘choices’ A list of valid values, or a function that returns such a + list. The latter is not implemented for ‘transient-switches’, + because I couldn’t think of a use-case. How exactly the choices + are used varies depending on the class of the suffix. + +Slots of ‘transient-variable’ +----------------------------- + + • ‘variable’ The variable. + +Slots of ‘transient-switches’ +----------------------------- + + • ‘argument-format’ The display format. Must contain ‘%s’, one of + the ‘choices’ is substituted for that. E.g., ‘--%s-order’. + + • ‘argument-regexp’ The regexp used to match any one of the switches. + E.g., ‘\\(--\\(topo\\|author-date\\|date\\)-order\\)’. + + +File: transient.info, Node: Predicate Slots, Prev: Suffix Slots, Up: Classes and Methods + +5.8 Predicate Slots +=================== + +Suffix and group objects share some predicate slots that control whether +a group or suffix should be available depending on some state. Only one +of these slots can be used at the same time. It is undefined what +happens if you use more than one. + + • ‘if’ Enable if predicate returns non-‘nil’. + • ‘if-not’ Enable if predicate returns ‘nil’. + • ‘if-non-nil’ Enable if variable’s value is non-‘nil’. + • ‘if-nil’ Enable if variable’s value is ‘nil’. + • ‘if-mode’ Enable if major-mode matches value. + • ‘if-not-mode’ Enable if major-mode does not match value. + • ‘if-derived’ Enable if major-mode derives from value. + • ‘if-not-derived’ Enable if major-mode does not derive from value. + + By default these predicates run when the prefix command is invoked, +but this can be changes, using the ‘refresh-suffixes’ prefix slot. See +*note Prefix Slots::. + + One more slot is shared between group and suffix classes, ‘level’. +Like the slots documented above, it is a predicate, but it is used for a +different purpose. The value has to be an integer between 1 and 7. +‘level’ controls whether a suffix or a group should be available +depending on user preference. See *note Enabling and Disabling +Suffixes::. + + +File: transient.info, Node: FAQ, Next: Keystroke Index, Prev: Classes and Methods, Up: Top + +Appendix A FAQ +************** + +A.1 Can I control how the popup buffer is displayed? +==================================================== + +Yes, see ‘transient-display-buffer-action’ in *note Configuration::. + +A.2 How can I copy text from the popup buffer? +============================================== + +To be able to mark text in Transient’s popup buffer using the mouse, you +have to add the below binding. Note that for technical reasons, the +region won’t be visualized, while doing so. After you have quit the +transient popup, you will be able to yank it in another buffer. + + (keymap-set transient-predicate-map + "<mouse-set-region>" + #'transient--do-stay) + +A.3 How can I autoload prefix and suffix commands? +================================================== + +If your package only supports Emacs 30, just prefix the definition with +‘;;;###autoload’. If your package supports released versions of Emacs, +you unfortunately have to use a long form autoload comment as described +in *note (elisp)Autoload::. + + ;;;###autoload (autoload 'magit-dispatch "magit" nil t) + (transient-define-prefix magit-dispatch () + ...) + +A.4 How does Transient compare to prefix keys and universal arguments? +====================================================================== + +See +<https://github.com/magit/transient/wiki/Comparison-with-prefix-keys-and-universal-arguments>. + +A.5 How does Transient compare to Magit-Popup and Hydra? +======================================================== + +See +<https://github.com/magit/transient/wiki/Comparison-with-other-packages>. + +A.6 Why did some of the key bindings change? +============================================ + +You may have noticed that the bindings for some of the common commands +do *not* have the prefix ‘C-x’ and that furthermore some of these +commands are grayed out while others are not. That unfortunately is a +bit confusing if the section of common commands is not shown +permanently, making the following explanation necessary. + + The purpose of usually hiding that section but showing it after the +user pressed the respective prefix key is to conserve space and not +overwhelm users with too much noise, while allowing the user to quickly +list common bindings on demand. + + That however should not keep us from using the best possible key +bindings. The bindings that do use a prefix do so to avoid wasting too +many non-prefix bindings, keeping them available for use in individual +transients. The bindings that do not use a prefix and that are *not* +grayed out are very important bindings that are *always* available, even +when invoking the “common command key prefix” or *any other* +transient-specific prefix. The non-prefix keys that *are* grayed out +however, are not available when any incomplete prefix key sequence is +active. They do not use the “common command key prefix” because it is +likely that users want to invoke them several times in a row and e.g., +‘M-p M-p M-p’ is much more convenient than ‘C-x M-p C-x M-p C-x M-p’. + + You may also have noticed that the “Set” command is bound to ‘C-x s’, +while Magit-Popup used to bind ‘C-c C-c’ instead. I have seen several +users praise the latter binding (sic), so I did not change it +willy-nilly. The reason that I changed it is that using different +prefix keys for different common commands, would have made the temporary +display of the common commands even more confusing, i.e., after pressing +‘C-c’ all the bindings that begin with the ‘C-x’ prefix would be grayed +out. + + Using a single prefix for common commands key means that all other +potential prefix keys can be used for transient-specific commands +*without* the section of common commands also popping up. ‘C-c’ in +particular is a prefix that I want to (and already do) use for Magit, +and also using that for a common command would prevent me from doing so. + + (Also see the next question.) + +A.7 Why does ‘q’ not quit popups anymore? +========================================= + +I agree that ‘q’ is a good binding for commands that quit something. +This includes quitting whatever transient is currently active, but it +also includes quitting whatever it is that some specific transient is +controlling. The transient ‘magit-blame’ for example binds ‘q’ to the +command that turns ‘magit-blame-mode’ off. + + So I had to decide if ‘q’ should quit the active transient (like +Magit-Popup used to) or whether ‘C-g’ should do that instead, so that +‘q’ could be bound in individual transient to whatever commands make +sense for them. Because all other letters are already reserved for use +by individual transients, I have decided to no longer make an exception +for ‘q’. + + If you want to get ‘q’’s old binding back then you can do so. Doing +that is a bit more complicated than changing a single key binding, so I +have implemented a function, ‘transient-bind-q-to-quit’ that makes the +necessary changes. See its documentation string for more information. + + +File: transient.info, Node: Keystroke Index, Next: Command and Function Index, Prev: FAQ, Up: Top + +Appendix B Keystroke Index +************************** + + +* Menu: + +* C-g: Aborting and Resuming Transients. + (line 27) +* C-g <1>: Aborting and Resuming Transients. + (line 27) +* C-h: Getting Help for Suffix Commands. + (line 11) +* C-M-n: Using History. (line 18) +* C-M-p: Using History. (line 13) +* C-q: Aborting and Resuming Transients. + (line 36) +* C-x a: Enabling and Disabling Suffixes. + (line 68) +* C-x C-k: Saving Values. (line 29) +* C-x C-s: Saving Values. (line 25) +* C-x l: Enabling and Disabling Suffixes. + (line 43) +* C-x n: Using History. (line 18) +* C-x p: Using History. (line 13) +* C-x s: Saving Values. (line 21) +* C-x t: Common Suffix Commands. + (line 18) +* C-z: Aborting and Resuming Transients. + (line 41) + + +File: transient.info, Node: Command and Function Index, Next: Variable Index, Prev: Keystroke Index, Up: Top + +Appendix C Command and Function Index +************************************* + + +* Menu: + +* transient--do-call: Transient State. (line 125) +* transient--do-exit: Transient State. (line 117) +* transient--do-leave: Transient State. (line 193) +* transient--do-quit-all: Transient State. (line 205) +* transient--do-quit-one: Transient State. (line 200) +* transient--do-recurse: Transient State. (line 133) +* transient--do-replace: Transient State. (line 153) +* transient--do-return: Transient State. (line 120) +* transient--do-stack: Transient State. (line 145) +* transient--do-stay: Transient State. (line 105) +* transient--do-stay <1>: Transient State. (line 190) +* transient--do-suspend: Transient State. (line 161) +* transient--do-suspend <1>: Transient State. (line 210) +* transient--do-warn: Transient State. (line 187) +* transient--history-init: Prefix Classes. (line 10) +* transient--insert-group: Group Methods. (line 19) +* transient-append-suffix: Modifying Existing Transients. + (line 51) +* transient-arg-value: Using Infix Arguments. + (line 31) +* transient-args: Using Infix Arguments. + (line 22) +* transient-define-argument: Defining Suffix and Infix Commands. + (line 57) +* transient-define-infix: Defining Suffix and Infix Commands. + (line 26) +* transient-define-prefix: Defining Transients. (line 13) +* transient-define-suffix: Defining Suffix and Infix Commands. + (line 9) +* transient-format: Suffix Format Methods. + (line 6) +* transient-format-description: Suffix Format Methods. + (line 18) +* transient-format-key: Suffix Format Methods. + (line 14) +* transient-format-value: Suffix Format Methods. + (line 22) +* transient-get-suffix: Modifying Existing Transients. + (line 73) +* transient-help: Getting Help for Suffix Commands. + (line 11) +* transient-history-next: Using History. (line 18) +* transient-history-prev: Using History. (line 13) +* transient-infix-read: Suffix Value Methods. + (line 16) +* transient-infix-set: Suffix Value Methods. + (line 36) +* transient-infix-value: Suffix Value Methods. + (line 39) +* transient-init-scope: Suffix Value Methods. + (line 52) +* transient-init-value: Suffix Value Methods. + (line 6) +* transient-insert-suffix: Modifying Existing Transients. + (line 49) +* transient-prompt: Suffix Value Methods. + (line 32) +* transient-quit-all: Aborting and Resuming Transients. + (line 36) +* transient-quit-one: Aborting and Resuming Transients. + (line 27) +* transient-quit-seq: Aborting and Resuming Transients. + (line 27) +* transient-remove-suffix: Modifying Existing Transients. + (line 70) +* transient-replace-suffix: Modifying Existing Transients. + (line 66) +* transient-reset: Saving Values. (line 29) +* transient-resume: Aborting and Resuming Transients. + (line 53) +* transient-save: Saving Values. (line 25) +* transient-scroll-down: Other Commands. (line 17) +* transient-scroll-up: Other Commands. (line 12) +* transient-set: Saving Values. (line 21) +* transient-set-level: Enabling and Disabling Suffixes. + (line 43) +* transient-setup-children: Group Methods. (line 6) +* transient-show-help: Suffix Format Methods. + (line 26) +* transient-suffix-put: Modifying Existing Transients. + (line 77) +* transient-suffixes: Using Infix Arguments. + (line 38) +* transient-suspend: Aborting and Resuming Transients. + (line 41) +* transient-toggle-common: Common Suffix Commands. + (line 18) +* transient-toggle-level-limit: Enabling and Disabling Suffixes. + (line 68) + + +File: transient.info, Node: Variable Index, Next: Concept Index, Prev: Command and Function Index, Up: Top + +Appendix D Variable Index +************************* + + +* Menu: + +* transient-align-variable-pitch: Configuration. (line 185) +* transient-current-command: Using Infix Arguments. + (line 57) +* transient-current-prefix: Using Infix Arguments. + (line 52) +* transient-current-suffixes: Using Infix Arguments. + (line 44) +* transient-default-level: Enabling and Disabling Suffixes. + (line 33) +* transient-detect-key-conflicts: Configuration. (line 210) +* transient-display-buffer-action: Configuration. (line 51) +* transient-enable-popup-navigation: Configuration. (line 36) +* transient-force-fixed-pitch: Configuration. (line 198) +* transient-force-single-column: Configuration. (line 93) +* transient-hide-during-minibuffer-read: Configuration. (line 181) +* transient-highlight-higher-levels: Configuration. (line 223) +* transient-highlight-mismatched-keys: Configuration. (line 135) +* transient-history-file: Using History. (line 33) +* transient-history-limit: Using History. (line 37) +* transient-levels-file: Enabling and Disabling Suffixes. + (line 38) +* transient-mode-line-format: Configuration. (line 102) +* transient-read-with-initial-input: Configuration. (line 174) +* transient-semantic-coloring: Configuration. (line 126) +* transient-show-common-commands: Common Suffix Commands. + (line 23) +* transient-show-popup: Configuration. (line 15) +* transient-substitute-key-function: Configuration. (line 153) +* transient-values-file: Saving Values. (line 31) + + +File: transient.info, Node: Concept Index, Next: GNU General Public License, Prev: Variable Index, Up: Top + +Appendix E Concept Index +************************ + + +* Menu: + +* aborting transients: Aborting and Resuming Transients. + (line 6) +* classes and methods: Classes and Methods. (line 6) +* command dispatchers: Technical Introduction. + (line 39) +* common suffix commands: Common Suffix Commands. + (line 6) +* defining infix commands: Defining Suffix and Infix Commands. + (line 6) +* defining suffix commands: Defining Suffix and Infix Commands. + (line 6) +* disabling suffixes: Enabling and Disabling Suffixes. + (line 6) +* enabling suffixes: Enabling and Disabling Suffixes. + (line 6) +* getting help: Getting Help for Suffix Commands. + (line 6) +* group specifications: Group Specifications. (line 6) +* invoking transients: Invoking Transients. (line 6) +* levels: Enabling and Disabling Suffixes. + (line 10) +* modifying existing transients: Modifying Existing Transients. + (line 6) +* quit transient: Aborting and Resuming Transients. + (line 6) +* resuming transients: Aborting and Resuming Transients. + (line 6) +* saving values of arguments: Saving Values. (line 6) +* scope of a transient: Defining Transients. (line 43) +* suffix specifications: Suffix Specifications. + (line 6) +* transient state: Transient State. (line 6) +* transient-level: Enabling and Disabling Suffixes. + (line 15) +* value history: Using History. (line 6) + + +File: transient.info, Node: GNU General Public License, Prev: Concept Index, Up: Top + +Appendix F GNU General Public License +************************************* + + Version 3, 29 June 2007 + + Copyright © 2007 Free Software Foundation, Inc. <https://fsf.org/> + + Everyone is permitted to copy and distribute verbatim copies of this + license document, but changing it is not allowed. + +Preamble +======== + +The GNU General Public License is a free, copyleft license for software +and other kinds of works. + + The licenses for most software and other practical works are designed +to take away your freedom to share and change the works. By contrast, +the GNU General Public License is intended to guarantee your freedom to +share and change all versions of a program—to make sure it remains free +software for all its users. We, the Free Software Foundation, use the +GNU General Public License for most of our software; it applies also to +any other work released this way by its authors. You can apply it to +your programs, too. + + When we speak of free software, we are referring to freedom, not +price. Our General Public Licenses are designed to make sure that you +have the freedom to distribute copies of free software (and charge for +them if you wish), that you receive source code or can get it if you +want it, that you can change the software or use pieces of it in new +free programs, and that you know you can do these things. + + To protect your rights, we need to prevent others from denying you +these rights or asking you to surrender the rights. Therefore, you have +certain responsibilities if you distribute copies of the software, or if +you modify it: responsibilities to respect the freedom of others. + + For example, if you distribute copies of such a program, whether +gratis or for a fee, you must pass on to the recipients the same +freedoms that you received. You must make sure that they, too, receive +or can get the source code. And you must show them these terms so they +know their rights. + + Developers that use the GNU GPL protect your rights with two steps: +(1) assert copyright on the software, and (2) offer you this License +giving you legal permission to copy, distribute and/or modify it. + + For the developers’ and authors’ protection, the GPL clearly explains +that there is no warranty for this free software. For both users’ and +authors’ sake, the GPL requires that modified versions be marked as +changed, so that their problems will not be attributed erroneously to +authors of previous versions. + + Some devices are designed to deny users access to install or run +modified versions of the software inside them, although the manufacturer +can do so. This is fundamentally incompatible with the aim of +protecting users’ freedom to change the software. The systematic +pattern of such abuse occurs in the area of products for individuals to +use, which is precisely where it is most unacceptable. Therefore, we +have designed this version of the GPL to prohibit the practice for those +products. If such problems arise substantially in other domains, we +stand ready to extend this provision to those domains in future versions +of the GPL, as needed to protect the freedom of users. + + Finally, every program is threatened constantly by software patents. +States should not allow patents to restrict development and use of +software on general-purpose computers, but in those that do, we wish to +avoid the special danger that patents applied to a free program could +make it effectively proprietary. To prevent this, the GPL assures that +patents cannot be used to render the program non-free. + + The precise terms and conditions for copying, distribution and +modification follow. + +TERMS AND CONDITIONS +==================== + + 0. Definitions. + + “This License” refers to version 3 of the GNU General Public + License. + + “Copyright” also means copyright-like laws that apply to other + kinds of works, such as semiconductor masks. + + “The Program” refers to any copyrightable work licensed under this + License. Each licensee is addressed as “you”. “Licensees” and + “recipients” may be individuals or organizations. + + To “modify” a work means to copy from or adapt all or part of the + work in a fashion requiring copyright permission, other than the + making of an exact copy. The resulting work is called a “modified + version” of the earlier work or a work “based on” the earlier work. + + A “covered work” means either the unmodified Program or a work + based on the Program. + + To “propagate” a work means to do anything with it that, without + permission, would make you directly or secondarily liable for + infringement under applicable copyright law, except executing it on + a computer or modifying a private copy. Propagation includes + copying, distribution (with or without modification), making + available to the public, and in some countries other activities as + well. + + To “convey” a work means any kind of propagation that enables other + parties to make or receive copies. Mere interaction with a user + through a computer network, with no transfer of a copy, is not + conveying. + + An interactive user interface displays “Appropriate Legal Notices” + to the extent that it includes a convenient and prominently visible + feature that (1) displays an appropriate copyright notice, and (2) + tells the user that there is no warranty for the work (except to + the extent that warranties are provided), that licensees may convey + the work under this License, and how to view a copy of this + License. If the interface presents a list of user commands or + options, such as a menu, a prominent item in the list meets this + criterion. + + 1. Source Code. + + The “source code” for a work means the preferred form of the work + for making modifications to it. “Object code” means any non-source + form of a work. + + A “Standard Interface” means an interface that either is an + official standard defined by a recognized standards body, or, in + the case of interfaces specified for a particular programming + language, one that is widely used among developers working in that + language. + + The “System Libraries” of an executable work include anything, + other than the work as a whole, that (a) is included in the normal + form of packaging a Major Component, but which is not part of that + Major Component, and (b) serves only to enable use of the work with + that Major Component, or to implement a Standard Interface for + which an implementation is available to the public in source code + form. A “Major Component”, in this context, means a major + essential component (kernel, window system, and so on) of the + specific operating system (if any) on which the executable work + runs, or a compiler used to produce the work, or an object code + interpreter used to run it. + + The “Corresponding Source” for a work in object code form means all + the source code needed to generate, install, and (for an executable + work) run the object code and to modify the work, including scripts + to control those activities. However, it does not include the + work’s System Libraries, or general-purpose tools or generally + available free programs which are used unmodified in performing + those activities but which are not part of the work. For example, + Corresponding Source includes interface definition files associated + with source files for the work, and the source code for shared + libraries and dynamically linked subprograms that the work is + specifically designed to require, such as by intimate data + communication or control flow between those subprograms and other + parts of the work. + + The Corresponding Source need not include anything that users can + regenerate automatically from other parts of the Corresponding + Source. + + The Corresponding Source for a work in source code form is that + same work. + + 2. Basic Permissions. + + All rights granted under this License are granted for the term of + copyright on the Program, and are irrevocable provided the stated + conditions are met. This License explicitly affirms your unlimited + permission to run the unmodified Program. The output from running + a covered work is covered by this License only if the output, given + its content, constitutes a covered work. This License acknowledges + your rights of fair use or other equivalent, as provided by + copyright law. + + You may make, run and propagate covered works that you do not + convey, without conditions so long as your license otherwise + remains in force. You may convey covered works to others for the + sole purpose of having them make modifications exclusively for you, + or provide you with facilities for running those works, provided + that you comply with the terms of this License in conveying all + material for which you do not control copyright. Those thus making + or running the covered works for you must do so exclusively on your + behalf, under your direction and control, on terms that prohibit + them from making any copies of your copyrighted material outside + their relationship with you. + + Conveying under any other circumstances is permitted solely under + the conditions stated below. Sublicensing is not allowed; section + 10 makes it unnecessary. + + 3. Protecting Users’ Legal Rights From Anti-Circumvention Law. + + No covered work shall be deemed part of an effective technological + measure under any applicable law fulfilling obligations under + article 11 of the WIPO copyright treaty adopted on 20 December + 1996, or similar laws prohibiting or restricting circumvention of + such measures. + + When you convey a covered work, you waive any legal power to forbid + circumvention of technological measures to the extent such + circumvention is effected by exercising rights under this License + with respect to the covered work, and you disclaim any intention to + limit operation or modification of the work as a means of + enforcing, against the work’s users, your or third parties’ legal + rights to forbid circumvention of technological measures. + + 4. Conveying Verbatim Copies. + + You may convey verbatim copies of the Program’s source code as you + receive it, in any medium, provided that you conspicuously and + appropriately publish on each copy an appropriate copyright notice; + keep intact all notices stating that this License and any + non-permissive terms added in accord with section 7 apply to the + code; keep intact all notices of the absence of any warranty; and + give all recipients a copy of this License along with the Program. + + You may charge any price or no price for each copy that you convey, + and you may offer support or warranty protection for a fee. + + 5. Conveying Modified Source Versions. + + You may convey a work based on the Program, or the modifications to + produce it from the Program, in the form of source code under the + terms of section 4, provided that you also meet all of these + conditions: + + a. The work must carry prominent notices stating that you + modified it, and giving a relevant date. + + b. The work must carry prominent notices stating that it is + released under this License and any conditions added under + section 7. This requirement modifies the requirement in + section 4 to “keep intact all notices”. + + c. You must license the entire work, as a whole, under this + License to anyone who comes into possession of a copy. This + License will therefore apply, along with any applicable + section 7 additional terms, to the whole of the work, and all + its parts, regardless of how they are packaged. This License + gives no permission to license the work in any other way, but + it does not invalidate such permission if you have separately + received it. + + d. If the work has interactive user interfaces, each must display + Appropriate Legal Notices; however, if the Program has + interactive interfaces that do not display Appropriate Legal + Notices, your work need not make them do so. + + A compilation of a covered work with other separate and independent + works, which are not by their nature extensions of the covered + work, and which are not combined with it such as to form a larger + program, in or on a volume of a storage or distribution medium, is + called an “aggregate” if the compilation and its resulting + copyright are not used to limit the access or legal rights of the + compilation’s users beyond what the individual works permit. + Inclusion of a covered work in an aggregate does not cause this + License to apply to the other parts of the aggregate. + + 6. Conveying Non-Source Forms. + + You may convey a covered work in object code form under the terms + of sections 4 and 5, provided that you also convey the + machine-readable Corresponding Source under the terms of this + License, in one of these ways: + + a. Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by the + Corresponding Source fixed on a durable physical medium + customarily used for software interchange. + + b. Convey the object code in, or embodied in, a physical product + (including a physical distribution medium), accompanied by a + written offer, valid for at least three years and valid for as + long as you offer spare parts or customer support for that + product model, to give anyone who possesses the object code + either (1) a copy of the Corresponding Source for all the + software in the product that is covered by this License, on a + durable physical medium customarily used for software + interchange, for a price no more than your reasonable cost of + physically performing this conveying of source, or (2) access + to copy the Corresponding Source from a network server at no + charge. + + c. Convey individual copies of the object code with a copy of the + written offer to provide the Corresponding Source. This + alternative is allowed only occasionally and noncommercially, + and only if you received the object code with such an offer, + in accord with subsection 6b. + + d. Convey the object code by offering access from a designated + place (gratis or for a charge), and offer equivalent access to + the Corresponding Source in the same way through the same + place at no further charge. You need not require recipients + to copy the Corresponding Source along with the object code. + If the place to copy the object code is a network server, the + Corresponding Source may be on a different server (operated by + you or a third party) that supports equivalent copying + facilities, provided you maintain clear directions next to the + object code saying where to find the Corresponding Source. + Regardless of what server hosts the Corresponding Source, you + remain obligated to ensure that it is available for as long as + needed to satisfy these requirements. + + e. Convey the object code using peer-to-peer transmission, + provided you inform other peers where the object code and + Corresponding Source of the work are being offered to the + general public at no charge under subsection 6d. + + A separable portion of the object code, whose source code is + excluded from the Corresponding Source as a System Library, need + not be included in conveying the object code work. + + A “User Product” is either (1) a “consumer product”, which means + any tangible personal property which is normally used for personal, + family, or household purposes, or (2) anything designed or sold for + incorporation into a dwelling. In determining whether a product is + a consumer product, doubtful cases shall be resolved in favor of + coverage. For a particular product received by a particular user, + “normally used” refers to a typical or common use of that class of + product, regardless of the status of the particular user or of the + way in which the particular user actually uses, or expects or is + expected to use, the product. A product is a consumer product + regardless of whether the product has substantial commercial, + industrial or non-consumer uses, unless such uses represent the + only significant mode of use of the product. + + “Installation Information” for a User Product means any methods, + procedures, authorization keys, or other information required to + install and execute modified versions of a covered work in that + User Product from a modified version of its Corresponding Source. + The information must suffice to ensure that the continued + functioning of the modified object code is in no case prevented or + interfered with solely because modification has been made. + + If you convey an object code work under this section in, or with, + or specifically for use in, a User Product, and the conveying + occurs as part of a transaction in which the right of possession + and use of the User Product is transferred to the recipient in + perpetuity or for a fixed term (regardless of how the transaction + is characterized), the Corresponding Source conveyed under this + section must be accompanied by the Installation Information. But + this requirement does not apply if neither you nor any third party + retains the ability to install modified object code on the User + Product (for example, the work has been installed in ROM). + + The requirement to provide Installation Information does not + include a requirement to continue to provide support service, + warranty, or updates for a work that has been modified or installed + by the recipient, or for the User Product in which it has been + modified or installed. Access to a network may be denied when the + modification itself materially and adversely affects the operation + of the network or violates the rules and protocols for + communication across the network. + + Corresponding Source conveyed, and Installation Information + provided, in accord with this section must be in a format that is + publicly documented (and with an implementation available to the + public in source code form), and must require no special password + or key for unpacking, reading or copying. + + 7. Additional Terms. + + “Additional permissions” are terms that supplement the terms of + this License by making exceptions from one or more of its + conditions. Additional permissions that are applicable to the + entire Program shall be treated as though they were included in + this License, to the extent that they are valid under applicable + law. If additional permissions apply only to part of the Program, + that part may be used separately under those permissions, but the + entire Program remains governed by this License without regard to + the additional permissions. + + When you convey a copy of a covered work, you may at your option + remove any additional permissions from that copy, or from any part + of it. (Additional permissions may be written to require their own + removal in certain cases when you modify the work.) You may place + additional permissions on material, added by you to a covered work, + for which you have or can give appropriate copyright permission. + + Notwithstanding any other provision of this License, for material + you add to a covered work, you may (if authorized by the copyright + holders of that material) supplement the terms of this License with + terms: + + a. Disclaiming warranty or limiting liability differently from + the terms of sections 15 and 16 of this License; or + + b. Requiring preservation of specified reasonable legal notices + or author attributions in that material or in the Appropriate + Legal Notices displayed by works containing it; or + + c. Prohibiting misrepresentation of the origin of that material, + or requiring that modified versions of such material be marked + in reasonable ways as different from the original version; or + + d. Limiting the use for publicity purposes of names of licensors + or authors of the material; or + + e. Declining to grant rights under trademark law for use of some + trade names, trademarks, or service marks; or + + f. Requiring indemnification of licensors and authors of that + material by anyone who conveys the material (or modified + versions of it) with contractual assumptions of liability to + the recipient, for any liability that these contractual + assumptions directly impose on those licensors and authors. + + All other non-permissive additional terms are considered “further + restrictions” within the meaning of section 10. If the Program as + you received it, or any part of it, contains a notice stating that + it is governed by this License along with a term that is a further + restriction, you may remove that term. If a license document + contains a further restriction but permits relicensing or conveying + under this License, you may add to a covered work material governed + by the terms of that license document, provided that the further + restriction does not survive such relicensing or conveying. + + If you add terms to a covered work in accord with this section, you + must place, in the relevant source files, a statement of the + additional terms that apply to those files, or a notice indicating + where to find the applicable terms. + + Additional terms, permissive or non-permissive, may be stated in + the form of a separately written license, or stated as exceptions; + the above requirements apply either way. + + 8. Termination. + + You may not propagate or modify a covered work except as expressly + provided under this License. Any attempt otherwise to propagate or + modify it is void, and will automatically terminate your rights + under this License (including any patent licenses granted under the + third paragraph of section 11). + + However, if you cease all violation of this License, then your + license from a particular copyright holder is reinstated (a) + provisionally, unless and until the copyright holder explicitly and + finally terminates your license, and (b) permanently, if the + copyright holder fails to notify you of the violation by some + reasonable means prior to 60 days after the cessation. + + Moreover, your license from a particular copyright holder is + reinstated permanently if the copyright holder notifies you of the + violation by some reasonable means, this is the first time you have + received notice of violation of this License (for any work) from + that copyright holder, and you cure the violation prior to 30 days + after your receipt of the notice. + + Termination of your rights under this section does not terminate + the licenses of parties who have received copies or rights from you + under this License. If your rights have been terminated and not + permanently reinstated, you do not qualify to receive new licenses + for the same material under section 10. + + 9. Acceptance Not Required for Having Copies. + + You are not required to accept this License in order to receive or + run a copy of the Program. Ancillary propagation of a covered work + occurring solely as a consequence of using peer-to-peer + transmission to receive a copy likewise does not require + acceptance. However, nothing other than this License grants you + permission to propagate or modify any covered work. These actions + infringe copyright if you do not accept this License. Therefore, + by modifying or propagating a covered work, you indicate your + acceptance of this License to do so. + + 10. Automatic Licensing of Downstream Recipients. + + Each time you convey a covered work, the recipient automatically + receives a license from the original licensors, to run, modify and + propagate that work, subject to this License. You are not + responsible for enforcing compliance by third parties with this + License. + + An “entity transaction” is a transaction transferring control of an + organization, or substantially all assets of one, or subdividing an + organization, or merging organizations. If propagation of a + covered work results from an entity transaction, each party to that + transaction who receives a copy of the work also receives whatever + licenses to the work the party’s predecessor in interest had or + could give under the previous paragraph, plus a right to possession + of the Corresponding Source of the work from the predecessor in + interest, if the predecessor has it or can get it with reasonable + efforts. + + You may not impose any further restrictions on the exercise of the + rights granted or affirmed under this License. For example, you + may not impose a license fee, royalty, or other charge for exercise + of rights granted under this License, and you may not initiate + litigation (including a cross-claim or counterclaim in a lawsuit) + alleging that any patent claim is infringed by making, using, + selling, offering for sale, or importing the Program or any portion + of it. + + 11. Patents. + + A “contributor” is a copyright holder who authorizes use under this + License of the Program or a work on which the Program is based. + The work thus licensed is called the contributor’s “contributor + version”. + + A contributor’s “essential patent claims” are all patent claims + owned or controlled by the contributor, whether already acquired or + hereafter acquired, that would be infringed by some manner, + permitted by this License, of making, using, or selling its + contributor version, but do not include claims that would be + infringed only as a consequence of further modification of the + contributor version. For purposes of this definition, “control” + includes the right to grant patent sublicenses in a manner + consistent with the requirements of this License. + + Each contributor grants you a non-exclusive, worldwide, + royalty-free patent license under the contributor’s essential + patent claims, to make, use, sell, offer for sale, import and + otherwise run, modify and propagate the contents of its contributor + version. + + In the following three paragraphs, a “patent license” is any + express agreement or commitment, however denominated, not to + enforce a patent (such as an express permission to practice a + patent or covenant not to sue for patent infringement). To “grant” + such a patent license to a party means to make such an agreement or + commitment not to enforce a patent against the party. + + If you convey a covered work, knowingly relying on a patent + license, and the Corresponding Source of the work is not available + for anyone to copy, free of charge and under the terms of this + License, through a publicly available network server or other + readily accessible means, then you must either (1) cause the + Corresponding Source to be so available, or (2) arrange to deprive + yourself of the benefit of the patent license for this particular + work, or (3) arrange, in a manner consistent with the requirements + of this License, to extend the patent license to downstream + recipients. “Knowingly relying” means you have actual knowledge + that, but for the patent license, your conveying the covered work + in a country, or your recipient’s use of the covered work in a + country, would infringe one or more identifiable patents in that + country that you have reason to believe are valid. + + If, pursuant to or in connection with a single transaction or + arrangement, you convey, or propagate by procuring conveyance of, a + covered work, and grant a patent license to some of the parties + receiving the covered work authorizing them to use, propagate, + modify or convey a specific copy of the covered work, then the + patent license you grant is automatically extended to all + recipients of the covered work and works based on it. + + A patent license is “discriminatory” if it does not include within + the scope of its coverage, prohibits the exercise of, or is + conditioned on the non-exercise of one or more of the rights that + are specifically granted under this License. You may not convey a + covered work if you are a party to an arrangement with a third + party that is in the business of distributing software, under which + you make payment to the third party based on the extent of your + activity of conveying the work, and under which the third party + grants, to any of the parties who would receive the covered work + from you, a discriminatory patent license (a) in connection with + copies of the covered work conveyed by you (or copies made from + those copies), or (b) primarily for and in connection with specific + products or compilations that contain the covered work, unless you + entered into that arrangement, or that patent license was granted, + prior to 28 March 2007. + + Nothing in this License shall be construed as excluding or limiting + any implied license or other defenses to infringement that may + otherwise be available to you under applicable patent law. + + 12. No Surrender of Others’ Freedom. + + If conditions are imposed on you (whether by court order, agreement + or otherwise) that contradict the conditions of this License, they + do not excuse you from the conditions of this License. If you + cannot convey a covered work so as to satisfy simultaneously your + obligations under this License and any other pertinent obligations, + then as a consequence you may not convey it at all. For example, + if you agree to terms that obligate you to collect a royalty for + further conveying from those to whom you convey the Program, the + only way you could satisfy both those terms and this License would + be to refrain entirely from conveying the Program. + + 13. Use with the GNU Affero General Public License. + + Notwithstanding any other provision of this License, you have + permission to link or combine any covered work with a work licensed + under version 3 of the GNU Affero General Public License into a + single combined work, and to convey the resulting work. The terms + of this License will continue to apply to the part which is the + covered work, but the special requirements of the GNU Affero + General Public License, section 13, concerning interaction through + a network will apply to the combination as such. + + 14. Revised Versions of this License. + + The Free Software Foundation may publish revised and/or new + versions of the GNU General Public License from time to time. Such + new versions will be similar in spirit to the present version, but + may differ in detail to address new problems or concerns. + + Each version is given a distinguishing version number. If the + Program specifies that a certain numbered version of the GNU + General Public License “or any later version” applies to it, you + have the option of following the terms and conditions either of + that numbered version or of any later version published by the Free + Software Foundation. If the Program does not specify a version + number of the GNU General Public License, you may choose any + version ever published by the Free Software Foundation. + + If the Program specifies that a proxy can decide which future + versions of the GNU General Public License can be used, that + proxy’s public statement of acceptance of a version permanently + authorizes you to choose that version for the Program. + + Later license versions may give you additional or different + permissions. However, no additional obligations are imposed on any + author or copyright holder as a result of your choosing to follow a + later version. + + 15. Disclaimer of Warranty. + + THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY + APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE + COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM “AS IS” + WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR IMPLIED, + INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF + MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE + RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. + SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL + NECESSARY SERVICING, REPAIR OR CORRECTION. + + 16. Limitation of Liability. + + IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN + WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES + AND/OR CONVEYS THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR + DAMAGES, INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR + CONSEQUENTIAL DAMAGES ARISING OUT OF THE USE OR INABILITY TO USE + THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA + BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD + PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER + PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF + THE POSSIBILITY OF SUCH DAMAGES. + + 17. Interpretation of Sections 15 and 16. + + If the disclaimer of warranty and limitation of liability provided + above cannot be given local legal effect according to their terms, + reviewing courts shall apply local law that most closely + approximates an absolute waiver of all civil liability in + connection with the Program, unless a warranty or assumption of + liability accompanies a copy of the Program in return for a fee. + +END OF TERMS AND CONDITIONS +=========================== + +How to Apply These Terms to Your New Programs +============================================= + +If you develop a new program, and you want it to be of the greatest +possible use to the public, the best way to achieve this is to make it +free software which everyone can redistribute and change under these +terms. + + To do so, attach the following notices to the program. It is safest +to attach them to the start of each source file to most effectively +state the exclusion of warranty; and each file should have at least the +“copyright” line and a pointer to where the full notice is found. + + ONE LINE TO GIVE THE PROGRAM'S NAME AND A BRIEF IDEA OF WHAT IT DOES. + Copyright (C) YEAR NAME OF AUTHOR + + This program is free software: you can redistribute it and/or modify + it under the terms of the GNU General Public License as published by + the Free Software Foundation, either version 3 of the License, or (at + your option) any later version. + + This program is distributed in the hope that it will be useful, but + WITHOUT ANY WARRANTY; without even the implied warranty of + MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU + General Public License for more details. + + You should have received a copy of the GNU General Public License + along with this program. If not, see <https://www.gnu.org/licenses/>. + + Also add information on how to contact you by electronic and paper +mail. + + If the program does terminal interaction, make it output a short +notice like this when it starts in an interactive mode: + + PROGRAM Copyright (C) YEAR NAME OF AUTHOR + This program comes with ABSOLUTELY NO WARRANTY; for details type ‘show w’. + This is free software, and you are welcome to redistribute it + under certain conditions; type ‘show c’ for details. + + The hypothetical commands ‘show w’ and ‘show c’ should show the +appropriate parts of the General Public License. Of course, your +program’s commands might be different; for a GUI interface, you would +use an “about box”. + + You should also get your employer (if you work as a programmer) or +school, if any, to sign a “copyright disclaimer” for the program, if +necessary. For more information on this, and how to apply and follow +the GNU GPL, see <https://www.gnu.org/licenses/>. + + The GNU General Public License does not permit incorporating your +program into proprietary programs. If your program is a subroutine +library, you may consider it more useful to permit linking proprietary +applications with the library. If this is what you want to do, use the +GNU Lesser General Public License instead of this License. But first, +please read <https://www.gnu.org/licenses/why-not-lgpl.html>. + + + +Tag Table: +Node: Top763 +Node: Introduction2976 +Ref: Some things that Transient can do3504 +Ref: Complexity in CLI programs3857 +Ref: Using Transient for composing interactive commands4458 +Node: Usage6700 +Node: Invoking Transients7068 +Node: Aborting and Resuming Transients8147 +Node: Common Suffix Commands10768 +Node: Saving Values12604 +Ref: Saving Values-Footnote-113975 +Node: Using History14168 +Node: Getting Help for Suffix Commands15742 +Node: Enabling and Disabling Suffixes17120 +Node: Other Commands20408 +Node: Configuration21384 +Ref: Essential Options21664 +Ref: Accessibility Options25325 +Ref: Auxiliary Options25648 +Ref: Developer Options30611 +Node: Modifying Existing Transients31859 +Node: Defining New Commands36051 +Node: Technical Introduction36414 +Node: Defining Transients42115 +Node: Binding Suffix and Infix Commands44582 +Node: Group Specifications45440 +Node: Suffix Specifications50542 +Node: Defining Suffix and Infix Commands54755 +Node: Using Infix Arguments57803 +Node: Transient State60637 +Ref: Pre-commands for Infixes65452 +Ref: Pre-commands for Suffixes65972 +Ref: Pre-commands for Non-Suffixes68426 +Ref: Special Pre-Commands69562 +Node: Classes and Methods70070 +Node: Group Classes72254 +Node: Group Methods74181 +Node: Prefix Classes75434 +Node: Suffix Classes76525 +Node: Suffix Methods79612 +Node: Suffix Value Methods79933 +Node: Suffix Format Methods82691 +Node: Prefix Slots84170 +Ref: Internal Prefix Slots86305 +Node: Suffix Slots87562 +Ref: Slots of transient-suffix87930 +Ref: Slots of transient-infix89067 +Ref: Slots of transient-variable92363 +Ref: Slots of transient-switches92465 +Node: Predicate Slots92828 +Node: FAQ94263 +Ref: Can I control how the popup buffer is displayed?94392 +Ref: How can I copy text from the popup buffer?94573 +Ref: How can I autoload prefix and suffix commands?95067 +Ref: How does Transient compare to prefix keys and universal arguments?95541 +Ref: How does Transient compare to Magit-Popup and Hydra?95784 +Ref: Why did some of the key bindings change?95978 +Ref: Why does q not quit popups anymore?98331 +Node: Keystroke Index99434 +Node: Command and Function Index101299 +Node: Variable Index107891 +Node: Concept Index110164 +Node: GNU General Public License112900 + +End Tag Table + + +Local Variables: +coding: utf-8 +End: diff --git a/emacs/elpa/vertico-20240511.2047/vertico-buffer.el b/emacs/elpa/vertico-20240511.2047/vertico-buffer.el @@ -1,214 +0,0 @@ -;;; vertico-buffer.el --- Display Vertico like a regular buffer -*- lexical-binding: t -*- - -;; Copyright (C) 2021-2024 Free Software Foundation, Inc. - -;; Author: Daniel Mendler <mail@daniel-mendler.de> -;; Maintainer: Daniel Mendler <mail@daniel-mendler.de> -;; Created: 2021 -;; Version: 1.8 -;; Package-Requires: ((emacs "27.1") (compat "29.1.4.4") (vertico "1.8")) -;; Homepage: https://github.com/minad/vertico - -;; This file is part of GNU Emacs. - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <https://www.gnu.org/licenses/>. - -;;; Commentary: - -;; This package is a Vertico extension, which displays Vertico like a -;; regular buffer in a large window instead of the miniwindow. The -;; buffer display can be enabled by the `vertico-buffer-mode'. - -;; The mode can be enabled globally or via `vertico-multiform-mode' -;; per command or completion category. Alternatively the buffer -;; display can be toggled temporarily with M-B if -;; `vertico-multiform-mode' is enabled. - -;;; Code: - -(require 'vertico) - -(defcustom vertico-buffer-hide-prompt t - "Hide prompt in the minibuffer." - :group 'vertico - :type 'boolean) - -(defcustom vertico-buffer-display-action - '(display-buffer-reuse-window) - "Display action for the Vertico buffer." - :group 'vertico - :type `(choice - (const :tag "Reuse some window" - (display-buffer-reuse-window)) - (const :tag "Least recently used window" - (,'display-buffer-use-least-recent-window)) - (const :tag "Left of current window" - (display-buffer-in-direction - (direction . left) - (window-width . 0.3))) - (const :tag "Right of current window" - (display-buffer-in-direction - (direction . right) - (window-height . 0.3))) - (const :tag "Above current window" - (display-buffer-in-direction - (direction . above) - (window-height . ,(+ 3 vertico-count)))) - (const :tag "Below current window" - (display-buffer-in-direction - (direction . below) - (window-height . ,(+ 3 vertico-count)))) - (const :tag "Bottom of frame" - (display-buffer-at-bottom - (window-height . ,(+ 3 vertico-count)))) - (const :tag "Side window on the right" - (display-buffer-in-side-window - (side . right) - (window-width . 0.3))) - (const :tag "Side window on the left" - (display-buffer-in-side-window - (side . left) - (window-width . 0.3))) - (const :tag "Side window at the top" - (display-buffer-in-side-window - (window-height . ,(+ 3 vertico-count)) - (side . top))) - (const :tag "Side window at the bottom" - (display-buffer-in-side-window - (window-height . ,(+ 3 vertico-count)) - (side . bottom))) - (sexp :tag "Other"))) - -(defvar-local vertico-buffer--restore nil) - -(defun vertico-buffer--redisplay (win) - "Redisplay window WIN." - (when-let ((mbwin (active-minibuffer-window)) - ((eq (window-buffer mbwin) (current-buffer)))) - (unless (eq win mbwin) - (setq-local truncate-lines (< (window-point win) - (* 0.8 (window-width win)))) - (set-window-point win (point)) - (set-window-hscroll win 0)) - (when vertico-buffer-hide-prompt - (window-resize mbwin (- (window-pixel-height mbwin)) nil nil 'pixelwise) - (set-window-vscroll mbwin 3)) - (when transient-mark-mode - (with-silent-modifications - (vertico--remove-face (point-min) (point-max) 'region) - (when (use-region-p) - (add-face-text-property - (max (minibuffer-prompt-end) (region-beginning)) - (region-end) 'region)))) - (let ((old cursor-in-non-selected-windows) - (new (and (eq (selected-window) mbwin) - (if (memq cursor-type '(nil t)) 'box cursor-type)))) - (unless (eq new old) - (setq-local cursor-in-non-selected-windows new) - (force-mode-line-update t))))) - -(defun vertico-buffer--setup () - "Setup buffer display." - (let* ((action vertico-buffer-display-action) - (old-wins (mapcar (lambda (w) (cons w (window-buffer w))) (window-list))) - win old-buf tmp-buf - (_ (unwind-protect - (progn - (with-current-buffer - (setq tmp-buf (generate-new-buffer "*vertico-buffer*")) - ;; Set a fake major mode such that - ;; `display-buffer-reuse-mode-window' does not take over! - (setq major-mode 'vertico-buffer-mode)) - ;; Temporarily select the original window such that - ;; `display-buffer-same-window' works. - (setq win (with-minibuffer-selected-window - (display-buffer tmp-buf action)) - old-buf (alist-get win old-wins)) - (set-window-buffer win (current-buffer))) - (kill-buffer tmp-buf))) - (old-no-other (window-parameter win 'no-other-window)) - (old-no-delete (window-parameter win 'no-delete-other-windows)) - (old-state (buffer-local-set-state - cursor-in-non-selected-windows cursor-in-non-selected-windows - show-trailing-whitespace nil - truncate-lines t - face-remapping-alist (copy-tree `((mode-line-inactive mode-line) - ,@face-remapping-alist)) - mode-line-format - (list (format #(" %s%s " 1 3 (face mode-line-buffer-id)) - (replace-regexp-in-string ":? *\\'" "" - (minibuffer-prompt)) - (let ((depth (recursion-depth))) - (if (< depth 2) "" (format " [%s]" depth))))) - vertico-count (- (/ (window-pixel-height win) - (default-line-height)) 2)))) - (set-window-parameter win 'no-other-window t) - (set-window-parameter win 'no-delete-other-windows t) - (set-window-dedicated-p win t) - (overlay-put vertico--candidates-ov 'window win) - (when (and vertico-buffer-hide-prompt vertico--count-ov) - (overlay-put vertico--count-ov 'window win)) - (setq-local vertico-buffer--restore (make-symbol "vertico-buffer--restore")) - (fset vertico-buffer--restore - (lambda () - (with-selected-window (active-minibuffer-window) - (when vertico-buffer--restore - (when transient-mark-mode - (with-silent-modifications - (vertico--remove-face (point-min) (point-max) 'region))) - (remove-hook 'pre-redisplay-functions #'vertico-buffer--redisplay 'local) - (remove-hook 'minibuffer-exit-hook vertico-buffer--restore) - (fset vertico-buffer--restore nil) - (kill-local-variable 'vertico-buffer--restore) - (buffer-local-restore-state old-state) - (overlay-put vertico--candidates-ov 'window nil) - (when vertico--count-ov (overlay-put vertico--count-ov 'window nil)) - (cond - ((and (window-live-p win) (buffer-live-p old-buf)) - (set-window-parameter win 'no-other-window old-no-other) - (set-window-parameter win 'no-delete-other-windows old-no-delete) - (set-window-dedicated-p win nil) - (set-window-buffer win old-buf)) - ((window-live-p win) - (delete-window win))) - (when vertico-buffer-hide-prompt - (set-window-vscroll nil 0)))))) - ;; We cannot use a buffer-local minibuffer-exit-hook here. The hook will - ;; not be called when abnormally exiting the minibuffer from another buffer - ;; via `keyboard-escape-quit'. - (add-hook 'minibuffer-exit-hook vertico-buffer--restore) - (add-hook 'pre-redisplay-functions #'vertico-buffer--redisplay nil 'local))) - -;;;###autoload -(define-minor-mode vertico-buffer-mode - "Display Vertico like a regular buffer in a large window." - :global t :group 'vertico - ;; Shrink current minibuffer window - (when-let ((win (active-minibuffer-window))) - (unless (frame-root-window-p win) - (window-resize win (- (window-pixel-height win)) nil nil 'pixelwise)) - (with-selected-window win - (cond - ((and vertico-buffer-mode vertico--input (not vertico-buffer--restore)) - (vertico-buffer--setup)) - ((and (not vertico-buffer-mode) vertico-buffer--restore) - (funcall vertico-buffer--restore)))))) - -(cl-defmethod vertico--resize-window (_height &context (vertico-buffer-mode (eql t)))) - -(cl-defmethod vertico--setup :after (&context (vertico-buffer-mode (eql t))) - (vertico-buffer--setup)) - -(provide 'vertico-buffer) -;;; vertico-buffer.el ends here diff --git a/emacs/elpa/vertico-20240511.2047/vertico-buffer.elc b/emacs/elpa/vertico-20240511.2047/vertico-buffer.elc Binary files differ. diff --git a/emacs/elpa/vertico-20240511.2047/vertico-directory.elc b/emacs/elpa/vertico-20240511.2047/vertico-directory.elc Binary files differ. diff --git a/emacs/elpa/vertico-20240511.2047/vertico-flat.elc b/emacs/elpa/vertico-20240511.2047/vertico-flat.elc Binary files differ. diff --git a/emacs/elpa/vertico-20240511.2047/vertico-grid.elc b/emacs/elpa/vertico-20240511.2047/vertico-grid.elc Binary files differ. diff --git a/emacs/elpa/vertico-20240511.2047/vertico-indexed.elc b/emacs/elpa/vertico-20240511.2047/vertico-indexed.elc Binary files differ. diff --git a/emacs/elpa/vertico-20240511.2047/vertico-mouse.elc b/emacs/elpa/vertico-20240511.2047/vertico-mouse.elc Binary files differ. diff --git a/emacs/elpa/vertico-20240511.2047/vertico-multiform.elc b/emacs/elpa/vertico-20240511.2047/vertico-multiform.elc Binary files differ. diff --git a/emacs/elpa/vertico-20240511.2047/vertico-pkg.el b/emacs/elpa/vertico-20240511.2047/vertico-pkg.el @@ -1,15 +0,0 @@ -(define-package "vertico" "20240511.2047" "VERTical Interactive COmpletion" - '((emacs "27.1") - (compat "29.1.4.4")) - :commit "ba650a7ab90d66686ba787937ac9e71f749c598e" :authors - '(("Daniel Mendler" . "mail@daniel-mendler.de")) - :maintainers - '(("Daniel Mendler" . "mail@daniel-mendler.de")) - :maintainer - '("Daniel Mendler" . "mail@daniel-mendler.de") - :keywords - '("convenience" "files" "matching" "completion") - :url "https://github.com/minad/vertico") -;; Local Variables: -;; no-byte-compile: t -;; End: diff --git a/emacs/elpa/vertico-20240511.2047/vertico-quick.elc b/emacs/elpa/vertico-20240511.2047/vertico-quick.elc Binary files differ. diff --git a/emacs/elpa/vertico-20240511.2047/vertico-repeat.elc b/emacs/elpa/vertico-20240511.2047/vertico-repeat.elc Binary files differ. diff --git a/emacs/elpa/vertico-20240511.2047/vertico-reverse.elc b/emacs/elpa/vertico-20240511.2047/vertico-reverse.elc Binary files differ. diff --git a/emacs/elpa/vertico-20240511.2047/vertico-suspend.elc b/emacs/elpa/vertico-20240511.2047/vertico-suspend.elc Binary files differ. diff --git a/emacs/elpa/vertico-20240511.2047/vertico-unobtrusive.elc b/emacs/elpa/vertico-20240511.2047/vertico-unobtrusive.elc Binary files differ. diff --git a/emacs/elpa/vertico-20240511.2047/vertico.elc b/emacs/elpa/vertico-20240511.2047/vertico.elc Binary files differ. diff --git a/emacs/elpa/vertico-20240511.2047/vertico-autoloads.el b/emacs/elpa/vertico-20240625.506/vertico-autoloads.el diff --git a/emacs/elpa/vertico-20240625.506/vertico-buffer.el b/emacs/elpa/vertico-20240625.506/vertico-buffer.el @@ -0,0 +1,215 @@ +;;; vertico-buffer.el --- Display Vertico like a regular buffer -*- lexical-binding: t -*- + +;; Copyright (C) 2021-2024 Free Software Foundation, Inc. + +;; Author: Daniel Mendler <mail@daniel-mendler.de> +;; Maintainer: Daniel Mendler <mail@daniel-mendler.de> +;; Created: 2021 +;; Version: 1.8 +;; Package-Requires: ((emacs "27.1") (compat "29.1.4.4") (vertico "1.8")) +;; Homepage: https://github.com/minad/vertico + +;; This file is part of GNU Emacs. + +;; This program is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This package is a Vertico extension, which displays Vertico like a +;; regular buffer in a large window instead of the miniwindow. The +;; buffer display can be enabled by the `vertico-buffer-mode'. + +;; The mode can be enabled globally or via `vertico-multiform-mode' +;; per command or completion category. Alternatively the buffer +;; display can be toggled temporarily with M-B if +;; `vertico-multiform-mode' is enabled. + +;;; Code: + +(require 'vertico) + +(defcustom vertico-buffer-hide-prompt t + "Hide prompt in the minibuffer." + :group 'vertico + :type 'boolean) + +(defcustom vertico-buffer-display-action + '(display-buffer-reuse-window) + "Display action for the Vertico buffer." + :group 'vertico + :type `(choice + (const :tag "Reuse some window" + (display-buffer-reuse-window)) + (const :tag "Least recently used window" + (,'display-buffer-use-least-recent-window)) + (const :tag "Left of current window" + (display-buffer-in-direction + (direction . left) + (window-width . 0.3))) + (const :tag "Right of current window" + (display-buffer-in-direction + (direction . right) + (window-height . 0.3))) + (const :tag "Above current window" + (display-buffer-in-direction + (direction . above) + (window-height . ,(+ 3 vertico-count)))) + (const :tag "Below current window" + (display-buffer-in-direction + (direction . below) + (window-height . ,(+ 3 vertico-count)))) + (const :tag "Bottom of frame" + (display-buffer-at-bottom + (window-height . ,(+ 3 vertico-count)))) + (const :tag "Side window on the right" + (display-buffer-in-side-window + (side . right) + (window-width . 0.3))) + (const :tag "Side window on the left" + (display-buffer-in-side-window + (side . left) + (window-width . 0.3))) + (const :tag "Side window at the top" + (display-buffer-in-side-window + (window-height . ,(+ 3 vertico-count)) + (side . top))) + (const :tag "Side window at the bottom" + (display-buffer-in-side-window + (window-height . ,(+ 3 vertico-count)) + (side . bottom))) + (sexp :tag "Other"))) + +(defvar-local vertico-buffer--restore nil) + +(defun vertico-buffer--redisplay (win) + "Redisplay window WIN." + (when-let ((mbwin (active-minibuffer-window)) + ((eq (window-buffer mbwin) (current-buffer)))) + (unless (eq win mbwin) + (setq-local truncate-lines (< (window-point win) + (* 0.8 (window-width win)))) + (set-window-point win (point)) + (set-window-hscroll win 0)) + (when vertico-buffer-hide-prompt + (window-resize mbwin (- (window-pixel-height mbwin)) nil nil 'pixelwise) + (set-window-vscroll mbwin 3)) + (when transient-mark-mode + (with-silent-modifications + (vertico--remove-face (point-min) (point-max) 'region) + (when (use-region-p) + (add-face-text-property + (max (minibuffer-prompt-end) (region-beginning)) + (region-end) 'region)))) + (let ((old cursor-in-non-selected-windows) + (new (and (eq (selected-window) mbwin) + (if (memq cursor-type '(nil t)) 'box cursor-type)))) + (unless (eq new old) + (setq-local cursor-in-non-selected-windows new) + (force-mode-line-update t))))) + +(defun vertico-buffer--setup () + "Setup buffer display." + (let* ((action vertico-buffer-display-action) + (old-wins (mapcar (lambda (w) (cons w (window-buffer w))) (window-list))) + win old-buf tmp-buf + (_ (unwind-protect + (progn + (with-current-buffer + (setq tmp-buf (generate-new-buffer "*vertico-buffer*")) + ;; Set a fake major mode such that + ;; `display-buffer-reuse-mode-window' does not take over! + (setq major-mode 'vertico-buffer-mode)) + ;; Temporarily select the original window such that + ;; `display-buffer-same-window' works. + (setq win (with-minibuffer-selected-window + (display-buffer tmp-buf action)) + old-buf (alist-get win old-wins)) + (set-window-buffer win (current-buffer))) + (kill-buffer tmp-buf))) + (old-no-other (window-parameter win 'no-other-window)) + (old-no-delete (window-parameter win 'no-delete-other-windows)) + (old-state (buffer-local-set-state + cursor-in-non-selected-windows cursor-in-non-selected-windows + show-trailing-whitespace nil + truncate-lines t + face-remapping-alist (copy-tree `((mode-line-inactive mode-line) + ,@face-remapping-alist)) + mode-line-format + (list (format #(" %s%s " 1 3 (face mode-line-buffer-id)) + (replace-regexp-in-string ":? *\\'" "" + (minibuffer-prompt)) + (let ((depth (recursion-depth))) + (if (< depth 2) "" (format " [%s]" depth))))) + vertico-count (- (/ (window-pixel-height win) + (default-line-height)) 2)))) + (set-window-parameter win 'no-other-window t) + (set-window-parameter win 'no-delete-other-windows t) + (set-window-dedicated-p win t) + (overlay-put vertico--candidates-ov 'window win) + (when (and vertico-buffer-hide-prompt vertico--count-ov) + (overlay-put vertico--count-ov 'window win)) + (setq-local vertico-buffer--restore (make-symbol "vertico-buffer--restore")) + (fset vertico-buffer--restore + (lambda () + (with-selected-window (active-minibuffer-window) + (when vertico-buffer--restore + (when transient-mark-mode + (with-silent-modifications + (vertico--remove-face (point-min) (point-max) 'region))) + (remove-hook 'pre-redisplay-functions #'vertico-buffer--redisplay 'local) + (remove-hook 'minibuffer-exit-hook vertico-buffer--restore) + (fset vertico-buffer--restore nil) + (kill-local-variable 'vertico-buffer--restore) + (buffer-local-restore-state old-state) + (overlay-put vertico--candidates-ov 'window nil) + (when vertico--count-ov (overlay-put vertico--count-ov 'window nil)) + (cond + ((and (window-live-p win) (buffer-live-p old-buf)) + (set-window-parameter win 'no-other-window old-no-other) + (set-window-parameter win 'no-delete-other-windows old-no-delete) + (set-window-dedicated-p win nil) + (set-window-buffer win old-buf)) + ((window-live-p win) + ;; The window may be a sole window (gh:minad/vertico#496). + (ignore-errors (delete-window win)))) + (when vertico-buffer-hide-prompt + (set-window-vscroll nil 0)))))) + ;; We cannot use a buffer-local minibuffer-exit-hook here. The hook will + ;; not be called when abnormally exiting the minibuffer from another buffer + ;; via `keyboard-escape-quit'. + (add-hook 'minibuffer-exit-hook vertico-buffer--restore) + (add-hook 'pre-redisplay-functions #'vertico-buffer--redisplay nil 'local))) + +;;;###autoload +(define-minor-mode vertico-buffer-mode + "Display Vertico like a regular buffer in a large window." + :global t :group 'vertico + ;; Shrink current minibuffer window + (when-let ((win (active-minibuffer-window))) + (unless (frame-root-window-p win) + (window-resize win (- (window-pixel-height win)) nil nil 'pixelwise)) + (with-selected-window win + (cond + ((and vertico-buffer-mode vertico--input (not vertico-buffer--restore)) + (vertico-buffer--setup)) + ((and (not vertico-buffer-mode) vertico-buffer--restore) + (funcall vertico-buffer--restore)))))) + +(cl-defmethod vertico--resize-window (_height &context (vertico-buffer-mode (eql t)))) + +(cl-defmethod vertico--setup :after (&context (vertico-buffer-mode (eql t))) + (vertico-buffer--setup)) + +(provide 'vertico-buffer) +;;; vertico-buffer.el ends here diff --git a/emacs/elpa/vertico-20240625.506/vertico-buffer.elc b/emacs/elpa/vertico-20240625.506/vertico-buffer.elc Binary files differ. diff --git a/emacs/elpa/vertico-20240511.2047/vertico-directory.el b/emacs/elpa/vertico-20240625.506/vertico-directory.el diff --git a/emacs/elpa/vertico-20240625.506/vertico-directory.elc b/emacs/elpa/vertico-20240625.506/vertico-directory.elc Binary files differ. diff --git a/emacs/elpa/vertico-20240511.2047/vertico-flat.el b/emacs/elpa/vertico-20240625.506/vertico-flat.el diff --git a/emacs/elpa/vertico-20240625.506/vertico-flat.elc b/emacs/elpa/vertico-20240625.506/vertico-flat.elc Binary files differ. diff --git a/emacs/elpa/vertico-20240511.2047/vertico-grid.el b/emacs/elpa/vertico-20240625.506/vertico-grid.el diff --git a/emacs/elpa/vertico-20240625.506/vertico-grid.elc b/emacs/elpa/vertico-20240625.506/vertico-grid.elc Binary files differ. diff --git a/emacs/elpa/vertico-20240511.2047/vertico-indexed.el b/emacs/elpa/vertico-20240625.506/vertico-indexed.el diff --git a/emacs/elpa/vertico-20240625.506/vertico-indexed.elc b/emacs/elpa/vertico-20240625.506/vertico-indexed.elc Binary files differ. diff --git a/emacs/elpa/vertico-20240511.2047/vertico-mouse.el b/emacs/elpa/vertico-20240625.506/vertico-mouse.el diff --git a/emacs/elpa/vertico-20240625.506/vertico-mouse.elc b/emacs/elpa/vertico-20240625.506/vertico-mouse.elc Binary files differ. diff --git a/emacs/elpa/vertico-20240511.2047/vertico-multiform.el b/emacs/elpa/vertico-20240625.506/vertico-multiform.el diff --git a/emacs/elpa/vertico-20240625.506/vertico-multiform.elc b/emacs/elpa/vertico-20240625.506/vertico-multiform.elc Binary files differ. diff --git a/emacs/elpa/vertico-20240625.506/vertico-pkg.el b/emacs/elpa/vertico-20240625.506/vertico-pkg.el @@ -0,0 +1,15 @@ +(define-package "vertico" "20240625.506" "VERTical Interactive COmpletion" + '((emacs "27.1") + (compat "29.1.4.4")) + :commit "0d2cde6c964833fe1f715921d9b174aee9b40b24" :authors + '(("Daniel Mendler" . "mail@daniel-mendler.de")) + :maintainers + '(("Daniel Mendler" . "mail@daniel-mendler.de")) + :maintainer + '("Daniel Mendler" . "mail@daniel-mendler.de") + :keywords + '("convenience" "files" "matching" "completion") + :url "https://github.com/minad/vertico") +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/emacs/elpa/vertico-20240511.2047/vertico-quick.el b/emacs/elpa/vertico-20240625.506/vertico-quick.el diff --git a/emacs/elpa/vertico-20240625.506/vertico-quick.elc b/emacs/elpa/vertico-20240625.506/vertico-quick.elc Binary files differ. diff --git a/emacs/elpa/vertico-20240511.2047/vertico-repeat.el b/emacs/elpa/vertico-20240625.506/vertico-repeat.el diff --git a/emacs/elpa/vertico-20240625.506/vertico-repeat.elc b/emacs/elpa/vertico-20240625.506/vertico-repeat.elc Binary files differ. diff --git a/emacs/elpa/vertico-20240511.2047/vertico-reverse.el b/emacs/elpa/vertico-20240625.506/vertico-reverse.el diff --git a/emacs/elpa/vertico-20240625.506/vertico-reverse.elc b/emacs/elpa/vertico-20240625.506/vertico-reverse.elc Binary files differ. diff --git a/emacs/elpa/vertico-20240511.2047/vertico-suspend.el b/emacs/elpa/vertico-20240625.506/vertico-suspend.el diff --git a/emacs/elpa/vertico-20240625.506/vertico-suspend.elc b/emacs/elpa/vertico-20240625.506/vertico-suspend.elc Binary files differ. diff --git a/emacs/elpa/vertico-20240511.2047/vertico-unobtrusive.el b/emacs/elpa/vertico-20240625.506/vertico-unobtrusive.el diff --git a/emacs/elpa/vertico-20240625.506/vertico-unobtrusive.elc b/emacs/elpa/vertico-20240625.506/vertico-unobtrusive.elc Binary files differ. diff --git a/emacs/elpa/vertico-20240511.2047/vertico.el b/emacs/elpa/vertico-20240625.506/vertico.el diff --git a/emacs/elpa/vertico-20240625.506/vertico.elc b/emacs/elpa/vertico-20240625.506/vertico.elc Binary files differ. diff --git a/emacs/elpa/with-editor-20240609.1518/with-editor-pkg.el b/emacs/elpa/with-editor-20240609.1518/with-editor-pkg.el @@ -1,15 +0,0 @@ -(define-package "with-editor" "20240609.1518" "Use the Emacsclient as $EDITOR" - '((emacs "25.1") - (compat "29.1.4.1")) - :commit "f6a3fc8f6735fbc804e02f9c54bc621746afd5b0" :authors - '(("Jonas Bernoulli" . "emacs.with-editor@jonas.bernoulli.dev")) - :maintainers - '(("Jonas Bernoulli" . "emacs.with-editor@jonas.bernoulli.dev")) - :maintainer - '("Jonas Bernoulli" . "emacs.with-editor@jonas.bernoulli.dev") - :keywords - '("processes" "terminals") - :url "https://github.com/magit/with-editor") -;; Local Variables: -;; no-byte-compile: t -;; End: diff --git a/emacs/elpa/with-editor-20240609.1518/with-editor.el b/emacs/elpa/with-editor-20240609.1518/with-editor.el @@ -1,980 +0,0 @@ -;;; with-editor.el --- Use the Emacsclient as $EDITOR -*- lexical-binding:t -*- - -;; Copyright (C) 2014-2024 The Magit Project Contributors - -;; Author: Jonas Bernoulli <emacs.with-editor@jonas.bernoulli.dev> -;; Homepage: https://github.com/magit/with-editor -;; Keywords: processes terminals - -;; Package-Version: 3.3.2 -;; Package-Requires: ((emacs "25.1") (compat "29.1.4.1")) - -;; 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 <https://www.gnu.org/licenses/>. - -;;; Commentary: - -;; This library makes it possible to reliably use the Emacsclient as -;; the `$EDITOR' of child processes. It makes sure that they know how -;; to call home. For remote processes a substitute is provided, which -;; communicates with Emacs on standard output/input instead of using a -;; socket as the Emacsclient does. - -;; It provides the commands `with-editor-async-shell-command' and -;; `with-editor-shell-command', which are intended as replacements -;; for `async-shell-command' and `shell-command'. They automatically -;; export `$EDITOR' making sure the executed command uses the current -;; Emacs instance as "the editor". With a prefix argument these -;; commands prompt for an alternative environment variable such as -;; `$GIT_EDITOR'. To always use these variants add this to your init -;; file: -;; -;; (keymap-global-set "<remap> <async-shell-command>" -;; #'with-editor-async-shell-command) -;; (keymap-global-set "<remap> <shell-command>" -;; #'with-editor-shell-command) - -;; Alternatively use the global `shell-command-with-editor-mode', -;; which always sets `$EDITOR' for all Emacs commands which ultimately -;; use `shell-command' to asynchronously run some shell command. - -;; The command `with-editor-export-editor' exports `$EDITOR' or -;; another such environment variable in `shell-mode', `eshell-mode', -;; `term-mode' and `vterm-mode' buffers. Use this Emacs command -;; before executing a shell command which needs the editor set, or -;; always arrange for the current Emacs instance to be used as editor -;; by adding it to the appropriate mode hooks: -;; -;; (add-hook 'shell-mode-hook #'with-editor-export-editor) -;; (add-hook 'eshell-mode-hook #'with-editor-export-editor) -;; (add-hook 'term-exec-hook #'with-editor-export-editor) -;; (add-hook 'vterm-mode-hook #'with-editor-export-editor) - -;; Some variants of this function exist, these two forms are -;; equivalent: -;; -;; (add-hook 'shell-mode-hook -;; (apply-partially #'with-editor-export-editor "GIT_EDITOR")) -;; (add-hook 'shell-mode-hook #'with-editor-export-git-editor) - -;; This library can also be used by other packages which need to use -;; the current Emacs instance as editor. In fact this library was -;; written for Magit and its `git-commit-mode' and `git-rebase-mode'. -;; Consult `git-rebase.el' and the related code in `magit-sequence.el' -;; for a simple example. - -;;; Code: - -(require 'cl-lib) -(require 'compat) -(require 'server) -(require 'shell) -(eval-when-compile (require 'subr-x)) - -(declare-function dired-get-filename "dired" - (&optional localp no-error-if-not-filep)) -(declare-function term-emulate-terminal "term" (proc str)) -(defvar eshell-preoutput-filter-functions) -(defvar git-commit-post-finish-hook) -(defvar vterm--process) -(defvar warning-minimum-level) -(defvar warning-minimum-log-level) - -;;; Options - -(defgroup with-editor nil - "Use the Emacsclient as $EDITOR." - :group 'external - :group 'server) - -(defun with-editor-locate-emacsclient () - "Search for a suitable Emacsclient executable." - (or (with-editor-locate-emacsclient-1 - (with-editor-emacsclient-path) - (length (split-string emacs-version "\\."))) - (prog1 nil (display-warning 'with-editor "\ -Cannot determine a suitable Emacsclient - -Determining an Emacsclient executable suitable for the -current Emacs instance failed. For more information -please see https://github.com/magit/magit/wiki/Emacsclient.")))) - -(defun with-editor-locate-emacsclient-1 (path depth) - (let* ((version-lst (cl-subseq (split-string emacs-version "\\.") 0 depth)) - (version-reg (concat "^" (mapconcat #'identity version-lst "\\.")))) - (or (locate-file - (cond ((equal (downcase invocation-name) "remacs") - "remacsclient") - ((bound-and-true-p emacsclient-program-name)) - ("emacsclient")) - path - (cl-mapcan - (lambda (v) (cl-mapcar (lambda (e) (concat v e)) exec-suffixes)) - (nconc (and (boundp 'debian-emacs-flavor) - (list (format ".%s" debian-emacs-flavor))) - (cl-mapcon (lambda (v) - (setq v (mapconcat #'identity (reverse v) ".")) - (list v (concat "-" v) (concat ".emacs" v))) - (reverse version-lst)) - (list "" "-snapshot" ".emacs-snapshot"))) - (lambda (exec) - (ignore-errors - (string-match-p version-reg - (with-editor-emacsclient-version exec))))) - (and (> depth 1) - (with-editor-locate-emacsclient-1 path (1- depth)))))) - -(defun with-editor-emacsclient-version (exec) - (let ((default-directory (file-name-directory exec))) - (ignore-errors - (cadr (split-string (car (process-lines exec "--version"))))))) - -(defun with-editor-emacsclient-path () - (let ((path exec-path)) - (when invocation-directory - (push (directory-file-name invocation-directory) path) - (let* ((linkname (expand-file-name invocation-name invocation-directory)) - (truename (file-chase-links linkname))) - (unless (equal truename linkname) - (push (directory-file-name (file-name-directory truename)) path))) - (when (eq system-type 'darwin) - (let ((dir (expand-file-name "bin" invocation-directory))) - (when (file-directory-p dir) - (push dir path))) - (when (string-search "Cellar" invocation-directory) - (let ((dir (expand-file-name "../../../bin" invocation-directory))) - (when (file-directory-p dir) - (push dir path)))))) - (cl-remove-duplicates path :test #'equal))) - -(defcustom with-editor-emacsclient-executable (with-editor-locate-emacsclient) - "The Emacsclient executable used by the `with-editor' macro." - :group 'with-editor - :type '(choice (string :tag "Executable") - (const :tag "Don't use Emacsclient" nil))) - -(defcustom with-editor-sleeping-editor "\ -sh -c '\ -printf \"\\nWITH-EDITOR: $$ OPEN $0\\037$1\\037 IN $(pwd)\\n\"; \ -sleep 604800 & sleep=$!; \ -trap \"kill $sleep; exit 0\" USR1; \ -trap \"kill $sleep; exit 1\" USR2; \ -wait $sleep'" - "The sleeping editor, used when the Emacsclient cannot be used. - -This fallback is used for asynchronous processes started inside -the macro `with-editor', when the process runs on a remote machine -or for local processes when `with-editor-emacsclient-executable' -is nil (i.e., when no suitable Emacsclient was found, or the user -decided not to use it). - -Where the latter uses a socket to communicate with Emacs' server, -this substitute prints edit requests to its standard output on -which a process filter listens for such requests. As such it is -not a complete substitute for a proper Emacsclient, it can only -be used as $EDITOR of child process of the current Emacs instance. - -Some shells do not execute traps immediately when waiting for a -child process, but by default we do use such a blocking child -process. - -If you use such a shell (e.g., `csh' on FreeBSD, but not Debian), -then you have to edit this option. You can either replace \"sh\" -with \"bash\" (and install that), or you can use the older, less -performant implementation: - - \"sh -c '\\ - echo -e \\\"\\nWITH-EDITOR: $$ OPEN $0$1 IN $(pwd)\\n\\\"; \\ - trap \\\"exit 0\\\" USR1; \\ - trap \\\"exit 1\" USR2; \\ - while true; do sleep 1; done'\" - -Note that the two unit separator characters () right after $0 -and $1 are required. Normally $0 is the file name and $1 is -missing or else gets ignored. But if $0 has the form \"+N[:N]\", -then it is treated as a position in the file and $1 is expected -to be the file. - -Also note that using this alternative implementation leads to a -delay of up to a second. The delay can be shortened by replacing -\"sleep 1\" with \"sleep 0.01\", or if your implementation does -not support floats, then by using \"nanosleep\" instead." - :package-version '(with-editor . "2.8.0") - :group 'with-editor - :type 'string) - -(defcustom with-editor-finish-query-functions nil - "List of functions called to query before finishing session. - -The buffer in question is current while the functions are called. -If any of them returns nil, then the session is not finished 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 that and return non-nil." - :group 'with-editor - :type 'hook) -(put 'with-editor-finish-query-functions 'permanent-local t) - -(defcustom with-editor-cancel-query-functions nil - "List of functions called to query before canceling session. - -The buffer in question is current while the functions are called. -If any of them returns nil, then the session is not canceled 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 canceling the session despite issues. Functions should -usually honor that and return non-nil." - :group 'with-editor - :type 'hook) -(put 'with-editor-cancel-query-functions 'permanent-local t) - -(defcustom with-editor-mode-lighter " WE" - "The mode-line lighter of the With-Editor mode." - :group 'with-editor - :type '(choice (const :tag "No lighter" "") string)) - -(defvar with-editor-server-window-alist nil - "Alist of filename patterns vs corresponding `server-window'. - -Each element looks like (REGEXP . FUNCTION). Files matching -REGEXP are selected using FUNCTION instead of the default in -`server-window'. - -Note that when a package adds an entry here then it probably -has a reason to disrespect `server-window' and it likely is -not a good idea to change such entries.") - -(defvar with-editor-file-name-history-exclude nil - "List of regexps for filenames `server-visit' should not remember. -When a filename matches any of the regexps, then `server-visit' -does not add it to the variable `file-name-history', which is -used when reading a filename in the minibuffer.") - -(defcustom with-editor-shell-command-use-emacsclient t - "Whether to use the emacsclient when running shell commands. - -This affects `with-editor-async-shell-command' and, if the input -ends with \"&\" `with-editor-shell-command' . - -If `shell-command-with-editor-mode' is enabled, then it also -affects `shell-command-async' and, if the input ends with \"&\" -`shell-command'. - -This is a temporary kludge that lets you choose between two -possible defects, the ones described in the issues #23 and #40. - -When t, then use the emacsclient. This has the disadvantage that -`with-editor-mode' won't be enabled because we don't know whether -this package was involved at all in the call to the emacsclient, -and when it is not, then we really should. The problem is that -the emacsclient doesn't pass along any environment variables to -the server. This will hopefully be fixed in Emacs eventually. - -When nil, then use the sleeping editor. Because in this case we -know that this package is involved, we can enable the mode. But -this makes it necessary that you invoke $EDITOR in shell scripts -like so: - - eval \"$EDITOR\" file - -And some tools that do not handle $EDITOR properly also break." - :package-version '(with-editor . "2.7.1") - :group 'with-editor - :type 'boolean) - -;;; Mode Commands - -(defvar with-editor-pre-finish-hook nil) -(defvar with-editor-pre-cancel-hook nil) -(defvar with-editor-post-finish-hook nil) -(defvar with-editor-post-finish-hook-1 nil) -(defvar with-editor-post-cancel-hook nil) -(defvar with-editor-post-cancel-hook-1 nil) -(defvar with-editor-cancel-alist nil) -(put 'with-editor-pre-finish-hook 'permanent-local t) -(put 'with-editor-pre-cancel-hook 'permanent-local t) -(put 'with-editor-post-finish-hook 'permanent-local t) -(put 'with-editor-post-cancel-hook 'permanent-local t) - -(defvar-local with-editor-show-usage t) -(defvar-local with-editor-cancel-message nil) -(defvar-local with-editor-previous-winconf nil) -(put 'with-editor-cancel-message 'permanent-local t) -(put 'with-editor-previous-winconf 'permanent-local t) - -(defvar-local with-editor--pid nil "For internal use.") -(put 'with-editor--pid 'permanent-local t) - -(defun with-editor-finish (force) - "Finish the current edit session." - (interactive "P") - (when (run-hook-with-args-until-failure - 'with-editor-finish-query-functions force) - (let ((post-finish-hook with-editor-post-finish-hook) - (post-commit-hook (bound-and-true-p git-commit-post-finish-hook)) - (dir default-directory)) - (run-hooks 'with-editor-pre-finish-hook) - (with-editor-return nil) - (accept-process-output nil 0.1) - (with-temp-buffer - (setq default-directory dir) - (setq-local with-editor-post-finish-hook post-finish-hook) - (when post-commit-hook - (setq-local git-commit-post-finish-hook post-commit-hook)) - (run-hooks 'with-editor-post-finish-hook))))) - -(defun with-editor-cancel (force) - "Cancel the current edit session." - (interactive "P") - (when (run-hook-with-args-until-failure - 'with-editor-cancel-query-functions force) - (let ((message with-editor-cancel-message)) - (when (functionp message) - (setq message (funcall message))) - (let ((post-cancel-hook with-editor-post-cancel-hook) - (with-editor-cancel-alist nil) - (dir default-directory)) - (run-hooks 'with-editor-pre-cancel-hook) - (with-editor-return t) - (accept-process-output nil 0.1) - (with-temp-buffer - (setq default-directory dir) - (setq-local with-editor-post-cancel-hook post-cancel-hook) - (run-hooks 'with-editor-post-cancel-hook))) - (message (or message "Canceled by user"))))) - -(defun with-editor-return (cancel) - (let ((winconf with-editor-previous-winconf) - (clients server-buffer-clients) - (dir default-directory) - (pid with-editor--pid)) - (remove-hook 'kill-buffer-query-functions - #'with-editor-kill-buffer-noop t) - (cond (cancel - (save-buffer) - (if clients - (let ((buf (current-buffer))) - (dolist (client clients) - (message "client %S" client) - (ignore-errors - (server-send-string client "-error Canceled by user")) - (delete-process client)) - (when (buffer-live-p buf) - (kill-buffer buf))) - ;; Fallback for when emacs was used as $EDITOR - ;; instead of emacsclient or the sleeping editor. - ;; See https://github.com/magit/magit/issues/2258. - (ignore-errors (delete-file buffer-file-name)) - (kill-buffer))) - (t - (save-buffer) - (if clients - ;; Don't use `server-edit' because we do not want to - ;; show another buffer belonging to another client. - ;; See https://github.com/magit/magit/issues/2197. - (server-done) - (kill-buffer)))) - (when pid - (let ((default-directory dir)) - (process-file "kill" nil nil nil - "-s" (if cancel "USR2" "USR1") pid))) - (when (and winconf (eq (window-configuration-frame winconf) - (selected-frame))) - (set-window-configuration winconf)))) - -;;; Mode - -(defvar-keymap with-editor-mode-map - "C-c C-c" #'with-editor-finish - "<remap> <server-edit>" #'with-editor-finish - "<remap> <evil-save-and-close>" #'with-editor-finish - "<remap> <evil-save-modified-and-close>" #'with-editor-finish - "C-c C-k" #'with-editor-cancel - "<remap> <kill-buffer>" #'with-editor-cancel - "<remap> <ido-kill-buffer>" #'with-editor-cancel - "<remap> <iswitchb-kill-buffer>" #'with-editor-cancel - "<remap> <evil-quit>" #'with-editor-cancel) - -(define-minor-mode with-editor-mode - "Edit a file as the $EDITOR of an external process." - :lighter with-editor-mode-lighter - ;; Protect the user from killing the buffer without using - ;; either `with-editor-finish' or `with-editor-cancel', - ;; and from removing the key bindings for these commands. - (unless with-editor-mode - (user-error "With-Editor mode cannot be turned off")) - (add-hook 'kill-buffer-query-functions - #'with-editor-kill-buffer-noop nil t) - ;; `server-execute' displays a message which is not - ;; correct when using this mode. - (when with-editor-show-usage - (with-editor-usage-message))) - -(put 'with-editor-mode 'permanent-local t) - -(defun with-editor-kill-buffer-noop () - ;; We started doing this in response to #64, but it is not safe - ;; to do so, because the client has already been killed, causing - ;; `with-editor-return' (called by `with-editor-cancel') to delete - ;; the file, see #66. The reason we delete the file in the first - ;; place are https://github.com/magit/magit/issues/2258 and - ;; https://github.com/magit/magit/issues/2248. - ;; (if (memq this-command '(save-buffers-kill-terminal - ;; save-buffers-kill-emacs)) - ;; (let ((with-editor-cancel-query-functions nil)) - ;; (with-editor-cancel nil) - ;; t) - ;; ...) - ;; So go back to always doing this instead: - (user-error (substitute-command-keys (format "\ -Don't kill this buffer %S. Instead cancel using \\[with-editor-cancel]" - (current-buffer))))) - -(defvar-local with-editor-usage-message "\ -Type \\[with-editor-finish] to finish, \ -or \\[with-editor-cancel] to cancel") - -(defun with-editor-usage-message () - ;; Run after `server-execute', which is run using - ;; a timer which starts immediately. - (let ((buffer (current-buffer))) - (run-with-timer - 0.05 nil - (lambda () - (with-current-buffer buffer - (message (substitute-command-keys with-editor-usage-message))))))) - -;;; Wrappers - -(defvar with-editor--envvar nil "For internal use.") - -(defmacro with-editor (&rest body) - "Use the Emacsclient as $EDITOR while evaluating BODY. -Modify the `process-environment' for processes started in BODY, -instructing them to use the Emacsclient as $EDITOR. If optional -ENVVAR is a literal string then bind that environment variable -instead. -\n(fn [ENVVAR] BODY...)" - (declare (indent defun) (debug (body))) - `(let ((with-editor--envvar ,(if (stringp (car body)) - (pop body) - '(or with-editor--envvar "EDITOR"))) - (process-environment process-environment)) - (with-editor--setup) - ,@body)) - -(defmacro with-editor* (envvar &rest body) - "Use the Emacsclient as the editor while evaluating BODY. -Modify the `process-environment' for processes started in BODY, -instructing them to use the Emacsclient as editor. ENVVAR is the -environment variable that is exported to do so, it is evaluated -at run-time. -\n(fn [ENVVAR] BODY...)" - (declare (indent defun) (debug (sexp body))) - `(let ((with-editor--envvar ,envvar) - (process-environment process-environment)) - (with-editor--setup) - ,@body)) - -(defun with-editor--setup () - (if (or (not with-editor-emacsclient-executable) - (file-remote-p default-directory)) - (push (concat with-editor--envvar "=" with-editor-sleeping-editor) - process-environment) - ;; Make sure server-use-tcp's value is valid. - (unless (featurep 'make-network-process '(:family local)) - (setq server-use-tcp t)) - ;; Make sure the server is running. - (unless (process-live-p server-process) - (when (server-running-p server-name) - (setq server-name (format "server%s" (emacs-pid))) - (when (server-running-p server-name) - (server-force-delete server-name))) - (server-start)) - ;; Tell $EDITOR to use the Emacsclient. - (push (concat with-editor--envvar "=" - ;; Quoting is the right thing to do. Applications that - ;; fail because of that, are the ones that need fixing, - ;; e.g., by using 'eval "$EDITOR" file'. See #121. - (shell-quote-argument - ;; If users set the executable manually, they might - ;; begin the path with "~", which would get quoted. - (if (string-prefix-p "~" with-editor-emacsclient-executable) - (concat (expand-file-name "~") - (substring with-editor-emacsclient-executable 1)) - with-editor-emacsclient-executable)) - ;; Tell the process where the server file is. - (and (not server-use-tcp) - (concat " --socket-name=" - (shell-quote-argument - (expand-file-name server-name - server-socket-dir))))) - process-environment) - (when server-use-tcp - (push (concat "EMACS_SERVER_FILE=" - (expand-file-name server-name server-auth-dir)) - process-environment)) - ;; As last resort fallback to the sleeping editor. - (push (concat "ALTERNATE_EDITOR=" with-editor-sleeping-editor) - process-environment))) - -(defun with-editor-server-window () - (or (and buffer-file-name - (cdr (cl-find-if (lambda (cons) - (string-match-p (car cons) buffer-file-name)) - with-editor-server-window-alist))) - server-window)) - -(define-advice server-switch-buffer - (:around (fn &optional next-buffer &rest args) - with-editor-server-window-alist) - "Honor `with-editor-server-window-alist' (which see)." - (let ((server-window (with-current-buffer - (or next-buffer (current-buffer)) - (when with-editor-mode - (setq with-editor-previous-winconf - (current-window-configuration))) - (with-editor-server-window)))) - (apply fn next-buffer args))) - -(define-advice start-file-process - (:around (fn name buffer program &rest program-args) - with-editor-process-filter) - "When called inside a `with-editor' form and the Emacsclient -cannot be used, then give the process the filter function -`with-editor-process-filter'. To avoid overriding the filter -being added here you should use `with-editor-set-process-filter' -instead of `set-process-filter' inside `with-editor' forms. - -When the `default-directory' is located on a remote machine, -then also manipulate PROGRAM and PROGRAM-ARGS in order to set -the appropriate editor environment variable." - (if (not with-editor--envvar) - (apply fn name buffer program program-args) - (when (file-remote-p default-directory) - (unless (equal program "env") - (push program program-args) - (setq program "env")) - (push (concat with-editor--envvar "=" with-editor-sleeping-editor) - program-args)) - (let ((process (apply fn name buffer program program-args))) - (set-process-filter process #'with-editor-process-filter) - (process-put process 'default-dir default-directory) - process))) - -(advice-add #'make-process :around - #'make-process@with-editor-process-filter) -(cl-defun make-process@with-editor-process-filter - (fn &rest keys &key name buffer command coding noquery stop - connection-type filter sentinel stderr file-handler - &allow-other-keys) - "When called inside a `with-editor' form and the Emacsclient -cannot be used, then give the process the filter function -`with-editor-process-filter'. To avoid overriding the filter -being added here you should use `with-editor-set-process-filter' -instead of `set-process-filter' inside `with-editor' forms. - -When the `default-directory' is located on a remote machine and -FILE-HANDLER is non-nil, then also manipulate COMMAND in order -to set the appropriate editor environment variable." - (if (or (not file-handler) (not with-editor--envvar)) - (apply fn keys) - (when (file-remote-p default-directory) - (unless (equal (car command) "env") - (push "env" command)) - (push (concat with-editor--envvar "=" with-editor-sleeping-editor) - (cdr command))) - (let* ((filter (if filter - (lambda (process output) - (funcall filter process output) - (with-editor-process-filter process output t)) - #'with-editor-process-filter)) - (process (funcall fn - :name name - :buffer buffer - :command command - :coding coding - :noquery noquery - :stop stop - :connection-type connection-type - :filter filter - :sentinel sentinel - :stderr stderr - :file-handler file-handler))) - (process-put process 'default-dir default-directory) - process))) - -(defun with-editor-set-process-filter (process filter) - "Like `set-process-filter' but keep `with-editor-process-filter'. -Give PROCESS the new FILTER but keep `with-editor-process-filter' -if that was added earlier by the advised `start-file-process'. - -Do so by wrapping the two filter functions using a lambda, which -becomes the actual filter. It calls FILTER first, which may or -may not insert the text into the PROCESS's buffer. Then it calls -`with-editor-process-filter', passing t as NO-STANDARD-FILTER." - (set-process-filter - process - (if (eq (process-filter process) 'with-editor-process-filter) - `(lambda (proc str) - (,filter proc str) - (with-editor-process-filter proc str t)) - filter))) - -(defvar with-editor-filter-visit-hook nil) - -(defconst with-editor-sleeping-editor-regexp "^\ -WITH-EDITOR: \\([0-9]+\\) \ -OPEN \\([^]+?\\)\ -\\(?:\\([^]*\\)\\)?\ -\\(?: IN \\([^\r]+?\\)\\)?\r?$") - -(defvar with-editor--max-incomplete-length 1000) - -(defun with-editor-sleeping-editor-filter (process string) - (when-let ((incomplete (and process (process-get process 'incomplete)))) - (setq string (concat incomplete string))) - (save-match-data - (cond - ((and process (not (string-suffix-p "\n" string))) - (let ((length (length string))) - (when (> length with-editor--max-incomplete-length) - (setq string - (substring string - (- length with-editor--max-incomplete-length))))) - (process-put process 'incomplete string) - nil) - ((string-match with-editor-sleeping-editor-regexp string) - (when process - (process-put process 'incomplete nil)) - (let ((pid (match-string 1 string)) - (arg0 (match-string 2 string)) - (arg1 (match-string 3 string)) - (dir (match-string 4 string)) - file line column) - (cond ((string-match "\\`\\+\\([0-9]+\\)\\(?::\\([0-9]+\\)\\)?\\'" arg0) - (setq file arg1) - (setq line (string-to-number (match-string 1 arg0))) - (setq column (match-string 2 arg0)) - (setq column (and column (string-to-number column)))) - ((setq file arg0))) - (unless (file-name-absolute-p file) - (setq file (expand-file-name file dir))) - (when default-directory - (setq file (concat (file-remote-p default-directory) file))) - (with-current-buffer (find-file-noselect file) - (with-editor-mode 1) - (setq with-editor--pid pid) - (setq with-editor-previous-winconf - (current-window-configuration)) - (when line - (let ((pos (save-excursion - (save-restriction - (goto-char (point-min)) - (forward-line (1- line)) - (when column - (move-to-column column)) - (point))))) - (when (and (buffer-narrowed-p) - widen-automatically - (not (<= (point-min) pos (point-max)))) - (widen)) - (goto-char pos))) - (run-hooks 'with-editor-filter-visit-hook) - (funcall (or (with-editor-server-window) #'switch-to-buffer) - (current-buffer)) - (kill-local-variable 'server-window))) - nil) - (t string)))) - -(defun with-editor-process-filter - (process string &optional no-default-filter) - "Listen for edit requests by child processes." - (let ((default-directory (process-get process 'default-dir))) - (with-editor-sleeping-editor-filter process string)) - (unless no-default-filter - (internal-default-process-filter process string))) - -(define-advice server-visit-files - (:after (files _proc &optional _nowait) - with-editor-file-name-history-exclude) - "Prevent certain files from being added to `file-name-history'. -Files matching a regexp in `with-editor-file-name-history-exclude' -are prevented from being added to that list." - (pcase-dolist (`(,file . ,_) files) - (when (cl-find-if (lambda (regexp) - (string-match-p regexp file)) - with-editor-file-name-history-exclude) - (setq file-name-history (delete file file-name-history))))) - -;;; Augmentations - -;;;###autoload -(cl-defun with-editor-export-editor (&optional (envvar "EDITOR")) - "Teach subsequent commands to use current Emacs instance as editor. - -Set and export the environment variable ENVVAR, by default -\"EDITOR\". The value is automatically generated to teach -commands to use the current Emacs instance as \"the editor\". - -This works in `shell-mode', `term-mode', `eshell-mode' and -`vterm'." - (interactive (list (with-editor-read-envvar))) - (cond - ((derived-mode-p 'comint-mode 'term-mode) - (when-let ((process (get-buffer-process (current-buffer)))) - (goto-char (process-mark process)) - (process-send-string - process (format " export %s=%s\n" envvar - (shell-quote-argument with-editor-sleeping-editor))) - (while (accept-process-output process 0.1)) - (if (derived-mode-p 'term-mode) - (with-editor-set-process-filter process #'with-editor-emulate-terminal) - (add-hook 'comint-output-filter-functions #'with-editor-output-filter - nil t)))) - ((derived-mode-p 'eshell-mode) - (add-to-list 'eshell-preoutput-filter-functions - #'with-editor-output-filter) - (setenv envvar with-editor-sleeping-editor)) - ((and (derived-mode-p 'vterm-mode) - (fboundp 'vterm-send-return) - (fboundp 'vterm-send-string)) - (if with-editor-emacsclient-executable - (let ((with-editor--envvar envvar) - (process-environment process-environment)) - (with-editor--setup) - (while (accept-process-output vterm--process 0.1)) - (when-let ((v (getenv envvar))) - (vterm-send-string (format " export %s=%S" envvar v)) - (vterm-send-return)) - (when-let ((v (getenv "EMACS_SERVER_FILE"))) - (vterm-send-string (format " export EMACS_SERVER_FILE=%S" v)) - (vterm-send-return)) - (vterm-send-string "clear") - (vterm-send-return)) - (error "Cannot use sleeping editor in this buffer"))) - (t - (error "Cannot export environment variables in this buffer"))) - (message "Successfully exported %s" envvar)) - -;;;###autoload -(defun with-editor-export-git-editor () - "Like `with-editor-export-editor' but always set `$GIT_EDITOR'." - (interactive) - (with-editor-export-editor "GIT_EDITOR")) - -;;;###autoload -(defun with-editor-export-hg-editor () - "Like `with-editor-export-editor' but always set `$HG_EDITOR'." - (interactive) - (with-editor-export-editor "HG_EDITOR")) - -(defun with-editor-output-filter (string) - "Handle edit requests on behalf of `comint-mode' and `eshell-mode'." - (with-editor-sleeping-editor-filter nil string)) - -(defun with-editor-emulate-terminal (process string) - "Like `term-emulate-terminal' but also handle edit requests." - (let ((with-editor-sleeping-editor-regexp - (substring with-editor-sleeping-editor-regexp 1))) - (with-editor-sleeping-editor-filter process string)) - (term-emulate-terminal process string)) - -(defvar with-editor-envvars '("EDITOR" "GIT_EDITOR" "HG_EDITOR")) - -(cl-defun with-editor-read-envvar - (&optional (prompt "Set environment variable") - (default "EDITOR")) - (let ((reply (completing-read (if default - (format "%s (%s): " prompt default) - (concat prompt ": ")) - with-editor-envvars nil nil nil nil default))) - (if (string= reply "") (user-error "Nothing selected") reply))) - -;;;###autoload -(define-minor-mode shell-command-with-editor-mode - "Teach `shell-command' to use current Emacs instance as editor. - -Teach `shell-command', and all commands that ultimately call that -command, to use the current Emacs instance as editor by executing -\"EDITOR=CLIENT COMMAND&\" instead of just \"COMMAND&\". - -CLIENT is automatically generated; EDITOR=CLIENT instructs -COMMAND to use to the current Emacs instance as \"the editor\", -assuming no other variable overrides the effect of \"$EDITOR\". -CLIENT may be the path to an appropriate emacsclient executable -with arguments, or a script which also works over Tramp. - -Alternatively you can use the `with-editor-async-shell-command', -which also allows the use of another variable instead of -\"EDITOR\"." - :global t) - -;;;###autoload -(defun with-editor-async-shell-command - (command &optional output-buffer error-buffer envvar) - "Like `async-shell-command' but with `$EDITOR' set. - -Execute string \"ENVVAR=CLIENT COMMAND\" in an inferior shell; -display output, if any. With a prefix argument prompt for an -environment variable, otherwise the default \"EDITOR\" variable -is used. With a negative prefix argument additionally insert -the COMMAND's output at point. - -CLIENT is automatically generated; ENVVAR=CLIENT instructs -COMMAND to use to the current Emacs instance as \"the editor\", -assuming it respects ENVVAR as an \"EDITOR\"-like variable. -CLIENT may be the path to an appropriate emacsclient executable -with arguments, or a script which also works over Tramp. - -Also see `async-shell-command' and `shell-command'." - (interactive (with-editor-shell-command-read-args "Async shell command: " t)) - (let ((with-editor--envvar envvar)) - (with-editor - (async-shell-command command output-buffer error-buffer)))) - -;;;###autoload -(defun with-editor-shell-command - (command &optional output-buffer error-buffer envvar) - "Like `shell-command' or `with-editor-async-shell-command'. -If COMMAND ends with \"&\" behave like the latter, -else like the former." - (interactive (with-editor-shell-command-read-args "Shell command: ")) - (if (string-match "&[ \t]*\\'" command) - (with-editor-async-shell-command - command output-buffer error-buffer envvar) - (shell-command command output-buffer error-buffer))) - -(defun with-editor-shell-command-read-args (prompt &optional async) - (let ((command (read-shell-command - prompt nil nil - (let ((filename (or buffer-file-name - (and (eq major-mode 'dired-mode) - (dired-get-filename nil t))))) - (and filename (file-relative-name filename)))))) - (list command - (if (or async (setq async (string-match-p "&[ \t]*\\'" command))) - (< (prefix-numeric-value current-prefix-arg) 0) - current-prefix-arg) - shell-command-default-error-buffer - (and async current-prefix-arg (with-editor-read-envvar))))) - -(define-advice shell-command - (:around (fn command &optional output-buffer error-buffer) - shell-command-with-editor-mode) - "`shell-mode' and its hook are intended for buffers in which an -interactive shell is running, but `shell-command' also turns on -that mode, even though it only runs the shell to run a single -command. The `with-editor-export-editor' hook function is only -intended to be used in buffers in which an interactive shell is -running, so it has to be removed here." - (let ((shell-mode-hook (remove 'with-editor-export-editor shell-mode-hook))) - (cond ((or (not (or with-editor--envvar shell-command-with-editor-mode)) - (not (string-suffix-p "&" command))) - (funcall fn command output-buffer error-buffer)) - ((and with-editor-shell-command-use-emacsclient - with-editor-emacsclient-executable - (not (file-remote-p default-directory))) - (with-editor (funcall fn command output-buffer error-buffer))) - (t - (funcall fn (format "%s=%s %s" - (or with-editor--envvar "EDITOR") - (shell-quote-argument with-editor-sleeping-editor) - command) - output-buffer error-buffer) - (ignore-errors - (let ((process (get-buffer-process - (or output-buffer - (get-buffer "*Async Shell Command*"))))) - (set-process-filter - process (lambda (proc str) - (comint-output-filter proc str) - (with-editor-process-filter proc str t))) - process)))))) - -;;; _ - -(defun with-editor-debug () - "Debug configuration issues. -See info node `(with-editor)Debugging' for instructions." - (interactive) - (require 'warnings) - (with-current-buffer (get-buffer-create "*with-editor-debug*") - (pop-to-buffer (current-buffer)) - (erase-buffer) - (ignore-errors (with-editor)) - (insert - (format "with-editor: %s\n" (locate-library "with-editor.el")) - (format "emacs: %s (%s)\n" - (expand-file-name invocation-name invocation-directory) - emacs-version) - "system:\n" - (format " system-type: %s\n" system-type) - (format " system-configuration: %s\n" system-configuration) - (format " system-configuration-options: %s\n" system-configuration-options) - "server:\n" - (format " server-running-p: %s\n" (server-running-p)) - (format " server-process: %S\n" server-process) - (format " server-use-tcp: %s\n" server-use-tcp) - (format " server-name: %s\n" server-name) - (format " server-socket-dir: %s\n" server-socket-dir)) - (if (and server-socket-dir (file-accessible-directory-p server-socket-dir)) - (dolist (file (directory-files server-socket-dir nil "^[^.]")) - (insert (format " %s\n" file))) - (insert (format " %s: not an accessible directory\n" - (if server-use-tcp "WARNING" "ERROR")))) - (insert (format " server-auth-dir: %s\n" server-auth-dir)) - (if (file-accessible-directory-p server-auth-dir) - (dolist (file (directory-files server-auth-dir nil "^[^.]")) - (insert (format " %s\n" file))) - (insert (format " %s: not an accessible directory\n" - (if server-use-tcp "ERROR" "WARNING")))) - (let ((val with-editor-emacsclient-executable) - (def (default-value 'with-editor-emacsclient-executable)) - (fun (let ((warning-minimum-level :error) - (warning-minimum-log-level :error)) - (with-editor-locate-emacsclient)))) - (insert "with-editor-emacsclient-executable:\n" - (format " value: %s (%s)\n" val - (and val (with-editor-emacsclient-version val))) - (format " default: %s (%s)\n" def - (and def (with-editor-emacsclient-version def))) - (format " funcall: %s (%s)\n" fun - (and fun (with-editor-emacsclient-version fun))))) - (insert "path:\n" - (format " $PATH: %s\n" (split-string (getenv "PATH") ":")) - (format " exec-path: %s\n" exec-path)) - (insert (format " with-editor-emacsclient-path:\n")) - (dolist (dir (with-editor-emacsclient-path)) - (insert (format " %s (%s)\n" dir (car (file-attributes dir)))) - (when (file-directory-p dir) - ;; Don't match emacsclientw.exe, it makes popup windows. - (dolist (exec (directory-files dir t "emacsclient\\(?:[^w]\\|\\'\\)")) - (insert (format " %s (%s)\n" exec - (with-editor-emacsclient-version exec)))))))) - -(defconst with-editor-font-lock-keywords - '(("(\\(with-\\(?:git-\\)?editor\\)\\_>" (1 'font-lock-keyword-face)))) -(font-lock-add-keywords 'emacs-lisp-mode with-editor-font-lock-keywords) - -(provide 'with-editor) -;; Local Variables: -;; indent-tabs-mode: nil -;; byte-compile-warnings: (not docstrings-control-chars) -;; End: -;;; with-editor.el ends here diff --git a/emacs/elpa/with-editor-20240609.1518/with-editor.elc b/emacs/elpa/with-editor-20240609.1518/with-editor.elc Binary files differ. diff --git a/emacs/elpa/with-editor-20240609.1518/with-editor.info b/emacs/elpa/with-editor-20240609.1518/with-editor.info @@ -1,384 +0,0 @@ -This is with-editor.info, produced by makeinfo version 6.7 from -with-editor.texi. - - Copyright (C) 2015-2024 Jonas Bernoulli - <emacs.with-editor@jonas.bernoulli.dev> - - 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 -* With-Editor: (with-editor). Using the Emacsclient as $EDITOR. -END-INFO-DIR-ENTRY - - -File: with-editor.info, Node: Top, Next: Using the With-Editor package, Up: (dir) - -With-Editor User Manual -*********************** - -The library ‘with-editor’ makes it easy to use the Emacsclient as the -‘$EDITOR’ of child processes, making sure they know how to call home. -For remote processes a substitute is provided, which communicates with -Emacs on standard output instead of using a socket as the Emacsclient -does. - - This library was written because Magit has to be able to do the above -to allow the user to edit commit messages gracefully and to edit rebase -sequences, which wouldn’t be possible at all otherwise. - - Because other packages can benefit from such functionality, this -library is made available as a separate package. It also defines some -additional functionality which makes it useful even for end-users, who -don’t use Magit or another package which uses it internally. - -This manual is for With-Editor version 3.3.2. - - Copyright (C) 2015-2024 Jonas Bernoulli - <emacs.with-editor@jonas.bernoulli.dev> - - 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: - -* Using the With-Editor package:: -* Using With-Editor as a library:: -* Debugging:: -* Function and Command Index:: -* Variable Index:: - -— The Detailed Node Listing — - -Using the With-Editor package - -* Configuring With-Editor:: -* Using With-Editor commands:: - - - -File: with-editor.info, Node: Using the With-Editor package, Next: Using With-Editor as a library, Prev: Top, Up: Top - -1 Using the With-Editor package -******************************* - -The ‘With-Editor’ package is used internally by Magit when editing -commit messages and rebase sequences. It also provides some commands -and features which are useful by themselves, even if you don’t use -Magit. - - For information about using this library in you own package, see -*note Using With-Editor as a library::. - -* Menu: - -* Configuring With-Editor:: -* Using With-Editor commands:: - - -File: with-editor.info, Node: Configuring With-Editor, Next: Using With-Editor commands, Up: Using the With-Editor package - -1.1 Configuring With-Editor -=========================== - -With-Editor tries very hard to locate a suitable ‘emacsclient’ -executable, so ideally you should never have to customize the option -‘with-editor-emacsclient-executable’. When it fails to do so, then the -most likely reason is that someone found yet another way to package -Emacs (most likely on macOS) without putting the executable on ‘$PATH’, -and we have to add another kludge to find it anyway. - - -- User Option: with-editor-emacsclient-executable - The ‘emacsclient’ executable used as the editor by child process of - this Emacs instance. By using this executable, child processes can - call home to their parent process. - - This option is automatically set at startup by looking in - ‘exec-path’, and other places where the executable could be - installed, to find the ‘emacsclient’ executable most suitable for - the current Emacs instance. - - You should *not* customize this option permanently. If you have to - do it, then you should consider that a temporary kludge and inform - the Magit maintainer as described in *note Debugging::. - - If With-Editor fails to find a suitable ‘emacsclient’ on you - system, then this should be fixed for all users at once, by - teaching ‘with-editor-locate-emacsclient’ how to do so on your - system and system like yours. Doing it this way has the advantage, - that you won’t have do it again every time you update Emacs, and - that other users who have installed Emacs the same way as you have, - won’t have to go through the same trouble. - - Note that there also is a nuclear option; setting this variable to - ‘nil’ causes the "sleeping editor" described below to be used even - for local child processes. Obviously we don’t recommend that you - use this except in "emergencies", i.e., before we had a change to - add a kludge appropriate for you setup. - - -- Function: with-editor-locate-emacsclient - The function used to set the initial value of the option - ‘with-editor-emacsclient-executable’. There’s a lot of voodoo - here. - - The ‘emacsclient’ cannot be used when using Tramp to run a process on -a remote machine. (Theoretically it could, but that would be hard to -setup, very fragile, and rather insecure). - - With-Editor provides an alternative "editor" which can be used by -remote processes in much the same way as local processes use an -‘emacsclient’ executable. This alternative is known as the "sleeping -editor" because it is implemented as a shell script which sleeps until -it receives a signal. - - -- User Option: with-editor-sleeping-editor - The sleeping editor is a shell script used as the editor of child - processes when the ‘emacsclient’ executable cannot be used. - - This fallback is used for asynchronous process started inside the - macro ‘with-editor’, when the process runs on a remote machine or - for local processes when ‘with-editor-emacsclient-executable’ is - ‘nil’. - - Where the latter uses a socket to communicate with Emacs’ server, - this substitute prints edit requests to its standard output on - which a process filter listens for such requests. As such it is - not a complete substitute for a proper ‘emacsclient’, it can only - be used as ‘$EDITOR’ of child process of the current Emacs - instance. - - Some shells do not execute traps immediately when waiting for a - child process, but by default we do use such a blocking child - process. - - If you use such a shell (e.g., ‘csh’ on FreeBSD, but not Debian), - then you have to edit this option. You can either replace ‘sh’ - with ‘bash’ (and install that), or you can use the older, less - performant implementation: - - "sh -c '\ - echo \"WITH-EDITOR: $$ OPEN $0$1 IN $(pwd)\"; \ - trap \"exit 0\" USR1; \ - trap \"exit 1\" USR2; \ - while true; do sleep 1; done'" - - Note that the unit separator character () right after the file name - ($0) is required. - - Also note that using this alternative implementation leads to a - delay of up to a second. The delay can be shortened by replacing - ‘sleep 1’ with ‘sleep 0.01’, or if your implementation does not - support floats, then by using ‘nanosleep’ instead. - - -File: with-editor.info, Node: Using With-Editor commands, Prev: Configuring With-Editor, Up: Using the With-Editor package - -1.2 Using With-Editor commands -============================== - -This section describes how to use the ‘with-editor’ library _outside_ of -Magit. You don’t need to know any of this just to create commits using -Magit. - - The commands ‘with-editor-async-shell-command’ and -‘with-editor-shell-command’ are intended as drop in replacements for -‘async-shell-command’ and ‘shell-command’. They automatically export -‘$EDITOR’ making sure the executed command uses the current Emacs -instance as "the editor". With a prefix argument these commands prompt -for an alternative environment variable such as ‘$GIT_EDITOR’. - - -- Command: with-editor-async-shell-command - This command is like ‘async-shell-command’, but it runs the shell - command with the current Emacs instance exported as ‘$EDITOR’. - - -- Command: with-editor-shell-command - This command is like ‘shell-command’, but if the shell command ends - with ‘&’ and is therefore run asynchronously, then the current - Emacs instance is exported as ‘$EDITOR’. - - To always use these variants add this to you init file: - - (keymap-global-set "<remap> <async-shell-command>" - #'with-editor-async-shell-command) - (keymap-global-set "<remap> <shell-command>" - #'with-editor-shell-command) - - Alternatively use the global ‘shell-command-with-editor-mode’. - - -- Variable: shell-command-with-editor-mode - When this mode is active, then ‘$EDITOR’ is exported whenever - ultimately ‘shell-command’ is called to asynchronously run some - shell command. This affects most variants of that command, whether - they are defined in Emacs or in some third-party package. - - The command ‘with-editor-export-editor’ exports ‘$EDITOR’ or another -such environment variable in ‘shell-mode’, ‘eshell-mode’, ‘term-mode’ -and ‘vterm-mode’ buffers. Use this Emacs command before executing a -shell command which needs the editor set, or always arrange for the -current Emacs instance to be used as editor by adding it to the -appropriate mode hooks: - - (add-hook 'shell-mode-hook 'with-editor-export-editor) - (add-hook 'eshell-mode-hook 'with-editor-export-editor) - (add-hook 'term-exec-hook 'with-editor-export-editor) - (add-hook 'vterm-mode-hook 'with-editor-export-editor) - - Some variants of this function exist; these two forms are equivalent: - - (add-hook 'shell-mode-hook - (apply-partially 'with-editor-export-editor "GIT_EDITOR")) - (add-hook 'shell-mode-hook 'with-editor-export-git-editor) - - -- Command: with-editor-export-editor - When invoked in a ‘shell-mode’, ‘eshell-mode’, ‘term-mode’ or - ‘vterm-mode’ buffer, this command teaches shell commands to use the - current Emacs instance as the editor, by exporting ‘$EDITOR’. - - -- Command: with-editor-export-git-editor - This command is like ‘with-editor-export-editor’ but exports - ‘$GIT_EDITOR’. - - -- Command: with-editor-export-hg-editor - This command is like ‘with-editor-export-editor’ but exports - ‘$HG_EDITOR’. - - -File: with-editor.info, Node: Using With-Editor as a library, Next: Debugging, Prev: Using the With-Editor package, Up: Top - -2 Using With-Editor as a library -******************************** - -This section describes how to use the ‘with-editor’ library _outside_ of -Magit to teach another package how to have its child processes call -home, just like Magit does. You don’t need to know any of this just to -create commits using Magit. You can also ignore this if you use -‘with-editor’ outside of Magit, but only as an end-user. - - For information about interactive use and options that affect both -interactive and non-interactive use, see *note Using the With-Editor -package::. - - -- Macro: with-editor &rest body - This macro arranges for the ‘emacsclient’ or the sleeping editor to - be used as the editor of child processes, effectively teaching them - to call home to the current Emacs instance when they require that - the user edits a file. - - This is done by establishing a local binding for - ‘process-environment’ and changing the value of the ‘EDITOR’ - environment variable in that scope. This affects all - (asynchronous) processes started by forms (dynamically) inside - BODY. - - If BODY begins with a literal string, then that variable is set - instead of ‘EDITOR’. - - -- Macro: with-editor envvar &rest body - This macro is like ‘with-editor’ instead that the ENVVAR argument - is required and that it is evaluated at run-time. - - -- Function: with-editor-set-process-filter process filter - This function is like ‘set-process-filter’ but ensures that adding - the new FILTER does not remove the ‘with-editor-process-filter’. - This is done by wrapping the two filter functions using a lambda, - which becomes the actual filter. It calls FILTER first, which may - or may not insert the text into the PROCESS’s buffer. Then it - calls ‘with-editor-process-filter’, passing t as - NO-STANDARD-FILTER. - - -File: with-editor.info, Node: Debugging, Next: Function and Command Index, Prev: Using With-Editor as a library, Up: Top - -3 Debugging -*********** - -With-Editor tries very hard to locate a suitable ‘emacsclient’ -executable, and then sets option ‘with-editor-emacsclient-executable’ -accordingly. In very rare cases this fails. When it does fail, then -the most likely reason is that someone found yet another way to package -Emacs (most likely on macOS) without putting the executable on ‘$PATH’, -and we have to add another kludge to find it anyway. - - If you are having problems using ‘with-editor’, e.g., you cannot -commit in Magit, then please open a new issue at -<https://github.com/magit/with-editor/issues> and provide information -about your Emacs installation. Most importantly how did you install -Emacs and what is the output of ‘M-x with-editor-debug RET’. - - -File: with-editor.info, Node: Function and Command Index, Next: Variable Index, Prev: Debugging, Up: Top - -Appendix A Function and Command Index -************************************* - - -* Menu: - -* with-editor: Using With-Editor as a library. - (line 16) -* with-editor <1>: Using With-Editor as a library. - (line 31) -* with-editor-async-shell-command: Using With-Editor commands. - (line 17) -* with-editor-export-editor: Using With-Editor commands. - (line 59) -* with-editor-export-git-editor: Using With-Editor commands. - (line 64) -* with-editor-export-hg-editor: Using With-Editor commands. - (line 68) -* with-editor-locate-emacsclient: Configuring With-Editor. - (line 41) -* with-editor-set-process-filter: Using With-Editor as a library. - (line 35) -* with-editor-shell-command: Using With-Editor commands. - (line 21) - - -File: with-editor.info, Node: Variable Index, Prev: Function and Command Index, Up: Top - -Appendix B Variable Index -************************* - - -* Menu: - -* shell-command-with-editor-mode: Using With-Editor commands. - (line 35) -* with-editor-emacsclient-executable: Configuring With-Editor. - (line 13) -* with-editor-sleeping-editor: Configuring With-Editor. - (line 56) - - - -Tag Table: -Node: Top799 -Node: Using the With-Editor package2615 -Node: Configuring With-Editor3201 -Node: Using With-Editor commands7750 -Node: Using With-Editor as a library11051 -Node: Debugging13076 -Node: Function and Command Index13968 -Node: Variable Index15466 - -End Tag Table - - -Local Variables: -coding: utf-8 -End: diff --git a/emacs/elpa/with-editor-20240618.1840/dir b/emacs/elpa/with-editor-20240618.1840/dir @@ -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<Return>" 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 -* With-Editor: (with-editor). Using the Emacsclient as $EDITOR. diff --git a/emacs/elpa/with-editor-20240618.1840/with-editor-autoloads.el b/emacs/elpa/with-editor-20240618.1840/with-editor-autoloads.el @@ -1,105 +0,0 @@ -;;; with-editor-autoloads.el --- automatically extracted autoloads (do not edit) -*- lexical-binding: t -*- -;; Generated by the `loaddefs-generate' function. - -;; This file is part of GNU Emacs. - -;;; Code: - -(add-to-list 'load-path (or (and load-file-name (directory-file-name (file-name-directory load-file-name))) (car load-path))) - - - -;;; Generated autoloads from with-editor.el - -(autoload 'with-editor-export-editor "with-editor" "\ -Teach subsequent commands to use current Emacs instance as editor. - -Set and export the environment variable ENVVAR, by default -\"EDITOR\". The value is automatically generated to teach -commands to use the current Emacs instance as \"the editor\". - -This works in `shell-mode', `term-mode', `eshell-mode' and -`vterm'. - -(fn &optional (ENVVAR \"EDITOR\"))" t) -(autoload 'with-editor-export-git-editor "with-editor" "\ -Like `with-editor-export-editor' but always set `$GIT_EDITOR'." t) -(autoload 'with-editor-export-hg-editor "with-editor" "\ -Like `with-editor-export-editor' but always set `$HG_EDITOR'." t) -(defvar shell-command-with-editor-mode nil "\ -Non-nil if Shell-Command-With-Editor mode is enabled. -See the `shell-command-with-editor-mode' command -for a description of this minor mode.") -(custom-autoload 'shell-command-with-editor-mode "with-editor" nil) -(autoload 'shell-command-with-editor-mode "with-editor" "\ -Teach `shell-command' to use current Emacs instance as editor. - -Teach `shell-command', and all commands that ultimately call that -command, to use the current Emacs instance as editor by executing -\"EDITOR=CLIENT COMMAND&\" instead of just \"COMMAND&\". - -CLIENT is automatically generated; EDITOR=CLIENT instructs -COMMAND to use to the current Emacs instance as \"the editor\", -assuming no other variable overrides the effect of \"$EDITOR\". -CLIENT may be the path to an appropriate emacsclient executable -with arguments, or a script which also works over Tramp. - -Alternatively you can use the `with-editor-async-shell-command', -which also allows the use of another variable instead of -\"EDITOR\". - -This is a global minor mode. If called interactively, toggle the -`Shell-Command-With-Editor 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 `(default-value \\='shell-command-with-editor-mode)'. - -The mode's hook is called both when the mode is enabled and when -it is disabled. - -(fn &optional ARG)" t) -(autoload 'with-editor-async-shell-command "with-editor" "\ -Like `async-shell-command' but with `$EDITOR' set. - -Execute string \"ENVVAR=CLIENT COMMAND\" in an inferior shell; -display output, if any. With a prefix argument prompt for an -environment variable, otherwise the default \"EDITOR\" variable -is used. With a negative prefix argument additionally insert -the COMMAND's output at point. - -CLIENT is automatically generated; ENVVAR=CLIENT instructs -COMMAND to use to the current Emacs instance as \"the editor\", -assuming it respects ENVVAR as an \"EDITOR\"-like variable. -CLIENT may be the path to an appropriate emacsclient executable -with arguments, or a script which also works over Tramp. - -Also see `async-shell-command' and `shell-command'. - -(fn COMMAND &optional OUTPUT-BUFFER ERROR-BUFFER ENVVAR)" t) -(autoload 'with-editor-shell-command "with-editor" "\ -Like `shell-command' or `with-editor-async-shell-command'. -If COMMAND ends with \"&\" behave like the latter, -else like the former. - -(fn COMMAND &optional OUTPUT-BUFFER ERROR-BUFFER ENVVAR)" t) -(register-definition-prefixes "with-editor" '("server-" "shell-command" "start-file-process" "with-editor")) - -;;; End of scraped data - -(provide 'with-editor-autoloads) - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; no-native-compile: t -;; coding: utf-8-emacs-unix -;; End: - -;;; with-editor-autoloads.el ends here diff --git a/emacs/elpa/with-editor-20240618.1840/with-editor-pkg.el b/emacs/elpa/with-editor-20240618.1840/with-editor-pkg.el @@ -1,15 +0,0 @@ -(define-package "with-editor" "20240618.1840" "Use the Emacsclient as $EDITOR" - '((emacs "25.1") - (compat "29.1.4.5")) - :commit "0eff758e59b0efeab0a4f40b19c51e5712c19d4e" :authors - '(("Jonas Bernoulli" . "emacs.with-editor@jonas.bernoulli.dev")) - :maintainers - '(("Jonas Bernoulli" . "emacs.with-editor@jonas.bernoulli.dev")) - :maintainer - '("Jonas Bernoulli" . "emacs.with-editor@jonas.bernoulli.dev") - :keywords - '("processes" "terminals") - :url "https://github.com/magit/with-editor") -;; Local Variables: -;; no-byte-compile: t -;; End: diff --git a/emacs/elpa/with-editor-20240618.1840/with-editor.el b/emacs/elpa/with-editor-20240618.1840/with-editor.el @@ -1,980 +0,0 @@ -;;; with-editor.el --- Use the Emacsclient as $EDITOR -*- lexical-binding:t -*- - -;; Copyright (C) 2014-2024 The Magit Project Contributors - -;; Author: Jonas Bernoulli <emacs.with-editor@jonas.bernoulli.dev> -;; Homepage: https://github.com/magit/with-editor -;; Keywords: processes terminals - -;; Package-Version: 3.3.3 -;; Package-Requires: ((emacs "25.1") (compat "29.1.4.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 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 <https://www.gnu.org/licenses/>. - -;;; Commentary: - -;; This library makes it possible to reliably use the Emacsclient as -;; the `$EDITOR' of child processes. It makes sure that they know how -;; to call home. For remote processes a substitute is provided, which -;; communicates with Emacs on standard output/input instead of using a -;; socket as the Emacsclient does. - -;; It provides the commands `with-editor-async-shell-command' and -;; `with-editor-shell-command', which are intended as replacements -;; for `async-shell-command' and `shell-command'. They automatically -;; export `$EDITOR' making sure the executed command uses the current -;; Emacs instance as "the editor". With a prefix argument these -;; commands prompt for an alternative environment variable such as -;; `$GIT_EDITOR'. To always use these variants add this to your init -;; file: -;; -;; (keymap-global-set "<remap> <async-shell-command>" -;; #'with-editor-async-shell-command) -;; (keymap-global-set "<remap> <shell-command>" -;; #'with-editor-shell-command) - -;; Alternatively use the global `shell-command-with-editor-mode', -;; which always sets `$EDITOR' for all Emacs commands which ultimately -;; use `shell-command' to asynchronously run some shell command. - -;; The command `with-editor-export-editor' exports `$EDITOR' or -;; another such environment variable in `shell-mode', `eshell-mode', -;; `term-mode' and `vterm-mode' buffers. Use this Emacs command -;; before executing a shell command which needs the editor set, or -;; always arrange for the current Emacs instance to be used as editor -;; by adding it to the appropriate mode hooks: -;; -;; (add-hook 'shell-mode-hook #'with-editor-export-editor) -;; (add-hook 'eshell-mode-hook #'with-editor-export-editor) -;; (add-hook 'term-exec-hook #'with-editor-export-editor) -;; (add-hook 'vterm-mode-hook #'with-editor-export-editor) - -;; Some variants of this function exist, these two forms are -;; equivalent: -;; -;; (add-hook 'shell-mode-hook -;; (apply-partially #'with-editor-export-editor "GIT_EDITOR")) -;; (add-hook 'shell-mode-hook #'with-editor-export-git-editor) - -;; This library can also be used by other packages which need to use -;; the current Emacs instance as editor. In fact this library was -;; written for Magit and its `git-commit-mode' and `git-rebase-mode'. -;; Consult `git-rebase.el' and the related code in `magit-sequence.el' -;; for a simple example. - -;;; Code: - -(require 'cl-lib) -(require 'compat) -(require 'server) -(require 'shell) -(eval-when-compile (require 'subr-x)) - -(declare-function dired-get-filename "dired" - (&optional localp no-error-if-not-filep)) -(declare-function term-emulate-terminal "term" (proc str)) -(defvar eshell-preoutput-filter-functions) -(defvar git-commit-post-finish-hook) -(defvar vterm--process) -(defvar warning-minimum-level) -(defvar warning-minimum-log-level) - -;;; Options - -(defgroup with-editor nil - "Use the Emacsclient as $EDITOR." - :group 'external - :group 'server) - -(defun with-editor-locate-emacsclient () - "Search for a suitable Emacsclient executable." - (or (with-editor-locate-emacsclient-1 - (with-editor-emacsclient-path) - (length (split-string emacs-version "\\."))) - (prog1 nil (display-warning 'with-editor "\ -Cannot determine a suitable Emacsclient - -Determining an Emacsclient executable suitable for the -current Emacs instance failed. For more information -please see https://github.com/magit/magit/wiki/Emacsclient.")))) - -(defun with-editor-locate-emacsclient-1 (path depth) - (let* ((version-lst (cl-subseq (split-string emacs-version "\\.") 0 depth)) - (version-reg (concat "^" (mapconcat #'identity version-lst "\\.")))) - (or (locate-file - (cond ((equal (downcase invocation-name) "remacs") - "remacsclient") - ((bound-and-true-p emacsclient-program-name)) - ("emacsclient")) - path - (cl-mapcan - (lambda (v) (cl-mapcar (lambda (e) (concat v e)) exec-suffixes)) - (nconc (and (boundp 'debian-emacs-flavor) - (list (format ".%s" debian-emacs-flavor))) - (cl-mapcon (lambda (v) - (setq v (mapconcat #'identity (reverse v) ".")) - (list v (concat "-" v) (concat ".emacs" v))) - (reverse version-lst)) - (list "" "-snapshot" ".emacs-snapshot"))) - (lambda (exec) - (ignore-errors - (string-match-p version-reg - (with-editor-emacsclient-version exec))))) - (and (> depth 1) - (with-editor-locate-emacsclient-1 path (1- depth)))))) - -(defun with-editor-emacsclient-version (exec) - (let ((default-directory (file-name-directory exec))) - (ignore-errors - (cadr (split-string (car (process-lines exec "--version"))))))) - -(defun with-editor-emacsclient-path () - (let ((path exec-path)) - (when invocation-directory - (push (directory-file-name invocation-directory) path) - (let* ((linkname (expand-file-name invocation-name invocation-directory)) - (truename (file-chase-links linkname))) - (unless (equal truename linkname) - (push (directory-file-name (file-name-directory truename)) path))) - (when (eq system-type 'darwin) - (let ((dir (expand-file-name "bin" invocation-directory))) - (when (file-directory-p dir) - (push dir path))) - (when (string-search "Cellar" invocation-directory) - (let ((dir (expand-file-name "../../../bin" invocation-directory))) - (when (file-directory-p dir) - (push dir path)))))) - (cl-remove-duplicates path :test #'equal))) - -(defcustom with-editor-emacsclient-executable (with-editor-locate-emacsclient) - "The Emacsclient executable used by the `with-editor' macro." - :group 'with-editor - :type '(choice (string :tag "Executable") - (const :tag "Don't use Emacsclient" nil))) - -(defcustom with-editor-sleeping-editor "\ -sh -c '\ -printf \"\\nWITH-EDITOR: $$ OPEN $0\\037$1\\037 IN $(pwd)\\n\"; \ -sleep 604800 & sleep=$!; \ -trap \"kill $sleep; exit 0\" USR1; \ -trap \"kill $sleep; exit 1\" USR2; \ -wait $sleep'" - "The sleeping editor, used when the Emacsclient cannot be used. - -This fallback is used for asynchronous processes started inside -the macro `with-editor', when the process runs on a remote machine -or for local processes when `with-editor-emacsclient-executable' -is nil (i.e., when no suitable Emacsclient was found, or the user -decided not to use it). - -Where the latter uses a socket to communicate with Emacs' server, -this substitute prints edit requests to its standard output on -which a process filter listens for such requests. As such it is -not a complete substitute for a proper Emacsclient, it can only -be used as $EDITOR of child process of the current Emacs instance. - -Some shells do not execute traps immediately when waiting for a -child process, but by default we do use such a blocking child -process. - -If you use such a shell (e.g., `csh' on FreeBSD, but not Debian), -then you have to edit this option. You can either replace \"sh\" -with \"bash\" (and install that), or you can use the older, less -performant implementation: - - \"sh -c '\\ - echo -e \\\"\\nWITH-EDITOR: $$ OPEN $0$1 IN $(pwd)\\n\\\"; \\ - trap \\\"exit 0\\\" USR1; \\ - trap \\\"exit 1\" USR2; \\ - while true; do sleep 1; done'\" - -Note that the two unit separator characters () right after $0 -and $1 are required. Normally $0 is the file name and $1 is -missing or else gets ignored. But if $0 has the form \"+N[:N]\", -then it is treated as a position in the file and $1 is expected -to be the file. - -Also note that using this alternative implementation leads to a -delay of up to a second. The delay can be shortened by replacing -\"sleep 1\" with \"sleep 0.01\", or if your implementation does -not support floats, then by using \"nanosleep\" instead." - :package-version '(with-editor . "2.8.0") - :group 'with-editor - :type 'string) - -(defcustom with-editor-finish-query-functions nil - "List of functions called to query before finishing session. - -The buffer in question is current while the functions are called. -If any of them returns nil, then the session is not finished 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 that and return non-nil." - :group 'with-editor - :type 'hook) -(put 'with-editor-finish-query-functions 'permanent-local t) - -(defcustom with-editor-cancel-query-functions nil - "List of functions called to query before canceling session. - -The buffer in question is current while the functions are called. -If any of them returns nil, then the session is not canceled 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 canceling the session despite issues. Functions should -usually honor that and return non-nil." - :group 'with-editor - :type 'hook) -(put 'with-editor-cancel-query-functions 'permanent-local t) - -(defcustom with-editor-mode-lighter " WE" - "The mode-line lighter of the With-Editor mode." - :group 'with-editor - :type '(choice (const :tag "No lighter" "") string)) - -(defvar with-editor-server-window-alist nil - "Alist of filename patterns vs corresponding `server-window'. - -Each element looks like (REGEXP . FUNCTION). Files matching -REGEXP are selected using FUNCTION instead of the default in -`server-window'. - -Note that when a package adds an entry here then it probably -has a reason to disrespect `server-window' and it likely is -not a good idea to change such entries.") - -(defvar with-editor-file-name-history-exclude nil - "List of regexps for filenames `server-visit' should not remember. -When a filename matches any of the regexps, then `server-visit' -does not add it to the variable `file-name-history', which is -used when reading a filename in the minibuffer.") - -(defcustom with-editor-shell-command-use-emacsclient t - "Whether to use the emacsclient when running shell commands. - -This affects `with-editor-async-shell-command' and, if the input -ends with \"&\" `with-editor-shell-command' . - -If `shell-command-with-editor-mode' is enabled, then it also -affects `shell-command-async' and, if the input ends with \"&\" -`shell-command'. - -This is a temporary kludge that lets you choose between two -possible defects, the ones described in the issues #23 and #40. - -When t, then use the emacsclient. This has the disadvantage that -`with-editor-mode' won't be enabled because we don't know whether -this package was involved at all in the call to the emacsclient, -and when it is not, then we really should. The problem is that -the emacsclient doesn't pass along any environment variables to -the server. This will hopefully be fixed in Emacs eventually. - -When nil, then use the sleeping editor. Because in this case we -know that this package is involved, we can enable the mode. But -this makes it necessary that you invoke $EDITOR in shell scripts -like so: - - eval \"$EDITOR\" file - -And some tools that do not handle $EDITOR properly also break." - :package-version '(with-editor . "2.7.1") - :group 'with-editor - :type 'boolean) - -;;; Mode Commands - -(defvar with-editor-pre-finish-hook nil) -(defvar with-editor-pre-cancel-hook nil) -(defvar with-editor-post-finish-hook nil) -(defvar with-editor-post-finish-hook-1 nil) -(defvar with-editor-post-cancel-hook nil) -(defvar with-editor-post-cancel-hook-1 nil) -(defvar with-editor-cancel-alist nil) -(put 'with-editor-pre-finish-hook 'permanent-local t) -(put 'with-editor-pre-cancel-hook 'permanent-local t) -(put 'with-editor-post-finish-hook 'permanent-local t) -(put 'with-editor-post-cancel-hook 'permanent-local t) - -(defvar-local with-editor-show-usage t) -(defvar-local with-editor-cancel-message nil) -(defvar-local with-editor-previous-winconf nil) -(put 'with-editor-cancel-message 'permanent-local t) -(put 'with-editor-previous-winconf 'permanent-local t) - -(defvar-local with-editor--pid nil "For internal use.") -(put 'with-editor--pid 'permanent-local t) - -(defun with-editor-finish (force) - "Finish the current edit session." - (interactive "P") - (when (run-hook-with-args-until-failure - 'with-editor-finish-query-functions force) - (let ((post-finish-hook with-editor-post-finish-hook) - (post-commit-hook (bound-and-true-p git-commit-post-finish-hook)) - (dir default-directory)) - (run-hooks 'with-editor-pre-finish-hook) - (with-editor-return nil) - (accept-process-output nil 0.1) - (with-temp-buffer - (setq default-directory dir) - (setq-local with-editor-post-finish-hook post-finish-hook) - (when post-commit-hook - (setq-local git-commit-post-finish-hook post-commit-hook)) - (run-hooks 'with-editor-post-finish-hook))))) - -(defun with-editor-cancel (force) - "Cancel the current edit session." - (interactive "P") - (when (run-hook-with-args-until-failure - 'with-editor-cancel-query-functions force) - (let ((message with-editor-cancel-message)) - (when (functionp message) - (setq message (funcall message))) - (let ((post-cancel-hook with-editor-post-cancel-hook) - (with-editor-cancel-alist nil) - (dir default-directory)) - (run-hooks 'with-editor-pre-cancel-hook) - (with-editor-return t) - (accept-process-output nil 0.1) - (with-temp-buffer - (setq default-directory dir) - (setq-local with-editor-post-cancel-hook post-cancel-hook) - (run-hooks 'with-editor-post-cancel-hook))) - (message (or message "Canceled by user"))))) - -(defun with-editor-return (cancel) - (let ((winconf with-editor-previous-winconf) - (clients server-buffer-clients) - (dir default-directory) - (pid with-editor--pid)) - (remove-hook 'kill-buffer-query-functions - #'with-editor-kill-buffer-noop t) - (cond (cancel - (save-buffer) - (if clients - (let ((buf (current-buffer))) - (dolist (client clients) - (message "client %S" client) - (ignore-errors - (server-send-string client "-error Canceled by user")) - (delete-process client)) - (when (buffer-live-p buf) - (kill-buffer buf))) - ;; Fallback for when emacs was used as $EDITOR - ;; instead of emacsclient or the sleeping editor. - ;; See https://github.com/magit/magit/issues/2258. - (ignore-errors (delete-file buffer-file-name)) - (kill-buffer))) - (t - (save-buffer) - (if clients - ;; Don't use `server-edit' because we do not want to - ;; show another buffer belonging to another client. - ;; See https://github.com/magit/magit/issues/2197. - (server-done) - (kill-buffer)))) - (when pid - (let ((default-directory dir)) - (process-file "kill" nil nil nil - "-s" (if cancel "USR2" "USR1") pid))) - (when (and winconf (eq (window-configuration-frame winconf) - (selected-frame))) - (set-window-configuration winconf)))) - -;;; Mode - -(defvar-keymap with-editor-mode-map - "C-c C-c" #'with-editor-finish - "<remap> <server-edit>" #'with-editor-finish - "<remap> <evil-save-and-close>" #'with-editor-finish - "<remap> <evil-save-modified-and-close>" #'with-editor-finish - "C-c C-k" #'with-editor-cancel - "<remap> <kill-buffer>" #'with-editor-cancel - "<remap> <ido-kill-buffer>" #'with-editor-cancel - "<remap> <iswitchb-kill-buffer>" #'with-editor-cancel - "<remap> <evil-quit>" #'with-editor-cancel) - -(define-minor-mode with-editor-mode - "Edit a file as the $EDITOR of an external process." - :lighter with-editor-mode-lighter - ;; Protect the user from killing the buffer without using - ;; either `with-editor-finish' or `with-editor-cancel', - ;; and from removing the key bindings for these commands. - (unless with-editor-mode - (user-error "With-Editor mode cannot be turned off")) - (add-hook 'kill-buffer-query-functions - #'with-editor-kill-buffer-noop nil t) - ;; `server-execute' displays a message which is not - ;; correct when using this mode. - (when with-editor-show-usage - (with-editor-usage-message))) - -(put 'with-editor-mode 'permanent-local t) - -(defun with-editor-kill-buffer-noop () - ;; We started doing this in response to #64, but it is not safe - ;; to do so, because the client has already been killed, causing - ;; `with-editor-return' (called by `with-editor-cancel') to delete - ;; the file, see #66. The reason we delete the file in the first - ;; place are https://github.com/magit/magit/issues/2258 and - ;; https://github.com/magit/magit/issues/2248. - ;; (if (memq this-command '(save-buffers-kill-terminal - ;; save-buffers-kill-emacs)) - ;; (let ((with-editor-cancel-query-functions nil)) - ;; (with-editor-cancel nil) - ;; t) - ;; ...) - ;; So go back to always doing this instead: - (user-error (substitute-command-keys (format "\ -Don't kill this buffer %S. Instead cancel using \\[with-editor-cancel]" - (current-buffer))))) - -(defvar-local with-editor-usage-message "\ -Type \\[with-editor-finish] to finish, \ -or \\[with-editor-cancel] to cancel") - -(defun with-editor-usage-message () - ;; Run after `server-execute', which is run using - ;; a timer which starts immediately. - (let ((buffer (current-buffer))) - (run-with-timer - 0.05 nil - (lambda () - (with-current-buffer buffer - (message (substitute-command-keys with-editor-usage-message))))))) - -;;; Wrappers - -(defvar with-editor--envvar nil "For internal use.") - -(defmacro with-editor (&rest body) - "Use the Emacsclient as $EDITOR while evaluating BODY. -Modify the `process-environment' for processes started in BODY, -instructing them to use the Emacsclient as $EDITOR. If optional -ENVVAR is a literal string then bind that environment variable -instead. -\n(fn [ENVVAR] BODY...)" - (declare (indent defun) (debug (body))) - `(let ((with-editor--envvar ,(if (stringp (car body)) - (pop body) - '(or with-editor--envvar "EDITOR"))) - (process-environment process-environment)) - (with-editor--setup) - ,@body)) - -(defmacro with-editor* (envvar &rest body) - "Use the Emacsclient as the editor while evaluating BODY. -Modify the `process-environment' for processes started in BODY, -instructing them to use the Emacsclient as editor. ENVVAR is the -environment variable that is exported to do so, it is evaluated -at run-time. -\n(fn [ENVVAR] BODY...)" - (declare (indent defun) (debug (sexp body))) - `(let ((with-editor--envvar ,envvar) - (process-environment process-environment)) - (with-editor--setup) - ,@body)) - -(defun with-editor--setup () - (if (or (not with-editor-emacsclient-executable) - (file-remote-p default-directory)) - (push (concat with-editor--envvar "=" with-editor-sleeping-editor) - process-environment) - ;; Make sure server-use-tcp's value is valid. - (unless (featurep 'make-network-process '(:family local)) - (setq server-use-tcp t)) - ;; Make sure the server is running. - (unless (process-live-p server-process) - (when (server-running-p server-name) - (setq server-name (format "server%s" (emacs-pid))) - (when (server-running-p server-name) - (server-force-delete server-name))) - (server-start)) - ;; Tell $EDITOR to use the Emacsclient. - (push (concat with-editor--envvar "=" - ;; Quoting is the right thing to do. Applications that - ;; fail because of that, are the ones that need fixing, - ;; e.g., by using 'eval "$EDITOR" file'. See #121. - (shell-quote-argument - ;; If users set the executable manually, they might - ;; begin the path with "~", which would get quoted. - (if (string-prefix-p "~" with-editor-emacsclient-executable) - (concat (expand-file-name "~") - (substring with-editor-emacsclient-executable 1)) - with-editor-emacsclient-executable)) - ;; Tell the process where the server file is. - (and (not server-use-tcp) - (concat " --socket-name=" - (shell-quote-argument - (expand-file-name server-name - server-socket-dir))))) - process-environment) - (when server-use-tcp - (push (concat "EMACS_SERVER_FILE=" - (expand-file-name server-name server-auth-dir)) - process-environment)) - ;; As last resort fallback to the sleeping editor. - (push (concat "ALTERNATE_EDITOR=" with-editor-sleeping-editor) - process-environment))) - -(defun with-editor-server-window () - (or (and buffer-file-name - (cdr (cl-find-if (lambda (cons) - (string-match-p (car cons) buffer-file-name)) - with-editor-server-window-alist))) - server-window)) - -(define-advice server-switch-buffer - (:around (fn &optional next-buffer &rest args) - with-editor-server-window-alist) - "Honor `with-editor-server-window-alist' (which see)." - (let ((server-window (with-current-buffer - (or next-buffer (current-buffer)) - (when with-editor-mode - (setq with-editor-previous-winconf - (current-window-configuration))) - (with-editor-server-window)))) - (apply fn next-buffer args))) - -(define-advice start-file-process - (:around (fn name buffer program &rest program-args) - with-editor-process-filter) - "When called inside a `with-editor' form and the Emacsclient -cannot be used, then give the process the filter function -`with-editor-process-filter'. To avoid overriding the filter -being added here you should use `with-editor-set-process-filter' -instead of `set-process-filter' inside `with-editor' forms. - -When the `default-directory' is located on a remote machine, -then also manipulate PROGRAM and PROGRAM-ARGS in order to set -the appropriate editor environment variable." - (if (not with-editor--envvar) - (apply fn name buffer program program-args) - (when (file-remote-p default-directory) - (unless (equal program "env") - (push program program-args) - (setq program "env")) - (push (concat with-editor--envvar "=" with-editor-sleeping-editor) - program-args)) - (let ((process (apply fn name buffer program program-args))) - (set-process-filter process #'with-editor-process-filter) - (process-put process 'default-dir default-directory) - process))) - -(advice-add #'make-process :around - #'make-process@with-editor-process-filter) -(cl-defun make-process@with-editor-process-filter - (fn &rest keys &key name buffer command coding noquery stop - connection-type filter sentinel stderr file-handler - &allow-other-keys) - "When called inside a `with-editor' form and the Emacsclient -cannot be used, then give the process the filter function -`with-editor-process-filter'. To avoid overriding the filter -being added here you should use `with-editor-set-process-filter' -instead of `set-process-filter' inside `with-editor' forms. - -When the `default-directory' is located on a remote machine and -FILE-HANDLER is non-nil, then also manipulate COMMAND in order -to set the appropriate editor environment variable." - (if (or (not file-handler) (not with-editor--envvar)) - (apply fn keys) - (when (file-remote-p default-directory) - (unless (equal (car command) "env") - (push "env" command)) - (push (concat with-editor--envvar "=" with-editor-sleeping-editor) - (cdr command))) - (let* ((filter (if filter - (lambda (process output) - (funcall filter process output) - (with-editor-process-filter process output t)) - #'with-editor-process-filter)) - (process (funcall fn - :name name - :buffer buffer - :command command - :coding coding - :noquery noquery - :stop stop - :connection-type connection-type - :filter filter - :sentinel sentinel - :stderr stderr - :file-handler file-handler))) - (process-put process 'default-dir default-directory) - process))) - -(defun with-editor-set-process-filter (process filter) - "Like `set-process-filter' but keep `with-editor-process-filter'. -Give PROCESS the new FILTER but keep `with-editor-process-filter' -if that was added earlier by the advised `start-file-process'. - -Do so by wrapping the two filter functions using a lambda, which -becomes the actual filter. It calls FILTER first, which may or -may not insert the text into the PROCESS's buffer. Then it calls -`with-editor-process-filter', passing t as NO-STANDARD-FILTER." - (set-process-filter - process - (if (eq (process-filter process) 'with-editor-process-filter) - `(lambda (proc str) - (,filter proc str) - (with-editor-process-filter proc str t)) - filter))) - -(defvar with-editor-filter-visit-hook nil) - -(defconst with-editor-sleeping-editor-regexp "^\ -WITH-EDITOR: \\([0-9]+\\) \ -OPEN \\([^]+?\\)\ -\\(?:\\([^]*\\)\\)?\ -\\(?: IN \\([^\r]+?\\)\\)?\r?$") - -(defvar with-editor--max-incomplete-length 1000) - -(defun with-editor-sleeping-editor-filter (process string) - (when-let ((incomplete (and process (process-get process 'incomplete)))) - (setq string (concat incomplete string))) - (save-match-data - (cond - ((and process (not (string-suffix-p "\n" string))) - (let ((length (length string))) - (when (> length with-editor--max-incomplete-length) - (setq string - (substring string - (- length with-editor--max-incomplete-length))))) - (process-put process 'incomplete string) - nil) - ((string-match with-editor-sleeping-editor-regexp string) - (when process - (process-put process 'incomplete nil)) - (let ((pid (match-string 1 string)) - (arg0 (match-string 2 string)) - (arg1 (match-string 3 string)) - (dir (match-string 4 string)) - file line column) - (cond ((string-match "\\`\\+\\([0-9]+\\)\\(?::\\([0-9]+\\)\\)?\\'" arg0) - (setq file arg1) - (setq line (string-to-number (match-string 1 arg0))) - (setq column (match-string 2 arg0)) - (setq column (and column (string-to-number column)))) - ((setq file arg0))) - (unless (file-name-absolute-p file) - (setq file (expand-file-name file dir))) - (when default-directory - (setq file (concat (file-remote-p default-directory) file))) - (with-current-buffer (find-file-noselect file) - (with-editor-mode 1) - (setq with-editor--pid pid) - (setq with-editor-previous-winconf - (current-window-configuration)) - (when line - (let ((pos (save-excursion - (save-restriction - (goto-char (point-min)) - (forward-line (1- line)) - (when column - (move-to-column column)) - (point))))) - (when (and (buffer-narrowed-p) - widen-automatically - (not (<= (point-min) pos (point-max)))) - (widen)) - (goto-char pos))) - (run-hooks 'with-editor-filter-visit-hook) - (funcall (or (with-editor-server-window) #'switch-to-buffer) - (current-buffer)) - (kill-local-variable 'server-window))) - nil) - (t string)))) - -(defun with-editor-process-filter - (process string &optional no-default-filter) - "Listen for edit requests by child processes." - (let ((default-directory (process-get process 'default-dir))) - (with-editor-sleeping-editor-filter process string)) - (unless no-default-filter - (internal-default-process-filter process string))) - -(define-advice server-visit-files - (:after (files _proc &optional _nowait) - with-editor-file-name-history-exclude) - "Prevent certain files from being added to `file-name-history'. -Files matching a regexp in `with-editor-file-name-history-exclude' -are prevented from being added to that list." - (pcase-dolist (`(,file . ,_) files) - (when (cl-find-if (lambda (regexp) - (string-match-p regexp file)) - with-editor-file-name-history-exclude) - (setq file-name-history (delete file file-name-history))))) - -;;; Augmentations - -;;;###autoload -(cl-defun with-editor-export-editor (&optional (envvar "EDITOR")) - "Teach subsequent commands to use current Emacs instance as editor. - -Set and export the environment variable ENVVAR, by default -\"EDITOR\". The value is automatically generated to teach -commands to use the current Emacs instance as \"the editor\". - -This works in `shell-mode', `term-mode', `eshell-mode' and -`vterm'." - (interactive (list (with-editor-read-envvar))) - (cond - ((derived-mode-p 'comint-mode 'term-mode) - (when-let ((process (get-buffer-process (current-buffer)))) - (goto-char (process-mark process)) - (process-send-string - process (format " export %s=%s\n" envvar - (shell-quote-argument with-editor-sleeping-editor))) - (while (accept-process-output process 0.1)) - (if (derived-mode-p 'term-mode) - (with-editor-set-process-filter process #'with-editor-emulate-terminal) - (add-hook 'comint-output-filter-functions #'with-editor-output-filter - nil t)))) - ((derived-mode-p 'eshell-mode) - (add-to-list 'eshell-preoutput-filter-functions - #'with-editor-output-filter) - (setenv envvar with-editor-sleeping-editor)) - ((and (derived-mode-p 'vterm-mode) - (fboundp 'vterm-send-return) - (fboundp 'vterm-send-string)) - (if with-editor-emacsclient-executable - (let ((with-editor--envvar envvar) - (process-environment process-environment)) - (with-editor--setup) - (while (accept-process-output vterm--process 0.1)) - (when-let ((v (getenv envvar))) - (vterm-send-string (format " export %s=%S" envvar v)) - (vterm-send-return)) - (when-let ((v (getenv "EMACS_SERVER_FILE"))) - (vterm-send-string (format " export EMACS_SERVER_FILE=%S" v)) - (vterm-send-return)) - (vterm-send-string "clear") - (vterm-send-return)) - (error "Cannot use sleeping editor in this buffer"))) - (t - (error "Cannot export environment variables in this buffer"))) - (message "Successfully exported %s" envvar)) - -;;;###autoload -(defun with-editor-export-git-editor () - "Like `with-editor-export-editor' but always set `$GIT_EDITOR'." - (interactive) - (with-editor-export-editor "GIT_EDITOR")) - -;;;###autoload -(defun with-editor-export-hg-editor () - "Like `with-editor-export-editor' but always set `$HG_EDITOR'." - (interactive) - (with-editor-export-editor "HG_EDITOR")) - -(defun with-editor-output-filter (string) - "Handle edit requests on behalf of `comint-mode' and `eshell-mode'." - (with-editor-sleeping-editor-filter nil string)) - -(defun with-editor-emulate-terminal (process string) - "Like `term-emulate-terminal' but also handle edit requests." - (let ((with-editor-sleeping-editor-regexp - (substring with-editor-sleeping-editor-regexp 1))) - (with-editor-sleeping-editor-filter process string)) - (term-emulate-terminal process string)) - -(defvar with-editor-envvars '("EDITOR" "GIT_EDITOR" "HG_EDITOR")) - -(cl-defun with-editor-read-envvar - (&optional (prompt "Set environment variable") - (default "EDITOR")) - (let ((reply (completing-read (if default - (format "%s (%s): " prompt default) - (concat prompt ": ")) - with-editor-envvars nil nil nil nil default))) - (if (string= reply "") (user-error "Nothing selected") reply))) - -;;;###autoload -(define-minor-mode shell-command-with-editor-mode - "Teach `shell-command' to use current Emacs instance as editor. - -Teach `shell-command', and all commands that ultimately call that -command, to use the current Emacs instance as editor by executing -\"EDITOR=CLIENT COMMAND&\" instead of just \"COMMAND&\". - -CLIENT is automatically generated; EDITOR=CLIENT instructs -COMMAND to use to the current Emacs instance as \"the editor\", -assuming no other variable overrides the effect of \"$EDITOR\". -CLIENT may be the path to an appropriate emacsclient executable -with arguments, or a script which also works over Tramp. - -Alternatively you can use the `with-editor-async-shell-command', -which also allows the use of another variable instead of -\"EDITOR\"." - :global t) - -;;;###autoload -(defun with-editor-async-shell-command - (command &optional output-buffer error-buffer envvar) - "Like `async-shell-command' but with `$EDITOR' set. - -Execute string \"ENVVAR=CLIENT COMMAND\" in an inferior shell; -display output, if any. With a prefix argument prompt for an -environment variable, otherwise the default \"EDITOR\" variable -is used. With a negative prefix argument additionally insert -the COMMAND's output at point. - -CLIENT is automatically generated; ENVVAR=CLIENT instructs -COMMAND to use to the current Emacs instance as \"the editor\", -assuming it respects ENVVAR as an \"EDITOR\"-like variable. -CLIENT may be the path to an appropriate emacsclient executable -with arguments, or a script which also works over Tramp. - -Also see `async-shell-command' and `shell-command'." - (interactive (with-editor-shell-command-read-args "Async shell command: " t)) - (let ((with-editor--envvar envvar)) - (with-editor - (async-shell-command command output-buffer error-buffer)))) - -;;;###autoload -(defun with-editor-shell-command - (command &optional output-buffer error-buffer envvar) - "Like `shell-command' or `with-editor-async-shell-command'. -If COMMAND ends with \"&\" behave like the latter, -else like the former." - (interactive (with-editor-shell-command-read-args "Shell command: ")) - (if (string-match "&[ \t]*\\'" command) - (with-editor-async-shell-command - command output-buffer error-buffer envvar) - (shell-command command output-buffer error-buffer))) - -(defun with-editor-shell-command-read-args (prompt &optional async) - (let ((command (read-shell-command - prompt nil nil - (let ((filename (or buffer-file-name - (and (eq major-mode 'dired-mode) - (dired-get-filename nil t))))) - (and filename (file-relative-name filename)))))) - (list command - (if (or async (setq async (string-match-p "&[ \t]*\\'" command))) - (< (prefix-numeric-value current-prefix-arg) 0) - current-prefix-arg) - shell-command-default-error-buffer - (and async current-prefix-arg (with-editor-read-envvar))))) - -(define-advice shell-command - (:around (fn command &optional output-buffer error-buffer) - shell-command-with-editor-mode) - "`shell-mode' and its hook are intended for buffers in which an -interactive shell is running, but `shell-command' also turns on -that mode, even though it only runs the shell to run a single -command. The `with-editor-export-editor' hook function is only -intended to be used in buffers in which an interactive shell is -running, so it has to be removed here." - (let ((shell-mode-hook (remove 'with-editor-export-editor shell-mode-hook))) - (cond ((or (not (or with-editor--envvar shell-command-with-editor-mode)) - (not (string-suffix-p "&" command))) - (funcall fn command output-buffer error-buffer)) - ((and with-editor-shell-command-use-emacsclient - with-editor-emacsclient-executable - (not (file-remote-p default-directory))) - (with-editor (funcall fn command output-buffer error-buffer))) - (t - (funcall fn (format "%s=%s %s" - (or with-editor--envvar "EDITOR") - (shell-quote-argument with-editor-sleeping-editor) - command) - output-buffer error-buffer) - (ignore-errors - (let ((process (get-buffer-process - (or output-buffer - (get-buffer "*Async Shell Command*"))))) - (set-process-filter - process (lambda (proc str) - (comint-output-filter proc str) - (with-editor-process-filter proc str t))) - process)))))) - -;;; _ - -(defun with-editor-debug () - "Debug configuration issues. -See info node `(with-editor)Debugging' for instructions." - (interactive) - (require 'warnings) - (with-current-buffer (get-buffer-create "*with-editor-debug*") - (pop-to-buffer (current-buffer)) - (erase-buffer) - (ignore-errors (with-editor)) - (insert - (format "with-editor: %s\n" (locate-library "with-editor.el")) - (format "emacs: %s (%s)\n" - (expand-file-name invocation-name invocation-directory) - emacs-version) - "system:\n" - (format " system-type: %s\n" system-type) - (format " system-configuration: %s\n" system-configuration) - (format " system-configuration-options: %s\n" system-configuration-options) - "server:\n" - (format " server-running-p: %s\n" (server-running-p)) - (format " server-process: %S\n" server-process) - (format " server-use-tcp: %s\n" server-use-tcp) - (format " server-name: %s\n" server-name) - (format " server-socket-dir: %s\n" server-socket-dir)) - (if (and server-socket-dir (file-accessible-directory-p server-socket-dir)) - (dolist (file (directory-files server-socket-dir nil "^[^.]")) - (insert (format " %s\n" file))) - (insert (format " %s: not an accessible directory\n" - (if server-use-tcp "WARNING" "ERROR")))) - (insert (format " server-auth-dir: %s\n" server-auth-dir)) - (if (file-accessible-directory-p server-auth-dir) - (dolist (file (directory-files server-auth-dir nil "^[^.]")) - (insert (format " %s\n" file))) - (insert (format " %s: not an accessible directory\n" - (if server-use-tcp "ERROR" "WARNING")))) - (let ((val with-editor-emacsclient-executable) - (def (default-value 'with-editor-emacsclient-executable)) - (fun (let ((warning-minimum-level :error) - (warning-minimum-log-level :error)) - (with-editor-locate-emacsclient)))) - (insert "with-editor-emacsclient-executable:\n" - (format " value: %s (%s)\n" val - (and val (with-editor-emacsclient-version val))) - (format " default: %s (%s)\n" def - (and def (with-editor-emacsclient-version def))) - (format " funcall: %s (%s)\n" fun - (and fun (with-editor-emacsclient-version fun))))) - (insert "path:\n" - (format " $PATH: %s\n" (split-string (getenv "PATH") ":")) - (format " exec-path: %s\n" exec-path)) - (insert (format " with-editor-emacsclient-path:\n")) - (dolist (dir (with-editor-emacsclient-path)) - (insert (format " %s (%s)\n" dir (car (file-attributes dir)))) - (when (file-directory-p dir) - ;; Don't match emacsclientw.exe, it makes popup windows. - (dolist (exec (directory-files dir t "emacsclient\\(?:[^w]\\|\\'\\)")) - (insert (format " %s (%s)\n" exec - (with-editor-emacsclient-version exec)))))))) - -(defconst with-editor-font-lock-keywords - '(("(\\(with-\\(?:git-\\)?editor\\)\\_>" (1 'font-lock-keyword-face)))) -(font-lock-add-keywords 'emacs-lisp-mode with-editor-font-lock-keywords) - -(provide 'with-editor) -;; Local Variables: -;; indent-tabs-mode: nil -;; byte-compile-warnings: (not docstrings-control-chars) -;; End: -;;; with-editor.el ends here diff --git a/emacs/elpa/with-editor-20240618.1840/with-editor.elc b/emacs/elpa/with-editor-20240618.1840/with-editor.elc Binary files differ. diff --git a/emacs/elpa/with-editor-20240618.1840/with-editor.info b/emacs/elpa/with-editor-20240618.1840/with-editor.info @@ -1,384 +0,0 @@ -This is with-editor.info, produced by makeinfo version 6.7 from -with-editor.texi. - - Copyright (C) 2015-2024 Jonas Bernoulli - <emacs.with-editor@jonas.bernoulli.dev> - - 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 -* With-Editor: (with-editor). Using the Emacsclient as $EDITOR. -END-INFO-DIR-ENTRY - - -File: with-editor.info, Node: Top, Next: Using the With-Editor package, Up: (dir) - -With-Editor User Manual -*********************** - -The library ‘with-editor’ makes it easy to use the Emacsclient as the -‘$EDITOR’ of child processes, making sure they know how to call home. -For remote processes a substitute is provided, which communicates with -Emacs on standard output instead of using a socket as the Emacsclient -does. - - This library was written because Magit has to be able to do the above -to allow the user to edit commit messages gracefully and to edit rebase -sequences, which wouldn’t be possible at all otherwise. - - Because other packages can benefit from such functionality, this -library is made available as a separate package. It also defines some -additional functionality which makes it useful even for end-users, who -don’t use Magit or another package which uses it internally. - -This manual is for With-Editor version 3.3.3. - - Copyright (C) 2015-2024 Jonas Bernoulli - <emacs.with-editor@jonas.bernoulli.dev> - - 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: - -* Using the With-Editor package:: -* Using With-Editor as a library:: -* Debugging:: -* Function and Command Index:: -* Variable Index:: - -— The Detailed Node Listing — - -Using the With-Editor package - -* Configuring With-Editor:: -* Using With-Editor commands:: - - - -File: with-editor.info, Node: Using the With-Editor package, Next: Using With-Editor as a library, Prev: Top, Up: Top - -1 Using the With-Editor package -******************************* - -The ‘With-Editor’ package is used internally by Magit when editing -commit messages and rebase sequences. It also provides some commands -and features which are useful by themselves, even if you don’t use -Magit. - - For information about using this library in you own package, see -*note Using With-Editor as a library::. - -* Menu: - -* Configuring With-Editor:: -* Using With-Editor commands:: - - -File: with-editor.info, Node: Configuring With-Editor, Next: Using With-Editor commands, Up: Using the With-Editor package - -1.1 Configuring With-Editor -=========================== - -With-Editor tries very hard to locate a suitable ‘emacsclient’ -executable, so ideally you should never have to customize the option -‘with-editor-emacsclient-executable’. When it fails to do so, then the -most likely reason is that someone found yet another way to package -Emacs (most likely on macOS) without putting the executable on ‘$PATH’, -and we have to add another kludge to find it anyway. - - -- User Option: with-editor-emacsclient-executable - The ‘emacsclient’ executable used as the editor by child process of - this Emacs instance. By using this executable, child processes can - call home to their parent process. - - This option is automatically set at startup by looking in - ‘exec-path’, and other places where the executable could be - installed, to find the ‘emacsclient’ executable most suitable for - the current Emacs instance. - - You should *not* customize this option permanently. If you have to - do it, then you should consider that a temporary kludge and inform - the Magit maintainer as described in *note Debugging::. - - If With-Editor fails to find a suitable ‘emacsclient’ on you - system, then this should be fixed for all users at once, by - teaching ‘with-editor-locate-emacsclient’ how to do so on your - system and system like yours. Doing it this way has the advantage, - that you won’t have do it again every time you update Emacs, and - that other users who have installed Emacs the same way as you have, - won’t have to go through the same trouble. - - Note that there also is a nuclear option; setting this variable to - ‘nil’ causes the "sleeping editor" described below to be used even - for local child processes. Obviously we don’t recommend that you - use this except in "emergencies", i.e., before we had a change to - add a kludge appropriate for you setup. - - -- Function: with-editor-locate-emacsclient - The function used to set the initial value of the option - ‘with-editor-emacsclient-executable’. There’s a lot of voodoo - here. - - The ‘emacsclient’ cannot be used when using Tramp to run a process on -a remote machine. (Theoretically it could, but that would be hard to -setup, very fragile, and rather insecure). - - With-Editor provides an alternative "editor" which can be used by -remote processes in much the same way as local processes use an -‘emacsclient’ executable. This alternative is known as the "sleeping -editor" because it is implemented as a shell script which sleeps until -it receives a signal. - - -- User Option: with-editor-sleeping-editor - The sleeping editor is a shell script used as the editor of child - processes when the ‘emacsclient’ executable cannot be used. - - This fallback is used for asynchronous process started inside the - macro ‘with-editor’, when the process runs on a remote machine or - for local processes when ‘with-editor-emacsclient-executable’ is - ‘nil’. - - Where the latter uses a socket to communicate with Emacs’ server, - this substitute prints edit requests to its standard output on - which a process filter listens for such requests. As such it is - not a complete substitute for a proper ‘emacsclient’, it can only - be used as ‘$EDITOR’ of child process of the current Emacs - instance. - - Some shells do not execute traps immediately when waiting for a - child process, but by default we do use such a blocking child - process. - - If you use such a shell (e.g., ‘csh’ on FreeBSD, but not Debian), - then you have to edit this option. You can either replace ‘sh’ - with ‘bash’ (and install that), or you can use the older, less - performant implementation: - - "sh -c '\ - echo \"WITH-EDITOR: $$ OPEN $0$1 IN $(pwd)\"; \ - trap \"exit 0\" USR1; \ - trap \"exit 1\" USR2; \ - while true; do sleep 1; done'" - - Note that the unit separator character () right after the file name - ($0) is required. - - Also note that using this alternative implementation leads to a - delay of up to a second. The delay can be shortened by replacing - ‘sleep 1’ with ‘sleep 0.01’, or if your implementation does not - support floats, then by using ‘nanosleep’ instead. - - -File: with-editor.info, Node: Using With-Editor commands, Prev: Configuring With-Editor, Up: Using the With-Editor package - -1.2 Using With-Editor commands -============================== - -This section describes how to use the ‘with-editor’ library _outside_ of -Magit. You don’t need to know any of this just to create commits using -Magit. - - The commands ‘with-editor-async-shell-command’ and -‘with-editor-shell-command’ are intended as drop in replacements for -‘async-shell-command’ and ‘shell-command’. They automatically export -‘$EDITOR’ making sure the executed command uses the current Emacs -instance as "the editor". With a prefix argument these commands prompt -for an alternative environment variable such as ‘$GIT_EDITOR’. - - -- Command: with-editor-async-shell-command - This command is like ‘async-shell-command’, but it runs the shell - command with the current Emacs instance exported as ‘$EDITOR’. - - -- Command: with-editor-shell-command - This command is like ‘shell-command’, but if the shell command ends - with ‘&’ and is therefore run asynchronously, then the current - Emacs instance is exported as ‘$EDITOR’. - - To always use these variants add this to you init file: - - (keymap-global-set "<remap> <async-shell-command>" - #'with-editor-async-shell-command) - (keymap-global-set "<remap> <shell-command>" - #'with-editor-shell-command) - - Alternatively use the global ‘shell-command-with-editor-mode’. - - -- Variable: shell-command-with-editor-mode - When this mode is active, then ‘$EDITOR’ is exported whenever - ultimately ‘shell-command’ is called to asynchronously run some - shell command. This affects most variants of that command, whether - they are defined in Emacs or in some third-party package. - - The command ‘with-editor-export-editor’ exports ‘$EDITOR’ or another -such environment variable in ‘shell-mode’, ‘eshell-mode’, ‘term-mode’ -and ‘vterm-mode’ buffers. Use this Emacs command before executing a -shell command which needs the editor set, or always arrange for the -current Emacs instance to be used as editor by adding it to the -appropriate mode hooks: - - (add-hook 'shell-mode-hook 'with-editor-export-editor) - (add-hook 'eshell-mode-hook 'with-editor-export-editor) - (add-hook 'term-exec-hook 'with-editor-export-editor) - (add-hook 'vterm-mode-hook 'with-editor-export-editor) - - Some variants of this function exist; these two forms are equivalent: - - (add-hook 'shell-mode-hook - (apply-partially 'with-editor-export-editor "GIT_EDITOR")) - (add-hook 'shell-mode-hook 'with-editor-export-git-editor) - - -- Command: with-editor-export-editor - When invoked in a ‘shell-mode’, ‘eshell-mode’, ‘term-mode’ or - ‘vterm-mode’ buffer, this command teaches shell commands to use the - current Emacs instance as the editor, by exporting ‘$EDITOR’. - - -- Command: with-editor-export-git-editor - This command is like ‘with-editor-export-editor’ but exports - ‘$GIT_EDITOR’. - - -- Command: with-editor-export-hg-editor - This command is like ‘with-editor-export-editor’ but exports - ‘$HG_EDITOR’. - - -File: with-editor.info, Node: Using With-Editor as a library, Next: Debugging, Prev: Using the With-Editor package, Up: Top - -2 Using With-Editor as a library -******************************** - -This section describes how to use the ‘with-editor’ library _outside_ of -Magit to teach another package how to have its child processes call -home, just like Magit does. You don’t need to know any of this just to -create commits using Magit. You can also ignore this if you use -‘with-editor’ outside of Magit, but only as an end-user. - - For information about interactive use and options that affect both -interactive and non-interactive use, see *note Using the With-Editor -package::. - - -- Macro: with-editor &rest body - This macro arranges for the ‘emacsclient’ or the sleeping editor to - be used as the editor of child processes, effectively teaching them - to call home to the current Emacs instance when they require that - the user edits a file. - - This is done by establishing a local binding for - ‘process-environment’ and changing the value of the ‘EDITOR’ - environment variable in that scope. This affects all - (asynchronous) processes started by forms (dynamically) inside - BODY. - - If BODY begins with a literal string, then that variable is set - instead of ‘EDITOR’. - - -- Macro: with-editor envvar &rest body - This macro is like ‘with-editor’ instead that the ENVVAR argument - is required and that it is evaluated at run-time. - - -- Function: with-editor-set-process-filter process filter - This function is like ‘set-process-filter’ but ensures that adding - the new FILTER does not remove the ‘with-editor-process-filter’. - This is done by wrapping the two filter functions using a lambda, - which becomes the actual filter. It calls FILTER first, which may - or may not insert the text into the PROCESS’s buffer. Then it - calls ‘with-editor-process-filter’, passing t as - NO-STANDARD-FILTER. - - -File: with-editor.info, Node: Debugging, Next: Function and Command Index, Prev: Using With-Editor as a library, Up: Top - -3 Debugging -*********** - -With-Editor tries very hard to locate a suitable ‘emacsclient’ -executable, and then sets option ‘with-editor-emacsclient-executable’ -accordingly. In very rare cases this fails. When it does fail, then -the most likely reason is that someone found yet another way to package -Emacs (most likely on macOS) without putting the executable on ‘$PATH’, -and we have to add another kludge to find it anyway. - - If you are having problems using ‘with-editor’, e.g., you cannot -commit in Magit, then please open a new issue at -<https://github.com/magit/with-editor/issues> and provide information -about your Emacs installation. Most importantly how did you install -Emacs and what is the output of ‘M-x with-editor-debug RET’. - - -File: with-editor.info, Node: Function and Command Index, Next: Variable Index, Prev: Debugging, Up: Top - -Appendix A Function and Command Index -************************************* - - -* Menu: - -* with-editor: Using With-Editor as a library. - (line 16) -* with-editor <1>: Using With-Editor as a library. - (line 31) -* with-editor-async-shell-command: Using With-Editor commands. - (line 17) -* with-editor-export-editor: Using With-Editor commands. - (line 59) -* with-editor-export-git-editor: Using With-Editor commands. - (line 64) -* with-editor-export-hg-editor: Using With-Editor commands. - (line 68) -* with-editor-locate-emacsclient: Configuring With-Editor. - (line 41) -* with-editor-set-process-filter: Using With-Editor as a library. - (line 35) -* with-editor-shell-command: Using With-Editor commands. - (line 21) - - -File: with-editor.info, Node: Variable Index, Prev: Function and Command Index, Up: Top - -Appendix B Variable Index -************************* - - -* Menu: - -* shell-command-with-editor-mode: Using With-Editor commands. - (line 35) -* with-editor-emacsclient-executable: Configuring With-Editor. - (line 13) -* with-editor-sleeping-editor: Configuring With-Editor. - (line 56) - - - -Tag Table: -Node: Top799 -Node: Using the With-Editor package2615 -Node: Configuring With-Editor3201 -Node: Using With-Editor commands7750 -Node: Using With-Editor as a library11051 -Node: Debugging13076 -Node: Function and Command Index13968 -Node: Variable Index15466 - -End Tag Table - - -Local Variables: -coding: utf-8 -End: diff --git a/emacs/elpa/with-editor-20240609.1518/dir b/emacs/elpa/with-editor-20240623.1757/dir diff --git a/emacs/elpa/with-editor-20240609.1518/with-editor-autoloads.el b/emacs/elpa/with-editor-20240623.1757/with-editor-autoloads.el diff --git a/emacs/elpa/with-editor-20240623.1757/with-editor-pkg.el b/emacs/elpa/with-editor-20240623.1757/with-editor-pkg.el @@ -0,0 +1,15 @@ +(define-package "with-editor" "20240623.1757" "Use the Emacsclient as $EDITOR" + '((emacs "25.1") + (compat "29.1.4.5")) + :commit "322ee26d3a7d3d67840293041837b7e70cffa8d1" :authors + '(("Jonas Bernoulli" . "emacs.with-editor@jonas.bernoulli.dev")) + :maintainers + '(("Jonas Bernoulli" . "emacs.with-editor@jonas.bernoulli.dev")) + :maintainer + '("Jonas Bernoulli" . "emacs.with-editor@jonas.bernoulli.dev") + :keywords + '("processes" "terminals") + :url "https://github.com/magit/with-editor") +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/emacs/elpa/with-editor-20240623.1757/with-editor.el b/emacs/elpa/with-editor-20240623.1757/with-editor.el @@ -0,0 +1,981 @@ +;;; with-editor.el --- Use the Emacsclient as $EDITOR -*- lexical-binding:t -*- + +;; Copyright (C) 2014-2024 The Magit Project Contributors + +;; Author: Jonas Bernoulli <emacs.with-editor@jonas.bernoulli.dev> +;; Homepage: https://github.com/magit/with-editor +;; Keywords: processes terminals + +;; Package-Version: 3.3.4 +;; Package-Requires: ((emacs "25.1") (compat "29.1.4.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 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 <https://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This library makes it possible to reliably use the Emacsclient as +;; the `$EDITOR' of child processes. It makes sure that they know how +;; to call home. For remote processes a substitute is provided, which +;; communicates with Emacs on standard output/input instead of using a +;; socket as the Emacsclient does. + +;; It provides the commands `with-editor-async-shell-command' and +;; `with-editor-shell-command', which are intended as replacements +;; for `async-shell-command' and `shell-command'. They automatically +;; export `$EDITOR' making sure the executed command uses the current +;; Emacs instance as "the editor". With a prefix argument these +;; commands prompt for an alternative environment variable such as +;; `$GIT_EDITOR'. To always use these variants add this to your init +;; file: +;; +;; (keymap-global-set "<remap> <async-shell-command>" +;; #'with-editor-async-shell-command) +;; (keymap-global-set "<remap> <shell-command>" +;; #'with-editor-shell-command) + +;; Alternatively use the global `shell-command-with-editor-mode', +;; which always sets `$EDITOR' for all Emacs commands which ultimately +;; use `shell-command' to asynchronously run some shell command. + +;; The command `with-editor-export-editor' exports `$EDITOR' or +;; another such environment variable in `shell-mode', `eshell-mode', +;; `term-mode' and `vterm-mode' buffers. Use this Emacs command +;; before executing a shell command which needs the editor set, or +;; always arrange for the current Emacs instance to be used as editor +;; by adding it to the appropriate mode hooks: +;; +;; (add-hook 'shell-mode-hook #'with-editor-export-editor) +;; (add-hook 'eshell-mode-hook #'with-editor-export-editor) +;; (add-hook 'term-exec-hook #'with-editor-export-editor) +;; (add-hook 'vterm-mode-hook #'with-editor-export-editor) + +;; Some variants of this function exist, these two forms are +;; equivalent: +;; +;; (add-hook 'shell-mode-hook +;; (apply-partially #'with-editor-export-editor "GIT_EDITOR")) +;; (add-hook 'shell-mode-hook #'with-editor-export-git-editor) + +;; This library can also be used by other packages which need to use +;; the current Emacs instance as editor. In fact this library was +;; written for Magit and its `git-commit-mode' and `git-rebase-mode'. +;; Consult `git-rebase.el' and the related code in `magit-sequence.el' +;; for a simple example. + +;;; Code: + +(require 'cl-lib) +(require 'compat) +(require 'server) +(require 'shell) +(eval-when-compile (require 'subr-x)) + +(declare-function dired-get-filename "dired" + (&optional localp no-error-if-not-filep)) +(declare-function term-emulate-terminal "term" (proc str)) +(defvar eshell-preoutput-filter-functions) +(defvar git-commit-post-finish-hook) +(defvar vterm--process) +(defvar warning-minimum-level) +(defvar warning-minimum-log-level) + +;;; Options + +(defgroup with-editor nil + "Use the Emacsclient as $EDITOR." + :group 'external + :group 'server) + +(defun with-editor-locate-emacsclient () + "Search for a suitable Emacsclient executable." + (or (with-editor-locate-emacsclient-1 + (with-editor-emacsclient-path) + (length (split-string emacs-version "\\."))) + (prog1 nil (display-warning 'with-editor "\ +Cannot determine a suitable Emacsclient + +Determining an Emacsclient executable suitable for the +current Emacs instance failed. For more information +please see https://github.com/magit/magit/wiki/Emacsclient.")))) + +(defun with-editor-locate-emacsclient-1 (path depth) + (let* ((version-lst (cl-subseq (split-string emacs-version "\\.") 0 depth)) + (version-reg (concat "^" (string-join version-lst "\\.")))) + (or (locate-file + (cond ((equal (downcase invocation-name) "remacs") + "remacsclient") + ((bound-and-true-p emacsclient-program-name)) + ("emacsclient")) + path + (cl-mapcan + (lambda (v) (cl-mapcar (lambda (e) (concat v e)) exec-suffixes)) + (nconc (and (boundp 'debian-emacs-flavor) + (list (format ".%s" debian-emacs-flavor))) + (cl-mapcon (lambda (v) + (setq v (string-join (reverse v) ".")) + (list v (concat "-" v) (concat ".emacs" v))) + (reverse version-lst)) + (list "" "-snapshot" ".emacs-snapshot"))) + (lambda (exec) + (ignore-errors + (string-match-p version-reg + (with-editor-emacsclient-version exec))))) + (and (> depth 1) + (with-editor-locate-emacsclient-1 path (1- depth)))))) + +(defun with-editor-emacsclient-version (exec) + (let ((default-directory (file-name-directory exec))) + (ignore-errors + (cadr (split-string (car (process-lines exec "--version"))))))) + +(defun with-editor-emacsclient-path () + (let ((path exec-path)) + (when invocation-directory + (push (directory-file-name invocation-directory) path) + (let* ((linkname (expand-file-name invocation-name invocation-directory)) + (truename (file-chase-links linkname))) + (unless (equal truename linkname) + (push (directory-file-name (file-name-directory truename)) path))) + (when (eq system-type 'darwin) + (let ((dir (expand-file-name "bin" invocation-directory))) + (when (file-directory-p dir) + (push dir path))) + (when (string-search "Cellar" invocation-directory) + (let ((dir (expand-file-name "../../../bin" invocation-directory))) + (when (file-directory-p dir) + (push dir path)))))) + (cl-remove-duplicates path :test #'equal))) + +(defcustom with-editor-emacsclient-executable (with-editor-locate-emacsclient) + "The Emacsclient executable used by the `with-editor' macro." + :group 'with-editor + :type '(choice (string :tag "Executable") + (const :tag "Don't use Emacsclient" nil))) + +(defcustom with-editor-sleeping-editor "\ +sh -c '\ +printf \"\\nWITH-EDITOR: $$ OPEN $0\\037$1\\037 IN $(pwd)\\n\"; \ +sleep 604800 & sleep=$!; \ +trap \"kill $sleep; exit 0\" USR1; \ +trap \"kill $sleep; exit 1\" USR2; \ +wait $sleep'" + "The sleeping editor, used when the Emacsclient cannot be used. + +This fallback is used for asynchronous processes started inside +the macro `with-editor', when the process runs on a remote machine +or for local processes when `with-editor-emacsclient-executable' +is nil (i.e., when no suitable Emacsclient was found, or the user +decided not to use it). + +Where the latter uses a socket to communicate with Emacs' server, +this substitute prints edit requests to its standard output on +which a process filter listens for such requests. As such it is +not a complete substitute for a proper Emacsclient, it can only +be used as $EDITOR of child process of the current Emacs instance. + +Some shells do not execute traps immediately when waiting for a +child process, but by default we do use such a blocking child +process. + +If you use such a shell (e.g., `csh' on FreeBSD, but not Debian), +then you have to edit this option. You can either replace \"sh\" +with \"bash\" (and install that), or you can use the older, less +performant implementation: + + \"sh -c '\\ + echo -e \\\"\\nWITH-EDITOR: $$ OPEN $0$1 IN $(pwd)\\n\\\"; \\ + trap \\\"exit 0\\\" USR1; \\ + trap \\\"exit 1\" USR2; \\ + while true; do sleep 1; done'\" + +Note that the two unit separator characters () right after $0 +and $1 are required. Normally $0 is the file name and $1 is +missing or else gets ignored. But if $0 has the form \"+N[:N]\", +then it is treated as a position in the file and $1 is expected +to be the file. + +Also note that using this alternative implementation leads to a +delay of up to a second. The delay can be shortened by replacing +\"sleep 1\" with \"sleep 0.01\", or if your implementation does +not support floats, then by using \"nanosleep\" instead." + :package-version '(with-editor . "2.8.0") + :group 'with-editor + :type 'string) + +(defcustom with-editor-finish-query-functions nil + "List of functions called to query before finishing session. + +The buffer in question is current while the functions are called. +If any of them returns nil, then the session is not finished 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 that and return non-nil." + :group 'with-editor + :type 'hook) +(put 'with-editor-finish-query-functions 'permanent-local t) + +(defcustom with-editor-cancel-query-functions nil + "List of functions called to query before canceling session. + +The buffer in question is current while the functions are called. +If any of them returns nil, then the session is not canceled 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 canceling the session despite issues. Functions should +usually honor that and return non-nil." + :group 'with-editor + :type 'hook) +(put 'with-editor-cancel-query-functions 'permanent-local t) + +(defcustom with-editor-mode-lighter " WE" + "The mode-line lighter of the With-Editor mode." + :group 'with-editor + :type '(choice (const :tag "No lighter" "") string)) + +(defvar with-editor-server-window-alist nil + "Alist of filename patterns vs corresponding `server-window'. + +Each element looks like (REGEXP . FUNCTION). Files matching +REGEXP are selected using FUNCTION instead of the default in +`server-window'. + +Note that when a package adds an entry here then it probably +has a reason to disrespect `server-window' and it likely is +not a good idea to change such entries.") + +(defvar with-editor-file-name-history-exclude nil + "List of regexps for filenames `server-visit' should not remember. +When a filename matches any of the regexps, then `server-visit' +does not add it to the variable `file-name-history', which is +used when reading a filename in the minibuffer.") + +(defcustom with-editor-shell-command-use-emacsclient t + "Whether to use the emacsclient when running shell commands. + +This affects `with-editor-async-shell-command' and, if the input +ends with \"&\" `with-editor-shell-command' . + +If `shell-command-with-editor-mode' is enabled, then it also +affects `shell-command-async' and, if the input ends with \"&\" +`shell-command'. + +This is a temporary kludge that lets you choose between two +possible defects, the ones described in the issues #23 and #40. + +When t, then use the emacsclient. This has the disadvantage that +`with-editor-mode' won't be enabled because we don't know whether +this package was involved at all in the call to the emacsclient, +and when it is not, then we really should. The problem is that +the emacsclient doesn't pass along any environment variables to +the server. This will hopefully be fixed in Emacs eventually. + +When nil, then use the sleeping editor. Because in this case we +know that this package is involved, we can enable the mode. But +this makes it necessary that you invoke $EDITOR in shell scripts +like so: + + eval \"$EDITOR\" file + +And some tools that do not handle $EDITOR properly also break." + :package-version '(with-editor . "2.7.1") + :group 'with-editor + :type 'boolean) + +;;; Mode Commands + +(defvar with-editor-pre-finish-hook nil) +(defvar with-editor-pre-cancel-hook nil) +(defvar with-editor-post-finish-hook nil) +(defvar with-editor-post-finish-hook-1 nil) +(defvar with-editor-post-cancel-hook nil) +(defvar with-editor-post-cancel-hook-1 nil) +(defvar with-editor-cancel-alist nil) +(put 'with-editor-pre-finish-hook 'permanent-local t) +(put 'with-editor-pre-cancel-hook 'permanent-local t) +(put 'with-editor-post-finish-hook 'permanent-local t) +(put 'with-editor-post-cancel-hook 'permanent-local t) + +(defvar-local with-editor-show-usage t) +(defvar-local with-editor-cancel-message nil) +(defvar-local with-editor-previous-winconf nil) +(put 'with-editor-cancel-message 'permanent-local t) +(put 'with-editor-previous-winconf 'permanent-local t) + +(defvar-local with-editor--pid nil "For internal use.") +(put 'with-editor--pid 'permanent-local t) + +(defun with-editor-finish (force) + "Finish the current edit session." + (interactive "P") + (when (run-hook-with-args-until-failure + 'with-editor-finish-query-functions force) + (let ((post-finish-hook with-editor-post-finish-hook) + (post-commit-hook (bound-and-true-p git-commit-post-finish-hook)) + (dir default-directory)) + (run-hooks 'with-editor-pre-finish-hook) + (with-editor-return nil) + (accept-process-output nil 0.1) + (with-temp-buffer + (setq default-directory dir) + (setq-local with-editor-post-finish-hook post-finish-hook) + (when post-commit-hook + (setq-local git-commit-post-finish-hook post-commit-hook)) + (run-hooks 'with-editor-post-finish-hook))))) + +(defun with-editor-cancel (force) + "Cancel the current edit session." + (interactive "P") + (when (run-hook-with-args-until-failure + 'with-editor-cancel-query-functions force) + (let ((message with-editor-cancel-message)) + (when (functionp message) + (setq message (funcall message))) + (let ((post-cancel-hook with-editor-post-cancel-hook) + (with-editor-cancel-alist nil) + (dir default-directory)) + (run-hooks 'with-editor-pre-cancel-hook) + (with-editor-return t) + (accept-process-output nil 0.1) + (with-temp-buffer + (setq default-directory dir) + (setq-local with-editor-post-cancel-hook post-cancel-hook) + (run-hooks 'with-editor-post-cancel-hook))) + (message (or message "Canceled by user"))))) + +(defun with-editor-return (cancel) + (let ((winconf with-editor-previous-winconf) + (clients server-buffer-clients) + (dir default-directory) + (pid with-editor--pid)) + (remove-hook 'kill-buffer-query-functions + #'with-editor-kill-buffer-noop t) + (cond (cancel + (save-buffer) + (if clients + (let ((buf (current-buffer))) + (dolist (client clients) + (message "client %S" client) + (ignore-errors + (server-send-string client "-error Canceled by user")) + (delete-process client)) + (when (buffer-live-p buf) + (kill-buffer buf))) + ;; Fallback for when emacs was used as $EDITOR + ;; instead of emacsclient or the sleeping editor. + ;; See https://github.com/magit/magit/issues/2258. + (ignore-errors (delete-file buffer-file-name)) + (kill-buffer))) + (t + (save-buffer) + (if clients + ;; Don't use `server-edit' because we do not want to + ;; show another buffer belonging to another client. + ;; See https://github.com/magit/magit/issues/2197. + (server-done) + (kill-buffer)))) + (when pid + (let ((default-directory dir)) + (process-file "kill" nil nil nil + "-s" (if cancel "USR2" "USR1") pid))) + (when (and winconf (eq (window-configuration-frame winconf) + (selected-frame))) + (set-window-configuration winconf)))) + +;;; Mode + +(defvar-keymap with-editor-mode-map + "C-c C-c" #'with-editor-finish + "<remap> <server-edit>" #'with-editor-finish + "<remap> <evil-save-and-close>" #'with-editor-finish + "<remap> <evil-save-modified-and-close>" #'with-editor-finish + "C-c C-k" #'with-editor-cancel + "<remap> <kill-buffer>" #'with-editor-cancel + "<remap> <ido-kill-buffer>" #'with-editor-cancel + "<remap> <iswitchb-kill-buffer>" #'with-editor-cancel + "<remap> <evil-quit>" #'with-editor-cancel) + +(define-minor-mode with-editor-mode + "Edit a file as the $EDITOR of an external process." + :lighter with-editor-mode-lighter + ;; Protect the user from killing the buffer without using + ;; either `with-editor-finish' or `with-editor-cancel', + ;; and from removing the key bindings for these commands. + (unless with-editor-mode + (user-error "With-Editor mode cannot be turned off")) + (add-hook 'kill-buffer-query-functions + #'with-editor-kill-buffer-noop nil t) + ;; `server-execute' displays a message which is not + ;; correct when using this mode. + (when with-editor-show-usage + (with-editor-usage-message))) + +(put 'with-editor-mode 'permanent-local t) + +(defun with-editor-kill-buffer-noop () + ;; We started doing this in response to #64, but it is not safe + ;; to do so, because the client has already been killed, causing + ;; `with-editor-return' (called by `with-editor-cancel') to delete + ;; the file, see #66. The reason we delete the file in the first + ;; place are https://github.com/magit/magit/issues/2258 and + ;; https://github.com/magit/magit/issues/2248. + ;; (if (memq this-command '(save-buffers-kill-terminal + ;; save-buffers-kill-emacs)) + ;; (let ((with-editor-cancel-query-functions nil)) + ;; (with-editor-cancel nil) + ;; t) + ;; ...) + ;; So go back to always doing this instead: + (user-error (substitute-command-keys (format "\ +Don't kill this buffer %S. Instead cancel using \\[with-editor-cancel]" + (current-buffer))))) + +(defvar-local with-editor-usage-message "\ +Type \\[with-editor-finish] to finish, \ +or \\[with-editor-cancel] to cancel") + +(defun with-editor-usage-message () + ;; Run after `server-execute', which is run using + ;; a timer which starts immediately. + (let ((buffer (current-buffer))) + (run-with-timer + 0.05 nil + (lambda () + (with-current-buffer buffer + (message (substitute-command-keys with-editor-usage-message))))))) + +;;; Wrappers + +(defvar with-editor--envvar nil "For internal use.") + +(defmacro with-editor (&rest body) + "Use the Emacsclient as $EDITOR while evaluating BODY. +Modify the `process-environment' for processes started in BODY, +instructing them to use the Emacsclient as $EDITOR. If optional +ENVVAR is a literal string then bind that environment variable +instead. +\n(fn [ENVVAR] BODY...)" + (declare (indent defun) (debug (body))) + `(let ((with-editor--envvar ,(if (stringp (car body)) + (pop body) + '(or with-editor--envvar "EDITOR"))) + (process-environment process-environment)) + (with-editor--setup) + ,@body)) + +(defmacro with-editor* (envvar &rest body) + "Use the Emacsclient as the editor while evaluating BODY. +Modify the `process-environment' for processes started in BODY, +instructing them to use the Emacsclient as editor. ENVVAR is the +environment variable that is exported to do so, it is evaluated +at run-time. +\n(fn [ENVVAR] BODY...)" + (declare (indent defun) (debug (sexp body))) + `(let ((with-editor--envvar ,envvar) + (process-environment process-environment)) + (with-editor--setup) + ,@body)) + +(defun with-editor--setup () + (if (or (not with-editor-emacsclient-executable) + (file-remote-p default-directory)) + (push (concat with-editor--envvar "=" with-editor-sleeping-editor) + process-environment) + ;; Make sure server-use-tcp's value is valid. + (unless (featurep 'make-network-process '(:family local)) + (setq server-use-tcp t)) + ;; Make sure the server is running. + (unless (process-live-p server-process) + (when (server-running-p server-name) + (setq server-name (format "server%s" (emacs-pid))) + (when (server-running-p server-name) + (server-force-delete server-name))) + (server-start)) + ;; Tell $EDITOR to use the Emacsclient. + (push (concat with-editor--envvar "=" + ;; Quoting is the right thing to do. Applications that + ;; fail because of that, are the ones that need fixing, + ;; e.g., by using 'eval "$EDITOR" file'. See #121. + (shell-quote-argument + ;; If users set the executable manually, they might + ;; begin the path with "~", which would get quoted. + (if (string-prefix-p "~" with-editor-emacsclient-executable) + (concat (expand-file-name "~") + (substring with-editor-emacsclient-executable 1)) + with-editor-emacsclient-executable)) + ;; Tell the process where the server file is. + (and (not server-use-tcp) + (concat " --socket-name=" + (shell-quote-argument + (expand-file-name server-name + server-socket-dir))))) + process-environment) + (when server-use-tcp + (push (concat "EMACS_SERVER_FILE=" + (expand-file-name server-name server-auth-dir)) + process-environment)) + ;; As last resort fallback to the sleeping editor. + (push (concat "ALTERNATE_EDITOR=" with-editor-sleeping-editor) + process-environment))) + +(defun with-editor-server-window () + (or (and buffer-file-name + (cdr (cl-find-if (lambda (cons) + (string-match-p (car cons) buffer-file-name)) + with-editor-server-window-alist))) + server-window)) + +(define-advice server-switch-buffer + (:around (fn &optional next-buffer &rest args) + with-editor-server-window-alist) + "Honor `with-editor-server-window-alist' (which see)." + (let ((server-window (with-current-buffer + (or next-buffer (current-buffer)) + (when with-editor-mode + (setq with-editor-previous-winconf + (current-window-configuration))) + (with-editor-server-window)))) + (apply fn next-buffer args))) + +(define-advice start-file-process + (:around (fn name buffer program &rest program-args) + with-editor-process-filter) + "When called inside a `with-editor' form and the Emacsclient +cannot be used, then give the process the filter function +`with-editor-process-filter'. To avoid overriding the filter +being added here you should use `with-editor-set-process-filter' +instead of `set-process-filter' inside `with-editor' forms. + +When the `default-directory' is located on a remote machine, +then also manipulate PROGRAM and PROGRAM-ARGS in order to set +the appropriate editor environment variable." + (if (not with-editor--envvar) + (apply fn name buffer program program-args) + (when (file-remote-p default-directory) + (unless (equal program "env") + (push program program-args) + (setq program "env")) + (push (concat with-editor--envvar "=" with-editor-sleeping-editor) + program-args)) + (let ((process (apply fn name buffer program program-args))) + (set-process-filter process #'with-editor-process-filter) + (process-put process 'default-dir default-directory) + process))) + +(advice-add #'make-process :around + #'make-process@with-editor-process-filter) +(cl-defun make-process@with-editor-process-filter + (fn &rest keys &key name buffer command coding noquery stop + connection-type filter sentinel stderr file-handler + &allow-other-keys) + "When called inside a `with-editor' form and the Emacsclient +cannot be used, then give the process the filter function +`with-editor-process-filter'. To avoid overriding the filter +being added here you should use `with-editor-set-process-filter' +instead of `set-process-filter' inside `with-editor' forms. + +When the `default-directory' is located on a remote machine and +FILE-HANDLER is non-nil, then also manipulate COMMAND in order +to set the appropriate editor environment variable." + (if (or (not file-handler) (not with-editor--envvar)) + (apply fn keys) + (when (file-remote-p default-directory) + (unless (equal (car command) "env") + (push "env" command)) + (push (concat with-editor--envvar "=" with-editor-sleeping-editor) + (cdr command))) + (let* ((filter (if filter + (lambda (process output) + (funcall filter process output) + (with-editor-process-filter process output t)) + #'with-editor-process-filter)) + (process (funcall fn + :name name + :buffer buffer + :command command + :coding coding + :noquery noquery + :stop stop + :connection-type connection-type + :filter filter + :sentinel sentinel + :stderr stderr + :file-handler file-handler))) + (process-put process 'default-dir default-directory) + process))) + +(defun with-editor-set-process-filter (process filter) + "Like `set-process-filter' but keep `with-editor-process-filter'. +Give PROCESS the new FILTER but keep `with-editor-process-filter' +if that was added earlier by the advised `start-file-process'. + +Do so by wrapping the two filter functions using a lambda, which +becomes the actual filter. It calls FILTER first, which may or +may not insert the text into the PROCESS's buffer. Then it calls +`with-editor-process-filter', passing t as NO-STANDARD-FILTER." + (set-process-filter + process + (if (eq (process-filter process) 'with-editor-process-filter) + `(lambda (proc str) + (,filter proc str) + (with-editor-process-filter proc str t)) + filter))) + +(defvar with-editor-filter-visit-hook nil) + +(defconst with-editor-sleeping-editor-regexp "^\ +WITH-EDITOR: \\([0-9]+\\) \ +OPEN \\([^]+?\\)\ +\\(?:\\([^]*\\)\\)?\ +\\(?: IN \\([^\r]+?\\)\\)?\r?$") + +(defvar with-editor--max-incomplete-length 1000) + +(defun with-editor-sleeping-editor-filter (process string) + (when-let ((incomplete (and process (process-get process 'incomplete)))) + (setq string (concat incomplete string))) + (save-match-data + (cond + ((and process (not (string-suffix-p "\n" string))) + (let ((length (length string))) + (when (> length with-editor--max-incomplete-length) + (setq string + (substring string + (- length with-editor--max-incomplete-length))))) + (process-put process 'incomplete string) + nil) + ((string-match with-editor-sleeping-editor-regexp string) + (when process + (process-put process 'incomplete nil)) + (let ((pid (match-string 1 string)) + (arg0 (match-string 2 string)) + (arg1 (match-string 3 string)) + (dir (match-string 4 string)) + file line column) + (cond ((string-match "\\`\\+\\([0-9]+\\)\\(?::\\([0-9]+\\)\\)?\\'" arg0) + (setq file arg1) + (setq line (string-to-number (match-string 1 arg0))) + (setq column (match-string 2 arg0)) + (setq column (and column (string-to-number column)))) + ((setq file arg0))) + (unless (file-name-absolute-p file) + (setq file (expand-file-name file dir))) + (when default-directory + (setq file (concat (file-remote-p default-directory) file))) + (with-current-buffer (find-file-noselect file) + (with-editor-mode 1) + (setq with-editor--pid pid) + (setq with-editor-previous-winconf + (current-window-configuration)) + (when line + (let ((pos (save-excursion + (save-restriction + (goto-char (point-min)) + (forward-line (1- line)) + (when column + (move-to-column column)) + (point))))) + (when (and (buffer-narrowed-p) + widen-automatically + (not (<= (point-min) pos (point-max)))) + (widen)) + (goto-char pos))) + (run-hooks 'with-editor-filter-visit-hook) + (funcall (or (with-editor-server-window) #'switch-to-buffer) + (current-buffer)) + (kill-local-variable 'server-window))) + nil) + (t string)))) + +(defun with-editor-process-filter + (process string &optional no-default-filter) + "Listen for edit requests by child processes." + (let ((default-directory (process-get process 'default-dir))) + (with-editor-sleeping-editor-filter process string)) + (unless no-default-filter + (internal-default-process-filter process string))) + +(define-advice server-visit-files + (:after (files _proc &optional _nowait) + with-editor-file-name-history-exclude) + "Prevent certain files from being added to `file-name-history'. +Files matching a regexp in `with-editor-file-name-history-exclude' +are prevented from being added to that list." + (pcase-dolist (`(,file . ,_) files) + (when (cl-find-if (lambda (regexp) + (string-match-p regexp file)) + with-editor-file-name-history-exclude) + (setq file-name-history + (delete (abbreviate-file-name file) file-name-history))))) + +;;; Augmentations + +;;;###autoload +(cl-defun with-editor-export-editor (&optional (envvar "EDITOR")) + "Teach subsequent commands to use current Emacs instance as editor. + +Set and export the environment variable ENVVAR, by default +\"EDITOR\". The value is automatically generated to teach +commands to use the current Emacs instance as \"the editor\". + +This works in `shell-mode', `term-mode', `eshell-mode' and +`vterm'." + (interactive (list (with-editor-read-envvar))) + (cond + ((derived-mode-p 'comint-mode 'term-mode) + (when-let ((process (get-buffer-process (current-buffer)))) + (goto-char (process-mark process)) + (process-send-string + process (format " export %s=%s\n" envvar + (shell-quote-argument with-editor-sleeping-editor))) + (while (accept-process-output process 0.1)) + (if (derived-mode-p 'term-mode) + (with-editor-set-process-filter process #'with-editor-emulate-terminal) + (add-hook 'comint-output-filter-functions #'with-editor-output-filter + nil t)))) + ((derived-mode-p 'eshell-mode) + (add-to-list 'eshell-preoutput-filter-functions + #'with-editor-output-filter) + (setenv envvar with-editor-sleeping-editor)) + ((and (derived-mode-p 'vterm-mode) + (fboundp 'vterm-send-return) + (fboundp 'vterm-send-string)) + (if with-editor-emacsclient-executable + (let ((with-editor--envvar envvar) + (process-environment process-environment)) + (with-editor--setup) + (while (accept-process-output vterm--process 0.1)) + (when-let ((v (getenv envvar))) + (vterm-send-string (format " export %s=%S" envvar v)) + (vterm-send-return)) + (when-let ((v (getenv "EMACS_SERVER_FILE"))) + (vterm-send-string (format " export EMACS_SERVER_FILE=%S" v)) + (vterm-send-return)) + (vterm-send-string "clear") + (vterm-send-return)) + (error "Cannot use sleeping editor in this buffer"))) + (t + (error "Cannot export environment variables in this buffer"))) + (message "Successfully exported %s" envvar)) + +;;;###autoload +(defun with-editor-export-git-editor () + "Like `with-editor-export-editor' but always set `$GIT_EDITOR'." + (interactive) + (with-editor-export-editor "GIT_EDITOR")) + +;;;###autoload +(defun with-editor-export-hg-editor () + "Like `with-editor-export-editor' but always set `$HG_EDITOR'." + (interactive) + (with-editor-export-editor "HG_EDITOR")) + +(defun with-editor-output-filter (string) + "Handle edit requests on behalf of `comint-mode' and `eshell-mode'." + (with-editor-sleeping-editor-filter nil string)) + +(defun with-editor-emulate-terminal (process string) + "Like `term-emulate-terminal' but also handle edit requests." + (let ((with-editor-sleeping-editor-regexp + (substring with-editor-sleeping-editor-regexp 1))) + (with-editor-sleeping-editor-filter process string)) + (term-emulate-terminal process string)) + +(defvar with-editor-envvars '("EDITOR" "GIT_EDITOR" "HG_EDITOR")) + +(cl-defun with-editor-read-envvar + (&optional (prompt "Set environment variable") + (default "EDITOR")) + (let ((reply (completing-read (if default + (format "%s (%s): " prompt default) + (concat prompt ": ")) + with-editor-envvars nil nil nil nil default))) + (if (string= reply "") (user-error "Nothing selected") reply))) + +;;;###autoload +(define-minor-mode shell-command-with-editor-mode + "Teach `shell-command' to use current Emacs instance as editor. + +Teach `shell-command', and all commands that ultimately call that +command, to use the current Emacs instance as editor by executing +\"EDITOR=CLIENT COMMAND&\" instead of just \"COMMAND&\". + +CLIENT is automatically generated; EDITOR=CLIENT instructs +COMMAND to use to the current Emacs instance as \"the editor\", +assuming no other variable overrides the effect of \"$EDITOR\". +CLIENT may be the path to an appropriate emacsclient executable +with arguments, or a script which also works over Tramp. + +Alternatively you can use the `with-editor-async-shell-command', +which also allows the use of another variable instead of +\"EDITOR\"." + :global t) + +;;;###autoload +(defun with-editor-async-shell-command + (command &optional output-buffer error-buffer envvar) + "Like `async-shell-command' but with `$EDITOR' set. + +Execute string \"ENVVAR=CLIENT COMMAND\" in an inferior shell; +display output, if any. With a prefix argument prompt for an +environment variable, otherwise the default \"EDITOR\" variable +is used. With a negative prefix argument additionally insert +the COMMAND's output at point. + +CLIENT is automatically generated; ENVVAR=CLIENT instructs +COMMAND to use to the current Emacs instance as \"the editor\", +assuming it respects ENVVAR as an \"EDITOR\"-like variable. +CLIENT may be the path to an appropriate emacsclient executable +with arguments, or a script which also works over Tramp. + +Also see `async-shell-command' and `shell-command'." + (interactive (with-editor-shell-command-read-args "Async shell command: " t)) + (let ((with-editor--envvar envvar)) + (with-editor + (async-shell-command command output-buffer error-buffer)))) + +;;;###autoload +(defun with-editor-shell-command + (command &optional output-buffer error-buffer envvar) + "Like `shell-command' or `with-editor-async-shell-command'. +If COMMAND ends with \"&\" behave like the latter, +else like the former." + (interactive (with-editor-shell-command-read-args "Shell command: ")) + (if (string-match "&[ \t]*\\'" command) + (with-editor-async-shell-command + command output-buffer error-buffer envvar) + (shell-command command output-buffer error-buffer))) + +(defun with-editor-shell-command-read-args (prompt &optional async) + (let ((command (read-shell-command + prompt nil nil + (let ((filename (or buffer-file-name + (and (eq major-mode 'dired-mode) + (dired-get-filename nil t))))) + (and filename (file-relative-name filename)))))) + (list command + (if (or async (setq async (string-match-p "&[ \t]*\\'" command))) + (< (prefix-numeric-value current-prefix-arg) 0) + current-prefix-arg) + shell-command-default-error-buffer + (and async current-prefix-arg (with-editor-read-envvar))))) + +(define-advice shell-command + (:around (fn command &optional output-buffer error-buffer) + shell-command-with-editor-mode) + "`shell-mode' and its hook are intended for buffers in which an +interactive shell is running, but `shell-command' also turns on +that mode, even though it only runs the shell to run a single +command. The `with-editor-export-editor' hook function is only +intended to be used in buffers in which an interactive shell is +running, so it has to be removed here." + (let ((shell-mode-hook (remove 'with-editor-export-editor shell-mode-hook))) + (cond ((or (not (or with-editor--envvar shell-command-with-editor-mode)) + (not (string-suffix-p "&" command))) + (funcall fn command output-buffer error-buffer)) + ((and with-editor-shell-command-use-emacsclient + with-editor-emacsclient-executable + (not (file-remote-p default-directory))) + (with-editor (funcall fn command output-buffer error-buffer))) + (t + (funcall fn (format "%s=%s %s" + (or with-editor--envvar "EDITOR") + (shell-quote-argument with-editor-sleeping-editor) + command) + output-buffer error-buffer) + (ignore-errors + (let ((process (get-buffer-process + (or output-buffer + (get-buffer "*Async Shell Command*"))))) + (set-process-filter + process (lambda (proc str) + (comint-output-filter proc str) + (with-editor-process-filter proc str t))) + process)))))) + +;;; _ + +(defun with-editor-debug () + "Debug configuration issues. +See info node `(with-editor)Debugging' for instructions." + (interactive) + (require 'warnings) + (with-current-buffer (get-buffer-create "*with-editor-debug*") + (pop-to-buffer (current-buffer)) + (erase-buffer) + (ignore-errors (with-editor)) + (insert + (format "with-editor: %s\n" (locate-library "with-editor.el")) + (format "emacs: %s (%s)\n" + (expand-file-name invocation-name invocation-directory) + emacs-version) + "system:\n" + (format " system-type: %s\n" system-type) + (format " system-configuration: %s\n" system-configuration) + (format " system-configuration-options: %s\n" system-configuration-options) + "server:\n" + (format " server-running-p: %s\n" (server-running-p)) + (format " server-process: %S\n" server-process) + (format " server-use-tcp: %s\n" server-use-tcp) + (format " server-name: %s\n" server-name) + (format " server-socket-dir: %s\n" server-socket-dir)) + (if (and server-socket-dir (file-accessible-directory-p server-socket-dir)) + (dolist (file (directory-files server-socket-dir nil "^[^.]")) + (insert (format " %s\n" file))) + (insert (format " %s: not an accessible directory\n" + (if server-use-tcp "WARNING" "ERROR")))) + (insert (format " server-auth-dir: %s\n" server-auth-dir)) + (if (file-accessible-directory-p server-auth-dir) + (dolist (file (directory-files server-auth-dir nil "^[^.]")) + (insert (format " %s\n" file))) + (insert (format " %s: not an accessible directory\n" + (if server-use-tcp "ERROR" "WARNING")))) + (let ((val with-editor-emacsclient-executable) + (def (default-value 'with-editor-emacsclient-executable)) + (fun (let ((warning-minimum-level :error) + (warning-minimum-log-level :error)) + (with-editor-locate-emacsclient)))) + (insert "with-editor-emacsclient-executable:\n" + (format " value: %s (%s)\n" val + (and val (with-editor-emacsclient-version val))) + (format " default: %s (%s)\n" def + (and def (with-editor-emacsclient-version def))) + (format " funcall: %s (%s)\n" fun + (and fun (with-editor-emacsclient-version fun))))) + (insert "path:\n" + (format " $PATH: %s\n" (split-string (getenv "PATH") ":")) + (format " exec-path: %s\n" exec-path)) + (insert (format " with-editor-emacsclient-path:\n")) + (dolist (dir (with-editor-emacsclient-path)) + (insert (format " %s (%s)\n" dir (car (file-attributes dir)))) + (when (file-directory-p dir) + ;; Don't match emacsclientw.exe, it makes popup windows. + (dolist (exec (directory-files dir t "emacsclient\\(?:[^w]\\|\\'\\)")) + (insert (format " %s (%s)\n" exec + (with-editor-emacsclient-version exec)))))))) + +(defconst with-editor-font-lock-keywords + '(("(\\(with-\\(?:git-\\)?editor\\)\\_>" (1 'font-lock-keyword-face)))) +(font-lock-add-keywords 'emacs-lisp-mode with-editor-font-lock-keywords) + +(provide 'with-editor) +;; Local Variables: +;; indent-tabs-mode: nil +;; byte-compile-warnings: (not docstrings-control-chars) +;; End: +;;; with-editor.el ends here diff --git a/emacs/elpa/with-editor-20240623.1757/with-editor.elc b/emacs/elpa/with-editor-20240623.1757/with-editor.elc Binary files differ. diff --git a/emacs/elpa/with-editor-20240623.1757/with-editor.info b/emacs/elpa/with-editor-20240623.1757/with-editor.info @@ -0,0 +1,384 @@ +This is with-editor.info, produced by makeinfo version 6.7 from +with-editor.texi. + + Copyright (C) 2015-2024 Jonas Bernoulli + <emacs.with-editor@jonas.bernoulli.dev> + + 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 +* With-Editor: (with-editor). Using the Emacsclient as $EDITOR. +END-INFO-DIR-ENTRY + + +File: with-editor.info, Node: Top, Next: Using the With-Editor package, Up: (dir) + +With-Editor User Manual +*********************** + +The library ‘with-editor’ makes it easy to use the Emacsclient as the +‘$EDITOR’ of child processes, making sure they know how to call home. +For remote processes a substitute is provided, which communicates with +Emacs on standard output instead of using a socket as the Emacsclient +does. + + This library was written because Magit has to be able to do the above +to allow the user to edit commit messages gracefully and to edit rebase +sequences, which wouldn’t be possible at all otherwise. + + Because other packages can benefit from such functionality, this +library is made available as a separate package. It also defines some +additional functionality which makes it useful even for end-users, who +don’t use Magit or another package which uses it internally. + +This manual is for With-Editor version 3.3.4. + + Copyright (C) 2015-2024 Jonas Bernoulli + <emacs.with-editor@jonas.bernoulli.dev> + + 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: + +* Using the With-Editor package:: +* Using With-Editor as a library:: +* Debugging:: +* Function and Command Index:: +* Variable Index:: + +— The Detailed Node Listing — + +Using the With-Editor package + +* Configuring With-Editor:: +* Using With-Editor commands:: + + + +File: with-editor.info, Node: Using the With-Editor package, Next: Using With-Editor as a library, Prev: Top, Up: Top + +1 Using the With-Editor package +******************************* + +The ‘With-Editor’ package is used internally by Magit when editing +commit messages and rebase sequences. It also provides some commands +and features which are useful by themselves, even if you don’t use +Magit. + + For information about using this library in you own package, see +*note Using With-Editor as a library::. + +* Menu: + +* Configuring With-Editor:: +* Using With-Editor commands:: + + +File: with-editor.info, Node: Configuring With-Editor, Next: Using With-Editor commands, Up: Using the With-Editor package + +1.1 Configuring With-Editor +=========================== + +With-Editor tries very hard to locate a suitable ‘emacsclient’ +executable, so ideally you should never have to customize the option +‘with-editor-emacsclient-executable’. When it fails to do so, then the +most likely reason is that someone found yet another way to package +Emacs (most likely on macOS) without putting the executable on ‘$PATH’, +and we have to add another kludge to find it anyway. + + -- User Option: with-editor-emacsclient-executable + The ‘emacsclient’ executable used as the editor by child process of + this Emacs instance. By using this executable, child processes can + call home to their parent process. + + This option is automatically set at startup by looking in + ‘exec-path’, and other places where the executable could be + installed, to find the ‘emacsclient’ executable most suitable for + the current Emacs instance. + + You should *not* customize this option permanently. If you have to + do it, then you should consider that a temporary kludge and inform + the Magit maintainer as described in *note Debugging::. + + If With-Editor fails to find a suitable ‘emacsclient’ on you + system, then this should be fixed for all users at once, by + teaching ‘with-editor-locate-emacsclient’ how to do so on your + system and system like yours. Doing it this way has the advantage, + that you won’t have do it again every time you update Emacs, and + that other users who have installed Emacs the same way as you have, + won’t have to go through the same trouble. + + Note that there also is a nuclear option; setting this variable to + ‘nil’ causes the "sleeping editor" described below to be used even + for local child processes. Obviously we don’t recommend that you + use this except in "emergencies", i.e., before we had a change to + add a kludge appropriate for you setup. + + -- Function: with-editor-locate-emacsclient + The function used to set the initial value of the option + ‘with-editor-emacsclient-executable’. There’s a lot of voodoo + here. + + The ‘emacsclient’ cannot be used when using Tramp to run a process on +a remote machine. (Theoretically it could, but that would be hard to +setup, very fragile, and rather insecure). + + With-Editor provides an alternative "editor" which can be used by +remote processes in much the same way as local processes use an +‘emacsclient’ executable. This alternative is known as the "sleeping +editor" because it is implemented as a shell script which sleeps until +it receives a signal. + + -- User Option: with-editor-sleeping-editor + The sleeping editor is a shell script used as the editor of child + processes when the ‘emacsclient’ executable cannot be used. + + This fallback is used for asynchronous process started inside the + macro ‘with-editor’, when the process runs on a remote machine or + for local processes when ‘with-editor-emacsclient-executable’ is + ‘nil’. + + Where the latter uses a socket to communicate with Emacs’ server, + this substitute prints edit requests to its standard output on + which a process filter listens for such requests. As such it is + not a complete substitute for a proper ‘emacsclient’, it can only + be used as ‘$EDITOR’ of child process of the current Emacs + instance. + + Some shells do not execute traps immediately when waiting for a + child process, but by default we do use such a blocking child + process. + + If you use such a shell (e.g., ‘csh’ on FreeBSD, but not Debian), + then you have to edit this option. You can either replace ‘sh’ + with ‘bash’ (and install that), or you can use the older, less + performant implementation: + + "sh -c '\ + echo \"WITH-EDITOR: $$ OPEN $0$1 IN $(pwd)\"; \ + trap \"exit 0\" USR1; \ + trap \"exit 1\" USR2; \ + while true; do sleep 1; done'" + + Note that the unit separator character () right after the file name + ($0) is required. + + Also note that using this alternative implementation leads to a + delay of up to a second. The delay can be shortened by replacing + ‘sleep 1’ with ‘sleep 0.01’, or if your implementation does not + support floats, then by using ‘nanosleep’ instead. + + +File: with-editor.info, Node: Using With-Editor commands, Prev: Configuring With-Editor, Up: Using the With-Editor package + +1.2 Using With-Editor commands +============================== + +This section describes how to use the ‘with-editor’ library _outside_ of +Magit. You don’t need to know any of this just to create commits using +Magit. + + The commands ‘with-editor-async-shell-command’ and +‘with-editor-shell-command’ are intended as drop in replacements for +‘async-shell-command’ and ‘shell-command’. They automatically export +‘$EDITOR’ making sure the executed command uses the current Emacs +instance as "the editor". With a prefix argument these commands prompt +for an alternative environment variable such as ‘$GIT_EDITOR’. + + -- Command: with-editor-async-shell-command + This command is like ‘async-shell-command’, but it runs the shell + command with the current Emacs instance exported as ‘$EDITOR’. + + -- Command: with-editor-shell-command + This command is like ‘shell-command’, but if the shell command ends + with ‘&’ and is therefore run asynchronously, then the current + Emacs instance is exported as ‘$EDITOR’. + + To always use these variants add this to you init file: + + (keymap-global-set "<remap> <async-shell-command>" + #'with-editor-async-shell-command) + (keymap-global-set "<remap> <shell-command>" + #'with-editor-shell-command) + + Alternatively use the global ‘shell-command-with-editor-mode’. + + -- Variable: shell-command-with-editor-mode + When this mode is active, then ‘$EDITOR’ is exported whenever + ultimately ‘shell-command’ is called to asynchronously run some + shell command. This affects most variants of that command, whether + they are defined in Emacs or in some third-party package. + + The command ‘with-editor-export-editor’ exports ‘$EDITOR’ or another +such environment variable in ‘shell-mode’, ‘eshell-mode’, ‘term-mode’ +and ‘vterm-mode’ buffers. Use this Emacs command before executing a +shell command which needs the editor set, or always arrange for the +current Emacs instance to be used as editor by adding it to the +appropriate mode hooks: + + (add-hook 'shell-mode-hook 'with-editor-export-editor) + (add-hook 'eshell-mode-hook 'with-editor-export-editor) + (add-hook 'term-exec-hook 'with-editor-export-editor) + (add-hook 'vterm-mode-hook 'with-editor-export-editor) + + Some variants of this function exist; these two forms are equivalent: + + (add-hook 'shell-mode-hook + (apply-partially 'with-editor-export-editor "GIT_EDITOR")) + (add-hook 'shell-mode-hook 'with-editor-export-git-editor) + + -- Command: with-editor-export-editor + When invoked in a ‘shell-mode’, ‘eshell-mode’, ‘term-mode’ or + ‘vterm-mode’ buffer, this command teaches shell commands to use the + current Emacs instance as the editor, by exporting ‘$EDITOR’. + + -- Command: with-editor-export-git-editor + This command is like ‘with-editor-export-editor’ but exports + ‘$GIT_EDITOR’. + + -- Command: with-editor-export-hg-editor + This command is like ‘with-editor-export-editor’ but exports + ‘$HG_EDITOR’. + + +File: with-editor.info, Node: Using With-Editor as a library, Next: Debugging, Prev: Using the With-Editor package, Up: Top + +2 Using With-Editor as a library +******************************** + +This section describes how to use the ‘with-editor’ library _outside_ of +Magit to teach another package how to have its child processes call +home, just like Magit does. You don’t need to know any of this just to +create commits using Magit. You can also ignore this if you use +‘with-editor’ outside of Magit, but only as an end-user. + + For information about interactive use and options that affect both +interactive and non-interactive use, see *note Using the With-Editor +package::. + + -- Macro: with-editor &rest body + This macro arranges for the ‘emacsclient’ or the sleeping editor to + be used as the editor of child processes, effectively teaching them + to call home to the current Emacs instance when they require that + the user edits a file. + + This is done by establishing a local binding for + ‘process-environment’ and changing the value of the ‘EDITOR’ + environment variable in that scope. This affects all + (asynchronous) processes started by forms (dynamically) inside + BODY. + + If BODY begins with a literal string, then that variable is set + instead of ‘EDITOR’. + + -- Macro: with-editor envvar &rest body + This macro is like ‘with-editor’ instead that the ENVVAR argument + is required and that it is evaluated at run-time. + + -- Function: with-editor-set-process-filter process filter + This function is like ‘set-process-filter’ but ensures that adding + the new FILTER does not remove the ‘with-editor-process-filter’. + This is done by wrapping the two filter functions using a lambda, + which becomes the actual filter. It calls FILTER first, which may + or may not insert the text into the PROCESS’s buffer. Then it + calls ‘with-editor-process-filter’, passing t as + NO-STANDARD-FILTER. + + +File: with-editor.info, Node: Debugging, Next: Function and Command Index, Prev: Using With-Editor as a library, Up: Top + +3 Debugging +*********** + +With-Editor tries very hard to locate a suitable ‘emacsclient’ +executable, and then sets option ‘with-editor-emacsclient-executable’ +accordingly. In very rare cases this fails. When it does fail, then +the most likely reason is that someone found yet another way to package +Emacs (most likely on macOS) without putting the executable on ‘$PATH’, +and we have to add another kludge to find it anyway. + + If you are having problems using ‘with-editor’, e.g., you cannot +commit in Magit, then please open a new issue at +<https://github.com/magit/with-editor/issues> and provide information +about your Emacs installation. Most importantly how did you install +Emacs and what is the output of ‘M-x with-editor-debug RET’. + + +File: with-editor.info, Node: Function and Command Index, Next: Variable Index, Prev: Debugging, Up: Top + +Appendix A Function and Command Index +************************************* + + +* Menu: + +* with-editor: Using With-Editor as a library. + (line 16) +* with-editor <1>: Using With-Editor as a library. + (line 31) +* with-editor-async-shell-command: Using With-Editor commands. + (line 17) +* with-editor-export-editor: Using With-Editor commands. + (line 59) +* with-editor-export-git-editor: Using With-Editor commands. + (line 64) +* with-editor-export-hg-editor: Using With-Editor commands. + (line 68) +* with-editor-locate-emacsclient: Configuring With-Editor. + (line 41) +* with-editor-set-process-filter: Using With-Editor as a library. + (line 35) +* with-editor-shell-command: Using With-Editor commands. + (line 21) + + +File: with-editor.info, Node: Variable Index, Prev: Function and Command Index, Up: Top + +Appendix B Variable Index +************************* + + +* Menu: + +* shell-command-with-editor-mode: Using With-Editor commands. + (line 35) +* with-editor-emacsclient-executable: Configuring With-Editor. + (line 13) +* with-editor-sleeping-editor: Configuring With-Editor. + (line 56) + + + +Tag Table: +Node: Top799 +Node: Using the With-Editor package2615 +Node: Configuring With-Editor3201 +Node: Using With-Editor commands7750 +Node: Using With-Editor as a library11051 +Node: Debugging13076 +Node: Function and Command Index13968 +Node: Variable Index15466 + +End Tag Table + + +Local Variables: +coding: utf-8 +End: