commit f115e437f4b6aaf019a2232a0c59b21b9b2608b6 parent 5c1648bc8373d63d8a38323eef24c463c8152a48 Author: Lukas Henkel <lh@entf.net> Date: Tue, 26 Dec 2023 12:11:56 +0100 Delete some packages I never actually use Diffstat:
| M | .gitignore | | | 3 | +-- |
| D | elpa/cider-1.12.0.signed | | | 3 | --- |
| D | elpa/cider-1.12.0/.circleci/config.yml | | | 160 | ------------------------------------------------------------------------------- |
| D | elpa/cider-1.12.0/.codespellrc | | | 2 | -- |
| D | elpa/cider-1.12.0/.dir-locals.el | | | 37 | ------------------------------------- |
| D | elpa/cider-1.12.0/.github/CONTRIBUTING.md | | | 56 | -------------------------------------------------------- |
| D | elpa/cider-1.12.0/.github/FUNDING.yml | | | 8 | -------- |
| D | elpa/cider-1.12.0/.github/ISSUE_TEMPLATE/bug_report.md | | | 53 | ----------------------------------------------------- |
| D | elpa/cider-1.12.0/.github/ISSUE_TEMPLATE/feature_request.md | | | 20 | -------------------- |
| D | elpa/cider-1.12.0/.github/PULL_REQUEST_TEMPLATE.md | | | 22 | ---------------------- |
| D | elpa/cider-1.12.0/.github/stale.yml | | | 62 | -------------------------------------------------------------- |
| D | elpa/cider-1.12.0/.github/workflows/spell_checking.yml | | | 33 | --------------------------------- |
| D | elpa/cider-1.12.0/.github/workflows/test.yml | | | 102 | ------------------------------------------------------------------------------- |
| D | elpa/cider-1.12.0/.projectile | | | 3 | --- |
| D | elpa/cider-1.12.0/CHANGELOG.md | | | 1770 | ------------------------------------------------------------------------------- |
| D | elpa/cider-1.12.0/Eldev | | | 59 | ----------------------------------------------------------- |
| D | elpa/cider-1.12.0/Makefile | | | 37 | ------------------------------------- |
| D | elpa/cider-1.12.0/README.md | | | 273 | ------------------------------------------------------------------------------- |
| D | elpa/cider-1.12.0/ROADMAP.md | | | 112 | ------------------------------------------------------------------------------- |
| D | elpa/cider-1.12.0/Vagrantfile | | | 8 | -------- |
| D | elpa/cider-1.12.0/cider-apropos.el | | | 210 | ------------------------------------------------------------------------------- |
| D | elpa/cider-1.12.0/cider-autoloads.el | | | 688 | ------------------------------------------------------------------------------- |
| D | elpa/cider-1.12.0/cider-browse-ns.el | | | 550 | ------------------------------------------------------------------------------- |
| D | elpa/cider-1.12.0/cider-browse-spec.el | | | 455 | ------------------------------------------------------------------------------- |
| D | elpa/cider-1.12.0/cider-cheatsheet.el | | | 577 | ------------------------------------------------------------------------------- |
| D | elpa/cider-1.12.0/cider-classpath.el | | | 109 | ------------------------------------------------------------------------------- |
| D | elpa/cider-1.12.0/cider-client.el | | | 904 | ------------------------------------------------------------------------------- |
| D | elpa/cider-1.12.0/cider-clojuredocs.el | | | 171 | ------------------------------------------------------------------------------- |
| D | elpa/cider-1.12.0/cider-common.el | | | 467 | ------------------------------------------------------------------------------- |
| D | elpa/cider-1.12.0/cider-completion-context.el | | | 122 | ------------------------------------------------------------------------------- |
| D | elpa/cider-1.12.0/cider-completion.el | | | 293 | ------------------------------------------------------------------------------- |
| D | elpa/cider-1.12.0/cider-connection.el | | | 1083 | ------------------------------------------------------------------------------- |
| D | elpa/cider-1.12.0/cider-debug.el | | | 796 | ------------------------------------------------------------------------------- |
| D | elpa/cider-1.12.0/cider-doc.el | | | 582 | ------------------------------------------------------------------------------ |
| D | elpa/cider-1.12.0/cider-docstring.el | | | 165 | ------------------------------------------------------------------------------- |
| D | elpa/cider-1.12.0/cider-eldoc.el | | | 523 | ------------------------------------------------------------------------------- |
| D | elpa/cider-1.12.0/cider-eval.el | | | 1809 | ------------------------------------------------------------------------------- |
| D | elpa/cider-1.12.0/cider-find.el | | | 285 | ------------------------------------------------------------------------------- |
| D | elpa/cider-1.12.0/cider-format.el | | | 154 | ------------------------------------------------------------------------------- |
| D | elpa/cider-1.12.0/cider-inspector.el | | | 794 | ------------------------------------------------------------------------------- |
| D | elpa/cider-1.12.0/cider-jar.el | | | 141 | ------------------------------------------------------------------------------- |
| D | elpa/cider-1.12.0/cider-log.el | | | 1429 | ------------------------------------------------------------------------------- |
| D | elpa/cider-1.12.0/cider-macroexpansion.el | | | 204 | ------------------------------------------------------------------------------- |
| D | elpa/cider-1.12.0/cider-mode.el | | | 1107 | ------------------------------------------------------------------------------- |
| D | elpa/cider-1.12.0/cider-ns.el | | | 273 | ------------------------------------------------------------------------------- |
| D | elpa/cider-1.12.0/cider-overlays.el | | | 362 | ------------------------------------------------------------------------------- |
| D | elpa/cider-1.12.0/cider-pkg.el | | | 2 | -- |
| D | elpa/cider-1.12.0/cider-popup.el | | | 157 | ------------------------------------------------------------------------------- |
| D | elpa/cider-1.12.0/cider-profile.el | | | 216 | ------------------------------------------------------------------------------- |
| D | elpa/cider-1.12.0/cider-repl-history.el | | | 721 | ------------------------------------------------------------------------------- |
| D | elpa/cider-1.12.0/cider-repl.el | | | 2069 | ------------------------------------------------------------------------------- |
| D | elpa/cider-1.12.0/cider-resolve.el | | | 130 | ------------------------------------------------------------------------------- |
| D | elpa/cider-1.12.0/cider-scratch.el | | | 100 | ------------------------------------------------------------------------------- |
| D | elpa/cider-1.12.0/cider-selector.el | | | 174 | ------------------------------------------------------------------------------- |
| D | elpa/cider-1.12.0/cider-stacktrace.el | | | 980 | ------------------------------------------------------------------------------- |
| D | elpa/cider-1.12.0/cider-test.el | | | 942 | ------------------------------------------------------------------------------- |
| D | elpa/cider-1.12.0/cider-tracing.el | | | 90 | ------------------------------------------------------------------------------- |
| D | elpa/cider-1.12.0/cider-util.el | | | 817 | ------------------------------------------------------------------------------- |
| D | elpa/cider-1.12.0/cider-xref-backend.el | | | 166 | ------------------------------------------------------------------------------- |
| D | elpa/cider-1.12.0/cider-xref.el | | | 185 | ------------------------------------------------------------------------------- |
| D | elpa/cider-1.12.0/cider.el | | | 2165 | ------------------------------------------------------------------------------- |
| D | elpa/cider-1.12.0/clojure.sh | | | 54 | ------------------------------------------------------ |
| D | elpa/cider-1.12.0/codespell.txt | | | 5 | ----- |
| D | elpa/cider-1.12.0/dev/deps.edn | | | 5 | ----- |
| D | elpa/cider-1.12.0/dev/docker-sample-project/.dir-locals.el | | | 4 | ---- |
| D | elpa/cider-1.12.0/dev/docker-sample-project/Dockerfile | | | 9 | --------- |
| D | elpa/cider-1.12.0/dev/docker-sample-project/Makefile | | | 5 | ----- |
| D | elpa/cider-1.12.0/dev/docker-sample-project/README.md | | | 14 | -------------- |
| D | elpa/cider-1.12.0/dev/docker-sample-project/project.clj | | | 5 | ----- |
| D | elpa/cider-1.12.0/dev/docker-sample-project/src/bar.clj | | | 2 | -- |
| D | elpa/cider-1.12.0/dev/docker-sample-project/src/foo.clj | | | 3 | --- |
| D | elpa/cider-1.12.0/dev/generate_html_fragments.clj | | | 33 | --------------------------------- |
| D | elpa/cider-1.12.0/dev/tramp-sample-project/Dockerfile | | | 45 | --------------------------------------------- |
| D | elpa/cider-1.12.0/dev/tramp-sample-project/Makefile | | | 10 | ---------- |
| D | elpa/cider-1.12.0/dev/tramp-sample-project/README.md | | | 26 | -------------------------- |
| D | elpa/cider-1.12.0/dev/tramp-sample-project/project.clj | | | 6 | ------ |
| D | elpa/cider-1.12.0/dev/tramp-sample-project/src/foo.clj | | | 3 | --- |
| D | elpa/cider-1.12.0/lein.sh | | | 45 | --------------------------------------------- |
| D | elpa/cider-1.12.0/nrepl-client.el | | | 1508 | ------------------------------------------------------------------------------- |
| D | elpa/cider-1.12.0/nrepl-dict.el | | | 205 | ------------------------------------------------------------------------------- |
| D | elpa/geiser-0.30.signed | | | 3 | --- |
| D | elpa/geiser-0.30/.dir-locals.el | | | 4 | ---- |
| D | elpa/geiser-0.30/README-elpa | | | 299 | ------------------------------------------------------------------------------- |
| D | elpa/geiser-0.30/dir | | | 18 | ------------------ |
| D | elpa/geiser-0.30/doc/cheat.texi | | | 251 | ------------------------------------------------------------------------------- |
| D | elpa/geiser-0.30/doc/dir | | | 18 | ------------------ |
| D | elpa/geiser-0.30/doc/geiser.css | | | 116 | ------------------------------------------------------------------------------- |
| D | elpa/geiser-0.30/doc/geiser.texi | | | 124 | ------------------------------------------------------------------------------- |
| D | elpa/geiser-0.30/doc/img/autodoc-multi.png | | | 0 | |
| D | elpa/geiser-0.30/doc/img/autodoc-req.png | | | 0 | |
| D | elpa/geiser-0.30/doc/img/autodoc-scm.png | | | 0 | |
| D | elpa/geiser-0.30/doc/img/autodoc-var.png | | | 0 | |
| D | elpa/geiser-0.30/doc/img/docstring-racket.png | | | 0 | |
| D | elpa/geiser-0.30/doc/img/docstring.png | | | 0 | |
| D | elpa/geiser-0.30/doc/img/eval-error.png | | | 0 | |
| D | elpa/geiser-0.30/doc/img/geiser-mode.png | | | 0 | |
| D | elpa/geiser-0.30/doc/img/guile-eval-error.png | | | 0 | |
| D | elpa/geiser-0.30/doc/img/mod-completion.png | | | 0 | |
| D | elpa/geiser-0.30/doc/img/repl-autodoc.png | | | 0 | |
| D | elpa/geiser-0.30/doc/img/repl-images.png | | | 0 | |
| D | elpa/geiser-0.30/doc/img/repl-menu.png | | | 0 | |
| D | elpa/geiser-0.30/doc/img/repl-mod.png | | | 0 | |
| D | elpa/geiser-0.30/doc/img/repls.png | | | 0 | |
| D | elpa/geiser-0.30/doc/index.texi | | | 14 | -------------- |
| D | elpa/geiser-0.30/doc/install.texi | | | 157 | ------------------------------------------------------------------------------- |
| D | elpa/geiser-0.30/doc/intro.texi | | | 97 | ------------------------------------------------------------------------------- |
| D | elpa/geiser-0.30/doc/macros.texi | | | 47 | ----------------------------------------------- |
| D | elpa/geiser-0.30/doc/makefile | | | 37 | ------------------------------------- |
| D | elpa/geiser-0.30/doc/parens.texi | | | 664 | ------------------------------------------------------------------------------- |
| D | elpa/geiser-0.30/doc/repl.texi | | | 534 | ------------------------------------------------------------------------------- |
| D | elpa/geiser-0.30/doc/thanks.texi | | | 92 | ------------------------------------------------------------------------------- |
| D | elpa/geiser-0.30/doc/top.texi | | | 23 | ----------------------- |
| D | elpa/geiser-0.30/geiser-autodoc.el | | | 256 | ------------------------------------------------------------------------------- |
| D | elpa/geiser-0.30/geiser-autoloads.el | | | 170 | ------------------------------------------------------------------------------- |
| D | elpa/geiser-0.30/geiser-base.el | | | 96 | ------------------------------------------------------------------------------- |
| D | elpa/geiser-0.30/geiser-capf.el | | | 95 | ------------------------------------------------------------------------------- |
| D | elpa/geiser-0.30/geiser-compile.el | | | 84 | ------------------------------------------------------------------------------- |
| D | elpa/geiser-0.30/geiser-completion.el | | | 159 | ------------------------------------------------------------------------------- |
| D | elpa/geiser-0.30/geiser-connection.el | | | 286 | ------------------------------------------------------------------------------- |
| D | elpa/geiser-0.30/geiser-custom.el | | | 80 | ------------------------------------------------------------------------------- |
| D | elpa/geiser-0.30/geiser-debug.el | | | 313 | ------------------------------------------------------------------------------- |
| D | elpa/geiser-0.30/geiser-doc.el | | | 510 | ------------------------------------------------------------------------------- |
| D | elpa/geiser-0.30/geiser-edit.el | | | 341 | ------------------------------------------------------------------------------- |
| D | elpa/geiser-0.30/geiser-eval.el | | | 225 | ------------------------------------------------------------------------------- |
| D | elpa/geiser-0.30/geiser-image.el | | | 122 | ------------------------------------------------------------------------------- |
| D | elpa/geiser-0.30/geiser-impl.el | | | 354 | ------------------------------------------------------------------------------- |
| D | elpa/geiser-0.30/geiser-log.el | | | 145 | ------------------------------------------------------------------------------- |
| D | elpa/geiser-0.30/geiser-menu.el | | | 145 | ------------------------------------------------------------------------------- |
| D | elpa/geiser-0.30/geiser-mode.el | | | 444 | ------------------------------------------------------------------------------- |
| D | elpa/geiser-0.30/geiser-pkg.el | | | 2 | -- |
| D | elpa/geiser-0.30/geiser-popup.el | | | 74 | -------------------------------------------------------------------------- |
| D | elpa/geiser-0.30/geiser-reload.el | | | 85 | ------------------------------------------------------------------------------- |
| D | elpa/geiser-0.30/geiser-repl.el | | | 1295 | ------------------------------------------------------------------------------- |
| D | elpa/geiser-0.30/geiser-syntax.el | | | 568 | ------------------------------------------------------------------------------- |
| D | elpa/geiser-0.30/geiser-table.el | | | 137 | ------------------------------------------------------------------------------- |
| D | elpa/geiser-0.30/geiser-xref.el | | | 165 | ------------------------------------------------------------------------------- |
| D | elpa/geiser-0.30/geiser.el | | | 134 | ------------------------------------------------------------------------------- |
| D | elpa/geiser-0.30/geiser.info | | | 1849 | ------------------------------------------------------------------------------- |
| D | elpa/geiser-0.30/license | | | 29 | ----------------------------- |
| D | elpa/geiser-0.30/news.org | | | 415 | ------------------------------------------------------------------------------- |
| D | elpa/geiser-0.30/readme.org | | | 224 | ------------------------------------------------------------------------------- |
| D | elpa/geiser-guile-0.28.1.signed | | | 2 | -- |
| D | elpa/geiser-guile-0.28.1/geiser-guile-autoloads.el | | | 38 | -------------------------------------- |
| D | elpa/geiser-guile-0.28.1/geiser-guile-pkg.el | | | 2 | -- |
| D | elpa/geiser-guile-0.28.1/geiser-guile.el | | | 697 | ------------------------------------------------------------------------------- |
| D | elpa/geiser-guile-0.28.1/geiser-guile.texi | | | 103 | ------------------------------------------------------------------------------- |
| D | elpa/geiser-guile-0.28.1/license | | | 29 | ----------------------------- |
| D | elpa/geiser-guile-0.28.1/readme.org | | | 71 | ----------------------------------------------------------------------- |
| D | elpa/geiser-guile-0.28.1/src/geiser/completion.scm | | | 27 | --------------------------- |
| D | elpa/geiser-guile-0.28.1/src/geiser/doc.scm | | | 258 | ------------------------------------------------------------------------------- |
| D | elpa/geiser-guile-0.28.1/src/geiser/emacs.scm | | | 60 | ------------------------------------------------------------ |
| D | elpa/geiser-guile-0.28.1/src/geiser/evaluation.scm | | | 163 | ------------------------------------------------------------------------------- |
| D | elpa/geiser-guile-0.28.1/src/geiser/modules.scm | | | 104 | ------------------------------------------------------------------------------- |
| D | elpa/geiser-guile-0.28.1/src/geiser/utils.scm | | | 52 | ---------------------------------------------------- |
| D | elpa/geiser-guile-0.28.1/src/geiser/xref.scm | | | 84 | ------------------------------------------------------------------------------- |
| D | elpa/request-0.3.3.signed | | | 2 | -- |
| D | elpa/request-0.3.3/.elpaignore | | | 3 | --- |
| D | elpa/request-0.3.3/.github/workflows/test.yml | | | 102 | ------------------------------------------------------------------------------- |
| D | elpa/request-0.3.3/Cask | | | 8 | -------- |
| D | elpa/request-0.3.3/Makefile | | | 121 | ------------------------------------------------------------------------------- |
| D | elpa/request-0.3.3/README.rst | | | 225 | ------------------------------------------------------------------------------- |
| D | elpa/request-0.3.3/request-autoloads.el | | | 33 | --------------------------------- |
| D | elpa/request-0.3.3/request-deferred.el | | | 71 | ----------------------------------------------------------------------- |
| D | elpa/request-0.3.3/request-pkg.el | | | 2 | -- |
| D | elpa/request-0.3.3/request.el | | | 1260 | ------------------------------------------------------------------------------- |
| D | elpa/request-0.3.3/tools/install-cask.sh | | | 64 | ---------------------------------------------------------------- |
| D | elpa/request-0.3.3/tools/install-evm.sh | | | 19 | ------------------- |
| D | elpa/request-0.3.3/tools/recipe | | | 1 | - |
| D | elpa/request-0.3.3/tools/retry.sh | | | 28 | ---------------------------- |
| D | elpa/vterm-20230417.424/CMakeLists.txt | | | 104 | ------------------------------------------------------------------------------- |
| D | elpa/vterm-20230417.424/elisp.c | | | 209 | ------------------------------------------------------------------------------- |
| D | elpa/vterm-20230417.424/elisp.h | | | 99 | ------------------------------------------------------------------------------- |
| D | elpa/vterm-20230417.424/emacs-module.h | | | 334 | ------------------------------------------------------------------------------- |
| D | elpa/vterm-20230417.424/etc/emacs-vterm-bash.sh | | | 55 | ------------------------------------------------------- |
| D | elpa/vterm-20230417.424/etc/emacs-vterm-zsh.sh | | | 54 | ------------------------------------------------------ |
| D | elpa/vterm-20230417.424/etc/emacs-vterm.fish | | | 67 | ------------------------------------------------------------------- |
| D | elpa/vterm-20230417.424/utf8.c | | | 69 | --------------------------------------------------------------------- |
| D | elpa/vterm-20230417.424/utf8.h | | | 12 | ------------ |
| D | elpa/vterm-20230417.424/vterm-autoloads.el | | | 81 | ------------------------------------------------------------------------------- |
| D | elpa/vterm-20230417.424/vterm-module.c | | | 1539 | ------------------------------------------------------------------------------- |
| D | elpa/vterm-20230417.424/vterm-module.h | | | 169 | ------------------------------------------------------------------------------- |
| D | elpa/vterm-20230417.424/vterm-pkg.el | | | 14 | -------------- |
| D | elpa/vterm-20230417.424/vterm.el | | | 1841 | ------------------------------------------------------------------------------- |
| M | init.el | | | 2 | +- |
184 files changed, 2 insertions(+), 47553 deletions(-)
diff --git a/.gitignore b/.gitignore @@ -33,6 +33,5 @@ var /places /.mc-lists.el elpa/pdf-tools-*/epdfinfo -elpa/vterm-*/build +elpa/pdf-tools-*/server/ /.emacs.desktop* -/elpa/pdf-tools-1.1.0/server/ diff --git a/elpa/cider-1.12.0.signed b/elpa/cider-1.12.0.signed @@ -1,2 +0,0 @@ -Good signature from 066DAFCB81E42C40 GNU ELPA Signing Agent (2019) <elpasign@elpa.gnu.org> (trust undefined) created at 2023-11-24T23:05:06+0100 using RSA -Good signature from 645357D2883A0966 GNU ELPA Signing Agent (2023) <elpasign@elpa.gnu.org> (trust undefined) created at 2023-11-24T23:05:06+0100 using EDDSA -\ No newline at end of file diff --git a/elpa/cider-1.12.0/.circleci/config.yml b/elpa/cider-1.12.0/.circleci/config.yml @@ -1,160 +0,0 @@ -version: 2.1 - -orbs: - win: circleci/windows@2.2.0 - shellcheck: circleci/shellcheck@3.2.0 - -# Default actions to perform on each Emacs version -commands: - setup: - steps: - - checkout - - run: - name: Install Eldev - command: curl -fsSL https://raw.github.com/doublep/eldev/master/webinstall/circle-eldev > x.sh && source ./x.sh - - run: - name: Install unzip - command: apt-get update && apt-get install unzip - - macos-setup: - steps: - - checkout - - run: - name: Install Emacs latest - command: | - brew install homebrew/cask/emacs - - run: - name: Install Eldev - command: curl -fsSL https://raw.github.com/doublep/eldev/master/webinstall/circle-eldev > x.sh && source ./x.sh - - setup-windows: - steps: - - checkout - - run: - name: Install Eldev - command: | - # Remove expired DST Root CA X3 certificate. Workaround - # for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=51038 - # bug on Emacs 27.2. - gci cert:\LocalMachine\Root\DAC9024F54D8F6DF94935FB1732638CA6AD77C13 - gci cert:\LocalMachine\Root\DAC9024F54D8F6DF94935FB1732638CA6AD77C13 | Remove-Item - (iwr https://raw.github.com/doublep/eldev/master/webinstall/circle-eldev.ps1).Content | powershell -command - - test: - steps: - - run: - name: Run regression tests - command: eldev -dtT -p test - lint: - steps: - - run: - name: Run Elisp-lint - command: eldev lint - - run: - name: Byte-compile .el files - command: eldev -dtT compile --warnings-as-errors - -jobs: - test-ubuntu-emacs-26: - docker: - - image: silex/emacs:26-ci - entrypoint: bash - steps: - - setup - - test - - test-ubuntu-emacs-27: - docker: - - image: silex/emacs:27-ci - entrypoint: bash - steps: - - setup - - test - - test-ubuntu-emacs-28: - docker: - - image: silex/emacs:28-ci - entrypoint: bash - steps: - - setup - - test - test-ubuntu-emacs-29: - docker: - - image: silex/emacs:29-ci - entrypoint: bash - steps: - - setup - - test - - test-ubuntu-emacs-master: - docker: - - image: silex/emacs:master-ci - entrypoint: bash - steps: - - setup - - test - - test-macos-emacs-latest: - macos: - xcode: "14.0.0" - steps: - - macos-setup - - test - - test-windows-emacs-latest: - executor: win/default - steps: - - run: - name: Install Emacs latest - command: | - choco install emacs - - setup-windows - - test - - test-shellcheck: - docker: - - image: circleci/clojure:openjdk-17-lein-2.9.5-buster - steps: - - checkout - - shellcheck/install - - shellcheck/check - - test-lint: - docker: - - image: silex/emacs:28-ci - steps: - - setup - - lint - -workflows: - version: 2.1 - ci-test-matrix: - jobs: - - test-shellcheck - - test-lint - - test-ubuntu-emacs-26: - requires: - - test-lint - - test-shellcheck - - test-ubuntu-emacs-27: - requires: - - test-lint - - test-shellcheck - - test-ubuntu-emacs-28: - requires: - - test-lint - - test-shellcheck - - test-ubuntu-emacs-29: - requires: - - test-lint - - test-shellcheck - - test-ubuntu-emacs-master: - requires: - - test-lint - - test-shellcheck - - test-windows-emacs-latest: - requires: - - test-lint - - test-shellcheck - - test-macos-emacs-latest: - requires: - - test-ubuntu-emacs-28 diff --git a/elpa/cider-1.12.0/.codespellrc b/elpa/cider-1.12.0/.codespellrc @@ -1,2 +0,0 @@ -[codespell] -skip = .git,.eldev,logo diff --git a/elpa/cider-1.12.0/.dir-locals.el b/elpa/cider-1.12.0/.dir-locals.el @@ -1,37 +0,0 @@ -;;; Directory Local Variables -;;; For more information see (info "(emacs) Directory Variables") - -((emacs-lisp-mode - (bug-reference-url-format . "https://github.com/clojure-emacs/cider/issues/%s") - (bug-reference-bug-regexp . "#\\(?2:[[:digit:]]+\\)") - (indent-tabs-mode . nil) - (fill-column . 80) - (sentence-end-double-space . t) - (emacs-lisp-docstring-fill-column . 75) - (checkdoc-symbol-words . ("top-level" "major-mode" "macroexpand-all" "print-level" "print-length")) - (checkdoc-package-keywords-flag) - (checkdoc-arguments-in-order-flag) - (checkdoc-verb-check-experimental-flag) - (elisp-lint-indent-specs . ((if-let* . 2) - (when-let* . 1) - (let* . defun) - (nrepl-dbind-response . 2) - (cider-save-marker . 1) - (cider-propertize-region . 1) - (cider-map-repls . 1) - (cider--jack-in . 1) - (cider--make-result-overlay . 1) - ;; need better solution for indenting cl-flet bindings - (insert-label . defun) ;; cl-flet - (insert-align-label . defun) ;; cl-flet - (insert-rect . defun) ;; cl-flet - (cl-defun . 2) - (with-parsed-tramp-file-name . 2) - (thread-first . 0) - (thread-last . 0) - (transient-define-prefix . defmacro) - (transient-define-suffix . defmacro))))) - -;; To use the bug-reference stuff, do: -;; (add-hook 'text-mode-hook #'bug-reference-mode) -;; (add-hook 'prog-mode-hook #'bug-reference-prog-mode) diff --git a/elpa/cider-1.12.0/.github/CONTRIBUTING.md b/elpa/cider-1.12.0/.github/CONTRIBUTING.md @@ -1,56 +0,0 @@ -# Contributing - -If you discover issues, have ideas for improvements or new features, -please report them to the [issue tracker][1] of the repository or -submit a pull request. Please, try to follow these guidelines when you -do so. - -## Issue reporting - -* Check that the issue has not already been reported. -* Check that the issue has not already been fixed in the latest code - (a.k.a. `master`). -* Be clear, concise and precise in your description of the problem. -* Open an issue with a descriptive title and a summary in grammatically correct, - complete sentences. -* Mention your Emacs version and operating system. -* Mention the CIDER version info. You can use the REPL version info, which looks like that: - -```el -;; CIDER 0.12.0snapshot (package: 20160331.421), nREPL 0.2.12 -;; Clojure 1.8.0, Java 1.8.0_31 -``` - -* Include any relevant code to the issue summary. - -### Reporting bugs - -When reporting bugs it's a good idea to go through the [Troubleshooting section -of the manual][7]. Adding information like the backtrace and the nREPL messages to -the bug report makes it easier to track down bugs. Some steps to reproduce a bug -reliably would also make a huge difference. - -## Pull requests - -* Read the [Hacking on CIDER][8] manual section. -* Read [how to properly contribute to open source projects on Github][2]. -* Use a topic branch to easily amend a pull request later, if necessary. -* Use the same coding conventions as the rest of the project. -* Verify your Emacs Lisp code with `checkdoc` (<kbd>C-c ? d</kbd>). -* Make sure that the unit tests are passing (`eldev test`). -* Make sure that there are no lint warnings (`eldev lint`). -* Write [good commit messages][3]. -* Mention related tickets in the commit messages (e.g. `[Fix #N] Add command ...`). -* Update the [changelog][6]. -* [Squash related commits together][5]. -* Open a [pull request][4] that relates to *only* one subject with a clear title - and description in grammatically correct, complete sentences. - -[1]: https://github.com/clojure-emacs/cider/issues -[2]: http://gun.io/blog/how-to-github-fork-branch-and-pull-request -[3]: http://tbaggery.com/2008/04/19/a-note-about-git-commit-messages.html -[4]: https://help.github.com/articles/using-pull-requests -[5]: http://gitready.com/advanced/2009/02/10/squashing-commits-with-rebase.html -[6]: https://github.com/clojure-emacs/cider/blob/master/CHANGELOG.md -[7]: http://cider.readthedocs.org/en/latest/troubleshooting/ -[8]: https://cider.readthedocs.io/en/latest/hacking_on_cider/ diff --git a/elpa/cider-1.12.0/.github/FUNDING.yml b/elpa/cider-1.12.0/.github/FUNDING.yml @@ -1,8 +0,0 @@ -# These are supported funding model platforms - -github: bbatsov -ko_fi: bbatsov -patreon: bbatsov -open_collective: cider -liberapay: bbatsov -custom: https://www.paypal.me/bbatsov diff --git a/elpa/cider-1.12.0/.github/ISSUE_TEMPLATE/bug_report.md b/elpa/cider-1.12.0/.github/ISSUE_TEMPLATE/bug_report.md @@ -1,53 +0,0 @@ ---- -name: Bug Report -about: Report an issue with CIDER you've discovered. ---- - -*Use the template below when reporting bugs. Please, make sure that -you're running the latest stable CIDER and that the problem you're reporting -hasn't been reported (and potentially fixed) already.* - -**Remove all of the placeholder text in your final report!** - -## Expected behavior - -## Actual behavior - -## Steps to reproduce the problem - -*This is extremely important! Providing us with a reliable way to reproduce -a problem will expedite its solution.* - -## Environment & Version information - -### CIDER version information - -*Include here the version string displayed when -CIDER's REPL is launched. Here's an example:* - -``` -;; CIDER 0.12.0snapshot (package: 20160331.421), nREPL 0.2.12 -;; Clojure 1.8.0, Java 1.8.0_31 -``` - -### Lein / Clojure CLI version - -*E.g. Lein 2.6.1* - -### Emacs version - -*E.g. 24.5* (use <kbd>M-x emacs-version</kbd> to check it if unsure) - -### Operating system - -*E.g. Fedora 23, OS X 10.11 "El Capitan", Windows 10, etc* - -### JDK distribution - -*The JDK distribution are you using (e.g. Oracle, Temurin, Corretto), and its version. (run `java -version` for obtaining this)* - -*Please note that you should be running a JDK, not a JRE.* - -*If you are using a JDK through Docker, please indicate the Docker image being used.* - -*Please note that especially on Linux, JDK sources may be absent by default and require a separate installation step.* diff --git a/elpa/cider-1.12.0/.github/ISSUE_TEMPLATE/feature_request.md b/elpa/cider-1.12.0/.github/ISSUE_TEMPLATE/feature_request.md @@ -1,20 +0,0 @@ ---- -name: Feature Request -about: Suggest new CIDER features or improvements to existing features. ---- - -**Is your feature request related to a problem? Please describe.** - -A clear and concise description of what the problem is. Ex. I'm always frustrated when [...] - -**Describe the solution you'd like** - -A clear and concise description of what you want to happen. - -**Describe alternatives you've considered** - -A clear and concise description of any alternative solutions or features you've considered. - -**Additional context** - -Add any other context or screenshots about the feature request here. diff --git a/elpa/cider-1.12.0/.github/PULL_REQUEST_TEMPLATE.md b/elpa/cider-1.12.0/.github/PULL_REQUEST_TEMPLATE.md @@ -1,22 +0,0 @@ -**Replace this placeholder text with a summary of the changes in your PR. -The more detailed you are, the better.** - ------------------ - -Before submitting the PR make sure the following things have been done (and denote this -by checking the relevant checkboxes): - -- [ ] The commits are consistent with our [contribution guidelines](../blob/master/.github/CONTRIBUTING.md) -- [ ] You've added tests (if possible) to cover your change(s) -- [ ] All tests are passing (`eldev test`) -- [ ] All code passes the linter (`eldev lint`) which is based on [`elisp-lint`](https://github.com/gonewest818/elisp-lint) and includes - - [byte-compilation](https://www.gnu.org/software/emacs/manual/html_node/elisp/Byte-Compilation.html), [`checkdoc`](https://www.gnu.org/software/emacs/manual/html_node/elisp/Tips.html), [check-declare](https://www.gnu.org/software/emacs/manual/html_node/elisp/Declaring-Functions.html), packaging metadata, indentation, and trailing whitespace checks. -- [ ] You've updated the [changelog](../blob/master/CHANGELOG.md) (if adding/changing user-visible functionality) -- [ ] You've updated the [user manual](../blob/master/doc) (if adding/changing user-visible functionality) - -Thanks! - -*If you're just starting out to hack on CIDER you might find this [section of its -manual][1] extremely useful.* - -[1]: https://docs.cider.mx/cider/contributing/hacking.html diff --git a/elpa/cider-1.12.0/.github/stale.yml b/elpa/cider-1.12.0/.github/stale.yml @@ -1,62 +0,0 @@ -# Configuration for probot-stale - https://github.com/probot/stale - -# Number of days of inactivity before an Issue or Pull Request becomes stale -daysUntilStale: 90 - -# Number of days of inactivity before an Issue or Pull Request with the stale label is closed. -# Set to false to disable. If disabled, issues still need to be closed manually, but will remain marked as stale. -daysUntilClose: 30 - -# Only issues or pull requests with all of these labels are check if stale. Defaults to `[]` (disabled) -onlyLabels: [] - -# Issues or Pull Requests with these labels will never be considered stale. Set to `[]` to disable -exemptLabels: - - "high priority" - - "good first issue" - - "pinned" - -# Set to true to ignore issues in a project (defaults to false) -exemptProjects: false - -# Set to true to ignore issues in a milestone (defaults to false) -exemptMilestones: true - -# Set to true to ignore issues with an assignee (defaults to false) -exemptAssignees: true - -# Label to use when marking as stale -staleLabel: stale - -# Comment to post when marking as stale. Set to `false` to disable -markComment: > - This issue has been automatically marked as stale because it has not had - recent activity. It will be closed if no further activity occurs. Thank you - for your contribution and understanding! - -# Comment to post when removing the stale label. -# unmarkComment: > -# Your comment here. - -# Comment to post when closing a stale Issue or Pull Request. -closeComment: > - This issues been automatically closed due to lack of activity. Feel free to re-open it - if you ever come back to it. - -# Limit the number of actions per hour, from 1-30. Default is 30 -limitPerRun: 30 - -# Limit to only `issues` or `pulls` -# only: issues - -# Optionally, specify configuration settings that are specific to just 'issues' or 'pulls': -# pulls: -# daysUntilStale: 30 -# markComment: > -# This pull request has been automatically marked as stale because it has not had -# recent activity. It will be closed if no further activity occurs. Thank you -# for your contributions. - -# issues: -# exemptLabels: -# - confirmed diff --git a/elpa/cider-1.12.0/.github/workflows/spell_checking.yml b/elpa/cider-1.12.0/.github/workflows/spell_checking.yml @@ -1,33 +0,0 @@ -name: Spell Checking - -on: [pull_request] - -jobs: - codespell: - name: Check spelling with codespell - runs-on: ubuntu-latest - strategy: - matrix: - python-version: [3.8] - steps: - - uses: actions/checkout@v2 - - name: Set up Python ${{ matrix.python-version }} - uses: actions/setup-python@v2 - with: - python-version: ${{ matrix.python-version }} - - name: Install dependencies - run: | - python -m pip install --upgrade pip - pip install codespell - if [ -f requirements.txt ]; then pip install -r requirements.txt; fi - - name: Check spelling with codespell - run: codespell --ignore-words=codespell.txt || exit 1 - misspell: - name: Check spelling with misspell - runs-on: ubuntu-latest - steps: - - uses: actions/checkout@v2 - - name: Install - run: wget -O - -q https://git.io/misspell | sh -s -- -b . - - name: Misspell - run: ./misspell -error diff --git a/elpa/cider-1.12.0/.github/workflows/test.yml b/elpa/cider-1.12.0/.github/workflows/test.yml @@ -1,102 +0,0 @@ -name: CI - -# This `on:` configuration avoids double-triggered jobs (one for `push`, one for `pull_request`). -# Pull requests will still get jobs on every commit. -# However you won't get jobs on branch pushes that lack an associated pull requests. -# On the other hand, CircleCI jobs will still be triggered, which give a useful form of feedback. -# Lastly, remember that we have a Makefile for local development - you are encouraged to use it before pushing commits. -on: - push: - branches: - - master - pull_request: - -permissions: - contents: read # to fetch code (actions/checkout) - -jobs: - integration: - # Run integration tests for all OSs and EMACS_VERSIONs. - runs-on: ${{matrix.os}} - - strategy: - matrix: - os: [macos-latest, ubuntu-latest, windows-latest] - emacs_version: ['26.3', '27.2', '28.2', '29.1'] - java_version: ['11', '17'] - - steps: - - name: Set up Emacs - if: "!startsWith (matrix.os, 'windows')" - uses: purcell/setup-emacs@master - with: - version: ${{matrix.emacs_version}} - - - name: Set up Emacs on Windows - if: startsWith (matrix.os, 'windows') - uses: jcs090218/setup-emacs-windows@master - with: - version: ${{matrix.emacs_version}} - - - name: Install Eldev - if: "!startsWith (matrix.os, 'windows')" - run: curl -fsSL https://raw.github.com/doublep/eldev/master/webinstall/github-eldev | sh - - - name: Install Eldev on MS-Windows - if: startsWith (matrix.os, 'windows') - run: | - # Remove expired DST Root CA X3 certificate. Workaround - # for https://debbugs.gnu.org/cgi/bugreport.cgi?bug=51038 - # bug on Emacs 27.2. - gci cert:\LocalMachine\Root\DAC9024F54D8F6DF94935FB1732638CA6AD77C13 - gci cert:\LocalMachine\Root\DAC9024F54D8F6DF94935FB1732638CA6AD77C13 | Remove-Item - - curl.exe -fsSL https://raw.github.com/doublep/eldev/master/webinstall/github-eldev.bat | cmd /Q - - - name: Install deps.clj on MS-Windows - if: startsWith (matrix.os, 'windows') - run: | - iwr -Uri https://raw.githubusercontent.com/borkdude/deps.clj/master/install.ps1 -outfile install_clojure.ps1 - .\install_clojure.ps1 - get-command deps.exe | split-path -parent | Out-File -FilePath $env:GITHUB_PATH -Encoding utf8 -Append - - - name: Check out the source code - uses: actions/checkout@v2 - - - name: Prepare java - uses: actions/setup-java@v3 - with: - distribution: 'temurin' - # shadow requires java 11 - java-version: ${{matrix.java_version}} - - - name: Install Clojure Tools - # Use SHA until - # https://github.com/DeLaGuardo/setup-clojure/issues/78 is - # released - uses: DeLaGuardo/setup-clojure@1376ded6747c79645e82c856f16375af5f5de307 - with: - bb: '1.0.165' - cli: '1.10.3.1013' - lein: '2.9.10' - - - uses: actions/setup-node@v3 - with: - node-version: 16 - - run: npm install shadow-cljs@2.20.13 -g - - run: npm install nbb@1.1.152 -g - - - name: Test integration - run: | - # The tests occasionally fail on macos&win in what is seems to - # be GH connectivity runner issues. We attempt to address this - # problem by rerunning the tests more than once. - eldev -p -dtTC test --test-type integration || eldev -p -dtTC test --test-type integration - - - name: Run tests that need enrich-classpath - if: "!startsWith(matrix.os, 'windows')" - run: | - cd dev; ../clojure.sh clojure -M:gen; cd - - wc -l test/File.edn - eldev -p -dtTC test --test-type enrich || eldev -p -dtTC test --test-type enrich - diff --git a/elpa/cider-1.12.0/.projectile b/elpa/cider-1.12.0/.projectile @@ -1,2 +0,0 @@ -/.cask -/packages -\ No newline at end of file diff --git a/elpa/cider-1.12.0/CHANGELOG.md b/elpa/cider-1.12.0/CHANGELOG.md @@ -1,1770 +0,0 @@ -# Changelog - -## master (unreleased) - -## 1.12.0 (2023-11-24) - -### Changes - -- [#3576](https://github.com/clojure-emacs/cider/issues/3576): CIDER [Inspector](https://docs.cider.mx/cider/debugging/inspector.html): display Java class/method/field block tags (Returns/Throws/Params info) when available. -- CIDER [Inspector](https://docs.cider.mx/cider/debugging/inspector.html#usage): introduce `1` keybinding which performs `cider-inspector-tap-at-point`. -- CIDER [Inspector](https://docs.cider.mx/cider/debugging/inspector.html#usage): introduce `o` keybinding which performs `cider-inspector-open-thing-at-point`. -- CIDER [Inspector](https://docs.cider.mx/cider/debugging/inspector.html#usage): introduce `:` keybinding which performs `cider-inspect-expr-from-inspector`. -- CIDER [Inspector](https://docs.cider.mx/cider/debugging/inspector.html): retain [`truncate-lines`](https://www.gnu.org/software/emacs/manual/html_node/emacs/Line-Truncation.html) values across screens. -- [#3580](https://github.com/clojure-emacs/cider/issues/3580): `cider-test`: make test vars in [test results reports](https://docs.cider.mx/cider/testing/test_reports.html) clickable. - - As defined in the newly introduced `cider-test-var-keymap` var. -- [#3582](https://github.com/clojure-emacs/cider/issues/3582): Handle `cider-clojure-compilation-error-phases` values that have been customized to `t`. -- [#3581](https://github.com/clojure-emacs/cider/issues/3581): Bump the injected `enrich-classpath` to [1.18.6](https://github.com/clojure-emacs/enrich-classpath/compare/v1.18.4...v1.18.6). - - Handles Clojure CLI `:paths` directly defined as `:aliases`. -- Bump the `clojure-mode` required version to [5.18.1](https://github.com/clojure-emacs/clojure-mode/blob/v5.18.1/CHANGELOG.md#5181-2023-11-24). -- Bump the injected `cider-nrepl` to [0.44.0](https://github.com/clojure-emacs/cider-nrepl/blob/44da162f51765464192ba04102398c5982f01638/CHANGELOG.md#0440-2023-11-24). - -## 1.11.1 (2023-11-11) - -### Changes - -- Bump the injected `cider-nrepl` to [0.43.3](https://github.com/clojure-emacs/cider-nrepl/blob/v0.43.3/CHANGELOG.md#0433-2023-11-11). - - Improves performance for error-handling functionality. -- Bump the injected `enrich-classpath` to [1.18.4](https://github.com/clojure-emacs/enrich-classpath/compare/v1.18.2...v1.18.4). - - Handles a Clojure CLI edge case. - -## 1.11.0 (2023-11-07) - -### New features - -- [#3565](https://github.com/clojure-emacs/cider/issues/3565): [`*cider-error*`](https://docs.cider.mx/cider/usage/dealing_with_errors.html#inspector-integration): open a given Exception in the [Inspector](https://docs.cider.mx/cider/debugging/inspector.html) by clicking it, or hitting <kbd>p</kbd>. - -### Changes - -- CIDER [Inspector](https://docs.cider.mx/cider/debugging/inspector.html): display Java class/method/field info when available. - - This info is available when [enrich-classpath](https://docs.cider.mx/cider/config/basic_config.html#use-enrich-classpath) is active. -- [#3495](https://github.com/clojure-emacs/cider/issues/3495): possibly display error overlays on [`cider-load-buffer`](https://docs.cider.mx/cider/usage/code_evaluation.html#basic-evaluation). -- `cider-popup-buffer-display`: honor `special-display-buffer-names` if customized for a given CIDER buffer name (e.g. `*cider-inspect*`), avoiding the double-rendering of the given buffer. -- [#3572](https://github.com/clojure-emacs/cider/issues/3572): `lein.sh`: honor `XDG_CACHE_HOME`. -- Bump the injected `cider-nrepl` to [0.43.1](https://github.com/clojure-emacs/cider-nrepl/blob/v0.43.1/CHANGELOG.md#0431-2023-11-07). - - Improves performance for exception handling and other use cases. - - Fixes [`cider-inspector-refresh`](https://docs.cider.mx/cider/debugging/inspector.html#usage) - - Offers better completions related to `:as-alias` under ClojureScript. - -## 1.10.0 (2023-10-31) - -### New features - -- [#3555](https://github.com/clojure-emacs/cider/pull/3555): Introduce [`cider-start-nrepl-server`](https://docs.cider.mx/cider/basics/up_and_running.html#starting-nrepl-server-without-trying-to-connect-to-it) function which does the same as `cider-jack-in` -but without connecting to the started nREPL server. - - This can help setting up more complex workflows. - -### Changes - -- Bump the injected `cider-nrepl` to [0.42.1](https://github.com/clojure-emacs/cider-nrepl/blob/v0.42.1/CHANGELOG.md#0421-2023-10-31). - - Improves performance for completions- and info-related functionality. - - Updates [Orchard](https://github.com/clojure-emacs/orchard/blob/v0.18.0/CHANGELOG.md#0180-2023-10-30) - - Improves various Inspector presentational aspects. - - Updates [Suitable](https://github.com/clojure-emacs/clj-suitable/blob/v0.5.1/CHANGELOG.md#051-2023-10-31) - - Improves keyword completion for ClojureScript. -- [#3553](https://github.com/clojure-emacs/cider/issues/3553): `cider-pprint-eval-last-sexp`, `cider-eval-last-sexp-to-repl`, `cider-pprint-eval-last-sexp-to-repl`: use error overlays to indicate failure. - - this also avoids showing an empty `*cider-result*` buffer. -- [#3554](https://github.com/clojure-emacs/cider/issues/3554): CIDER macroexpand: handle errors more gracefully. - -### Bugs fixed - -- [#3541](https://github.com/clojure-emacs/cider/issues/3541): Fix `cider-jack-in` failing with SSH remotes. -- [#3559](https://github.com/clojure-emacs/cider/issues/3559): Don't apply [dynamic syntax highlighting](https://docs.cider.mx/cider/config/syntax_highlighting.html) over buffers belonging to unrelated Sesman sessions. - -## 1.9.0 (2023-10-24) - -### New features - -- [#3529](https://github.com/clojure-emacs/cider/issues/3529): CIDER inspector: introduce `cider-inspector-previous-sibling`, `cider-inspector-next-sibling` commands ([doc](https://docs.cider.mx/cider/debugging/inspector.html#usage)). -- [#3548](https://github.com/clojure-emacs/cider/issues/3548): CIDER inspector: introduce `cider-inspector-tap-current-val` command ([doc](https://docs.cider.mx/cider/debugging/inspector.html#usage)). - -### Changes - -- [#3546](https://github.com/clojure-emacs/cider/issues/3546): Inspector: render Java items using `java-mode` syntax coloring. -- [#3521](https://github.com/clojure-emacs/cider/issues/3521): Expand `cider-clojure-compilation-regexp` to also match e.g. `Unexpected error (ExceptionInfo) macroexpanding defmulti at (src/ns.clj:1:1).`. -- Remove module info from the [CIDER error overlay](https://docs.cider.mx/cider/usage/dealing_with_errors.html#configuration). - - Example string that is now trimmed away: `(java.lang.Long is in module java.base of loader 'bootstrap'; clojure.lang.IObj is in unnamed module of loader 'app')` -- [#3522](https://github.com/clojure-emacs/cider/issues/3522): Introduce a new possible value for [`cider-use-overlays`](https://docs.cider.mx/cider/usage/code_evaluation.html#overlays): `errors-only`. - - If specified, only errors will result in an overlay being shown. -- [#3527](https://github.com/clojure-emacs/cider/issues/3527): Preserve the font size as one navigates through the CIDER inspector. -- [#3525](https://github.com/clojure-emacs/cider/issues/3525): Introduce [`cider-inline-error-message-function`](https://docs.cider.mx/cider/usage/code_evaluation.html#overlays) customization option. -- [#3528](https://github.com/clojure-emacs/cider/issues/3528): Bump the injected `cider-nrepl` to [0.41.0](https://github.com/clojure-emacs/cider-nrepl/blob/v0.41.0/CHANGELOG.md#0410-2023-10-24). - - Updates [Orchard](https://github.com/clojure-emacs/orchard/blob/v0.17.0/CHANGELOG.md#0170-2023-10-24), providing misc presentational improvements for the CIDER Inspector. - -### Bugs fixed - -- Inspector: avoid `Symbol's value as variable is void: text-scale-mode-amount` under certain Emacs clients. - -## 1.8.3 (2023-10-18) - -### Changes - -- [#2903](https://github.com/clojure-emacs/cider/issues/2903): Avoid `No comment syntax is defined` prompts. -- Bump the `clojure-mode` required version to [5.18.0](https://github.com/clojure-emacs/clojure-mode/blob/v5.18.0/CHANGELOG.md#5180-2023-10-18). - -### Bugs fixed - -- [#3533](https://github.com/clojure-emacs/cider/issues/3533): Refine Sesman session linking to accurately work on `*cider-test-report*` buffers. -- [#3539](https://github.com/clojure-emacs/cider/issues/3539): `cider-jump-to-locref-at-point`: don't jump to non-existing files. - -## 1.8.2 (2023-10-15) - -### Changes - -- Bump the injected `cider-nrepl` to [0.40.0](https://github.com/clojure-emacs/cider-nrepl/blob/v0.40.0/CHANGELOG.md#0400-2023-10-15). - - Improves the `:style/indent` `:arglist` and other key metadata propagation for ClojureScript macros. - -## 1.8.0 (2023-10-13) - -### New features - -- [#3364](https://github.com/clojure-emacs/cider/pull/3364): Update [enrich-classpath](https://docs.cider.mx/cider/config/basic_config.html#use-enrich-classpath), adding Clojure CLI compatibility, and reworking its integration into CIDER. -- [#3472](https://github.com/clojure-emacs/cider/pull/3472): render Java doc comments and arglists with an improved format, and improve Java interop type inference. - * Requires enrich-classpath to be enabled (see previous bullet point). - * A related option has been introduced: [`cider-docstring-max-lines`](https://docs.cider.mx/cider/usage/code_completion.html#configuration). -- [#3352](https://github.com/clojure-emacs/cider/pull/3352): Add [CIDER Log Mode](https://docs.cider.mx/cider/debugging/logging.html), a major mode that allows you to capture, debug, inspect and view log events emitted by Java logging frameworks. -- [#3418](https://github.com/clojure-emacs/cider/issues/3418): Introduce `cider-clojure-compilation-error-phases` ([doc](https://docs.cider.mx/cider/usage/dealing_with_errors.html#configuration)). - - This prevents stacktraces from showing up whenever the [:clojure.error/phase](https://clojure.org/reference/repl_and_main#_at_repl) indicates that it's a compilation error. -- Infer indentation specs when possible ([doc](https://docs.cider.mx/cider/indent_spec.html#indentation-inference)). -- [#2958](https://github.com/clojure-emacs/cider/issues/2958), [#3279](https://github.com/clojure-emacs/cider/issues/3279): `cider-test-run-test`: support arbitrary deftest-like forms, defns with :test metadata, and search for a `-test` counterpart for a given defn (following `cider-test-infer-test-ns` logic). - - This also makes obsolete the `cider-test-defining-forms` customization variable. -- `cider-test`: add timing information. -- `cider-test`: fail-fast by default, as controlled by the new [`cider-test-fail-fast`](https://docs.cider.mx/cider/testing/running_tests.html#fail-fast) defcustom and `cider-test-toggle-fail-fast` keybinding. -- [#3352](https://github.com/clojure-emacs/cider/pull/3496): Introduce [`cider-eval-dwim`](https://docs.cider.mx/cider/usage/cider_mode.html#key-reference). -- Add new customization variable [`cider-clojurec-eval-destination`](https://docs.cider.mx/cider/cljs/up_and_running.html#working-with-cljc-files) to allow specifying which REPL .cljc evals are sent to. -- [#3354](https://github.com/clojure-emacs/cider/issues/3354): Add new customization variable [`cider-reuse-dead-repls`](https://docs.cider.mx/cider/usage/managing_connections.html#reusing-dead-repls) to control how dead REPL buffers are reused on new connections. - -### Bugs fixed - -- [#3341](https://github.com/clojure-emacs/cider/issues/3341): Escape clojure-cli args on MS-Windows on non powershell invocations. -- [#3353](https://github.com/clojure-emacs/cider/issues/3353): Fix regression which caused new connections to prompt for reusing dead REPLs. -- [#3355](https://github.com/clojure-emacs/cider/pull/3355): Fix `cider-mode` disabling itself after a disconnect when `cider-auto-mode` is set to nil. -- [#3362](https://github.com/clojure-emacs/cider/issues/3362): Fix `sesman-restart` regression issue. -- [#3236](https://github.com/clojure-emacs/cider/issues/3236): `cider-repl-set-ns` no longer changes the repl session type from `cljs:shadow` to `clj`. -- [#3383](https://github.com/clojure-emacs/cider/issues/3383): `cider-connect-clj&cljs`: don't render `"ClojureScript REPL type:"` for JVM repls. -- [#3331](https://github.com/clojure-emacs/cider/issues/3331): `cider-eval`: never jump to spurious locations, as sometimes conveyed by nREPL. -- [#3112](https://github.com/clojure-emacs/cider/issues/3112): Fix the CIDER `xref-find-references` backend to return correct filenames. -- [#3402](https://github.com/clojure-emacs/cider/issues/3402): Fix `cider-format-connection-params` edge case for Emacs 29. -- [#3393](https://github.com/clojure-emacs/cider/issues/3393): Recompute namespace info on each shadow-cljs recompilation or evaluation. -- Recompute namespace info on each fighweel-main recompilation. -- [#3250](https://github.com/clojure-emacs/cider/issues/3250): Don't lose the CIDER session over TRAMP files. -- [#3413](https://github.com/clojure-emacs/cider/issues/3413): Make jump-to-definition work in projects needing `cider-path-translations` (i.e. Dockerized projects). -- [#2436](https://github.com/clojure-emacs/cider/issues/2436): Prevent malformed `cider-repl-history-file`s from failing `cider-jack-in`. -- [#3456](https://github.com/clojure-emacs/cider/issues/3456): Restore xref-based jump-to-definition in Babashka (and any nREPL clients not having cider-nrepl). -- [#3466](https://github.com/clojure-emacs/cider/issues/3466): Restore the usual `cider--connected-handler` performance for JVM Clojure repls. -- [#3503](https://github.com/clojure-emacs/cider/issues/3503): Make `cider-repl-set-ns` more reliable on Piggieback connections. -- Fix the `xref-find-definitions` CIDER backend to return correct filenames. -- Fix the `cider-xref-fn-deps` buttons to direct to the right file. -- Fix the `cider-find-keyword` overall reliability and correctness, particularly for ClojureScript. -- Make TRAMP functionality work when using non-standard ports. -- Fix the `cider-insert-commands-map` variable initialization. - -### Changes - -- Ensure that `cider` completion isn't used with completion styles that are currently unsupported (`initials`, `partial-completion`, `orderless`, etc). - - This restores completions for users that favor those styles - otherwise the would see bad or no completions. - - Relatedly, `cider-company-enable-fuzzy-completion` is now deprecated in favor of `cider-enable-flex-completion`. -- Improve support for multiple forms in the same line by replacing `beginning-of-defun` fn. -- [#3390](https://github.com/clojure-emacs/cider/issues/3390): Enhance `cider-connect` to show all nREPLs available ports, instead of only Leiningen ones. -- [#3408](https://github.com/clojure-emacs/cider/issues/3408): `cider-connect`: check `.nrepl-port`-like files for liveness, hiding them if they don't reflect an active port. -- Introduce [`cider-stacktrace-navigate-to-other-window`](https://docs.cider.mx/cider/usage/dealing_with_errors.html#configuration) defcustom. -- Preserve the `:cljs-repl-type` more reliably. -- Improve the presentation of `xref` data. -- [#3419](https://github.com/clojure-emacs/cider/issues/3419): Also match friendly sessions based on the buffer's ns form. -- Always match friendly sessions for `cider-ancillary-buffers` (like `*cider-error*`, `*cider-result*`, etc). -- `cider-test`: only show diffs for collections. -- `cider-inspector-def-current-val` now can suggest a var name (default none), which can be customized via [`cider-inspector-preferred-var-names`](https://docs.cider.mx/cider/debugging/inspector.html#configuration). -- The `"Member in class: "` prompt can now be optionally skipped in ido-mode by pressing `<up>` or `<down>` ([doc](https://docs.cider.mx/cider/usage/code_completion.html)). -- [#3375](https://github.com/clojure-emacs/cider/pull/3375): `cider-test`: don't render a newline between expected and actual, most times. -- Interactive evaluation: show a shorter overlay when rendering compilation errors. - - e.g., the `Syntax error compiling clojure.core/let at (foo/bar.clj:10:1)` prefix is now removed. -- Ensure there's a leading `:` when using `cider-clojure-cli-aliases`. -- Improve `nrepl-dict` error reporting. -- Bump the injected `piggieback` to [0.5.3](https://github.com/nrepl/piggieback/blob/0.5.3/CHANGES.md#053-2021-10-26). -- Bump the `clojure-mode` required version to [5.17.1](https://github.com/clojure-emacs/clojure-mode/blob/v5.17.1/CHANGELOG.md#5171-2023-09-12), and use `clojure-find-ns` more safely, which fixes issues such as #[2849](https://github.com/clojure-emacs/cider/issues/2849). -- Bump the `parseedn` require version, and wrap its usage with a more informative `user-error`. -- Bump the injected `cider-nrepl` to [0.39.1](https://github.com/clojure-emacs/cider-nrepl/blob/v0.39.1/CHANGELOG.md#0391-2023-10-12). - - Improves indentation, font-locking and other metadata support for ClojureScript. - - Updates [Orchard](https://github.com/clojure-emacs/orchard/blob/v0.16.1/CHANGELOG.md#0161-2023-10-05) - - introduces support for displaying the docstring and arglists of 'indirect' vars (e.g. `(def foo bar)`) for Clojure/Script. - - fixes xref support across deftest vars. - - Updates [Compliment](https://github.com/alexander-yakushev/compliment/blob/0.4.4/CHANGELOG.md#044-2023-10-10) - - Improves type hint propagation. - - Supports better completions for `doto`, `->`, `->>`, `some->`, and `some->>`. - - Supports better completions for var-quote (`#'some/var`). - - Supports better completions for deftype field names. - - Updates [Haystack](https://github.com/clojure-emacs/haystack/blob/v0.3.1/CHANGELOG.md#031-2023-09-29). - - Now, in `*cider-error*`, more internal stackframes will be hidden under the `tooling` category. - - Updates [Suitable](https://github.com/clojure-emacs/clj-suitable/blob/v0.5.0/CHANGELOG.md#050-2023-07-28) - - avoiding side-effecting `->` evaluation for pure-ClojureScript chains. - -## 1.7.0 (2023-03-23) - -### New features - -- [#3314](https://github.com/clojure-emacs/cider/issues/3314): Detect `nrepl+unix` sockets (say via `lein nrepl :headless :socket nrepl.sock`). -- [#3262](https://github.com/clojure-emacs/cider/issues/3262): Add navigation functionality to `n/p/f/b` keys inside the data inspector's buffer. -- [#3310](https://github.com/clojure-emacs/cider/issues/3310): Add ability to use custom coordinates in `cider-jack-in-dependencies`. -- [cider-nrepl#766](https://github.com/clojure-emacs/cider-nrepl/issues/766): Complete local bindings for ClojureScript files. -- [#3179](https://github.com/clojure-emacs/cider/issues/3179): Introduce `cider-jack-in-universal` to support jacking-in without a project from a set of pre-configured Clojure project tools. - -### Changes - -- Allow using `npx nbb` as `cider-nbb-command`. -- [#3281](https://github.com/clojure-emacs/cider/pull/3281): Replace newline chars with actual newlines in `*cider-test-report*` buffer, for prettier error messages. -- Bump the injected `cider-nrepl` to 0.30. -- [#3219](https://github.com/clojure-emacs/cider/issues/3219): Disable by default forcing the display of output when the REPL prompt is at the first line of the of the REPL window. This behavior is desirable, but very slow and rarely needed. It can be re-enabled by setting `cider-repl-display-output-before-window-boundaries` to `t`. -- [#3335](https://github.com/clojure-emacs/cider/issues/3335): Disable the Paredit binding of RET in cider-repl-mode buffers, which can cause unexpected behaviour by appearing to hang instead of evaluating forms. -- [#3307](https://github.com/clojure-emacs/cider/issues/3307): Make eldoc highlighting on emacs special forms better match the location of the point when latest `cider-nrepl` is used. - -## 1.6.0 (2022-12-21) - -### New features - -- [#3278](https://github.com/clojure-emacs/cider/pull/3278): Introduce integration tests, which also fix a long standing issue with orphaned process on MS-Windows by contracting `taskkill`, if available, to properly kill the nREPL server process tree. -- [#3061](https://github.com/clojure-emacs/cider/issues/3061): Add support for `nbb`. -- [#3249](https://github.com/clojure-emacs/cider/pull/3249): Add support for Clojure Spec 2. -- [#3247](https://github.com/clojure-emacs/cider/pull/3247): Add the `cider-stacktrace-analyze-at-point` and `cider-stacktrace-analyze-in-region` commands to view printed exceptions in the stacktrace inspector. - -### Changes - -- Bump the injected nREPL version to 1.0. -- [#3061](https://github.com/clojure-emacs/cider/issues/3061): Allow to use `cider-connect-clj` for self-hosted cljs repls (e.g. `nbb`). -- [#3291](https://github.com/clojure-emacs/cider/pull/3291): **Remove** the `'cljs-pending` `repl-type`. It is replaced by `cider-repl-cljs-upgrade-pending`. -- [#3261](https://github.com/clojure-emacs/cider/issues/3261): If user is connecting to nREPL from a TRAMP buffer, use its connection parameters (port, username) for establishing SSH tunnel. - -### Bugs fixed - -- Remove needless quotes from the choices of `cider-jack-in-auto-inject-clojure`. -- [#2561](https://github.com/clojure-emacs/cider/issues/2561): Disable undo in `*cider-test-report*` buffers. -- [#3251](https://github.com/clojure-emacs/cider/pull/3251): Disable undo in `*cider-stacktrace*` buffers. -- Consecutive overlays will not be spuriously deleted. -- [#3260](https://github.com/clojure-emacs/cider/pull/3260): Scroll REPL buffer in other frame. -- [#3293](https://github.com/clojure-emacs/cider/issues/3293): Can't jack in to more than one `bb` projects. - -## 1.5.0 (2022-08-24) - -### New features - -- [#3226](https://github.com/clojure-emacs/cider/pull/3226): Populate completions metadata, making it possible to change the style of completion via `completion-category-override` or `completion-category-defaults`. -- [#2946](https://github.com/clojure-emacs/cider/issues/2946): Add custom var `cider-merge-sessions` to allow combining sessions in two different ways: Setting `cider-merge-sessions` to `'host` will merge all sessions associated with the same host within a project. Setting it to `'project` will combine all sessions of a project irrespective of their host. -- Support Gradle jack-in via the Gradle wrapper (`gradlew`), instead of just a globally installed `gradle` on the `PATH`. -- Gradle projects can now inject dependencies and middleware as with other build tools (dependency injection requires [Clojurephant](https://github.com/clojurephant/clojurephant) 0.7.0 or higher). -- [#3239](https://github.com/clojure-emacs/cider/issues/3239): Added commands to evaluate and tap last sexp (`cider-tap-last-sexp`) and sexp at point (`cider-tap-sexp-at-point`). - -## Changes - -- Upgrade clojure-mode to [5.15.1](https://github.com/clojure-emacs/clojure-mode/blob/v5.15.1/CHANGELOG.md). -- Upgrade injected `cider-nrepl` to [0.28.5](https://github.com/clojure-emacs/cider-nrepl/releases/tag/v0.28.5). -- [#3200](https://github.com/clojure-emacs/cider/issues/3200): Improve cider-browse-ns interface to allow selective hiding of var types as well as grouping options. Include private vars in result list. -- Changed default `cider-gradle-command` to `./gradlew` to use the Gradle wrapper. -- Changed default `cider-gradle-global-options` to `""` (empty, formerly `--no-daemon`). -- [#3234](https://github.com/clojure-emacs/cider/pull/3234): Autocomplete multiple available ports on nREPL connect. - -### Bugs fixed - -- [#3235](https://github.com/clojure-emacs/cider/issues/3235): Check `name` is a TRAMP file in `cider--client-tramp-filename` via `tramp-tramp-file-p`. - -## 1.4.1 (2022-05-25) - -## Changes - -* Upgrade cider-nrepl to [0.28.4](https://github.com/clojure-emacs/cider-nrepl/releases/tag/v0.28.4). - -### Bugs fixed - -* [#3195](https://github.com/clojure-emacs/cider/issues/3195): Revert the change that resulted in `(error "Cyclic keymap inheritance")` on `cider-test-run-test`. -* [#3182](https://github.com/clojure-emacs/cider/issues/3182): Don't try to invoke -JVM-specific code outside of JVM Clojure. -* [#3202](https://github.com/clojure-emacs/cider/pull/3202): Fix `cider-eval-ns-form` - * Do not always perform `undef-all`. Undef only with `C-u` prefix. - * Fix extraction of namespace name. - -## 1.4.0 (2022-05-02) - -## New features - -* [#3188](https://github.com/clojure-emacs/cider/pull/3188): Add support for `undef-all` op, for removing stale vars and conflicting aliases. - * Add new command `cider-undef-all`. - * Existing commands `cider-load-buffer`, `cider-load-file`, and `cider-eval-ns-form` can be called with `C-u` prefix to execute `undef-all` before reloading the ns. -* [#3185](https://github.com/clojure-emacs/cider/pull/3185): Add feature to `cider-eval-in-context` for automatically extracting parent let bindings when called with `C-u` prefix argument. -* Add new interactive command `cider-inspire-me`. It does what you'd expect. -* [#3162](https://github.com/clojure-emacs/cider/pull/3162): Save eval results into kill ring and registers. - * Add new customization variable `cider-eval-register` to automatically store the last interactive eval result into the specified register. - * Add interactive command `cider-kill-last-result` to manually save the last eval result into kill ring. - -### Changes - -* [#3177](https://github.com/clojure-emacs/cider/pull/3177): Apply ANSI colorization to test assertion output. -* Use clojure-mode [5.14.0](https://github.com/clojure-emacs/clojure-mode/blob/v5.14.0/CHANGELOG.md#5140-2022-03-07). - -### Bugs fixed - -* [#3170](https://github.com/clojure-emacs/cider/issues/3170): Skip ensure repl available checks on xref functions. (this improves the interop with `clojure-lsp`) -* [#3173](https://github.com/clojure-emacs/cider/issues/3173): Locally remove `cider-complete-at-point` from `completion-at-point-functions` instead of killing it as a local variable. -* [#3172](https://github.com/clojure-emacs/cider/issues/3172): Restore the long-lost (but critical) inspirational message on connect. -* [#3186](https://github.com/clojure-emacs/cider/pull/3186): An assortment of small fixes. - -## 1.3.0 (2022-03-07) - -### New features - -* [#3148](https://github.com/clojure-emacs/cider/pull/3148): Display error messages in multiline comment eval results, and in result overlays when `cider-show-error-buffer` is set to `nil`. -* [#3149](https://github.com/clojure-emacs/cider/pull/3149): Add option `'change` to `cider-eval-result-duration`, allowing multiple eval result overlays to persist until the next change to the buffer. - -### Changes - -* [#3127](https://github.com/clojure-emacs/cider/pull/3040): Strip all exec-opts flags (`-A` `-M` `-T` `-X`) if they exist in `cider-clojure-cli-aliases`. Also addresses a duplicate `:` in the generated `clj` command. -* `cider-jack-in-lein-plugins` no longer affects non-Leiningen projects. - * Third-party packages should rely on `cider-jack-in-dependencies` instead. -* Upgrade cider-nrepl to [0.28.3](https://github.com/clojure-emacs/cider-nrepl/blob/v0.28.3/CHANGELOG.md#0283-2022-02-22). -* Remove `cider-jdk-src-paths` defcustom since enrich-classpath makes it redundant. -* Remove `cider-resolve-java-class` function since enrich-classpath makes it redundant. - -### Bugs fixed - -* Upgrade [enrich-classpath](https://github.com/clojure-emacs/enrich-classpath), which fixes various edge cases. - * Remember: at the moment the enrich-classpath is disabled by default. If you wish to try it out, you can customize `cider-enrich-classpath` to `t`. - * Also remember: for it to work, on Linux, you'll also have to do something like `sudo apt install openjdk-11-source` (depending on your package manager and JDK of choice). -* [#3145](https://github.com/clojure-emacs/cider/pull/3145): Allow fallback to other `xref` backends if cider-nrepl is not loaded. -* [#3148](https://github.com/clojure-emacs/cider/pull/3148): Fix eval result overlays at point inheriting the faces of following text. -* [#3133](https://github.com/clojure-emacs/cider/issues/3133): Respect `cider-injected-middleware-version`. -* [#3163](https://github.com/clojure-emacs/cider/pull/3163): `cider-clojuredocs`: prevent redundant prompt for a symbol. - -## 1.2.0 (2021-12-22) - -### New features - -* Integrate [enrich-classpath](https://github.com/clojure-emacs/enrich-classpath) by default for Leiningen projects. - * This enables functionality related to Java sources, javadocs or parsing thereof. - * This can slightly slow down jack-in for the _first_ time for a given project; later on the related work will be cached. - * The feature is experimental at this point and needs to be enabled with `(setq cider-enrich-classpath t)`. -* [#2831](https://github.com/clojure-emacs/cider/issues/2831): Add `xref` integration, configured with customizable variables `cider-use-xref` and `cider-xref-fn-depth`. -* [#3017](https://github.com/clojure-emacs/cider/issues/3017): Annotate company completion kinds. -* [#3040](https://github.com/clojure-emacs/cider/pull/3040): Support invoking `cider-clojuredocs` within the `*clojuredocs*` buffer. -* Make it possible to specify the version of `cider-nrepl` to use with `cider-jack-in`. See `cider-injected-middleware-version`. -* Make it possible to specify the version of nREPL to use with `cider-jack-in`. See `cider-injected-nrepl-version`. -* Upgrade `cider-nrepl`, `Orchard` and `clj-suitable` for pulling their latest bugfixes. -* Add support for babashka projects to `cider-jack-in`. -* Introduce `cider-jack-in-lein-middlewares` defcustom. -* [#3093](https://github.com/clojure-emacs/cider/pull/3093): Make `see-also`s clickable in ClojureDocs buffers. -* [#3044](https://github.com/clojure-emacs/cider/pull/3044): Dynamically upgrade nREPL connection. See `cider-upgrade-nrepl-connection`. - -### Bugs fixed - -* [#3022](https://github.com/clojure-emacs/cider/issues/3022): Handle empty stacktraces, pointing users to docs about the `OmitStackTraceInFastThrow` JVM optimization. -* [#3020](https://github.com/clojure-emacs/cider/issues/3020): Fix session linking on Windows, e.g. when jumping into a library on the classpath. -* [#3031](https://github.com/clojure-emacs/cider/pull/3031): Fix `cider-eval-defun-up-to-point` failing to match delimiters correctly in some cases, resulting in reader exceptions. -* [#3039](https://github.com/clojure-emacs/cider/pull/3039): Allow starting the sideloader for the tooling session. -* [#3041](https://github.com/clojure-emacs/cider/pull/3041): Sideloader: handle binary files, support multiple directories. -* [#3047](https://github.com/clojure-emacs/cider/pull/3047): Fix info/lookup fallback: response has an extra level. -* [#2746](https://github.com/clojure-emacs/cider/issues/2746): Handle gracefully Clojure versions with non-standard qualifiers (e.g. `1.11.0-master-SNAPSHOT`). -* [#3069](https://github.com/clojure-emacs/cider/pull/3069): Fix cursor color changing when it shouldn't in `evil-mode`. -* [#3071](https://github.com/clojure-emacs/cider/issues/3071): Use `xref` instead of `etags` to push point to marker stack. -* [#3074](https://github.com/clojure-emacs/cider/issues/3074): Recognize `pwsh` as a `powershell` executable. - -### Changes - -* Drop support for Emacs 25 (this tracks upstream deps like `parseedn` that no longer support Emacs 25 and is line with our compatibility policy for RHEL and Debian). - -## 1.1.1 (2021-05-24) - -### Bugs fixed - -* [#3014](https://github.com/clojure-emacs/cider/pull/3014): Update Krell repl initialization code to follow latest guidelines as found in Krell wiki. -* [#3012](https://github.com/clojure-emacs/cider/issues/3012): Allow connecting sibling repls from any buffer. -* [#3010](https://github.com/clojure-emacs/cider/issues/3010): Remove `::` auto-resolved keyword expansion logic from `cider-symbol-at-point`, moving it to `cider-browse-spec`. - -## 1.1.0 (2021-04-22) - -### New features - -* [#2930](https://github.com/clojure-emacs/cider/issues/2930): Add new customization variable `cider-test-default-include-selectors` and `cider-test-default-exclude-selectors` for specifying default test selectors when running commands such as `cider-test-run-ns-tests`. -* [#2907](https://github.com/clojure-emacs/cider/issues/2907): Add new customization variable `cider-format-code-options` to specify options used by `cljfmt` to format code when running commands `cider-format-buffer`, `cider-format-region` and `cider-format-defun`. -* [#3002](https://github.com/clojure-emacs/cider/pull/3002): [Inspector] Make collection member truncation limits configurable. - -### Bugs fixed - -* [#2871](https://github.com/clojure-emacs/cider/issues/2871): Restore the dynamic code completion (the actual fixes are in `clj-suitable` and `cider-nrepl`). -* [#2993](https://github.com/clojure-emacs/cider/issues/2993): Fix bug where calling `cider-repl-set-ns` for a cljs ns when `cider-repl-require-ns-on-set` is `t` would fail. -* [#2983](https://github.com/clojure-emacs/cider/issues/2983): Update signal description in nrepl server sentinel as a workaround for Emacs bug #46284 affecting v27.1 on Windows. -* [#2941](https://github.com/clojure-emacs/cider/issues/2941): Use main args in alias for clojure cli. -* [#2953](https://github.com/clojure-emacs/cider/issues/2953): Don't font-lock function/macro vars as generic vars. -* [#2964](https://github.com/clojure-emacs/cider/issues/2964): Fix issue with `cider-company-enable-fuzzy-completion` and Helm. -* [#2937](https://github.com/clojure-emacs/cider/issues/2937): Green fringe produced for extra line in rich comment block. -* [#2996](https://github.com/clojure-emacs/cider/issues/2937): Fix debugger incorrectly locating `#_` ignored forms. -* Fix a compatibility issue with Java 15 and fetching fresh ClojureDocs data. (fixed in `cider-nrepl` 0.25.6) -* [#3004](https://github.com/clojure-emacs/cider/pull/3004): Use appropriate coding system when unzipping jars. -* [#2934](https://github.com/clojure-emacs/cider/issues/2934): Enable `eldoc-mode` in existing clojure buffers. - -### Changes - -* Removed `cider-clojure-cli-parameters` due to clojure-cli jack-in changes. -* Changed the behaviour of `cider-last-sexp` so it returns only the sexp, excluding all whitespace and/or the first newline after. - -## 1.0.0 (2020-28-12) - -### New features - -* [#2909](https://github.com/clojure-emacs/cider/issues/2909): Add new customization variable `cider-inspector-auto-select-buffer` to control the auto selection of the inspector buffer. -* [#2940](https://github.com/clojure-emacs/cider/pull/2940): Add a new customization variable cider-shadow-watched-builds to allow watching several shadow-cljs builds at the same time. - -### Bugs fixed - -* Fix broken links to the docs in REPL warnings (the REPL links included the full CIDER version, but the docs URLs are without the patch version). -* [#2916](https://github.com/clojure-emacs/cider/issues/2916): Fix ordering of dependencies, global-opts and params for Clojure CLI projects when calling `cider-jack-in`. -* [#2929](https://github.com/clojure-emacs/cider/issues/2929): Fix handling of reader tags or metadata when calling `cider-eval-last-sexp-and-replace`. - -### Changes - -* Bump the injected nREPL version to 0.8.3. -* Bump the injected `cider-nrepl` version to 0.25.5. -* Bump the injected Piggieback version to 0.5.2. See [this issue](https://github.com/nrepl/piggieback/issues/118) for details. -* [#2897](https://github.com/clojure-emacs/cider/pull/2897): Translate paths from CIDER to nREPL and vice-versa. -* Set `cider-prompt-for-symbol` to `nil` by default. - -## 0.26.1 (2020-08-14) - -### Bugs fixed - -* [#2886](https://github.com/clojure-emacs/cider/pull/2886): Don't check for `node`'s presence before starting a browser REPL. -* [#2889](https://github.com/clojure-emacs/cider/pull/2889): Fix a typo in `cider-info-form`. - -### Changes - -* Bump the injected piggieback version to 0.5.1. - -## 0.26.0 (2020-08-03) - -### New features - -* Add first class support for Babashka (more warnings when you connect to `babashka.nrepl`). -* Add support for nREPL 0.8's `lookup` op. -* Add support for nREPL 0.7's sideloading functionality (experimental). -* Add support for nREPL 0.8's `ls-middleware` op. -* [#2861](https://github.com/clojure-emacs/cider/pull/2861): Add support for the Krell REPL. -* [#2881](https://github.com/clojure-emacs/cider/pull/2881): Add command to evaluate list around point (`cider-eval-list-at-point`). - -### Changes - -* [#2527](https://github.com/clojure-emacs/cider/issues/2527): Enable auto-clear of REPL buffer by setting a limit to the max buffer size. -* [#2852](https://github.com/clojure-emacs/cider/issues/2852): Convert 1-based column numbers in response map to Emacs' 0-based system. -* Differentiate between more types in `cider-eldoc`. They used to be just `var` and `fn` and now we have additional handling for -macros, special forms and methods. -* No longer fetches ClojureDocs data on first run (it's now bundled with `cider-nrepl`). -* No longer updates the ClojureDocs data automatically on startup (it has to be updated explicitly using `M-x cider-clojuredocs-refresh-cache`). -* Use nREPL 0.8 by default (when doing `cider-jack-in`). - -### Bugs fixed - -* Handle properly missing file metadata in `cider-doc` buffers, when you eval fallback to obtain var metadata. -* Show eldoc for `.` and `..`. -* [#2860](https://github.com/clojure-emacs/cider/issues/2860): Don't send blank strings in `eldoc` requests. -* [#2718](https://github.com/clojure-emacs/cider/issues/2718): When calling `cider-pprint-eval-last-sexp-to-comment`, avoid printing empty comment if eval throws error. -* [#2796](https://github.com/clojure-emacs/cider/issues/2796): Closing CIDER connection will disable the debug minor mode on clojure buffers. - -## 0.25.0 (2020-06-04) - -### New features - -* [#2482](https://github.com/clojure-emacs/cider/pull/2842): Improvements to CIDER Inspector. - * New defcustom `cider-inspector-skip-uninteresting` to control whether to skip over nils, numbers and keywords when navigating between values in the inspector buffer. - * New defcustom `cider-auto-inspect-after-eval` to control whether a visible inspector buffer is updated with the last evaluated result. -* [#2833](https://github.com/clojure-emacs/cider/pull/2833): Save command history for jack-in with universal arg. -* [#2828](https://github.com/clojure-emacs/cider/pull/2828): Bind "L" to toggle display of locals during a debug session. -* [#2800](https://github.com/clojure-emacs/cider/pull/2800): Add support for force-out debugger command. -* Add support for nREPL 0.8 `completions` op. It's used if `cider-nrepl` is not available. -* Add `browser` to the list of supported ClojureScript REPL types. -* Add an interactive command to toggle Clojure font-locking in the REPL (`cider-repl-toggle-clojure-font-lock`). -* Add a defcustom controlling nREPL's print buffer size (`cider-print-buffer-size`). It's set to 4K by default, nREPL own default is 1k. - -### Changes - -* [#2826](https://github.com/clojure-emacs/cider/pull/2826): Add support for symbols with quotes and resolving of ns-aliased keywords in `cider-symbol-at-point`. -* [#2617](https://github.com/clojure-emacs/cider/pull/2617): Add menu bar entry for `Insert last sexp in REPL`. -* Removed support for the Nashorn ClojureScript REPL. (it was removed upstream in ClojureScript) -* [#2825](https://github.com/clojure-emacs/cider/issues/2825): Disable support for displaying images in the REPL. (set `cider-repl-use-content-types` to re-enable it) -* [#2850](https://github.com/clojure-emacs/cider/issues/2850): Ensure you're in the middle of a window after commands like `cider-find-var`. - -### Bugs fixed - -* [#2839](https://github.com/clojure-emacs/cider/pull/2839): Fix symbol-at-point on var-quoted symbols. -* [#2807](https://github.com/clojure-emacs/cider/pull/2807): Fix require-repl-utils for shadow-cljs repls. -* [#1971](https://github.com/clojure-emacs/cider/issues/1971), [#2628](https://github.com/clojure-emacs/cider/issues/2628): Don't try to font-lock multi-chunk results in the REPL. -* [#2816](https://github.com/clojure-emacs/cider/issues/2816): Update eldoc to work with Emacs 28.1. - -## 0.24.0 (2020-02-15) - -### New features - -* [#2744](https://github.com/clojure-emacs/cider/pull/2744): Add startup commands to REPL banner. -* [#2499](https://github.com/clojure-emacs/cider/issues/2499): Add `cider-jump-to-pop-to-buffer-actions`. -* [#2738](https://github.com/clojure-emacs/cider/pull/2738): Add ability to lookup a function symbol when cursor is at the opening paren. -* [#2735](https://github.com/clojure-emacs/cider/pull/2735): New debugger command `P` to inspect an arbitrary expression, it was previously bound to `p` which now inspects the current value. -* [#2729](https://github.com/clojure-emacs/cider/pull/2729): New cider inspector command `cider-inspector-def-current-val` lets you define a var with the current inspector value. - -### Changes - -* [#2781](https://github.com/clojure-emacs/cider/pull/2781): Extend `cider-doc-xref-regexp` to recognize `[[var]]` syntax and fully qualified symbols as xref links in cider-doc buffers. -* [#2731](https://github.com/clojure-emacs/cider/pull/2731): Make the in-buffer debugging menu customizable via `cider-debug-prompt-commands`. - -### Bugs fixed - -* [#2787](https://github.com/clojure-emacs/cider/issues/2787): Fix nrepl process naming collision when using `nrepl-hide-special-buffers`. -* [#2739](https://github.com/clojure-emacs/cider/pull/2739): Start built-in shadow-cljs build profiles correctly (node-repl, browser-repl). -* [#2730](https://github.com/clojure-emacs/cider/pull/2730): Require REPL utilities into current namespace not just `user` ns. -* [#2614](https://github.com/clojure-emacs/cider/issues/2614): Fix error highlighting in source buffers for Clojure 1.10. -* [#2733](https://github.com/clojure-emacs/cider/issues/2733): Restore compatibility with Emacs 25.3. - -## 0.23.0 (2019-10-08) - -### New features - -* New configuration variable `cider-result-overlay-position` determining where debugger and inline eval result overlays should be displayed. Current options are 'at-eol and 'at-point. -* [#2606](https://github.com/clojure-emacs/cider/pull/2606): Defcustom `cider-path-translations` for translating paths from nREPL messages (useful where a file appears to be somewhere, but it's actually somewhere else). -* [#2698](https://github.com/clojure-emacs/cider/pull/2689): Infer figwheel builds automatically. -* New command `cider-clojuredocs-refresh-cache`. - -### Changes - -* [#2711](https://github.com/clojure-emacs/cider/pull/2711): `cider-selector` has more robust handling for edge cases. -* [#2572](https://github.com/clojure-emacs/cider/issues/2572): Make it possible to a start a one off ClojureScript REPL without defining a new REPL type. -* Dynamic cljs completions (via suitable) can be disable by setting `cider-enhanced-cljs-completion-p` to nil. - -### Bugs fixed - -* [#2715](https://github.com/clojure-emacs/cider/issues/2715): Fix the `shadow-cljs` presence check. -* [#2705](https://github.com/clojure-emacs/cider/issues/2705): Middleware version check looks at only at the minor version for comparison (when the major version is 0) and ensures a matching major and a minor >= required otherwise. -* Fixed some bugs related to the new suitable-powered ClojureScript code completion (this was fixed by upgrading the `suitable` used by `cider-nrepl`). -* Remove a misplaced error message when doing `clojuredocs-lookup`. -* [#2721](https://github.com/clojure-emacs/cider/issues/2721): Handle properly symbols ending in `.` (e.g. `SomeRecord.`). - -## 0.22.0 (2019-09-01) - -### New features - -* [#2656](https://github.com/clojure-emacs/cider/issues/2656): Base64 encode clojure command and arguments on jack-in when `cider-clojure-cli-command` is `"powershell"` to avoid escaping issues. If no `clojure` command is found on Windows `cider-clojure-cli-command` defaults to `"powershell"`. -* Allow editing of jack in command with prefix or when `cider-edit-jack-in-command` is truthy. -* New defcustom `cider-repl-require-ns-on-set`: Set it to make cider require the namespace before setting it, when calling `cider-repl-set-ns`. -* [#2611](https://github.com/clojure-emacs/cider/issues/2611): Add `eval`-based classpath lookup fallback. It's used when cider-nrepl is not present. -* [#2611](https://github.com/clojure-emacs/cider/issues/2611): Add `eval`-based var info lookup fallback. It's used when cider-nrepl is not present. -* [#1840](https://github.com/clojure-emacs/cider/issues/1840): Add a command to find runtime function references (`cider-xref-fn-refs`). -* Add a command to find runtime function dependencies (`cider-xref-fn-deps`). -* Add a menu to the inspector. -* Add completion of shadow-cljs build names in the minibuffer when connecting or jacking in. - -### Changes - -* `cider-use-tooltips` now also controls whether `help-echo` is used. -* `cider-print-options` is now supported by the `pr` option for `cider-print-fn`. The options will now be also used by interactive eval commands that do not use pretty-printing. -* `spec-list` and `spec-form` requests send the current namespace for alias resolution. -* `C-c , C-g` and `C-c C-t C-g` cancel the key chord instead of rerunning the last test. The respective command has been moved to `C-c , C-a`, `C-c , a`, `C-c C-t C-a` and `C-c C-t a`. -* [#2643](https://github.com/clojure-emacs/cider/issues/2643): **(Breaking)** Stop using the `cider.tasks/nrepl-server` custom task for `cider-jack-in` with Boot. -* [#2647](https://github.com/clojure-emacs/cider/issues/2647): `cider-repl-require-repl-utils` now loads cljs specific REPL utils in cljs buffers. -* [#2689](https://github.com/clojure-emacs/cider/issues/2689): `cider-load-buffer` now takes an optional `callback` that will override the default `cider-load-file-handler`. -* [#2689](https://github.com/clojure-emacs/cider/issues/2689): `cider-load-file-handler` now takes an optional `done-handler` lambda that is run once load is complete. - -### Bug fixes - -* [#2685](https://github.com/clojure-emacs/cider/pull/2658): Send `exclude-regexps` in apropos under correct key -* Stop cursor moving when initialising the CIDER REPL, when `cider-repl-pop-to-buffer-on-connect` is nil. This fixes a bug introduced by [commit e0aca78b](https://github.com/clojure-emacs/cider/commit/e0aca78ba56425e50ea895c5adc7c0331cee0b19). -* [#2577](https://github.com/clojure-emacs/cider/issues/2577): Ensure user friendly error messages if a REPL connection is expected but none was found in certain situations. -* [#2593](https://github.com/clojure-emacs/cider/issues/2593): The REPL's initial namespace is now set correctly if configured in another tool (e.g. Leiningen's `:init-ns`). -* [#2607](https://github.com/clojure-emacs/cider/pull/2607): Use markers for specifying insertion point for `cider-eval-*-to-comment`commands. This fixes a bug where editing the buffer during a pending evaluation resulted in comments appearing in unintended locations. -* [#2308](https://github.com/clojure-emacs/cider/issues/2308): Don't rely on the classpath in `cider-library-present-p`. Now it does a `require` instead to check if some library is present or not. -* [#2541](https://github.com/clojure-emacs/cider/issues/2541): Hook properly CIDER's code completion machinery. -* [#2659](https://github.com/clojure-emacs/cider/issues/2659): Handle `#shadow/env` reader tags in `cider--shadow-get-builds`. -* [#2676](https://github.com/clojure-emacs/cider/issues/2676): Widen before `cider--file-string`, to allow `cider-load-buffer` to work on narrowed buffers. -* Don't disable `cider-mode` until all CIDER sessions have been closed. - -## 0.21.0 (2019-02-19) - -### New features - -* The `cider-test-run-*` and `cider-ns-refresh-*` commands are now interruptible by the `cider-interrupt` command. -* Many commands now stream printed results back to the client incrementally – meaning it's now possible to, for example, interrupt evaluations while their result is being rendered. -* New option: `cider-repl-init-code`. This is a list of strings containing Clojure code to evaluate when the REPL starts (with bindings for any `set!`-able vars in place). Replaces `cider-print-length` and `cider-print-level`, which are now obsolete. -* New option: `cider-print-quota`. This is a hard limit on the number of bytes that will be returned by any printing operation. This defaults to one megabyte and can be set to `nil` if no limit is desired. - -### Changes - -* Add new defcustom `cider-switch-to-repl-on-insert`: Set to prevent cursor from going to the REPL when inserting a form in the REPL with the insert-to-repl commands. Replaces obsoleted `cider-switch-to-repl-after-insert-p` -* **(Breaking)** Upgrade to nREPL 0.6.0. This is now the minimum required version. -* **(Breaking)** Upgrade to piggieback 0.4.0. This is now the minimum required version. -* **(Breaking)** Remove `cider.nrepl.middleware.pprint`. All functionality has been replaced by the built-in printing support in nREPL 0.6. -* Option `cider-repl-scroll-on-output` is now obsolete, and the default REPL behavior has changed to _not_ recenter the window. The built-in variable `scroll-conservatively` can be set to 101 (either globally or locally in the REPL buffer) to restore the old behavior. This change has a dramatic positive effect on REPL performance. -* `cider-pprint-fn` and `cider-pprint-options` are now obsolete, replaced by `cider-print-fn` and `cider-print-options`. -* `cider-debug-print-options`, `cider-stacktrace-print-options`, and `cider-repl-pretty-print-width` are now all obsolete, replaced by `cider-print-options`. -* [#2546](https://github.com/clojure-emacs/cider/pull/2546): New defcustom `cider-ns-save-files-on-refresh-modes` to control for which buffers `cider-ns-refresh` should save before refreshing. - -### Bug fixes - -* Fix values for `cider-preferred-build-tool` variable. -* Fix value and safe property for `cider-allow-jack-in-without-project` variable. -* `cider-ns-save-files-on-refresh` will now save any modified buffers visiting files on the classpath, rather than just in the current project. -* `cider-expected-ns` no longer requires an absolute path as its argument, and now internally handles paths canonically and consistently. -* Fixed a bug causing REPL output to be inserted after the prompt. -* Fixed a bug causing `cider-pprint-eval-last-sexp-to-comment` and `cider-pprint-eval-defun-to-comment` to not insert anything. -* `cider-find-var` now correctly uses a new window when passed a prefix of `-` or a double prefix argument. - -## 0.20.0 (2019-01-14) - -### New features - -* Make it possible to pass an options map to the currently selected pprint function via `cider-pprint-options`. -* Add support for zprint. -* Make it possible to eval and pprint in the scratch buffer using `C-u C-j`. -* [#2532](https://github.com/clojure-emacs/cider/pull/2532): Add support for `CompilationException` dynamic source location discovery. - -### Changes - -* [#2496](https://github.com/clojure-emacs/cider/issues/2496): Replace CIDER's pprint implementation with nREPL 0.5's built-in pprint support. -* [#2558](https://github.com/clojure-emacs/cider/pull/2558): Load clj, cljc, & cljs (if cljs REPL available) files on `cider-load-all-files` (`C-c C-M-l`). Previously, this only loaded clj files. -* Enable pretty-printing in the REPL by default. - -### Bug fixes - -* [#2532](https://github.com/clojure-emacs/cider/pull/2532): Fix re-display hangs while dynamically recovering source locations under mouse pointer. -* [#2560](https://github.com/clojure-emacs/cider/pull/2560): Detect REPL type for completion, eldoc and info ops. - -## 0.19.0 (2019-01-01) - -### New features - -* [#2430](https://github.com/clojure-emacs/cider/issues/2375): `cider-find-var` opens archive files inside [AVFS](http://avf.sourceforge.net) folders if AVFS is detected. -* [#2446](https://github.com/clojure-emacs/cider/issues/2446): Implement Sesman friendly sessions to allow for on-the-fly association with sessions from dependency projects and jars. -* [#2253](https://github.com/clojure-emacs/cider/issues/2253): Split `continue` debug command into "continue till next breakpoint" (`c`) and "continue non stop" (`C`) commands. - -### Bug fixes - -* [#2474](https://github.com/clojure-emacs/cider/issues/2474): Fix incorrect detection of output and out-of-order printing. -* [#2514](https://github.com/clojure-emacs/cider/issues/2514): Don't auto-jump to warnings when `cider-auto-jump-to-error` is set to 'errors-only. -* [#2453](https://github.com/clojure-emacs/cider/issues/2453): Make it possible to debug deftype methods by direct insertion of #dbg and #break readers into the deftype methods. -* [#1869](https://github.com/clojure-emacs/cider/issues/1869),[cider-nrepl#460](https://github.com/clojure-emacs/cider-nrepl/issues/460): Fix `continue` debugger command which was stopping entering debugger on repeated invocations. -* [#2444](https://github.com/clojure-emacs/cider/issues/2444): Reuse dead REPL buffers on new connections. -* [#2441](https://github.com/clojure-emacs/cider/issues/2441): Make it possible to use `C-c C-x` keys without loading cider first (autoload `cider-start-map`). -* [#2440](https://github.com/clojure-emacs/cider/issues/2440): Make `cider-check-cljs-repl-requirements` take effect again. -* [#2439](https://github.com/clojure-emacs/cider/issues/2439): Remove mentions of `cider-toggle-connection-buffer` from the docs. -* [#2435](https://github.com/clojure-emacs/cider/issues/2435): Remove killed REPLs from sessions in client sentinel. -* Fix jack-in from inside of remote buffers. -* [#2454](https://github.com/clojure-emacs/cider/pull/2454): Fix erratic inspector behavior when multiple REPLs are connected -* [#2467](https://github.com/clojure-emacs/cider/pull/2467): Make generic CIDER ops use any available nREPL connection. -* [#2105](https://github.com/clojure-emacs/cider/issues/2105): Fix no comment syntax defined message when loading buffer after running a failing test. -* [#2115](https://github.com/clojure-emacs/cider/issues/2515): Reset the current buffer after `display-buffer`. - -### Changes - -* [#2482](https://github.com/clojure-emacs/cider/issues/2482): Don't bind nREPL server started by `cider-jack-in` to `::` (use `localhost` instead). -* [#2484](https://github.com/clojure-emacs/cider/pull/2484): Fix issues where some functionality in REPL buffers (like eldoc) was broken. -* [#2484](https://github.com/clojure-emacs/cider/pull/2484): REPL types are now symbols instead of strings. -* [#1544](https://github.com/clojure-emacs/cider/issues/1544): Add a new defcustom `cider-infer-remote-nrepl-ports` to control whether we use tramp/ssh to infer remote ports. Now defaulting to `nil` (previously it always tried to infer). - -## 0.18.0 (2018-09-02) - -### New features - -* [#2375](https://github.com/clojure-emacs/cider/issues/2375): Move `cider-eval-toplevel-inside-comment-form` into clojure-mode as `clojure-toplevel-inside-comment-form` so `beginning-of-defun` is aware of comment forms. -* Add new `cider-session-name-template` variable for flexible customization of cider session and REPL buffer names. -* Bind `C-c M-r` to `cider-restart`. -* Add new `cider-start-map` keymap (`C-c C-x`) for jack-in and connection commands. -* Add new `cider-ns-map` keymap (`C-c M-n`) for namespace related functionality. -* Allow evaling top level forms in a comment form rather than the entire comment form with `cider-eval-toplevel-inside-comment-form`. -* Create keymap for inserting forms into the REPL at `C-c C-j`. -* Add new defcustom `cider-invert-insert-eval-p`: Set to cause insert-to-repl commands to eval the forms by default when inserted. -* Add new defcustom `cider-switch-to-repl-after-insert-p`: Set to prevent cursor from going to the REPL when inserting a form in the REPL with the insert-to-repl commands. -* Inject piggieback automatically on `cider-jack-in-clojurescript`. -* Introduce a new command named `cider` (`C-c M-x`) that acts as a simple wrapper around all commands for starting/connecting to REPLs. -* [#2305](https://github.com/clojure-emacs/cider/issues/2305): Make it possible to disable the REPL type auto-detection by customizing `cider-repl-auto-detect-type`. -* [#2373](https://github.com/clojure-emacs/cider/issues/2373): Make it possible to configure the welcome message displayed in scratch buffers via `cider-scratch-initial-message`. -* Add the ability to jump to the profiler buffer using `cider-selector`. -* [#1980](https://github.com/clojure-emacs/cider/issues/1980): Echo back missing namespace name on interactive eval (requires nREPL 0.4.3+). -* [#2397](https://github.com/clojure-emacs/cider/pull/2397): Add shadow-select ClojureScript REPL type. -* [#2314](https://github.com/clojure-emacs/cider/pull/2314): Add `cider-ns-reload` and `cider-ns-reload-all` interactive commands. - -### Bugs fixed - -* [#2317](https://github.com/clojure-emacs/cider/issues/2317): The stdin prompt can now be cancelled. -* [#2328](https://github.com/clojure-emacs/cider/issues/2328): Added `cider-eval-sexp-to-point`. -* [#2310](https://github.com/clojure-emacs/cider/issues/2310): `cider-format-edn-last-sexp` will format the last sexp. -* [#2294](https://github.com/clojure-emacs/cider/issues/2294): Fix setting default stacktrace filters. -* [#2286](https://github.com/clojure-emacs/cider/issues/2286): Fix eldoc issue with images in the REPL. -* [#2307](https://github.com/clojure-emacs/cider/pull/2307): Use a better error when a cljs REPL form cannot be found. -* Fix the broken test selector functionality. -* [#2291](https://github.com/clojure-emacs/cider/issues/2291): `cider-use-tooltips` custom variable works as expected. -* [#2424](https://github.com/clojure-emacs/cider/issues/2424): Fallback to `lein` as the default jack-in command when `clojure` is not present. - -### Changes - -* **(Breaking)** Move `cider-repl-set-ns`, previously on `C-c M-n`, on `C-c M-n (M-)n` in the `cider-ns-map`. -* **(Breaking)** Move `cider-ns-refresh`, previously on `C-c C-x`, on `C-c M-n (M-)r` in the `cider-ns-map`. -* **(Breaking)** Bump the minimum required Emacs version to 25.1. -* **(Breaking)** Drop support for Java 7 and Clojure(Script) 1.7. -* **(Breaking)** Use session name as part of CIDER buffers names (REPL, server, messages), and obsolete `nrepl-buffer-name-separator` and `nrepl-buffer-name-show-port`. See `cider-session-name-template` and `cider-format-connection-params` for how to customize CIDER buffer names. -* **(Breaking)** Use a custom task (`cider.tasks/nrepl-server`) for `cider-jack-in` with Boot (that's done to provide access to newer nREPL features to users of older versions of Boot). -* Rename `cider-eval-defun-to-point` to `cider-eval-defun-up-to-point`. -* Add support for printing to the current buffer to `cider-eval-defun-up-to-point`. -* Remove `cider-ping` command. -* Remove `cider-visit-error-buffer` in favour of using `cider-selector`. -* Rename `cider-refresh` to `cider-ns-refresh` (and all the related defcustoms). -* **(Breaking)** Rewrote connection management (see https://docs.cider.mx/cider/usage/managing_connections.html for details). -* **(Breaking)** `cider-jack-in-clojurescript` now creates only a ClojureScript REPL (use `cider-jack-in-clj&cljs` to create both REPLs). -* [#2357](https://github.com/clojure-emacs/cider/issues/2357): Support both keywords and strings as test selectors (previously it was only strings). -* [#2378](https://github.com/clojure-emacs/cider/pull/2378): Add autoloads target to Makefile. -* Map `cider-pprint-eval-last-sexp` to `C-c C-v (C-)f (C-)e` in the `cider-eval-commands-map`. -* Map `cider-pprint-eval-defun-at-point` to `C-c C-v (C-)f (C-)d` in the `cider-eval-commands-map`. -* Accept bare figwheel-main build names (e.g., `dev`). Previously, a keyword (e.g., `:dev`) was required. -* Stop releasing CIDER and cider-nrepl together. cider-nrepl now has its own release cycle and CIDER introduces `cider-required-middleware-version` to track it. - -## 0.17.0 (2018-05-07) - -### New features - -* [#2248](https://github.com/clojure-emacs/cider/pull/2248): `cider-repl` can now display recognized images in the REPL buffer. -* [#2172](https://github.com/clojure-emacs/cider/pull/2172): Render diffs for expected / actual test results. -* [#2167](https://github.com/clojure-emacs/cider/pull/2167): Add new defcustom `cider-jdk-src-paths`. Configure it to connect stack trace links to Java source code. -* [#2161](https://github.com/clojure-emacs/cider/issues/2161): Add new interactive command `cider-eval-defun-to-point` which is bound to `C-c C-v (C-)z`. It evaluates the current top-level form up to the point. -* [#2113](https://github.com/clojure-emacs/cider/issues/2113): Add new interactive commands `cider-eval-last-sexp-in-context` (bound to `C-c C-v (C-)c`) and `cider-eval-sexp-at-point-in-context` (bound to `C-c C-v (C-)b`). -* Add new interactive command `cider-repl-set-type`. -* [#1976](https://github.com/clojure-emacs/cider/issues/1976): Add new interactive command `cider-connect-clojurescript`. -* Add a menu for `cider-browse-ns-mode`. -* [#2160](https://github.com/clojure-emacs/cider/issues/2160): Make it possible to configure the default `*print-level*` and `*print-length*` via defcustoms (`cider-repl-print-level` and `cider-repl-print-length`). -* New interactive command `cider-cheatsheet` allows you to browse the Clojure Cheatsheet with an Emacs interface. -* [#2191](https://github.com/clojure-emacs/cider/issues/2191): Add support for jacking-in just with the `clojure` command-line tool and `tools.deps`. -* Make it possible to start a Nashorn ClojureScript REPL. -* [#2235](https://github.com/clojure-emacs/cider/pull/2235): Make the REPL ignore blank input rather than evaluating. -* [#2241](https://github.com/clojure-emacs/cider/pull/2241): Make `cider-test-ediff` diff eval'ed values. -* Add support for shadow-cljs to `cider-jack-in`. -* [#2244](https://github.com/clojure-emacs/cider/issues/2244): Display the REPL type in the modeline. -* [#2238](https://github.com/clojure-emacs/cider/pull/2238): Allow specifying predicates for entries in `cider-jack-in-lein-plugins` and `cider-jack-in-nrepl-middlewares`. -* Add support for test selectors. If test all or all loaded is called with a prefix ask for filter test selectors in the minibuffer and only run those tests in the project which match the filters. Add variation of test namespace which asks for filter selectors the same way and only runs a subset of the namespace tests. -* Add a configuration variable allowing to control whether server output should be redirected to the REPL (`cider-redirect-server-output-to-repl`). - -### Bugs Fixed - -* [#1913](https://github.com/clojure-emacs/cider/issues/1913): Fix `cider-toggle-buffer-connection` to allow cycling of connection and restoring all connections in cljc buffers. -* [#2148](https://github.com/clojure-emacs/cider/issues/2148): Fix `jump to definition` working properly when remote `cider-jack-in` and `cider-connect`. -* Font-lock failed assertions even in tests that were evaluated interactively. -* [#2102](https://github.com/clojure-emacs/cider/issues/2102): Make `cider-format-buffer` handle mismatched parens gracefully. - -### Changes - -* [#2163](https://github.com/clojure-emacs/cider/issues/2163): Add `cider-browse-spec-regex`, and changed `cider-browse-spec-all` to use it. -* [#2029](https://github.com/clojure-emacs/cider/pull/2154): Make cider-doc use cider-browse-spec functionality to print the spec part of the doc buffer -* [#2151](https://github.com/clojure-emacs/cider/pull/2151): Improve formatting of spec in `cider-doc` buffer. -* Remove support for CLJX. -* Fix `cider-eval-region` masking `clojure-refactor-map` in `cider-repl-mode`. -* [#2171](https://github.com/clojure-emacs/cider/issues/2171): Update `See Also` mappings for Clojure 1.9. -* [#2202](https://github.com/clojure-emacs/cider/issues/2202): Make `cider-jack-in-clojurescript` prompt from the ClojureScript REPL type to use. -* [#2202](https://github.com/clojure-emacs/cider/issues/2202): Don't try to start a ClojureScript REPL before checking whether that's possible or not. -* [orchard#24](https://github.com/clojure-emacs/orchard/pull/24): Inspector now separately renders clickable keys and values when inspecting maps. -* [orchard#24](https://github.com/clojure-emacs/orchard/pull/24): Inspector now remembers the current page of each level of nesting when navigating big and nested collection. -* Require piggieback 0.3 or newer. -* Drops support for Rhino in favour of the modern Nashorn. - -## 0.16.0 (2017-12-28) - -### New Features - -* [#2082](https://github.com/clojure-emacs/cider/pull/2082), [cider-nrepl#440](https://github.com/clojure-emacs/cider-nrepl/pull/440): Add specialized stacktraces for clojure.spec assertions. -* [#2111](https://github.com/clojure-emacs/cider/pull/2111): Add `cider-pprint-eval-last-sexp-to-comment` and `cider-pprint-eval-defun-to-comment`. -* Add a REPL shortcut for `cider-repl-require-repl-utils` (this makes it easy to require common functions like `doc`, `source`, etc. in REPL buffers). -* [#2112](https://github.com/clojure-emacs/cider/issues/2112): Add a new interactive command `cider-find-keyword` (bound to `C-c C-:`). -* [#2144](https://github.com/clojure-emacs/cider/issues/2144): Create a Docker image to mimic the Travis CI environment. - -### Changes - -* `cider-switch-to-last-clojure-buffer` switches to most recent relevant Clojure(Script) buffer instead of the last "remembered" buffer. -* [cider-nrepl#438](https://github.com/clojure-emacs/cider-nrepl/pull/438): Improve startup time by deferring loading CIDER's middleware until the first usage. -* [#2078](https://github.com/clojure-emacs/cider/pull/2078): Improve startup time by bundling together sync requests during startup. -* `cider-rotate-default-connection` will warn if you use it with only a single active connection. -* `cider-format-buffer` tries to preserve the point position. - -### Bugs Fixed - -* [#2084](https://github.com/clojure-emacs/cider/issues/2084): Select correct REPL type (clj or cljs) in `cider-switch-to-repl-buffer` conditional on the current buffer. -* [#2088](https://github.com/clojure-emacs/cider/issues/2088): Fix functions defined with `def` being font-locked as vars instead of functions. -* [#1651](https://github.com/clojure-emacs/cider/issues/1651), [cider-nrepl#445](https://github.com/clojure-emacs/cider-nrepl/pull/455): Fix `cider-expected-ns` returns `nil` on boot projects. -* [#2120](https://github.com/clojure-emacs/cider/issues/2120): Fix Travis CI build errors for Emacs versions >25.2. -* [#2117](https://github.com/clojure-emacs/cider/pull/2117): Ensure `cider-repl-result-prefix` is only inserted before the first result chunk. -* [#2123](https://github.com/clojure-emacs/cider/issues/2123): Process properly the Java version in Java 9. - -## 0.15.1 (2017-09-13) - -### New Features - -* [#2083](https://github.com/clojure-emacs/cider/pull/2083): New utility function `cider-add-face`. -* [#2083](https://github.com/clojure-emacs/cider/pull/2083): New utility function `cider-run-chained-hook`. -* [#2083](https://github.com/clojure-emacs/cider/pull/2083): New `cider-repl-preoutput-hook` that allows custom output processing. -* [#2083](https://github.com/clojure-emacs/cider/pull/2083): Highlight clojure.spec keywords in REPL (`cider-repl-highlight-spec-keywords` pre-output processor). - -### Changes - -* [#2045](https://github.com/clojure-emacs/cider/issues/2045) `*cider-scratch*` buffers are no longer automatically killed on connection quit. -* [#2083](https://github.com/clojure-emacs/cider/pull/2083): Jump to other window when clicking on location references in REPL. -* [#2083](https://github.com/clojure-emacs/cider/pull/2083): Improve project namespace highlighting in REPLs. -* [#2083](https://github.com/clojure-emacs/cider/pull/2083): Find locations in more cases when clicking on references in REPL. - -### Bugs Fixed - -* [#2004](https://github.com/clojure-emacs/cider/issues/2004), [#2039](https://github.com/clojure-emacs/cider/issues/2039), [cider-nrepl#420](https://github.com/clojure-emacs/cider-nrepl/issues/420): Fix namespace issues in instrumentation and debugging commands. -* Project-Only stacktrace filter: hide all other tags when viewing project-only stacktrace. -* Fix interactive evaluation in cljc buffers with only one connection. -* [#2058](https://github.com/clojure-emacs/cider/pull/2058): Don't cache ns-forms in buffers with no such forms. -* [#2057](https://github.com/clojure-emacs/cider/pull/2057): Use `cider--font-lock-ensure` for compatibility with Emacs 24.5. -* [cider-nrepl#436](https://github.com/clojure-emacs/cider-nrepl/pull/436): Ensure that `*print-right-margin*` is not ignored by cider-nrepl middleware. -* [cider-nrepl#435](https://github.com/clojure-emacs/cider-nrepl/pull/435): Allow debugging of forms with `#?(:cljs ... :clj ..)` conditionals. -* [cider-nrepl#432](https://github.com/clojure-emacs/cider-nrepl/pull/432): Ensure `pprint` is after `load-file`. - -## 0.15.0 (2017-07-20) - -### New Features - -* [#2050](https://github.com/clojure-emacs/cider/pull/2050): Use `view-mode` for `cider-grimoire` buffers -* Make stacktraces and other location references in REPL clickable. -* Highlight root namespace in REPL stacktraces. -* Filter stacktrace to just frames from your project. -* [#1918](https://github.com/clojure-emacs/cider/issues/1918): Add new commands `cider-browse-spec` and `cider-browse-spec-all` which start a spec browser. -* [#2015](https://github.com/clojure-emacs/cider/pull/2015): Show symbols as special forms *and* macros in `cider-doc` -* [#2012](https://github.com/clojure-emacs/cider/pull/2012): Support special forms in `cider-apropos` and `cider-grimoire-lookup`. -* [#2007](https://github.com/clojure-emacs/cider/pull/2007): Fontify code blocks from `cider-grimoire` if possible. -* Add support for notifications from the NREPL server. -* [#1990](https://github.com/clojure-emacs/cider/issues/1990): Add new customation variable `cider-save-files-on-cider-refresh` to allow auto-saving buffers when `cider-refresh` is called. -* Add new function `cider-load-all-files`, along with menu bar update. -* Add new customization variable `cider-special-mode-truncate-lines`. -* Add an option `cider-inspector-fill-frame` to control whether the cider inspector window fills its frame. -* [#1893](https://github.com/clojure-emacs/cider/issues/1893): Add negative prefix argument to `cider-refresh` to inhibit invoking of cider-refresh-functions -* [#1776](https://github.com/clojure-emacs/cider/issues/1776): Add new customization variable `cider-test-defining-forms` allowing new test defining forms to be recognized. -* [#1860](https://github.com/clojure-emacs/cider/issues/1860): Add `cider-repl-history` to browse the REPL input history and insert elements from it into the REPL buffer. -* Add new customization variable `cider-font-lock-reader-conditionals` which toggles syntax highlighting of reader conditional expressions based on the buffer connection. -* Add new face `cider-reader-conditional-face` which is used to mark unused reader conditional expressions. -* [#1544](https://github.com/clojure-emacs/cider/issues/1544): Add a new defcustom `nrepl-use-ssh-fallback-for-remote-hosts` to control the behavior of `nrepl-connect` (and in turn that of `cider-connect`) for remote hosts. -* [#1910](https://github.com/clojure-emacs/cider/issues/1910): Add custom company-mode completion style to show fuzzy completions from Compliment. -* Introduce `cider-*-global-options` for customizing options that are not related to tasks. -* [#1731](https://github.com/clojure-emacs/cider/issues/1731): Change code in order to use the new `cider.tasks/add-middleware` boot tasks. -* [#1943](https://github.com/clojure-emacs/cider/pull/1943): Add interactive function to flush Compliment caches. -* [#1726](https://github.com/clojure-emacs/cider/issues/1726): Order keys in printed nrepl message objects. -* [#1832](https://github.com/clojure-emacs/cider/issues/1832): Add new customization variable `cider-eldoc-display-context-dependent-info` to control showing eldoc info for datomic query input parameters. -* Make it possible to disable auto-evaluation of changed ns forms via the defcustom `cider-auto-track-ns-form-changes`. -* [#1991](https://github.com/clojure-emacs/cider/issues/1832): Make it possible to disable the prompt to open a ClojureScript in a browser on connect via `cider-offer-to-open-cljs-app-in-browser`. -* [#1995](https://github.com/clojure-emacs/cider/pull/1995): Add new customization variable `cider-doc-auto-select-buffer` to control cider-doc popup buffer auto selection. -* Ensure that `cider-current-connection` picks the most recently used connection in ambiguous cases. -* Ensure that `cider-switch-to-repl-buffer` picks the most recent REPL buffer if multiple connections are available. -* Add new function `cider-project-connections-types`. - -### Changes - -* Handle ANSI REPL evaluation created by Puget. -* Drop support for Emacs 24.3. -* Don't try to use ssh automatically when connecting to remote hosts and a direct connection fails. See `nrepl-use-ssh-fallback-for-remote-hosts`. -* [#1945](https://github.com/clojure-emacs/cider/pull/1945): Start nREPL servers bound to `::` by default using `cider-jack-in`. -* Renamed `cider-prompt-save-file-on-load` to `cider-save-file-on-load` and adjust its supported values accordingly (the default now is `'prompt` and `'always-save` is now simply `t`). -* [#2014](https://github.com/clojure-emacs/cider/pull/2014): Unify the format for `forms-str` and `arglists-str`. -* [#2027](https://github.com/clojure-emacs/cider/pull/2027): Mark many custom variables relating to `cider-jack-in` as safe. -* [#2023](https://github.com/clojure-emacs/cider/issues/2023): Make popup-buffer sexp indentation optional. - -### Bugs Fixed - -* [#2040](https://github.com/clojure-emacs/cider/issues/2040): Fix fontification of conditional expressions in cljc files. -* [#2018](https://github.com/clojure-emacs/cider/issues/2018): Don't delete wrong overlays during code evaluation. -* [#1699](https://github.com/clojure-emacs/cider/issues/1699): Fix "Method code too large!" error that occurred during instrumentation for debugging. -* [#1987](https://github.com/clojure-emacs/cider/issues/1987): Fix: Update faces when disabling a theme -* [#1962](https://github.com/clojure-emacs/cider/issues/1962): Fix performance in fringe overlay placement. -* [#1947](https://github.com/clojure-emacs/cider/issues/1947): Fix error on `cider-jack-in` when `enlighten-mode` is enabled. -* [#1588](https://github.com/clojure-emacs/cider/issues/1588): Redirect `*err*`, `java.lang.System/out`, and `java.lang.System/err` to REPL buffer on all attached sessions. -* [#1707](https://github.com/clojure-emacs/cider/issues/1707): Allow to customize line truncating in CIDER's special buffers. -* [#1876](https://github.com/clojure-emacs/cider/issues/1876): Set pretty-printing width with `cider-repl-pretty-print-width`. If this variable is not set, fall back to `fill-column`. -* [#1875](https://github.com/clojure-emacs/cider/issues/1875): Ensure that loading and evaluation in cljc buffers is performed in both clj and cljs repls. -* [#1897](https://github.com/clojure-emacs/cider/issues/1897): Bind TAB in stacktrace buffers in the terminal. -* [#1895](https://github.com/clojure-emacs/cider/issues/1895): Connect to the same host:port after `cider-restart` if the connection was established with `cider-connect`. -* [#1881](https://github.com/clojure-emacs/cider/issues/1881): Add `cider-cljs-boot-repl` and `cider-cljs-gradle-repl` defcustom and hook `boot-cljs-repl`. -* [#1997](https://github.com/clojure-emacs/cider/pull/1997): Fix a nil error when loading a code buffer and the error buffer is visible. -* [#390](https://github.com/clojure-emacs/cider/issues/390): Workaround for orphaned java process on windows machine after quitting the REPL. - -## 0.14.0 (2016-10-13) - -### New Features - -* [#1825](https://github.com/clojure-emacs/cider/issues/1825): Display test input generated by `test.check`. -* [#1769](https://github.com/clojure-emacs/cider/issues/1769): Display function spec in the doc buffers. -* Add a new interactive command `cider-toggle-request-dispatch`. It allows you to quickly toggle between dynamic and static -request dispatch. -* Add a new interactive command `nrepl-toggle-message-logging`. It allows you to quickly toggle nREPL message logging on and off -within the scope of your current Emacs session. -* [#1851](https://github.com/clojure-emacs/cider/issues/1851): Add a command to rerun the last test ran via `cider-test-run-test`. The new command is named `cider-test-rerun-test` and is about to `C-c C-t (C-)g`. -* [#1748](https://github.com/clojure-emacs/cider/issues/1748): Add new interactive command `cider-pprint-eval-last-sexp-to-repl`. -* [#1789](https://github.com/clojure-emacs/cider/issues/1789): Make it easy to change the connection of the cider-scratch buffer from the mode's menu. -* New interactive command `cider-toggle-buffer-connection`. -* [#1861](https://github.com/clojure-emacs/cider/issues/1861): New interactive commands in message log buffer `nrepl-log-expand-button` and `nrepl-log-expand-all-buttons`. -* [#1872](https://github.com/clojure-emacs/cider/issues/1872): Add new value `display-only` for option `cider-repl-pop-to-buffer-on-connect` that allows for showing the REPL buffer without focusing it. - -### Changes - -* [#1758](https://github.com/clojure-emacs/cider/issues/1758): Disable nREPL message logging by default due to its negative impact on performance. -* Warn when running `cider-jack-in` without a Clojure project. This behavior is controllable via `cider-allow-jack-in-without-project`. - -### Bugs Fixed - -* [#1677](https://github.com/clojure-emacs/cider/issues/1677): Interpret `\r` as a newline. -* [#1819](https://github.com/clojure-emacs/cider/issues/1819): Handle properly missing commands on `cider-jack-in`. -* Add option to define exclusions for injected dependencies. Fixes [#1824](https://github.com/clojure-emacs/cider/issues/1824): Can no longer jack-in to an inherited clojure version. -* [#1820](https://github.com/clojure-emacs/cider/issues/1820): Don't try to display eldoc in EDN buffers. -* [#1823](https://github.com/clojure-emacs/cider/issues/1823): Fix column location metadata set by interactive evaluation. -* [#1859](https://github.com/clojure-emacs/cider/issues/1859): Make nREPL message log much faster. `nrepl-dict-max-message-size` custom variable was removed. -* [#1613](https://github.com/clojure-emacs/cider/issues/1859): Check whether a before/after refresh function is resolvable. - -## 0.13.0 (2016-07-25) - -### New Features - -* Add an option `nrepl-prompt-to-kill-server-buffer-on-quit` to control whether killing nREPL server buffer and process requires a confirmation prompt. -* [#1672](https://github.com/clojure-emacs/cider/issues/1672): Allow setting a preferred build tool when multiple are found via `cider-preferred-build-tool`. -* Ensure Clojure version meets minimum supported by CIDER (1.7.0). -* Fringe indicators highlight which sexps have been loaded. Disable it with `cider-use-fringe-indicators`. -* New command: `cider-inspect-last-result`. -* `cider-cljs-lein-repl` now also supports figwheel. -* Option `cider-jack-in-auto-inject-clojure` enables the user to specify a - version of Clojure for CIDER. This allows the user to override the version - used in a project, particular if it is lower than minimum required for CIDER. -* Allow the ns displayed by eldoc to be tailored via `cider-eldoc-ns-function`. -* After connecting a ClojureScript REPL, CIDER will try to figure out if it's being served on a port and will offer to open it in a browser. -* [#1720](https://github.com/clojure-emacs/cider/issues/1720): Add a command `cider-eval-sexp-at-point` to evaluate the form around point (bound to `C-c C-v v`). -* [#1564](https://github.com/clojure-emacs/cider/issues/1564): CIDER's internal namespaces and vars are filtered from the ns-browser and apropos functions. -* [#1725](https://github.com/clojure-emacs/cider/issues/1725): Display class names in eldoc for interop forms. -* [#1572](https://github.com/clojure-emacs/cider/issues/1572): Add support for variables in eldoc. -* [#1736](https://github.com/clojure-emacs/cider/issues/1736): Show "See Also" links for functions/variables in documentation buffers. -* [#1767](https://github.com/clojure-emacs/cider/issues/1767): Add a command `cider-read-and-eval-defun-at-point` to insert the defun at point into the minibuffer for evaluation (bound to `C-c C-v .`). -* [#1646](https://github.com/clojure-emacs/cider/issues/1646): Add an option `cider-apropos-actions` to control the list of actions to be applied on the symbol found by an apropos search. -* [#1783](https://github.com/clojure-emacs/cider/issues/1783): Put eval commands onto single map bound to `C-c C-v`. -* [#1804](https://github.com/clojure-emacs/cider/issues/1804): Remember cursor position between `cider-inspector-*` operations. - -### Changes - -* Simpler keybindings in macroexpand buffer. Expand one step with `m` and all expansions with `a`. Previously was `C-c C-m` and `C-c M-m`. -* Signal an error sooner if the user misconfigured `cider-known-endpoints`. -* `cider-inspect-read-and-inspect` is obsolete. Use `cider-inspect-expression` instead. -* Extremely long overlays are truncated and `cider-inspect-last-result` is recommended. -* Signal `user-error` instead of `error` on jack-in if a project type is not supported. -* Users with `boot.sh` instead of `boot` should customize `cider-boot-command` instead of relying on automatic detection. -* [#1737](https://github.com/clojure-emacs/cider/issues/1737): Show value of locals in debugger tooltip. -* Rebind `cider-eval-last-sexp-and-replace` to `C-c C-v w`. -* Rebind `cider-eval-region` to `C-c C-v r`. -* Rebind `cider-eval-ns-form` to `C-c C-v n`. -* [#1577](https://github.com/clojure-emacs/cider/issues/1577): Show first line of docstring in ns browser. -* `cider-repl-closing-return` (`C-<Return>`) now also completes brackets (`[]`) and curly braces (`{}`) in an expression. - -### Bugs fixed - -* [#1755](https://github.com/clojure-emacs/cider/issues/1755): Impossible completion for multiple zombie REPL buffers. -* [#1712](https://github.com/clojure-emacs/cider/issues/1712): Bad compilation issue caused when installed along with `nim-mode`. -* Fix arglist display for `def` in the doc buffer. -* Use `cider-apropos-select` instead of `cider-apropos` in `cider-apropos-documentation-select`. -* [#1561](https://github.com/clojure-emacs/cider/issues/1561): Use an appropriate font-lock-face for variables, macros and functions in -the ns-browser. -* [#1708](https://github.com/clojure-emacs/cider/issues/1708): Fix `cider-popup-buffer-display` when another frame is used for the error buffer. -* [#1733](https://github.com/clojure-emacs/cider/pull/1733): Better error handling when no boot command is found in `exec-path`. -* Fix orphaned nrepl-messages buffer after `cider-quit`. -* [#1782](https://github.com/clojure-emacs/cider/issues/1782): Disable mouse-over tooltips when `help-at-pt-display-when-idle` is non-nil. -* [#1811](https://github.com/clojure-emacs/cider/issues/1811): Handle properly jack-in commands with spaces in them. - -## 0.12.0 (2016-04-16) - -### New Features - -* Option `cider-use-tooltips` controls the display of mouse-over tooltips. -* `f` key reruns failed tests on the test-report buffer. -* `g` key reruns test at point on the test-report buffer. -* Debugger now supports step-in. -* Improve CIDER's menu-bar menu: - - Thoroughly reorganize it and split it into 3 separate menus; - - Add custom-written `:help` strings to some items, and automatically add help strings to the rest; - - Add a few commands; - - Grey-out commands that rely on connections while there is no connection. -* Var docstrings are automatically displayed in mouse-over tooltips. -* [#1636](https://github.com/clojure-emacs/cider/pull/1636): New minor-mode `cider-auto-test-mode` for test-driven-development. When activated, tests are rerun after every load-file. -* Javadoc commands take into account the variable `clojure.java.javadoc/*remote-javadocs*`. -* Javadoc also works on classes of the AmazonAWS Java SDK. -* Apropos commands now accept lists of space-separated words as arguments, in addition to regular expressions (similar to Emacs's own apropos commands). -* [#1541](https://github.com/clojure-emacs/cider/issues/1541): New commands `cider-apropos-select` (bound to `C-c C-d C-s`) and `cider-apropos-documentation-select` (bound to `C-c C-d c-e`). -* New function `cider-expected-ns` is like `clojure-expected-ns`, but uses classpath for better results. See [clojure-mode#372](https://github.com/clojure-emacs/clojure-mode/issues/372). -* A double prefix argument (`C-u C-u`) for `cider-eval-defun-at-point` debugs the sexp at point instead of the entire defun, and offers to create a conditional breakpoint. -* New command `cider-load-all-project-ns` allows you to load all project namespaces. -* Display eldoc for keywords used to get map keys. -* Display eldoc for `Classname.`. -* Display namespace in eldoc. -* [cider-nrepl#313](https://github.com/clojure-emacs/cider-nrepl/issues/313): Selectively suppress user-specified categories of middleware errors from foregrounding stacktrace buffers via the `cider-stacktrace-suppressed-errors` variable. - -### Changes - -* Doc buffer splits arglists into several lines. -* Changed the face of the words “Macro” and “Special form” in the doc buffer to be easier to see. -* Display multi-line eval overlays at the start of the following line. It looked weird that these overlays started on the middle of a line, but then folded onto the start of following lines. -* [#1627](https://github.com/clojure-emacs/cider/issues/1627): Align the terminology used by `cider-test` with the one used by lein and boot (use the terms `assertion` and `test`). -* Remove the warning about missing nREPl ops. -* [#1420](https://github.com/clojure-emacs/cider/issues/1420): Show stacktrace buffers for sync requests errors. - -### Bugs fixed - -* [cider-nrepl#329](https://github.com/clojure-emacs/cider-nrepl/pull/329): Fix error instrumenting functions that call clojure.tools.logging. -* [#1643](https://github.cim/clojure-emacs/cider/issues/1643): Running tests no longer deletes unrelated overlays. -* [#1632](https://github.com/clojure-emacs/cider/pull/1632): Redefining a function correctly updates eldoc. -* [#1630](https://github.com/clojure-emacs/cider/pull/1630): The debugger no longer gets confused inside `@` redefs. -* [#1599](https://github.com/clojure-emacs/cider/pull/1599): Don't error when test makes 0 assertions. -* [#1563](https://github.com/clojure-emacs/cider/issues/1563): Handle invalid regular expressions in apropos. -* [#1625](https://github.com/clojure-emacs/cider/issues/1625): Display a more meaningful message when running -an individual test using `C-c C-t t`. -* Fix buffer closing in `cider-close-ancillary-buffers`. -* Dynamic font-locking is also refreshed when a file's namespace depends on a namespace that was changed, so the traced-face should be immediately updated even on functions from another namespace. -* [#1656](https://github.com/clojure-emacs/cider/issues/1656): Apply ansi colors to output when doing eval and print. - -## 0.11.0 (2016-03-03) - -### New features - -* [#1545](https://github.com/clojure-emacs/cider/pull/1545): New feature: Enlighten. See the new Readme section for more information. -* [#1169](https://github.com/clojure-emacs/cider/pull/1169): New command `cider-eval-defun-to-comment`. -* Change default value of `cider-overlays-use-font-lock` to `t`. Unlike before, a value of `t`, causes `cider-result-overlay-face` is to be prepended to the font-lock faces (instead of just not being used). -* `cider-result-overlay-face` default value changed to a background and a box, so it can be prepended to other faces without overriding the foreground. -* [#1518](https://github.com/clojure-emacs/cider/pull/1518): Add `cider-dynamic-indentation` defcustom, to disable dynamic indent functionality. -* Font-lock traced vars. -* New defcustom, `cider-pprint-fn`, allows you to set the function to use when pretty-printing evaluation results. -* [#1432](https://github.com/clojure-emacs/cider/issues/1432): Show explicit error messages when invoking commands with no ClojureScript support. -* [#1463](https://github.com/clojure-emacs/cider/issues/1463): Assume that `cider-connect` is invoked from within a project, -and try to associate the created connection with this project automatically. -* Typing `s` in a debug session shows the current stack. -* Typing `h` (as in *h*ere) skips all sexps until the current point position. -* [#1507](https://github.com/clojure-emacs/cider/issues/1507): Add the ability to control the REPL's scroll on output functionality via `cider-repl-scroll-on-output`. -* [#1543](https://github.com/clojure-emacs/cider/issues/1543): Add some getting started instructions to the welcome banner. -* New command `cider-drink-a-sip`. Use in case you're thirsty for knowledge. -* Make the connection message configurable via `cider-connection-message-fn`. This means now you can have any function (e.g. `cider-random-tip`) provide the second part of the message. -* New command `cider-repl-clear-banners`. -* New command `cider-repl-clear-help-banner`. - -### Changes - -* [#1531](https://github.com/clojure-emacs/cider/issues/1531) `cider-jack-in` now injects its own dependencies using CLI. Both leiningen and boot are supported. Set `cider-inject-dependencies-at-jack-in` to nil to opt out. Extension point for other tools to inject their own dependencies is `cider-add-repl-dependencies`. -* `cider-inspect` now operates by default on the last sexp. Its behavior can be altered via prefix arguments. -* Requires Clojure(Script) 1.7 or newer. -* Requires Java 7 or newer. -* Improve stacktrace presentation of compiler errors (readability, DWIM point positioning). -* [#1458](https://github.com/clojure-emacs/cider/issues/1458): Separate nREPL messages by connections instead of by sessions. -* [#1226](https://github.com/clojure-emacs/cider/issues/1226): Enable running of all loaded and all project tests. -* Give test commands their own keybinding prefix (`C-c C-t`). Use both single-key and - `Control` + letter mnemonics for these commands (as for the documentation - commands). -* `cider-test` commands now have keybindings in `cider-repl-mode`. The keybindings are exactly the same as those in `cider-mode`. -* Changed the binding of `cider-apropos-documentation` to `C-c C-d f` and `C-c C-d C-f` (it was `C-c C-d A`). -* [#1584](https://github.com/clojure-emacs/cider/issues/1584): Don't enable `eldoc-mode` automatically in `cider-repl-mode`. -* [#1585](https://github.com/clojure-emacs/cider/issues/1585): Show the eval command in the debugger's prompt. - -### Bugs fixed - -* [#1578](https://github.com/clojure-emacs/cider/issues/1578): nrepl-server-filter called with dead process buffer in Windows. -* [#1441](https://github.com/clojure-emacs/cider/issues/1441): Don't popup a buffer that's already displayed. -* [#1557](https://github.com/clojure-emacs/cider/issues/1557): When a sibling REPL is started by hasn't yet turned into a cljs REPL, it won't hijack clj requests. -* [#1562](https://github.com/clojure-emacs/cider/issues/1562): Actually disable cider-mode when it gets disabled. -* [#1540](https://github.com/clojure-emacs/cider/issues/1540): Fix cider-complete-at-point. -* [cider-nrepl#294](https://github.com/clojure-emacs/cider-nrepl/issues/294): Handle errors in the `complete-doc` nREPL op. -* [#1493](https://github.com/clojure-emacs/cider/issues/1493): Support special forms in eldoc. -* [#1529](https://github.com/clojure-emacs/cider/issues/1529): Close nREPL message buffer when you quit its matching connection. -* [#707](https://github.com/clojure-emacs/cider/issues/707): Better support clojure.test/with-test. -* Fix namespace navigation in the namespace browser. -* [#1565](https://github.com/clojure-emacs/cider/issues/1565): Fix font-locking in apropos buffers. -* [#1570](https://github.com/clojure-emacs/cider/issues/1570): Handle properly rest params in eldoc. - -## 0.10.2 (2016-01-27) - -### Changes - -* `cider-current-connection` actually, really considers major mode before `cider-repl-type`. - -### Bugs fixed - -* [#1521](https://github.com/clojure-emacs/cider/pull/1521): Don't assume the REPL buffer is in the current frame in `cider-repl--show-maximum-output`. - -## 0.10.1 (2016-01-05) - -### Changes - -* Suppress eldoc when the current sexp seems to be too large. -* [#1500](https://github.com/clojure-emacs/cider/pull/1500): Improve the performance of REPL buffers by using text properties instead of overlays for ANSI coloring. -* `cider-current-connection` considers major mode before `cider-repl-type`. - -### Bugs fixed - -* [#1450](https://github.com/clojure-emacs/cider/pull/1450): Fix an error in `cider-restart` caused by a reference to a killed buffer. -* [#1456](https://github.com/clojure-emacs/cider/issues/1456): Don't font-lock buffer if font-lock-mode is OFF. -* [#1459](https://github.com/clojure-emacs/cider/issues/1459): Add support for dynamic dispatch in scratch buffers. -* [#1466](https://github.com/clojure-emacs/cider/issues/1466): Correctly font-lock pretty-printed results in the REPL. -* [#1475](https://github.com/clojure-emacs/cider/pull/1475): Fix `args-out-of-range` error in `cider--get-symbol-indent`. -* [#1479](https://github.com/clojure-emacs/cider/pull/1479): Make paredit and `cider-repl-mode` play nice. -* [#1452](https://github.com/clojure-emacs/cider/issues/1452): Fix wrong ANSI coloring in the REPL buffer. -* [#1486](https://github.com/clojure-emacs/cider/issues/1486): Complete a partial fix in stacktrace font-locking. -* [#1482](https://github.com/clojure-emacs/cider/issues/1482): Clear nREPL sessions when a connection is closed. -* [#1435](https://github.com/clojure-emacs/cider/issues/1435): Improve error display in cider-test. -* [#1379](https://github.com/clojure-emacs/cider/issues/1379): Fix test highlighting at start of line. -* [#1490](https://github.com/clojure-emacs/cider/issues/1490): Don't display the inspector buffer when evaluation fails. - -## 0.10.0 (2015-12-03) - -### New features - -* [#1406](https://github.com/clojure-emacs/cider/issues/1406): When running tests, report test ns in minibuffer messages. -* [#1402](https://github.com/clojure-emacs/cider/pull/1402): When tests pass after previously failing, update the test-report buffer to show success. -* [#1373](https://github.com/clojure-emacs/cider/issues/1373): Add gradle support for `cider-jack-in`. -* Indentation of macros (and functions) [can be specified](https://docs.cider.mx/cider/config/indentation.html#_dynamic_indentation) in the var's metadata, via [indent specs](https://docs.cider.mx/cider/indent_spec.html). -* [Abbreviated printing](https://github.com/clojure-emacs/cider-nrepl/pull/268) for functions multimethods. Instead of seeing `#object[clojure.core$_PLUS_ 0x4e648e99 "clojure.core$_PLUS_@4e648e99"]` you'll see `#function[clojure.core/+]`. -* [#1376](https://github.com/clojure-emacs/cider/pull/1376): Anything printed to `*out*` outside an eval scope is also forwarded to all nREPL sessions connected from CIDER. Normally it would only be sent to the server's `out`. -* [#1371](https://github.com/clojure-emacs/cider/issues/1371): Font-lock deprecated vars with a background color. -* [#1232](https://github.com/clojure-emacs/cider/pull/1232): Add `cider-load-buffer-and-switch-to-repl-buffer`. -* [#1325](https://github.com/clojure-emacs/cider/issues/1325): Jump to error location when clicking on the error message in the stack-trace pop-up. -* [#1301](https://github.com/clojure-emacs/cider/issues/1301): CIDER can do dynamic font-locking of defined variables, functions, and macros. This is controlled by the `cider-font-lock-dynamically` custom option. -* [#1271](https://github.com/clojure-emacs/cider/issues/1271): New possible value (`always-save`) for `cider-prompt-save-file-on-load`. -* [#1197](https://github.com/clojure-emacs/cider/issues/1197): Display some indication that we're waiting for a result for long-running evaluations. -* [#1127](https://github.com/clojure-emacs/cider/issues/1127): Make it possible to associate a buffer with a connection (via `cider-assoc-buffer-with-connection`). -* [#1217](https://github.com/clojure-emacs/cider/issues/1217): Add new command `cider-assoc-project-with-connection` to associate a project directory with a connection. -* [#1248](https://github.com/clojure-emacs/cider/pull/1248): Add <kbd>TAB</kbd> and <kbd>RET</kbd> keys to the test-report buffer. -* [#1245](https://github.com/clojure-emacs/cider/pull/1245): New variable, `cider-overlays-use-font-lock` controls whether results overlay should be font-locked or just use a single face. -* [#1235](https://github.com/clojure-emacs/cider/pull/1235): Add support for syntax-quoted forms to the debugger. -* [#1212](https://github.com/clojure-emacs/cider/pull/1212): Add pagination of long collections to inspector. -* [#1237](https://github.com/clojure-emacs/cider/pull/1237): Add two functions for use with `cider-repl-prompt-function`, `cider-repl-prompt-lastname` and `repl-prompt-abbreviated`. -* [#1201](https://github.com/clojure-emacs/cider/pull/1201): Integrate overlays with interactive evaluation. `cider-use-overlays` can be used to turn this on or off. -* [#1195](https://github.com/clojure-emacs/cider/pull/1195): CIDER can [create cljs REPLs](https://github.com/clojure-emacs/cider#clojurescript-usage). -* [#1191](https://github.com/clojure-emacs/cider/pull/1191): New custom variables `cider-debug-print-level` and `cider-debug-print-length`. -* [#1188](https://github.com/clojure-emacs/cider/pull/1188): New debugging tool-bar. -* [#1187](https://github.com/clojure-emacs/cider/pull/1187): The list of keys displayed by the debugger can be configured with `cider-debug-prompt`. -* [#1187](https://github.com/clojure-emacs/cider/pull/1187): While debugging, there is a menu on the menu-bar listing available commands. -* [#1184](https://github.com/clojure-emacs/cider/pull/1184): When the user kills the REPL buffer, CIDER will offer to kill the nrepl buffer and process too. Also, when the client (repl) process dies, the server (nrepl) process is killed too. -* [#1182](https://github.com/clojure-emacs/cider/pull/1182): New command `cider-browse-instrumented-defs`, displays a buffer listing all definitions currently instrumented by the debugger. -* [#1182](https://github.com/clojure-emacs/cider/pull/1182): Definitions currently instrumented by the debugger are marked with a red box in the source buffer. -* [#1174](https://github.com/clojure-emacs/cider/pull/1174): New command `cider-run`, runs the project's `-main` function. -* [#1176](https://github.com/clojure-emacs/cider/pull/1176): While debugging, cider's usual eval commands will evaluate code in the current lexical context. Additionally, the <kbd>l</kbd> key now inspects local variables. -* [#1149](https://github.com/clojure-emacs/cider/pull/1149): [Two new ways](https://github.com/clojure-emacs/cider#debugging) to debug code, the `#break` and `#dbg` reader macros. -* [#1219](https://github.com/clojure-emacs/cider/pull/1219): The output of `cider-refresh` is now sent to a dedicated `*cider-refresh-log*` buffer. -* [#1219](https://github.com/clojure-emacs/cider/pull/1219): New custom variables `cider-refresh-before-fn` and `cider-refresh-after-fn`. -* [#1220](https://github.com/clojure-emacs/cider/issues/1220): Treat keywords as symbols in lookup commands like `cider-find-var`. -* [#1241](https://github.com/clojure-emacs/cider/pull/1241): Passing a double prefix argument to `cider-refresh` will now clear the state of the namespace tracker used by the refresh middleware. This is useful for recovering from errors that a normal reload would not otherwise recover from, but may cause stale code in any deleted files to not be completely unloaded. -* New defcustom `cider-result-use-clojure-font-lock` allows you disable the use of Clojure font-locking for interactive results. -* [#1239](https://github.com/clojure-emacs/cider/issues/1239): New defcustom `cider-refresh-show-log-buffer`, controls the behavior of the `*cider-refresh-log*` buffer when calling `cider-refresh`. When set to nil (the default), the log buffer will still be written to, but not displayed automatically. Instead, the most relevant information will be displayed in the echo area. When set to non-nil, the log buffer will be displayed every time `cider-refresh` is called. -* [#1328](https://github.com/clojure-emacs/cider/issues/1328): Auto-scroll the `*nrepl-server*` buffer on new output. -* [#1300](https://github.com/clojure-emacs/cider/issues/1300): Add the ability to replicate an existing connection with `cider-replicate-connection`. -* [#1330](https://github.com/clojure-emacs/cider/issues/1330): Leverage nREPL 0.2.11's source-tracking feature. -* [#1392](https://github.com/clojure-emacs/cider/issues/1392): Track definitions made in the REPL. -* [#1337](https://github.com/clojure-emacs/cider/issues/1337): Added a command to switch between the Clojure and ClojureScript REPLs in the same project (bound to <kbd>C-c M-o</kbd> in `cider-repl-mode`). - -### Changes - -* [#1299](https://github.com/clojure-emacs/cider/issues/1299) <kbd>C-c C-k</kbd> and <kbd> C-c C-l</kbd> now dispatch to both the Clojure and ClojureScript REPL (in the same project) when called from a `.cljc` or `.cljx` file. -* [#1397](https://github.com/clojure-emacs/cider/issues/1297) <kbd>C-c M-n</kbd> now changes the ns of both the Clojure and ClojureScript REPL (in the same project) when called from a cljc or cljx file. -* [#1348](https://github.com/clojure-emacs/cider/issues/1348): Drop the dash dependency. -* The usage of the default connection has been reduced significantly. Now evaluations & related commands will be routed via the connection matching the current project automatically unless there's some ambiguity when determining the connection (like multiple or no matching connections). Simply put you'll no longer have to mess around much with connecting-setting commands (e.g. `nrepl-connection-browser`, `cider-rotate-default-connection`). -* [#732](https://github.com/clojure-emacs/cider/issues/732): `cider-quit` and `cider-restart` now operate on the current connection only. With a prefix argument they operate on all connections. -* `nrepl-log-messages` is now set to `t` by default. -* Renamed `cider-repl-output-face` to `cider-repl-stdout-face` and `cider-repl-err-output-face` to `cider-repl-stderr-face`. -* Clearing the REPL buffer is now bound to `C-u C-C C-o`. -* [#1422](https://github.com/clojure-emacs/cider/issues/1422): Don't display mismatching parens error on incomplete expressions in REPL buffers. -* [#1412](https://github.com/clojure-emacs/cider/issues/1412): nREPL messages for separate sessions are tracked in separate buffers. -* Removed `cider-switch-to-repl-command`. -* Renamed `cider-default-repl-command` to `cider-jack-in-default`. - -### Bugs fixed - -* [#1384](https://github.com/clojure-emacs/cider/pull/1384): Match windows file names in `cider-compilation-regexp`. -* [#1252](https://github.com/clojure-emacs/cider/issues/1252) `cider-repl-clear-buffer` stops working in certain circumstances. -* [#1164](https://github.com/clojure-emacs/cider/pull/1164): Fix an error in `cider-browse-ns--doc-at-point`. -* [#1189](https://github.com/clojure-emacs/cider/issues/1189): Don't show result from automatic ns form evaluation. -* [#1079](https://github.com/clojure-emacs/cider/issues/1079): Don't try to font-lock very long results. The maximum font-lockable result length is controlled by `cider-font-lock-max-length`. - -## 0.9.1 (2015-06-24) - -### New features - -* [#1155](https://github.com/clojure-emacs/cider/pull/1155): The debugger displays overlays highlighting the current sexp and its return value. - -### Bugs fixed - -* [#1142](https://github.com/clojure-emacs/cider/issues/1142): Don't retrieve nrepl ports when `cider-known-endpoints` entry already contains the port. -* [#1153](https://github.com/clojure-emacs/cider/pull/1153): Fix behavior of `cider-switch-to-current-repl-buffer`. -* [#1139](https://github.com/clojure-emacs/cider/issues/1139): Fix evaluation of ns forms and of forms with unevaluated namespaces. -* Replace `assert` with `cl-assert` (we don't use anything from `cl` now). -* [#1135](https://github.com/clojure-emacs/cider/pull/1135): Fix a corner case with locals display in the debugger. -* [#1129](https://github.com/clojure-emacs/cider/issues/1129): Fix occasional `(wrong-type-argument stringp nil)` on clojure-android. -* [#1122](https://github.com/clojure-emacs/cider/issues/1122): Run client initialization in new client buffer. -* [#1143](https://github.com/clojure-emacs/cider/issues/1143): Handle tests without location metadata. - -## 0.9.0 (2015-06-16) - -### New features - -* [#1109](https://github.com/clojure-emacs/cider/issues/1109): New defcustom `cider-auto-mode`. -On by default, when `nil` don't automatically enable `cider-mode` in all Clojure buffers. -* [#1061](https://github.com/clojure-emacs/cider/issues/1061): New command `cider-find-ns`, bound to <kbd>C-c C-.</kbd>, which prompts for an ns and jumps to the corresponding source file. -* [#1019](https://github.com/clojure-emacs/cider/pull/1019): New file, cider-debug.el. - Provides a new command, `cider-debug-defun-at-point`, bound to <kbd>C-u C-M-x</kbd>. - Interactively debug top-level clojure forms. -* New defcustom, `cider-auto-select-test-report-buffer` (boolean). - Controls whether the test report buffer is selected after running a test. Defaults to true. -* Trigger Grimoire doc lookup from doc buffers by pressing <kbd>g</kbd> (in Emacs) and <kbd>G</kbd> (in browser). -* [#903](https://github.com/clojure-emacs/cider/pull/903): Isolate - `nrepl-client` connection logic from CIDER. New hooks `cider-connected-hook` - and `cider-disconnected-hook`. -* [#920](https://github.com/clojure-emacs/cider/issues/920): Support `cider-jack-in` for boot-based projects. -* [#949](https://github.com/clojure-emacs/cider/issues/949): New custom var: `cider-default-repl-command`. -* New code formatting commands - `cider-format-buffer`, `cider-format-region` and `cider-format-defun`. -* New data formatting commands - `cider-format-edn-buffer` and `cider-format-edn-region`. -* New insert region in REPL command - `cider-insert-region-in-repl`. -* Pretty printing functionality moved to middleware, adding support for ClojureScript. - - New command to eval and pprint result: `cider-interactive-pprint-eval`. - - `cider-format-pprint-eval` has been removed. -* Warn when used with incompatible nREPL server. -* Allow the prompt to be tailored by adding `cider-repl-prompt-function` and `cider-repl-default-prompt`. -* Support for middleware-annotated completion candidates. - - `cider-annotate-completion-function` controls how the annotations are formatted. - - `cider-completion-annotations-alist` controls the abbreviations used in annotations. - - `cider-completion-annotations-include-ns` controls when to include the candidate namespace in annotations. -* Inspector middleware now relies on `eval` middleware, adding support for ClojureScript. -* Better printing of large amounts of exception cause data in the error buffer. - - New defcustom, `cider-stacktrace-print-length` (boolean). -* [#958](https://github.com/clojure-emacs/cider/pull/958): Reuse existing repl - buffers with dead processes. Users are now informed about existing zombie repl - buffers and are offered the choice to reuse those for new connections. -* New defcustom, `cider-prompt-for-symbol`. Controls whether to prompt for - symbol when interactive commands require one. Defaults to t, which always - prompts. Currently applies to all documentation and source lookup commands. -* [#1032](https://github.com/clojure-emacs/cider/issues/1032): New functions, `cider-find-dwim` and - `cider-find-dwim-other-window`. These functions combine the functionality of `cider-jump-to-var` and - `cider-jump-to-resource`. Which are now renamed to `cider-find-var` and `cider-find-resource` respectively. -* [#1014](https://github.com/clojure-emacs/cider/issues/1014): A prefix of <kbd>-</kbd> causes `cider-find-var` and - `cider-find-resource` to show results in other window. Additionally, a double prefix argument <kbd>C-u C-u</kbd> - inverts the meaning of `cider-prompt-for-symbol` and shows the results in other window. -* [#1062](https://github.com/clojure-emacs/cider/issues/1062): Added completion candidates to `cider-find-resource`. -* Middleware support for Piggieback 0.2.x. -* In the namespace browser, `d` and `s` are now bound to show the documentation - or the source respectively for the symbol at point. -* [#1090](https://github.com/clojure-emacs/cider/issues/1090): New defcustom, - `cider-macroexpansion-print-metadata` (boolean). Controls whether metadata of - forms is included in macroexpansion results. Defaults to nil. - -### Changes - -* Display the current connection instead of the current namespace in `cider-mode`'s modeline. -* [#1078](https://github.com/clojure-emacs/cider/issues/1078): Removed - `cider-load-fn-into-repl-buffer`, previously bound to `C-c M-f` in the REPL. -* [#1019](https://github.com/clojure-emacs/cider/pull/1019): - <kbd>C-u C-M-x</kbd> no longer does `eval-defun`+print-result. Instead it debugs the form at point. -* [#854](https://github.com/clojure-emacs/cider/pull/854): Error navigation now - favors line information reported by the stacktrace, being more detailed than - the info reported by `info` middleware. -* [#854](https://github.com/clojure-emacs/cider/pull/854): Add `nrepl-dict` constructor. -* [#934](https://github.com/clojure-emacs/cider/issues/934): Remove - `cider-turn-on-eldoc-mode` in favor of simply using `eldoc-mode`. -* [#953](https://github.com/clojure-emacs/cider/pull/953): Use `sshx` instead of `ssh` in `cider-select-endpoint`. -* [#956](https://github.com/clojure-emacs/cider/pull/956): Eval full ns form only when needed. -* Enable annotated completion candidates by default. -* [#1031](https://github.com/clojure-emacs/cider/pull/1031): Interactive functions prompt with - symbol at point as a default value. -* Remapped `cider-grimoire` to <kbd>C-c C-d r</kbd> & <kbd>C-c C-d C-r</kbd> -to avoid conflicts with <kbd>C-g</kbd>. -* [#1088](https://github.com/clojure-emacs/cider/issues/1088): Kill the -source-tracking evaluation hack as it wasn't compatible with ClojureScript. -* Removed `clojure-enable-cider` and `clojure-disable-cider`. - -### Bugs fixed - -* [#921](https://github.com/clojure-emacs/cider/issues/921): Fixed -non-functioning `cider-test-jump` from test reports. -* [#962](https://github.com/clojure-emacs/cider/pull/962): On error don't auto-jump to tooling files. -* [#909](https://github.com/clojure-emacs/cider/issues/909): Fixed -`cider-repl-set-ns`'s behavior for ClojureScript. -* [#950](https://github.com/clojure-emacs/cider/issues/950): Eval `ns` form in the -`user` namespace when using `cider-interactive-eval`. -* [#954](https://github.com/clojure-emacs/cider/issues/954): Detect properly a project's root -when in buffer that's not visiting a file (e.g. a REPL buffer). -* [#977](https://github.com/clojure-emacs/cider/issues/977): `cider-format-region` now respects indentation of the region start position. -* [#979](https://github.com/clojure-emacs/cider/issues/979): Fixed the inspector buffer popping up needlessly. -* [#981](https://github.com/clojure-emacs/cider/issues/981): Updated `cider-find-file` to use `find-buffer-visiting` instead of `get-file-buffer`. -* [#1004](https://github.com/clojure-emacs/cider/issues/1004): `:repl-env` key is now filtered from exception causes, as it contains unprintably large strings of compiled javascript when using ClojureScript. -* Tunneled ssh connection now deals correctly with the ssh password request. -* [#1033](https://github.com/clojure-emacs/cider/issues/1033): Removed erroneous underlining from stacktrace frames and disabled frame filters in the error buffer. -* The error buffer no longer pops up when there is no error to display. -* `cider-find-resource` now correctly throws an error when no path is provided. -* [#946](https://github.com/clojure-emacs/cider/issues/946): `cider-stacktrace-mode` is now enabled before the error buffer is displayed. -* [#1077](https://github.com/clojure-emacs/cider/issues/1077): Respect `cider-repl-display-in-current-window` in `cider-switch-to-last-clojure-buffer`. - -## 0.8.2 (2014-12-21) - -### Bugs fixed - -* [#867](https://github.com/clojure-emacs/cider/issues/867): Update Grimoire URL to fix (cider-grimoire-lookup) regression due to HTTP 301 (Moved Permanently). -* [#883](https://github.com/clojure-emacs/cider/issues/883): Encode properly the javadoc url. -* [#824](https://github.com/clojure-emacs/cider/issues/824): Fix REPL font-locking. -* [#888](https://github.com/clojure-emacs/cider/issues/888): Handle comments in `cider-repl-mode`. -* [#830](https://github.com/clojure-emacs/cider/issues/830): Stop using `load-file` for most interactive evaluation commands. -* [#885](https://github.com/clojure-emacs/cider/issues/885): Translate nREPL-delivered map keys to symbols before adding as text properties. -* Fix tab completion in `cider-read-from-minibuffer`. -* [#894](https://github.com/clojure-emacs/cider/issues/894): Make it possible to enter any symbol with `cider-read-symbol-name`. -* Report Clojure's version including its qualifier (e.g. `alpha4`) if present. -* Use the `field` text property to make move-beginning-of-line respect the REPL prompt instead of writing our own beginning-of-line commands. - -## 0.8.1 (2014-11-20) - -### Bugs fixed - -* Fixed version mismatch warning on CIDER startup (the actual bug was in `cider-nrepl`). - -## 0.8.0 (2014-11-20) - -### New features - -* `cider-auto-jump-to-error` accepts new option `'errors-only` -* `cider-connect` now asks for remote hosts defined in machine-wide `ssh` - configuration files and automatically detects running instances of lein - server, both on local and remote machines. -* New defcustom `cider-stacktrace-print-level`. Controls the `*print-level*` used when - pretty printing an exception cause's data. Defaults to 50. -* New interactive command `cider-undef`. -* New interactive command `cider-clear-compilation-highlights`. -* First pass at a CIDER quick reference card. -* `completion-at-point` now annotates functions, macros and special forms, thus making it -simpler to gain understanding of what you're using (disabled by default). -* When invoked with a prefix argument `cider-quit` doesn't ask for confirmation. -* Enhance stacktrace to definition navigation to work for interactively defined vars. -* New vars: `cider-to-nrepl-filename-function` and `cider-from-nrepl-filename-function` -are used to translate filenames from/to the nREPL server (default Cygwin implementation provided). -* Java classpath browser (`M-x cider-classpath`). -* Clojure namespace browser (`M-x cider-browse-ns` and `M-x cider-browse-ns-all`). -* Added the ability to jump to a definition from a docview buffer. -* New interactive command `cider-close-nrepl-session`. -* New interactive command `cider-describe-nrepl-session`. -* New interactive command `cider-toggle-trace-ns` (mapped to <kbd>C-c M-t n</kbd>) -* New interactive command `cider-repl-require-repl-utils`. -* [#784](https://github.com/clojure-emacs/cider/issues/784): Make it possible to run tests in -the current ns with `C-u C-c ,`. - -### Changes - -* bencode decoder was rewritten: - - nREPL dicts are now plists and accessor api is given by `nrepl-dict-p`, - `nrepl-dict-get` and `nrepl-dict-put`. - - nested stack is used for decoded messages to avoid re-parsing of incomplete messages - - queues are used for incoming strings from the server and for the decoded responses -* REPL buffers are now connection buffers for REPL client connections. -* Server and client cranking were isolated into `nrepl-start-server-process` and - `nrepl-start-client-process`. - -* nrepl-client.el refactoring: - - - `nrepl-send-request-sync` was renamed into `nrepl-send-sync-request` to comply - - with the names of other 'sync' variables. - - - nREPL requests are now named with `nrepl-request:OP` where "OP" stands for - the type of the request (eval, clone etc.). The following functions - were renamed: - - `nrepl-send-string` -> `nrepl-request:eval` - `nrepl-send-string-sync` -> `nrepl-sync-request:eval` - `nrepl-send-interrupt` -> `nrepl-request:interrupt` - `nrepl-send-stdin` -> `nrepl-request:stdin` - `nrepl-describe-session` -> `nrepl-request:describe` - `nrepl-create-client-session` -> `nrepl-request:clone` - -* Renamed `cider-macroexpansion-suppress-namespaces` to `cider-macroexpansion-display-namespaces`. -* [#652](https://github.com/clojure-emacs/cider/issues/652): Suppress eldoc when -an error message is displayed in the minibuffer. -* [#719](https://github.com/clojure-emacs/cider/issues/719) The customization -variable `cider-test-show-report-on-success` controls now, whether to show the -`*cider-test-report*` buffer on passing tests. The default is to not show the -buffer. -* Renamed `cider-toggle-trace` to `cider-toggle-trace-var` and remapped it to <kbd>C-c M-t v</kbd>. - -### Bugs fixed - -* [#705](https://github.com/clojure-emacs/cider/pull/705): Fixed macroexpansion -bug for `tidy` namespace display. -* Font-lock properly error messages in the REPL resulting from interactive evaluation. -* [#671](https://github.com/clojure-emacs/cider/issues/671): Remove problematic code that was -setting the REPL's initial ns based on lein's `:init-ns` option. -* [#695](https://github.com/clojure-emacs/cider/issues/695): Keep point at -original position when clearing or highlighting test results. -* [#744](https://github.com/clojure-emacs/cider/issues/744): Fix the ability to customize the -lein command invoked by `cider-jack-in`. -* [#752](https://github.com/clojure-emacs/cider/issues/752): Don't assume -`clojure.core/let` is always available as `let`. -* [#772](https://github.com/clojure-emacs/cider/issues/772): Don't try to read Clojure results as -Emacs Lisp code. -* [#631](https://github.com/clojure-emacs/cider/issues/631): Set `file` and `line` metadata when -doing interactive evaluation. -* nREPL sessions are now closed on `cider-quit`. -* Fix minibuffer history for `cider-read-and-eval`. - -## 0.7.0 (2014-08-05) - -### New features - -* New `cider-auto-jump-to-error` control variable for auto jumping to error - location. -* [#537](https://github.com/clojure-emacs/cider/pull/537): New support for -Java symbol lookup from cider-nrepl's info middleware. -* [#570](https://github.com/clojure-emacs/cider/pull/570): Enable toggling -of the 'all' filter on stacktraces. -* [#588](https://github.com/clojure-emacs/cider/pull/588): New `doc-mode` -for presenting fontified documentation, including Javadoc. -* New interactive command `cider-toggle-trace`. -* `cider-select` can now switch to the `*cider-error*` buffer (bound to `x`). -* [#613](https://github.com/clojure-emacs/cider/issues/613): New `clojure.test` -integration. -* [#22](https://github.com/clojure-emacs/cider/issues/22): New command -`cider-jump-to-resource` (bound to <kbd>C-c M-.</kbd>). -* [#664](https://github.com/clojure-emacs/cider/pull/664): New apropos support: -search function/var names (bound to <kbd>C-c C-d a</kbd>) or documentation -(bound to <kbd>C-c C-d A</kbd>). -* You can view Grimoire's entry for a particular Clojure (built-in) symbol in -Emacs with `cider-grimoire` (<kbd>C-c C-d g</kbd>) or your default browser with -`cider-grimoire-web` (<kbd>C-c C-d h</kbd>). -* `cider-mode` now displays the namespace of the current buffer in the mode-line - (as SLIME does). - -### Changes - -* [#597](https://github.com/clojure-emacs/cider/issues/597): Don't process nREPL - messages unless the whole message has been received. -* [#603](https://github.com/clojure-emacs/cider/pull/603): New variable -`cider-show-error-buffer` to control the behavior of the error buffer. Obsoletes -`cider-popup-on-error`, `cider-popup-stacktraces` and -`cider-repl-popup-stacktraces`. -* `cider-nrepl` is now required. Without it pretty much nothing will work. -* Removed redundant command `cider-src`. -* Renamed `nrepl-log-events` variable to `nrepl-log-messages`. -* Renamed `nrepl-log-events` command to `nrepl-log-messages`. -* Remove redundant `cider-src` command. -* [#582](https://github.com/clojure-emacs/cider/pull/582): Enable efficient -loading of jar/zip resources. -* [#589](https://github.com/clojure-emacs/cider/pull/589): Don't prefer local -paths over tramp by default. -* [#554](https://github.com/clojure-emacs/cider/issues/554): `cider-auto-select-error-buffer` is set to `t` by default. -* [#610](https://github.com/clojure-emacs/cider/pull/610): Present error and -stacktrace info for all exception causes. -* Removed `cider-repl-print-length` config option and -`cider-repl-toggle-print-length-limiting` command. -* Remapped `cider-doc` to <kbd>C-c C-d d</kbd>. -* Remapped `cider-javadoc` to <kbd>C-c C-d j</kbd> -* cider's scratch is now more consistent with an Emacs Lisp scratch buffer. - -### Bugs fixed - -* [#577](https://github.com/clojure-emacs/cider/pull/577): Fix bencode decoding -of negative integers. -* [#607](https://github.com/clojure-emacs/cider/pull/607): Respect - `*print-length*` in `cider-pprint-eval-defun-at-point` and - `cider-pprint-eval-last-sexp`. - -## 0.6.0 (2014-04-24) - -### New features - -* New interactive command `cider-change-buffers-designation`. -* Cider command uses `cider-known-endpoints`. -* [#490](https://github.com/clojure-emacs/cider/pull/490): Dedicated - support for `company-mode` in `cider-complete-at-point`. -* [#489](https://github.com/clojure-emacs/cider/issues/489): Enable - cider-jack-in on tramp source buffers. -* [#460](https://github.com/clojure-emacs/cider/issues/460): Support for -cider-nrepl's complete middleware for CLJ/CLJS autocomplete. -* [#465](https://github.com/clojure-emacs/cider/issues/465): Support for -cider-nrepl's info middleware for jump-to-definition. -* [#469](https://github.com/clojure-emacs/cider/issues/469): Add option -`cider-prompt-save-file-on-load`. -* New interactive command `cider-insert-defun-in-repl`. -* New interactive command `cider-insert-ns-form-in-repl`. -* New inspector inspired by SLIME's inspector -* STDERR output is now font-locked with `cider-repl-err-output-face` to make it -visually distinctive from `cider-repl-output-face` (used for STDOUT output). -* New interactive command `cider-scratch`. -* [#521](https://github.com/clojure-emacs/cider/pull/521): New interactive -stacktrace filtering/navigation using cider-nrepl's stacktrace middleware. - -### Changes - -* [#513](https://github.com/clojure-emacs/cider/issues/513): - Remove hardcoded use of IDO mode and use `completing-read`. -* Required Emacs version is now 24.1. -* [#486](https://github.com/clojure-emacs/cider/issues/486): Improve - support for tramp, so tramp paths do not get used in compiled debug - information. `cider-jump` still uses tramp filenames to find - definitions if used in a buffer associated with a tramp file. -* Renamed `cider` command to `cider-connect`. - -### Bugs fixed - -* [#515](https://github.com/clojure-emacs/cider/issues/515): Fix -inconsistent prompt used for load symbol functions. -* [#501](https://github.com/clojure-emacs/cider/issues/501): Fix -nil appearing in nrepl-server buffer name when no project directory. -* [#493](https://github.com/clojure-emacs/cider/issues/493) Fix rotate connection to handle no -nREPL connection. -* [#468](https://github.com/clojure-emacs/cider/issues/468): Fix -pretty-printing of evaluation results so that `*1` is set properly. -* [#439](https://github.com/clojure-emacs/cider/issues/439): Fix -race condition bug in `cider-restart`. -* [#441](https://github.com/clojure-emacs/cider/issues/441): Fix timing bug in `cider-jack-in`. -* [#482](https://github.com/clojure-emacs/cider/issues/482): Fix jump-to-def for cljx dependency jars. - -## 0.5.0 (2014-01-24) - -### New features - -* <kbd>C-c M-f</kbd> Select a function from the current namespace using IDO and insert into the REPL buffer. -* `cider-read-and-eval` now supports completion and keeps history. -* Added ability to limit the number of objects printed in collections - by managing `*print-length*`. `cider-repl-print-length` can be used - to set a limit, and `cider-repl-toggle-print-length-limiting` can be - used to toggle the enforcement of the limit. -* New config `cider-eval-result-prefix` controls the prefix displayed before results -from interactive evaluation displayed in the minibuffer. -* New config `cider-repl-result-prefix` controls the prefix displayed before results in the REPL. -* Font-lock interactive evaluation results as Clojure code. -* Added the ability to font-lock input and results in the REPL as Clojure code. This is controlled via -the option `cider-repl-use-clojure-font-lock`. -* Added `cider-pprint-eval-defun-at-point`, a companion to `cider-pprint-eval-last-sexp` which works on the top-level form. -* The REPL buffer name uses host if no project directory available; `*cider-repl*` will appear as `*cider-repl <host>*`. - -### Bugs fixed - -* [#316](https://github.com/clojure-emacs/cider/issues/316): Honor the `:init-ns` namespace on startup. -* [#436](https://github.com/clojure-emacs/cider/issues/436): Fix an infinite loop when evaluating ns forms. -* [#435](https://github.com/clojure-emacs/cider/issues/435): Fix trampling of `cider-switch-to-repl-buffer` by `cider-switch-to-relevant-repl-buffer`. - -## 0.4.0 (2013-12-03) - -### New features - -* Added new interactive command `cider-read-and-eval` (bound to `C-c M-:` in `cider-mode`). -* Added new interactive command `cider-eval-last-sexp-to-repl` (`C-c M-e`). The command will output the result -of the evaluated code to the REPL buffer, so you can easily play with the output there afterwards. -* Added new interactive command `cider-insert-last-sexp-in-repl` (`C-c M-p`). -* Added new interactive command `cider-eval-last-expression-and-replace` (`C-c C-w`). -* Implemented REPL shortcuts, triggered by pressing `,` at the start of a REPL input line (similar to the ones in SLIME). -* Added new interactive command `cider-ping` to check connectivity with the server. - -### Changes - -* Renamed `cider-history-size` to `cider-repl-history-size`. -* Renamed `cider-history-file` to `cider-repl-history-file`. -* Renamed `cider-wrap-history` to `cider-repl-wrap-history`. -* Renamed `cider-eval-expression-at-point` to `cider-eval-defun-at-point`. -* Changed `last-expression` to `last-sexp` in a number of functions. - -### Bugs fixed - -* [#315](https://github.com/clojure-emacs/cider/issues/393): Removed spurious newlines in output. -* [#237](https://github.com/clojure-emacs/cider/issues/237): Don't swallow output from futures. -* Create non-existing namespaces, when evaluating code in Clojure buffers. - -## 0.3.1 (2013-10-29) - -* Fix REPL init - -## 0.3.0 (2013-10-28) - -### New features - -* The variable `cider-repl-display-in-current-window` controls whether the REPL should be displayed in the current window when switched to. -* `cider-repl-set-ns` can now be invoked in the REPL. -* The content of `.nrepl-port`, if present, will be used as the - default port for <kbd>M-x nrepl</kbd>. This is in addition to `target/repl-port`. -* Applies ANSI color to all output in the REPL buffer. - -### Changes - -* Renamed package to CIDER. -* Split package into several files. -* Renamed `cider-interaction-mode` to `cider-mode`. - -### Bugs fixed - -* [#393](https://github.com/clojure-emacs/cider/issues/393) - Error when evaluating strings with a namespace declaration in them. - -## 0.2.0 (2013-10-10) - -### New features - -* <kbd>C-c M-d</kbd> will display default nREPL connection details. -* <kbd>C-c M-r</kbd> will rotate and display the default nREPL connection. -* Setting the variable `nrepl-buffer-name-show-port` will display the port on which the nREPL server is running. -* The REPL buffer name uses project directory name; `*nrepl*` will appear as `*nrepl project-directory-name*`. -* The nREPL connection buffer name uses project directory name; `*nrepl-connection*` will appear as `*nrepl-connection project-directory-name*`. -* nREPL server buffer name uses project directory name; `*nrepl-server*` will appear as `*nrepl-server project-directory-name*`. -* <kbd>C-c C-Z</kbd> will select the nrepl buffer based on the current namespace. -* <kbd>C-u C-c C-Z</kbd> will select the nrepl buffer based on a user project directory prompt. -* Bind <kbd>C-c C-q</kbd> to `nrepl-quit` -* Added an option to auto-select error popups (`nrepl-auto-select-error-buffer`) -* Made the display of the REPL buffer on connect optional - -### Changes - -* Renamed `nrepl-mode` to `nrepl-repl-mode` - -### Bugs fixed - -* <kbd>C-c M-s</kbd> (`nrepl-selector`) was bound to non-existing symbol. -* Fix indentation in REPL buffers. -* Fix `nrepl-doc` on Clojure 1.5 - -## 0.1.8 (2013-08-08) - -### New features - -* Evaluate all namespace forms `(ns ...)` in the user namespace. -* Add highlighting of compilation warnings in addition to existing highlighting of errors -* Add support for selecting last Clojure source buffer with keybinding -<kbd>C-c C-z</kbd> (the same as `nrepl-switch-to-repl-buffer`). -* The content of `target/repl-port`, if present, will be used as the - default port for <kbd>M-x nrepl</kbd> -* Added an extendable slime-style selector command and binding <kbd>C-c M-s</kbd> - -### Bugs fixed - -* <kbd>M-.</kbd> (`nrepl-jump`) on remote nrepl connection (across OS hosts) has been fixed. - -## 0.1.7 (2013-03-13) - -### New features - -* Add support for multiple nrepl sessions. A single session is closed with - `M-x nrepl-close`. A REPL session is made default with - `M-x nrepl-make-repl-connection-default`. -* Added support for pretty-printing in the REPL buffer. -* Added a check for the presence of an existing `*nrepl*` buffer before -creating a new one with `nrepl-jack-in` or `nrepl`. -* `M-.` learned about namespaces. -* Added new customization variable `nrepl-popup-stacktraces-in-repl`. -* Added some convenience keybindings to `clojure-mode` - -`nrepl-jack-in` is now bound to <kbd>C-c M-j</kbd> and `nrepl` is -bound to <kbd>C-c M-c</kbd>. -* Added `nrepl-hide-special-buffers` setting to control the display of special -buffers like `*nrepl-server*` and `*nrepl-connection*`. -* Apply ANSI color codes to output sent to nrepl buffers. -* Add a connection browser `nrepl-connection-browser` to allow control of - multiple connections. -* Add macroexpand key bindings to `nrepl-mode-map`. -* Don't suppress namespaces in macroexpansion. -* Add explicit require of expected namespaces in the REPL buffer. - -* Add command `nrepl-pprint-eval-last-expression`. -* Add an event buffer for debugging. -* Allow connections without REPL buffers. -* Add hook `nrepl-file-loaded-hook` which runs on load-file - completion. -* Expand ido-completion to include "used" variables in addition to - "interned" variables. - -### Bugs fixed - -* More accurate matching of filenames in stacktraces. -* Fix #290 - Macroexpand buffer truncates long expansions - -## 0.1.6 (2013-01-29) - -### New features - -* Ported SLIME macroexpansion mode (see README for full documentation) -* Updated macroexpansion to use pprint with code-dispatch -* Eldoc argument highlighting -* Simplify popup buffer quit/restore using `quit-window'. -* Add nrepl-disconnected-hook and disable nrepl when disconnected. -* Get key bindings documentation into the minor mode descriptions (Ivan Necas) -* made the TAB command in the nrepl-mode buffers configurable (Bozhidar Batsov) -* Added convenience function to report the version of nREPL in use. (fogus) -* Shift-Home and Shift-Ctrl-a in repl, which select just the user input when on the input line. (Ivan Kozik) - -### Bugs fixed - -* Emit server log output at bottom of `*nrepl-server*` buffer. (Brian Rowe) -* Reset nrepl-buffer-ns on nrepl-restart. Fixes issue #187. -* Implement nrepl-mode as a derived mode. (Bozhidar Batsov) -* fix #194 - stacktrace buffer was not respecting nrepl-popup-stacktraces (Bozhidar Batsov) -* Fix message formatting for results containing "%" (fixes issue #195). -* Fix NPE in nrepl-jump (issue #124). (cola-zero) -* Fix nrepl to work with fish shell (issue #192). (Dario Bertini) -* Adjusted the javadoc keybinding and mentioned it in the README. (Bozhidar Batsov) -* Fix issue #163 - exclude ns from nrepl-load-file. -* Ignore "killed" and "hangup" events in sentinel (Chris Bilson) -* Clear the correct region when replacing the input line. (Ivan Kozik) -* Fix issue #146. Include "@" in nrepl-input-complete-p. -* Handle stdout messages that arrive after status "done" - -## 0.1.5 (2012-10-22) - -### New features - -* Support for describe op to determine which server ops are available at startup -* Support for the following server ops (if available): load-file, complete, and javadoc (available in ritz) -* Added nrepl-host and nrepl-port custom variables M-x nrepl default hostname/port -* Ported over the following REPL buffer functions from slime: - History regexp filtering - M-s nrepl-next-matching-input, M-r nrepl-previous-matching-input - C-c C-u nrepl-kill-input - C-c C-n nrepl-next-prompt/C-c C-p nrepl-previous-prompt -* Added nrepl-quit and nrepl-restart commands -* Added menus for nrepl-mode and nrepl-interaction-mode -* Add nrepl-eval-print-last-expression - -### Bugs fixed - -* Ensure nrepl-eval-sync waits for :done when response is chunked - -## 0.1.4 (2012-09-18) - -### New features - -* Improvements and simplifications for completion (Tassilo Horn) -* Documentation additions and fixes (Ryan Fowler, Nikita Beloglazov, Bozhidar Batsov, Juha Syrjl, Philipp Meier) -* Make completion back-end and error handler configurable (Hugo Duncan) -* Accept host as well as port on connect (Ken Restivo) -* Enable nrepl-interaction-mode in clojurescript-mode (Nelson Morris) -* Emit stdout from interactive evaluations into the REPL buffer - -### Bugs fixed - -* Fix paredit .. don't make clojure-mode-map parent of nrepl-interaction-mode-map (Tassilo Horn) -* Fixes for ECB interop (Matthew Willson) -* Namespace qualify tooling calls (Justin Kramer) -* Eldoc fixes (Jack Moffitt) -* Fix path quoting in load file for Windows (Philipp Meier) -* Fix nREPL / Emacs error "Unable to resolve symbol: if-let" - -## 0.1.3 (2012-08-19) - -### New features - -* eldoc support for displaying arglists in the minibuffer (Stefan Kamphausen) -* persistent REPL history (Stefan Kamphausen) -* fix for jumbled stacktraces (Ryan Fowler) -* add a doc keybinding for the REPL buffer (Ken Restivo) -* plumbing to support ac-nrepl [https://github.com/purcell/ac-nrepl] (Steve Purcell) -* stdin support (which also provides support for debug-repl - [https://github.com/GeorgeJahad/debug-repl] and limit-break [https://github.com/technomancy/limit-break]) - -## 0.1.2 (2012-07-24) - -### New features - -* convert nrepl-interaction-mode into a major mode -* display stacktrace on eval-error -* change lein command to `lein` -* add fn to eval current buffer's ns -* handle filter messages spanning multiple chunks of output -* Let nrepl-jack-in accept project dir when given a prefix arg. -* C-c C-b nrepl-interrupt -* client session management -* added words of inspiration + version at startup -* Add M-n and M-p to nrepl-mode-map. -* Implement M-.: nrepl-jump-to-def. -* Implement basic completion. -* Implement nrepl-doc. -* Prevent M-p at top of history from pushing position one step further. -* M-n after end of history should blank out input. -* Add M-n and M-p to nrepl-mode-map. -* Implement M-.: nrepl-jump-to-def. - -## 0.1.1 (2012-07-11) - -* Initial version diff --git a/elpa/cider-1.12.0/Eldev b/elpa/cider-1.12.0/Eldev @@ -1,59 +0,0 @@ -; -*- mode: emacs-lisp; lexical-binding: t; no-byte-compile: t -*- - -(eldev-require-version "0.6") - -(eldev-use-package-archive 'gnu) -;; For compatibility; e.g. with MELPA Stable one test fails. -(eldev-use-package-archive 'melpa-unstable) - -(eldev-use-plugin 'autoloads) - -(eldev-add-loading-roots 'test "test/utils") -(eldev-add-extra-dependencies 'runtime '(:package logview :optional t)) - -;; slightly increase the maximum (applies to checkdoc and the byte compiler alike) -(setq byte-compile-docstring-max-column 100) - -;; allow commas to indicate that the first sentence continues, which enables longer first sentences -(setq checkdoc-permit-comma-termination-flag t) - -(defvar cider-test-type 'main) -(setf eldev-standard-excludes `(:or ,eldev-standard-excludes - ;; Avoid including files in test "projects". - (eldev-pcase-exhaustive cider-test-type - (`main "./test/*/") - (`integration '("./test/" "!./test/integration")) - (`enrich '("./test/" "!./test/enrich")) - (`all '("./test/*/" "!./test/integration"))) - "test/integration/projects" - ;; This file is _supposed_ to be excluded - ;; from automated testing. - "test/cider-tests--no-auto.el")) - -(eldev-defoption cider-test-selection (type) - "Select tests to run; type can be `main', `integration', `enrich' or `all'" - :options (-T --test-type) - :for-command test - :value TYPE - :default-value cider-test-type - (unless (memq (intern type) '(main integration enrich all)) - (signal 'eldev-wrong-option-usage `("unknown test type `%s'" ,type))) - (setf cider-test-type (intern type))) - -(add-hook 'eldev-test-hook - (lambda () - (eldev-verbose "Using cider tests of type `%s'" cider-test-type))) -(add-hook 'eldev-executing-command-hook - (lambda (command) - (unless (eq command 'test) - ;; So that e.g. byte-compilation works on all tests. - (setf cider-test-type 'all)))) - -;; CIDER cannot be compiled otherwise. -(setf eldev-build-load-before-byte-compiling t) - -(setf eldev-lint-default '(elisp)) -(with-eval-after-load 'elisp-lint - ;; We will byte-compile with Eldev. - (setf elisp-lint-ignored-validators '("package-lint" "fill-column" "byte-compile") - enable-local-variables :safe)) diff --git a/elpa/cider-1.12.0/Makefile b/elpa/cider-1.12.0/Makefile @@ -1,37 +0,0 @@ -.PHONY: clean compile lint test-all test-integration test-unit -.DEFAULT_GOAL := test - -# Per our CircleCI, linting/compiling assumes Emacs 28. -# If you primarily use a different version, you can download Emacs 28 to a separate directory and set up: -# export ELDEV_EMACS="$HOME/emacs28/Emacs.app/Contents/MacOS/Emacs" - -# Remove byte-compilation artifacts, which can alter the result of the test suite: -clean: - cd ~/.emacs.d; find . -type f -name "*.elc" -exec rm {} + - -# You can find a generic `eldev` installation script in https://github.com/emacs-eldev/eldev/blob/master/webinstall/eldev -# (Don't use the one defined for CircleCI in your local machine) - -lint: clean - eldev lint - -# Checks for byte-compilation warnings. -compile: clean - eldev -dtT compile --warnings-as-errors - -test/File.edn: - cd dev; ../clojure.sh clojure -M:gen - -test-all: clean test/File.edn - eldev -dtT -p test --test-type all - -test-enrich: clean test/File.edn - eldev -dtT -p test --test-type enrich - -test-integration: clean - eldev -dtT -p test --test-type integration - -test-unit: clean - eldev -dtT -p test - -test: lint test-unit compile diff --git a/elpa/cider-1.12.0/README.md b/elpa/cider-1.12.0/README.md @@ -1,273 +0,0 @@ -<p align="center"> - <img src="https://raw.github.com/clojure-emacs/cider/master/logo/cider-logo-w640.png" alt="CIDER Logo"/> -</p> - ------------ -[![License GPL 3][badge-license]](http://www.gnu.org/licenses/gpl-3.0.txt) -[](https://circleci.com/gh/clojure-emacs/cider) -[](https://github.com/clojure-emacs/cider/actions/workflows/spell_checking.yml) -[](https://discord.com/invite/nFPpynQPME) -[](http://clojurians.net) - -CIDER is the **C**lojure(Script) **I**nteractive **D**evelopment **E**nvironment -that **R**ocks! - -CIDER extends Emacs with support for [interactive -programming](https://docs.cider.mx/cider/usage/interactive_programming.html) -in Clojure. The features are centered around `cider-mode`, an Emacs -minor-mode that complements [clojure-mode][]. While `clojure-mode` -supports editing Clojure source files, `cider-mode` adds support for -interacting with a running Clojure process for compilation, code -completion, debugging, definition and documentation lookup, running -tests and so on. - ----------- -[](#open-collective-backers) -[](#open-collective-sponsors) -[](https://www.patreon.com/bbatsov) -[](https://www.paypal.com/cgi-bin/webscr?cmd=_s-xclick&hosted_button_id=GRQKNBM6P8VRQ) - -Bozhidar (a.k.a. Bug, CIDER's primary author/maintainer) has spent countless hours working on -CIDER and the [numerous related projects](https://metaredux.com/posts/2018/11/09/ciders-orchard-the-heart.html). That's a lot of work and not all of it is fun! - -**Please consider [supporting financially CIDER's ongoing development](#funding).** - -## Quickstart - -The instructions that follow are meant to get you from zero to a running CIDER -REPL in under 5 minutes. See the -[online documentation](https://docs.cider.mx) for (way) more -details. - -### Installation - -[](http://melpa.org/#/cider) -[](http://stable.melpa.org/#/cider) -[](https://elpa.nongnu.org/nongnu/cider.html) - -The recommended way to install CIDER is via `package.el` - the built-in package -manager in Emacs. - -CIDER is available on all major `package.el` community -maintained repos - [NonGNU ELPA](https://elpa.nongnu.org), -[MELPA Stable](http://stable.melpa.org) -and [MELPA](http://melpa.org). - -Provided you've enabled one of them in your Emacs setup, you can -install CIDER with the following command: - -<kbd>M-x</kbd> `package-install` <kbd>RET</kbd> `cider` <kbd>RET</kbd> - -### Launch an nREPL server and client from Emacs - -Simply open in Emacs a file belonging to your `lein`, `tools.deps` or `boot` project (like -`foo.clj`) and type <kbd>M-x</kbd> `cider-jack-in`. This will start an nREPL -server with all the project dependencies loaded in and CIDER will automatically -connect to it. - -Alternatively you can use <kbd>C-u M-x</kbd> `cider-jack-in` to specify the path to -a Clojure project, without having to visit any file in it. - -**Tip:** In Clojure(Script) buffers the command `cider-jack-in` is bound to -<kbd>C-c C-x (C-)j</kbd>. - -### Connect to a running nREPL server - -You can go to your project's directory in a terminal and type there -(assuming you're using Leiningen that is): - -``` -$ lein repl -``` - -Or with Boot: - -``` -$ boot repl -s wait -``` - -Alternatively you can start nREPL either manually or by the facilities provided -by your project's build tool (`tools.deps`, Gradle, Maven, etc). - -After you get your nREPL server running go back to Emacs. Typing there <kbd>M-x</kbd> -`cider-connect` will allow you to connect to the running nREPL server. - -**Tip:** In Clojure(Script) buffers the command `cider-connect` is bound to -<kbd>C-c C-x (C-)c (C-)j</kbd> and the command `cider-connect-cljs` is bound to -<kbd>C-c C-x (C-)c (C-)s</kbd>. - -## Diving Deeper - -CIDER packs a ton of functionality and you really want to be familiar with it, -so you can fully empower your workflow. The best way to get acquainted with all -available features is to go over the entire -[CIDER manual](https://docs.cider.mx/). - -If you're into video lessons, you might also check out -this [intro to CIDER demo](https://www.youtube.com/watch?v=aYA4AAjLfT0) as well. - -## Quick Reference Card - -You'll find all of CIDER's essential commands and their keybindings in its -one-page printable [quick reference card](https://github.com/clojure-emacs/cider/blob/master/refcard/cider-refcard.pdf). - -New CIDER users might benefit from keeping a copy close to their keyboard. - -## Get Help - -Start with CIDER's [discussions board](https://github.com/clojure-emacs/cider/discussions). If it doesn't get the job done consider some of the other available -[support channels](https://docs.cider.mx/cider/about/support.html). - -## Changelog - -An extensive changelog is available [here](CHANGELOG.md). - -## Team - -### The Core Team - -The direction of the project is being stewarded by the CIDER core team. This -group of long-term contributors manage releases, evaluate pull-requests, and -does a lot of the groundwork on major new features. - -* [Bozhidar Batsov](https://github.com/bbatsov) (author & head maintainer) -* [Vitalie Spinu](https://github.com/vspinu) -* [Michael Griffiths](https://github.com/cichli) -* [Lars Andersen](https://github.com/expez) - -### CIDER Alumni - -In addition, we'd like to extend a special thanks the following retired CIDER -core team members. Lovingly known as The Alumni: - -* [Tim King](https://github.com/kingtim) (original author) -* [Phil Hagelberg](https://github.com/technomancy) -* [Hugo Duncan](https://github.com/hugoduncan) -* [Steve Purcell](https://github.com/purcell) -* [Artur Malabarba](https://github.com/malabarba) -* [Jeff Valk](https://github.com/jeffvalk) - -## Release policy - -We’re following [SemVer](http://semver.org/). - -You can read more on the subject [here](https://docs.cider.mx/cider/about/release_policy.html). - -## Logo - -CIDER's logo was created by [@tapeinosyne](https://github.com/tapeinosyne). You can find -the logo in various formats -[here](https://github.com/clojure-emacs/cider/tree/master/logo). - -The logo is licensed under a -[Creative Commons Attribution-NonCommercial 4.0 International License](http://creativecommons.org/licenses/by-nc/4.0/deed.en_GB). - -## Homepage - -CIDER's homepage <https://cider.mx> is in the `gh-pages` branch of this repository and is deployed -automatically when changes are made to it. - -It's just a single `index.html` file and a bit of Bootstrap 4. Contributions to it are very welcome! - -## Funding - -While CIDER is free software and will always be, the project would benefit immensely from some funding. -Raising a monthly budget of a couple of thousand dollars would make it possible to pay people to work on -certain complex features, fund other development related stuff (e.g. hardware, conference trips) and so on. -Raising a monthly budget of over $5000 would open the possibility of someone working full-time on the project -which would speed up the pace of development significantly. - -We welcome both individual and corporate sponsors! We also offer a wide array of funding channels to account -for your preferences (although currently [Open Collective](https://opencollective.com/cider) is our preferred funding platform). - -If you're working in a company that's making significant use of CIDER we'd appreciate it if you suggest to your company -to become a CIDER sponsor. - -You can support the development of CIDER, [clojure-mode][] and [inf-clojure][] via -[Open Collective](https://opencollective.com/cider), -[GitHub Sponsors](https://github.com/sponsors/bbatsov), -[Patreon](https://www.patreon.com/bbatsov) and -[PayPal](https://www.paypal.me/bbatsov). - -### Open Collective Backers - -<a href="https://opencollective.com/cider/backer/0/website" target="_blank"><img src="https://opencollective.com/cider/backer/0/avatar.svg"></a> -<a href="https://opencollective.com/cider/backer/1/website" target="_blank"><img src="https://opencollective.com/cider/backer/1/avatar.svg"></a> -<a href="https://opencollective.com/cider/backer/2/website" target="_blank"><img src="https://opencollective.com/cider/backer/2/avatar.svg"></a> -<a href="https://opencollective.com/cider/backer/3/website" target="_blank"><img src="https://opencollective.com/cider/backer/3/avatar.svg"></a> -<a href="https://opencollective.com/cider/backer/4/website" target="_blank"><img src="https://opencollective.com/cider/backer/4/avatar.svg"></a> -<a href="https://opencollective.com/cider/backer/5/website" target="_blank"><img src="https://opencollective.com/cider/backer/5/avatar.svg"></a> -<a href="https://opencollective.com/cider/backer/6/website" target="_blank"><img src="https://opencollective.com/cider/backer/6/avatar.svg"></a> -<a href="https://opencollective.com/cider/backer/7/website" target="_blank"><img src="https://opencollective.com/cider/backer/7/avatar.svg"></a> -<a href="https://opencollective.com/cider/backer/8/website" target="_blank"><img src="https://opencollective.com/cider/backer/8/avatar.svg"></a> -<a href="https://opencollective.com/cider/backer/9/website" target="_blank"><img src="https://opencollective.com/cider/backer/9/avatar.svg"></a> -<a href="https://opencollective.com/cider/backer/10/website" target="_blank"><img src="https://opencollective.com/cider/backer/10/avatar.svg"></a> -<a href="https://opencollective.com/cider/backer/11/website" target="_blank"><img src="https://opencollective.com/cider/backer/11/avatar.svg"></a> -<a href="https://opencollective.com/cider/backer/12/website" target="_blank"><img src="https://opencollective.com/cider/backer/12/avatar.svg"></a> -<a href="https://opencollective.com/cider/backer/13/website" target="_blank"><img src="https://opencollective.com/cider/backer/13/avatar.svg"></a> -<a href="https://opencollective.com/cider/backer/14/website" target="_blank"><img src="https://opencollective.com/cider/backer/14/avatar.svg"></a> -<a href="https://opencollective.com/cider/backer/15/website" target="_blank"><img src="https://opencollective.com/cider/backer/15/avatar.svg"></a> -<a href="https://opencollective.com/cider/backer/16/website" target="_blank"><img src="https://opencollective.com/cider/backer/16/avatar.svg"></a> -<a href="https://opencollective.com/cider/backer/17/website" target="_blank"><img src="https://opencollective.com/cider/backer/17/avatar.svg"></a> -<a href="https://opencollective.com/cider/backer/18/website" target="_blank"><img src="https://opencollective.com/cider/backer/18/avatar.svg"></a> -<a href="https://opencollective.com/cider/backer/19/website" target="_blank"><img src="https://opencollective.com/cider/backer/19/avatar.svg"></a> -<a href="https://opencollective.com/cider/backer/20/website" target="_blank"><img src="https://opencollective.com/cider/backer/20/avatar.svg"></a> -<a href="https://opencollective.com/cider/backer/21/website" target="_blank"><img src="https://opencollective.com/cider/backer/21/avatar.svg"></a> -<a href="https://opencollective.com/cider/backer/22/website" target="_blank"><img src="https://opencollective.com/cider/backer/22/avatar.svg"></a> -<a href="https://opencollective.com/cider/backer/23/website" target="_blank"><img src="https://opencollective.com/cider/backer/23/avatar.svg"></a> -<a href="https://opencollective.com/cider/backer/24/website" target="_blank"><img src="https://opencollective.com/cider/backer/24/avatar.svg"></a> -<a href="https://opencollective.com/cider/backer/25/website" target="_blank"><img src="https://opencollective.com/cider/backer/25/avatar.svg"></a> -<a href="https://opencollective.com/cider/backer/26/website" target="_blank"><img src="https://opencollective.com/cider/backer/26/avatar.svg"></a> -<a href="https://opencollective.com/cider/backer/27/website" target="_blank"><img src="https://opencollective.com/cider/backer/27/avatar.svg"></a> -<a href="https://opencollective.com/cider/backer/28/website" target="_blank"><img src="https://opencollective.com/cider/backer/28/avatar.svg"></a> -<a href="https://opencollective.com/cider/backer/29/website" target="_blank"><img src="https://opencollective.com/cider/backer/29/avatar.svg"></a> - -### Open Collective Sponsors - -Become a sponsor and get your logo on our README on Github with a link to your -site. [[Become a sponsor](https://opencollective.com/cider#sponsor)] - -<a href="https://opencollective.com/cider/sponsor/0/website" target="_blank"><img src="https://opencollective.com/cider/sponsor/0/avatar.svg"></a> -<a href="https://opencollective.com/cider/sponsor/1/website" target="_blank"><img src="https://opencollective.com/cider/sponsor/1/avatar.svg"></a> -<a href="https://opencollective.com/cider/sponsor/2/website" target="_blank"><img src="https://opencollective.com/cider/sponsor/2/avatar.svg"></a> -<a href="https://opencollective.com/cider/sponsor/3/website" target="_blank"><img src="https://opencollective.com/cider/sponsor/3/avatar.svg"></a> -<a href="https://opencollective.com/cider/sponsor/4/website" target="_blank"><img src="https://opencollective.com/cider/sponsor/4/avatar.svg"></a> -<a href="https://opencollective.com/cider/sponsor/5/website" target="_blank"><img src="https://opencollective.com/cider/sponsor/5/avatar.svg"></a> -<a href="https://opencollective.com/cider/sponsor/6/website" target="_blank"><img src="https://opencollective.com/cider/sponsor/6/avatar.svg"></a> -<a href="https://opencollective.com/cider/sponsor/7/website" target="_blank"><img src="https://opencollective.com/cider/sponsor/7/avatar.svg"></a> -<a href="https://opencollective.com/cider/sponsor/8/website" target="_blank"><img src="https://opencollective.com/cider/sponsor/8/avatar.svg"></a> -<a href="https://opencollective.com/cider/sponsor/9/website" target="_blank"><img src="https://opencollective.com/cider/sponsor/9/avatar.svg"></a> -<a href="https://opencollective.com/cider/sponsor/10/website" target="_blank"><img src="https://opencollective.com/cider/sponsor/10/avatar.svg"></a> -<a href="https://opencollective.com/cider/sponsor/11/website" target="_blank"><img src="https://opencollective.com/cider/sponsor/11/avatar.svg"></a> -<a href="https://opencollective.com/cider/sponsor/12/website" target="_blank"><img src="https://opencollective.com/cider/sponsor/12/avatar.svg"></a> -<a href="https://opencollective.com/cider/sponsor/13/website" target="_blank"><img src="https://opencollective.com/cider/sponsor/13/avatar.svg"></a> -<a href="https://opencollective.com/cider/sponsor/14/website" target="_blank"><img src="https://opencollective.com/cider/sponsor/14/avatar.svg"></a> -<a href="https://opencollective.com/cider/sponsor/15/website" target="_blank"><img src="https://opencollective.com/cider/sponsor/15/avatar.svg"></a> -<a href="https://opencollective.com/cider/sponsor/16/website" target="_blank"><img src="https://opencollective.com/cider/sponsor/16/avatar.svg"></a> -<a href="https://opencollective.com/cider/sponsor/17/website" target="_blank"><img src="https://opencollective.com/cider/sponsor/17/avatar.svg"></a> -<a href="https://opencollective.com/cider/sponsor/18/website" target="_blank"><img src="https://opencollective.com/cider/sponsor/18/avatar.svg"></a> -<a href="https://opencollective.com/cider/sponsor/19/website" target="_blank"><img src="https://opencollective.com/cider/sponsor/19/avatar.svg"></a> -<a href="https://opencollective.com/cider/sponsor/20/website" target="_blank"><img src="https://opencollective.com/cider/sponsor/20/avatar.svg"></a> -<a href="https://opencollective.com/cider/sponsor/21/website" target="_blank"><img src="https://opencollective.com/cider/sponsor/21/avatar.svg"></a> -<a href="https://opencollective.com/cider/sponsor/22/website" target="_blank"><img src="https://opencollective.com/cider/sponsor/22/avatar.svg"></a> -<a href="https://opencollective.com/cider/sponsor/23/website" target="_blank"><img src="https://opencollective.com/cider/sponsor/23/avatar.svg"></a> -<a href="https://opencollective.com/cider/sponsor/24/website" target="_blank"><img src="https://opencollective.com/cider/sponsor/24/avatar.svg"></a> -<a href="https://opencollective.com/cider/sponsor/25/website" target="_blank"><img src="https://opencollective.com/cider/sponsor/25/avatar.svg"></a> -<a href="https://opencollective.com/cider/sponsor/26/website" target="_blank"><img src="https://opencollective.com/cider/sponsor/26/avatar.svg"></a> -<a href="https://opencollective.com/cider/sponsor/27/website" target="_blank"><img src="https://opencollective.com/cider/sponsor/27/avatar.svg"></a> -<a href="https://opencollective.com/cider/sponsor/28/website" target="_blank"><img src="https://opencollective.com/cider/sponsor/28/avatar.svg"></a> -<a href="https://opencollective.com/cider/sponsor/29/website" target="_blank"><img src="https://opencollective.com/cider/sponsor/29/avatar.svg"></a> - -## License - -CIDER is distributed under the GNU General Public License, version 3. - -Copyright © 2012-2023 Bozhidar Batsov, Artur Malabarba, Tim King, Phil Hagelberg and -[contributors](https://github.com/clojure-emacs/cider/contributors). - -[badge-license]: https://img.shields.io/badge/license-GPL_3-green.svg -[nREPL]:https://github.com/nrepl/nrepl -[Sly]: https://github.com/joaotavora/sly -[Geiser]: https://github.com/jaor/geiser -[clojure-mode]: https://github.com/clojure-emacs/clojure-mode -[inf-clojure]: https://github.com/clojure-emacs/inf-clojure diff --git a/elpa/cider-1.12.0/ROADMAP.md b/elpa/cider-1.12.0/ROADMAP.md @@ -1,112 +0,0 @@ -# CIDER Roadmap (as of July, 2020) - -That's a very high-level roadmap for CIDER. It focuses on the most -important challenges we need to tackle. - -It's meant to give users a general idea about the direction we -envision for the project's future, and collaborators a good list of -high-impact tasks to tackle. - -## Misc Features - -* ~~find-references (https://github.com/clojure-emacs/cider/issues/1840)~~ (**DONE/0.22**) -* highlight symbol occurrences (https://github.com/clojure-emacs/cider/issues/1461) -* macrostep style of macro expansion (https://github.com/clojure-emacs/cider/issues/1850) - -## Internal improvements - -* ~~Replace usages of Elisp's `read` with `parseedn`.~~ -* ~~Break down `cider-interaction.el` and remove this file completely.~~ (**DONE/0.18**) -* ~~Improve the connection management (https://github.com/clojure-emacs/cider/pull/2069)~~ (**DONE/0.18**) -* Improve nREPL callback handling (https://github.com/clojure-emacs/cider/issues/1099) -* ~~Better handling for huge output/results (we can warn users about it, - truncate it in the REPL and store the whole result internally, etc).~~ - -## Better ClojureScript support - -### Make it easier to start ClojureScript REPLs - -* Implement some deps injection for ClojureScript REPLs -* ~~Providing meaningful errors when starting ClojureScript REPLs.~~ (**DONE/0.17**) -* ~~Make it possible to have a project with only a ClojureScript REPL.~~(**DONE/0.18**) -* ~~Merge cljs-tooling into orchard and evolve it a bit (under - consideration, might be better to keep it a separate library).~~ (**Done/Orchard 0.5**) -* Add ability to restart a ClojureScript REPL (https://github.com/clojure-emacs/cider/issues/1874) - -### Add ClojureScript support for more commands - -* clojure.test -* tracing - -### Always show meaningful errors if a command is not supported under ClojureScript - -Right now it's very confusing if you try to run a Clojure-only command with a ClojureScript REPL. -You'd get some really weird error instead of something nice like "command X is not supported for ClojureScript". - -### Add debugging support for ClojureScript - -There's a bit of info on the subject [here](https://github.com/clojure-emacs/cider/issues/1416). - -## Implement new nREPL features - -* sideloading (there's some experimental support for this) -* dynamic middleware loading -* ~~completion~~ -* ~~lookup~~ - -## Make CIDER somewhat Clojure-agnostic - -There are many languages that provide their nREPL implementations and it'd be nice if -they worked with CIDER as far as the core nREPL protocol goes. - -Here's [an example](https://github.com/clojure-emacs/cider/issues/2848) of how little work is needed to have CIDER work with -Fennel. - -## Gradual merger with refactor-nrepl - -It would make sense to move some important refactor-nrepl -functionality into CIDER, provided it doesn't depend on anything -complex (e.g. building an AST for the entire project). - -Below follow a few such candidates. - -This merger also relies on collaboration from the refactor-nrepl team. - -### Move hotload deps to CIDER - -The deps hotloading has been broken in clj-refactor.el for a while now. -It'd be nice if we reimplement it in CIDER. - -### Move the ns-cleanup functionality to CIDER - -Pretty useful functionality, although potentially this can be achieved by shelling out some external tool as well. - -## Socket REPL support (and potentially unrepl/prepl support as well) - -Eventually we want to support socket REPLs of any kind (plain, unrepl, -prepl) in the same manner we support nREPL today (meaning everything -should work with them). The bulk of the work to achieve this is -related to making the CIDER client and server code nREPL agnostic, -so. Work for this is already underway with respect to the server code -(that's the `orchard` project), but hasn't started on the client -(Emacs) side. - -**Update 07/2020** Now that nREPL is once again actively maintained the priority -of this has dropped significantly for us. - -### Decouple the CIDER code from nREPL - -* Isolate the connection-specific code in a couple of client libraries and build a -generic API on top of them dispatching based on the connection type. - -### Implement a socket REPL client - -That should be relatively straightforward, as the communication -protocol for the socket REPL is pretty simple. `parseedn` should be -used to "encode/decode" EDN data. - -### Transition everything non-nREPL specific to Orchard - -As of July, 2020 that's mostly done. We still need to decide if we want to extra pieces -of code like the test runner and the debugger, which are unlikely to be used outside -of nREPL. diff --git a/elpa/cider-1.12.0/Vagrantfile b/elpa/cider-1.12.0/Vagrantfile @@ -1,8 +0,0 @@ -# -*- mode: ruby -*- -# vi: set ft=ruby : - -Vagrant::Config.run do |config| - config.vm.box = "ubuntu/trusty64" - - config.vm.provision :shell, :path => "vagrant/provision.sh" -end diff --git a/elpa/cider-1.12.0/cider-apropos.el b/elpa/cider-1.12.0/cider-apropos.el @@ -1,210 +0,0 @@ -;;; cider-apropos.el --- Apropos functionality for Clojure -*- lexical-binding: t -*- - -;; Copyright © 2014-2023 Jeff Valk, Bozhidar Batsov and CIDER contributors -;; -;; Author: Jeff Valk <jv@jeffvalk.com> - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Apropos functionality for Clojure. - -;;; Code: - -(require 'cider-doc) ; for cider-doc-lookup -(require 'cider-find) ; for cider--find-var -(require 'cider-util) -(require 'subr-x) -(require 'cider-connection) ; for cider-ensure-connected - -(require 'cider-client) -(require 'cider-popup) -(require 'nrepl-dict) - -(require 'apropos) -(require 'button) - -(defconst cider-apropos-buffer "*cider-apropos*") - -(defcustom cider-apropos-actions '(("display-doc" . cider-doc-lookup) - ("find-def" . cider--find-var) - ("lookup-on-clojuredocs" . cider-clojuredocs-lookup)) - "Controls the actions to be applied on the symbol found by an apropos search. -The first action key in the list will be selected as default. If the list -contains only one action key, the associated action function will be -applied automatically. An action function can be any function that receives -the symbol found by the apropos search as argument." - :type '(alist :key-type string :value-type function) - :group 'cider - :package-version '(cider . "0.13.0")) - -(define-button-type 'apropos-special-form - 'apropos-label "Special form" - 'apropos-short-label "s" - 'face 'font-lock-keyword-face - 'help-echo "mouse-2, RET: Display more help on this special form" - 'follow-link t - 'action (lambda (button) - (describe-function (button-get button 'apropos-symbol)))) - -(defun cider-apropos-doc (button) - "Display documentation for the symbol represented at BUTTON." - (cider-doc-lookup (button-get button 'apropos-symbol))) - -(defun cider-apropos-summary (query ns docs-p include-private-p case-sensitive-p) - "Return a short description for the performed apropos search. - -QUERY can be a regular expression list of space-separated words -\(e.g take while) which will be converted to a regular expression -\(like take.+while) automatically behind the scenes. The search may be -limited to the namespace NS, and may optionally search doc strings -\(based on DOCS-P), include private vars (based on INCLUDE-PRIVATE-P), -and be case-sensitive (based on CASE-SENSITIVE-P)." - (concat (if case-sensitive-p "Case-sensitive " "") - (if docs-p "Documentation " "") - (format "Apropos for %S" query) - (if ns (format " in namespace %S" ns) "") - (if include-private-p - " (public and private symbols)" - " (public symbols only)"))) - -(defun cider-apropos-highlight (doc query) - "Return the DOC string propertized to highlight QUERY matches." - (let ((pos 0)) - (while (string-match query doc pos) - (setq pos (match-end 0)) - (put-text-property (match-beginning 0) - (match-end 0) - 'font-lock-face apropos-match-face doc))) - doc) - -(defvar cider-use-tooltips) -(defun cider-apropos-result (result query docs-p) - "Emit a RESULT matching QUERY into current buffer, formatted for DOCS-P." - (nrepl-dbind-response result (name type doc) - (let* ((label (capitalize (if (string= type "variable") "var" type))) - (help (concat "Display doc for this " (downcase label))) - (props (list 'apropos-symbol name - 'action #'cider-apropos-doc)) - (props (if cider-use-tooltips - (append props (list 'help-echo help)) - props))) - (cider-propertize-region props - (insert-text-button name 'type 'apropos-symbol) - (insert "\n ") - (insert-text-button label 'type (intern (concat "apropos-" type))) - (insert ": ") - (let ((beg (point))) - (if docs-p - (insert (cider-apropos-highlight doc query) "\n") - (insert doc) - (fill-region beg (point)))) - (insert "\n"))))) - -(defun cider-show-apropos (summary results query docs-p) - "Show SUMMARY and RESULTS for QUERY in a pop-up buffer, formatted for DOCS-P." - (with-current-buffer (cider-popup-buffer cider-apropos-buffer 'select 'apropos-mode 'ancillary) - (let ((inhibit-read-only t)) - (if (boundp 'header-line-format) - (setq-local header-line-format summary) - (insert summary "\n\n")) - (dolist (result results) - (cider-apropos-result result query docs-p)) - (goto-char (point-min))))) - -;;;###autoload -(defun cider-apropos (query &optional ns docs-p privates-p case-sensitive-p) - "Show all symbols whose names match QUERY, a regular expression. -QUERY can also be a list of space-separated words (e.g. take while) which -will be converted to a regular expression (like take.+while) automatically -behind the scenes. The search may be limited to the namespace NS, and may -optionally search doc strings (based on DOCS-P), include private vars -\(based on PRIVATES-P), and be case-sensitive (based on CASE-SENSITIVE-P)." - (interactive - (cons (read-string "Search for Clojure symbol (a regular expression): ") - (when current-prefix-arg - (list (let ((ns (completing-read "Namespace (default is all): " (cider-sync-request:ns-list)))) - (if (string= ns "") nil ns)) - (y-or-n-p "Search doc strings? ") - (y-or-n-p "Include private symbols? ") - (y-or-n-p "Case-sensitive? "))))) - (cider-ensure-connected) - (cider-ensure-op-supported "apropos") - (if-let* ((summary (cider-apropos-summary - query ns docs-p privates-p case-sensitive-p)) - (results (cider-sync-request:apropos query ns docs-p privates-p case-sensitive-p))) - (cider-show-apropos summary results query docs-p) - (message "No apropos matches for %S" query))) - -;;;###autoload -(defun cider-apropos-documentation () - "Shortcut for (cider-apropos <query> nil t)." - (interactive) - (cider-ensure-connected) - (cider-ensure-op-supported "apropos") - (cider-apropos (read-string "Search for Clojure documentation (a regular expression): ") nil t)) - -(defun cider-apropos-act-on-symbol (symbol) - "Apply selected action on SYMBOL." - (let* ((first-action-key (car (car cider-apropos-actions))) - (action-key (if (= 1 (length cider-apropos-actions)) - first-action-key - (completing-read (format "Choose action to apply to `%s` (default %s): " - symbol first-action-key) - cider-apropos-actions nil nil nil nil first-action-key))) - (action-fn (cdr (assoc action-key cider-apropos-actions)))) - (if action-fn - (funcall action-fn symbol) - (user-error "Unknown action `%s`" action-key)))) - -;;;###autoload -(defun cider-apropos-select (query &optional ns docs-p privates-p case-sensitive-p) - "Similar to `cider-apropos', but presents the results in a completing read. -Show all symbols whose names match QUERY, a regular expression. -QUERY can also be a list of space-separated words (e.g. take while) which -will be converted to a regular expression (like take.+while) automatically -behind the scenes. The search may be limited to the namespace NS, and may -optionally search doc strings (based on DOCS-P), include private vars -\(based on PRIVATES-P), and be case-sensitive (based on CASE-SENSITIVE-P)." - (interactive - (cons (read-string "Search for Clojure symbol (a regular expression): ") - (when current-prefix-arg - (list (let ((ns (completing-read "Namespace (default is all): " (cider-sync-request:ns-list)))) - (if (string= ns "") nil ns)) - (y-or-n-p "Search doc strings? ") - (y-or-n-p "Include private symbols? ") - (y-or-n-p "Case-sensitive? "))))) - (cider-ensure-connected) - (cider-ensure-op-supported "apropos") - (if-let* ((summary (cider-apropos-summary - query ns docs-p privates-p case-sensitive-p)) - (results (mapcar (lambda (r) (nrepl-dict-get r "name")) - (cider-sync-request:apropos query ns docs-p privates-p case-sensitive-p)))) - (cider-apropos-act-on-symbol (completing-read (concat summary ": ") results)) - (message "No apropos matches for %S" query))) - -;;;###autoload -(defun cider-apropos-documentation-select () - "Shortcut for (cider-apropos-select <query> nil t)." - (interactive) - (cider-ensure-connected) - (cider-ensure-op-supported "apropos") - (cider-apropos-select (read-string "Search for Clojure documentation (a regular expression): ") nil t)) - -(provide 'cider-apropos) - -;;; cider-apropos.el ends here diff --git a/elpa/cider-1.12.0/cider-autoloads.el b/elpa/cider-1.12.0/cider-autoloads.el @@ -1,688 +0,0 @@ -;;; cider-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 cider.el - -(autoload 'cider-version "cider" "\ -Display CIDER's version." t) - (autoload 'cider-start-map "cider" "CIDER jack-in and connect keymap." t 'keymap) -(autoload 'cider-jack-in-clj "cider" "\ -Start an nREPL server for the current project and connect to it. -PARAMS is a plist optionally containing :project-dir and :jack-in-cmd. -With the prefix argument, allow editing of the jack in command; with a -double prefix prompt for all these parameters. - -(fn PARAMS)" t) -(autoload 'cider-jack-in-cljs "cider" "\ -Start an nREPL server for the current project and connect to it. -PARAMS is a plist optionally containing :project-dir, :jack-in-cmd and -:cljs-repl-type (e.g. 'shadow, 'node, 'figwheel, etc). - -With the prefix argument, -allow editing of the jack in command; with a double prefix prompt for all -these parameters. - -(fn PARAMS)" t) -(autoload 'cider-jack-in-clj&cljs "cider" "\ -Start an nREPL server and connect with clj and cljs REPLs. -PARAMS is a plist optionally containing :project-dir, :jack-in-cmd and -:cljs-repl-type (e.g. 'shadow, 'node, 'fighweel, etc). - -With the prefix argument, allow for editing of the jack in command; -with a double prefix prompt for all these parameters. - -When SOFT-CLJS-START is non-nil, start cljs REPL -only when the ClojureScript dependencies are met. - -(fn &optional PARAMS SOFT-CLJS-START)" t) -(autoload 'cider-connect-sibling-clj "cider" "\ -Create a Clojure REPL with the same server as OTHER-REPL. -PARAMS is for consistency with other connection commands and is currently -ignored. OTHER-REPL defaults to `cider-current-repl' and in programs can -also be a server buffer, in which case a new session with a REPL for that -server is created. - -(fn PARAMS &optional OTHER-REPL)" t) -(autoload 'cider-connect-sibling-cljs "cider" "\ -Create a ClojureScript REPL with the same server as OTHER-REPL. -PARAMS is a plist optionally containing :cljs-repl-type (e.g. 'node, -'figwheel, 'shadow, etc). - -All other parameters are inferred from the OTHER-REPL. -OTHER-REPL defaults to `cider-current-repl' but in programs can also be a -server buffer, in which case a new session for that server is created. - -(fn PARAMS &optional OTHER-REPL)" t) -(autoload 'cider-connect-clj "cider" "\ -Initialize a Clojure connection to an nREPL server. -PARAMS is a plist optionally containing :host, :port and :project-dir. On -prefix argument, prompt for all the parameters. - -(fn &optional PARAMS)" t) -(autoload 'cider-connect-cljs "cider" "\ -Initialize a ClojureScript connection to an nREPL server. -PARAMS is a plist optionally containing :host, :port, :project-dir and -:cljs-repl-type (e.g. 'shadow, 'node, 'figwheel, etc). - -On prefix, prompt for all the -parameters regardless of their supplied or default values. - -(fn &optional PARAMS)" t) -(autoload 'cider-connect-clj&cljs "cider" "\ -Initialize a Clojure and ClojureScript connection to an nREPL server. -PARAMS is a plist optionally containing :host, :port, :project-dir and -:cljs-repl-type (e.g. 'shadow, 'node, 'figwheel, etc). When SOFT-CLJS-START is -non-nil, don't start if ClojureScript requirements are not met. - -(fn PARAMS &optional SOFT-CLJS-START)" t) -(autoload 'cider "cider" "\ -Start a connection of any type interactively." t) -(defalias 'cider-jack-in #'cider-jack-in-clj) -(defalias 'cider-connect #'cider-connect-clj) -(autoload 'cider-jack-in-universal "cider" "\ -Start and connect to an nREPL server for the current project or ARG project id. - -If a project is found in current dir, call `cider-jack-in' passing ARG as -first parameter, of which see. Otherwise, ask user which project type to -start an nREPL server and connect to without a project. - -But if invoked with a numeric prefix ARG, then start an nREPL server for -the project type denoted by ARG number and connect to it, even if there is -no project for it in the current dir. - -The supported project tools and their assigned numeric prefix ids are -sourced from `cider-jack-in-universal-options', of which see. - -You can pass a numeric prefix argument n with `M-n` or `C-u n`. - -For example, to jack in to leiningen which is assigned to prefix arg 2 type - -M-2 \\[cider-jack-in-universal]. - -(fn ARG)" t) -(with-eval-after-load 'clojure-mode (define-key clojure-mode-map (kbd "C-c M-x") #'cider) (define-key clojure-mode-map (kbd "C-c M-j") #'cider-jack-in-clj) (define-key clojure-mode-map (kbd "C-c M-J") #'cider-jack-in-cljs) (define-key clojure-mode-map (kbd "C-c M-c") #'cider-connect-clj) (define-key clojure-mode-map (kbd "C-c M-C") #'cider-connect-cljs) (define-key clojure-mode-map (kbd "C-c C-x") 'cider-start-map) (define-key clojure-mode-map (kbd "C-c C-s") 'sesman-map) (require 'sesman) (sesman-install-menu clojure-mode-map) (add-hook 'clojure-mode-hook (lambda nil (setq-local sesman-system 'CIDER)))) -(register-definition-prefixes "cider" '("cider-")) - - -;;; Generated autoloads from cider-apropos.el - -(autoload 'cider-apropos "cider-apropos" "\ -Show all symbols whose names match QUERY, a regular expression. -QUERY can also be a list of space-separated words (e.g. take while) which -will be converted to a regular expression (like take.+while) automatically -behind the scenes. The search may be limited to the namespace NS, and may -optionally search doc strings (based on DOCS-P), include private vars -(based on PRIVATES-P), and be case-sensitive (based on CASE-SENSITIVE-P). - -(fn QUERY &optional NS DOCS-P PRIVATES-P CASE-SENSITIVE-P)" t) -(autoload 'cider-apropos-documentation "cider-apropos" "\ -Shortcut for (cider-apropos <query> nil t)." t) -(autoload 'cider-apropos-select "cider-apropos" "\ -Similar to `cider-apropos', but presents the results in a completing read. -Show all symbols whose names match QUERY, a regular expression. -QUERY can also be a list of space-separated words (e.g. take while) which -will be converted to a regular expression (like take.+while) automatically -behind the scenes. The search may be limited to the namespace NS, and may -optionally search doc strings (based on DOCS-P), include private vars -(based on PRIVATES-P), and be case-sensitive (based on CASE-SENSITIVE-P). - -(fn QUERY &optional NS DOCS-P PRIVATES-P CASE-SENSITIVE-P)" t) -(autoload 'cider-apropos-documentation-select "cider-apropos" "\ -Shortcut for (cider-apropos-select <query> nil t)." t) -(register-definition-prefixes "cider-apropos" '("apropos-special-form" "cider-")) - - -;;; Generated autoloads from cider-browse-ns.el - -(autoload 'cider-browse-ns "cider-browse-ns" "\ -List all NAMESPACE's vars in BUFFER. - -(fn NAMESPACE)" t) -(autoload 'cider-browse-ns-all "cider-browse-ns" "\ -List all loaded namespaces in BUFFER." t) -(register-definition-prefixes "cider-browse-ns" '("cider-browse-ns-")) - - -;;; Generated autoloads from cider-browse-spec.el - -(autoload 'cider-browse-spec "cider-browse-spec" "\ -Browse SPEC definition. - -(fn SPEC)" t) -(autoload 'cider-browse-spec-all "cider-browse-spec" "\ -Open list of specs in a popup buffer. - -With a prefix argument ARG, prompts for a regexp to filter specs. -No filter applied if the regexp is the empty string. - -(fn &optional ARG)" t) -(register-definition-prefixes "cider-browse-spec" '("cider-")) - - -;;; Generated autoloads from cider-cheatsheet.el - -(autoload 'cider-cheatsheet "cider-cheatsheet" "\ -Navigate `cider-cheatsheet-hierarchy' with `completing-read'. - -When you make it to a Clojure var its doc buffer gets displayed." t) -(register-definition-prefixes "cider-cheatsheet" '("cider-cheatsheet-")) - - -;;; Generated autoloads from cider-classpath.el - -(autoload 'cider-classpath "cider-classpath" "\ -List all classpath entries." t) -(autoload 'cider-open-classpath-entry "cider-classpath" "\ -Open a classpath entry." t) -(register-definition-prefixes "cider-classpath" '("cider-classpath-")) - - -;;; Generated autoloads from cider-client.el - -(register-definition-prefixes "cider-client" '("cider-")) - - -;;; Generated autoloads from cider-clojuredocs.el - -(autoload 'cider-clojuredocs-web "cider-clojuredocs" "\ -Open ClojureDocs documentation in the default web browser. - -Prompts for the symbol to use, or uses the symbol at point, depending on -the value of `cider-prompt-for-symbol'. With prefix arg ARG, does the -opposite of what that option dictates. - -(fn &optional ARG)" t) -(autoload 'cider-clojuredocs-refresh-cache "cider-clojuredocs" "\ -Refresh the ClojureDocs cache." t) -(autoload 'cider-clojuredocs "cider-clojuredocs" "\ -Open ClojureDocs documentation in a popup buffer. - -Prompts for the symbol to use, or uses the symbol at point, depending on -the value of `cider-prompt-for-symbol'. With prefix arg ARG, does the -opposite of what that option dictates. - -(fn &optional ARG)" t) -(register-definition-prefixes "cider-clojuredocs" '("cider-")) - - -;;; Generated autoloads from cider-common.el - -(register-definition-prefixes "cider-common" '("cider-")) - - -;;; Generated autoloads from cider-completion.el - -(register-definition-prefixes "cider-completion" '("cider-")) - - -;;; Generated autoloads from cider-completion-context.el - -(register-definition-prefixes "cider-completion-context" '("cider-completion-")) - - -;;; Generated autoloads from cider-connection.el - -(register-definition-prefixes "cider-connection" '("cider-")) - - -;;; Generated autoloads from cider-debug.el - -(autoload 'cider-debug-defun-at-point "cider-debug" "\ -Instrument the \"top-level\" expression at point. -If it is a defn, dispatch the instrumented definition. Otherwise, -immediately evaluate the instrumented expression. - -While debugged code is being evaluated, the user is taken through the -source code and displayed the value of various expressions. At each step, -a number of keys will be prompted to the user." t) -(register-definition-prefixes "cider-debug" '("cider-")) - - -;;; Generated autoloads from cider-doc.el - -(register-definition-prefixes "cider-doc" '("cider-")) - - -;;; Generated autoloads from cider-docstring.el - -(register-definition-prefixes "cider-docstring" '("cider-")) - - -;;; Generated autoloads from cider-eldoc.el - -(register-definition-prefixes "cider-eldoc" '("cider-")) - - -;;; Generated autoloads from cider-eval.el - -(register-definition-prefixes "cider-eval" '("cider-")) - - -;;; Generated autoloads from cider-find.el - -(autoload 'cider-find-var "cider-find" "\ -Find definition for VAR at LINE. -Prompt according to prefix ARG and `cider-prompt-for-symbol'. -A single or double prefix argument inverts the meaning of -`cider-prompt-for-symbol'. A prefix of `-` or a double prefix argument causes -the results to be displayed in a different window. The default value is -thing at point. - -(fn &optional ARG VAR LINE)" t) -(autoload 'cider-find-dwim-at-mouse "cider-find" "\ -Find and display variable or resource at mouse EVENT. - -(fn EVENT)" t) -(autoload 'cider-find-dwim "cider-find" "\ -Find and display the SYMBOL-FILE at point. -SYMBOL-FILE could be a var or a resource. If thing at point is empty then -show Dired on project. If var is not found, try to jump to resource of the -same name. When called interactively, a prompt is given according to the -variable `cider-prompt-for-symbol'. A single or double prefix argument -inverts the meaning. A prefix of `-' or a double prefix argument causes -the results to be displayed in a different window. A default value of thing -at point is given when prompted. - -(fn SYMBOL-FILE)" t) -(autoload 'cider-find-resource "cider-find" "\ -Find the resource at PATH. -Prompt for input as indicated by the variable `cider-prompt-for-symbol'. -A single or double prefix argument inverts the meaning of -`cider-prompt-for-symbol'. A prefix argument of `-` or a double prefix -argument causes the results to be displayed in other window. The default -value is thing at point. - -(fn PATH)" t) -(autoload 'cider-find-ns "cider-find" "\ -Find the file containing NS. -A prefix ARG of `-` or a double prefix argument causes -the results to be displayed in a different window. - -(fn &optional ARG NS)" t) -(autoload 'cider-find-keyword "cider-find" "\ -Find the namespace of the keyword at point and its primary occurrence there. - -For instance - if the keyword at point is \":cider.demo/keyword\", this command -would find the namespace \"cider.demo\" and afterwards find the primary (most relevant or first) -mention of \"::keyword\" there. - -Prompt according to prefix ARG and `cider-prompt-for-symbol'. -A single or double prefix argument inverts the meaning of -`cider-prompt-for-symbol'. A prefix of `-` or a double prefix argument causes -the results to be displayed in a different window. The default value is -thing at point. - -(fn &optional ARG)" t) -(register-definition-prefixes "cider-find" '("cider-")) - - -;;; Generated autoloads from cider-format.el - -(autoload 'cider-format-region "cider-format" "\ -Format the Clojure code in the current region. -START and END represent the region's boundaries. - -(fn START END)" t) -(autoload 'cider-format-defun "cider-format" "\ -Format the code in the current defun." t) -(autoload 'cider-format-buffer "cider-format" "\ -Format the Clojure code in the current buffer." t) -(autoload 'cider-format-edn-buffer "cider-format" "\ -Format the EDN data in the current buffer." t) -(autoload 'cider-format-edn-region "cider-format" "\ -Format the EDN data in the current region. -START and END represent the region's boundaries. - -(fn START END)" t) -(autoload 'cider-format-edn-last-sexp "cider-format" "\ -Format the EDN data of the last sexp." t) -(register-definition-prefixes "cider-format" '("cider--format-")) - - -;;; Generated autoloads from cider-inspector.el - -(autoload 'cider-inspect-last-sexp "cider-inspector" "\ -Inspect the result of the the expression preceding point." t) -(autoload 'cider-inspect-defun-at-point "cider-inspector" "\ -Inspect the result of the \"top-level\" expression at point." t) -(autoload 'cider-inspect-last-result "cider-inspector" "\ -Inspect the most recent eval result." t) -(autoload 'cider-inspect "cider-inspector" "\ -Inspect the result of the preceding sexp. - -With a prefix argument ARG it inspects the result of the \"top-level\" form. -With a second prefix argument it prompts for an expression to eval and inspect. - -(fn &optional ARG)" t) -(autoload 'cider-inspect-expr "cider-inspector" "\ -Evaluate EXPR in NS and inspect its value. -Interactively, EXPR is read from the minibuffer, and NS the -current buffer's namespace. - -(fn EXPR NS)" t) -(autoload 'cider-sync-request:inspect-last-exception "cider-inspector" "\ -Inspects the exception in the cause stack identified by INDEX, -V2 indicates if the entire response should be returned -instead of just its \"value\" entry. - -(fn INDEX &optional V2)") -(register-definition-prefixes "cider-inspector" '("cider-")) - - -;;; Generated autoloads from cider-jar.el - -(register-definition-prefixes "cider-jar" '("cider-jar-")) - - -;;; Generated autoloads from cider-log.el - - (autoload 'cider-log-info "cider-log-info" "Show the Cider log current log buffer, framework, appender and consumer." t) - (autoload 'cider-log-framework "cider-log" "Show the Cider log framework menu." t) - (autoload 'cider-log-appender "cider-log" "Show the Cider log appender menu." t) - (autoload 'cider-log-consumer "cider-log" "Show the Cider log consumer menu." t) - (autoload 'cider-log-event "cider-log" "Show the Cider log event menu." t) - (autoload 'cider-log "cider-log" "Show the Cider log menu." t) -(register-definition-prefixes "cider-log" '("cider-")) - - -;;; Generated autoloads from cider-macroexpansion.el - -(autoload 'cider-macroexpand-1 "cider-macroexpansion" "\ -Invoke \\=`macroexpand-1\\=` on the expression preceding point. -If invoked with a PREFIX argument, use \\=`macroexpand\\=` instead of -\\=`macroexpand-1\\=`. - -(fn &optional PREFIX)" t) -(autoload 'cider-macroexpand-all "cider-macroexpansion" "\ -Invoke \\=`macroexpand-all\\=` on the expression preceding point." t) -(register-definition-prefixes "cider-macroexpansion" '("cider-")) - - -;;; Generated autoloads from cider-mode.el - -(defvar cider-mode-line '(:eval (format " cider[%s]" (cider--modeline-info))) "\ -Mode line lighter for cider mode. - -The value of this variable is a mode line template as in -`mode-line-format'. See Info Node `(elisp)Mode Line Format' for details -about mode line templates. - -Customize this variable to change how cider mode displays its status in the -mode line. The default value displays the current connection. Set this -variable to nil to disable the mode line entirely.") -(custom-autoload 'cider-mode-line "cider-mode" t) -(with-eval-after-load 'clojure-mode (easy-menu-define cider-clojure-mode-menu-open clojure-mode-map "Menu for Clojure mode. - This is displayed in `clojure-mode' buffers, if `cider-mode' is not active." `("CIDER" :visible (not cider-mode) ["Start a Clojure REPL" cider-jack-in-clj :help "Starts an nREPL server and connects a Clojure REPL to it."] ["Connect to a Clojure REPL" cider-connect-clj :help "Connects to a REPL that's already running."] ["Start a ClojureScript REPL" cider-jack-in-cljs :help "Starts an nREPL server and connects a ClojureScript REPL to it."] ["Connect to a ClojureScript REPL" cider-connect-cljs :help "Connects to a ClojureScript REPL that's already running."] ["Start a Clojure REPL, and a ClojureScript REPL" cider-jack-in-clj&cljs :help "Starts an nREPL server, connects a Clojure REPL to it, and then a ClojureScript REPL."] "--" ["View user manual" cider-view-manual]))) -(autoload 'cider-mode "cider-mode" "\ -Minor mode for REPL interaction from a Clojure buffer. - -\\{cider-mode-map} - -This is a minor mode. If called interactively, toggle the `Cider - 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 `cider-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 "cider-mode" '("cider-")) - - -;;; Generated autoloads from cider-ns.el - -(autoload 'cider-ns-reload "cider-ns" "\ -Send a (require 'ns :reload) to the REPL. - -With an argument PROMPT, it prompts for a namespace name. This is the -Clojure out of the box reloading experience and does not rely on -org.clojure/tools.namespace. See Commentary of this file for a longer list -of differences. From the Clojure doc: \":reload forces loading of all the -identified libs even if they are already loaded\". - -(fn &optional PROMPT)" t) -(autoload 'cider-ns-reload-all "cider-ns" "\ -Send a (require 'ns :reload-all) to the REPL. - -With an argument PROMPT, it prompts for a namespace name. This is the -Clojure out of the box reloading experience and does not rely on -org.clojure/tools.namespace. See Commentary of this file for a longer list -of differences. From the Clojure doc: \":reload-all implies :reload and -also forces loading of all libs that the identified libs directly or -indirectly load via require\". - -(fn &optional PROMPT)" t) -(autoload 'cider-ns-refresh "cider-ns" "\ -Reload modified and unloaded namespaces on the classpath. - -With a single prefix argument, or if MODE is `refresh-all', reload all -namespaces on the classpath unconditionally. - -With a double prefix argument, or if MODE is `clear', clear the state of -the namespace tracker before reloading. This is useful for recovering from -some classes of error (for example, those caused by circular dependencies) -that a normal reload would not otherwise recover from. The trade-off of -clearing is that stale code from any deleted files may not be completely -unloaded. - -With a negative prefix argument, or if MODE is `inhibit-fns', prevent any -refresh functions (defined in `cider-ns-refresh-before-fn' and -`cider-ns-refresh-after-fn') from being invoked. - -(fn &optional MODE)" t) -(register-definition-prefixes "cider-ns" '("cider-ns-")) - - -;;; Generated autoloads from cider-overlays.el - -(register-definition-prefixes "cider-overlays" '("cider-")) - - -;;; Generated autoloads from cider-popup.el - -(register-definition-prefixes "cider-popup" '("cider-")) - - -;;; Generated autoloads from cider-profile.el - -(autoload 'cider-profile-samples "cider-profile" "\ -Displays current max-sample-count. -If optional QUERY is specified, set max-sample-count and display new value. - -(fn &optional QUERY)" t) -(autoload 'cider-profile-var-profiled-p "cider-profile" "\ -Displays the profiling status of var under point. -Prompts for var if none under point or QUERY is present. - -(fn QUERY)" t) -(autoload 'cider-profile-ns-toggle "cider-profile" "\ -Toggle profiling for the ns associated with optional QUERY. - -If optional argument QUERY is non-nil, prompt for ns. Otherwise use -current ns. - -(fn &optional QUERY)" t) -(autoload 'cider-profile-toggle "cider-profile" "\ -Toggle profiling for the given QUERY. -Defaults to the symbol at point. -With prefix arg or no symbol at point, prompts for a var. - -(fn QUERY)" t) -(autoload 'cider-profile-summary "cider-profile" "\ -Display a summary of currently collected profile data." t) -(autoload 'cider-profile-var-summary "cider-profile" "\ -Display profile data for var under point QUERY. -Defaults to the symbol at point. With prefix arg or no symbol at point, -prompts for a var. - -(fn QUERY)" t) -(autoload 'cider-profile-clear "cider-profile" "\ -Clear any collected profile data." t) -(register-definition-prefixes "cider-profile" '("cider-profile-")) - - -;;; Generated autoloads from cider-repl.el - -(register-definition-prefixes "cider-repl" '("cider-")) - - -;;; Generated autoloads from cider-repl-history.el - -(autoload 'cider-repl-history "cider-repl-history" "\ -Display items in the CIDER command history in another buffer." t) -(register-definition-prefixes "cider-repl-history" '("cider-repl-history-")) - - -;;; Generated autoloads from cider-resolve.el - -(register-definition-prefixes "cider-resolve" '("cider-resolve-")) - - -;;; Generated autoloads from cider-scratch.el - -(autoload 'cider-scratch "cider-scratch" "\ -Go to the scratch buffer named `cider-scratch-buffer-name'." t) -(register-definition-prefixes "cider-scratch" '("cider-")) - - -;;; Generated autoloads from cider-selector.el - -(autoload 'cider-selector "cider-selector" "\ -Select a new buffer by type, indicated by a single character. -The user is prompted for a single character indicating the method by -which to choose a new buffer. The `?' character describes the -available methods. OTHER-WINDOW provides an optional target. -See `def-cider-selector-method' for defining new methods. - -(fn &optional OTHER-WINDOW)" t) -(register-definition-prefixes "cider-selector" '("??" "?c" "?d" "?e" "?m" "?p" "?q" "?r" "?s" "?x" "cider-selector-" "def-cider-selector-method")) - - -;;; Generated autoloads from cider-stacktrace.el - -(register-definition-prefixes "cider-stacktrace" '("cider-")) - - -;;; Generated autoloads from cider-test.el - -(defvar cider-auto-test-mode nil "\ -Non-nil if Cider-Auto-Test mode is enabled. -See the `cider-auto-test-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 `cider-auto-test-mode'.") -(custom-autoload 'cider-auto-test-mode "cider-test" nil) -(autoload 'cider-auto-test-mode "cider-test" "\ -Toggle automatic testing of Clojure files. - -When enabled this reruns tests every time a Clojure file is loaded. -Only runs tests corresponding to the loaded file's namespace and does -nothing if no tests are defined or if the file failed to load. - -This is a global minor mode. If called interactively, toggle the - `Cider-Auto-Test 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 \\='cider-auto-test-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 "cider-test" '("cider-")) - - -;;; Generated autoloads from cider-tracing.el - -(autoload 'cider-toggle-trace-var "cider-tracing" "\ -Toggle var tracing. -Prompts for the symbol to use, or uses the symbol at point, depending on -the value of `cider-prompt-for-symbol'. With prefix arg ARG, does the -opposite of what that option dictates. - -(fn ARG)" t) -(autoload 'cider-toggle-trace-ns "cider-tracing" "\ -Toggle ns tracing. -Defaults to the current ns. With prefix arg QUERY, prompts for a ns. - -(fn QUERY)" t) -(register-definition-prefixes "cider-tracing" '("cider-")) - - -;;; Generated autoloads from cider-util.el - -(autoload 'cider-view-manual "cider-util" "\ -View the manual in your default browser." t) -(register-definition-prefixes "cider-util" '("cider-")) - - -;;; Generated autoloads from cider-xref.el - -(autoload 'cider-xref-fn-refs "cider-xref" "\ -Show all functions that reference the var matching NS and SYMBOL. - -(fn &optional NS SYMBOL)" t) -(autoload 'cider-xref-fn-deps "cider-xref" "\ -Show all functions referenced by the var matching NS and SYMBOL. - -(fn &optional NS SYMBOL)" t) -(autoload 'cider-xref-fn-refs-select "cider-xref" "\ -Displays the references for NS and SYMBOL using completing read. - -(fn &optional NS SYMBOL)" t) -(autoload 'cider-xref-fn-deps-select "cider-xref" "\ -Displays the function dependencies for NS and SYMBOL using completing read. - -(fn &optional NS SYMBOL)" t) -(register-definition-prefixes "cider-xref" '("cider-")) - - -;;; Generated autoloads from cider-xref-backend.el - -(register-definition-prefixes "cider-xref-backend" '("cider--")) - - -;;; Generated autoloads from nrepl-client.el - -(register-definition-prefixes "nrepl-client" '("cider-" "emacs-bug-46284/when-27.1-windows-nt" "nrepl-")) - - -;;; Generated autoloads from nrepl-dict.el - -(register-definition-prefixes "nrepl-dict" '("nrepl-")) - -;;; End of scraped data - -(provide 'cider-autoloads) - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; no-native-compile: t -;; coding: utf-8-emacs-unix -;; End: - -;;; cider-autoloads.el ends here diff --git a/elpa/cider-1.12.0/cider-browse-ns.el b/elpa/cider-1.12.0/cider-browse-ns.el @@ -1,550 +0,0 @@ -;;; cider-browse-ns.el --- CIDER namespace browser -*- lexical-binding: t; -*- - -;; Copyright © 2014-2023 John Andrews, Bozhidar Batsov and CIDER contributors - -;; Author: John Andrews <john.m.andrews@gmail.com> - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; M-x cider-browse-ns -;; -;; Display a list of all vars in a namespace. -;; Pressing <enter> will take you to the cider-doc buffer for that var. -;; Pressing ^ will take you to a list of all namespaces (akin to `dired-mode'). - -;; M-x cider-browse-ns-all -;; -;; Explore Clojure namespaces by browsing a list of all namespaces. -;; Pressing <enter> expands into a list of that namespace's vars as if by -;; executing the command (cider-browse-ns "my.ns"). - -;;; Code: - -(require 'cider-client) -(require 'cider-popup) -(require 'cider-util) -(require 'nrepl-dict) - -(require 'subr-x) -(require 'easymenu) -(require 'button) -(require 'cl-lib) -(require 'thingatpt) - - -(defgroup cider-browse-ns nil - "Display contents of namespaces for CIDER." - :prefix "cider-browse-ns-" - :group 'cider) - -(defface cider-browse-ns-extra-info-face - '((t (:inherit shadow))) - "Face for displaying extra info of namespace vars." - :package-version '(cider . "1.4.0")) - -(defcustom cider-browse-ns-default-filters nil - "List of default hide filters to apply to browse-ns buffer. - -Available options include `private', `test', `macro', `function', and -`var'." - :type 'list - :package-version '(cider . "1.4.0")) - -(defconst cider-browse-ns-buffer "*cider-ns-browser*") - -(defvar-local cider-browse-ns-current-ns nil) - -(defvar-local cider-browse-ns-filters nil) -(defvar-local cider-browse-ns-show-all nil) -(defvar-local cider-browse-ns-group-by nil) -(defvar-local cider-browse-ns-items nil) -(defvar-local cider-browse-ns-title nil) -(defvar-local cider-browse-ns-group-by nil) - - -;; Mode Definition - -(defvar cider-browse-ns-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map cider-popup-buffer-mode-map) - (define-key map "d" #'cider-browse-ns-doc-at-point) - (define-key map "s" #'cider-browse-ns-find-at-point) - (define-key map (kbd "RET") #'cider-browse-ns-operate-at-point) - (define-key map "^" #'cider-browse-ns-all) - (define-key map "n" #'next-line) - (define-key map "p" #'previous-line) - - (define-key map "a" #'cider-browse-ns-toggle-all) - - (define-key map (kbd "h p") #'cider-browse-ns-toggle-hide-private) - (define-key map (kbd "h t") #'cider-browse-ns-toggle-hide-test) - (define-key map (kbd "h m") #'cider-browse-ns-toggle-hide-macro) - (define-key map (kbd "h f") #'cider-browse-ns-toggle-hide-function) - (define-key map (kbd "h v") #'cider-browse-ns-toggle-hide-var) - - (define-key map (kbd "g t") #'cider-browse-ns-group-by-type) - (define-key map (kbd "g v") #'cider-browse-ns-group-by-visibility) - - (easy-menu-define cider-browse-ns-mode-menu map - "Menu for CIDER's namespace browser" - '("Namespace Browser" - ["Show doc" cider-browse-ns-doc-at-point] - ["Go to definition" cider-browse-ns-find-at-point] - "--" - ["Browse all namespaces" cider-browse-ns-all])) - map)) - -(defvar cider-browse-ns-mouse-map - (let ((map (make-sparse-keymap))) - (define-key map [mouse-1] #'cider-browse-ns-handle-mouse) - map)) - -(define-derived-mode cider-browse-ns-mode special-mode "browse-ns" - "Major mode for browsing Clojure namespaces. - -\\{cider-browse-ns-mode-map}" - (setq-local electric-indent-chars nil) - (setq-local sesman-system 'CIDER) - (when cider-special-mode-truncate-lines - (setq-local truncate-lines t)) - (setq-local cider-browse-ns-current-ns nil)) - -(defun cider-browse-ns--text-face (var-meta) - "Return font-lock-face for a var. -VAR-META contains the metadata information used to decide a face. -Presence of \"arglists\" and \"macro\" indicates a macro form. -Only \"arglists\" indicates a function. Otherwise, its a variable. -If the NAMESPACE is not loaded in the REPL, assume TEXT is a fn." - (cond - ((not var-meta) 'font-lock-function-name-face) - ((and (nrepl-dict-contains var-meta "arglists") - (string= (nrepl-dict-get var-meta "macro") "true")) - 'font-lock-keyword-face) - ((nrepl-dict-contains var-meta "arglists") 'font-lock-function-name-face) - (t 'font-lock-variable-name-face))) - -(defun cider-browse-ns--properties (var var-meta) - "Decorate VAR with a clickable keymap and a face. -VAR-META is used to decide a font-lock face." - (let ((face (cider-browse-ns--text-face var-meta))) - (propertize var - 'font-lock-face face - 'mouse-face 'highlight - 'keymap cider-browse-ns-mouse-map))) - -(defun cider-browse-ns--ns-list (buffer title nss) - "List the namespaces NSS in BUFFER. - -Buffer is rendered with TITLE at the top and lists ITEMS filtered according -to user settings." - (let ((dict (nrepl-dict))) - (dolist (ns nss) - (nrepl-dict-put dict ns (nrepl-dict "ns" "true"))) - (cider-browse-ns--list buffer title dict nil))) - -(defun cider-browse-ns--list (buffer title items ns) - "Initialize rendering of browse-ns BUFFER. - -Initialize the buffer's TITLE, namespace NS, and the nrepl-dict ITEMS to be -displayed." - (with-current-buffer buffer - (cider-browse-ns-mode) - (setq-local cider-browse-ns-items items) - (setq-local cider-browse-ns-title title) - (setq-local cider-browse-ns-filters cider-browse-ns-default-filters) - (setq-local cider-browse-ns-current-ns ns)) - (cider-browse-ns--render-buffer)) - -(defun cider-browse-ns--meta-macro-p (var-meta) - "Return non-nil if VAR-META is the metadata of a macro." - (and (nrepl-dict-contains var-meta "arglists") - (string= (nrepl-dict-get var-meta "macro") "true"))) - -(defun cider-browse-ns--meta-test-p (var-meta) - "Return non-nil if VAR-META is the metadata of a test." - (nrepl-dict-contains var-meta "test")) - -(defun cider-browse-ns--meta-function-p (var-meta) - "Return non-nil if VAR-META is the metadata of a function." - (and (nrepl-dict-contains var-meta "arglists") - (not (cider-browse-ns--meta-macro-p var-meta)))) - -(defun cider-browse-ns--meta-private-p (var-meta) - "Return non-nil if VAR-META indicates a private element." - (string= (nrepl-dict-get var-meta "private") "true")) - -(defun cider-browse-ns--meta-var-p (var-meta) - "Return non-nil if VAR-META indicates a var." - (not (or (cider-browse-ns--meta-test-p var-meta) - (cider-browse-ns--meta-macro-p var-meta) - (cider-browse-ns--meta-function-p var-meta)))) - -(defun cider-browse-ns--item-filter (_ var-meta) - "Return non-nil if item containing VAR-META should be listed in buffer." - (let ((function-filter-p (memq 'function cider-browse-ns-filters)) - (var-filter-p (memq 'var cider-browse-ns-filters)) - (private-filter-p (memq 'private cider-browse-ns-filters)) - (test-filter-p (memq 'test cider-browse-ns-filters)) - (macro-filter-p (memq 'macro cider-browse-ns-filters))) - ;; check if item should be displayed - (let* ((macro-p (cider-browse-ns--meta-macro-p var-meta)) - (function-p (cider-browse-ns--meta-function-p var-meta)) - (private-p (cider-browse-ns--meta-private-p var-meta)) - (test-p (cider-browse-ns--meta-test-p var-meta)) - (var-p (cider-browse-ns--meta-var-p var-meta))) - (or cider-browse-ns-show-all - (not (or (and macro-p macro-filter-p) - (and function-p function-filter-p) - (and test-p test-filter-p) - (and var-p var-filter-p) - (and private-p private-filter-p))))))) - -(defun cider-browse-ns--propertized-item (key items) - "Return propertized line of item KEY in nrepl-dict ITEMS." - (let* ((var-meta (nrepl-dict-get items key)) - (face (cider-browse-ns--text-face (nrepl-dict-get items key))) - (private-p (string= (nrepl-dict-get var-meta "private") "true")) - (test-p (nrepl-dict-contains var-meta "test")) - (ns-p (nrepl-dict-contains var-meta "ns"))) - (concat - (propertize key - 'font-lock-face face - 'ns ns-p) - " " - (cond - (test-p (propertize "(test) " 'face 'cider-browse-ns-extra-info-face)) - (private-p (propertize "(-) " 'face 'cider-browse-ns-extra-info-face)) - (t ""))))) - -(defun cider-browse-ns--display-list (keys items max-length &optional label) - "Render the items of KEYS as condained in the nrepl-dict ITEMS. - -Pad the row to be MAX-LENGTH+1. If LABEL is non-nil, add a header to the -list of items." - (when keys - (when label - (insert " " label ":\n")) - (dolist (key keys) - (let* ((doc (nrepl-dict-get-in items (list key "doc"))) - (doc (when doc (read doc))) - (first-doc-line (cider-browse-ns--first-doc-line doc)) - (item-line (cider-browse-ns--propertized-item key items))) - (insert " ") - (insert item-line) - (when cider-browse-ns-current-ns - (insert (make-string (+ (- max-length (string-width item-line)) 1) ?·)) - (insert " " (propertize first-doc-line 'font-lock-face 'font-lock-doc-face))) - (insert "\n"))) - (insert "\n"))) - -(defun cider-browse-ns--column-width (items) - "Determine the display width of displayed ITEMS." - (let* ((propertized-lines - (seq-map (lambda (key) - (cider-browse-ns--propertized-item key items)) - (nrepl-dict-keys items)))) - (if propertized-lines - (apply #'max (seq-map (lambda (entry) (string-width entry)) - propertized-lines)) - 0))) - -(defun cider-browse-ns--render-items (items) - "Render the nrepl-dict ITEMS to the browse-ns buffer." - (let* ((max-length (cider-browse-ns--column-width items))) - (cl-labels - ((keys-from-pred - (pred items) - (nrepl-dict-keys (nrepl-dict-filter (lambda (_ var-meta) - (funcall pred var-meta)) - items)))) - (cond - ((eql cider-browse-ns-group-by 'type) - (let* ((func-keys (keys-from-pred #'cider-browse-ns--meta-function-p items)) - (macro-keys (keys-from-pred #'cider-browse-ns--meta-macro-p items)) - (var-keys (keys-from-pred #'cider-browse-ns--meta-var-p items)) - (test-keys (keys-from-pred #'cider-browse-ns--meta-test-p items))) - (cider-browse-ns--display-list func-keys items max-length "Functions") - (cider-browse-ns--display-list macro-keys items max-length "Macros") - (cider-browse-ns--display-list var-keys items max-length "Vars") - (cider-browse-ns--display-list test-keys items max-length "Tests"))) - ((eql cider-browse-ns-group-by 'visibility) - (let* ((public-keys - (keys-from-pred - (lambda (var-meta) - (not (cider-browse-ns--meta-private-p var-meta))) - items)) - (private-keys (keys-from-pred #'cider-browse-ns--meta-private-p items))) - (cider-browse-ns--display-list public-keys items max-length "Public") - (cider-browse-ns--display-list private-keys items max-length "Private"))) - (t - (cider-browse-ns--display-list - (nrepl-dict-keys items) items max-length)))))) - -(defun cider-browse-ns--filter (flag) - "Toggle the filter indicated by FLAG and re-render the buffer." - (setq cider-browse-ns-filters - (if (memq flag cider-browse-ns-filters) - (remq flag cider-browse-ns-filters) - (cons flag cider-browse-ns-filters))) - (cider-browse-ns--render-buffer)) - -(defun cider-browse-ns--button-filter (button) - "Handle filter action for BUTTON." - (let ((flag (button-get button 'filter))) - (cider-browse-ns--filter flag))) - -(defun cider-browse-ns--group (flag) - "Set the group-by option to FLAG and re-renderthe buffer." - (setq cider-browse-ns-group-by - (if (eql flag cider-browse-ns-group-by) nil flag)) - (cider-browse-ns--render-buffer)) - -(defun cider-browse-ns--button-group (button) - "Handle grouping action for BUTTON." - (let ((flag (button-get button 'group-by))) - (cider-browse-ns--group flag))) - -(defun cider-browse-ns--toggle-all (_button) - "Toggle the display-all visibility setting." - (setq cider-browse-ns-show-all (not cider-browse-ns-show-all)) - (cider-browse-ns--render-buffer)) - -(defun cider-browse-ns--render-header (&optional filtered-items-ct) - "Render the section at the top of the buffer displaying visibility controls. - -If FILTERED-ITEMS-CT is non-nil, then display a message of how many items -are being filtered." - ;; Display Show line - (insert " Show: ") - (insert-text-button "All" - 'follow-link t - 'action #'cider-browse-ns--toggle-all - ;; 'help-echo (cider-stacktrace-tooltip) - 'face (if cider-browse-ns-show-all - 'cider-stacktrace-filter-active-face - nil)) - (insert "\n") - ;; Display Filters - (let ((filters '(("Private" private) - ("Test" test) - ("Macro" macro) - ("Function" function) - ("Var" var)))) - (insert " Hide: ") - (dolist (filter filters) - (seq-let (title key) filter - (let ((is-active (memq key cider-browse-ns-filters))) - (insert-text-button title - 'filter key - 'follow-link t - 'action #'cider-browse-ns--button-filter - ;; 'help-echo (cider-stacktrace-tooltip) - 'face (if (and is-active (not cider-browse-ns-show-all)) - 'cider-stacktrace-filter-active-face - nil)) - (insert " ")))) - (when filtered-items-ct - (insert (format "(%d items filtered)" filtered-items-ct)))) - (insert "\n") - ;; Groupings - (insert " Group-by: ") - (let ((groupings '(("Type" type) - ("Visibility" visibility)))) - (dolist (grouping groupings) - (seq-let (title key) grouping - (let ((is-active (eql key cider-browse-ns-group-by))) - (insert-text-button title - 'group-by key - 'follow-link t - 'action #'cider-browse-ns--button-group - ;; 'help-echo () - 'face (if is-active - 'cider-stacktrace-filter-active-face - nil))) - (insert " ")))) - (insert "\n\n")) - -(defun cider-browse-ns--render-buffer (&optional buffer) - "Render the sections of the browse-ns buffer. - -Render occurs in BUFFER if non-nil. This function is the main entrypoint -for redisplaying the buffer when filters change." - (with-current-buffer (or buffer (current-buffer)) - (let* ((inhibit-read-only t) - (point (point)) - (filtered-items (nrepl-dict-filter #'cider-browse-ns--item-filter - cider-browse-ns-items)) - (filtered-item-ct (- (length (nrepl-dict-keys cider-browse-ns-items)) - (length (nrepl-dict-keys filtered-items))))) - (erase-buffer) - (insert (propertize (cider-propertize cider-browse-ns-title 'ns) 'ns t) "\n") - (when cider-browse-ns-current-ns - (cider-browse-ns--render-header filtered-item-ct)) - (cider-browse-ns--render-items filtered-items) - (goto-char point)))) - -(defun cider-browse-ns--first-doc-line (doc) - "Return the first line of the given DOC string. -If the first line of the DOC string contains multiple sentences, only -the first sentence is returned. If the DOC string is nil, a Not documented -string is returned." - (if doc - (let* ((split-newline (split-string doc "\n")) - (first-line (car split-newline))) - (cond - ((string-match "\\. " first-line) (substring first-line 0 (match-end 0))) - ((= 1 (length split-newline)) first-line) - (t (concat first-line "...")))) - "Not documented.")) - -(defun cider-browse-ns--combined-vars-with-meta (namespace) - "Return the combined public and private vars in NAMESPACE. - -Private vars have the additional metadata \"private\": \"true\" in their -var-meta map." - (let ((items (cider-sync-request:ns-vars-with-meta namespace)) - (private-items (cider-sync-request:private-ns-vars-with-meta namespace))) - (when private-items - (dolist (key (nrepl-dict-keys private-items)) - (let ((var-meta (nrepl-dict-put (nrepl-dict-get private-items key) - "private" "true"))) - (setq items (nrepl-dict-put items key var-meta))))) - items)) - -;; Interactive Functions - -;;;###autoload -(defun cider-browse-ns (namespace) - "List all NAMESPACE's vars in BUFFER." - (interactive (list (completing-read "Browse namespace: " (cider-sync-request:ns-list)))) - (with-current-buffer (cider-popup-buffer cider-browse-ns-buffer 'select nil 'ancillary) - (cider-browse-ns--list (current-buffer) - namespace - (cider-browse-ns--combined-vars-with-meta namespace) - namespace))) - -;;;###autoload -(defun cider-browse-ns-all () - "List all loaded namespaces in BUFFER." - (interactive) - (with-current-buffer (cider-popup-buffer cider-browse-ns-buffer 'select nil 'ancillary) - (let ((names (cider-sync-request:ns-list))) - (cider-browse-ns--ns-list - (current-buffer) - "All loaded namespaces" - (mapcar (lambda (name) - (cider-browse-ns--properties name nil)) - names))))) - -(defun cider-browse-ns--thing-at-point () - "Get the thing at point. -Return a list of the type ('ns or 'var) and the value." - (let ((ns-p (get-text-property (point) 'ns)) - (line (car (split-string (string-trim (thing-at-point 'line)) " ")))) - (if (or ns-p (string-match "\\." line)) - `(ns ,line) - `(var ,(format "%s/%s" - (or (get-text-property (point) 'cider-browse-ns-current-ns) - cider-browse-ns-current-ns) - line))))) - -(defun cider-browse-ns-toggle-all () - "Toggle showing all of the items in the browse-ns buffer." - (interactive) - (cider-browse-ns--toggle-all nil)) - -(defun cider-browse-ns-toggle-hide-private () - "Toggle visibility of private items displayed in browse-ns buffer." - (interactive) - (cider-browse-ns--filter 'private)) - -(defun cider-browse-ns-toggle-hide-test () - "Toggle visibility of test items displayed in browse-ns buffer." - (interactive) - (cider-browse-ns--filter 'test)) - -(defun cider-browse-ns-toggle-hide-macro () - "Toggle visibility of macro items displayed in browse-ns buffer." - (interactive) - (cider-browse-ns--filter 'macro)) - -(defun cider-browse-ns-toggle-hide-function () - "Toggle visibility of function items displayed in browse-ns buffer." - (interactive) - (cider-browse-ns--filter 'function)) - -(defun cider-browse-ns-toggle-hide-var () - "Toggle visibility of var items displayed in browse-ns buffer." - (interactive) - (cider-browse-ns--filter 'var)) - -(defun cider-browse-ns-group-by-type () - "Toggle visibility of var items displayed in browse-ns buffer." - (interactive) - (cider-browse-ns--group 'type)) - -(defun cider-browse-ns-group-by-visibility () - "Toggle visibility of var items displayed in browse-ns buffer." - (interactive) - (cider-browse-ns--group 'visibility)) - - -(declare-function cider-doc-lookup "cider-doc") - -(defun cider-browse-ns-doc-at-point () - "Show the documentation for the thing at current point." - (interactive) - (let* ((thing (cider-browse-ns--thing-at-point)) - (value (cadr thing))) - ;; value is either some ns or a var - (cider-doc-lookup value))) - -(defun cider-browse-ns-operate-at-point () - "Expand browser according to thing at current point. -If the thing at point is a ns it will be browsed, -and if the thing at point is some var - its documentation will -be displayed." - (interactive) - (let* ((thing (cider-browse-ns--thing-at-point)) - (type (car thing)) - (value (cadr thing))) - (if (eq type 'ns) - (cider-browse-ns value) - (cider-doc-lookup value)))) - -(declare-function cider-find-ns "cider-find") -(declare-function cider-find-var "cider-find") - -(defun cider-browse-ns-find-at-point () - "Find the definition of the thing at point." - (interactive) - (let* ((thing (cider-browse-ns--thing-at-point)) - (type (car thing)) - (value (cadr thing))) - (if (eq type 'ns) - (cider-find-ns nil value) - (cider-find-var current-prefix-arg value)))) - -(defun cider-browse-ns-handle-mouse (_event) - "Handle mouse click EVENT." - (interactive "e") - (cider-browse-ns-operate-at-point)) - -(provide 'cider-browse-ns) - -;;; cider-browse-ns.el ends here diff --git a/elpa/cider-1.12.0/cider-browse-spec.el b/elpa/cider-1.12.0/cider-browse-spec.el @@ -1,455 +0,0 @@ -;;; cider-browse-spec.el --- CIDER spec browser -*- lexical-binding: t; -*- - -;; Copyright © 2017-2023 Juan Monetta, Bozhidar Batsov and CIDER contributors - -;; Author: Juan Monetta <jpmonettas@gmail.com> - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; M-x cider-browse-spec -;; -;; Display a spec description you can browse. -;; Pressing <enter> over a sub spec will take you to the description of that sub spec. -;; Pressing ^ takes you to the list of all specs. - -;; M-x cider-browse-spec-all -;; -;; Explore clojure.spec registry by browsing a list of all specs. -;; Pressing <enter> over a spec display the spec description you can browse. - -;;; Code: - -(require 'cider-client) -(require 'cider-popup) -(require 'cider-util) -(require 'cl-lib) -(require 'nrepl-dict) -(require 'seq) -(require 'subr-x) -(require 'help-mode) - -;; The buffer names used by the spec browser -(defconst cider-browse-spec-buffer "*cider-spec-browser*") -(defconst cider-browse-spec-example-buffer "*cider-spec-example*") - -;; Mode Definition - -(defvar cider-browse-spec-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map (make-composed-keymap button-buffer-map - cider-popup-buffer-mode-map)) - (define-key map (kbd "RET") #'cider-browse-spec--browse-at) - (define-key map "n" #'forward-button) - (define-key map "p" #'backward-button) - map) - "Keymap for `cider-browse-spec-mode'.") - -(define-derived-mode cider-browse-spec-mode special-mode "Specs" - "Major mode for browsing Clojure specs. - -\\{cider-browse-spec-mode-map}" - (setq-local electric-indent-chars nil) - (setq-local sesman-system 'CIDER) - (when cider-special-mode-truncate-lines - (setq-local truncate-lines t))) - -(defvar cider-browse-spec--current-spec nil) - -(defvar cider-browse-spec-view-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map help-mode-map) - (define-key map (kbd "RET") #'cider-browse-spec--browse-at) - (define-key map "^" #'cider-browse-spec-all) - (define-key map "e" #'cider-browse-spec--print-curr-spec-example) - (define-key map "n" #'forward-button) - (define-key map "p" #'backward-button) - map) - "Keymap for `cider-browse-spec-view-mode'.") - -(define-derived-mode cider-browse-spec-view-mode help-mode "Spec" - "Major mode for displaying CIDER spec. - -\\{cider-browse-spec-view-mode-map}" - (setq-local cider-browse-spec--current-spec nil) - (setq-local electric-indent-chars nil) - (setq-local sesman-system 'CIDER) - (when cider-special-mode-truncate-lines - (setq-local truncate-lines t))) - -(defvar cider-browse-spec-example-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map cider-popup-buffer-mode-map) - (define-key map "^" #'cider-browse-spec-all) - (define-key map "e" #'cider-browse-spec--print-curr-spec-example) - (define-key map "g" #'revert-buffer) - map) - "Keymap for `cider-browse-spec-example-mode'.") - -(define-derived-mode cider-browse-spec-example-mode special-mode "Example" - "Major mode for Clojure spec examples. - -\\{cider-browse-spec-example-mode-map}" - (setq-local electric-indent-chars nil) - (setq-local revert-buffer-function #'cider-browse-spec--example-revert-buffer-function) - (setq-local sesman-system 'CIDER) - (when cider-special-mode-truncate-lines - (setq-local truncate-lines t))) - -;; Non interactive functions - -(define-button-type 'cider-browse-spec--spec - 'action #'cider-browse-spec--browse-at - 'face nil - 'follow-link t - 'help-echo "View spec") - -(defun cider-browse-spec--draw-list-buffer (buffer title specs) - "Reset contents of BUFFER. -Display TITLE at the top and SPECS are indented underneath." - (with-current-buffer buffer - (cider-browse-spec-mode) - (let ((inhibit-read-only t)) - (erase-buffer) - (goto-char (point-max)) - (insert (cider-propertize title 'emph) "\n") - (dolist (spec-name specs) - (insert (propertize " " 'spec-name spec-name)) - (thread-first - (cider-font-lock-as-clojure spec-name) - (insert-text-button 'type 'cider-browse-spec--spec) - (button-put 'spec-name spec-name)) - (insert (propertize "\n" 'spec-name spec-name))) - (goto-char (point-min))))) - -(defun cider--qualified-keyword-p (str) - "Return non nil if STR is a namespaced keyword." - (string-match-p "^:.+/.+$" str)) - -(defun cider--spec-fn-p (value fn-name) - "Return non nil if VALUE is clojure.spec.[alpha]/FN-NAME." - (string-match-p (concat "^\\(clojure.spec\\|clojure.spec.alpha\\|clojure.alpha.spec\\)/" fn-name "$") value)) - -(defun cider-browse-spec--render-schema-map (spec-form) - "Render the s/schema map declaration SPEC-FORM." - (let ((name-spec-pairs (seq-partition (cdaadr spec-form) 2))) - (format "(s/schema\n {%s})" - (string-join - (thread-last - (seq-sort-by #'car #'string< name-spec-pairs) - (mapcar (lambda (s) (concat (cl-first s) " " (cider-browse-spec--pprint (cl-second s)))))) - "\n ")))) - -(defun cider-browse-spec--render-schema-vector (spec-form) - "Render the s/schema vector declaration SPEC-FORM." - (format "(s/schema\n [%s])" - (string-join - (thread-last - (cl-second spec-form) - (mapcar (lambda (s) (cider-browse-spec--pprint s)))) - "\n "))) - -(defun cider-browse-spec--render-schema (spec-form) - "Render the s/schema SPEC-FORM." - (let ((schema-args (cl-second spec-form))) - (if (and (listp schema-args) - (nrepl-dict-p (cl-first schema-args))) - (cider-browse-spec--render-schema-map spec-form) - (cider-browse-spec--render-schema-vector spec-form)))) - -(defun cider-browse-spec--render-select (spec-form) - "Render the s/select SPEC-FORM." - (let ((keyset (cl-second spec-form)) - (selection (cl-third spec-form))) - (format "(s/select\n %s\n [%s])" - (cider-browse-spec--pprint keyset) - (string-join - (thread-last - selection - (mapcar (lambda (s) (cider-browse-spec--pprint s)))) - "\n ")))) - -(defun cider-browse-spec--render-union (spec-form) - "Render the s/union SPEC-FORM." - (let ((keyset (cl-second spec-form)) - (selection (cl-third spec-form))) - (format "(s/union\n %s\n [%s])" - (cider-browse-spec--pprint keyset) - (string-join - (thread-last - selection - (mapcar (lambda (s) (cider-browse-spec--pprint s)))) - "\n ")))) - -(defun cider-browse-spec--render-vector (spec-form) - "Render SPEC-FORM as a vector." - (format "[%s]" (string-join (mapcar #'cider-browse-spec--pprint spec-form)))) - -(defun cider-browse-spec--render-map-entry (spec-form) - "Render SPEC-FORM as a map entry." - (let ((key (cl-first spec-form)) - (value (cl-second spec-form))) - (format "%s %s" (cider-browse-spec--pprint key) - (if (listp value) - (cider-browse-spec--render-vector value) - (cider-browse-spec--pprint value))))) - -(defun cider-browse-spec--render-map (spec-form) - "Render SPEC-FORM as a map." - (let ((map-entries (cl-rest spec-form))) - (format "{%s}" (thread-last - (seq-partition map-entries 2) - (seq-map #'cider-browse-spec--render-map-entry) - (string-join))))) - -(defun cider-browse-spec--pprint (form) - "Given a spec FORM builds a multi line string with a pretty render of that FORM." - (cond ((stringp form) - (if (cider--qualified-keyword-p form) - (with-temp-buffer - (thread-first - form - (insert-text-button 'type 'cider-browse-spec--spec) - (button-put 'spec-name form)) - (buffer-string)) - ;; to make it easier to read replace all clojure.spec ns with s/ - ;; and remove all clojure.core ns - (thread-last - form - (replace-regexp-in-string "^\\(clojure.spec\\|clojure.spec.alpha\\|clojure.alpha.spec\\)/" "s/") - (replace-regexp-in-string "^\\(clojure.core\\)/" "")))) - - ((and (listp form) (stringp (cl-first form))) - (let ((form-tag (cl-first form))) - (cond - ;; prettier fns #() - ((string-equal form-tag "clojure.core/fn") - (if (equal (cl-second form) '("%")) - (format "#%s" (cl-reduce #'concat (mapcar #'cider-browse-spec--pprint (cl-rest (cl-rest form))))) - (format "(fn [%%] %s)" (cl-reduce #'concat (mapcar #'cider-browse-spec--pprint (cl-rest (cl-rest form))))))) - ;; prettier (s/and ) - ((cider--spec-fn-p form-tag "and") - (format "(s/and\n%s)" (string-join (thread-last - (cl-rest form) - (mapcar #'cider-browse-spec--pprint) - (mapcar (lambda (x) (format "%s" x)))) - "\n"))) - ;; prettier (s/or ) - ((cider--spec-fn-p form-tag "or") - (let ((name-spec-pair (seq-partition (cl-rest form) 2))) - (format "(s/or\n%s)" (string-join - (thread-last - name-spec-pair - (mapcar (lambda (s) (format "%s %s" (cl-first s) (cider-browse-spec--pprint (cl-second s)))))) - "\n")))) - ;; prettier (s/merge ) - ((cider--spec-fn-p form-tag "merge") - (format "(s/merge\n%s)" (string-join (thread-last - (cl-rest form) - (mapcar #'cider-browse-spec--pprint) - (mapcar (lambda (x) (format "%s" x)))) - "\n"))) - ;; prettier (s/keys ) - ((cider--spec-fn-p form-tag "keys") - (let ((keys-args (seq-partition (cl-rest form) 2))) - (format "(s/keys%s)" (thread-last - keys-args - (mapcar (lambda (s) - (let ((key-type (cl-first s)) - (specs-vec (cl-second s))) - (concat "\n" key-type - " [" - (string-join (thread-last - specs-vec - (mapcar #'cider-browse-spec--pprint) - (mapcar (lambda (x) (format "%s" x)))) - "\n") - "]")))) - (cl-reduce #'concat))))) - ;; prettier (s/multi-spec) - ((cider--spec-fn-p form-tag "multi-spec") - (let ((multi-method (cl-second form)) - (retag (cl-third form)) - (sub-specs (cl-rest (cl-rest (cl-rest form))))) - (format "(s/multi-spec %s %s\n%s)" - multi-method - retag - (string-join - (thread-last - sub-specs - (mapcar (lambda (s) - (concat "\n\n" (cl-first s) " " (cider-browse-spec--pprint (cl-second s)))))) - "\n")))) - ;; prettier (s/cat ) - ((cider--spec-fn-p form-tag "cat") - (let ((name-spec-pairs (seq-partition (cl-rest form) 2))) - (format "(s/cat %s)" - (thread-last - name-spec-pairs - (mapcar (lambda (s) - (concat "\n" (cl-first s) " " (cider-browse-spec--pprint (cl-second s))))) - (cl-reduce #'concat))))) - ;; prettier (s/alt ) - ((cider--spec-fn-p form-tag "alt") - (let ((name-spec-pairs (seq-partition (cl-rest form) 2))) - (format "(s/alt %s)" - (thread-last - name-spec-pairs - (mapcar (lambda (s) - (concat "\n" (cl-first s) " " (cider-browse-spec--pprint (cl-second s))))) - (cl-reduce #'concat))))) - ;; prettier (s/fspec ) - ((cider--spec-fn-p form-tag "fspec") - (thread-last - (seq-partition (cl-rest form) 2) - (cl-remove-if (lambda (s) (and (stringp (cl-second s)) - (string-empty-p (cl-second s))))) - (mapcar (lambda (s) - (format "\n%-11s: %s" (pcase (cl-first s) - (":args" "arguments") - (":ret" "returns") - (":fn" "invariants")) - (cider-browse-spec--pprint (cl-second s))))) - (cl-reduce #'concat) - (format "%s"))) - ;; prettier (s/schema ) - ((cider--spec-fn-p form-tag "schema") - (cider-browse-spec--render-schema form)) - ;; prettier (s/select ) - ((cider--spec-fn-p form-tag "select") - (cider-browse-spec--render-select form)) - ;; prettier (s/union ) - ((cider--spec-fn-p form-tag "union") - (cider-browse-spec--render-union form)) - ;; every other with no special management - (t (format "(%s %s)" - (cider-browse-spec--pprint form-tag) - (string-join (mapcar #'cider-browse-spec--pprint (cl-rest form)) " ")))))) - ((nrepl-dict-p form) - (cider-browse-spec--render-map form)) - (t (format "%s" form)))) - -(defun cider-browse-spec--pprint-indented (spec-form) - "Indent (pretty-print) and font-lock SPEC-FORM. -Return the result as a string." - (with-temp-buffer - (clojure-mode) - (insert (cider-browse-spec--pprint spec-form)) - (indent-region (point-min) (point-max)) - (font-lock-ensure) - (buffer-string))) - -(defun cider-browse-spec--draw-spec-buffer (buffer spec spec-form) - "Reset contents of BUFFER and draws everything needed to browse the SPEC-FORM. -Display SPEC as a title and uses `cider-browse-spec--pprint' to display -a more user friendly representation of SPEC-FORM." - (with-current-buffer buffer - (let ((inhibit-read-only t)) - (cider--help-setup-xref (list #'cider-browse-spec spec) nil buffer) - (goto-char (point-max)) - (insert (cider-font-lock-as-clojure spec) "\n\n") - (insert (cider-browse-spec--pprint-indented spec-form)) - (cider--make-back-forward-xrefs) - (current-buffer)))) - -(defun cider-browse-spec--browse (spec) - "Browse SPEC." - (cider-ensure-connected) - (cider-ensure-op-supported "spec-form") - ;; Expand auto-resolved keywords - (when-let* ((val (and (string-match-p "^::.+" spec) - (nrepl-dict-get (cider-sync-tooling-eval spec (cider-current-ns)) "value")))) - (setq spec val)) - (with-current-buffer (cider-popup-buffer cider-browse-spec-buffer 'select #'cider-browse-spec-view-mode 'ancillary) - (setq-local cider-browse-spec--current-spec spec) - (cider-browse-spec--draw-spec-buffer (current-buffer) - spec - (cider-sync-request:spec-form spec)) - (goto-char (point-min)) - (current-buffer))) - -(defun cider-browse-spec--browse-at (&optional pos) - "View the definition of a spec. - -Optional argument POS is the position of a spec, defaulting to point. POS -may also be a button, so this function can be used a the button's `action' -property." - (interactive) - (let ((pos (or pos (point)))) - (when-let* ((spec (button-get pos 'spec-name))) - (cider-browse-spec--browse spec)))) - -;; Interactive Functions - -(defun cider-browse-spec--print-curr-spec-example () - "Generate and print an example of the current spec." - (interactive) - (cider-ensure-connected) - (cider-ensure-op-supported "spec-example") - (if-let* ((spec cider-browse-spec--current-spec)) - (if-let* ((example (cider-sync-request:spec-example spec))) - (with-current-buffer (cider-popup-buffer cider-browse-spec-example-buffer 'select #'cider-browse-spec-example-mode 'ancillary) - (setq-local cider-browse-spec--current-spec spec) - (let ((inhibit-read-only t)) - (insert "Example of " (cider-font-lock-as-clojure spec)) - (insert "\n\n") - (insert (cider-font-lock-as-clojure example)) - (goto-char (point-min)))) - (error (format "No example for spec %s" spec))) - (error "No current spec"))) - -(defun cider-browse-spec--example-revert-buffer-function (&rest _) - "`revert-buffer' function for `cider-browse-spec-example-mode'. - -Generates a new example for the current spec." - (cider-browse-spec--print-curr-spec-example)) - -;;;###autoload -(defun cider-browse-spec (spec) - "Browse SPEC definition." - (interactive (list (completing-read "Browse spec: " - (cider-sync-request:spec-list) - nil nil - (cider-symbol-at-point)))) - (cider-browse-spec--browse spec)) - -(defun cider-browse-spec-regex (regex) - "Open the list of specs that matches REGEX in a popup buffer. -Displays all specs when REGEX is nil." - (cider-ensure-connected) - (cider-ensure-op-supported "spec-list") - (let ((filter-regex (or regex ""))) - (with-current-buffer (cider-popup-buffer cider-browse-spec-buffer 'select nil 'ancillary) - (let ((specs (cider-sync-request:spec-list filter-regex))) - (cider-browse-spec--draw-list-buffer (current-buffer) - (if (string-empty-p filter-regex) - "All specs in registry" - (format "All specs matching regex `%s' in registry" filter-regex)) - specs))))) - -;;;###autoload -(defun cider-browse-spec-all (&optional arg) - "Open list of specs in a popup buffer. - -With a prefix argument ARG, prompts for a regexp to filter specs. -No filter applied if the regexp is the empty string." - (interactive "P") - (cider-browse-spec-regex (if arg (read-string "Filter regex: ") ""))) - -(provide 'cider-browse-spec) - -;;; cider-browse-spec.el ends here diff --git a/elpa/cider-1.12.0/cider-cheatsheet.el b/elpa/cider-1.12.0/cider-cheatsheet.el @@ -1,577 +0,0 @@ -;;; cider-cheatsheet.el --- Quick reference for Clojure -*- lexical-binding: t -*- - -;; Copyright © 2019-2023 Kris Jenkins, Bozhidar Batsov and CIDER contributors -;; -;; Author: Kris Jenkins <krisajenkins@gmail.com> - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; A quick reference system for Clojure. Fast, searchable & available offline. - -;; Mostly taken from Kris Jenkins' `clojure-cheatsheet' -;; See: https://github.com/clojure-emacs/clojure-cheatsheet - -;;; Code: - -(require 'cider-doc) -(require 'seq) - -(defconst cider-cheatsheet-hierarchy - '(("Primitives" - ("Numbers" - ("Arithmetic" - (clojure.core + - * / quot rem mod dec inc max min)) - ("Compare" - (clojure.core = == not= < > <= >= compare)) - ("Bitwise" - (clojure.core bit-and bit-and-not bit-clear bit-flip bit-not bit-or bit-set bit-shift-left bit-shift-right bit-test bit-xor unsigned-bit-shift-right)) - ("Cast" - (clojure.core byte short long int float double bigdec bigint biginteger num rationalize)) - ("Test" - (clojure.core nil? some? identical? zero? pos? neg? even? odd?)) - ("Random" - (clojure.core rand rand-int)) - ("BigDecimal" - (clojure.core with-precision)) - ("Ratios" - (clojure.core numerator denominator ratio?)) - ("Arbitrary Precision Arithmetic" - (clojure.core +\' -\' *\' inc\' dec\')) - ("Unchecked" - (clojure.core *unchecked-math* - unchecked-add - unchecked-add-int - unchecked-byte - unchecked-char - unchecked-dec - unchecked-dec-int - unchecked-divide-int - unchecked-double - unchecked-float - unchecked-inc - unchecked-inc-int - unchecked-int - unchecked-long - unchecked-multiply - unchecked-multiply-int - unchecked-negate - unchecked-negate-int - unchecked-remainder-int - unchecked-short - unchecked-subtract - unchecked-subtract-int))) - - ("Strings" - ("Create" - (clojure.core str format)) - ("Use" - (clojure.core count get subs compare) - (clojure.string join escape split split-lines replace replace-first reverse re-quote-replacement index-of last-index-of starts-with? ends-with? includes?)) - ("Regex" - (clojure.core re-find re-seq re-matches re-pattern re-matcher re-groups) - (clojure.string replace replace-first re-quote-replacement)) - ("Letters" - (clojure.string capitalize lower-case upper-case)) - ("Trim" - (clojure.string trim trim-newline triml trimr)) - ("Test" - (clojure.core char char? string?) - (clojure.string blank?))) - - ("Other" - ("Characters" - (clojure.core char char-name-string char-escape-string)) - ("Keywords" - (clojure.core keyword keyword? find-keyword)) - ("Symbols" - (clojure.core symbol symbol? gensym)) - ("Data Readers" - (clojure.core *data-readers* default-data-readers *default-data-reader-fn*)))) - - ("Collections" - ("Generic Ops" - (clojure.core count bounded-count empty not-empty into conj)) - ("Tree Walking" - (clojure.walk walk prewalk prewalk-demo prewalk-replace postwalk postwalk-demo postwalk-replace keywordize-keys stringify-keys)) - ("Content tests" - (clojure.core distinct? empty? every? not-every? some not-any?)) - ("Capabilities" - (clojure.core sequential? associative? sorted? counted? reversible?)) - ("Type tests" - (clojure.core type class coll? list? vector? set? map? seq? - number? integer? float? decimal? class? rational? ratio? - chunked-seq? reduced? special-symbol? record?)) - ("Lists" - ("Create" - (clojure.core list list*)) - ("Examine" - (clojure.core first nth peek)) - ("Change" - (clojure.core cons conj rest pop))) - - ("Vectors" - ("Create" - (clojure.core vec vector vector-of)) - ("Examine" - (clojure.core get peek)) - - ("Change" - (clojure.core assoc pop subvec replace conj rseq)) - ("Ops" - (clojure.core mapv filterv reduce-kv))) - - ("Sets" - ("Create" - (clojure.core set hash-set sorted-set sorted-set-by)) - ("Examine" - (clojure.core get contains?)) - ("Change" - (clojure.core conj disj)) - ("Relational Algebra" - (clojure.set join select project union difference intersection)) - ("Get map" - (clojure.set index rename-keys rename map-invert)) - ("Test" - (clojure.set subset? superset?)) - ("Sorted Sets" - (clojure.core rseq subseq rsubseq))) - - ("Maps" - ("Create" - (clojure.core hash-map array-map zipmap sorted-map sorted-map-by bean frequencies group-by)) - ("Examine" - (clojure.core get get-in contains? find keys vals map-entry?)) - ("Change" - (clojure.core assoc assoc-in dissoc merge merge-with select-keys update update-in)) - ("Entry" - (clojure.core key val)) - ("Sorted Maps" - (clojure.core rseq subseq rsubseq))) - - ("Hashes" - (clojure.core hash hash-ordered-coll hash-unordered-coll mix-collection-hash)) - - ("Volatiles" - (clojure.core volatile! volatile? vreset! vswap!))) - - ("Functions" - ("Create" - (clojure.core fn defn defn- definline identity constantly comp complement partial juxt memfn memoize fnil every-pred some-fn trampoline)) - ("Call" - (clojure.core -> ->> some-> some->> as-> cond-> cond->>)) - ("Test" - (clojure.core fn? ifn?))) - - ("Transducers" - ("Create" - (clojure.core cat dedupe distinct drop drop-while filter halt-when interpose keep keep-indexed map map-indexed mapcat partition-all partition-by random-sample remove replace take take-nth take-while)) - ("Call" - (clojure.core ->Eduction eduction into sequence transduce completing run!)) - ("Early Termination" - (clojure.core deref reduced reduced? ensure-reduced unreduced))) - - ("Spec" - ("Operations" - (clojure.spec.alpha valid? conform unform explain explain-data explain-str explain-out form describe assert check-asserts check-asserts?)) - ("Generator Ops" - (clojure.spec.alpha gen exercise exercise-fn)) - ("Defn & Registry" - (clojure.spec.alpha def fdef registry get-spec spec? spec with-gen)) - ("Logical" - (clojure.spec.alpha and or)) - ("Collection" - (clojure.spec.alpha coll-of map-of every every-kv keys merge)) - ("Regex " - (clojure.spec.alpha cat alt * + \? & keys*)) - ("Range" - (clojure.spec.alpha int-in inst-in double-in int-in-range? inst-in-range?)) - ("Custom Explain" - (clojure.spec.alpha explain-printer *explain-out*)) - ("Other" - (clojure.spec.alpha nilable multi-spec fspec conformer)) - - ("Predicates with test.check generators" - ("Numbers" - (clojure.core number? rational? integer? ratio? decimal? float? zero? double? int? nat-int? neg-int? pos-int?)) - ("Symbols & Keywords" - (clojure.core keyword? symbol? ident? qualified-ident? qualified-keyword? qualified-symbol? simple-ident? simple-keyword? simple-symbol?)) - ("Scalars" - (clojure.core string? true? false? nil? some? boolean? bytes? inst? uri? uuid?)) - ("Collections" - (clojure.core list? map? set? vector? associative? coll? sequential? seq? empty? indexed? seqable?)) - ("Other" - (clojure.core any?)))) - - ("Other" - ("XML" - (clojure.core xml-seq) - (clojure.xml parse)) - ("REPL" - (clojure.core *1 *2 *3 *e *print-dup* *print-length* *print-level* *print-meta* *print-readably*)) - ("EDN" - (clojure.edn read read-string)) - ("Compiling Code & Class Generation" - (clojure.core *compile-files* *compile-path* *file* *warn-on-reflection* compile gen-class gen-interface loaded-libs test)) - ("Misc" - (clojure.core eval force name *clojure-version* clojure-version *command-line-args*)) - ("Pretty Printing" - (clojure.pprint pprint print-table pp *print-right-margin*)) - ("Browser / Shell" - (clojure.java.browse browse-url) - (clojure.java.shell sh with-sh-dir with-sh-env))) - - ("Vars & Global Environment" - ("Def Variants" - (:special def) - (clojure.core defn defn- definline defmacro defmethod defmulti defonce defrecord)) - ("Interned Vars" - (:special var) - (clojure.core declare intern binding find-var)) - ("Var Objects" - (clojure.core with-local-vars var-get var-set alter-var-root var?)) - ("Var Validators" - (clojure.core set-validator! get-validator))) - - ("Reader Conditionals" - (clojure.core reader-conditional reader-conditional? tagged-literal tagged-literal?)) - - ("Abstractions" - ("Protocols" - (clojure.core defprotocol extend extend-type extend-protocol reify extends? satisfies? extenders)) - ("Records & Types" - (clojure.core defrecord deftype)) - ("Multimethods" - ("Define" - (clojure.core defmulti defmethod)) - ("Dispatch" - (clojure.core get-method methods)) - ("Remove" - (clojure.core remove-method remove-all-methods)) - ("Prefer" - (clojure.core prefer-method prefers)) - ("Relation" - (clojure.core derive isa? parents ancestors descendants make-hierarchy)))) - - ("Macros" - ("Create" - (clojure.core defmacro definline)) - ("Debug" - (clojure.core macroexpand-1 macroexpand) - (clojure.walk macroexpand-all)) - ("Branch" - (clojure.core and or when when-not when-let when-first if-not if-let cond condp case)) - ("Loop" - (clojure.core for doseq dotimes while)) - ("Arrange" - (clojure.core .. doto ->)) - ("Scope" - (clojure.core binding locking time) - (clojure.core with-in-str with-local-vars with-open with-out-str with-precision with-redefs with-redefs-fn)) - ("Lazy" - (clojure.core lazy-cat lazy-seq delay delay?)) - ("Doc" - (clojure.core assert comment) - (clojure.repl doc dir dir-fn source-fn))) - - ("Java Interop" - ("General" - (:special new set!) - (clojure.core .. doto bean comparator enumeration-seq import iterator-seq memfn definterface supers bases)) - ("Cast" - (clojure.core boolean byte short char int long float double bigdec bigint num cast biginteger)) - ("Exceptions" - (:special throw try catch finally) - (clojure.core ex-info ex-data Throwable->map StackTraceElement->vec) - (clojure.repl pst)) - ("Arrays" - ("Create" - (clojure.core boolean-array byte-array double-array char-array float-array int-array long-array make-array object-array short-array to-array)) - ("Manipulate" - (clojure.core aclone aget aset alength amap areduce aset-int aset-long aset-short aset-boolean aset-byte aset-char aset-double aset-float)) - ("Cast" - (clojure.core booleans bytes chars doubles floats ints longs shorts))) - ("Proxy" - ("Create" - (clojure.core proxy get-proxy-class construct-proxy init-proxy)) - ("Misc" - (clojure.core proxy-mappings proxy-super update-proxy)))) - - ("Namespaces" - ("Current" - (clojure.core *ns*)) - ("Create Switch" - (clojure.core ns in-ns create-ns)) - ("Add" - (clojure.core alias import intern refer refer-clojure)) - ("Find" - (clojure.core all-ns find-ns)) - ("Examine" - (clojure.core ns-aliases ns-imports ns-interns ns-map ns-name ns-publics ns-refers)) - ("From symbol" - (clojure.core resolve namespace ns-resolve the-ns)) - ("Remove" - (clojure.core ns-unalias ns-unmap remove-ns))) - ("Loading" - ("Load libs" - (clojure.core require use import refer)) - ("List Loaded" - (clojure.core loaded-libs)) - ("Load Misc" - (clojure.core load load-file load-reader load-string))) - - ("Concurrency" - ("Atoms" - (clojure.core atom swap! swap-vals! reset! reset-vals! compare-and-set!)) - ("Futures" - (clojure.core future future-call future-cancel future-cancelled? future-done? future?)) - ("Threads" - (clojure.core bound-fn bound-fn* get-thread-bindings pop-thread-bindings push-thread-bindings)) - - ("Misc" - (clojure.core locking pcalls pvalues pmap seque promise deliver)) - - ("Refs & Transactions" - ("Create" - (clojure.core ref)) - ("Examine" - (clojure.core deref)) - ("Transaction" - (clojure.core sync dosync io!)) - ("In Transaction" - (clojure.core ensure ref-set alter commute)) - ("Validators" - (clojure.core get-validator set-validator!)) - ("History" - (clojure.core ref-history-count ref-max-history ref-min-history))) - - ("Agents & Asynchronous Actions" - ("Create" - (clojure.core agent)) - ("Examine" - (clojure.core agent-error)) - ("Change State" - (clojure.core send send-off restart-agent send-via set-agent-send-executor! set-agent-send-off-executor!)) - ("Block Waiting" - (clojure.core await await-for)) - ("Ref Validators" - (clojure.core get-validator set-validator!)) - ("Watchers" - (clojure.core add-watch remove-watch)) - ("Thread Handling" - (clojure.core shutdown-agents)) - ("Error" - (clojure.core error-handler set-error-handler! error-mode set-error-mode!)) - ("Misc" - (clojure.core *agent* release-pending-sends)))) - - ("Sequences" - ("Creating a Lazy Seq" - ("From Collection" - (clojure.core seq sequence keys vals rseq subseq rsubseq)) - ("From Producer Fn" - (clojure.core lazy-seq repeatedly iterate)) - ("From Constant" - (clojure.core repeat range)) - ("From Other" - (clojure.core file-seq line-seq resultset-seq re-seq tree-seq xml-seq iterator-seq enumeration-seq)) - ("From Seq" - (clojure.core keep keep-indexed))) - - ("Seq in, Seq out" - ("Get shorter" - (clojure.core distinct dedupe filter remove for)) - ("Get longer" - (clojure.core cons conj concat lazy-cat mapcat cycle interleave interpose))) - ("Tail-items" - (clojure.core rest nthrest fnext nnext drop drop-while take-last for)) - ("Head-items" - (clojure.core take take-nth take-while butlast drop-last for)) - ("Change" - (clojure.core conj concat distinct flatten group-by partition partition-all partition-by split-at split-with filter remove replace shuffle random-sample)) - ("Rearrange" - (clojure.core reverse sort sort-by compare)) - ("Process items" - (clojure.core map pmap map-indexed mapcat for replace seque)) - - ("Using a Seq" - ("Extract item" - (clojure.core first second last rest next ffirst nfirst fnext nnext nth nthnext rand-nth when-first max-key min-key)) - ("Construct coll" - (clojure.core zipmap into reduce reductions set vec into-array to-array-2d)) - ("Pass to fn" - (clojure.core apply)) - ("Search" - (clojure.core some filter)) - ("Force evaluation" - (clojure.core doseq dorun doall)) - ("Check for forced" - (clojure.core realized?)))) - - ("Zippers" - ("Create" - (clojure.zip zipper seq-zip vector-zip xml-zip)) - ("Get loc" - (clojure.zip up down left right leftmost rightmost)) - ("Get seq" - (clojure.zip lefts rights path children)) - ("Change" - (clojure.zip make-node replace edit insert-child insert-left insert-right append-child remove)) - ("Move" - (clojure.zip next prev)) - ("XML" - (clojure.data.zip.xml attr attr= seq-test tag= text text= xml-> xml1->)) - ("Misc" - (clojure.zip root node branch? end?))) - - ("Documentation" - ("REPL" - (clojure.repl doc find-doc apropos source pst) - (clojure.java.javadoc javadoc))) - - ("Transients" - ("Create" - (clojure.core transient persistent!)) - ("Change" - (clojure.core conj! pop! assoc! dissoc! disj!))) - ("Misc" - ("Compare" - (clojure.core = == identical? not= not compare) - (clojure.data diff)) - ("Test" - (clojure.core true? false? nil? instance?))) - - ("IO" - ("To/from ..." - (clojure.core spit slurp)) - ("To *out*" - (clojure.core pr prn print printf println newline) - (clojure.pprint print-table)) - ("To writer" - (clojure.pprint pprint cl-format)) - ("To string" - (clojure.core format with-out-str pr-str prn-str print-str println-str)) - ("From *in*" - (clojure.core read-line read)) - ("From reader" - (clojure.core line-seq read)) - ("From string" - (clojure.core read-string with-in-str)) - ("Open" - (clojure.core with-open) - (clojure.java.io reader writer input-stream output-stream)) - ("Interop" - (clojure.java.io make-writer make-reader make-output-stream make-input-stream)) - ("Misc" - (clojure.core flush file-seq *in* *out* *err*) - (clojure.java.io file copy delete-file resource as-file as-url as-relative-path make-parents))) - - ("Metadata" - (clojure.core meta with-meta alter-meta! reset-meta! vary-meta)) - - ("Special Forms" - (:special def if do quote var recur throw try monitor-enter monitor-exit) - (clojure.core fn loop) - ("Binding / Destructuring" - (clojure.core let fn letfn defn defmacro loop for doseq if-let if-some when-let when-some))) - - ("Async" - ("Main" - (clojure.core.async go go-loop <! <!! >! >!! chan put! take take! close! timeout offer! poll! promise-chan)) - ("Choice" - (clojure.core.async alt! alt!! alts! alts!! do-alts)) - ("Buffering" - (clojure.core.async buffer dropping-buffer sliding-buffer unblocking-buffer?)) - ("Pipelines" - (clojure.core.async pipeline pipeline-async pipeline-blocking)) - ("Threading" - (clojure.core.async thread thread-call)) - ("Mixing" - (clojure.core.async admix solo-mode mix unmix unmix-all toggle merge pipe unique)) - ("Multiples" - (clojure.core.async mult tap untap untap-all)) - ("Publish/Subscribe" - (clojure.core.async pub sub unsub unsub-all)) - ("Higher Order" - (clojure.core.async filter< filter> map map< map> mapcat< mapcat> partition partition-by reduce remove< remove> split)) - ("Pre-Populate" - (clojure.core.async into onto-chan to-chan))) - ("Unit Tests" - ("Defining" - (clojure.test deftest deftest- testing is are)) - ("Running" - (clojure.test run-tests run-all-tests test-vars)) - ("Fixtures" - (clojure.test use-fixtures join-fixtures compose-fixtures)))) - "A data structure for Clojure cheatsheet information. - -It's a tree, where the head of each list determines the context of the rest -of the list. The head may be: - - - A string, in which case it's a (sub)heading for the rest of the items. - - - A symbol, in which case it's the Clojure namespace of the symbols that - follow it. - - - The keyword :special, in which case it's a Clojure special form - - - Any other keyword, in which case it's a typed item that will be passed - through. - -Note that some Clojure symbols appear in more than once. This is entirely -intentional. For instance, `map` belongs in the sections on collections -and transducers.") - -(defun cider-cheatsheet--expand-vars (list) - "Expand the symbols in LIST to fully-qualified var names. - -This list is supposed to have the following format: - - (my-ns var1 var2 var3)" - (let ((ns (car list)) - (vars (cdr list))) - (if (eq ns :special) - (mapcar #'symbol-name vars) - (mapcar (lambda (var) (format "%s/%s" ns var)) vars)))) - -(defun cider-cheatsheet--select-var (var-list) - "Expand the symbols in VAR-LIST to fully-qualified var names. - -The list can hold one or more lists inside - one per each namespace." - (let ((namespaced-vars (seq-mapcat #'cider-cheatsheet--expand-vars - (seq-remove (lambda (list) - (eq (car list) :url)) - var-list)))) - (cider-doc-lookup (completing-read "Select var: " namespaced-vars)))) - -;;;###autoload -(defun cider-cheatsheet () - "Navigate `cider-cheatsheet-hierarchy' with `completing-read'. - -When you make it to a Clojure var its doc buffer gets displayed." - (interactive) - (let ((cheatsheet-data cider-cheatsheet-hierarchy)) - (while (stringp (caar cheatsheet-data)) - (let* ((sections (mapcar #'car cheatsheet-data)) - (sel-section (completing-read "Select cheatsheet section: " sections)) - (section-data (seq-find (lambda (elem) (equal (car elem) sel-section)) cheatsheet-data))) - (setq cheatsheet-data (cdr section-data)))) - (cider-cheatsheet--select-var cheatsheet-data))) - -(provide 'cider-cheatsheet) - -;;; cider-cheatsheet.el ends here diff --git a/elpa/cider-1.12.0/cider-classpath.el b/elpa/cider-1.12.0/cider-classpath.el @@ -1,109 +0,0 @@ -;;; cider-classpath.el --- Basic Java classpath browser -*- lexical-binding: t; -*- - -;; Copyright © 2014-2023 Bozhidar Batsov and CIDER contributors - -;; 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/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Basic Java classpath browser for CIDER. - -;;; Code: - -(require 'cider-client) -(require 'cider-popup) -(require 'subr-x) - -(defvar cider-classpath-buffer "*cider-classpath*") - -(defvar cider-classpath-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map cider-popup-buffer-mode-map) - (define-key map (kbd "RET") #'cider-classpath-operate-on-point) - (define-key map "n" #'next-line) - (define-key map "p" #'previous-line) - map)) - -(defvar cider-classpath-mouse-map - (let ((map (make-sparse-keymap))) - (define-key map [mouse-1] #'cider-classpath-handle-mouse) - map)) - -(define-derived-mode cider-classpath-mode special-mode "classpath" - "Major mode for browsing the entries in Java's classpath. - -\\{cider-classpath-mode-map}" - (setq-local electric-indent-chars nil) - (setq-local sesman-system 'CIDER) - (when cider-special-mode-truncate-lines - (setq-local truncate-lines t))) - -(defun cider-classpath-list (buffer items) - "Populate BUFFER with ITEMS." - (with-current-buffer buffer - (cider-classpath-mode) - (let ((inhibit-read-only t)) - (erase-buffer) - (dolist (item items) - (insert item "\n")) - (goto-char (point-min))))) - -(defun cider-classpath-properties (text) - "Decorate TEXT with a clickable keymap and function face." - (let ((face (cond - ((not (file-exists-p text)) 'font-lock-warning-face) - ((file-directory-p text) 'dired-directory) - (t 'default)))) - (propertize text - 'font-lock-face face - 'mouse-face 'highlight - 'keymap cider-classpath-mouse-map))) - -(defun cider-classpath-operate-on-point () - "Expand browser according to thing at current point." - (interactive) - (let* ((bol (line-beginning-position)) - (eol (line-end-position)) - (line (buffer-substring-no-properties bol eol))) - (find-file-other-window line))) - -(defun cider-classpath-handle-mouse (_event) - "Handle mouse click EVENT." - (interactive "e") - (cider-classpath-operate-on-point)) - -;;;###autoload -(defun cider-classpath () - "List all classpath entries." - (interactive) - (cider-ensure-connected) - (with-current-buffer (cider-popup-buffer cider-classpath-buffer 'select nil 'ancillary) - (cider-classpath-list (current-buffer) - (mapcar (lambda (name) - (cider-classpath-properties name)) - (cider-classpath-entries))))) - -;;;###autoload -(defun cider-open-classpath-entry () - "Open a classpath entry." - (interactive) - (cider-ensure-connected) - (when-let* ((entry (completing-read "Classpath entries: " (cider-classpath-entries)))) - (find-file-other-window entry))) - -(provide 'cider-classpath) - -;;; cider-classpath.el ends here diff --git a/elpa/cider-1.12.0/cider-client.el b/elpa/cider-1.12.0/cider-client.el @@ -1,904 +0,0 @@ -;;; cider-client.el --- A layer of abstraction above low-level nREPL client code. -*- lexical-binding: t -*- - -;; Copyright © 2013-2023 Bozhidar Batsov -;; -;; Author: Bozhidar Batsov <bozhidar@batsov.dev> - -;; 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/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; A layer of abstraction above the low-level nREPL client code. - -;;; Code: - -(require 'map) -(require 'seq) -(require 'subr-x) -(require 'parseedn) - -(require 'clojure-mode) -(require 'spinner) - -(require 'cider-connection) -(require 'cider-completion-context) -(require 'cider-common) -(require 'cider-util) -(require 'nrepl-client) - - -;;; Eval spinner -(defcustom cider-eval-spinner-type 'progress-bar - "Appearance of the evaluation spinner. - -Value is a symbol. The possible values are the symbols in the -`spinner-types' variable." - :type 'symbol - :group 'cider - :package-version '(cider . "0.10.0")) - -(defcustom cider-show-eval-spinner t - "When true, show the evaluation spinner in the mode line." - :type 'boolean - :group 'cider - :package-version '(cider . "0.10.0")) - -(defcustom cider-eval-spinner-delay 1 - "Amount of time, in seconds, after which the evaluation spinner will be shown." - :type 'integer - :group 'cider - :package-version '(cider . "0.10.0")) - -(defcustom cider-enhanced-cljs-completion-p t - "This setting enables dynamic cljs completions. -That is, expressions at point are evaluated and the properties of the -resulting value are used to compute completions." - :type 'boolean - :group 'cider - :package-version '(cider . "0.23.0")) - -(defcustom cider-before-eval-hook nil - "List of functions to call before eval request is sent to nrepl." - :type 'hook - :group 'cider - :package-version '(cider . "1.2.0")) - -(defcustom cider-after-eval-done-hook nil - "List of functions to call after eval was responded by nrepl with done status." - :type 'hook - :group 'cider - :package-version '(cider . "1.2.0")) - -(defun cider-spinner-start (buffer) - "Start the evaluation spinner in BUFFER. -Do nothing if `cider-show-eval-spinner' is nil." - (when cider-show-eval-spinner - (with-current-buffer buffer - (spinner-start cider-eval-spinner-type nil - cider-eval-spinner-delay)))) - -(defun cider-eval-spinner (eval-buffer response) - "Handle RESPONSE stopping the spinner. -EVAL-BUFFER is the buffer where the spinner was started." - ;; buffer still exists and - ;; we've got status "done" from nrepl - ;; stop the spinner - (when (and (buffer-live-p eval-buffer) - (let ((status (nrepl-dict-get response "status"))) - (or (member "done" status) - (member "eval-error" status) - (member "error" status)))) - (with-current-buffer eval-buffer - (when spinner-current (spinner-stop))))) - - -;;; Evaluation helpers -(defun cider-ns-form-p (form) - "Check if FORM is an ns form." - (string-match-p "^[[:space:]]*\(ns\\([[:space:]]*$\\|[[:space:]]+\\)" form)) - -(defun cider-ns-from-form (ns-form) - "Get ns substring from NS-FORM." - (when (string-match "^[ \t\n]*\(ns[ \t\n]+\\([^][ \t\n(){}]+\\)" ns-form) - (match-string-no-properties 1 ns-form))) - -(defvar-local cider-buffer-ns nil - "Current Clojure namespace of some buffer. -Useful for special buffers (e.g. REPL, doc buffers) that have to keep track -of a namespace. This should never be set in Clojure buffers, as there the -namespace should be extracted from the buffer's ns form.") - -(defun cider-current-ns (&optional no-default no-repl-check) - "Return the current ns. -The ns is extracted from the ns form for Clojure buffers and from -`cider-buffer-ns' for all other buffers. If it's missing, use the current -REPL's ns, otherwise fall back to \"user\". -When NO-DEFAULT is non-nil, it will return nil instead of \"user\". -When NO-REPL-CHECK is non-nil, `cider-current-repl' will not be queried, -improving performance (at the possible cost of accuracy)." - (or cider-buffer-ns - (cider-get-ns-name) - (unless no-repl-check - (when-let* ((repl (cider-current-repl))) - (buffer-local-value 'cider-buffer-ns repl))) - (if no-default nil "user"))) - -(defun cider-path-to-ns (relpath) - "Transform RELPATH to Clojure namespace. -Remove extension and substitute \"/\" with \".\", \"_\" with \"-\"." - (thread-last - relpath - (file-name-sans-extension) - (replace-regexp-in-string "/" ".") - (replace-regexp-in-string "_" "-"))) - -(defun cider-expected-ns (&optional path) - "Return the namespace string matching PATH, or nil if not found. -If PATH is nil, use the path to the file backing the current buffer. The -command falls back to `clojure-expected-ns' in the absence of an active -nREPL connection." - (if (cider-connected-p) - (let* ((path (file-truename (or path buffer-file-name))) - (relpath (thread-last - (cider-classpath-entries) - (seq-filter #'file-directory-p) - (seq-map (lambda (dir) - (when (file-in-directory-p path dir) - (file-relative-name path dir)))) - (seq-filter #'identity) - (seq-sort (lambda (a b) - (< (length a) (length b)))) - (car)))) - (if relpath - (cider-path-to-ns relpath) - (clojure-expected-ns path))) - (clojure-expected-ns path))) - -(defun cider-nrepl-op-supported-p (op &optional connection skip-ensure) - "Check whether the CONNECTION supports the nREPL middleware OP. -Skip check if repl is active if SKIP-ENSURE is non nil." - (nrepl-op-supported-p op (or connection (cider-current-repl nil (if skip-ensure - nil - 'ensure))))) - -(defun cider-ensure-op-supported (op) - "Check for support of middleware op OP. -Signal an error if it is not supported." - (unless (cider-nrepl-op-supported-p op) - (user-error "`%s' requires the nREPL op \"%s\" (provided by cider-nrepl)" this-command op))) - -(defun cider-nrepl-send-request (request callback &optional connection tooling) - "Send REQUEST and register response handler CALLBACK. -REQUEST is a pair list of the form (\"op\" \"operation\" \"par1-name\" - \"par1\" ... ). -If CONNECTION is provided dispatch to that connection instead of -the current connection. Return the id of the sent message. -If TOOLING is truthy then the tooling session is used." - (nrepl-send-request request callback (or connection (cider-current-repl 'any 'ensure)) tooling)) - -(defun cider-nrepl-send-sync-request (request &optional connection abort-on-input) - "Send REQUEST to the nREPL server synchronously using CONNECTION. -Hold till final \"done\" message has arrived and join all response messages -of the same \"op\" that came along and return the accumulated response. -If ABORT-ON-INPUT is non-nil, the function will return nil -at the first sign of user input, so as not to hang the -interface." - (nrepl-send-sync-request request - (or connection (cider-current-repl 'any 'ensure)) - abort-on-input)) - -(defun cider-nrepl-send-unhandled-request (request &optional connection) - "Send REQUEST to the nREPL CONNECTION and ignore any responses. -Immediately mark the REQUEST as done. Return the id of the sent message." - (let* ((conn (or connection (cider-current-repl 'any 'ensure))) - (id (nrepl-send-request request #'ignore conn))) - (with-current-buffer conn - (nrepl--mark-id-completed id)) - id)) - -(defun cider-nrepl-request:eval (input callback &optional ns line column additional-params connection) - "Send the request INPUT and register the CALLBACK as the response handler. -If NS is non-nil, include it in the request. LINE and COLUMN, if non-nil, -define the position of INPUT in its buffer. ADDITIONAL-PARAMS is a plist -to be appended to the request message. CONNECTION is the connection -buffer, defaults to (cider-current-repl)." - (let ((connection (or connection (cider-current-repl nil 'ensure))) - (eval-buffer (current-buffer))) - (run-hooks 'cider-before-eval-hook) - (nrepl-request:eval input - (lambda (response) - (when cider-show-eval-spinner - (cider-eval-spinner connection response)) - (when (and (buffer-live-p eval-buffer) - (member "done" (nrepl-dict-get response "status"))) - (with-current-buffer eval-buffer - (run-hooks 'cider-after-eval-done-hook))) - (funcall callback response)) - connection - ns line column additional-params) - (cider-spinner-start connection))) - -(defun cider-nrepl-sync-request:eval (input &optional connection ns) - "Send the INPUT to the nREPL CONNECTION synchronously. -If NS is non-nil, include it in the eval request." - (nrepl-sync-request:eval input (or connection (cider-current-repl nil 'ensure)) ns)) - -(defcustom cider-format-code-options nil - "A map of options that will be passed to `cljfmt' to format code. -Assuming this is the Clojure map you want to use as `cljfmt' options: - - {:indents {org.me/foo [[:inner 0]]} - :alias-map {\"me\" \"org.me\"}} - -you need to encode it as the following plist: - - '((\"indents\" ((\"org.me/foo\" ((\"inner\" 0))))) (\"alias-map\" ((\"me\" \"org.me\"))))" - :type 'list - :group 'cider - :package-version '(cider . "1.1.0")) - -(defun cider--nrepl-format-code-request-map (&optional format-options) - "Map to merge into requests that require code formatting. -If non-nil, FORMAT-OPTIONS specifies the options cljfmt will use to format -the code. See `cider-format-code-options` for details." - (when format-options - (let* ((indents-dict (when (assoc "indents" format-options) - (thread-last - (cadr (assoc "indents" format-options)) - (map-pairs) - (seq-mapcat #'identity) - (apply #'nrepl-dict)))) - (alias-map-dict (when (assoc "alias-map" format-options) - (thread-last - (cadr (assoc "alias-map" format-options)) - (map-pairs) - (seq-mapcat #'identity) - (apply #'nrepl-dict))))) - (thread-last - (map-merge 'list - (when indents-dict - `(("indents" ,indents-dict))) - (when alias-map-dict - `(("alias-map" ,alias-map-dict)))) - (map-pairs) - (seq-mapcat #'identity) - (apply #'nrepl-dict))))) - -(defcustom cider-print-fn 'pprint - "Sets the function to use for printing. - -nil – to defer to nREPL to choose the printing function. This will use -the bound value of \\=`nrepl.middleware.print/*print-fn*\\=`, which -defaults to the equivalent of \\=`clojure.core/pr\\=`. - -`pr' – to use the equivalent of \\=`clojure.core/pr\\=`. - -`pprint' – to use \\=`clojure.pprint/pprint\\=` (this is the default). - -`fipp' – to use the Fast Idiomatic Pretty Printer, approximately 5-10x -faster than \\=`clojure.core/pprint\\=`. - -`puget' – to use Puget, which provides canonical serialization of data on -top of fipp, but at a slight performance cost. - -`zprint' – to use zprint, a fast and flexible alternative to the libraries -mentioned above. - -Alternatively can be the namespace-qualified name of a Clojure var whose -function takes three arguments: the object to print, the -\\=`java.io.PrintWriter\\=` to print on, and a (possibly nil) map of -options. If the function cannot be resolved, will behave as if set to -nil." - :type '(choice (const nil) - (const pr) - (const pprint) - (const fipp) - (const puget) - (const zprint) - string) - :group 'cider - :package-version '(cider . "0.21.0")) - -(defcustom cider-print-options nil - "A map of options that will be passed to `cider-print-fn'. -Here's an example for `pprint': - - '((\"length\" 50) (\"right-margin\" 70))" - :type 'list - :group 'cider - :package-version '(cider . "0.21.0")) - -(make-obsolete-variable 'cider-pprint-fn 'cider-print-fn "0.21") -(make-obsolete-variable 'cider-pprint-options 'cider-print-options "0.21") - -(defcustom cider-print-quota (* 1024 1024) - "A hard limit on the number of bytes to return from any printing operation. -Set to nil for no limit." - :type 'integer - :group 'cider - :package-version '(cider . "0.21.0")) - -(defcustom cider-print-buffer-size (* 4 1024) - "The size in bytes of each value/output chunk when using print streaming. -Smaller values mean smaller data chunks and faster feedback, but they also mean -smaller results that can be font-locked as Clojure in the REPL buffers, as only -a single chunk result can be font-locked. - -The default value in nREPL is 1024." - :type 'integer - :group 'cider - :package-version '(cider . "0.25.0")) - -(defun cider--print-fn () - "Return the value to send in the nrepl.middleware.print/print slot." - (pcase cider-print-fn - (`pr "cider.nrepl.pprint/pr") - (`pprint "cider.nrepl.pprint/pprint") - (`fipp "cider.nrepl.pprint/fipp-pprint") - (`puget "cider.nrepl.pprint/puget-pprint") - (`zprint "cider.nrepl.pprint/zprint-pprint") - (_ cider-print-fn))) - -(defvar cider--print-options-mapping - '((right-margin - ((fipp . width) (puget . width) (zprint . width))) - (length - ((fipp . print-length) (puget . print-length) (zprint . max-length))) - (level - ((fipp . print-level) (puget . print-level) (zprint . max-depth)))) - "A mapping of print option for the various supported print engines.") - -(defun cider--print-option (name printer) - "Convert the generic NAME to its PRINTER specific variant. -E.g. pprint's right-margin would become width for fipp. -The function is useful when you want to generate dynamically -print options. - -NAME can be a string or a symbol. PRINTER has to be a symbol. -The result will be a string." - (let* ((name (cider-maybe-intern name)) - (result (cdr (assoc printer (cadr (assoc name cider--print-options-mapping)))))) - (symbol-name (or result name)))) - -(defun cider--nrepl-print-request-map (&optional right-margin) - "Map to merge into requests that require pretty-printing. -RIGHT-MARGIN specifies the maximum column-width of the printed result, and -is included in the request if non-nil." - (let* ((width-option (cider--print-option "right-margin" cider-print-fn)) - (print-options (thread-last - (map-merge 'hash-table - `((,width-option ,right-margin)) - cider-print-options) - (map-pairs) - (seq-mapcat #'identity) - (apply #'nrepl-dict)))) - (map-merge 'list - `(("nrepl.middleware.print/stream?" "1")) - (when cider-print-fn - `(("nrepl.middleware.print/print" ,(cider--print-fn)))) - (when cider-print-quota - `(("nrepl.middleware.print/quota" ,cider-print-quota))) - (when cider-print-buffer-size - `(("nrepl.middleware.print/buffer-size" ,cider-print-buffer-size))) - (unless (nrepl-dict-empty-p print-options) - `(("nrepl.middleware.print/options" ,print-options)))))) - -(defun cider--nrepl-pr-request-map () - "Map to merge into requests that do not require pretty printing." - (let ((print-options (thread-last - cider-print-options - (map-pairs) - (seq-mapcat #'identity) - (apply #'nrepl-dict)))) - (map-merge 'list - `(("nrepl.middleware.print/print" "cider.nrepl.pprint/pr") - ("nrepl.middleware.print/stream?" nil)) - (unless (nrepl-dict-empty-p print-options) - `(("nrepl.middleware.print/options" ,print-options))) - (when cider-print-quota - `(("nrepl.middleware.print/quota" ,cider-print-quota)))))) - -(defun cider--nrepl-content-type-map () - "Map to be merged into an eval request to make it use content-types." - '(("content-type" "true"))) - -(defun cider-tooling-eval (input callback &optional ns connection) - "Send the request INPUT to CONNECTION and register the CALLBACK. -NS specifies the namespace in which to evaluate the request. Requests -evaluated in the tooling nREPL session don't affect the thread-local -bindings of the primary eval nREPL session (e.g. this is not going to -clobber *1/2/3)." - ;; namespace forms are always evaluated in the "user" namespace - (nrepl-request:eval input - callback - (or connection (cider-current-repl nil 'ensure)) - ns nil nil nil 'tooling)) - -(defun cider-sync-tooling-eval (input &optional ns connection) - "Send the request INPUT to CONNECTION and evaluate in synchronously. -NS specifies the namespace in which to evaluate the request. Requests -evaluated in the tooling nREPL session don't affect the thread-local -bindings of the primary eval nREPL session (e.g. this is not going to -clobber *1/2/3)." - ;; namespace forms are always evaluated in the "user" namespace - (nrepl-sync-request:eval input - (or connection (cider-current-repl nil 'ensure)) - ns - 'tooling)) - -(defun cider-library-present-p (lib-ns) - "Check whether LIB-NS is present. -If a certain well-known ns in a library is present we assume that library -itself is present." - (nrepl-dict-get (cider-sync-tooling-eval (format "(require '%s)" lib-ns)) "value")) - - -;;; Interrupt evaluation - -(defun cider-interrupt-handler (buffer) - "Create an interrupt response handler for BUFFER." - (nrepl-make-response-handler buffer nil nil nil nil)) - -(defun cider-interrupt () - "Interrupt any pending evaluations." - (interactive) - ;; FIXME: does this work correctly in cljc files? - (with-current-buffer (cider-current-repl nil 'ensure) - (let ((pending-request-ids (cider-util--hash-keys nrepl-pending-requests))) - (dolist (request-id pending-request-ids) - (nrepl-request:interrupt - request-id - (cider-interrupt-handler (current-buffer)) - (cider-current-repl)))))) - -(defun cider-nrepl-eval-session () - "Return the eval nREPL session id of the current connection." - (with-current-buffer (cider-current-repl) - nrepl-session)) - -(defun cider-nrepl-tooling-session () - "Return the tooling nREPL session id of the current connection." - (with-current-buffer (cider-current-repl) - nrepl-tooling-session)) - -(declare-function ido-exit-minibuffer "ido" t) - -;; Not used anywhere, except in documentation as a suggestion for users. -(defmacro cider--with-temporary-ido-keys (UP DOWN &rest body) - "Temporarily define UP, DOWN keys for ido and execute BODY. - -This makes the UX for auto-completion more streamlined, -since one often wants to go to the next candidate (DOWN key) -without having to specify a Java class for the current candidate -\(because the current candidate may be irrelevant to the user)." - `(if (bound-and-true-p ido-common-completion-map) - (let ((original-up-binding (lookup-key ido-common-completion-map (kbd ,UP))) - (original-down-binding (lookup-key ido-common-completion-map (kbd ,DOWN)))) - (define-key ido-common-completion-map (kbd ,UP) (lambda () - (interactive) - (ido-exit-minibuffer))) - (define-key ido-common-completion-map (kbd ,DOWN) (lambda () - (interactive) - (ido-exit-minibuffer))) - (unwind-protect - (progn ,@body) - (define-key ido-common-completion-map (kbd ,UP) original-up-binding) - (define-key ido-common-completion-map (kbd ,DOWN) original-down-binding))) - ,@body)) - -(defun cider-class-choice-completing-read (prompt candidates) - "A completing read that can be customized with the `advice' mechanism, -forwarding PROMPT and CANDIDATES as-is. - -See also: `cider--with-temporary-ido-keys'." - (completing-read prompt candidates)) - -(defun cider--var-choice (var-info) - "Prompt to choose from among multiple VAR-INFO candidates, if required. -This is needed only when the symbol queried is an unqualified host platform -method, and multiple classes have a so-named member. If VAR-INFO does not -contain a `candidates' key, it is returned as is." - (let ((candidates (nrepl-dict-get var-info "candidates"))) - (if candidates - (let* ((classes (nrepl-dict-keys candidates)) - (choice (cider-class-choice-completing-read "Member in class: " classes)) - (info (nrepl-dict-get candidates choice))) - info) - var-info))) - -;; FIXME: Now that nREPL supports a lookup op natively, we should -;; remove this eval-based hack at some point. -(defconst cider-info-form " -(do - (require 'clojure.java.io) - (require 'clojure.walk) - - (if-let [var (resolve '%s)] - (let [info (meta var)] - (-> info - (update :ns str) - (update :name str) - (update :file (comp str clojure.java.io/resource)) - (cond-> (:macro info) (update :macro str)) - (cond-> (:special-form info) (update :special-form str)) - (cond-> (:protocol info) (update :protocol str)) - (cond-> (:arglists info) (update :arglists str)) - (assoc :arglists-str (str (:arglists info))) - (clojure.walk/stringify-keys))))) -") - -(defun cider-fallback-eval:info (var) - "Obtain VAR metadata via a regular eval. -Used only when the info nREPL middleware is not available." - (let* ((response (cider-sync-tooling-eval (format cider-info-form var))) - (var-info (nrepl-dict-from-hash (parseedn-read-str (nrepl-dict-get response "value"))))) - var-info)) - -(defun cider-var-info (var &optional all) - "Return VAR's info as an alist with list cdrs. -When multiple matching vars are returned you'll be prompted to select one, -unless ALL is truthy." - (when (and var (not (string= var ""))) - (let ((var-info (cond - ((cider-nrepl-op-supported-p "info") (cider-sync-request:info var nil nil (cider-completion-get-context t))) - ((cider-nrepl-op-supported-p "lookup") (cider-sync-request:lookup var)) - (t (cider-fallback-eval:info var))))) - (if all var-info (cider--var-choice var-info))))) - -(defun cider-member-info (class member) - "Return the CLASS MEMBER's info as an alist with list cdrs." - (when (and class member) - (cider-sync-request:info nil class member (cider-completion-get-context t)))) - - -;;; Requests - -(declare-function cider-load-file-handler "cider-eval") -(defun cider-request:load-file (file-contents file-path file-name &optional connection callback) - "Perform the nREPL \"load-file\" op. -FILE-CONTENTS, FILE-PATH and FILE-NAME are details of the file to be -loaded. If CONNECTION is nil, use `cider-current-repl'. If CALLBACK -is nil, use `cider-load-file-handler'." - (cider-nrepl-send-request `("op" "load-file" - "file" ,file-contents - "file-path" ,file-path - "file-name" ,file-name) - (or callback - (cider-load-file-handler (current-buffer))) - connection)) - - -;;; Sync Requests - -(defcustom cider-filtered-namespaces-regexps - '("^cider.nrepl" "^refactor-nrepl" "^nrepl") - "List of regexps used to filter out some vars/symbols/namespaces. -When nil, nothing is filtered out. Otherwise, all namespaces matching any -regexp from this list are dropped out of the \"ns-list\" op. Also, -\"apropos\" won't include vars from such namespaces. This list is passed -on to the nREPL middleware without any pre-processing. So the regexps have -to be in Clojure format (with twice the number of backslashes) and not -Emacs Lisp." - :type '(repeat string) - :safe #'listp - :group 'cider - :package-version '(cider . "0.13.0")) - -(defun cider-sync-request:apropos (query &optional search-ns docs-p privates-p case-sensitive-p) - "Send \"apropos\" request for regexp QUERY. - -Optional arguments include SEARCH-NS, DOCS-P, PRIVATES-P, CASE-SENSITIVE-P." - (let* ((query (replace-regexp-in-string "[ \t]+" ".+" query)) - (response (cider-nrepl-send-sync-request - `("op" "apropos" - "ns" ,(cider-current-ns) - "query" ,query - ,@(when search-ns `("search-ns" ,search-ns)) - ,@(when docs-p '("docs?" "t")) - ,@(when privates-p '("privates?" "t")) - ,@(when case-sensitive-p '("case-sensitive?" "t")) - "exclude-regexps" ,cider-filtered-namespaces-regexps)))) - (if (member "apropos-regexp-error" (nrepl-dict-get response "status")) - (user-error "Invalid regexp: %s" (nrepl-dict-get response "error-msg")) - (nrepl-dict-get response "apropos-matches")))) - -(defun cider-sync-request:classpath () - "Return a list of classpath entries." - (cider-ensure-op-supported "classpath") - (thread-first - '("op" "classpath") - (cider-nrepl-send-sync-request) - (nrepl-dict-get "classpath"))) - -(defun cider--get-abs-path (path project) - "Resolve PATH to an absolute path relative to PROJECT. -Do nothing if PATH is already absolute." - (if (not (file-name-absolute-p path)) - (expand-file-name path project) - path)) - -(defun cider-fallback-eval:classpath () - "Return a list of classpath entries using eval. - -Sometimes the classpath contains entries like src/main and we need to -resolve those to absolute paths." - (when (cider-runtime-clojure-p) - (let ((classpath (thread-first - "(seq (.split (System/getProperty \"java.class.path\") \":\"))" - (cider-sync-tooling-eval) - (nrepl-dict-get "value") - read)) - (project (clojure-project-dir))) - (mapcar (lambda (path) (cider--get-abs-path path project)) classpath)))) - -(defun cider-classpath-entries () - "Return a list of classpath entries." - (seq-map #'expand-file-name ; normalize filenames for e.g. Windows - (if (cider-nrepl-op-supported-p "classpath") - (cider-sync-request:classpath) - (cider-fallback-eval:classpath)))) - -(defun cider-sync-request:completion (prefix) - "Return a list of completions for PREFIX using nREPL's \"completion\" op." - (when-let* ((dict (thread-first `("op" "completions" - "ns" ,(cider-current-ns) - "prefix" ,prefix) - (cider-nrepl-send-sync-request (cider-current-repl) - 'abort-on-input)))) - (nrepl-dict-get dict "completions"))) - -(defun cider-sync-request:complete (prefix context) - "Return a list of completions for PREFIX using nREPL's \"complete\" op. -CONTEXT represents a completion context for compliment." - (when-let* ((dict (thread-first `("op" "complete" - "ns" ,(cider-current-ns) - "prefix" ,prefix - "context" ,context - ,@(when cider-enhanced-cljs-completion-p '("enhanced-cljs-completion?" "t"))) - (cider-nrepl-send-sync-request (cider-current-repl) - 'abort-on-input)))) - (nrepl-dict-get dict "completions"))) - -(defun cider-sync-request:complete-flush-caches () - "Send \"complete-flush-caches\" op to flush Compliment's caches." - (cider-nrepl-send-sync-request (list "op" "complete-flush-caches" - "session" (cider-nrepl-eval-session)) - nil - 'abort-on-input)) - -(defun cider-sync-request:info (symbol &optional class member context) - "Send \"info\" op with parameters SYMBOL or CLASS and MEMBER, honor CONTEXT." - (let ((var-info (thread-first `("op" "info" - "ns" ,(cider-current-ns) - ,@(when symbol `("sym" ,symbol)) - ,@(when class `("class" ,class)) - ,@(when member `("member" ,member)) - ,@(when context `("context" ,context))) - (cider-nrepl-send-sync-request (cider-current-repl))))) - (if (member "no-info" (nrepl-dict-get var-info "status")) - nil - var-info))) - -(defun cider-sync-request:lookup (symbol &optional lookup-fn) - "Send \"lookup\" op request with parameters SYMBOL and LOOKUP-FN." - (let ((var-info (thread-first `("op" "lookup" - "ns" ,(cider-current-ns) - ,@(when symbol `("sym" ,symbol)) - ,@(when lookup-fn `("lookup-fn" ,lookup-fn))) - (cider-nrepl-send-sync-request (cider-current-repl))))) - (if (member "lookup-error" (nrepl-dict-get var-info "status")) - nil - (nrepl-dict-get var-info "info")))) - -(defun cider-sync-request:eldoc (symbol &optional class member context) - "Send \"eldoc\" op with parameters SYMBOL or CLASS and MEMBER, honor CONTEXT." - (when-let* ((eldoc (thread-first `("op" "eldoc" - "ns" ,(cider-current-ns) - ,@(when symbol `("sym" ,symbol)) - ,@(when class `("class" ,class)) - ,@(when member `("member" ,member)) - ,@(when context `("context" ,context))) - (cider-nrepl-send-sync-request (cider-current-repl) - 'abort-on-input)))) - (if (member "no-eldoc" (nrepl-dict-get eldoc "status")) - nil - eldoc))) - -(defun cider-sync-request:eldoc-datomic-query (symbol) - "Send \"eldoc-datomic-query\" op with parameter SYMBOL." - (when-let* ((eldoc (thread-first `("op" "eldoc-datomic-query" - "ns" ,(cider-current-ns) - ,@(when symbol `("sym" ,symbol))) - (cider-nrepl-send-sync-request nil 'abort-on-input)))) - (if (member "no-eldoc" (nrepl-dict-get eldoc "status")) - nil - eldoc))) - -(defun cider-sync-request:spec-list (&optional filter-regex) - "Get a list of the available specs in the registry. -Optional argument FILTER-REGEX filters specs. By default, all specs are -returned." - (setq filter-regex (or filter-regex "")) - (thread-first `("op" "spec-list" - "filter-regex" ,filter-regex - "ns" ,(cider-current-ns)) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "spec-list"))) - -(defun cider-sync-request:spec-form (spec) - "Get SPEC's form from registry." - (thread-first `("op" "spec-form" - "spec-name" ,spec - "ns" ,(cider-current-ns)) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "spec-form"))) - -(defun cider-sync-request:spec-example (spec) - "Get an example for SPEC." - (thread-first `("op" "spec-example" - "spec-name" ,spec) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "spec-example"))) - -(defun cider-sync-request:ns-list () - "Get a list of the available namespaces." - (thread-first `("op" "ns-list" - "exclude-regexps" ,cider-filtered-namespaces-regexps) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "ns-list"))) - -(defun cider-sync-request:ns-vars (ns) - "Get a list of the vars in NS." - (thread-first `("op" "ns-vars" - "ns" ,ns) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "ns-vars"))) - -(defun cider-sync-request:ns-path (ns &optional favor-url) - "Get the path to the file containing NS, FAVOR-URL if specified. - -FAVOR-URL ensures a Java URL is returned. - -* This always is the case if the underlying runtime is JVM Clojure. -* For ClojureScript, the default is a resource name. - * This often cannot be open by `cider-find-file' - (unless there was already a buffer opening that file) - -Generally, you always want to FAVOR-URL. -The option is kept for backwards compatibility. - -Note that even when favoring a url, the url itself might be nil, -in which case we'll fall back to the resource name." - (unless ns - (error "No ns provided")) - (let ((response (cider-nrepl-send-sync-request `("op" "ns-path" - "ns" ,ns)))) - (nrepl-dbind-response response (path url) - (if (and favor-url url) - url - path)))) - -(defun cider-sync-request:ns-vars-with-meta (ns) - "Get a map of the vars in NS to its metadata information." - (thread-first `("op" "ns-vars-with-meta" - "ns" ,ns) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "ns-vars-with-meta"))) - -(defun cider-sync-request:private-ns-vars-with-meta (ns) - "Get a map of the vars in NS to its metadata information." - (thread-first `("op" "ns-vars-with-meta" - "ns" ,ns - "var-query" ,(nrepl-dict "private?" "t" - "include-meta-key" '("private"))) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "ns-vars-with-meta"))) - -(defun cider-sync-request:ns-load-all () - "Load all project namespaces." - (thread-first '("op" "ns-load-all") - (cider-nrepl-send-sync-request) - (nrepl-dict-get "loaded-ns"))) - -(defun cider-sync-request:resource (name) - "Perform nREPL \"resource\" op with resource name NAME." - (thread-first `("op" "resource" - "name" ,name) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "resource-path"))) - -(defun cider-sync-request:resources-list () - "Return a list of all resources on the classpath. -The result entries are relative to the classpath." - (when-let* ((resources (thread-first '("op" "resources-list") - (cider-nrepl-send-sync-request) - (nrepl-dict-get "resources-list")))) - (seq-map (lambda (resource) (nrepl-dict-get resource "relpath")) resources))) - -(defun cider-sync-request:fn-refs (ns sym) - "Return a list of functions that reference the function identified by NS and SYM." - (cider-ensure-op-supported "fn-refs") - (thread-first `("op" "fn-refs" - "ns" ,ns - "sym" ,sym) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "fn-refs"))) - -(defun cider-sync-request:fn-deps (ns sym) - "Return a list of function deps for the function identified by NS and SYM." - (cider-ensure-op-supported "fn-deps") - (thread-first `("op" "fn-deps" - "ns" ,ns - "sym" ,sym) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "fn-deps"))) - -(defun cider-sync-request:format-code (code &optional format-options) - "Perform nREPL \"format-code\" op with CODE. -FORMAT-OPTIONS is an optional configuration map for cljfmt." - (let* ((request `("op" "format-code" - "options" ,(cider--nrepl-format-code-request-map format-options) - "code" ,code)) - (response (cider-nrepl-send-sync-request request)) - (err (nrepl-dict-get response "err"))) - (when err - ;; err will be a stacktrace with a first line that looks like: - ;; "clojure.lang.ExceptionInfo: Unmatched delimiter ]" - (error (car (split-string err "\n")))) - (nrepl-dict-get response "formatted-code"))) - -(defun cider-sync-request:format-edn (edn right-margin) - "Perform \"format-edn\" op with EDN and RIGHT-MARGIN." - (let* ((request (thread-last - (map-merge 'list - `(("op" "format-edn") - ("edn" ,edn)) - (cider--nrepl-print-request-map right-margin)) - (seq-mapcat #'identity))) - (response (cider-nrepl-send-sync-request request)) - (err (nrepl-dict-get response "err"))) - (when err - ;; err will be a stacktrace with a first line that looks like: - ;; "clojure.lang.ExceptionInfo: Unmatched delimiter ]" - (error (car (split-string err "\n")))) - (nrepl-dict-get response "formatted-edn"))) - -;;; Dealing with input -;; TODO: Replace this with some nil handler. -(defun cider-stdin-handler (&optional _buffer) - "Make a stdin response handler for _BUFFER." - (nrepl-make-response-handler (current-buffer) - (lambda (_buffer _value)) - (lambda (_buffer _out)) - (lambda (_buffer _err)) - nil)) - -(defun cider-need-input (buffer) - "Handle an need-input request from BUFFER." - (with-current-buffer buffer - (let ((map (make-sparse-keymap))) - (set-keymap-parent map minibuffer-local-map) - (define-key map (kbd "C-c C-c") #'abort-recursive-edit) - (let ((stdin (condition-case nil - (concat (read-from-minibuffer "Stdin: " nil map) "\n") - (quit nil)))) - (nrepl-request:stdin stdin - (cider-stdin-handler buffer) - (cider-current-repl)))))) - -(provide 'cider-client) - -;;; cider-client.el ends here diff --git a/elpa/cider-1.12.0/cider-clojuredocs.el b/elpa/cider-1.12.0/cider-clojuredocs.el @@ -1,171 +0,0 @@ -;;; cider-clojuredocs.el --- ClojureDocs integration -*- lexical-binding: t -*- - -;; Copyright © 2014-2023 Bozhidar Batsov and CIDER contributors -;; -;; Author: Bozhidar Batsov <bozhidar@batsov.dev> - -;; 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/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; A few commands for ClojureDocs documentation lookup. - -;;; Code: - -(require 'cider-client) -(require 'cider-common) -(require 'subr-x) -(require 'cider-popup) - -(require 'nrepl-dict) - -(require 'url-vars) - -(defconst cider-clojuredocs-url "https://clojuredocs.org/") - -(defconst cider-clojuredocs-buffer "*cider-clojuredocs*") - -(defun cider-sync-request:clojuredocs-lookup (ns sym) - "Perform nREPL \"resource\" op with NS and SYM." - (thread-first `("op" "clojuredocs-lookup" - "ns" ,ns - "sym" ,sym) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "clojuredocs"))) - -(defun cider-sync-request:clojuredocs-refresh () - "Refresh the ClojureDocs cache." - (thread-first '("op" "clojuredocs-refresh-cache") - (cider-nrepl-send-sync-request) - (nrepl-dict-get "status"))) - -(defun cider-clojuredocs-replace-special (name) - "Convert the dashes in NAME to a ClojureDocs friendly format. -We need to handle \"?\", \".\", \"..\" and \"/\"." - (thread-last - name - (replace-regexp-in-string "\\?" "_q") - (replace-regexp-in-string "\\(\\.+\\)" "_\\1") - (replace-regexp-in-string "/" "fs"))) - -(defun cider-clojuredocs-url (name ns) - "Generate a ClojureDocs url from NAME and NS." - (let ((base-url cider-clojuredocs-url)) - (when (and name ns) - (concat base-url ns "/" (cider-clojuredocs-replace-special name))))) - -(defun cider-clojuredocs-web-lookup (sym) - "Open the ClojureDocs documentation for SYM in a web browser." - (if-let* ((var-info (cider-var-info sym))) - (let ((name (nrepl-dict-get var-info "name")) - (ns (nrepl-dict-get var-info "ns"))) - (browse-url (cider-clojuredocs-url name ns))) - (error "Symbol %s not resolved" sym))) - -;;;###autoload -(defun cider-clojuredocs-web (&optional arg) - "Open ClojureDocs documentation in the default web browser. - -Prompts for the symbol to use, or uses the symbol at point, depending on -the value of `cider-prompt-for-symbol'. With prefix arg ARG, does the -opposite of what that option dictates." - (interactive "P") - (funcall (cider-prompt-for-symbol-function arg) - "ClojureDocs doc for" - #'cider-clojuredocs-web-lookup)) - -;;;###autoload -(defun cider-clojuredocs-refresh-cache () - "Refresh the ClojureDocs cache." - (interactive) - (let ((result (cider-sync-request:clojuredocs-refresh))) - (if (member "ok" result) - (message "ClojureDocs cache refreshed successfully") - (message "An error occurred while trying to refresh the ClojureDocs cache")))) - -(defun cider-create-clojuredocs-buffer (content) - "Create a new ClojureDocs buffer with CONTENT." - (with-current-buffer (cider-popup-buffer cider-clojuredocs-buffer t) - (read-only-mode -1) - (set-syntax-table clojure-mode-syntax-table) - (local-set-key (kbd "C-c C-d C-c") 'cider-clojuredocs) - (insert content) - (cider-popup-buffer-mode 1) - (view-mode 1) - (goto-char (point-min)) - (current-buffer))) - -(defun cider-clojuredocs--content (dict) - "Generate a nice string from DICT." - (with-temp-buffer - (insert "= " (nrepl-dict-get dict "ns") "/" (nrepl-dict-get dict "name") "\n\n") - (let ((arglists (nrepl-dict-get dict "arglists"))) - (dolist (arglist arglists) - (insert (format " [%s]\n" arglist))) - (insert "\n") - (insert (nrepl-dict-get dict "doc")) - (insert "\n")) - (insert "\n== See Also\n\n") - (if-let ((see-alsos (nrepl-dict-get dict "see-alsos"))) - (dolist (see-also see-alsos) - (insert-text-button (format "* %s\n" see-also) - 'sym see-also - 'action (lambda (btn) - (cider-clojuredocs-lookup (button-get btn 'sym))) - 'help-echo (format "Press Enter or middle click to jump to %s" see-also))) - (insert "Not available\n")) - (insert "\n== Examples\n\n") - (if-let ((examples (nrepl-dict-get dict "examples"))) - (dolist (example examples) - (insert (cider-font-lock-as-clojure example)) - (insert "\n-------------------------------------------------\n")) - (insert "Not available\n")) - (insert "\n== Notes\n\n") - (if-let ((notes (nrepl-dict-get dict "notes"))) - (dolist (note notes) - (insert note) - (insert "\n-------------------------------------------------\n")) - (insert "Not available\n")) - (buffer-string))) - -(defun cider-clojuredocs-lookup (sym) - "Look up the ClojureDocs documentation for SYM." - (let ((docs (cider-sync-request:clojuredocs-lookup (cider-current-ns) sym))) - (pop-to-buffer (cider-create-clojuredocs-buffer (cider-clojuredocs--content docs))) - ;; highlight the symbol in question in the docs buffer - (highlight-regexp - (regexp-quote - (or (cadr (split-string sym "/")) - sym)) - 'bold))) - -;;;###autoload -(defun cider-clojuredocs (&optional arg) - "Open ClojureDocs documentation in a popup buffer. - -Prompts for the symbol to use, or uses the symbol at point, depending on -the value of `cider-prompt-for-symbol'. With prefix arg ARG, does the -opposite of what that option dictates." - (interactive "P") - (when (derived-mode-p 'clojurescript-mode) - (user-error "`cider-clojuredocs' doesn't support ClojureScript")) - (funcall (cider-prompt-for-symbol-function arg) - "ClojureDocs doc for" - #'cider-clojuredocs-lookup)) - -(provide 'cider-clojuredocs) - -;;; cider-clojuredocs.el ends here diff --git a/elpa/cider-1.12.0/cider-common.el b/elpa/cider-1.12.0/cider-common.el @@ -1,467 +0,0 @@ -;;; cider-common.el --- Common use functions -*- lexical-binding: t; -*- - -;; Copyright © 2015-2023 Artur Malabarba - -;; Author: Artur Malabarba <bruce.connor.am@gmail.com> - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; Common functions that are useful in both Clojure buffers and REPL -;; buffers. - -;;; Code: - -(require 'subr-x) -(require 'nrepl-dict) -(require 'cider-util) -(require 'xref) -(require 'tramp) - -(defcustom cider-prompt-for-symbol nil - "Controls when to prompt for symbol when a command requires one. - -When non-nil, always prompt, and use the symbol at point as the default -value at the prompt. - -When nil, attempt to use the symbol at point for the command, and only -prompt if that throws an error." - :type '(choice (const :tag "always" t) - (const :tag "dwim" nil)) - :group 'cider - :package-version '(cider . "0.9.0")) - -(defcustom cider-special-mode-truncate-lines t - "If non-nil, contents of CIDER's special buffers will be line-truncated. -Should be set before loading CIDER." - :type 'boolean - :group 'cider - :package-version '(cider . "0.15.0")) - -(defun cider--should-prompt-for-symbol (&optional invert) - "Return the value of the variable `cider-prompt-for-symbol'. -Optionally invert the value, if INVERT is truthy." - (if invert (not cider-prompt-for-symbol) cider-prompt-for-symbol)) - -(defun cider-prompt-for-symbol-function (&optional invert) - "Prompt for symbol if funcall `cider--should-prompt-for-symbol' is truthy. -Otherwise attempt to use the symbol at point for the command, and only -prompt if that throws an error. - -INVERT inverts the semantics of the function `cider--should-prompt-for-symbol'." - (if (cider--should-prompt-for-symbol invert) - #'cider-read-symbol-name - #'cider-try-symbol-at-point)) - -(defun cider--kw-to-symbol (kw) - "Convert the keyword KW to a symbol." - (when kw - (replace-regexp-in-string "\\`:+" "" kw))) - -;;; Minibuffer -(defvar cider-minibuffer-history '() - "History list of expressions read from the minibuffer.") - -(defvar cider-minibuffer-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map minibuffer-local-map) - (define-key map (kbd "TAB") #'complete-symbol) - (define-key map (kbd "M-TAB") #'complete-symbol) - map) - "Minibuffer keymap used for reading Clojure expressions.") - -(declare-function cider-complete-at-point "cider-completion") -(declare-function cider-eldoc "cider-eldoc") -(defun cider-read-from-minibuffer (prompt &optional value skip-colon) - "Read a string from the minibuffer, prompting with PROMPT. -If VALUE is non-nil, it is inserted into the minibuffer as initial-input. -PROMPT need not end with \": \". If it doesn't, VALUE is displayed on the -prompt as a default value (used if the user doesn't type anything) and is -not used as initial input (input is left empty). -If SKIP-COLON is non-nil, no \": \" is forced at the end of the prompt." - (minibuffer-with-setup-hook - (lambda () - (set-syntax-table clojure-mode-syntax-table) - (add-hook 'completion-at-point-functions - #'cider-complete-at-point nil t) - (setq-local eldoc-documentation-function #'cider-eldoc) - (run-hooks 'eval-expression-minibuffer-setup-hook)) - (let* ((has-colon (string-match ": \\'" prompt)) - (input (read-from-minibuffer (cond - (has-colon prompt) - (skip-colon prompt) - (value (format "%s (default %s): " prompt value)) - (t (format "%s: " prompt))) - (when has-colon value) ; initial-input - cider-minibuffer-map nil - 'cider-minibuffer-history - (unless has-colon value)))) ; default-value - (if (and (equal input "") value (not has-colon)) - value - input)))) - -(defun cider-read-symbol-name (prompt callback) - "Read a symbol name using PROMPT with a default of the one at point. -Use CALLBACK as the completing read var callback." - (funcall callback (cider-read-from-minibuffer - prompt - ;; if the thing at point is a keyword we treat it as symbol - (cider--kw-to-symbol (cider-symbol-at-point 'look-back))))) - -(defun cider-try-symbol-at-point (prompt callback) - "Call CALLBACK with symbol at point. -On failure, read a symbol name using PROMPT and call CALLBACK with that." - (condition-case nil (funcall callback (cider--kw-to-symbol (cider-symbol-at-point 'look-back))) - ('error (funcall callback (cider-read-from-minibuffer prompt))))) - -(declare-function cider-mode "cider-mode") - -(defcustom cider-jump-to-pop-to-buffer-actions - '((display-buffer-reuse-window display-buffer-same-window)) - "Determines what window `cider-jump-to` uses. -The value is passed as the `action` argument to `pop-to-buffer`. - -The default value means: - -- If the target file is already visible in a window, reuse it (switch to it). -- Otherwise, open the target buffer in the current window. - -For further details, see https://docs.cider.mx/cider/config/basic_config.html#control-what-window-to-use-when-jumping-to-a-definition" - :type 'sexp - :group 'cider - :package-version '(cider . "0.24.0")) - -(defun cider-jump-to (buffer &optional pos other-window) - "Push current point onto marker ring, and jump to BUFFER and POS. -POS can be either a number, a cons, or a symbol. -If a number, it is the character position (the point). -If a cons, it specifies the position as (LINE . COLUMN). COLUMN can be nil. -If a symbol, `cider-jump-to' searches for something that looks like the -symbol's definition in the file. -If OTHER-WINDOW is non-nil don't reuse current window." - (with-no-warnings - (xref-push-marker-stack)) - (if other-window - (pop-to-buffer buffer 'display-buffer-pop-up-window) - (pop-to-buffer buffer cider-jump-to-pop-to-buffer-actions)) - (with-current-buffer buffer - (widen) - (goto-char (point-min)) - (cider-mode +1) - (let ((status - (cond - ;; Line-column specification. - ((consp pos) - (forward-line (1- (or (car pos) 1))) - (if (cdr pos) - (move-to-column (cdr pos)) - (back-to-indentation))) - ;; Point specification. - ((numberp pos) - (goto-char pos)) - ;; Symbol or string. - (pos - ;; Try to find (def full-name ...). - (if (or (save-excursion - (search-forward-regexp (format "(def.*\\s-\\(%s\\)" (regexp-quote pos)) - nil 'noerror)) - (let ((name (replace-regexp-in-string ".*/" "" pos))) - ;; Try to find (def name ...). - (or (save-excursion - (search-forward-regexp (format "(def.*\\s-\\(%s\\)" (regexp-quote name)) - nil 'noerror)) - ;; Last resort, just find the first occurrence of `name'. - (save-excursion - (search-forward name nil 'noerror))))) - (goto-char (match-beginning 0)) - (message "Can't find %s in %s" pos (buffer-file-name)) - 'not-found)) - (t 'not-found)))) - (unless (eq status 'not-found) - ;; Make sure the location we jump to is centered within the target window - (recenter))))) - -(defun cider--find-buffer-for-file (file) - "Return a buffer visiting FILE. -If FILE is a temp buffer name, return that buffer." - (if (string-prefix-p "*" file) - file - (and file - (not (cider--tooling-file-p file)) - (cider-find-file file)))) - -(defun cider--jump-to-loc-from-info (info &optional other-window) - "Jump to location give by INFO. -INFO object is returned by `cider-var-info' or `cider-member-info'. -OTHER-WINDOW is passed to `cider-jump-to'." - (let* ((line (nrepl-dict-get info "line")) - (file (nrepl-dict-get info "file")) - (name (nrepl-dict-get info "name")) - ;; the filename might actually be a REPL buffer name - (buffer (cider--find-buffer-for-file file))) - (if buffer - (cider-jump-to buffer (if line (cons line nil) name) other-window) - (error "No source location")))) - -(declare-function url-filename "url-parse" (cl-x) t) - -(defun cider--url-to-file (url) - "Return the filename from the resource URL. -Uses `url-generic-parse-url' to parse the url. The filename is extracted and -then url decoded. If the decoded filename has a Windows device letter followed -by a colon immediately after the leading '/' then the leading '/' is dropped to -create a valid path." - (let ((filename (url-unhex-string (url-filename (url-generic-parse-url url))))) - (if (string-match "^/\\([a-zA-Z]:/.*\\)" filename) - (match-string 1 filename) - filename))) - -(defun cider-make-tramp-prefix (method user host &optional port) - "Constructs a Tramp file prefix from METHOD, USER, HOST, PORT. -It originated from Tramp's `tramp-make-tramp-file-name'. The original be -forced to make full file name with `with-parsed-tramp-file-name', not providing -prefix only option." - (concat tramp-prefix-format - (unless (zerop (length method)) - (concat method tramp-postfix-method-format)) - (unless (zerop (length user)) - (concat user tramp-postfix-user-format)) - (when host - (if (string-match tramp-ipv6-regexp host) - (concat tramp-prefix-ipv6-format host tramp-postfix-ipv6-format) - host)) - (when port - (concat "#" port)) - tramp-postfix-host-format)) - -(defun cider-tramp-prefix (&optional buffer) - "Use the filename for BUFFER to determine a tramp prefix. -Defaults to the current buffer. Return the tramp prefix, or nil -if BUFFER is local." - (let* ((buffer (or buffer (current-buffer))) - (name (or (buffer-file-name buffer) - (with-current-buffer buffer - default-directory)))) - (when (tramp-tramp-file-p name) - (with-parsed-tramp-file-name name v - (with-no-warnings - (cider-make-tramp-prefix v-method v-user v-host v-port)))))) - -(defun cider--client-tramp-filename (name &optional buffer) - "Return the tramp filename for path NAME relative to BUFFER. -If BUFFER has a tramp prefix, it will be added as a prefix to NAME. -If the resulting path is an existing tramp file, it returns the path, -otherwise, nil." - (let* ((buffer (or buffer (current-buffer))) - (name (replace-regexp-in-string "^file:" "" name)) - (name (concat (cider-tramp-prefix buffer) name))) - (if (and (tramp-tramp-file-p name) - (tramp-handle-file-exists-p name)) - name))) - -(defun cider--server-filename (name) - "Return the nREPL server-relative filename for NAME." - (if (tramp-tramp-file-p name) - (with-parsed-tramp-file-name name nil - localname) - name)) - -(defcustom cider-path-translations nil - "Alist of path prefixes to path prefixes. -Useful to intercept the location of a path in a container (or virtual -machine) and translate to the original location. If your project is located -at \"~/projects/foo\" and the src directory of foo is mounted at \"/src\" -in the container, the alist would be `((\"/src\" \"~/projects/foo/src\"))." - :type '(alist :key-type string :value-type string) - :group 'cider - :package-version '(cider . "0.23.0")) - -(defun cider--translate-path (path direction &optional return-all) - "Attempt to translate the PATH in the given DIRECTION, optionally RETURN-ALL. -Looks at `cider-path-translations' for (container . host) alist of path -prefixes and translates PATH from container to host or vice-versa depending on -whether DIRECTION is 'from-nrepl or 'to-nrepl." - (seq-let [from-fn to-fn path-fn] (cond ((eq direction 'from-nrepl) '(car cdr identity)) - ((eq direction 'to-nrepl) '(cdr car expand-file-name))) - (let ((f (lambda (translation) - (let ((path (funcall path-fn path)) - (prefix (file-name-as-directory (expand-file-name (funcall from-fn translation))))) - (when (string-prefix-p prefix path) - (replace-regexp-in-string (format "^%s" (regexp-quote prefix)) - (file-name-as-directory - (expand-file-name (funcall to-fn translation))) - path)))))) - (if return-all - (seq-filter #'identity (mapcar f cider-path-translations)) - (seq-some f cider-path-translations))))) - -(defun cider--all-path-translations () - "Returns `cider-path-translations' if non-empty, else seeks a present value." - (or cider-path-translations - ;; cider-path-translations often is defined as a directory-local variable, - ;; so after jumping to a .jar file, its value can be lost, - ;; so we have to figure out a possible translation: - (thread-last (buffer-list) - (seq-map (lambda (buffer) - (buffer-local-value 'cider-path-translations buffer))) - (seq-filter #'identity) - (seq-uniq) - (apply #'append) - (seq-uniq)))) - -(defun cider--translate-path-from-nrepl (path) - "Attempt to translate the nREPL PATH to a local path." - (cider--translate-path path 'from-nrepl)) - -(defun cider--translate-path-to-nrepl (path) - "Attempt to translate the local PATH to an nREPL path." - (cider--translate-path (expand-file-name path) 'to-nrepl)) - -(defvar cider-from-nrepl-filename-function - (with-no-warnings - (lambda (path) - (let ((path* (if (eq system-type 'cygwin) - (cygwin-convert-file-name-from-windows path) - path))) - (or (cider--translate-path-from-nrepl path*) path*)))) - "Function to translate nREPL namestrings to Emacs filenames.") - -(defcustom cider-prefer-local-resources nil - "Prefer local resources to remote (tramp) ones when both are available." - :type 'boolean - :group 'cider) - -(defun cider--file-path (path) - "Return PATH's local or tramp path using `cider-prefer-local-resources'. -If no local or remote file exists, return nil." - (let* ((local-path (funcall cider-from-nrepl-filename-function path)) - (tramp-path (and local-path (cider--client-tramp-filename local-path)))) - (cond ((equal local-path "") "") - ((and cider-prefer-local-resources (file-exists-p local-path)) - local-path) - ((and tramp-path (file-exists-p tramp-path)) - tramp-path) - ((and local-path (file-exists-p local-path)) - local-path) - (t - (when-let* ((cider-path-translations (cider--all-path-translations))) - (thread-last (cider--translate-path local-path 'from-nrepl :return-all) - (seq-filter #'file-exists-p) - car)))))) - -(declare-function archive-extract "arc-mode") -(declare-function archive-zip-extract "arc-mode") - -(defun cider-find-file (url) - "Return a buffer visiting the file URL if it exists, or nil otherwise. -If URL has a scheme prefix, it must represent a fully-qualified file path -or an entry within a zip/jar archive. If AVFS (archive virtual file -system; see online docs) is mounted the archive entry is opened inside the -AVFS directory, otherwise the entry is archived into a temporary read-only -buffer. If URL doesn't contain a scheme prefix and is an absolute path, it -is treated as such. Finally, if URL is relative, it is expanded within each -of the open Clojure buffers till an existing file ending with URL has been -found." - (require 'arc-mode) - (cond ((string-match "^file:\\(.+\\)" url) - (when-let* ((file (cider--url-to-file (match-string 1 url))) - (path (cider--file-path file))) - (find-file-noselect path))) - ((string-match "^\\(jar\\|zip\\):\\(file:.+\\)!/\\(.+\\)" url) - (when-let* ((entry (match-string 3 url)) - (file (cider--url-to-file (match-string 2 url))) - (path (cider--file-path file)) - (name (format "%s:%s" path entry)) - (avfs (format "%s%s#uzip/%s" - (expand-file-name (or (getenv "AVFSBASE") "~/.avfs/")) - path entry))) - (cond - ;; 1) use avfs - ((file-exists-p avfs) - (find-file-noselect avfs)) - ;; 2) already uncompressed - ((find-buffer-visiting name)) - ;; 3) on remotes use Emacs built-in archiving - ((tramp-tramp-file-p path) - (find-file path) - (goto-char (point-min)) - ;; anchor to eol to prevent eg. clj matching cljs. - (re-search-forward (concat entry "$")) - (let ((archive-buffer (current-buffer))) - (archive-extract) - (kill-buffer archive-buffer)) - (current-buffer)) - ;; 4) Use external zip program to extract a single file - (t - (with-current-buffer (generate-new-buffer - (file-name-nondirectory entry)) - ;; Use appropriate coding system for bytes read from unzip cmd to - ;; display Emacs native newlines regardless of whether the file - ;; uses unix LF or dos CRLF line endings. - ;; It's important to avoid spurious CR characters, which may - ;; appear as `^M', because they can confuse clojure-mode's symbol - ;; detection, e.g. `clojure-find-ns', and break `cider-find-var'. - ;; `clojure-find-ns' uses Emacs' (thing-at-point 'symbol) as - ;; part of identifying a file's namespace, and when a file - ;; isn't decoded properly, namespaces can be reported as - ;; `my.lib^M' which `cider-find-var' won't know what to do with. - (let ((coding-system-for-read 'prefer-utf-8)) - (archive-zip-extract path entry)) - (set-visited-file-name name) - (setq-local default-directory (file-name-directory path)) - (setq-local buffer-read-only t) - (set-buffer-modified-p nil) - (set-auto-mode) - (current-buffer)))))) - (t (if-let* ((path (cider--file-path url))) - (find-file-noselect path) - (unless (file-name-absolute-p url) - (let ((cider-buffers (cider-util--clojure-buffers)) - (url (file-name-nondirectory url))) - (or (cl-loop for bf in cider-buffers - for path = (with-current-buffer bf - (expand-file-name url)) - if (and path (file-exists-p path)) - return (find-file-noselect path)) - (cl-loop for bf in cider-buffers - if (string= (buffer-name bf) url) - return bf)))))))) - -(defun cider--open-other-window-p (arg) - "Test prefix value ARG to see if it indicates displaying results in other window." - (let ((narg (prefix-numeric-value arg))) - (pcase narg - (-1 t) ; - - (16 t) ; empty empty - (_ nil)))) - -(defun cider-abbreviate-ns (namespace) - "Return a string that abbreviates NAMESPACE." - (when namespace - (let* ((names (reverse (split-string namespace "\\."))) - (lastname (car names))) - (concat (mapconcat (lambda (s) (concat (substring s 0 1) ".")) - (reverse (cdr names)) - "") - lastname)))) - -(defun cider-last-ns-segment (namespace) - "Return the last segment of NAMESPACE." - (when namespace - (car (reverse (split-string namespace "\\."))))) - - -(provide 'cider-common) -;;; cider-common.el ends here diff --git a/elpa/cider-1.12.0/cider-completion-context.el b/elpa/cider-1.12.0/cider-completion-context.el @@ -1,122 +0,0 @@ -;;; cider-completion-context.el --- Context parsing -*- lexical-binding: t -*- - -;; Copyright © 2013-2023 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; -;; Author: Bozhidar Batsov <bozhidar@batsov.dev> -;; Artur Malabarba <bruce.connor.am@gmail.com> - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Context-parsing utilities. Extracted from cider-completion.el. - -;;; Code: - -(defcustom cider-completion-use-context t - "When true, uses context at point to improve completion suggestions." - :type 'boolean - :group 'cider - :package-version '(cider . "0.7.0")) - -(defun cider-completion--bounds-of-non-string-symbol-at-point () - "Returns the bounds of the symbol at point, unless it's inside a string." - (let ((sap (symbol-at-point))) - (when (and sap (not (nth 3 (syntax-ppss)))) - (bounds-of-thing-at-point 'symbol)))) - -(defun cider-completion-symbol-start-pos () - "Find the starting position of the symbol at point, unless inside a string." - (car (cider-completion--bounds-of-non-string-symbol-at-point))) - -(defun cider-completion-symbol-end-pos () - "Find the end position of the symbol at point, unless inside a string." - (cdr (cider-completion--bounds-of-non-string-symbol-at-point))) - -(defun cider-completion-get-info-context-at-point () - "Extract a context at point that is suitable for eldoc and info ops. -Note that this context is slightly different than that of -`cider-completion-get-context-at-point': this one does not include -the current symbol at point." - (when (save-excursion - (condition-case _ - (progn - (up-list) - (check-parens) - t) - (scan-error nil) - (user-error nil))) - (save-excursion - (let* ((pref-start (cider-completion-symbol-start-pos)) - (context (cider-defun-at-point)) - (end (cider-completion-symbol-end-pos)) - (_ (beginning-of-defun-raw)) - (expr-start (point)) - (_ (if (derived-mode-p 'cider-repl-mode) - (goto-char (point-max)) - (end-of-defun))) - (expr-end (point))) - (string-remove-suffix "\n" - (concat (when pref-start (substring context 0 (- pref-start expr-start))) - "__prefix__" - (substring context (- (- expr-end end))))))))) - -(defun cider-completion-get-context-at-point () - "Extract the context at point. -If point is not inside the list, returns nil; otherwise return \"top-level\" -form, with symbol at point replaced by __prefix__." - (when (save-excursion - (condition-case _ - (progn - (up-list) - (check-parens) - t) - (scan-error nil) - (user-error nil))) - (save-excursion - (let* ((pref-end (point)) - (pref-start (cider-completion-symbol-start-pos)) - (context (cider-defun-at-point)) - (_ (beginning-of-defun-raw)) - (expr-start (point))) - (concat (when pref-start (substring context 0 (- pref-start expr-start))) - "__prefix__" - (substring context (- pref-end expr-start))))))) - -(defvar cider-completion-last-context nil) - -(defun cider-completion-get-context (&optional info) - "Extract context depending (maybe of INFO type). - -Output depends on `cider-completion-use-context' and the current major mode." - (let ((context (if cider-completion-use-context - ;; We use ignore-errors here since grabbing the context - ;; might fail because of unbalanced parens, or other - ;; technical reasons, yet we don't want to lose all - ;; completions and throw error to user because of that. - (or (ignore-errors - (if info - (cider-completion-get-info-context-at-point) - (cider-completion-get-context-at-point))) - "nil") - "nil"))) - (if (string= cider-completion-last-context context) - ":same" - (setq cider-completion-last-context context) - context))) - -(provide 'cider-completion-context) -;;; cider-completion-context.el ends here diff --git a/elpa/cider-1.12.0/cider-completion.el b/elpa/cider-1.12.0/cider-completion.el @@ -1,293 +0,0 @@ -;;; cider-completion.el --- Smart REPL-powered code completion -*- lexical-binding: t -*- - -;; Copyright © 2013-2023 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; -;; Author: Bozhidar Batsov <bozhidar@batsov.dev> -;; Artur Malabarba <bruce.connor.am@gmail.com> - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Smart REPL-powered code completion and integration with company-mode. - -;;; Code: - -(require 'subr-x) -(require 'thingatpt) - -(require 'cider-client) -(require 'cider-common) -(require 'cider-completion-context) -(require 'cider-doc) -(require 'cider-docstring) -(require 'cider-eldoc) -(require 'nrepl-dict) -(require 'seq) - -(defcustom cider-annotate-completion-candidates t - "When true, annotate completion candidates with some extra information." - :type 'boolean - :group 'cider - :package-version '(cider . "0.8.0")) - -(defcustom cider-annotate-completion-function - #'cider-default-annotate-completion-function - "Controls how the annotations for completion candidates are formatted. -Must be a function that takes two arguments: the abbreviation of the -candidate type according to `cider-completion-annotations-alist' and the -candidate's namespace." - :type 'function - :group 'cider - :package-version '(cider . "0.9.0")) - -(defcustom cider-completion-annotations-alist - '(("class" "c") - ("field" "fi") - ("function" "f") - ("import" "i") - ("keyword" "k") - ("local" "l") - ("macro" "m") - ("method" "me") - ("namespace" "n") - ("protocol" "p") - ("protocol-function" "pf") - ("record" "r") - ("special-form" "s") - ("static-field" "sf") - ("static-method" "sm") - ("type" "t") - ("var" "v")) - "Controls the abbreviations used when annotating completion candidates. - -Must be a list of elements with the form (TYPE . ABBREVIATION), where TYPE -is a possible value of the candidate's type returned from the completion -backend, and ABBREVIATION is a short form of that type." - :type '(alist :key-type string :value-type string) - :group 'cider - :package-version '(cider . "0.9.0")) - -(defconst cider-completion-kind-alist - '(("class" class) - ("field" field) - ("function" function) - ("import" class) - ("keyword" keyword) - ("local" variable) - ("macro" macro) - ("method" method) - ("namespace" module) - ("protocol" enum) - ("protocol-function" enum-member) - ("record" struct) - ("special-form" keyword) - ("static-field" field) - ("static-method" interface) - ("type" parameter) - ("var" variable)) - "Icon mapping for company-mode.") - -(defcustom cider-completion-annotations-include-ns 'unqualified - "Controls passing of namespaces to `cider-annotate-completion-function'. - -When set to 'always, the candidate's namespace will always be passed if it -is available. When set to 'unqualified, the namespace will only be passed -if the candidate is not namespace-qualified." - :type '(choice (const always) - (const unqualified) - (const :tag "never" nil)) - :group 'cider - :package-version '(cider . "0.9.0")) - -(defun cider-completion--parse-candidate-map (candidate-map) - "Get \"candidate\" from CANDIDATE-MAP. -Put type and ns properties on the candidate" - (let ((candidate (nrepl-dict-get candidate-map "candidate")) - (type (nrepl-dict-get candidate-map "type")) - (ns (nrepl-dict-get candidate-map "ns"))) - (put-text-property 0 1 'type type candidate) - (put-text-property 0 1 'ns ns candidate) - candidate)) - -(defun cider-complete (prefix) - "Complete PREFIX with context at point. -Completion relies on nREPL middleware. First -we check if cider-nrepl's complete op is available -and afterward we fallback on nREPL's built-in -completion functionality." - (cond - ;; if we don't have a connection, end early - ((not (cider-connected-p)) nil) - ;; next we try if cider-nrepl's completion is available - ((cider-nrepl-op-supported-p "complete") - (let* ((context (cider-completion-get-context)) - (candidates (cider-sync-request:complete prefix context))) - (mapcar #'cider-completion--parse-candidate-map candidates))) - ;; then we fallback to nREPL's built-in op (available in nREPL 0.8+) - ((cider-nrepl-op-supported-p "completions") - (mapcar #'cider-completion--parse-candidate-map (cider-sync-request:completion prefix))) - (t nil))) - -(defun cider-completion--get-candidate-type (symbol) - "Get candidate type for SYMBOL." - (let ((type (get-text-property 0 'type symbol))) - (or (cadr (assoc type cider-completion-annotations-alist)) - type))) - -(defun cider-completion--get-candidate-ns (symbol) - "Get candidate ns for SYMBOL." - (when (or (eq 'always cider-completion-annotations-include-ns) - (and (eq 'unqualified cider-completion-annotations-include-ns) - (not (cider-namespace-qualified-p symbol)))) - (get-text-property 0 'ns symbol))) - -(defun cider-default-annotate-completion-function (type ns) - "Get completion function based on TYPE and NS." - (concat (when ns (format " (%s)" ns)) - (when type (format " <%s>" type)))) - -(defun cider-company-symbol-kind (symbol) - "Get SYMBOL kind for company-mode." - (let ((type (get-text-property 0 'type symbol))) - (or (cadr (assoc type cider-completion-kind-alist)) - type))) - -(defun cider-annotate-symbol (symbol) - "Return a string suitable for annotating SYMBOL. -If SYMBOL has a text property `type` whose value is recognised, its -abbreviation according to `cider-completion-annotations-alist' will be -used. If `type` is present but not recognised, its value will be used -unaltered. If SYMBOL has a text property `ns`, then its value will be used -according to `cider-completion-annotations-include-ns'. The formatting is -performed by `cider-annotate-completion-function'." - (when cider-annotate-completion-candidates - (let* ((type (cider-completion--get-candidate-type symbol)) - (ns (cider-completion--get-candidate-ns symbol))) - (funcall cider-annotate-completion-function type ns)))) - -(defun cider-complete-at-point () - "Complete the symbol at point." - (when-let* ((bounds (bounds-of-thing-at-point 'symbol))) - (when (and (cider-connected-p) - (not (or (cider-in-string-p) (cider-in-comment-p)))) - (list (car bounds) (cdr bounds) - (lambda (prefix pred action) - ;; When the 'action is 'metadata, this lambda returns metadata about this - ;; capf, when action is (boundaries . suffix), it returns nil. With every - ;; other value of 'action (t, nil, or lambda), 'action is forwarded to - ;; (complete-with-action), together with (cider-complete), prefix and pred. - ;; And that function performs the completion based on those arguments. - ;; - ;; This api is better described in the section - ;; '21.6.7 Programmed Completion' of the elisp manual. - (cond ((eq action 'metadata) `(metadata (category . cider))) ;; defines a completion category named 'cider, used later in our `completion-category-overrides` logic. - ((eq (car-safe action) 'boundaries) nil) - (t (with-current-buffer (current-buffer) - (complete-with-action action - (cider-complete prefix) prefix pred))))) - :annotation-function #'cider-annotate-symbol - :company-kind #'cider-company-symbol-kind - :company-doc-buffer #'cider-create-compact-doc-buffer - :company-location #'cider-company-location - :company-docsig #'cider-company-docsig)))) - -(defun cider-completion-flush-caches () - "Force Compliment to refill its caches. -This command should be used if Compliment fails to pick up new classnames -and methods from dependencies that were loaded dynamically after the REPL -has started." - (interactive) - (cider-sync-request:complete-flush-caches)) - -(defun cider-company-location (var) - "Open VAR's definition in a buffer. -Returns the cons of the buffer itself and the location of VAR's definition -in the buffer." - (when-let* ((info (cider-var-info var)) - (file (nrepl-dict-get info "file")) - (line (nrepl-dict-get info "line")) - (buffer (cider-find-file file))) - (with-current-buffer buffer - (save-excursion - (goto-char (point-min)) - (forward-line (1- line)) - (cons buffer (point)))))) - -(defun cider-company-docsig (thing) - "Return signature for THING." - (when-let ((eldoc-info (cider-eldoc-info thing))) - (let* ((ns (lax-plist-get eldoc-info "ns")) - (symbol (lax-plist-get eldoc-info "symbol")) - (arglists (lax-plist-get eldoc-info "arglists"))) - (format "%s: %s" - (cider-eldoc-format-thing ns symbol thing - (cider-eldoc-thing-type eldoc-info)) - (cider-eldoc-format-arglist arglists 0))))) - -;; Fuzzy completion for company-mode - -(defun cider-company-unfiltered-candidates (string &rest _) - "Return CIDER completion candidates for STRING as is, unfiltered." - (cider-complete string)) - -;; defines a completion style named `cider' (which ideally would have been named `cider-fuzzy'). -;; note that there's already a completion category named `cider' (grep for `(metadata (category . cider))` in this file), -;; which can be confusing given the identical name. -;; The `cider' completion style should be removed because the `flex' style is essentially equivalent. -;; (To be fair, `flex' was introduced in Emacs 27, 3 years in after our commit 04e428b -;; which introduced `cider-company-enable-fuzzy-completion') -(add-to-list 'completion-styles-alist - '(cider - cider-company-unfiltered-candidates - cider-company-unfiltered-candidates - "CIDER backend-driven completion style.")) - -;; Currently CIDER completions only work for `basic`, and not `initials`, `partial-completion`, `orderless`, etc. -;; So we ensure that those other styles aren't used with CIDER, otherwise one would see bad or no completions at all. -;; This `add-to-list` call can be removed once we implement the other completion styles. -;; (When doing that, please refactor `cider-enable-flex-completion' as well) -(add-to-list 'completion-category-overrides '(cider (styles basic))) - -(defun cider-company-enable-fuzzy-completion () - "Enable backend-driven fuzzy completion in the current buffer. - -DEPRECATED: please use `cider-enable-flex-completion' instead." - (setq-local completion-styles '(cider))) - -(make-obsolete 'cider-company-enable-fuzzy-completion 'cider-enable-flex-completion "1.8.0") - -(defun cider-enable-flex-completion () - "Enables `flex' (fuzzy) completion for CIDER in all buffers. - -Only affects the `cider' completion category.`" - (interactive) - (when (< emacs-major-version 27) - (user-error "`cider-enable-flex-completion' requires Emacs 27 or later")) - (let ((found-styles (when-let ((cider (assq 'cider completion-category-overrides))) - (assq 'styles cider))) - (found-cycle (when-let ((cider (assq 'cider completion-category-overrides))) - (assq 'cycle cider)))) - (setq completion-category-overrides (seq-remove (lambda (x) - (equal 'cider (car x))) - completion-category-overrides)) - (unless (member 'flex found-styles) - (setq found-styles (append found-styles '(flex)))) - (add-to-list 'completion-category-overrides (apply #'list 'cider found-styles (when found-cycle - (list found-cycle)))))) - -(provide 'cider-completion) -;;; cider-completion.el ends here diff --git a/elpa/cider-1.12.0/cider-connection.el b/elpa/cider-1.12.0/cider-connection.el @@ -1,1083 +0,0 @@ -;;; cider-connection.el --- Connection and session life-cycle management for CIDER -*- lexical-binding: t -*- -;; -;; Copyright © 2019-2023 Artur Malabarba, Bozhidar Batsov, Vitalie Spinu and CIDER contributors -;; -;; Author: Artur Malabarba <bruce.connor.am@gmail.com> -;; Bozhidar Batsov <bozhidar@batsov.dev> -;; Vitalie Spinu <spinuvit@gmail.com> -;; -;; Keywords: languages, clojure, cider -;; -;; 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/>. -;; -;; This file is not part of GNU Emacs. -;; -;; -;;; Commentary: -;; -;; -;;; Code: - -(require 'nrepl-client) -(require 'cl-lib) -(require 'format-spec) -(require 'sesman) -(require 'sesman-browser) -(require 'spinner) -(require 'cider-popup) -(require 'cider-util) - -(defcustom cider-session-name-template "%J:%h:%p" - "Format string to use for session names. -See `cider-format-connection-params' for available format characters." - :type 'string - :group 'cider - :package-version '(cider . "0.18.0")) - -(defcustom cider-redirect-server-output-to-repl t - "Controls whether nREPL server output would be redirected to the REPL. -When non-nil the output would end up in both the nrepl-server buffer (when -available) and the matching REPL buffer." - :type 'boolean - :group 'cider - :safe #'booleanp - :package-version '(cider . "0.17.0")) - -(defcustom cider-auto-mode t - "When non-nil, automatically enable and disable CIDER in all Clojure buffers. - -After an initial connection, `cider-mode' is added to `clojure-mode-hook' and -automatically enabled on all existing Clojure buffers. After the last -connection has been closed, `cider-mode' is disabled in all Clojure buffers, and -has to be manually re-enabled via \\[cider-mode]. - -Useful for switching between alternative minor modes like `inf-clojure-mode'." - :type 'boolean - :group 'cider - :safe #'booleanp - :package-version '(cider . "0.9.0")) - -(defcustom cider-merge-sessions nil - "Controls session combination behaviour. - -Symbol `host' combines all sessions of a project associated with the same host. -Symbol `project' combines all sessions of a project. - -All other values do not combine any sessions." - :type '(choice (const :tag "Combine all sessions with the same host" host) - (const :tag "Combine all sessions from the same project" project) - (other :tag "Do not combine any sessions")) - :group 'cider - :safe #'symbolp - :package-version '(cider . "1.5")) - -(defcustom cider-reuse-dead-repls 'prompt - "How to deal with existing dead REPL buffers when initializing a connection. - -Possible choices are `prompt', `auto', `any', and nil. -- `prompt' means to always ask the user for a decision. -- `auto' means to automatically reuse a dead REPL without prompting the user - if it is the only available option. When there are multiple buffers to - choose from, the user is is prompted for a choice. -- `any' (or any other non-nil value) means to reuse any dead REPL buffer - available, by default the most relevant according to various heuristics, - and never prompt the user. -- nil means to start a new REPL each time, ignoring existing buffers." - :type '(choice (const :tag "Always prompt for what to do with dead REPLs" prompt) - (const :tag "Reuse dead REPL, prompting only for multiple choice" auto) - (const :tag "Reuse any available dead REPL and never prompt" any) - (const :tag "Never reuse dead REPLs" nil)) - :group 'cider - :safe #'symbolp - :package-version '(cider . "1.8")) - -(defconst cider-required-nrepl-version "0.6.0" - "The minimum nREPL version that's known to work properly with CIDER.") - -(defcustom cider-clojurec-eval-destination 'multi - "The REPL type to be chosen in .cljc buffers." - :type '(choice (const :tag "Clojure" clj) - (const :tag "ClojureScript" cljs) - (const :tag "Multi (evaluate in Clojure and ClojureScript simultaneously)" multi)) - :group 'cider - :package-version '(cider . "1.8")) - -;;; Connect - -(defun cider-nrepl-connect (params) - "Start nrepl client and create the REPL. -PARAMS is a plist containing :host, :port, :server and other parameters for -`cider-repl-create'." - (process-buffer - (nrepl-start-client-process - (plist-get params :host) - (plist-get params :port) - (plist-get params :server) - (lambda (_) - (cider-repl-create params)) - (plist-get params :socket-file)))) - -(defun cider-sessions () - "Return a list of all active CIDER sessions." - (sesman-sessions 'CIDER)) - -(defun cider-connected-p () - "Return t if CIDER is currently connected, nil otherwise." - (process-live-p (get-buffer-process (cider-current-repl)))) - -(defun cider-ensure-connected () - "Ensure there is a linked CIDER session." - (sesman-ensure-session 'CIDER)) - -(defun cider--session-server (session) - "Return server buffer for SESSION or nil if there is no server." - (seq-some (lambda (r) - (buffer-local-value 'nrepl-server-buffer r)) - (cdr session))) - -(defun cider--gather-session-params (session) - "Gather all params for a SESSION." - (let (params) - (dolist (repl (cdr session)) - (setq params (cider--gather-connect-params params repl))) - (when-let* ((server (cider--session-server session))) - (setq params (cider--gather-connect-params params server))) - params)) - -(defun cider--gather-connect-params (&optional params proc-buffer) - "Gather all relevant connection parameters into PARAMS plist. -PROC-BUFFER is either server or client buffer, defaults to current buffer." - (let ((proc-buffer (or proc-buffer (current-buffer)))) - (with-current-buffer proc-buffer - (unless nrepl-endpoint - (error "This is not a REPL or SERVER buffer; is there an active REPL?")) - (let ((server-buf (if (nrepl-server-p proc-buffer) - proc-buffer - nrepl-server-buffer))) - (cl-loop for l on nrepl-endpoint by #'cddr - do (setq params (plist-put params (car l) (cadr l)))) - (setq params (thread-first params - (plist-put :project-dir nrepl-project-dir))) - (when (buffer-live-p server-buf) - (setq params (thread-first params - (plist-put :server (get-buffer-process server-buf)) - (plist-put :server-command nrepl-server-command)))) - ;; repl-specific parameters (do not pollute server params!) - (unless (nrepl-server-p proc-buffer) - (setq params (thread-first params - (plist-put :session-name cider-session-name) - (plist-put :repl-type cider-repl-type) - (plist-put :cljs-repl-type cider-cljs-repl-type) - (plist-put :repl-init-function cider-repl-init-function)))) - params)))) - -(defun cider--close-buffer (buffer) - "Close the BUFFER and kill its associated process (if any)." - (when (buffer-live-p buffer) - (when-let* ((proc (get-buffer-process buffer))) - (when (process-live-p proc) - (delete-process proc))) - (kill-buffer buffer))) - -(declare-function cider-repl-emit-interactive-stderr "cider-repl") -(defun cider--close-connection (repl &optional no-kill) - "Close connection associated with REPL. -When NO-KILL is non-nil stop the connection but don't kill the REPL -buffer." - (when (buffer-live-p repl) - (with-current-buffer repl - (when spinner-current (spinner-stop)) - (when nrepl-tunnel-buffer - (cider--close-buffer nrepl-tunnel-buffer)) - (when no-kill - ;; inform sentinel not to kill the server, if any - (thread-first (get-buffer-process repl) - (process-plist) - (plist-put :keep-server t)))) - (let ((proc (get-buffer-process repl))) - (when (and (process-live-p proc) - (or (not nrepl-server-buffer) - ;; Sync request will hang if the server is dead. - (process-live-p (get-buffer-process nrepl-server-buffer)))) - (nrepl-sync-request:close repl) - ;; give a chance to the REPL to respond to the closing of the connection - (sleep-for 0.5) - (delete-process proc))) - (when-let* ((messages-buffer (and nrepl-log-messages - (nrepl-messages-buffer repl)))) - (kill-buffer messages-buffer)) - (unless no-kill - (kill-buffer repl))) - (when repl - (sesman-remove-object 'CIDER nil repl (not no-kill) t))) - -(defun cider-emit-manual-warning (section-id format &rest args) - "Emit a warning to the REPL and link to the online manual. -SECTION-ID is the section to link to. The link is added on the last line. -FORMAT is a format string to compile with ARGS and display on the REPL." - (let ((message (apply #'format format args))) - (cider-repl-emit-interactive-stderr - (concat "WARNING: " message " (" - (cider--manual-button "More information" section-id) - ")\n")))) - -(defvar cider-version) -(defun cider--check-required-nrepl-version () - "Check whether we're using a compatible nREPL version." - (if-let* ((nrepl-version (cider--nrepl-version))) - (when (version< nrepl-version cider-required-nrepl-version) - (cider-emit-manual-warning "troubleshooting.html#warning-saying-you-have-to-use-newer-nrepl" - "CIDER requires nREPL %s (or newer) to work properly" - cider-required-nrepl-version)))) - -(defvar cider-minimum-clojure-version) -(defun cider--check-clojure-version-supported () - "Ensure that we are meeting the minimum supported version of Clojure." - (if-let* ((clojure-version (cider--clojure-version)) - ;; drop all qualifiers from the version string - ;; e.g. 1.10.0-master-SNAPSHOT becomes simply 1.10.0 - (clojure-version (car (split-string clojure-version "-")))) - (when (version< clojure-version cider-minimum-clojure-version) - (cider-emit-manual-warning "basics/installation.html#prerequisites" - "Clojure version (%s) is not supported (minimum %s). CIDER will not work." - clojure-version cider-minimum-clojure-version)))) - -(defun cider--strip-version-patch (v) - "Strips everything but major.minor from the version, returning a version list. -V is the version string to strip the patch from." - (seq-take (version-to-list v) 2)) - -(defun cider--compatible-middleware-version-p (required-ver ver) - "Checks that the available middleware version is compatible with the required. -We look only at the major and minor components. When the major -version is 0, only check that the minor versions match. When the major version -is > 0, first check that the major version matches, then that the minor -version is >= the required minor version. -VER the 'installed' version, -REQUIRED-VER the version required by cider." - (let ((ver* (cider--strip-version-patch ver)) - (required-ver* (cider--strip-version-patch required-ver))) - (cond ((= 0 (car required-ver*)) (= (cadr required-ver*) - (cadr ver*))) - (t (and (= (car required-ver*) - (car ver*)) - (version-list-<= required-ver* ver*)))))) - -(defvar cider-required-middleware-version) -(defun cider--check-middleware-compatibility () - "CIDER frontend/backend compatibility check. -Retrieve the underlying connection's CIDER-nREPL version and checks if the -middleware used is compatible with CIDER. If not, will display a warning -message in the REPL area." - (let* ((version-dict (nrepl-aux-info "cider-version" (cider-current-repl))) - (middleware-version (nrepl-dict-get version-dict "version-string"))) - (cond - ((null middleware-version) - (cider-emit-manual-warning "troubleshooting.html#cider-complains-of-the-cider-nrepl-version" - "CIDER requires cider-nrepl to be fully functional. Some features will not be available without it!")) - ((not (cider--compatible-middleware-version-p cider-required-middleware-version middleware-version)) - (cider-emit-manual-warning "troubleshooting.html#cider-complains-of-the-cider-nrepl-version" - "CIDER %s requires cider-nrepl %s, but you're currently using cider-nrepl %s. The version mismatch might break some functionality!" - cider-version cider-required-middleware-version middleware-version))))) - -(declare-function cider-interactive-eval-handler "cider-eval") -(declare-function cider-nrepl-send-request "cider-client") -;; TODO: Use some null handler here -(defun cider--subscribe-repl-to-server-out () - "Subscribe to the nREPL server's *out*." - (cider-nrepl-send-request '("op" "out-subscribe") - (cider-interactive-eval-handler (current-buffer)))) - -(defvar cider-mode) -(declare-function cider-mode "cider-mode") -(defun cider-enable-on-existing-clojure-buffers () - "Enable CIDER's minor mode on existing Clojure buffers. -See command `cider-mode'." - (interactive) - (add-hook 'clojure-mode-hook #'cider-mode) - (dolist (buffer (cider-util--clojure-buffers)) - (with-current-buffer buffer - (unless cider-mode - (cider-mode +1) - ;; In global-eldoc-mode, a new file-visiting buffer calls - ;; `turn-on-eldoc-mode' which enables eldoc-mode if it's supported in that - ;; buffer as determined by `eldoc--supported-p'. Cider's eldoc support - ;; allows new buffers in cider-mode to enable eldoc-mode. As of 2021-04, - ;; however, clojure-mode itself has no eldoc support, so old clojure - ;; buffers opened before cider started aren't necessarily in eldoc-mode. - ;; Here, we've enabled cider-mode for this old clojure buffer, and now, if - ;; global-eldoc-mode is enabled, try to enable eldoc-mode as if the buffer - ;; had just been created with cider-mode. - (when global-eldoc-mode - (turn-on-eldoc-mode)))))) - -(declare-function cider--debug-mode "cider-debug") -(defun cider-disable-on-existing-clojure-buffers () - "Disable `cider-mode' and related commands on existing Clojure buffers." - (interactive) - (dolist (buffer (cider-util--clojure-buffers)) - (with-current-buffer buffer - (cider--debug-mode -1) - (cider-mode -1)))) - -(defun cider-possibly-disable-on-existing-clojure-buffers () - "Disable `cider-mode' in all Clojure buffers if all CIDER sessions are closed." - (unless (cider-sessions) - (cider-disable-on-existing-clojure-buffers))) - -(defun cider--set-connection-capabilities (&optional conn-buffer) - "Set `cider-connection-capabilities' for CONN-BUFFER during repl init. -See `cider-connection-capabilities'." - (with-current-buffer (or conn-buffer (current-buffer)) - (setf cider-connection-capabilities - (append - (pcase (cider-runtime) - ('clojure '(clojure jvm-compilation-errors)) - ('babashka '(babashka jvm-compilation-errors)) - ('nbb '(cljs)) - (_ '())) - (when - (eq cider-repl-type 'cljs) - '(cljs)))))) - -(declare-function cider--debug-init-connection "cider-debug") -(declare-function cider-repl-init "cider-repl") -(declare-function cider-nrepl-op-supported-p "cider-client") -(declare-function cider-nrepl-request:eval "cider-client") - -(defun cider--connected-handler () - "Handle CIDER initialization after nREPL connection has been established. -This function is appended to `nrepl-connected-hook' in the client process -buffer." - ;; `nrepl-connected-hook' is run in the connection buffer - ;; `cider-enlighten-mode' changes eval to include the debugger, so we inhibit - ;; it here as the debugger isn't necessarily initialized yet - (let ((cider-enlighten-mode nil)) - ;; after initialization, set mode-line and buffer name. - (cider-set-repl-type cider-repl-type) - (cider-repl-init - (current-buffer) - (lambda () - ;; Init logic that's specific to Clojure's nREPL and cider-nrepl - (when (cider-runtime-clojure-p) - (cider--check-required-nrepl-version) - (cider--check-clojure-version-supported) - (cider--check-middleware-compatibility) - - ;; Redirect the nREPL's terminal output to a REPL buffer. - ;; If we don't do this the server's output will end up - ;; in the *nrepl-server* buffer. - (when (and cider-redirect-server-output-to-repl - (cider-nrepl-op-supported-p "out-subscribe")) - (cider--subscribe-repl-to-server-out)) - - ;; Middleware on cider-nrepl's side is deferred until first usage, but - ;; loading middleware concurrently can lead to occasional "require" issues - ;; (likely a Clojure bug). Thus, we load the heavy debug middleware towards - ;; the end, allowing for the faster "server-out" middleware to load - ;; first. - (cider--debug-init-connection)) - - (cider--set-connection-capabilities) - - (when cider-repl-init-function - (funcall cider-repl-init-function)) - - (when cider-auto-mode - (cider-enable-on-existing-clojure-buffers)) - - (run-hooks 'cider-connected-hook))))) - -(defun cider--disconnected-handler () - "Cleanup after nREPL connection has been lost or closed. -This function is appended to `nrepl-disconnected-hook' in the client -process buffer." - ;; `nrepl-connected-hook' is run in the connection buffer - (when cider-auto-mode - (cider-possibly-disable-on-existing-clojure-buffers)) - (run-hooks 'cider-disconnected-hook)) - - -;;; Connection Info - -(defun cider--java-version () - "Retrieve the underlying connection's Java version." - (with-current-buffer (cider-current-repl) - (when nrepl-versions - (thread-first nrepl-versions - (nrepl-dict-get "java") - (nrepl-dict-get "version-string"))))) - -(defun cider--clojure-version () - "Retrieve the underlying connection's Clojure version." - (with-current-buffer (cider-current-repl) - (when nrepl-versions - (thread-first nrepl-versions - (nrepl-dict-get "clojure") - (nrepl-dict-get "version-string"))))) - -(defun cider--nrepl-version () - "Retrieve the underlying connection's nREPL version." - (with-current-buffer (cider-current-repl) - (when nrepl-versions - (thread-first nrepl-versions - (nrepl-dict-get "nrepl") - (nrepl-dict-get "version-string"))))) - -(defun cider--babashka-version () - "Retrieve the underlying connection's Babashka version." - (with-current-buffer (cider-current-repl) - (when nrepl-versions - (nrepl-dict-get nrepl-versions "babashka")))) - -(defun cider--babashka-nrepl-version () - "Retrieve the underlying connection's babashka.nrepl version." - (with-current-buffer (cider-current-repl) - (when nrepl-versions - (nrepl-dict-get nrepl-versions "babashka.nrepl")))) - -(defun cider--nbb-nrepl-version () - "Retrieve the underlying connection's nbb version. - -Note that this is currently not a real version number. -But helps us know if this is a nbb repl, or not." - (with-current-buffer (cider-current-repl) - (when nrepl-versions - (nrepl-dict-get nrepl-versions "nbb-nrepl")))) - -(defun cider-runtime () - "Return the runtime of the nREPl server." - (cond - ((cider--clojure-version) 'clojure) - ((cider--babashka-version) 'babashka) - ((cider--nbb-nrepl-version) 'nbb) - (t 'generic))) - -(defun cider-runtime-clojure-p () - "Check if the current runtime is Clojure." - (eq (cider-runtime) 'clojure)) - -(defun cider--connection-info (connection-buffer &optional genericp) - "Return info about CONNECTION-BUFFER. -Info contains project name, current REPL namespace, host:port endpoint and -runtime details. When GENERICP is non-nil, don't provide specific info -about this buffer (like variable `cider-repl-type')." - (with-current-buffer connection-buffer - (cond - ((cider--clojure-version) - (format "%s%s@%s:%s (Java %s, Clojure %s, nREPL %s)" - (if genericp "" (upcase (concat (symbol-name cider-repl-type) " "))) - (or (cider--project-name nrepl-project-dir) "<no project>") - (plist-get nrepl-endpoint :host) - (plist-get nrepl-endpoint :port) - (cider--java-version) - (cider--clojure-version) - (cider--nrepl-version))) - ((cider--babashka-version) - (format "%s%s@%s:%s (Babashka %s, babashka.nrepl %s)" - (if genericp "" (upcase (concat (symbol-name cider-repl-type) " "))) - (or (cider--project-name nrepl-project-dir) "<no project>") - (plist-get nrepl-endpoint :host) - (plist-get nrepl-endpoint :port) - (cider--babashka-version) - (cider--babashka-nrepl-version))) - (t - (format "%s%s@%s:%s" - (if genericp "" (upcase (concat (symbol-name cider-repl-type) " "))) - (or (cider--project-name nrepl-project-dir) "<no project>") - (plist-get nrepl-endpoint :host) - (plist-get nrepl-endpoint :port)))))) - -(defvar-local cider-connection-capabilities '() - "A list of some of the capabilities of this connection buffer. -In other words - what assumptions we make about the runtime. -This is more general than -`cider-nrepl-op-supported-p' and `cider-library-present-p'. -But does not need to replace them.") - -(defun cider-connection-has-capability-p (capability &optional conn-buf) - "Return non nil when the cider connection has CAPABILITY for CONN-BUF. -By default it assumes the connection buffer is current." - (with-current-buffer (or conn-buf (current-buffer)) - (member capability cider-connection-capabilities))) - - -;;; Connection Management Commands - -(defun cider-quit (&optional repl) - "Quit the CIDER connection associated with REPL. -REPL defaults to the current REPL." - (interactive) - (let ((repl (or repl - (sesman-browser-get 'object) - (cider-current-repl nil 'ensure)))) - (cider--close-connection repl)) - ;; if there are no more sessions we can kill all ancillary buffers - (unless (cider-sessions) - (cider-close-ancillary-buffers)) - ;; need this to refresh sesman browser - (run-hooks 'sesman-post-command-hook)) - -(defun cider-restart (&optional repl) - "Restart CIDER connection associated with REPL. -REPL defaults to the current REPL. Don't restart the server or other -connections within the same session. Use `sesman-restart' to restart the -entire session." - (interactive) - (let* ((repl (or repl - (sesman-browser-get 'object) - (cider-current-repl nil 'ensure))) - (params (thread-first () - (cider--gather-connect-params repl) - (plist-put :session-name (sesman-session-name-for-object 'CIDER repl)) - (plist-put :repl-buffer repl)))) - (cider--close-connection repl 'no-kill) - (cider-nrepl-connect params) - ;; need this to refresh sesman browser - (run-hooks 'sesman-post-command-hook))) - -(defun cider-close-ancillary-buffers () - "Close buffers that are shared across connections." - (interactive) - (dolist (buf-name cider-ancillary-buffers) - (when (get-buffer buf-name) - (kill-buffer buf-name)))) - -(defun cider-describe-connection (&optional repl) - "Display information about the connection associated with REPL. -REPL defaults to the current REPL." - (interactive) - (let ((repl (or repl - (sesman-browser-get 'object) - (cider-current-repl nil 'ensure)))) - (message "%s" (cider--connection-info repl)))) - -(defconst cider-nrepl-session-buffer "*cider-nrepl-session*") - -(declare-function cider-nrepl-eval-session "cider-client") -(declare-function cider-nrepl-tooling-session "cider-client") -(defun cider-describe-nrepl-session () - "Describe an nREPL session." - (interactive) - (cider-ensure-connected) - (let* ((repl (cider-current-repl nil 'ensure)) - (selected-session (completing-read "Describe nREPL session: " (nrepl-sessions repl)))) - (when (and selected-session (not (equal selected-session ""))) - (let* ((session-info (nrepl-sync-request:describe repl)) - (ops (nrepl-dict-keys (nrepl-dict-get session-info "ops"))) - (session-id (nrepl-dict-get session-info "session")) - (session-type (cond - ((equal session-id (cider-nrepl-eval-session)) "Active eval") - ((equal session-id (cider-nrepl-tooling-session)) "Active tooling") - (t "Unknown")))) - (with-current-buffer (cider-popup-buffer cider-nrepl-session-buffer 'select nil 'ancillary) - (read-only-mode -1) - (insert (format "Session: %s\n" session-id) - (format "Type: %s session\n" session-type) - (format "Supported ops:\n")) - (mapc (lambda (op) (insert (format " * %s\n" op))) ops))) - (display-buffer cider-nrepl-session-buffer)))) - -(defun cider-list-nrepl-middleware () - "List the loaded nREPL middleware." - (interactive) - (cider-ensure-connected) - (let* ((repl (cider-current-repl nil 'ensure)) - (middleware (nrepl-middleware repl))) - (with-current-buffer (cider-popup-buffer "*cider-nrepl-middleware*" 'select nil 'ancillary) - (read-only-mode -1) - (insert (format "Currently loaded middleware:\n")) - (mapc (lambda (mw) (insert (format " * %s\n" mw))) middleware)) - (display-buffer "*cider-nrepl-middleware*"))) - - -;;; Sesman's Session-Wise Management UI - -(cl-defmethod sesman-project ((_system (eql CIDER))) - "Find project directory." - (clojure-project-dir (cider-current-dir))) - -(cl-defmethod sesman-more-relevant-p ((_system (eql CIDER)) session1 session2) - "Figure out if SESSION1 or SESSION2 is more relevant." - (sesman-more-recent-p (cdr session1) (cdr session2))) - -(declare-function cider-classpath-entries "cider-client") - -(defvar cider-sesman-browser-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "j q") #'cider-quit) - (define-key map (kbd "j k") #'cider-quit) - (define-key map (kbd "j r") #'cider-restart) - (define-key map (kbd "j d") #'cider-describe-connection) - (define-key map (kbd "j i") #'cider-describe-connection) - (define-key map (kbd "C-c C-q") #'cider-quit) - (define-key map (kbd "C-c C-q") #'cider-quit) - (define-key map (kbd "C-c C-r") #'cider-restart) - (define-key map (kbd "C-c M-r") #'cider-restart) - (define-key map (kbd "C-c C-d") #'cider-describe-connection) - (define-key map (kbd "C-c M-d") #'cider-describe-connection) - (define-key map (kbd "C-c C-i") #'cider-describe-connection) - map) - "Map active on REPL objects in sesman browser.") - -(cl-defmethod sesman-session-info ((_system (eql CIDER)) session) - "Obtain info for a CIDER SESSION." - (list :objects (cdr session) - :map cider-sesman-browser-map)) - -(declare-function cider "cider") -(cl-defmethod sesman-start-session ((_system (eql CIDER))) - "Start a connection of any type interactively. -Fallback on `cider' command." - (call-interactively #'cider)) - -(cl-defmethod sesman-quit-session ((_system (eql CIDER)) session) - "Quit a CIDER SESSION." - (mapc #'cider--close-connection (cdr session)) - ;; if there are no more session we can kill all ancillary buffers - (unless (cider-sessions) - (cider-close-ancillary-buffers))) - -(cl-defmethod sesman-restart-session ((_system (eql CIDER)) session) - "Restart a CIDER SESSION." - (let* ((ses-name (car session)) - (repls (cdr session)) - (srv-buf (cider--session-server session))) - (if srv-buf - ;; session with a server - (let ((s-params (cider--gather-connect-params nil srv-buf))) - ;; 1) kill all connections, but keep the buffers - (mapc (lambda (conn) - (cider--close-connection conn 'no-kill)) - repls) - ;; 2) kill the server - (nrepl-kill-server-buffer srv-buf) - ;; 3) start server - (nrepl-start-server-process - (plist-get s-params :project-dir) - (plist-get s-params :server-command) - (lambda (server-buf) - ;; 4) restart the repls reusing the buffer - (dolist (r repls) - (cider-nrepl-connect - (thread-first () - (cider--gather-connect-params r) - ;; server params (:port, :project-dir etc) have precedence - (cider--gather-connect-params server-buf) - (plist-put :session-name ses-name) - (plist-put :repl-buffer r)))) - (sesman-browser-revert-all 'CIDER) - (message "Restarted CIDER %s session" ses-name)))) - ;; server-less session - (dolist (r repls) - (cider--close-connection r 'no-kill) - (cider-nrepl-connect - (thread-first () - (cider--gather-connect-params r) - (plist-put :session-name ses-name) - (plist-put :repl-buffer r))))))) - -(defun cider--ensure-spec-is-not-invokable (spec) - "Ensures SPEC cannot be invoked as a function. - -Invokeable specs are an Emacs 29 feature -that we don't intend to use in this context." - (let ((spec-char (car spec)) - (spec-value (cdr spec))) - `(,spec-char - . - ,(if (symbolp spec-value) - (prin1-to-string spec-value) - spec-value)))) - -(defun cider-format-connection-params (template params) - "Format PARAMS with TEMPLATE string. -The following formats can be used in TEMPLATE string: - - %h - host - %H - remote host, empty for local hosts - %p - port - %j - short project name, or directory name if no project - %J - long project name including parent dir name - %r - REPL type (clj or cljs) - %S - type of the ClojureScript runtime (Browser, Node, Figwheel etc.) - %s - session name as defined by `cider-session-name-template'. - -In case some values are empty, extra separators (: and -) are automatically -removed." - (let* ((dir (directory-file-name - (abbreviate-file-name - (or (plist-get params :project-dir) - (clojure-project-dir (cider-current-dir)) - default-directory)))) - (short-proj (file-name-nondirectory (directory-file-name dir))) - (parent-dir (ignore-errors - (thread-first dir - file-name-directory - directory-file-name file-name-nondirectory - file-name-as-directory))) - (long-proj (format "%s%s" (or parent-dir "") short-proj)) - ;; use `dir` if it is shorter than `long-proj` or `short-proj` - (short-proj (if (>= (length short-proj) (length dir)) - dir - short-proj)) - (long-proj (if (>= (length long-proj) (length dir)) - dir - long-proj)) - (port (or (plist-get params :port) "")) - (host (or (plist-get params :host) "localhost")) - (remote-host (if (member host '("localhost" "127.0.0.1")) - "" - host)) - (repl-type (or (plist-get params :repl-type) "unknown")) - (cljs-repl-type (or (and (eq repl-type 'cljs) - (plist-get params :cljs-repl-type)) - "")) - (specs `((?h . ,host) - (?H . ,remote-host) - (?p . ,port) - (?j . ,short-proj) - (?J . ,long-proj) - (?r . ,repl-type) - (?S . ,cljs-repl-type))) - (ses-name (or (plist-get params :session-name) - (format-spec cider-session-name-template specs))) - (specs (append `((?s . ,ses-name)) specs)) - (specs (mapcar #'cider--ensure-spec-is-not-invokable specs))) - (thread-last (format-spec template specs) - ;; remove extraneous separators - (replace-regexp-in-string "\\([:-]\\)[:-]+" "\\1") - (replace-regexp-in-string "\\(^[:-]\\)\\|\\([:-]$\\)" "") - (replace-regexp-in-string "[:-]\\([])*]\\)" "\\1")))) - -(defun cider-make-session-name (params) - "Create new session name given plist of connection PARAMS. -Session name can be customized with `cider-session-name-template'." - (let* ((root-name (cider-format-connection-params cider-session-name-template params)) - (other-names (mapcar #'car (sesman-sessions 'CIDER))) - (name root-name) - (i 2)) - (while (member name other-names) - (setq name (concat root-name "#" (number-to-string i)) - i (+ i 1))) - name)) - - -;;; REPL Buffer Init - -(defvar-local cider-cljs-repl-type nil - "The type of the ClojureScript runtime ('browser, 'node, 'figwheel, etc.).") - -(defvar-local cider-repl-type nil - "The type of this REPL buffer, usually either clj or cljs.") - -(defvar-local cider-repl-cljs-upgrade-pending nil - "Is the cljs repl currently pending?") - -(defun cider-repl-type (repl-buffer) - "Get REPL-BUFFER's type." - (buffer-local-value 'cider-repl-type repl-buffer)) - -(defun cider-cljs-pending-p (repl-buffer) - "Returns non nil when REPL-BUFFER is currently a pending cljs repl." - (buffer-local-value 'cider-repl-cljs-upgrade-pending repl-buffer)) - -(defun cider-repl-type-for-buffer (&optional buffer) - "Return the matching connection type (clj or cljs) for BUFFER. -BUFFER defaults to the `current-buffer'. In cljc buffers return -multi. This function infers connection type based on the major mode. -For the REPL type use the function `cider-repl-type'." - (with-current-buffer (or buffer (current-buffer)) - (cond - ((derived-mode-p 'clojurescript-mode) 'cljs) - ((derived-mode-p 'clojurec-mode) cider-clojurec-eval-destination) - ((derived-mode-p 'clojure-mode) 'clj) - (cider-repl-type)))) - -(defun cider-set-repl-type (&optional type) - "Set REPL TYPE to clj or cljs. -Assume that the current buffer is a REPL." - (interactive) - (let ((type (cider-maybe-intern (or type (completing-read - (format "Set REPL type (currently `%s') to: " - cider-repl-type) - '(clj cljs)))))) - (when (or (not (equal cider-repl-type type)) - (null mode-name)) - (setq cider-repl-type type) - (setq mode-name (format "REPL[%s]" type)) - (let ((params (cider--gather-connect-params))) - ;; We need to set current name to something else temporarily to avoid - ;; false name duplication in `nrepl-repl-buffer-name`. - (rename-buffer (generate-new-buffer-name "*dummy-cider-repl-buffer*")) - (rename-buffer (nrepl-repl-buffer-name params)) - (when (and nrepl-log-messages nrepl-messages-buffer) - (with-current-buffer nrepl-messages-buffer - (rename-buffer (nrepl-messages-buffer-name params)))))))) - -(defun cider--choose-reusable-repl-buffer (params) - "Find connection-less REPL buffer and ask the user for confirmation. -Return nil if no such buffers exists or the user has chosen not to reuse -the buffer. If multiple dead REPLs exist, ask the user to choose one. -PARAMS is a plist as received by `cider-repl-create'." - (when-let* ((repls (seq-filter (lambda (b) - (with-current-buffer b - (and (derived-mode-p 'cider-repl-mode) - (not (process-live-p (get-buffer-process b)))))) - (buffer-list)))) - (let* ((proj-dir (plist-get params :project-dir)) - (host (plist-get params :host)) - (port (plist-get params :port)) - (type (plist-get params :repl-type)) - (scored-repls - (mapcar (lambda (b) - (let ((bparams (ignore-errors (cider--gather-connect-params nil b)))) - (when (eq type (plist-get bparams :repl-type)) - (cons b (+ - (if (equal proj-dir (plist-get bparams :project-dir)) 8 0) - (if (equal host (plist-get bparams :host)) 4 0) - (if (equal port (plist-get bparams :port)) 2 0)))))) - repls)) - (sorted-repls (mapcar #'car (seq-sort-by #'cdr #'> (delq nil scored-repls))))) - (cond ((null sorted-repls) nil) - ((and (= 1 (length sorted-repls)) - (eq cider-reuse-dead-repls 'prompt)) - (if (y-or-n-p (format "A dead REPL %s exists. Reuse buffer? " (car sorted-repls))) - (car sorted-repls) - (and (y-or-n-p "Kill dead REPL buffer?") - (kill-buffer (car sorted-repls)) - nil))) - ((and (< 1 (length sorted-repls)) - (memq cider-reuse-dead-repls '(prompt auto))) - (if (y-or-n-p "Dead REPL buffers exist. Select one to reuse? ") - (get-buffer (completing-read "REPL buffer to reuse: " (mapcar #'buffer-name sorted-repls) - nil t nil nil (car sorted-repls))) - (and (y-or-n-p "Kill all dead REPL buffers?") - (mapc #'kill-buffer sorted-repls) - nil))) - (cider-reuse-dead-repls ;; fallthrough for 'auto / 'any / other non-nil values - (car sorted-repls)))))) - -(declare-function cider-default-err-handler "cider-eval") -(declare-function cider-repl-mode "cider-repl") -(declare-function cider-repl--state-handler "cider-repl") -(declare-function cider-repl-reset-markers "cider-repl") -(defvar-local cider-session-name nil) -(defvar-local cider-repl-init-function nil) -(defvar-local cider-launch-params nil) -(defun cider-repl-create (params) - "Create new repl buffer. -PARAMS is a plist which contains :repl-type, :host, :port, :project-dir, -:repl-init-function and :session-name. When non-nil, :repl-init-function -must be a function with no arguments which is called after repl creation -function with the repl buffer set as current." - ;; Connection might not have been set as yet. Please don't send requests in - ;; this function, but use cider--connected-handler instead. - (let ((buffer (or (plist-get params :repl-buffer) - (and cider-reuse-dead-repls - (cider--choose-reusable-repl-buffer params)) - (get-buffer-create (generate-new-buffer-name "*cider-uninitialized-repl*")))) - (ses-name (or (plist-get params :session-name) - (cider-make-session-name params)))) - (with-current-buffer buffer - (setq-local sesman-system 'CIDER) - (setq-local default-directory (or (plist-get params :project-dir) default-directory)) - ;; creates a new session if session with ses-name doesn't already exist - (sesman-add-object 'CIDER ses-name buffer 'allow-new) - (unless (derived-mode-p 'cider-repl-mode) - (cider-repl-mode)) - (setq nrepl-err-handler #'cider-default-err-handler - ;; used as a new-repl marker in cider-set-repl-type - mode-name nil - cider-session-name ses-name - nrepl-project-dir (plist-get params :project-dir) - ;; Cljs repls are pending until they are upgraded. See cider-repl--state-handler - cider-repl-type (plist-get params :repl-type) - cider-repl-cljs-upgrade-pending (plist-get params :cider-repl-cljs-upgrade-pending) - ;; ran at the end of cider--connected-handler - cider-repl-init-function (plist-get params :repl-init-function) - cider-launch-params params) - (when-let ((type (plist-get params :cljs-repl-type))) - (setq cider-cljs-repl-type type)) - (cider-repl-reset-markers) - (add-hook 'nrepl-response-handler-functions #'cider-repl--state-handler nil 'local) - (add-hook 'nrepl-connected-hook #'cider--connected-handler nil 'local) - (add-hook 'nrepl-disconnected-hook #'cider--disconnected-handler nil 'local) - (current-buffer)))) - - -;;; Current/other REPLs - -(defun cider--no-repls-user-error (type) - "Throw \"No REPL\" user error customized for TYPE." - (let ((type (cond - ((or (eq type 'multi) (eq type 'any)) - "clj or cljs") - ((listp type) - (mapconcat #'identity type " or ")) - (type)))) - (user-error "No %s REPLs in current session \"%s\"" - type (car (sesman-current-session 'CIDER))))) - -(defun cider-current-repl (&optional type ensure) - "Get the most recent REPL of TYPE from the current session. -TYPE is either clj, cljs, multi or any. -When nil, infer the type from the current buffer. -If ENSURE is non-nil, throw an error if either there is -no linked session or there is no REPL of TYPE within the current session." - (let ((type (cider-maybe-intern type))) - (if (and (derived-mode-p 'cider-repl-mode) - (or (null type) - (eq 'any type) - (eq cider-repl-type type))) - ;; shortcut when in REPL buffer - (current-buffer) - (let* ((type (or type (cider-repl-type-for-buffer))) - (repls (cider-repls type ensure)) - (repl (if (<= (length repls) 1) - (car repls) - ;; pick the most recent one - (seq-find (lambda (b) - (member b repls)) - (buffer-list))))) - (if (and ensure (null repl)) - (cider--no-repls-user-error type) - repl))))) - -(defun cider--match-repl-type (type buffer) - "Return non-nil if TYPE matches BUFFER's REPL type." - (let ((buffer-repl-type (cider-repl-type buffer))) - (cond ((null buffer-repl-type) nil) - ((or (null type) (eq type 'multi) (eq type 'any)) t) - ((listp type) (member buffer-repl-type type)) - (t - (or (string= type buffer-repl-type) - (let ((capabilities - (buffer-local-value 'cider-connection-capabilities buffer))) - (cond ((listp type) - (cl-some (lambda (it) (member it capabilities)) type)) - (t (member type capabilities))))))))) - -(defun cider--get-host-from-session (session) - "Returns the host associated with SESSION." - (plist-get (cider--gather-session-params session) - :host)) - -(defun cider--make-sessions-list-with-hosts (sessions) - "Makes a list of SESSIONS and their hosts. -Returns a list of the form ((session1 host1) (session2 host2) ...)." - (mapcar (lambda (session) - (list session (cider--get-host-from-session session))) - sessions)) - -(defun cider--get-sessions-with-same-host (session sessions) - "Returns a list of SESSIONS with the same host as SESSION." - (mapcar #'car - (seq-filter (lambda (x) - (string-equal (cadr x) - (cider--get-host-from-session session))) - (cider--make-sessions-list-with-hosts sessions)))) - -(defun cider--extract-connections (sessions) - "Returns a flattened list of all session buffers in SESSIONS." - (cl-reduce (lambda (x y) - (append x (cdr y))) - sessions - :initial-value '())) - -(defun cider-repls (&optional type ensure) - "Return cider REPLs of TYPE from the current session. -If TYPE is nil or multi, return all REPLs. If TYPE is a list of types, -return only REPLs of type contained in the list. If ENSURE is non-nil, -throw an error if no linked session exists." - (let ((type (cond - ((listp type) - (mapcar #'cider-maybe-intern type)) - ((cider-maybe-intern type)))) - (repls (pcase cider-merge-sessions - ('host - (if ensure - (or (cider--extract-connections (cider--get-sessions-with-same-host - (sesman-current-session 'CIDER) - (sesman-current-sessions 'CIDER))) - (user-error "No linked %s sessions" 'CIDER)) - (cider--extract-connections (cider--get-sessions-with-same-host - (sesman-current-session 'CIDER) - (sesman-current-sessions 'CIDER))))) - ('project - (if ensure - (or (cider--extract-connections (sesman-current-sessions 'CIDER)) - (user-error "No linked %s sessions" 'CIDER)) - (cider--extract-connections (sesman-current-sessions 'CIDER)))) - (_ (cdr (if ensure - (sesman-ensure-session 'CIDER) - (sesman-current-session 'CIDER))))))) - (or (seq-filter (lambda (b) - (unless - (cider-cljs-pending-p b) - (cider--match-repl-type type b))) - repls) - (when ensure - (cider--no-repls-user-error type))))) - -(defun cider-map-repls (which function) - "Call FUNCTION once for each appropriate REPL as indicated by WHICH. -The function is called with one argument, the REPL buffer. The appropriate -connections are found by inspecting the current buffer. WHICH is one of -the following keywords: - :auto - Act on the connections whose type matches the current buffer. In - `cljc' files, mapping happens over both types of REPLs. - :clj (:cljs) - Map over clj (cljs)) REPLs only. - :clj-strict (:cljs-strict) - Map over clj (cljs) REPLs but signal a - `user-error' in `clojurescript-mode' (`clojure-mode'). Use this for - commands only supported in Clojure (ClojureScript). -Error is signaled if no REPL buffers of specified type exist in current -session." - (declare (indent 1)) - (let ((cur-type (cider-repl-type-for-buffer))) - (cl-case which - (:clj-strict (when (eq cur-type 'cljs) - (user-error "Clojure-only operation requested in a ClojureScript buffer"))) - (:cljs-strict (when (eq cur-type 'clj) - (user-error "ClojureScript-only operation requested in a Clojure buffer")))) - (let* ((type (cl-case which - ((:clj :clj-strict) 'clj) - ((:cljs :cljs-strict) 'cljs) - (:auto (if (eq cur-type 'multi) - '(clj cljs) - cur-type)))) - (ensure (cl-case which - (:auto nil) - (t 'ensure))) - (repls (cider-repls type ensure))) - (mapcar function repls)))) - -;; REPLs double as connections in CIDER, so it's useful to be able to refer to -;; them as connections in certain contexts. -(defalias 'cider-current-connection #'cider-current-repl) -(defalias 'cider-connections #'cider-repls) -(defalias 'cider-map-connections #'cider-map-repls) -(defalias 'cider-connection-type-for-buffer #'cider-repl-type-for-buffer) - -;; Deprecated after #2324 (introduction of sesman) - -(define-obsolete-function-alias 'cider-current-repl-buffer #'cider-current-repl "0.18") -(define-obsolete-function-alias 'cider-repl-buffers #'cider-repls "0.18") -(define-obsolete-function-alias 'cider-current-session #'cider-nrepl-eval-session "0.18") -(define-obsolete-function-alias 'cider-current-tooling-session #'cider-nrepl-tooling-session "0.18") -(define-obsolete-function-alias 'nrepl-connection-buffer-name #'nrepl-repl-buffer-name "0.18") - -(provide 'cider-connection) - -;;; cider-connection.el ends here diff --git a/elpa/cider-1.12.0/cider-debug.el b/elpa/cider-1.12.0/cider-debug.el @@ -1,796 +0,0 @@ -;;; cider-debug.el --- CIDER interaction with the cider.debug nREPL middleware -*- lexical-binding: t; -*- - -;; Copyright © 2015-2023 Bozhidar Batsov, Artur Malabarba and CIDER contributors - -;; Author: Artur Malabarba <bruce.connor.am@gmail.com> - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; Instrument code with `cider-debug-defun-at-point', and when the code is -;; executed cider-debug will kick in. See this function's doc for more -;; information. - -;;; Code: - -(require 'map) -(require 'seq) -(require 'subr-x) - -(require 'spinner) - -(require 'cider-browse-ns) -(require 'cider-client) -(require 'cider-eval) -(require 'cider-inspector) -(require 'cider-util) -(require 'cider-common) -(require 'nrepl-client) ; `nrepl--mark-id-completed' -(require 'nrepl-dict) - - -;;; Customization -(defgroup cider-debug nil - "Presentation and behavior of the cider debugger." - :prefix "cider-debug-" - :group 'cider - :package-version '(cider . "0.10.0")) - -(defface cider-debug-code-overlay-face - '((((class color) (background light)) :background "grey80") - (((class color) (background dark)) :background "grey30")) - "Face used to mark code being debugged." - :package-version '(cider . "0.9.1")) - -(defface cider-debug-prompt-face - '((t :underline t :inherit font-lock-builtin-face)) - "Face used to highlight keys in the debug prompt." - :package-version '(cider . "0.10.0")) - -(defface cider-enlightened-face - '((((class color) (background light)) :inherit cider-result-overlay-face - :box (:color "darkorange" :line-width -1)) - (((class color) (background dark)) :inherit cider-result-overlay-face - ;; "#dd0" is a dimmer yellow. - :box (:color "#990" :line-width -1))) - "Face used to mark enlightened sexps and their return values." - :package-version '(cider . "0.11.0")) - -(defface cider-enlightened-local-face - '((((class color) (background light)) :weight bold :foreground "darkorange") - (((class color) (background dark)) :weight bold :foreground "yellow")) - "Face used to mark enlightened locals (not their values)." - :package-version '(cider . "0.11.0")) - -(defcustom cider-debug-prompt 'overlay - "If and where to show the keys while debugging. -If `minibuffer', show it in the minibuffer along with the return value. -If `overlay', show it in an overlay above the current function. -If t, do both. -If nil, don't list available keys at all." - :type '(choice (const :tag "Show in minibuffer" minibuffer) - (const :tag "Show above function" overlay) - (const :tag "Show in both places" t) - (const :tag "Don't list keys" nil)) - :package-version '(cider . "0.10.0")) - -(defcustom cider-debug-use-overlays t - "Whether to highlight debugging information with overlays. -Takes the same possible values as `cider-use-overlays', but only applies to -values displayed during debugging sessions. -To control the overlay that lists possible keys above the current function, -configure `cider-debug-prompt' instead." - :type '(choice (const :tag "End of line" t) - (const :tag "Bottom of screen" nil) - (const :tag "Both" both)) - :package-version '(cider . "0.9.1")) - -(make-obsolete 'cider-debug-print-length 'cider-debug-print-options "0.20") -(make-obsolete 'cider-debug-print-level 'cider-debug-print-options "0.20") -(make-obsolete-variable 'cider-debug-print-options 'cider-print-options "0.21") - - -;;; Implementation -(declare-function cider-browse-ns--combined-vars-with-meta "cider-browse-ns") - -(defun cider-browse-instrumented-defs () - "List all instrumented definitions." - (interactive) - (if-let* ((all (thread-first (cider-nrepl-send-sync-request '("op" "debug-instrumented-defs")) - (nrepl-dict-get "list")))) - (with-current-buffer (cider-popup-buffer cider-browse-ns-buffer t) - (let ((inhibit-read-only t)) - (dolist (list all) - (let* ((ns (car list)) - (ns-vars-with-meta (cider-browse-ns--combined-vars-with-meta ns)) - (instrumented-meta (nrepl-dict-filter (lambda (k _) - (member k list)) - ns-vars-with-meta))) - (cider-browse-ns--list (current-buffer) ns - instrumented-meta - ns))))) - (message "No currently instrumented definitions"))) - -(defun cider--debug-response-handler (response) - "Handles RESPONSE from the cider.debug middleware." - (nrepl-dbind-response response (status id causes) - (when (member "enlighten" status) - (cider--handle-enlighten response)) - (when (or (member "eval-error" status) - (member "stack" status)) - ;; TODO: Make the error buffer a bit friendlier when we're just printing - ;; the stack. - (cider--render-stacktrace-causes causes)) - (when (member "need-debug-input" status) - (cider--handle-debug response)) - (when (member "done" status) - (nrepl--mark-id-completed id)))) - -(defun cider--debug-init-connection () - "Initialize a connection with the cider.debug middleware." - (cider-nrepl-send-request - (thread-last - (map-merge 'list - '(("op" "init-debugger")) - (cider--nrepl-print-request-map fill-column)) - (seq-mapcat #'identity)) - #'cider--debug-response-handler)) - - -;;; Debugging overlays -(defconst cider--fringe-arrow-string - #("." 0 1 (display (left-fringe right-triangle))) - "Used as an overlay's before-string prop to place a fringe arrow.") - -(defun cider--debug-display-result-overlay (value) - "Place an overlay at point displaying VALUE." - (when cider-debug-use-overlays - ;; This is cosmetic, let's ensure it doesn't break the session no matter what. - (ignore-errors - ;; Result - (cider--make-result-overlay (cider-font-lock-as-clojure value) - :where (point-marker) - :type 'debug-result - 'before-string cider--fringe-arrow-string) - ;; Code - (cider--make-overlay (save-excursion (clojure-backward-logical-sexp 1) (point)) - (point) 'debug-code - 'face 'cider-debug-code-overlay-face - ;; Higher priority than `show-paren'. - 'priority 2000)))) - - -;;; Minor mode -(defvar-local cider--debug-mode-response nil - "Response that triggered current debug session. -Set by `cider--turn-on-debug-mode'.") - -(defcustom cider-debug-display-locals nil - "If non-nil, local variables are displayed while debugging. -Can be toggled at any time with `\\[cider-debug-toggle-locals]'." - :type 'boolean - :package-version '(cider . "0.10.0")) - -(defcustom cider-debug-prompt-commands - '((?c "continue" "continue") - (?C "continue-all" nil) - (?n "next" "next") - (?i "in" "in") - (?o "out" "out") - (?O "force-out" nil) - (?h "here" "here") - (?e "eval" "eval") - (?p "inspect" "inspect") - (?P "inspect-prompt" nil) - (?l "locals" "locals") - (?j "inject" "inject") - (?s "stacktrace" "stacktrace") - (?t "trace" "trace") - (?q "quit" "quit")) - "A list of debugger command specs. - -Specs are in the format (KEY COMMAND-NAME DISPLAY-NAME?) where KEY is a -character which is mapped to the command COMMAND-NAME is a valid debug -command to be passed to the cider-nrepl middleware DISPLAY-NAME is the -string displayed in the debugger overlay - -If DISPLAY-NAME is nil, that command is hidden from the overlay but still -callable. The rest of the commands are displayed in the same order as this -list." - :type '(alist :key-type character - :value-type (list - (string :tag "command name") - (choice (string :tag "display name") nil))) - :package-version '(cider . "0.24.0")) - -(defun cider--debug-format-locals-list (locals) - "Return a string description of list LOCALS. -Each element of LOCALS should be a list of at least two elements." - (if locals - (let ((left-col-width - ;; To right-indent the variable names. - (apply #'max (mapcar (lambda (l) (string-width (car l))) locals)))) - ;; A format string to build a format string. :-P - (mapconcat (lambda (l) (format (format " %%%ds: %%s\n" left-col-width) - (propertize (car l) 'face 'font-lock-variable-name-face) - (cider-font-lock-as-clojure (cadr l)))) - locals "")) - "")) - -(defun cider--debug-propertize-prompt-commands () - "In-place format the command display names for the `cider-debug-prompt' overlay." - (mapc (lambda (spec) - (cl-destructuring-bind (char _cmd disp-name) spec - (when-let* ((pos (cl-position char disp-name))) - (put-text-property pos (1+ pos) 'face 'cider-debug-prompt-face disp-name)))) - cider-debug-prompt-commands)) - -(defun cider--debug-prompt (commands) - "Return prompt to display for COMMANDS." - ;; Force `default' face, otherwise the overlay "inherits" the face of the text - ;; after it. - (format (propertize "%s\n" 'face 'default) - (cl-reduce - (lambda (prompt spec) - (cl-destructuring-bind (_char cmd disp) spec - (if (and disp (cl-find cmd commands :test 'string=)) - (concat prompt " " disp) - prompt))) - cider-debug-prompt-commands - :initial-value ""))) - -(defvar-local cider--debug-prompt-overlay nil) - -(defun cider--debug-mode-redisplay () - "Display the input prompt to the user." - (nrepl-dbind-response cider--debug-mode-response (debug-value input-type locals) - ;; input-type is an unsorted collection of command names, - ;; as sent by `cider.nrepl.middleware.debug/read-debug-input` - (when (or (eq cider-debug-prompt t) - (eq cider-debug-prompt 'overlay)) - (if (overlayp cider--debug-prompt-overlay) - (overlay-put cider--debug-prompt-overlay - 'before-string (cider--debug-prompt input-type)) - (setq cider--debug-prompt-overlay - (cider--make-overlay - (max (car (cider-defun-at-point 'bounds)) - (window-start)) - nil 'debug-prompt - 'before-string (cider--debug-prompt input-type))))) - (let* ((value (concat " " cider-eval-result-prefix - (cider-font-lock-as-clojure - (or debug-value "#unknown#")))) - (to-display - (concat (when cider-debug-display-locals - (cider--debug-format-locals-list locals)) - (when (or (eq cider-debug-prompt t) - (eq cider-debug-prompt 'minibuffer)) - (cider--debug-prompt input-type)) - (when (or (not cider-debug-use-overlays) - (eq cider-debug-use-overlays 'both)) - value)))) - (if (> (string-width to-display) 0) - (message "%s" to-display) - ;; If there's nothing to display in the minibuffer. Just send the value - ;; to the Messages buffer. - (message "%s" value) - (message nil))))) - -(defun cider-debug-toggle-locals () - "Toggle display of local variables." - (interactive) - (setq cider-debug-display-locals (not cider-debug-display-locals)) - (cider--debug-mode-redisplay)) - -(defun cider--debug-lexical-eval (key form &optional callback _point) - "Eval FORM in the lexical context of debug session given by KEY. -Do nothing if CALLBACK is provided. -Designed to be used as `cider-interactive-eval-override' and called instead -of `cider-interactive-eval' in debug sessions." - ;; The debugger uses its own callback, so if the caller is passing a callback - ;; we return nil and let `cider-interactive-eval' do its thing. - (unless callback - (cider-debug-mode-send-reply (format "{:response :eval, :code %s}" form) - key) - t)) - -(defvar cider--debug-mode-tool-bar-map - (let ((tool-bar-map (make-sparse-keymap))) - (tool-bar-add-item "right-arrow" #'cider-debug-mode-send-reply :next :label "Next step") - (tool-bar-add-item "next-node" #'cider-debug-mode-send-reply :continue :label "Continue") - (tool-bar-add-item "jump-to" #'cider-debug-mode-send-reply :out :label "Out of sexp") - (tool-bar-add-item "exit" #'cider-debug-mode-send-reply :quit :label "Quit") - tool-bar-map)) - -(defvar cider--debug-mode-map - (let ((map (make-sparse-keymap))) - ;; Bind the `:here` command to both h and H, because it behaves differently - ;; if invoked with an uppercase letter. - (define-key map "h" #'cider-debug-move-here) - (define-key map "H" #'cider-debug-move-here) - (define-key map "L" #'cider-debug-toggle-locals) - map) - "The active keymap during a debugging session.") - -(define-minor-mode cider--debug-mode - "Mode active during debug sessions. -In order to work properly, this mode must be activated by -`cider--turn-on-debug-mode'." - :init-value nil :lighter " DEBUG" :keymap '() - (if cider--debug-mode - (if cider--debug-mode-response - (nrepl-dbind-response cider--debug-mode-response (input-type) - ;; A debug session is an ongoing eval, but it's annoying to have the - ;; spinner spinning while you debug. - (when spinner-current (spinner-stop)) - (setq-local tool-bar-map cider--debug-mode-tool-bar-map) - (add-hook 'kill-buffer-hook #'cider--debug-quit nil 'local) - (add-hook 'before-revert-hook #'cider--debug-quit nil 'local) - (unless (consp input-type) - (error "Activated debug-mode on a message not asking for commands: %s" cider--debug-mode-response)) - ;; Integrate with eval commands. - (setq cider-interactive-eval-override - (apply-partially #'cider--debug-lexical-eval - (nrepl-dict-get cider--debug-mode-response "key"))) - ;; Map over the key->command alist and set the keymap - (mapc - (lambda (p) - (let ((char (car p))) - (unless (= char ?h) ; `here' needs a special command. - (define-key cider--debug-mode-map (string char) #'cider-debug-mode-send-reply)) - (when (= char ?o) - (define-key cider--debug-mode-map (string (upcase ?o)) #'cider-debug-mode-send-reply)))) - cider-debug-prompt-commands) - (cider--debug-propertize-prompt-commands) - ;; Show the prompt. - (cider--debug-mode-redisplay) - ;; If a sync request is ongoing, the user can't act normally to - ;; provide input, so we enter `recursive-edit'. - (when nrepl-ongoing-sync-request - (recursive-edit))) - (cider--debug-mode -1) - (if (called-interactively-p 'any) - (user-error (substitute-command-keys "Don't call this mode manually, use `\\[universal-argument] \\[cider-eval-defun-at-point]' instead")) - (error "Attempt to activate `cider--debug-mode' without setting `cider--debug-mode-response' first"))) - (setq cider-interactive-eval-override nil) - (setq cider--debug-mode-response nil) - ;; We wait a moment before clearing overlays and the read-onlyness, so that - ;; cider-nrepl has a chance to send the next message, and so that the user - ;; doesn't accidentally hit `n' between two messages (thus editing the code). - (when-let* ((proc (unless nrepl-ongoing-sync-request - (get-buffer-process (cider-current-repl))))) - (accept-process-output proc 1)) - (unless cider--debug-mode - (setq buffer-read-only nil) - (cider--debug-remove-overlays (current-buffer))) - (when nrepl-ongoing-sync-request - (ignore-errors (exit-recursive-edit))))) - -(defun cider--debug-remove-overlays (&optional buffer) - "Remove CIDER debug overlays from BUFFER if variable `cider--debug-mode' is nil." - (when (or (not buffer) (buffer-live-p buffer)) - (with-current-buffer (or buffer (current-buffer)) - (unless cider--debug-mode - (kill-local-variable 'tool-bar-map) - (remove-overlays nil nil 'category 'debug-result) - (remove-overlays nil nil 'category 'debug-code) - (setq cider--debug-prompt-overlay nil) - (remove-overlays nil nil 'category 'debug-prompt))))) - -(defun cider--debug-set-prompt (value) - "Set `cider-debug-prompt' to VALUE, then redisplay." - (setq cider-debug-prompt value) - (cider--debug-mode-redisplay)) - -(easy-menu-define cider-debug-mode-menu cider--debug-mode-map - "Menu for CIDER debug mode." - `("CIDER Debugger" - ["Next step" (cider-debug-mode-send-reply ":next") :keys "n"] - ["Continue" (cider-debug-mode-send-reply ":continue") :keys "c"] - ["Continue non-stop" (cider-debug-mode-send-reply ":continue-all") :keys "C"] - ["Move out of sexp" (cider-debug-mode-send-reply ":out") :keys "o"] - ["Forced move out of sexp" (cider-debug-mode-send-reply ":out" nil true) :keys "O"] - ["Move to current position" (cider-debug-mode-send-reply ":here") :keys "h"] - ["Quit" (cider-debug-mode-send-reply ":quit") :keys "q"] - "--" - ["Evaluate in current scope" (cider-debug-mode-send-reply ":eval") :keys "e"] - ["Inject value" (cider-debug-mode-send-reply ":inject") :keys "i"] - ["Inspect current value" (cider-debug-mode-send-reply ":inspect") :keys "p"] - ["Inspect expression" (cider-debug-mode-send-reply ":inspect-prompt") :keys "P"] - ["Inspect local variables" (cider-debug-mode-send-reply ":locals") :keys "l"] - "--" - ("Configure keys prompt" - ["Don't show keys" (cider--debug-set-prompt nil) :style toggle :selected (eq cider-debug-prompt nil)] - ["Show in minibuffer" (cider--debug-set-prompt 'minibuffer) :style toggle :selected (eq cider-debug-prompt 'minibuffer)] - ["Show above function" (cider--debug-set-prompt 'overlay) :style toggle :selected (eq cider-debug-prompt 'overlay)] - ["Show in both places" (cider--debug-set-prompt t) :style toggle :selected (eq cider-debug-prompt t)] - "--" - ["List locals" cider-debug-toggle-locals :style toggle :selected cider-debug-display-locals]) - ["Customize" (customize-group 'cider-debug)])) - -(defun cider--uppercase-command-p () - "Return non-nil if the last command was uppercase letter." - (ignore-errors - (let ((case-fold-search nil)) - (string-match "[[:upper:]]" (string last-command-event))))) - -(defun cider-debug-mode-send-reply (command &optional key force) - "Reply to the message that started current bufer's debugging session. -COMMAND is sent as the input option. KEY can be provided to reply to a -specific message. If FORCE is non-nil, send a \"force?\" argument in the -message." - (interactive (list - (if (symbolp last-command-event) - (symbol-name last-command-event) - (ignore-errors - (concat ":" (cadr (assoc last-command-event cider-debug-prompt-commands))))) - nil - (cider--uppercase-command-p))) - (when (and (string-prefix-p ":" command) force) - (setq command (format "{:response %s :force? true}" command))) - (cider-nrepl-send-unhandled-request - `("op" "debug-input" - "input" ,(or command ":quit") - "key" ,(or key (nrepl-dict-get cider--debug-mode-response "key")))) - (ignore-errors (cider--debug-mode -1))) - -(defun cider--debug-quit () - "Send a :quit reply to the debugger. Used in hooks." - (when cider--debug-mode - (cider-debug-mode-send-reply ":quit") - (message "Quitting debug session"))) - - -;;; Movement logic -(defconst cider--debug-buffer-format "*cider-debug %s*") - -(defun cider--debug-trim-code (code) - "Remove whitespace and reader macros from the start of the CODE. -Return trimmed CODE." - (replace-regexp-in-string "\\`#[a-z]+[\n\r[:blank:]]*" "" code)) - -(declare-function cider-set-buffer-ns "cider-mode") -(defun cider--initialize-debug-buffer (code ns id &optional reason) - "Create a new debugging buffer with CODE and namespace NS. -ID is the id of the message that instrumented CODE. -REASON is a keyword describing why this buffer was necessary." - (let ((buffer-name (format cider--debug-buffer-format id))) - (if-let* ((buffer (get-buffer buffer-name))) - (cider-popup-buffer-display buffer 'select) - (with-current-buffer (cider-popup-buffer buffer-name 'select - #'clojure-mode 'ancillary) - (cider-set-buffer-ns ns) - (setq buffer-undo-list nil) - (let ((inhibit-read-only t) - (buffer-undo-list t)) - (erase-buffer) - (insert (format "%s" (cider--debug-trim-code code))) - (when code - (insert "\n\n\n;; We had to create this temporary buffer because we couldn't find the original definition. That probably happened because " - reason - ".") - (fill-paragraph)) - (font-lock-ensure) - (set-buffer-modified-p nil)))) - (switch-to-buffer buffer-name) - (goto-char (point-min)))) - -(defun cider--debug-goto-keyval (key) - "Find KEY in current sexp or return nil." - (when-let* ((limit (ignore-errors (save-excursion (up-list) (point))))) - (search-forward-regexp (concat "\\_<" (regexp-quote key) "\\_>") - limit 'noerror))) - -(defun cider--debug-skip-ignored-forms () - "Skip past all forms ignored with #_ reader macro." - ;; Logic taken from `clojure--search-comment-macro-internal' - (while (looking-at (concat "[ ,\r\t\n]*" clojure--comment-macro-regexp)) - (let ((md (match-data)) - (start (match-beginning 1))) - (goto-char start) - ;; Count how many #_ we got and step by that many sexps - (clojure-forward-logical-sexp - (count-matches (rx "#_") (elt md 0) (elt md 1)))))) - -(defun cider--debug-move-point (coordinates) - "Place point on after the sexp specified by COORDINATES. -COORDINATES is a list of integers that specify how to navigate into the -sexp that is after point when this function is called. - -As an example, a COORDINATES list of '(1 0 2) means: - - enter next sexp then `forward-sexp' once, - - enter next sexp, - - enter next sexp then `forward-sexp' twice. - -In the following snippet, this takes us to the (* x 2) sexp (point is left -at the end of the given sexp). - - (letfn [(twice [x] - (* x 2))] - (twice 15)) - -In addition to numbers, a coordinate can be a string. This string names the -key of a map, and it means \"go to the value associated with this key\"." - (condition-case-unless-debug nil - ;; Navigate through sexps inside the sexp. - (let ((in-syntax-quote nil)) - (while coordinates - (while (clojure--looking-at-non-logical-sexp) - (forward-sexp)) - ;; An `@x` is read as (deref x), so we pop coordinates once to account - ;; for the extra depth, and move past the @ char. - (if (eq ?@ (char-after)) - (progn (forward-char 1) - (pop coordinates)) - (down-list) - ;; Are we entering a syntax-quote? - (when (looking-back "`\\(#{\\|[{[(]\\)" (line-beginning-position)) - ;; If we are, this affects all nested structures until the next `~', - ;; so we set this variable for all following steps in the loop. - (setq in-syntax-quote t)) - (when in-syntax-quote - ;; A `(. .) is read as (seq (concat (list .) (list .))). This pops - ;; the `seq', since the real coordinates are inside the `concat'. - (pop coordinates) - ;; Non-list seqs like `[] and `{} are read with - ;; an extra (apply vector ...), so pop it too. - (unless (eq ?\( (char-before)) - (pop coordinates))) - ;; #(...) is read as (fn* ([] ...)), so we patch that here. - (when (looking-back "#(" (line-beginning-position)) - (pop coordinates)) - (if coordinates - (let ((next (pop coordinates))) - (when in-syntax-quote - ;; We're inside the `concat' form, but we need to discard the - ;; actual `concat' symbol from the coordinate. - (setq next (1- next))) - ;; String coordinates are map keys. - (if (stringp next) - (cider--debug-goto-keyval next) - (clojure-forward-logical-sexp next) - (when in-syntax-quote - (clojure-forward-logical-sexp 1) - (forward-sexp -1) - ;; Here a syntax-quote is ending. - (let ((match (when (looking-at "~@?") - (match-string 0)))) - (when match - (setq in-syntax-quote nil)) - ;; A `~@' is read as the object itself, so we don't pop - ;; anything. - (unless (equal "~@" match) - ;; Anything else (including a `~') is read as a `list' - ;; form inside the `concat', so we need to pop the list - ;; from the coordinates. - (pop coordinates)))))) - ;; If that extra pop was the last coordinate, this represents the - ;; entire #(...), so we should move back out. - (backward-up-list))) - ;; Finally skip past all #_ forms - (cider--debug-skip-ignored-forms)) - ;; Place point at the end of instrumented sexp. - (clojure-forward-logical-sexp 1)) - ;; Avoid throwing actual errors, since this happens on every breakpoint. - (error (message "Can't find instrumented sexp, did you edit the source?")))) - -(defun cider--debug-position-for-code (code) - "Return non-nil if point is roughly before CODE. -This might move point one line above." - (or (looking-at-p (regexp-quote code)) - (let ((trimmed (regexp-quote (cider--debug-trim-code code)))) - (or (looking-at-p trimmed) - ;; If this is a fake #dbg injected by `C-u - ;; C-M-x', then the sexp we want is actually on - ;; the line above. - (progn (forward-line -1) - (looking-at-p trimmed)))))) - -(defun cider--debug-find-source-position (response &optional create-if-needed) - "Return a marker of the position after the sexp specified in RESPONSE. -This marker might be in a different buffer! If the sexp can't be -found (file that contains the code is no longer visited or has been -edited), return nil. However, if CREATE-IF-NEEDED is non-nil, a new buffer -is created in this situation and the return value is never nil. - -Follow the \"line\" and \"column\" entries in RESPONSE, and check whether -the code at point matches the \"code\" entry in RESPONSE. If it doesn't, -assume that the code in this file has been edited, and create a temp buffer -holding the original code. -Either way, navigate inside the code by following the \"coor\" entry which -is a coordinate measure in sexps." - (nrepl-dbind-response response (code file line column ns original-id coor) - (when (or code (and file line column)) - ;; This is for restoring current-buffer. - (save-excursion - (let ((out)) - ;; We prefer in-source debugging. - (when-let* ((buf (and file line column - (ignore-errors - (cider--find-buffer-for-file file))))) - ;; The logic here makes it hard to use `with-current-buffer'. - (with-current-buffer buf - ;; This is for restoring point inside buf. - (save-excursion - ;; Get to the proper line & column in the file - (forward-line (- line (line-number-at-pos))) - ;; Column numbers in the response start from 1. - ;; Convert to Emacs system which starts from 0 - ;; Inverse of `cider-column-number-at-pos'. - (move-to-column (max 0 (1- column))) - ;; Check if it worked - (when (cider--debug-position-for-code code) - ;; Find the desired sexp. - (cider--debug-move-point coor) - (setq out (point-marker)))))) - ;; But we can create a temp buffer if that fails. - (or out - (when create-if-needed - (cider--initialize-debug-buffer - code ns original-id - (if (and line column) - "you edited the code" - "your nREPL version is older than 0.2.11")) - (save-excursion - (cider--debug-move-point coor) - (point-marker))))))))) - -(defun cider--handle-debug (response) - "Handle debugging notification. -RESPONSE is a message received from the nrepl describing the input -needed. It is expected to contain at least \"key\", \"input-type\", and -\"prompt\", and possibly other entries depending on the input-type." - (nrepl-dbind-response response (debug-value key input-type prompt inspect) - (condition-case-unless-debug e - (progn - (pcase input-type - ("expression" (cider-debug-mode-send-reply - (condition-case nil - (cider-read-from-minibuffer - (or prompt "Expression: ")) - (quit "nil")) - key)) - ((pred sequencep) - (let* ((marker (cider--debug-find-source-position response 'create-if-needed))) - (pop-to-buffer (marker-buffer marker)) - (goto-char marker)) - ;; The overlay code relies on window boundaries, but point could have been - ;; moved outside the window by some other code. Redisplay here to ensure the - ;; visible window includes point. - (redisplay) - ;; Remove overlays AFTER redisplaying! Otherwise there's a visible - ;; flicker even if we immediately recreate the overlays. - (cider--debug-remove-overlays) - (when cider-debug-use-overlays - (cider--debug-display-result-overlay debug-value)) - (setq cider--debug-mode-response response) - (cider--debug-mode 1))) - (when inspect - (setq cider-inspector--current-repl (cider-current-repl)) - (cider-inspector--render-value inspect))) - ;; If something goes wrong, we send a "quit" or the session hangs. - (error (cider-debug-mode-send-reply ":quit" key) - (message "Error encountered while handling the debug message: %S" e))))) - -(defun cider--handle-enlighten (response) - "Handle an enlighten notification. -RESPONSE is a message received from the nrepl describing the value and -coordinates of a sexp. Create an overlay after the specified sexp -displaying its value." - (when-let* ((marker (cider--debug-find-source-position response))) - (with-current-buffer (marker-buffer marker) - (save-excursion - (goto-char marker) - (clojure-backward-logical-sexp 1) - (nrepl-dbind-response response (debug-value erase-previous) - (when erase-previous - (remove-overlays (point) marker 'category 'enlighten)) - (when debug-value - (if (memq (char-before marker) '(?\) ?\] ?})) - ;; Enlightening a sexp looks like a regular return value, except - ;; for a different border. - (cider--make-result-overlay (cider-font-lock-as-clojure debug-value) - :where (cons marker marker) - :type 'enlighten - :prepend-face 'cider-enlightened-face) - ;; Enlightening a symbol uses a more abbreviated format. The - ;; result face is the same as a regular result, but we also color - ;; the symbol with `cider-enlightened-local-face'. - (cider--make-result-overlay (cider-font-lock-as-clojure debug-value) - :format "%s" - :where (cons (point) marker) - :type 'enlighten - 'face 'cider-enlightened-local-face)))))))) - - -;;; Move here command -;; This is the inverse of `cider--debug-move-point'. However, that algorithm is -;; complicated, and trying to code its inverse would probably be insane. -;; Instead, we find the coordinate by trial and error. -(defun cider--debug-find-coordinates-for-point (target &optional list-so-far) - "Return the coordinates list for reaching TARGET. -Assumes that the next thing after point is a logical Clojure sexp and that -TARGET is inside it. The returned list is suitable for use in -`cider--debug-move-point'. LIST-SO-FAR is for internal use." - (when (looking-at (rx (or "(" "[" "#{" "{"))) - (let ((starting-point (point))) - (unwind-protect - (let ((x 0)) - ;; Keep incrementing the last coordinate until we've moved - ;; past TARGET. - (while (condition-case nil - (progn (goto-char starting-point) - (cider--debug-move-point (append list-so-far (list x))) - (< (point) target)) - ;; Not a valid coordinate. Move back a step and stop here. - (scan-error (setq x (1- x)) - nil)) - (setq x (1+ x))) - (setq list-so-far (append list-so-far (list x))) - ;; We have moved past TARGET, now determine whether we should - ;; stop, or if target is deeper inside the previous sexp. - (if (or (= target (point)) - (progn (forward-sexp -1) - (<= target (point)))) - list-so-far - (goto-char starting-point) - (cider--debug-find-coordinates-for-point target list-so-far))) - ;; `unwind-protect' clause. - (goto-char starting-point))))) - -(defun cider-debug-move-here (&optional force) - "Skip any breakpoints up to point. -The boolean value of FORCE will be sent in the reply." - (interactive (list (cider--uppercase-command-p))) - (unless cider--debug-mode - (user-error "`cider-debug-move-here' only makes sense during a debug session")) - (let ((here (point))) - (nrepl-dbind-response cider--debug-mode-response (line column) - (if (and line column (buffer-file-name)) - (progn ;; Get to the proper line & column in the file - (forward-line (1- (- line (line-number-at-pos)))) - (move-to-column column)) - (beginning-of-defun-raw)) - ;; Is HERE inside the sexp being debugged? - (when (or (< here (point)) - (save-excursion - (forward-sexp 1) - (> here (point)))) - (user-error "Point is outside the sexp being debugged")) - ;; Move forward until start of sexp. - (comment-normalize-vars t) - (comment-forward (point-max)) - ;; Find the coordinate and send it. - (cider-debug-mode-send-reply - (format "{:response :here, :coord %s :force? %s}" - (cider--debug-find-coordinates-for-point here) - (if force "true" "false")))))) - - -;;; User commands -;;;###autoload -(defun cider-debug-defun-at-point () - "Instrument the \"top-level\" expression at point. -If it is a defn, dispatch the instrumented definition. Otherwise, -immediately evaluate the instrumented expression. - -While debugged code is being evaluated, the user is taken through the -source code and displayed the value of various expressions. At each step, -a number of keys will be prompted to the user." - (interactive) - (cider-eval-defun-at-point 'debug-it)) - -(provide 'cider-debug) -;;; cider-debug.el ends here diff --git a/elpa/cider-1.12.0/cider-doc.el b/elpa/cider-1.12.0/cider-doc.el @@ -1,582 +0,0 @@ -;;; cider-doc.el --- CIDER documentation functionality -*- lexical-binding: t -*- - -;; Copyright © 2014-2023 Bozhidar Batsov, Jeff Valk and CIDER contributors - -;; Author: Jeff Valk <jv@jeffvalk.com> - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Mode for formatting and presenting documentation - -;;; Code: - -(require 'cider-common) -(require 'cider-docstring) -(require 'subr-x) -(require 'cider-util) -(require 'cider-popup) -(require 'cider-client) -(require 'cider-clojuredocs) -(require 'nrepl-dict) -(require 'button) -(require 'easymenu) -(require 'cider-browse-spec) - -;; we defer loading those, as org-table is a big library -(declare-function org-table-map-tables "org-table") -(declare-function org-table-align "org-table") -(declare-function org-table-begin "org-table") -(declare-function org-table-end "org-table") - - -;;; Variables - -(defgroup cider-doc nil - "Documentation for CIDER." - :prefix "cider-doc-" - :group 'cider) - -(defcustom cider-doc-auto-select-buffer t - "Controls whether to auto-select the doc popup buffer." - :type 'boolean - :group 'cider-doc - :package-version '(cider . "0.15.0")) - -(declare-function cider-apropos "cider-apropos") -(declare-function cider-apropos-select "cider-apropos") -(declare-function cider-apropos-documentation "cider-apropos") -(declare-function cider-apropos-documentation-select "cider-apropos") - -(defvar cider-doc-map - (let (cider-doc-map) - (define-prefix-command 'cider-doc-map) - (define-key cider-doc-map (kbd "a") #'cider-apropos) - (define-key cider-doc-map (kbd "C-a") #'cider-apropos) - (define-key cider-doc-map (kbd "s") #'cider-apropos-select) - (define-key cider-doc-map (kbd "C-s") #'cider-apropos-select) - (define-key cider-doc-map (kbd "f") #'cider-apropos-documentation) - (define-key cider-doc-map (kbd "C-f") #'cider-apropos-documentation) - (define-key cider-doc-map (kbd "e") #'cider-apropos-documentation-select) - (define-key cider-doc-map (kbd "C-e") #'cider-apropos-documentation-select) - (define-key cider-doc-map (kbd "d") #'cider-doc) - (define-key cider-doc-map (kbd "C-d") #'cider-doc) - (define-key cider-doc-map (kbd "c") #'cider-clojuredocs) - (define-key cider-doc-map (kbd "C-c") #'cider-clojuredocs) - (define-key cider-doc-map (kbd "w") #'cider-clojuredocs-web) - (define-key cider-doc-map (kbd "C-w") #'cider-clojuredocs-web) - (define-key cider-doc-map (kbd "j") #'cider-javadoc) - (define-key cider-doc-map (kbd "C-j") #'cider-javadoc) - cider-doc-map) - "CIDER documentation keymap.") - -(defconst cider-doc-menu - '("Documentation" - ["CiderDoc" cider-doc] - ["JavaDoc in browser" cider-javadoc] - "--" - ["Clojuredocs" cider-clojuredocs] - ["Clojuredocs in browser" cider-clojuredocs-web] - ["Refresh ClojureDocs cache" cider-clojuredocs-refresh-cache] - "--" - ["Search symbols" cider-apropos] - ["Search symbols & select" cider-apropos-select] - ["Search documentation" cider-apropos-documentation] - ["Search documentation & select" cider-apropos-documentation-select] - "--" - ["Configure Doc buffer" (customize-group 'cider-docview-mode)]) - "CIDER documentation submenu.") - - -;;; cider-docview-mode - -(defgroup cider-docview-mode nil - "Formatting/fontifying documentation viewer." - :prefix "cider-docview-" - :group 'cider) - -(defcustom cider-docview-fill-column fill-column - "Fill column for docstrings in doc buffer." - :type 'list - :group 'cider-docview-mode - :package-version '(cider . "0.7.0")) - - -;; Faces - -(defface cider-docview-emphasis-face - '((t (:inherit default :underline t))) - "Face for emphasized text." - :group 'cider-docview-mode - :package-version '(cider . "0.7.0")) - -(defface cider-docview-strong-face - '((t (:inherit default :underline t :weight bold))) - "Face for strongly emphasized text." - :group 'cider-docview-mode - :package-version '(cider . "0.7.0")) - -(defface cider-docview-literal-face - '((t (:inherit font-lock-string-face))) - "Face for literal text." - :group 'cider-docview-mode - :package-version '(cider . "0.7.0")) - -(defface cider-docview-table-border-face - '((t (:inherit shadow))) - "Face for table borders." - :group 'cider-docview-mode - :package-version '(cider . "0.7.0")) - - -;; Colors & Theme Support - -(defvar cider-docview-code-background-color - (cider-scale-background-color) - "Background color for code blocks.") - -(advice-add 'enable-theme :after #'cider--docview-adapt-to-theme) -(advice-add 'disable-theme :after #'cider--docview-adapt-to-theme) -(defun cider--docview-adapt-to-theme (&rest _) - "When theme is changed, update `cider-docview-code-background-color'." - (setq cider-docview-code-background-color (cider-scale-background-color))) - -;; Mode & key bindings - -(defvar cider-docview-mode-map - (let ((map (make-sparse-keymap))) - (define-key map "q" #'cider-popup-buffer-quit-function) - (define-key map "g" #'cider-docview-clojuredocs) - (define-key map "G" #'cider-docview-clojuredocs-web) - (define-key map "j" #'cider-docview-javadoc) - (define-key map "s" #'cider-docview-source) - (define-key map (kbd "<backtab>") #'backward-button) - (define-key map (kbd "TAB") #'forward-button) - (easy-menu-define cider-docview-mode-menu map - "Menu for CIDER's doc mode" - `("CiderDoc" - ["Look up in Clojuredocs" cider-docview-clojuredocs] - ["Look up in Clojuredocs (browser)" cider-docview-clojuredocs-web] - ["JavaDoc in browser" cider-docview-javadoc] - ["Jump to source" cider-docview-source] - "--" - ["Quit" cider-popup-buffer-quit-function] - )) - map)) - -(defvar cider-docview-symbol) -(defvar cider-docview-javadoc-url) -(defvar cider-docview-file) -(defvar cider-docview-line) - -(define-derived-mode cider-docview-mode help-mode "Doc" - "Major mode for displaying CIDER documentation. - -\\{cider-docview-mode-map}" - (setq buffer-read-only t) - (setq-local sesman-system 'CIDER) - (when cider-special-mode-truncate-lines - (setq-local truncate-lines t)) - (setq-local electric-indent-chars nil) - (setq-local cider-docview-symbol nil) - (setq-local cider-docview-javadoc-url nil) - (setq-local cider-docview-file nil) - (setq-local cider-docview-line nil)) - - -;;; Interactive functions - -(defun cider-docview-javadoc () - "Open the Javadoc for the current class, if available." - (interactive) - (if cider-docview-javadoc-url - (browse-url cider-docview-javadoc-url) - (error "No Javadoc available for %s" cider-docview-symbol))) - -(defun cider-javadoc-handler (symbol-name) - "Invoke the nREPL \"info\" op on SYMBOL-NAME if available." - (when symbol-name - (let* ((info (cider-var-info symbol-name)) - (url (nrepl-dict-get info "javadoc"))) - (if url - (browse-url url) - (user-error "No Javadoc available for %s" symbol-name))))) - -(defun cider-javadoc (arg) - "Open Javadoc documentation in a popup buffer. - -Prompts for the symbol to use, or uses the symbol at point, depending on -the value of `cider-prompt-for-symbol'. With prefix arg ARG, does the -opposite of what that option dictates." - (interactive "P") - (cider-ensure-connected) - (cider-ensure-op-supported "info") - (funcall (cider-prompt-for-symbol-function arg) - "Javadoc for" - #'cider-javadoc-handler)) - -(defun cider-docview-source () - "Open the source for the current symbol, if available." - (interactive) - (if cider-docview-file - (if-let* ((buffer (and (not (cider--tooling-file-p cider-docview-file)) - (cider-find-file cider-docview-file)))) - (cider-jump-to buffer (if cider-docview-line - (cons cider-docview-line nil) - cider-docview-symbol) - nil) - (user-error - (substitute-command-keys - "Can't find the source because it wasn't defined with `cider-eval-buffer'"))) - (error "No source location for %s" cider-docview-symbol))) - -(defvar cider-buffer-ns) - -(declare-function cider-clojuredocs-lookup "cider-clojuredocs") - -(defun cider-docview-clojuredocs () - "Return the clojuredocs documentation for `cider-docview-symbol'." - (interactive) - (if cider-buffer-ns - (cider-clojuredocs-lookup cider-docview-symbol) - (error "%s cannot be looked up on ClojureDocs" cider-docview-symbol))) - -(declare-function cider-clojuredocs-web-lookup "cider-clojuredocs") - -(defun cider-docview-clojuredocs-web () - "Open the clojuredocs documentation for `cider-docview-symbol' in a web browser." - (interactive) - (if cider-buffer-ns - (cider-clojuredocs-web-lookup cider-docview-symbol) - (error "%s cannot be looked up on ClojureDocs" cider-docview-symbol))) - -(defconst cider-doc-buffer "*cider-doc*") - -(defun cider-create-doc-buffer (symbol &optional compact) - "Populates *cider-doc* with the documentation for SYMBOL, -favoring a COMPACT format if specified." - (when-let* ((info (cider-var-info symbol))) - (cider-docview-render (cider-make-popup-buffer cider-doc-buffer nil 'ancillary) symbol info compact))) - -(defun cider-create-compact-doc-buffer (symbol) - "Populates *cider-doc* with the documentation for SYMBOL. - -Favors a compact rendering of docstrings" - (cider-create-doc-buffer symbol :compact)) - -(defun cider-doc-lookup (symbol) - "Look up documentation for SYMBOL." - (if-let* ((buffer (cider-create-doc-buffer symbol))) - (cider-popup-buffer-display buffer cider-doc-auto-select-buffer) - (user-error "Symbol %s not resolved" symbol))) - -(defun cider-doc (&optional arg) - "Open Clojure documentation in a popup buffer. - -Prompts for the symbol to use, or uses the symbol at point, depending on -the value of `cider-prompt-for-symbol'. With prefix arg ARG, does the -opposite of what that option dictates." - (interactive "P") - (cider-ensure-connected) - (funcall (cider-prompt-for-symbol-function arg) - "Doc for" - #'cider-doc-lookup)) - - -;;; Font Lock and Formatting - -(defun cider-docview-fontify-code-blocks (buffer mode) - "Font lock BUFFER code blocks using MODE and remove markdown characters. -This processes the triple backtick GFM markdown extension. An overlay is used -to shade the background. Blocks are marked to be ignored by other fonification -and line wrap." - (with-current-buffer buffer - (save-excursion - (while (search-forward-regexp "```\n" nil t) - (replace-match "") - (let ((beg (point)) - (bg `(:background ,cider-docview-code-background-color))) - (when (search-forward-regexp "```\n" nil t) - (replace-match "") - (cider-font-lock-region-as mode beg (point)) - (overlay-put (make-overlay beg (point)) 'font-lock-face bg) - (put-text-property beg (point) 'block 'code))))))) - -(defun cider-docview-fontify-literals (buffer) - "Font lock BUFFER literal text and remove backtick markdown characters. -Preformatted code text blocks are ignored." - (with-current-buffer buffer - (save-excursion - (while (search-forward "`" nil t) - (if (eq (get-text-property (point) 'block) 'code) - (forward-char) - (progn - (replace-match "") - (let ((beg (point))) - (when (search-forward "`" (line-end-position) t) - (replace-match "") - (put-text-property beg (point) 'font-lock-face 'cider-docview-literal-face))))))))) - -(defun cider-docview-fontify-emphasis (buffer) - "Font lock BUFFER emphasized text and remove markdown characters. -One '*' represents emphasis, multiple '**'s represent strong emphasis. -Preformatted code text blocks are ignored." - (with-current-buffer buffer - (save-excursion - (while (search-forward-regexp "\\(*+\\)\\(\\w\\)" nil t) - (if (eq (get-text-property (point) 'block) 'code) - (forward-char) - (progn - (replace-match "\\2") - (let ((beg (1- (point))) - (face (if (> (length (match-string 1)) 1) - 'cider-docview-strong-face - 'cider-docview-emphasis-face))) - (when (search-forward-regexp "\\(\\w\\)\\*+" (line-end-position) t) - (replace-match "\\1") - (put-text-property beg (point) 'font-lock-face face))))))))) - -(defun cider-docview-format-tables (buffer) - "Align BUFFER tables and dim borders. -This processes the GFM table markdown extension using `org-table'. -Tables are marked to be ignored by line wrap." - (require 'org-table) - (with-current-buffer buffer - (save-excursion - (let ((border 'cider-docview-table-border-face)) - (org-table-map-tables - (lambda () - (org-table-align) - (goto-char (org-table-begin)) - (while (search-forward-regexp "[+|-]" (org-table-end) t) - (put-text-property (match-beginning 0) (match-end 0) 'font-lock-face border)) - (put-text-property (org-table-begin) (org-table-end) 'block 'table))))))) - -(defun cider-docview-wrap-text (buffer) - "For text in BUFFER not propertized as 'block', apply line wrap." - (with-current-buffer buffer - (save-excursion - (while (not (eobp)) - (unless (get-text-property (point) 'block) - (fill-region (point) (line-end-position))) - (forward-line))))) - - -;;; Rendering - -(defun cider-docview-render-java-doc (buffer text) - "Emit into BUFFER formatted doc TEXT for a Java class or member." - (with-current-buffer buffer - (let ((beg (point))) - (insert text) - (save-excursion - (goto-char beg) - (cider-docview-fontify-code-blocks buffer 'java-mode) ; left alone hereafter - (cider-docview-fontify-literals buffer) - (cider-docview-fontify-emphasis buffer) - (cider-docview-format-tables buffer) ; may contain literals, emphasis - (cider-docview-wrap-text buffer))))) ; ignores code, table blocks - -(defun cider--abbreviate-file-protocol (file-with-protocol) - "Abbreviate the file-path in `file:/path/to/file' of FILE-WITH-PROTOCOL. - -Same for `jar:file:...!/' segments." - (let ((result (if (string-match "^\\(jar\\|zip\\):\\(file:.+\\)!/\\(.+\\)" file-with-protocol) - (match-string 3 file-with-protocol) - file-with-protocol))) - (if (string-match "\\`file:\\(.*\\)" result) - (let ((file (match-string 1 result)) - (proj-dir (clojure-project-dir))) - (if (and proj-dir - (file-in-directory-p file proj-dir)) - (file-relative-name file proj-dir) - file)) - result))) - -(defun cider-docview-render-info (buffer info &optional compact for-tooltip) - "Emit into BUFFER formatted INFO for the Clojure or Java symbol, -in a COMPACT format is specified, FOR-TOOLTIP if specified." - (let* ((ns (nrepl-dict-get info "ns")) - (name (nrepl-dict-get info "name")) - (added (nrepl-dict-get info "added")) - (depr (nrepl-dict-get info "deprecated")) - (macro (nrepl-dict-get info "macro")) - (special (nrepl-dict-get info "special-form")) - (builtin (nrepl-dict-get info "built-in")) ;; babashka specific - (forms (when-let* ((str (nrepl-dict-get info "forms-str"))) - (split-string str "\n"))) - (args (or (nrepl-dict-get info "annotated-arglists") - (when-let* ((str (nrepl-dict-get info "arglists-str"))) - (split-string str "\n")))) - (rendered-fragments (cider--render-docstring (list "doc-fragments" (unless compact - (nrepl-dict-get info "doc-fragments")) - "doc-block-tags-fragments" (nrepl-dict-get info "doc-block-tags-fragments") - "doc-first-sentence-fragments" (nrepl-dict-get info "doc-first-sentence-fragments")))) - (fetched-doc (nrepl-dict-get info "doc")) - (doc (or rendered-fragments - (if compact - (cider-docstring--dumb-trim fetched-doc) - fetched-doc) - (unless compact - "Not documented."))) - (url (nrepl-dict-get info "url")) - (class (nrepl-dict-get info "class")) - (member (nrepl-dict-get info "member")) - (javadoc (nrepl-dict-get info "javadoc")) - (super (nrepl-dict-get info "super")) - (ifaces (nrepl-dict-get info "interfaces")) - (spec (nrepl-dict-get info "spec")) - (clj-name (if ns (concat ns "/" name) name)) - (java-name (if member (concat class "/" member) class)) - (see-also (nrepl-dict-get info "see-also"))) - (cider--help-setup-xref (list #'cider-doc-lookup (format "%s/%s" ns name)) nil buffer) - (with-current-buffer buffer - (cl-flet ((emit (text &optional face sep) - (insert (if face - (propertize text 'font-lock-face face) - text) - (or sep "\n")))) - (emit (if class java-name clj-name) 'font-lock-function-name-face) - (when super - (emit (concat "Extends: " (cider-font-lock-as 'java-mode super)))) - (when ifaces - (emit (concat "Implements: " (cider-font-lock-as 'java-mode (car ifaces)))) - ;; choose a separator that will produce correct alignment on monospace and regular fonts: - (let ((sep (if for-tooltip - " " - " "))) - (dolist (iface (cdr ifaces)) - (emit (concat sep (cider-font-lock-as 'java-mode iface)))))) - (when (or super ifaces) - (insert "\n")) - (when-let* ((forms (or forms args)) - (forms (delq nil (mapcar (lambda (f) - (unless (equal f "nil") - f)) - forms)))) - (dolist (form forms) - (emit (cider-font-lock-as-clojure form) - nil)) - (when compact - ;; Compensate for the newlines not `emit`ted in the previous call: - (insert "\n"))) - (when special - (emit "Special Form" 'font-lock-keyword-face)) - (when macro - (emit "Macro" 'font-lock-variable-name-face)) - (when builtin - (emit "Built-in" 'font-lock-keyword-face)) - (when added - (emit (concat "Added in " added) 'font-lock-comment-face)) - (when depr - (emit (concat "Deprecated in " depr) 'font-lock-keyword-face)) - (if (and doc class (not rendered-fragments)) - (cider-docview-render-java-doc (current-buffer) doc) - (when doc - (emit (if rendered-fragments - doc - (concat " " doc))))) - (when url - (insert "\n Please see ") - (insert-text-button url - 'url url - 'follow-link t - 'action (lambda (x) - (browse-url (button-get x 'url)))) - (insert "\n")) - (when (and (not compact) javadoc) - (insert "\n\nFor additional documentation, see the ") - (insert-text-button "Javadoc" - 'url javadoc - 'follow-link t - 'action (lambda (x) - (browse-url (button-get x 'url)))) - (insert ".\n")) - (insert "\n") - (when spec - (emit "Spec:" 'font-lock-function-name-face) - (insert (cider-browse-spec--pprint-indented spec)) - (insert "\n\n") - (insert-text-button "Browse spec" - 'follow-link t - 'action (lambda (_) - (cider-browse-spec (format "%s/%s" ns name)))) - (insert "\n\n")) - (unless compact - (if (and cider-docview-file (not (string= cider-docview-file ""))) - (progn - (insert (propertize (if class java-name clj-name) - 'font-lock-face 'font-lock-function-name-face) - " is defined in ") - (insert-text-button (cider--abbreviate-file-protocol cider-docview-file) - 'follow-link t - 'action (lambda (_x) - (cider-docview-source))) - (insert ".")) - (insert "Definition location unavailable."))) - (when (and (not compact) - see-also) - (insert "\n\n Also see: ") - (mapc (lambda (ns-sym) - (let* ((ns-sym-split (split-string ns-sym "/")) - (see-also-ns (car ns-sym-split)) - (see-also-sym (cadr ns-sym-split)) - ;; if the var belongs to the same namespace, - ;; we omit the namespace to save some screen space - (symbol (if (equal ns see-also-ns) see-also-sym ns-sym))) - (insert-text-button symbol - 'type 'help-xref - 'help-function (apply-partially #'cider-doc-lookup symbol))) - (insert " ")) - see-also)) - (unless compact - (cider--doc-make-xrefs)) - (let ((beg (point-min)) - (end (point-max))) - (nrepl-dict-map (lambda (k v) - (put-text-property beg end k v)) - info))) - (current-buffer)))) - -(declare-function cider-set-buffer-ns "cider-mode") -(defun cider-docview-render (buffer symbol info &optional compact for-tooltip) - "Emit into BUFFER formatted documentation for SYMBOL's INFO, -favoring a COMPACT format if specified, FOR-TOOLTIP if specified." - (with-current-buffer buffer - (let ((javadoc (nrepl-dict-get info "javadoc")) - (file (nrepl-dict-get info "file")) - (line (nrepl-dict-get info "line")) - (ns (nrepl-dict-get info "ns")) - (inhibit-read-only t)) - (cider-docview-mode) - - (cider-set-buffer-ns ns) - (setq-local cider-docview-symbol symbol) - (setq-local cider-docview-javadoc-url javadoc) - (setq-local cider-docview-file file) - (setq-local cider-docview-line line) - - (remove-overlays) - (cider-docview-render-info buffer info compact for-tooltip) - - (goto-char (point-min)) - (current-buffer)))) - - -(provide 'cider-doc) - -;;; cider-doc.el ends here diff --git a/elpa/cider-1.12.0/cider-docstring.el b/elpa/cider-1.12.0/cider-docstring.el @@ -1,165 +0,0 @@ -;;; cider-docstring.el --- Docstring rendering -*- lexical-binding: t -*- - -;; Copyright © 2013-2023 Bozhidar Batsov and CIDER contributors -;; -;; Author: Bozhidar Batsov <bozhidar@batsov.dev> - -;; 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/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Utilities for rendering a docstring into a shorter, especially-formatted string -;; that will look nice in UIs. - -;;; Code: - -(require 'cl-lib) -(require 'shr) - -(defsubst cider--render-pre* (dom) - "Render DOM nodes, formatting them them as Java if they are strings." - (dolist (sub (dom-children dom)) - (if (stringp sub) - (shr-insert (cider-font-lock-as 'java-mode sub)) - (shr-descend sub)))) - -(defun cider--render-pre (dom) - "Render DOM nodes without folding, a monospaced font, and Java syntax coloring." - (let ((shr-folding-mode 'none) - (shr-current-font 'default)) - (cider--render-pre* dom))) - -(defun cider--string-rstrip-newlines (str) - "Remove newlines at the end of STR." - (if (string-match "\\([\n\r]+\\)$" str) - (replace-match "" nil nil str) - str)) - -(defun cider--html-to-propertized-string (html-string) - "Convert an HTML-STRING into a propertized string using SHR." - (with-temp-buffer - (insert html-string) - (cider--string-rstrip-newlines ;; shr-insert-document adds a final newline. Plain text fragments are responsible for separating fragments if needed.. - (let ((dom (libxml-parse-html-region (point-min) (point-max)))) - (erase-buffer) - (shr-insert-document dom) - (buffer-string))))) - -(defun cider--fragments-to-s (fragments) - "Convert FRAGMENTS into a concatenated string representation. -If a given fragment is of html type, it's converted to a propertized string; -otherwise, it's included as-is." - (when (and fragments - (> (length fragments) - 0)) - (string-trim (cl-reduce (lambda (new-s fragment) - (let* ((html? (equal "html" (nrepl-dict-get fragment "type"))) - (v (nrepl-dict-get fragment "content"))) - (concat new-s (if html? - (let ((shr-use-fonts nil) - (shr-external-rendering-functions '((pre . cider--render-pre)))) - (cider--html-to-propertized-string v)) - v)))) - fragments - :initial-value "")))) - -(defcustom cider-docstring-max-lines 20 - "The maximum number of docstring lines that will be rendered in a UI widget (or the echo area). - -Note that `cider-docstring' will trim thing smartly, for Java doc comments: -* First, the whole doc comment will be attempted to be rendered. -* If that exceeds `cider-docstring-max-lines', - we will use only the first sentence and the block tags - (that is, the params/throws/returns info). -* If that exceeds `cider-docstring-max-lines', we will use only the block tags. -* If that exceeds `cider-docstring-max-lines', we will use only the first sentence." - :type 'integer - :group 'cider - :package-version '(cider . "1.8.0")) - -(defun cider--attempt-invalid? (attempt) - "Check if ATTEMPT is either nil or exceeds `cider-docstring-max-lines' in line count." - (or (not attempt) - (and attempt - (> (length (split-string attempt "\n")) - cider-docstring-max-lines)))) - -(defun cider--render-docstring-first-sentence (eldoc-info) - "Render the first sentence of the docstring extracted from ELDOC-INFO." - (when-let ((first-sentence-fragments (lax-plist-get eldoc-info "doc-first-sentence-fragments"))) - (cider--fragments-to-s first-sentence-fragments))) - -(defun cider--render-docstring (eldoc-info) - "Renders the docstring from ELDOC-INFO based on its length and content. -Prioritize rendering as much as possible while staying within `cider-docstring-max-lines'." - (let* ((first-sentence-fragments (lax-plist-get eldoc-info "doc-first-sentence-fragments")) - (body-fragments (lax-plist-get eldoc-info "doc-fragments")) - (block-tags-fragments (lax-plist-get eldoc-info "doc-block-tags-fragments")) - (block-tags-fragments-rendered (cider--fragments-to-s block-tags-fragments)) - (first-sentence-fragments-rendered) ;; mutable, for performance - (first-attempt (when body-fragments - (concat (cider--fragments-to-s body-fragments) - (when block-tags-fragments - "\n\n") - block-tags-fragments-rendered))) - (first-attempt-invalid? (cider--attempt-invalid? first-attempt)) - (second-attempt (when (and first-sentence-fragments - first-attempt-invalid?) - (setq first-sentence-fragments-rendered (cider--fragments-to-s first-sentence-fragments)) - (concat first-sentence-fragments-rendered - (when block-tags-fragments-rendered - "\n\n") - block-tags-fragments-rendered))) - (second-attempt-invalid? (cider--attempt-invalid? second-attempt)) - (third-attempt (when (and block-tags-fragments-rendered - first-attempt-invalid? - second-attempt-invalid?) - block-tags-fragments-rendered)) - (third-attempt-invalid? (cider--attempt-invalid? third-attempt)) - (last-attempt (when (and first-sentence-fragments-rendered - first-attempt-invalid? - second-attempt-invalid? - third-attempt-invalid?) - first-sentence-fragments-rendered))) - (or last-attempt ;; the last attempt has to go first - it takes priority over an attempt deemed invalid. - third-attempt - second-attempt - first-attempt))) - -(defun cider-docstring--dumb-trim (s &optional n) - "Returns up to the first N lines of string S, -adding \"...\" if trimming was necessary. - -N defaults to `cider-docstring-max-lines'. - -Also performs some bare-bones formatting, cleaning up some common whitespace issues." - (when s - (let* ((s (replace-regexp-in-string "\\. " ".\n\n" s)) ;; improve the formatting of e.g. clojure.core/reduce - (n (or n cider-docstring-max-lines)) - (lines (split-string s "\n")) - (lines-length (length lines)) - (selected-lines (cl-subseq lines 0 (min n lines-length))) - (result (mapconcat (lambda (f) - ;; Remove spaces at the beginning of each line, as it is common in many clojure.core defns: - (replace-regexp-in-string "\\`[ ]+" "" f)) - selected-lines - "\n"))) - (if (> lines-length n) - (concat result "...") - result)))) - -(provide 'cider-docstring) -;;; cider-docstring.el ends here diff --git a/elpa/cider-1.12.0/cider-eldoc.el b/elpa/cider-1.12.0/cider-eldoc.el @@ -1,523 +0,0 @@ -;;; cider-eldoc.el --- eldoc support for Clojure -*- lexical-binding: t -*- - -;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2023 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; -;; Author: Tim King <kingtim@gmail.com> -;; Phil Hagelberg <technomancy@gmail.com> -;; Bozhidar Batsov <bozhidar@batsov.dev> -;; Artur Malabarba <bruce.connor.am@gmail.com> -;; Hugo Duncan <hugo@hugoduncan.org> -;; Steve Purcell <steve@sanityinc.com> - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; eldoc support for Clojure. - -;;; Code: - -(require 'cider-client) -(require 'cider-common) ; for cider-symbol-at-point -(require 'cider-completion-context) -(require 'cider-docstring) -(require 'subr-x) -(require 'cider-util) -(require 'nrepl-dict) - -(require 'seq) - -(require 'eldoc) - -(defvar cider-extra-eldoc-commands '("yas-expand") - "Extra commands to be added to eldoc's safe commands list.") - -(defcustom cider-eldoc-max-num-sexps-to-skip 30 - "Max number of sexps to skip while searching the beginning of current sexp." - :type 'integer - :group 'cider - :package-version '(cider . "0.10.1")) - -(defvar-local cider-eldoc-last-symbol nil - "The eldoc information for the last symbol we checked.") - -(defcustom cider-eldoc-ns-function #'identity - "A function that returns a ns string to be used by eldoc. -Takes one argument, a namespace name. -For convenience, some functions are already provided for this purpose: -`cider-abbreviate-ns', and `cider-last-ns-segment'." - :type '(choice (const :tag "Full namespace" identity) - (const :tag "Abbreviated namespace" cider-abbreviate-ns) - (const :tag "Last name in namespace" cider-last-ns-segment) - (function :tag "Custom function")) - :group 'cider - :package-version '(cider . "0.13.0")) - -(defcustom cider-eldoc-max-class-names-to-display 3 - "The maximum number of classes to display in an eldoc string. -An eldoc string for Java interop forms can have a number of classes prefixed to -it, when the form belongs to more than 1 class. When, not nil we only display -the names of first `cider-eldoc-max-class-names-to-display' classes and add -a \"& x more\" suffix. Otherwise, all the classes are displayed." - :type 'integer - :safe #'integerp - :group 'cider - :package-version '(cider . "0.13.0")) - -(defcustom cider-eldoc-display-for-symbol-at-point t - "When non-nil, display eldoc for symbol at point if available. -So in (map inc ...) when the cursor is over inc its eldoc would be -displayed. When nil, always display eldoc for first symbol of the sexp." - :type 'boolean - :safe #'booleanp - :group 'cider - :package-version '(cider . "0.13.0")) - -(defcustom cider-eldoc-display-context-dependent-info nil - "When non-nil, display context dependent info in the eldoc where possible. -CIDER will try to add expected function arguments based on the current context, -for example for the datomic.api/q function where it will show the expected -inputs of the query at point." - :type 'boolean - :group 'cider - :package-version '(cider . "0.15.0")) - -(defun cider--eldoc-format-class-names (class-names) - "Return a formatted CLASS-NAMES prefix string. -CLASS-NAMES is a list of classes to which a Java interop form belongs. -Only keep the first `cider-eldoc-max-class-names-to-display' names, and -add a \"& x more\" suffix. Return nil if the CLASS-NAMES list is empty or -mapping `cider-eldoc-ns-function' on it returns an empty list." - (when-let* ((eldoc-class-names (seq-remove #'null (mapcar (apply-partially cider-eldoc-ns-function) class-names))) - (eldoc-class-names-length (length eldoc-class-names))) - (cond - ;; truncate class-names list and then format it - ((and cider-eldoc-max-class-names-to-display - (> eldoc-class-names-length cider-eldoc-max-class-names-to-display)) - (format "(%s & %s more)" - (thread-first - eldoc-class-names - (seq-take cider-eldoc-max-class-names-to-display) - (string-join " ") - (cider-propertize 'ns)) - (- eldoc-class-names-length cider-eldoc-max-class-names-to-display))) - - ;; format the whole list but add surrounding parentheses - ((> eldoc-class-names-length 1) - (format "(%s)" - (thread-first - eldoc-class-names - (string-join " ") - (cider-propertize 'ns)))) - - ;; don't add the parentheses - (t (format "%s" (car eldoc-class-names)))))) - -(defun cider-eldoc-format-thing (ns symbol thing type) - "Format the eldoc subject defined by NS, SYMBOL, THING and TYPE. -THING represents the thing at point which triggered eldoc. Normally NS and -SYMBOL are used (they are derived from THING), but when empty we fallback to -THING (e.g. for Java methods). Format it as a function, if FUNCTION-P -is non-nil. Else format it as a variable." - (if-let* ((method-name (if (and symbol (not (string= symbol ""))) - symbol - thing)) - (propertized-method-name (cider-propertize method-name type)) - (ns-or-class (if (and ns (stringp ns)) - (funcall cider-eldoc-ns-function ns) - (cider--eldoc-format-class-names ns)))) - (format "%s/%s" - ;; we set font-lock properties of classes in `cider--eldoc-format-class-names' - ;; to avoid font locking the parentheses and "& x more" - ;; so we only propertize ns-or-class if not already done - (if (get-text-property 1 'face ns-or-class) - ;; it is already propertized - ns-or-class - (cider-propertize ns-or-class 'ns)) - propertized-method-name) - ;; in case ns-or-class is nil - propertized-method-name)) - -(defun cider-eldoc-format-sym-doc (var ns docstring) - "Return the formatted eldoc string for VAR and DOCSTRING. - -Consider the value of `eldoc-echo-area-use-multiline-p' while formatting. -If the entire line cannot fit in the echo area, the var name may be -truncated or eliminated entirely from the output to make room for the -description. - -Try to truncate the var with various strategies, so that the var and -the docstring can be displayed in the minibuffer without resizing the window. -We start with `cider-abbreviate-ns' and `cider-last-ns-segment'. -Next, if the var is in current namespace, we remove NS from the eldoc string. -Otherwise, only the docstring is returned." - (let* ((ea-multi eldoc-echo-area-use-multiline-p) - ;; Subtract 1 from window width since emacs will not write - ;; any chars to the last column, or in later versions, will - ;; cause a wraparound and resize of the echo area. - (ea-width (1- (window-width (minibuffer-window)))) - (strip (- (+ (length var) (length docstring)) ea-width)) - (newline (string-match-p "\n" docstring)) - ;; Truncated var can be ea-var long - ;; Subtract 2 to account for the : and / added when including - ;; the namespace prefixed form in eldoc string - (ea-var (- (- ea-width (length docstring)) 2))) - (cond - ((or (eq ea-multi t) - (and (<= strip 0) (null newline)) - (and ea-multi (or (> (length docstring) ea-width) newline))) - (format "%s: %s" var docstring)) - - ;; Now we have to truncate either the docstring or the var - (newline (cider-eldoc-format-sym-doc var ns (substring docstring 0 newline))) - - ;; Only return the truncated docstring - ((> (length docstring) ea-width) - (substring docstring 0 ea-width)) - - ;; Try to truncate the var with cider-abbreviate-ns - ((<= (length (cider-abbreviate-ns var)) ea-var) - (format "%s: %s" (cider-abbreviate-ns var) docstring)) - - ;; Try to truncate var with cider-last-ns-segment - ((<= (length (cider-last-ns-segment var)) ea-var) - (format "%s: %s" (cider-last-ns-segment var) docstring)) - - ;; If the var is in current namespace, we try to truncate the var by - ;; skipping the namespace from the returned eldoc string - ((and (string-equal ns (cider-current-ns)) - (<= (- (length var) (length ns)) ea-var)) - (format "%s: %s" - (replace-regexp-in-string (format "%s/" ns) "" var) - docstring)) - - ;; We couldn't fit the var and docstring in the available space, - ;; so we just display the docstring - (t docstring)))) - -(defun cider-eldoc-format-variable (thing eldoc-info) - "Return the formatted eldoc string for a variable. - -THING is the variable name. ELDOC-INFO is a p-list containing the eldoc -information." - (let* ((ns (lax-plist-get eldoc-info "ns")) - (symbol (lax-plist-get eldoc-info "symbol")) - (docstring (or (cider--render-docstring-first-sentence eldoc-info) - (cider--render-docstring eldoc-info) - (cider-docstring--dumb-trim (lax-plist-get eldoc-info "docstring")))) - ;; if it's a single class (and not multiple class candidates), that's it - (maybe-class (car (lax-plist-get eldoc-info "class"))) - (formatted-var (or (when maybe-class - (cider-propertize maybe-class 'var)) - (cider-eldoc-format-thing ns symbol thing 'var)))) - (when docstring - (cider-eldoc-format-sym-doc formatted-var ns docstring)))) - -(defun cider-eldoc-format-function (thing pos eldoc-info) - "Return the formatted eldoc string for a function. -THING is the function name. POS is the argument-index of the functions -arglists. ELDOC-INFO is a p-list containing the eldoc information." - (let ((ns (lax-plist-get eldoc-info "ns")) - (symbol (lax-plist-get eldoc-info "symbol")) - (arglists (lax-plist-get eldoc-info "arglists"))) - (format "%s: %s" - (cider-eldoc-format-thing ns symbol thing 'fn) - (cider-eldoc-format-arglist arglists pos)))) - -(defun cider-eldoc-format-special-form (thing pos eldoc-info) - "Return the formatted eldoc string for a special-form. -THING is the special form's name. POS is the argument index of the -special-form's arglists. ELDOC-INFO is a p-list containing the eldoc -information." - (let* ((ns (lax-plist-get eldoc-info "ns")) - (special-form-symbol (lax-plist-get eldoc-info "symbol")) - (arglists (mapcar (lambda (arglist) - (if (equal (car arglist) special-form-symbol) - (cdr arglist) - arglist)) - (lax-plist-get eldoc-info "arglists")))) - (format "%s: %s" - (cider-eldoc-format-thing ns special-form-symbol thing 'fn) - (cider-eldoc-format-arglist arglists pos)))) - -(defun cider-highlight-args (arglist pos) - "Format the the function ARGLIST for eldoc. -POS is the index of the currently highlighted argument." - (let* ((rest-pos (cider--find-rest-args-position arglist)) - (i 0)) - (mapconcat - (lambda (arg) - (let ((argstr (format "%s" arg))) - (if (string= arg "&") - argstr - (prog1 - (if (or (= (1+ i) pos) - (and rest-pos - (> (1+ i) rest-pos) - (> pos rest-pos))) - (propertize argstr 'face - 'eldoc-highlight-function-argument) - argstr) - (setq i (1+ i)))))) arglist " "))) - -(defun cider--find-rest-args-position (arglist) - "Find the position of & in the ARGLIST vector." - (seq-position arglist "&")) - -(defun cider-highlight-arglist (arglist pos) - "Format the ARGLIST for eldoc. -POS is the index of the argument to highlight." - (concat "[" (cider-highlight-args arglist pos) "]")) - -(defun cider-eldoc-format-arglist (arglist pos) - "Format all the ARGLIST for eldoc. -POS is the index of current argument." - (concat "(" - (mapconcat (lambda (args) (cider-highlight-arglist args pos)) - arglist - " ") - ")")) - -(defun cider-eldoc-beginning-of-sexp () - "Move to the beginning of current sexp. - -Return the number of nested sexp the point was over or after. Return nil -if the maximum number of sexps to skip is exceeded." - (let ((parse-sexp-ignore-comments t) - (num-skipped-sexps 0)) - (condition-case _ - (progn - ;; First account for the case the point is directly over a - ;; beginning of a nested sexp. - (condition-case _ - (let ((p (point))) - (forward-sexp -1) - (forward-sexp 1) - (when (< (point) p) - (setq num-skipped-sexps 1))) - (error)) - (while - (let ((p (point))) - (clojure-backward-logical-sexp 1) - (when (< (point) p) - (setq num-skipped-sexps - (unless (and cider-eldoc-max-num-sexps-to-skip - (>= num-skipped-sexps - cider-eldoc-max-num-sexps-to-skip)) - ;; Without the above guard, - ;; `cider-eldoc-beginning-of-sexp' could traverse the - ;; whole buffer when the point is not within a - ;; list. This behavior is problematic especially with - ;; a buffer containing a large number of - ;; non-expressions like a REPL buffer. - (1+ num-skipped-sexps))))))) - (error)) - num-skipped-sexps)) - -(defun cider-eldoc-thing-type (eldoc-info) - "Return the type of the ELDOC-INFO being displayed by eldoc. -It can be a function or var now." - (or (pcase (lax-plist-get eldoc-info "type") - ("function" 'fn) - ("special-form" 'special-form) - ("macro" 'macro) - ("method" 'method) - ("variable" 'var)) - 'fn)) - -(defun cider-eldoc-info-at-point () - "Return eldoc info at point. -First go to the beginning of the sexp and check if the eldoc is to be -considered (i.e sexp is a method call) and not a map or vector literal. -Then go back to the point and return its eldoc." - (save-excursion - (unless (cider-in-comment-p) - (let* ((current-point (point))) - (cider-eldoc-beginning-of-sexp) - (unless (member (or (char-before (point)) 0) '(?\" ?\{ ?\[)) - (goto-char current-point) - (when-let* ((eldoc-info (cider-eldoc-info - (cider--eldoc-remove-dot (cider-symbol-at-point))))) - `("eldoc-info" ,eldoc-info - "thing" ,(cider-symbol-at-point) - "pos" 0))))))) - -(defun cider-eldoc-info-at-sexp-beginning () - "Return eldoc info for first symbol in the sexp." - (save-excursion - (when-let* ((beginning-of-sexp (cider-eldoc-beginning-of-sexp)) - ;; If we are at the beginning of function name, this will be -1 - (argument-index (max 0 (1- beginning-of-sexp)))) - (unless (or (memq (or (char-before (point)) 0) - '(?\" ?\{ ?\[)) - (cider-in-comment-p)) - (when-let* ((eldoc-info (cider-eldoc-info - (cider--eldoc-remove-dot (cider-symbol-at-point))))) - `("eldoc-info" ,eldoc-info - "thing" ,(cider-symbol-at-point) - "pos" ,argument-index)))))) - -(defun cider-eldoc-info-in-current-sexp () - "Return eldoc information from the sexp. -If `cider-eldoc-display-for-symbol-at-point' is non-nil and -the symbol at point has a valid eldoc available, return that. -Otherwise return the eldoc of the first symbol of the sexp." - (or (when cider-eldoc-display-for-symbol-at-point - (cider-eldoc-info-at-point)) - (cider-eldoc-info-at-sexp-beginning))) - -(defun cider-eldoc--convert-ns-keywords (thing) - "Convert THING values that match ns macro keywords to function names." - (pcase thing - (":import" "clojure.core/import") - (":refer-clojure" "clojure.core/refer-clojure") - (":use" "clojure.core/use") - (":refer" "clojure.core/refer") - (_ thing))) - -(defun cider-eldoc-info (thing) - "Return the info for THING (as string). -This includes the arglist and ns and symbol name (if available)." - (let ((thing (cider-eldoc--convert-ns-keywords thing))) - (when (and (cider-nrepl-op-supported-p "eldoc") - thing - ;; ignore blank things - (not (string-blank-p thing)) - ;; ignore string literals - (not (string-prefix-p "\"" thing)) - ;; ignore regular expressions - (not (string-prefix-p "#" thing)) - ;; ignore chars - (not (string-prefix-p "\\" thing)) - ;; ignore numbers - (not (string-match-p "^[0-9]" thing))) - ;; check if we can used the cached eldoc info - (cond - ;; handle keywords for map access - ((string-prefix-p ":" thing) (list "symbol" thing - "type" "function" - "arglists" '(("map") ("map" "not-found")))) - ;; handle Classname. by displaying the eldoc for new - ((string-match-p "^[A-Z].+\\.$" thing) (list "symbol" thing - "type" "function" - "arglists" '(("args*")))) - ;; generic case - (t (if (equal thing (car cider-eldoc-last-symbol)) - (cadr cider-eldoc-last-symbol) - (when-let* ((eldoc-info (cider-sync-request:eldoc thing nil nil (cider-completion-get-context t)))) - (let* ((arglists (nrepl-dict-get eldoc-info "eldoc")) - (docstring (nrepl-dict-get eldoc-info "docstring")) - (type (nrepl-dict-get eldoc-info "type")) - (ns (nrepl-dict-get eldoc-info "ns")) - (class (nrepl-dict-get eldoc-info "class")) - (name (nrepl-dict-get eldoc-info "name")) - (member (nrepl-dict-get eldoc-info "member")) - (ns-or-class (if (and ns (not (string= ns ""))) - ns - class)) - (name-or-member (if (and name (not (string= name ""))) - name - (format ".%s" member))) - (eldoc-plist (list "ns" ns-or-class - "class" class - "symbol" name-or-member - "arglists" arglists - "docstring" docstring - "doc-fragments" (nrepl-dict-get eldoc-info "doc-fragments") - "doc-first-sentence-fragments" (nrepl-dict-get eldoc-info - "doc-first-sentence-fragments") - "doc-block-tags-fragments" (nrepl-dict-get eldoc-info - "doc-block-tags-fragments") - "type" type))) - ;; add context dependent args if requested by defcustom - ;; do not cache this eldoc info to avoid showing info - ;; of the previous context - (if cider-eldoc-display-context-dependent-info - (cond - ;; add inputs of datomic query - ((and (equal ns-or-class "datomic.api") - (equal name-or-member "q")) - (let ((arglists (lax-plist-get eldoc-plist "arglists"))) - (lax-plist-put eldoc-plist "arglists" - (cider--eldoc-add-datomic-query-inputs-to-arglists arglists)))) - ;; if none of the clauses is successful, do cache the eldoc - (t (setq cider-eldoc-last-symbol (list thing eldoc-plist)))) - ;; middleware eldoc lookups are expensive, so we - ;; cache the last lookup. This eliminates the need - ;; for extra middleware requests within the same sexp. - (setq cider-eldoc-last-symbol (list thing eldoc-plist))) - eldoc-plist)))))))) - -(defun cider--eldoc-remove-dot (sym) - "Remove the preceding \".\" from a namespace qualified SYM and return sym. -Only useful for interop forms. Clojure forms would be returned unchanged." - (when sym (replace-regexp-in-string "/\\." "/" sym))) - -(defun cider--eldoc-edn-file-p (file-name) - "Check whether FILE-NAME is representing an EDN file." - (and file-name (equal (file-name-extension file-name) "edn"))) - -(defun cider--eldoc-add-datomic-query-inputs-to-arglists (arglists) - "Add the expected inputs of the datomic query to the ARGLISTS." - (if (cider-second-sexp-in-list) - (let* ((query (cider-second-sexp-in-list)) - (query-inputs (nrepl-dict-get - (cider-sync-request:eldoc-datomic-query query) - "inputs"))) - (if query-inputs - (thread-first - (thread-last arglists - (car) - (remove "&") - (remove "inputs")) - (append (car query-inputs)) - (list)) - arglists)) - arglists)) - -(defun cider-eldoc (&rest _ignored) - "Backend function for eldoc to show argument list in the echo area." - (when (and (cider-connected-p) - ;; don't clobber an error message in the minibuffer - (not (member last-command '(next-error previous-error))) - ;; don't try to provide eldoc in EDN buffers - (not (cider--eldoc-edn-file-p buffer-file-name))) - (let* ((sexp-eldoc-info (cider-eldoc-info-in-current-sexp)) - (eldoc-info (lax-plist-get sexp-eldoc-info "eldoc-info")) - (pos (lax-plist-get sexp-eldoc-info "pos")) - (thing (lax-plist-get sexp-eldoc-info "thing"))) - (when eldoc-info - (cond - ((eq (cider-eldoc-thing-type eldoc-info) 'var) - (cider-eldoc-format-variable thing eldoc-info)) - ((eq (cider-eldoc-thing-type eldoc-info) 'special-form) - (cider-eldoc-format-special-form thing pos eldoc-info)) - (t (cider-eldoc-format-function thing pos eldoc-info))))))) - -(defun cider-eldoc-setup () - "Setup eldoc in the current buffer. -eldoc mode has to be enabled for this to have any effect." - ;; Emacs 28.1 changes the way eldoc is setup. - ;; There you can have multiple eldoc functions. - (if (boundp 'eldoc-documentation-functions) - (add-hook 'eldoc-documentation-functions #'cider-eldoc nil t) - (setq-local eldoc-documentation-function #'cider-eldoc)) - (apply #'eldoc-add-command cider-extra-eldoc-commands)) - -(provide 'cider-eldoc) - -;;; cider-eldoc.el ends here diff --git a/elpa/cider-1.12.0/cider-eval.el b/elpa/cider-1.12.0/cider-eval.el @@ -1,1809 +0,0 @@ -;;; cider-eval.el --- Interactive evaluation (compilation) functionality -*- lexical-binding: t -*- - -;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2023 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; -;; Author: Tim King <kingtim@gmail.com> -;; Phil Hagelberg <technomancy@gmail.com> -;; Bozhidar Batsov <bozhidar@batsov.dev> -;; Artur Malabarba <bruce.connor.am@gmail.com> -;; Hugo Duncan <hugo@hugoduncan.org> -;; Steve Purcell <steve@sanityinc.com> -;; Arne Brasseur <arne@arnebraasseur.net> - -;; 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/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; This file contains CIDER's interactive evaluation (compilation) functionality. -;; Although Clojure doesn't really have the concept of evaluation (only -;; compilation), we're using everywhere in the code the term evaluation for -;; brevity (and to be in line with the naming employed by other similar modes). -;; -;; This files also contains all the logic related to displaying errors and -;; evaluation warnings. -;; -;; Pretty much all of the commands here are meant to be used mostly from -;; `cider-mode', but some of them might make sense in other contexts as well. - -;;; Code: - -(require 'ansi-color) -(require 'cl-lib) -(require 'compile) -(require 'map) -(require 'seq) -(require 'subr-x) - -(require 'clojure-mode) - -(require 'cider-client) -(require 'cider-common) -(require 'cider-jar) -(require 'cider-overlays) -(require 'cider-popup) -(require 'cider-repl) -(require 'cider-stacktrace) -(require 'cider-util) - -(defconst cider-read-eval-buffer "*cider-read-eval*") -(defconst cider-result-buffer "*cider-result*") - -(defcustom cider-show-error-buffer t - "Control the popup behavior of cider stacktraces. -The following values are possible t or 'always, 'except-in-repl, -'only-in-repl. Any other value, including nil, will cause the stacktrace -not to be automatically shown. - -Irrespective of the value of this variable, the `cider-error-buffer' is -always generated in the background. Use `cider-selector' to -navigate to this buffer. - -Please note, if the error phase belongs to -one of the `cider-clojure-compilation-error-phases', -then no stacktrace showing will happen. -That defcustom takes precedence over this one. - -See its doc for understanding its rationale. You can also customize it to nil -in order to void its effect." - :type '(choice (const :tag "always" t) - (const except-in-repl) - (const only-in-repl) - (const :tag "never" nil)) - :group 'cider) - -(defcustom cider-auto-jump-to-error t - "Control the cursor jump behavior in compilation error buffer. -When non-nil automatically jump to error location during interactive -compilation. When set to 'errors-only, don't jump to warnings. -When set to nil, don't jump at all." - :type '(choice (const :tag "always" t) - (const errors-only) - (const :tag "never" nil)) - :group 'cider - :package-version '(cider . "0.7.0")) - -(defcustom cider-auto-select-error-buffer t - "Controls whether to auto-select the error popup buffer." - :type 'boolean - :group 'cider) - -(defcustom cider-auto-track-ns-form-changes t - "Controls whether to auto-evaluate a source buffer's ns form when changed. -When non-nil CIDER will check for ns form changes before each eval command. -When nil the users are expected to take care of the re-evaluating updated -ns forms manually themselves." - :type 'boolean - :group 'cider - :package-version '(cider . "0.15.0")) - -(defcustom cider-auto-inspect-after-eval t - "Controls whether to auto-update the inspector buffer after eval. -Only applies when the *cider-inspect* buffer is currently visible." - :type 'boolean - :group 'cider - :package-version '(cider . "0.25.0")) - -(defcustom cider-save-file-on-load 'prompt - "Controls whether to prompt to save the file when loading a buffer. -If nil, files are not saved. -If 'prompt, the user is prompted to save the file if it's been modified. -If t, save the file without confirmation." - :type '(choice (const prompt :tag "Prompt to save the file if it's been modified") - (const nil :tag "Don't save the file") - (const t :tag "Save the file without confirmation")) - :group 'cider - :package-version '(cider . "0.6.0")) - -(defcustom cider-file-loaded-hook nil - "List of functions to call when a load file has completed." - :type 'hook - :group 'cider - :package-version '(cider . "0.1.7")) - -(defconst cider-output-buffer "*cider-out*") - -(defcustom cider-interactive-eval-output-destination 'repl-buffer - "The destination for stdout and stderr produced from interactive evaluation." - :type '(choice (const output-buffer) - (const repl-buffer)) - :group 'cider - :package-version '(cider . "0.7.0")) - -(defface cider-error-highlight-face - '((((supports :underline (:style wave))) - (:underline (:style wave :color "red") :inherit unspecified)) - (t (:inherit font-lock-warning-face :underline t))) - "Face used to highlight compilation errors in Clojure buffers." - :group 'cider) - -(defface cider-warning-highlight-face - '((((supports :underline (:style wave))) - (:underline (:style wave :color "yellow") :inherit unspecified)) - (t (:inherit font-lock-warning-face :underline (:color "yellow")))) - "Face used to highlight compilation warnings in Clojure buffers." - :group 'cider) - -(defcustom cider-comment-prefix ";; => " - "The prefix to insert before the first line of commented output." - :type 'string - :group 'cider - :package-version '(cider . "0.16.0")) - -(defcustom cider-comment-continued-prefix ";; " - "The prefix to use on the second and subsequent lines of commented output." - :type 'string - :group 'cider - :package-version '(cider . "0.16.0")) - -(defcustom cider-comment-postfix "" - "The postfix to be appended after the final line of commented output." - :type 'string - :group 'cider - :package-version '(cider . "0.16.0")) - -(defcustom cider-eval-register ?e - "The text register assigned to the most recent evaluation result. -When non-nil, the return value of all CIDER eval commands are -automatically written into this register." - :type '(choice character - (const nil)) - :group 'cider - :package-version '(cider . "1.4.0")) - - -;;; Utilities - -(defun cider--clear-compilation-highlights () - "Remove compilation highlights." - (remove-overlays (point-min) (point-max) 'cider-note-p t)) - -(defun cider-clear-compilation-highlights (&optional arg) - "Remove compilation highlights. -When invoked with a prefix ARG the command doesn't prompt for confirmation." - (interactive "P") - (when (or arg (y-or-n-p "Are you sure you want to clear the compilation highlights? ")) - (cider--clear-compilation-highlights))) - -(defun cider--quit-error-window () - "Buries the `cider-error-buffer' and quits its containing window." - (when-let* ((error-win (get-buffer-window cider-error-buffer))) - (save-excursion - (quit-window nil error-win)))) - - -;;; Sideloader -;; -;; nREPL includes sideloader middleware which provides a Java classloader that -;; is able to dynamically load classes and resources at runtime by interacting -;; with the nREPL client (as opposed to using the classpath of the JVM hosting -;; nREPL server). -;; -;; This performs a similar functionality as the load-file -;; operation, where we can load Clojure namespaces (as source files) or Java -;; classes (as bytecode) by simply requiring or importing them. -;; -;; See https://nrepl.org/nrepl/design/middleware.html#sideloading - -(defcustom cider-sideloader-path nil - "List of directories and jar files to scan for sideloader resources. -When not set the cider-nrepl jar will be added automatically when upgrading -an nREPL connection." - :type 'list - :group 'cider - :package-version '(cider . "1.2.0")) - -(defcustom cider-dynload-cider-nrepl-version nil - "Version of the cider-nrepl jar used for dynamically upgrading a connection. -Defaults to `cider-required-middleware-version'." - :type 'string - :group 'cider - :package-version '(cider . "1.2.0")) - -(defun cider-read-bytes (path) - "Read binary data from PATH. -Return the binary data as unibyte string." - ;; based on f-read-bytes - (with-temp-buffer - (set-buffer-multibyte nil) - (setq buffer-file-coding-system 'binary) - (insert-file-contents-literally path nil) - (buffer-substring-no-properties (point-min) (point-max)))) - -(defun cider-retrieve-resource (dirs name) - "Find a resource NAME in a list DIRS of directories or jar files. -Similar to a classpath lookup. Returns the file contents as a string." - (seq-some - (lambda (path) - (cond - ((file-directory-p path) - (let ((expanded (expand-file-name name path))) - (when (file-exists-p expanded) - (cider-read-bytes expanded)))) - ((and (file-exists-p path) (string-suffix-p ".jar" path)) - (cider-jar-retrieve-resource path name)))) - dirs)) - -(defun cider-provide-file (file) - "Provide FILE in a format suitable for sideloading." - (let ((contents (cider-retrieve-resource cider-sideloader-path file))) - (if contents - (base64-encode-string contents 'no-line-breaks) - ;; if we can't find the file we should return an empty string - (base64-encode-string "")))) - -(defun cider-sideloader-lookup-handler () - "Make a sideloader-lookup handler." - (lambda (response) - (nrepl-dbind-response response (id status type name) - (if status - (when (member "sideloader-lookup" status) - (cider-request:sideloader-provide id type name)))))) - -(defun cider-add-middleware-handler (continue) - "Make a add-middleware handler. -CONTINUE is an optional continuation function." - (lambda (response) - (nrepl-dbind-response response (status unresolved-middleware) ;; id middleware - (when unresolved-middleware - (seq-do - (lambda (mw) - (cider-repl-emit-interactive-stderr - (concat "WARNING: middleware " mw " was not found or failed to load.\n"))) - unresolved-middleware)) - (when (and status (member "done" status) continue) - (funcall continue))))) - -(defun cider-request:sideloader-start (&optional connection tooling) - "Perform the nREPL \"sideloader-start\" op. -If CONNECTION is nil, use `cider-current-repl'. -If TOOLING is truthy then the operation is performed over the tooling -session, rather than the regular session." - (cider-ensure-op-supported "sideloader-start") - (cider-nrepl-send-request `("op" "sideloader-start") - (cider-sideloader-lookup-handler) - connection - tooling)) - -(defun cider-request:sideloader-provide (id type file &optional connection) - "Perform the nREPL \"sideloader-provide\" op for ID, TYPE and FILE. -If CONNECTION is nil, use `cider-current-repl'." - (cider-nrepl-send-request `("id" ,id - "op" "sideloader-provide" - "type" ,type - "name" ,file - "content" ,(cider-provide-file file)) - (cider-sideloader-lookup-handler) - connection)) - -(defun cider-sideloader-start (&optional connection) - "Start nREPL's sideloader. -If CONNECTION is nil, use `cider-current-repl'." - (interactive) - (message "Starting nREPL's sideloader") - (cider-request:sideloader-start connection) - (cider-request:sideloader-start connection 'tooling)) - -(defvar cider-nrepl-middlewares - '("cider.nrepl/wrap-apropos" - "cider.nrepl/wrap-classpath" - "cider.nrepl/wrap-clojuredocs" - "cider.nrepl/wrap-complete" - "cider.nrepl/wrap-content-type" - "cider.nrepl/wrap-debug" - "cider.nrepl/wrap-enlighten" - "cider.nrepl/wrap-format" - "cider.nrepl/wrap-info" - "cider.nrepl/wrap-inspect" - "cider.nrepl/wrap-log" - "cider.nrepl/wrap-macroexpand" - "cider.nrepl/wrap-ns" - "cider.nrepl/wrap-out" - "cider.nrepl/wrap-slurp" - "cider.nrepl/wrap-profile" - "cider.nrepl/wrap-refresh" - "cider.nrepl/wrap-resource" - "cider.nrepl/wrap-spec" - "cider.nrepl/wrap-stacktrace" - "cider.nrepl/wrap-test" - "cider.nrepl/wrap-trace" - "cider.nrepl/wrap-tracker" - "cider.nrepl/wrap-undef" - "cider.nrepl/wrap-version" - "cider.nrepl/wrap-xref")) - -(defun cider-request:add-middleware (middlewares - &optional connection tooling continue) - "Use the nREPL dynamic loader to add MIDDLEWARES to the nREPL session. - -- If CONNECTION is nil, use `cider-current-repl'. -- If TOOLING it truthy, use the tooling session instead of the main session. -- CONTINUE is an optional continuation function, which will be called when the -add-middleware op has finished successfully." - (cider-nrepl-send-request `("op" "add-middleware" - "middleware" ,middlewares) - (cider-add-middleware-handler continue) - connection - tooling)) - -(defun cider-add-cider-nrepl-middlewares (&optional connection) - "Use dynamic loading to add the cider-nrepl middlewares to nREPL. -If CONNECTION is nil, use `cider-current-repl'." - (cider-request:add-middleware - cider-nrepl-middlewares connection nil - (lambda () - ;; When the main session is done adding middleware, then do the tooling - ;; session. At this point all the namespaces have been sideloaded so this - ;; is faster, we don't want these to race to sideload resources. - (cider-request:add-middleware - cider-nrepl-middlewares connection 'tooling - (lambda () - ;; Ask nREPL again what its capabilities are, so we know which new - ;; operations are supported. - (nrepl--init-capabilities (or connection (cider-current-repl)))))))) - -(defvar cider-required-middleware-version) -(defun cider-upgrade-nrepl-connection (&optional connection) - "Sideload cider-nrepl middleware. -If CONNECTION is nil, use `cider-current-repl'." - (interactive) - (when (not cider-sideloader-path) - (setq cider-sideloader-path (list (cider-jar-find-or-fetch - "cider" "cider-nrepl" - (or cider-dynload-cider-nrepl-version - cider-required-middleware-version))))) - (cider-sideloader-start connection) - (cider-add-cider-nrepl-middlewares connection)) - - -;;; Dealing with compilation (evaluation) errors and warnings -(defun cider-find-property (property &optional backward) - "Find the next text region which has the specified PROPERTY. -If BACKWARD is t, then search backward. -Returns the position at which PROPERTY was found, or nil if not found." - (let ((p (if backward - (previous-single-char-property-change (point) property) - (next-single-char-property-change (point) property)))) - (when (and (not (= p (point-min))) (not (= p (point-max)))) - p))) - -(defun cider-jump-to-compilation-error (&optional _arg _reset) - "Jump to the line causing the current compilation error. -_ARG and _RESET are ignored, as there is only ever one compilation error. -They exist for compatibility with `next-error'." - (interactive) - (cl-labels ((goto-next-note-boundary - () - (let ((p (or (cider-find-property 'cider-note-p) - (cider-find-property 'cider-note-p t)))) - (when p - (goto-char p) - (message "%s" (get-char-property p 'cider-note)))))) - ;; if we're already on a compilation error, first jump to the end of - ;; it, so that we find the next error. - (when (get-char-property (point) 'cider-note-p) - (goto-next-note-boundary)) - (goto-next-note-boundary))) - -(defun cider--show-error-buffer-p () - "Return non-nil if the error buffer must be shown on error. -Takes into account both the value of `cider-show-error-buffer' and the -currently selected buffer." - (let* ((selected-buffer (window-buffer (selected-window))) - (replp (with-current-buffer selected-buffer (derived-mode-p 'cider-repl-mode)))) - (memq cider-show-error-buffer - (if replp - '(t always only-in-repl) - '(t always except-in-repl))))) - -(defun cider-new-error-buffer (&optional mode error-types) - "Return an empty error buffer using MODE. - -When deciding whether to display the buffer, takes into account not only -the value of `cider-show-error-buffer' and the currently selected buffer -but also the ERROR-TYPES of the error, which is checked against the -`cider-stacktrace-suppressed-errors' set. - -When deciding whether to select the buffer, takes into account the value of -`cider-auto-select-error-buffer'." - (if (and (cider--show-error-buffer-p) - (not (cider-stacktrace-some-suppressed-errors-p error-types))) - (cider-popup-buffer cider-error-buffer cider-auto-select-error-buffer mode 'ancillary) - (cider-make-popup-buffer cider-error-buffer mode 'ancillary))) - -(defun cider-emit-into-color-buffer (buffer value) - "Emit into color BUFFER the provided VALUE." - (with-current-buffer buffer - (let ((inhibit-read-only t) - (buffer-undo-list t)) - (goto-char (point-max)) - (insert (format "%s" value)) - (ansi-color-apply-on-region (point-min) (point-max))) - (goto-char (point-min)))) - -(defun cider--handle-err-eval-response (response) - "Render eval RESPONSE into a new error buffer. - -Uses the value of the `out' slot in RESPONSE." - (nrepl-dbind-response response (out) - (when out - (let ((error-buffer (cider-new-error-buffer))) - (cider-emit-into-color-buffer error-buffer out) - (with-current-buffer error-buffer - (compilation-minor-mode +1)))))) - -(defun cider-default-err-eval-handler () - "Display the last exception without middleware support." - (cider--handle-err-eval-response - (cider-nrepl-sync-request:eval - "(clojure.stacktrace/print-cause-trace *e)"))) - -(defun cider-default-err-eval-print-handler () - "Display the last exception without middleware support. -When clojure.stracktrace is not present." - (cider--handle-err-eval-response - (cider-nrepl-sync-request:eval - "(println (ex-data *e))"))) - -(defun cider--render-stacktrace-causes (causes &optional error-types) - "If CAUSES is non-nil, render its contents into a new error buffer. -Optional argument ERROR-TYPES contains a list which should determine the -op/situation that originated this error." - (when causes - (let ((error-buffer (cider-new-error-buffer #'cider-stacktrace-mode error-types))) - (cider-stacktrace-render error-buffer (reverse causes) error-types)))) - -(defconst cider-clojure-compilation-error-phases-default-value - '("read-source" - "macro-syntax-check" - "macroexpansion" - "compile-syntax-check" - "compilation" - ;; "execution" is certainly not to be included here. - ;; "read-eval-result" and "print-eval-result" are not to be included here, - ;; because they mean that the code has been successfully executed. - )) - -(defcustom cider-clojure-compilation-error-phases cider-clojure-compilation-error-phases-default-value - "Error phases which will not cause the `*cider-error*' buffer to pop up. - -The default value results in no stacktrace being shown for compile-time errors. - -Note that `*cider-error*' pop behavior is otherwise controlled -by the `cider-show-error-buffer' defcustom. - -`cider-clojure-compilation-error-phases' takes precedence. -If you wish phases to be ignored, set this variable to nil instead. - -You can learn more about Clojure's error phases at: -https://clojure.org/reference/repl_and_main#_at_repl" - :type 'list - :group 'cider - :package-version '(cider . "0.18.0")) - -(defun cider-clojure-compilation-error-phases () - "Get the normalized value of the `cider-clojure-compilation-error-phases' var." - (if (equal t cider-clojure-compilation-error-phases) - cider-clojure-compilation-error-phases-default-value - cider-clojure-compilation-error-phases)) - -(defun cider--handle-stacktrace-response (response causes ex-phase) - "Handle stacktrace RESPONSE, aggregate the result into CAUSES, honor EX-PHASE. -If RESPONSE contains a cause, cons it onto CAUSES and return that. If -RESPONSE is the final message (i.e. it contains a status), render CAUSES -into a new error buffer." - (nrepl-dbind-response response (class msg status type) - (cond ((and (member "notification" status) causes) - (nrepl-notify msg type)) - (class (cons response causes)) - (status - (unless (member ex-phase (cider-clojure-compilation-error-phases)) - (cider--render-stacktrace-causes causes)))))) - -(defun cider-default-err-op-handler () - "Display the last exception, with middleware support." - ;; Causes are returned as a series of messages, which we aggregate in `causes' - (let (causes ex-phase) - (cider-nrepl-send-request - (thread-last - (map-merge 'list - '(("op" "analyze-last-stacktrace")) - (cider--nrepl-print-request-map fill-column)) - (seq-mapcat #'identity)) - (lambda (response) - (nrepl-dbind-response response (phase) - (when phase - (setq ex-phase phase))) - ;; While the return value of `cider--handle-stacktrace-response' is not - ;; meaningful for the last message, we do not need the value of `causes' - ;; after it has been handled, so it's fine to set it unconditionally here - (setq causes (cider--handle-stacktrace-response response causes ex-phase)))))) - -(defun cider-default-err-handler () - "This function determines how the error buffer is shown. -It delegates the actual error content to the eval or op handler." - (cond ((cider-nrepl-op-supported-p "analyze-last-stacktrace") - (cider-default-err-op-handler)) - ((cider-library-present-p "clojure.stacktrace") - (cider-default-err-eval-handler)) - (t (cider-default-err-eval-print-handler)))) - - -;; The format of the error messages emitted by Clojure's compiler changed in -;; Clojure 1.10. That's why we're trying to match error messages to both the -;; old and the new format, by utilizing a combination of two different regular -;; expressions. - -(defconst cider-clojure-1.10--location `("at (" - (group-n 2 (minimal-match (zero-or-more anything))) - ":" - (group-n 3 (one-or-more digit)) - (optional ":" (group-n 4 (one-or-more digit))) - ").")) - -(defconst cider-clojure-1.10-error (append `(sequence - "Syntax error " - (minimal-match (zero-or-more anything)) - (or "compiling " - "macroexpanding " - "reading source ") - (minimal-match (zero-or-more anything))) - cider-clojure-1.10--location)) - -(defconst cider-clojure-unexpected-error (append `(sequence - "Unexpected error (" - (minimal-match (one-or-more anything)) - ") " - (or "compiling " - "macroexpanding " - "reading source ") - (minimal-match (one-or-more anything))) - cider-clojure-1.10--location)) - -(defconst cider-clojure-1.9-error `(sequence - (zero-or-more anything) - ", compiling:(" - (group-n 2 (minimal-match (zero-or-more anything))) - ":" - (group-n 3 (one-or-more digit)) - (optional ":" (group-n 4 (one-or-more digit))) - ")")) - -(defconst cider-clojure-warning `(sequence - (minimal-match (zero-or-more anything)) - (group-n 1 "warning") - ", " - (group-n 2 (minimal-match (zero-or-more anything))) - ":" - (group-n 3 (one-or-more digit)) - (optional ":" (group-n 4 (one-or-more digit))) - " - ")) - -(defconst cider-clojure-compilation-regexp - (eval - `(rx bol (or ,cider-clojure-1.9-error - ,cider-clojure-warning - ,cider-clojure-1.10-error - ,cider-clojure-unexpected-error)) - t) - "A few example values that will match: -\"Reflection warning, /tmp/foo/src/foo/core.clj:14:1 - \" -\"CompilerException java.lang.RuntimeException: Unable to resolve symbol: \\ -lol in this context, compiling:(/foo/core.clj:10:1)\" -\"Syntax error compiling at (src/workspace_service.clj:227:3).\" -\"Unexpected error (ClassCastException) macroexpanding defmulti at (src/haystack/parser.cljc:21:1).\"") - -(defconst cider-module-info-regexp - (rx " (" - (minimal-match (one-or-more anything)) - " is in" - (minimal-match (one-or-more anything)) ;; module or unnamed module - " of loader " - (minimal-match (one-or-more anything)) - "; " - (minimal-match (one-or-more anything)) - " is in " - (minimal-match (one-or-more anything)) ;; module or unnamed module - " of loader " - (minimal-match (one-or-more anything)) - ")")) - -(defvar cider-compilation-regexp - (list cider-clojure-compilation-regexp 2 3 4 '(1)) - "Specifications for matching errors and warnings in Clojure stacktraces. -See `compilation-error-regexp-alist' for help on their format.") - -(add-to-list 'compilation-error-regexp-alist-alist - (cons 'cider cider-compilation-regexp)) -(add-to-list 'compilation-error-regexp-alist 'cider) - -(defun cider-extract-error-info (regexp message) - "Extract error information with REGEXP against MESSAGE." - (let ((file (nth 1 regexp)) - (line (nth 2 regexp)) - (col (nth 3 regexp)) - (type (nth 4 regexp)) - (pat (car regexp))) - (when (string-match pat message) - ;; special processing for type (1.2) style - (setq type (if (consp type) - (or (and (car type) (match-end (car type)) 1) - (and (cdr type) (match-end (cdr type)) 0) - 2))) - (list - (when file - (let ((val (match-string-no-properties file message))) - (unless (string= val "NO_SOURCE_PATH") val))) - (when line (string-to-number (match-string-no-properties line message))) - (when col - (let ((val (match-string-no-properties col message))) - (when (and val (not (string-blank-p val))) (string-to-number val)))) - (aref [cider-warning-highlight-face - cider-warning-highlight-face - cider-error-highlight-face] - (or type 2)) - message)))) - -(defun cider--goto-expression-start () - "Go to the beginning a list, vector, map or set outside of a string. -We do so by starting and the current position and proceeding backwards -until we find a delimiters that's not inside a string." - (if (and (looking-back "[])}]" (line-beginning-position)) - (null (nth 3 (syntax-ppss)))) - (backward-sexp) - (while (or (not (looking-at-p "[({[]")) - (nth 3 (syntax-ppss))) - (backward-char)))) - -(defun cider--find-last-error-location (message) - "Return the location (begin end buffer) from the Clojure error MESSAGE. -If location could not be found, return nil." - (save-excursion - (let ((info (cider-extract-error-info cider-compilation-regexp message))) - (when info - (let ((file (nth 0 info)) - (line (nth 1 info)) - (col (nth 2 info))) - (unless (or (not (stringp file)) - (cider--tooling-file-p file)) - (when-let* ((buffer (cider-find-file file))) - (with-current-buffer buffer - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (forward-line (1- line)) - (move-to-column (or col 0)) - ;; if this condition is false, it means that `col` was a spuriously large value, - ;; therefore the whole calculation should be discarded: - (when (or (not col) ;; if there's no col info, we cannot judge if it's spurious/not - ;; (current-column) never goes past the last column in the actual line, - ;; so if it's <, then the message had spurious info: - (>= (1+ (current-column)) - col)) - (let ((begin (progn (if col (cider--goto-expression-start) (back-to-indentation)) - (point))) - (end (progn (if col (forward-list) (move-end-of-line nil)) - (point)))) - (list begin end buffer))))))))))))) - -(defun cider-handle-compilation-errors (message eval-buffer &optional no-jump) - "Highlight and jump to compilation error extracted from MESSAGE, honor NO-JUMP. -EVAL-BUFFER is the buffer that was current during user's interactive -evaluation command. Honor `cider-auto-jump-to-error'." - (when-let* ((loc (cider--find-last-error-location message)) - (overlay (make-overlay (nth 0 loc) (nth 1 loc) (nth 2 loc))) - (info (cider-extract-error-info cider-compilation-regexp message))) - (let* ((face (nth 3 info)) - (note (nth 4 info)) - (auto-jump (unless no-jump - (if (eq cider-auto-jump-to-error 'errors-only) - (not (or (eq face 'cider-warning-highlight-face) - (string-match-p "warning" note))) - cider-auto-jump-to-error)))) - (overlay-put overlay 'cider-note-p t) - (overlay-put overlay 'font-lock-face face) - (overlay-put overlay 'cider-note note) - (overlay-put overlay 'help-echo note) - (overlay-put overlay 'modification-hooks - (list (lambda (o &rest _args) (delete-overlay o)))) - (when auto-jump - (with-current-buffer eval-buffer - (push-mark) - ;; At this stage selected window commonly is *cider-error* and we need to - ;; re-select the original user window. If eval-buffer is not - ;; visible it was probably covered as a result of a small screen or user - ;; configuration (https://github.com/clojure-emacs/cider/issues/847). In - ;; that case we don't jump at all in order to avoid covering *cider-error* - ;; buffer. - (when-let* ((win (get-buffer-window eval-buffer))) - (with-selected-window win - (cider-jump-to (nth 2 loc) (car loc))))))))) - - -;;; Interactive evaluation handlers -(defun cider-insert-eval-handler (&optional buffer bounds source-buffer on-success-callback) - "Make an nREPL evaluation handler for the BUFFER, -BOUNDS representing the buffer bounds of the evaled input, -SOURCE-BUFFER the original buffer, -and ON-SUCCESS-CALLBACK an optional callback. - -The handler simply inserts the result value in BUFFER." - (let ((eval-buffer (current-buffer)) - (res "") - (failed nil)) - (nrepl-make-response-handler (or buffer eval-buffer) - ;; value handler: - (lambda (_buffer value) - (with-current-buffer buffer - (insert value)) - (when cider-eval-register - (setq res (concat res value)))) - ;; stdout handler: - (lambda (_buffer out) - (cider-repl-emit-interactive-stdout out)) - ;; stderr handler: - (lambda (_buffer err) - (setq failed t) - (when (and source-buffer - (listp bounds)) ;; if it's a list, it represents bounds, otherwise it's a string (code) and we can't display the overlay - (with-current-buffer source-buffer - (let* ((phase (cider--error-phase-of-last-exception buffer)) - (end (or (car-safe (cdr-safe bounds)) bounds)) - (end (when end - (copy-marker end)))) - (cider--maybe-display-error-as-overlay phase err end)))) - - (cider-handle-compilation-errors err eval-buffer)) - ;; done handler: - (lambda (_buffer) - (when cider-eval-register - (set-register cider-eval-register res)) - (when (and (not failed) - on-success-callback) - (funcall on-success-callback)))))) - -(defun cider--emit-interactive-eval-output (output repl-emit-function) - "Emit output resulting from interactive code evaluation. -The OUTPUT can be sent to either a dedicated output buffer or the current -REPL buffer. This is controlled by `cider-interactive-eval-output-destination'. -REPL-EMIT-FUNCTION emits the OUTPUT." - (pcase cider-interactive-eval-output-destination - (`output-buffer (let ((output-buffer (or (get-buffer cider-output-buffer) - (cider-popup-buffer cider-output-buffer t)))) - (cider-emit-into-popup-buffer output-buffer output) - (pop-to-buffer output-buffer))) - (`repl-buffer (funcall repl-emit-function output)) - (_ (error "Unsupported value %s for `cider-interactive-eval-output-destination'" - cider-interactive-eval-output-destination)))) - -(defun cider-emit-interactive-eval-output (output) - "Emit OUTPUT resulting from interactive code evaluation. -The output can be send to either a dedicated output buffer or the current -REPL buffer. This is controlled via -`cider-interactive-eval-output-destination'." - (cider--emit-interactive-eval-output output 'cider-repl-emit-interactive-stdout)) - -(defun cider-emit-interactive-eval-err-output (output) - "Emit err OUTPUT resulting from interactive code evaluation. -The output can be send to either a dedicated output buffer or the current -REPL buffer. This is controlled via -`cider-interactive-eval-output-destination'." - (cider--emit-interactive-eval-output output 'cider-repl-emit-interactive-stderr)) - -(defun cider--make-fringe-overlays-for-region (beg end) - "Place eval indicators on all sexps between BEG and END." - (with-current-buffer (if (markerp end) - (marker-buffer end) - (current-buffer)) - (save-excursion - (goto-char beg) - (remove-overlays beg end 'category 'cider-fringe-indicator) - (condition-case nil - (while (progn (clojure-forward-logical-sexp) - (and (<= (point) end) - (not (eobp)))) - (cider--make-fringe-overlay (point))) - (scan-error nil))))) - -(defun cider--error-phase-of-last-exception (buffer) - "Returns the :phase of the latest exception associated to BUFFER, if any." - (when (cider-clojure-compilation-error-phases) - (when-let ((conn (with-current-buffer buffer - (cider-current-repl)))) - (when (cider-nrepl-op-supported-p "analyze-last-stacktrace" conn) - (when-let* ((result (nrepl-send-sync-request (thread-last (map-merge 'list - '(("op" "analyze-last-stacktrace")) - (cider--nrepl-print-request-map fill-column)) - (seq-mapcat #'identity)) - conn))) - (nrepl-dict-get result "phase")))))) - -(defcustom cider-inline-error-message-function #'cider--shorten-error-message - "A function that will shorten a given error message, -as shown in overlays / the minibuffer (per `cider-use-overlays'). - -The function takes a single arg. You may want to use `identity', -for leaving the message as-is." - :type 'boolean - :group 'cider - :package-version '(cider . "1.19.0")) - -(defun cider--shorten-error-message (err) - "Removes from ERR the prefix matched by `cider-clojure-compilation-regexp', -and the suffix matched by `cider-module-info-regexp'." - (thread-last err - (replace-regexp-in-string cider-clojure-compilation-regexp - "") - (replace-regexp-in-string cider-module-info-regexp - "") - (string-trim))) - -(defun cider--maybe-display-error-as-overlay (phase err end) - "Possibly display ERR as an overlay honoring END, -depending on the PHASE." - (when (or - ;; if we won't show *cider-error*, because of configuration, the overlay is adequate because it compensates for the lack of info in a compact manner: - (not cider-show-error-buffer) - (not (cider-connection-has-capability-p 'jvm-compilation-errors)) - ;; if we won't show *cider-error*, because of an ignored phase, the overlay is adequate: - (and cider-show-error-buffer - (member phase (cider-clojure-compilation-error-phases)))) - ;; Display errors as temporary overlays - (let ((cider-result-use-clojure-font-lock nil) - (trimmed-err (funcall cider-inline-error-message-function err))) - (cider--display-interactive-eval-result trimmed-err - 'error - end - 'cider-error-overlay-face)))) - -(declare-function cider-inspect-last-result "cider-inspector") -(defun cider-interactive-eval-handler (&optional buffer place) - "Make an interactive eval handler for BUFFER. -PLACE is used to display the evaluation result. -If non-nil, it can be the position where the evaluated sexp ends, -or it can be a list with (START END) of the evaluated region. -Update the cider-inspector buffer with the evaluation result -when `cider-auto-inspect-after-eval' is non-nil." - - (let* ((eval-buffer (current-buffer)) - (beg (car-safe place)) - (end (or (car-safe (cdr-safe place)) place)) - (beg (when beg (copy-marker beg))) - (end (when end (copy-marker end))) - (fringed nil) - (res "")) - (nrepl-make-response-handler (or buffer eval-buffer) - (lambda (_buffer value) - (setq res (concat res value)) - (cider--display-interactive-eval-result res 'value end)) - (lambda (_buffer out) - (cider-emit-interactive-eval-output out)) - (lambda (buffer err) - (cider-emit-interactive-eval-err-output err) - - (let ((phase (cider--error-phase-of-last-exception buffer))) - - (cider--maybe-display-error-as-overlay phase err end) - - (cider-handle-compilation-errors err - eval-buffer - ;; we prevent jumping behavior on compilation errors, - ;; because lines tend to be spurious (e.g. 0:0) - ;; and because on compilation errors, normally - ;; the error is 'right there' in the current line - ;; and needs no jumping: - phase))) - (lambda (buffer) - (if beg - (unless fringed - (cider--make-fringe-overlays-for-region beg end) - (setq fringed t)) - (cider--make-fringe-overlay end)) - (when (and cider-auto-inspect-after-eval - (boundp 'cider-inspector-buffer) - (windowp (get-buffer-window cider-inspector-buffer 'visible))) - (cider-inspect-last-result) - (select-window (get-buffer-window buffer))) - (when cider-eval-register - (set-register cider-eval-register res)))))) - - -(defun cider-load-file-handler (&optional buffer done-handler) - "Make a load file handler for BUFFER. -Optional argument DONE-HANDLER lambda will be run once load is complete." - (let ((eval-buffer (current-buffer)) - (res "")) - (nrepl-make-response-handler (or buffer eval-buffer) - (lambda (buffer value) - (cider--display-interactive-eval-result value 'value) - (when cider-eval-register - (setq res (concat res value))) - (when (buffer-live-p buffer) - (with-current-buffer buffer - (cider--make-fringe-overlays-for-region (point-min) (point-max)) - (run-hooks 'cider-file-loaded-hook)))) - (lambda (_buffer value) - (cider-emit-interactive-eval-output value)) - (lambda (_buffer err) - (cider-emit-interactive-eval-err-output err) - ;; 1.- Jump to the error line: - (cider-handle-compilation-errors err eval-buffer) - (with-current-buffer eval-buffer - (let* ((phase (cider--error-phase-of-last-exception buffer)) - ;; 2.- Calculate the overlay position, which is the point (per the previous jump), - ;; and then end-of-line (for ensuring the overlay will be rendered properly): - (end (save-excursion - (when (equal cider-result-overlay-position 'at-eol) - (end-of-line)) - (point)))) - (cider--maybe-display-error-as-overlay phase err end)))) - (lambda (buffer) - (when cider-eval-register - (set-register cider-eval-register res)) - (when done-handler - (funcall done-handler buffer))) - (lambda () - (funcall nrepl-err-handler))))) - -(defun cider-eval-print-handler (&optional buffer) - "Make a handler for evaluating and printing result in BUFFER." - ;; NOTE: cider-eval-register behavior is not implemented here for performance reasons. - ;; See https://github.com/clojure-emacs/cider/pull/3162 - (nrepl-make-response-handler (or buffer (current-buffer)) - (lambda (buffer value) - (with-current-buffer buffer - (insert - (if (derived-mode-p 'cider-clojure-interaction-mode) - (format "\n%s\n" value) - value)))) - (lambda (_buffer out) - (cider-emit-interactive-eval-output out)) - (lambda (_buffer err) - (cider-emit-interactive-eval-err-output err)) - ())) - -(defun cider-eval-print-with-comment-handler (buffer location comment-prefix) - "Make a handler for evaluating and printing commented results in BUFFER. -LOCATION is the location marker at which to insert. COMMENT-PREFIX is the -comment prefix to use." - (let ((res "")) - (nrepl-make-response-handler buffer - (lambda (_buffer value) - (setq res (concat res value))) - (lambda (_buffer out) - (cider-emit-interactive-eval-output out)) - (lambda (_buffer err) - (cider-emit-interactive-eval-err-output err)) - (lambda (buffer) - (with-current-buffer buffer - (save-excursion - (goto-char (marker-position location)) - (insert (concat comment-prefix - res "\n")))) - (when cider-eval-register - (set-register cider-eval-register res)))))) - -(defun cider-maybe-insert-multiline-comment (result comment-prefix continued-prefix comment-postfix) - "Insert eval RESULT at current location if RESULT is not empty. -RESULT will be preceded by COMMENT-PREFIX. -CONTINUED-PREFIX is inserted for each additional line of output. -COMMENT-POSTFIX is inserted after final text output." - (unless (string= result "") - (clojure-indent-line) - (let ((lines (split-string result "[\n]+" t)) - (beg (point)) - (col (current-indentation))) - ;; only the first line gets the normal comment-prefix - (insert (concat comment-prefix (pop lines))) - (dolist (elem lines) - (insert (concat "\n" continued-prefix elem))) - (indent-rigidly beg (point) col) - (unless (string= comment-postfix "") - (insert comment-postfix))))) - -(defun cider-eval-pprint-with-multiline-comment-handler (buffer location comment-prefix continued-prefix comment-postfix) - "Make a handler for evaluating and inserting results in BUFFER. -The inserted text is pretty-printed and region will be commented. -LOCATION is the location marker at which to insert. -COMMENT-PREFIX is the comment prefix for the first line of output. -CONTINUED-PREFIX is the comment prefix to use for the remaining lines. -COMMENT-POSTFIX is the text to output after the last line." - (let ((res "")) - (nrepl-make-response-handler - buffer - (lambda (_buffer value) - (setq res (concat res value))) - nil - (lambda (_buffer err) - (setq res (concat res err))) - (lambda (buffer) - (with-current-buffer buffer - (save-excursion - (goto-char (marker-position location)) - ;; edge case: defun at eob - (unless (bolp) (insert "\n")) - (cider-maybe-insert-multiline-comment res comment-prefix continued-prefix comment-postfix))) - (when cider-eval-register - (set-register cider-eval-register res))) - nil - nil - (lambda (_buffer warning) - (setq res (concat res warning)))))) - -(defun cider-popup-eval-handler (&optional buffer bounds source-buffer) - "Make a handler for printing evaluation results in popup BUFFER, -BOUNDS representing the buffer bounds of the evaled input, -and SOURCE-BUFFER the original buffer - -This is used by pretty-printing commands." - ;; NOTE: cider-eval-register behavior is not implemented here for performance reasons. - ;; See https://github.com/clojure-emacs/cider/pull/3162 - (let ((chosen-buffer (or buffer (current-buffer)))) - (nrepl-make-response-handler - chosen-buffer - ;; value handler: - (lambda (buffer value) - (cider-emit-into-popup-buffer buffer (ansi-color-apply value) nil t)) - ;; stdout handler: - (lambda (_buffer out) - (cider-emit-interactive-eval-output out)) - ;; stderr handler: - (lambda (buffer err) - (cider-emit-interactive-eval-err-output err) - (when (and source-buffer - (listp bounds)) ;; if it's a list, it represents bounds, otherwise it's a string (code) and we can't display the overlay - (with-current-buffer source-buffer - (let* ((phase (cider--error-phase-of-last-exception buffer)) - (end (or (car-safe (cdr-safe bounds)) bounds)) - (end (when end - (copy-marker end)))) - (cider--maybe-display-error-as-overlay phase err end))))) - ;; done handler: - nil - ;; eval-error handler: - (lambda () - (when (and (buffer-live-p chosen-buffer) - (member (buffer-name chosen-buffer) - cider-ancillary-buffers)) - (with-selected-window (get-buffer-window chosen-buffer) - (cider-popup-buffer-quit-function t))) - ;; also call the default nrepl-err-handler, so that our custom behavior doesn't void the base behavior: - (when nrepl-err-handler - (funcall nrepl-err-handler))) - ;; content type handler: - nil - ;; truncated handler: - (lambda (buffer warning) - (cider-emit-into-popup-buffer buffer warning 'font-lock-warning-face t))))) - - -;;; Interactive valuation commands - -(defvar cider-to-nrepl-filename-function - (with-no-warnings - (lambda (path) - (let ((path* (if (eq system-type 'cygwin) - (cygwin-convert-file-name-to-windows path) - path))) - (or (cider--translate-path-to-nrepl path*) path*)))) - "Function to translate Emacs filenames to nREPL namestrings.") - -(defun cider--prep-interactive-eval (form connection) - "Prepare the environment for an interactive eval of FORM in CONNECTION. -Ensure the current ns declaration has been evaluated (so that the ns -containing FORM exists). Cache ns-form in the current buffer unless FORM is -ns declaration itself. Clear any compilation highlights and kill the error -window." - (cider--clear-compilation-highlights) - (cider--quit-error-window) - (let ((cur-ns-form (cider-ns-form))) - (when (and cur-ns-form - (not (cider-ns-form-p form)) - (cider-repl--ns-form-changed-p cur-ns-form connection)) - (when cider-auto-track-ns-form-changes - ;; The first interactive eval on a file can load a lot of libs. This can - ;; easily lead to more than 10 sec. - (let ((nrepl-sync-request-timeout 30)) - ;; TODO: check for evaluation errors - (cider-nrepl-sync-request:eval cur-ns-form connection))) - ;; cache at the end, in case of errors - (cider-repl--cache-ns-form cur-ns-form connection)))) - -(defvar-local cider-interactive-eval-override nil - "Function to call instead of `cider-interactive-eval'.") - -(defun cider-interactive-eval (form &optional callback bounds additional-params) - "Evaluate FORM and dispatch the response to CALLBACK. -If the code to be evaluated comes from a buffer, it is preferred to use a -nil FORM, and specify the code via the BOUNDS argument instead. - -This function is the main entry point in CIDER's interactive evaluation -API. Most other interactive eval functions should rely on this function. -If CALLBACK is nil use `cider-interactive-eval-handler'. -BOUNDS, if non-nil, is a list of two numbers marking the start and end -positions of FORM in its buffer. -ADDITIONAL-PARAMS is a map to be merged into the request message. - -If `cider-interactive-eval-override' is a function, call it with the same -arguments and only proceed with evaluation if it returns nil." - (let ((form (or form (apply #'buffer-substring-no-properties bounds))) - (start (car-safe bounds)) - (end (car-safe (cdr-safe bounds)))) - (when (and start end) - ;; NOTE: don't use `remove-overlays' as it splits and leaves behind - ;; partial overlays, leading to duplicate eval results in some situations. - (dolist (ov (overlays-in start end)) - (when (eq (overlay-get ov 'cider-temporary) t) - (delete-overlay ov)))) - (unless (and cider-interactive-eval-override - (functionp cider-interactive-eval-override) - (funcall cider-interactive-eval-override form callback bounds)) - (cider-map-repls :auto - (lambda (connection) - (cider--prep-interactive-eval form connection) - (cider-nrepl-request:eval - form - (or callback (cider-interactive-eval-handler nil bounds)) - ;; always eval ns forms in the user namespace - ;; otherwise trying to eval ns form for the first time will produce an error - (if (cider-ns-form-p form) "user" (cider-current-ns)) - (when start (line-number-at-pos start)) - (when start (cider-column-number-at-pos start)) - (seq-mapcat #'identity additional-params) - connection)))))) - -(defun cider-eval-region (start end) - "Evaluate the region between START and END." - (interactive "r") - (cider-interactive-eval nil - nil - (list start end) - (cider--nrepl-pr-request-map))) - -(defun cider-eval-last-sexp (&optional output-to-current-buffer) - "Evaluate the expression preceding point. -If invoked with OUTPUT-TO-CURRENT-BUFFER, print the result in the current -buffer." - (interactive "P") - (cider-interactive-eval nil - (when output-to-current-buffer (cider-eval-print-handler)) - (cider-last-sexp 'bounds) - (cider--nrepl-pr-request-map))) - -(defun cider-eval-last-sexp-and-replace () - "Evaluate the expression preceding point and replace it with its result." - (interactive) - (let ((last-sexp (cider-last-sexp))) - ;; we have to be sure the evaluation won't result in an error - (cider-nrepl-sync-request:eval last-sexp) - ;; seems like the sexp is valid, so we can safely kill it - (let ((opoint (point))) - (clojure-backward-logical-sexp) - (kill-region (point) opoint)) - (cider-interactive-eval last-sexp - (cider-eval-print-handler) - nil - (cider--nrepl-pr-request-map)))) - -(defun cider-eval-list-at-point (&optional output-to-current-buffer) - "Evaluate the list (eg. a function call, surrounded by parens) around point. -If invoked with OUTPUT-TO-CURRENT-BUFFER, output the result to current buffer." - (interactive "P") - (save-excursion - (goto-char (cadr (cider-list-at-point 'bounds))) - (cider-eval-last-sexp output-to-current-buffer))) - -(defun cider-eval-sexp-at-point (&optional output-to-current-buffer) - "Evaluate the expression around point. -If invoked with OUTPUT-TO-CURRENT-BUFFER, output the result to current buffer." - (interactive "P") - (save-excursion - (goto-char (cadr (cider-sexp-at-point 'bounds))) - (cider-eval-last-sexp output-to-current-buffer))) - -(defun cider-tap-last-sexp (&optional output-to-current-buffer) - "Evaluate and tap the expression preceding point. -If invoked with OUTPUT-TO-CURRENT-BUFFER, print the result in the current -buffer." - (interactive "P") - (let ((tapped-form (concat "(clojure.core/doto " (cider-last-sexp) " (clojure.core/tap>))"))) - (cider-interactive-eval tapped-form - (when output-to-current-buffer (cider-eval-print-handler)) - nil - (cider--nrepl-pr-request-map)))) - -(defun cider-tap-sexp-at-point (&optional output-to-current-buffer) - "Evaluate and tap the expression around point. -If invoked with OUTPUT-TO-CURRENT-BUFFER, output the result to current buffer." - (interactive "P") - (save-excursion - (goto-char (cadr (cider-sexp-at-point 'bounds))) - (cider-tap-last-sexp output-to-current-buffer))) - -(defvar-local cider-previous-eval-context nil - "The previous evaluation context if any. -That's set by commands like `cider-eval-last-sexp-in-context'.") - - -(defun cider--guess-eval-context () - "Return context for `cider--eval-in-context'. -This is done by extracting all parent let bindings." - (save-excursion - (let ((res "")) - (condition-case nil - (while t - (backward-up-list) - (when (looking-at (rx "(" (or "when-let" "if-let" "let") (opt "*") - symbol-end (* space) - (group "["))) ;; binding vector - (let ((beg (match-end 1)) - (end (save-excursion - (goto-char (match-beginning 1)) - (forward-sexp 1) - (1- (point))))) - (setq res (concat (buffer-substring-no-properties beg end) ", " res))))) - (scan-error res))))) - -(defun cider--eval-in-context (bounds &optional guess) - "Evaluate code at BOUNDS in user-provided evaluation context. -When GUESS is non-nil, attempt to extract the context from parent let-bindings." - (let* ((code (string-trim-right - (buffer-substring-no-properties (car bounds) (cadr bounds)))) - (eval-context - (minibuffer-with-setup-hook (if guess #'beginning-of-buffer #'ignore) - (read-string "Evaluation context (let-style): " - (if guess (cider--guess-eval-context) - cider-previous-eval-context)))) - (code (concat "(let [" eval-context "]\n " code ")"))) - (setq-local cider-previous-eval-context eval-context) - (cider-interactive-eval code - nil - bounds - (cider--nrepl-pr-request-map)))) - -(defun cider-eval-last-sexp-in-context (guess) - "Evaluate the preceding sexp in user-supplied context. -The context is just a let binding vector (without the brackets). -The context is remembered between command invocations. - -When GUESS is non-nil, or called interactively with \\[universal-argument], -attempt to extract the context from parent let-bindings." - (interactive "P") - (cider--eval-in-context (cider-last-sexp 'bounds) guess)) - -(defun cider-eval-sexp-at-point-in-context (guess) - "Evaluate the sexp around point in user-supplied context. - -The context is just a let binding vector (without the brackets). -The context is remembered between command invocations. - -When GUESS is non-nil, or called interactively with \\[universal-argument], -attempt to extract the context from parent let-bindings." - (interactive "P") - (cider--eval-in-context (cider-sexp-at-point 'bounds) guess)) - -(defun cider-eval-defun-to-comment (&optional insert-before) - "Evaluate the \"top-level\" form and insert result as comment. - -The formatting of the comment is defined in `cider-comment-prefix' -which, by default, is \";; => \" and can be customized. - -With the prefix arg INSERT-BEFORE, insert before the form, otherwise afterwards." - (interactive "P") - (let* ((bounds (cider-defun-at-point 'bounds)) - (insertion-point (nth (if insert-before 0 1) bounds))) - (cider-interactive-eval nil - (cider-eval-print-with-comment-handler - (current-buffer) - (set-marker (make-marker) insertion-point) - cider-comment-prefix) - bounds - (cider--nrepl-pr-request-map)))) - -(defun cider-pprint-form-to-comment (form-fn insert-before) - "Evaluate the form selected by FORM-FN and insert result as comment. -FORM-FN can be either `cider-last-sexp' or `cider-defun-at-point'. - -The formatting of the comment is controlled via three options: - `cider-comment-prefix' \";; => \" - `cider-comment-continued-prefix' \";; \" - `cider-comment-postfix' \"\" - -so that with customization you can optionally wrap the output -in the reader macro \"#_( .. )\", or \"(comment ... )\", or any -other desired formatting. - -If INSERT-BEFORE is non-nil, insert before the form, otherwise afterwards." - (let* ((bounds (funcall form-fn 'bounds)) - (insertion-point (nth (if insert-before 0 1) bounds)) - ;; when insert-before, we need a newline after the output to - ;; avoid commenting the first line of the form - (comment-postfix (concat cider-comment-postfix - (if insert-before "\n" "")))) - (cider-interactive-eval nil - (cider-eval-pprint-with-multiline-comment-handler - (current-buffer) - (set-marker (make-marker) insertion-point) - cider-comment-prefix - cider-comment-continued-prefix - comment-postfix) - bounds - (cider--nrepl-print-request-map fill-column)))) - -(defun cider-pprint-eval-last-sexp-to-comment (&optional insert-before) - "Evaluate the last sexp and insert result as comment. - -The formatting of the comment is controlled via three options: - `cider-comment-prefix' \";; => \" - `cider-comment-continued-prefix' \";; \" - `cider-comment-postfix' \"\" - -so that with customization you can optionally wrap the output -in the reader macro \"#_( .. )\", or \"(comment ... )\", or any -other desired formatting. - -If INSERT-BEFORE is non-nil, insert before the form, otherwise afterwards." - (interactive "P") - (cider-pprint-form-to-comment 'cider-last-sexp insert-before)) - -(defun cider-pprint-eval-defun-to-comment (&optional insert-before) - "Evaluate the \"top-level\" form and insert result as comment. - -The formatting of the comment is controlled via three options: - `cider-comment-prefix' \";; => \" - `cider-comment-continued-prefix' \";; \" - `cider-comment-postfix' \"\" - -so that with customization you can optionally wrap the output -in the reader macro \"#_( .. )\", or \"(comment ... )\", or any -other desired formatting. - -If INSERT-BEFORE is non-nil, insert before the form, otherwise afterwards." - (interactive "P") - (cider-pprint-form-to-comment 'cider-defun-at-point insert-before)) - -(declare-function cider-switch-to-repl-buffer "cider-mode") - -(defun cider--eval-last-sexp-to-repl (switch-to-repl request-map) - "Evaluate the expression preceding point and insert its result in the REPL, -honoring SWITCH-TO-REPL, REQUEST-MAP." - (let ((bounds (cider-last-sexp 'bounds))) - (cider-interactive-eval nil - (cider-insert-eval-handler (cider-current-repl) - bounds - (current-buffer) - (lambda () - (when switch-to-repl - (cider-switch-to-repl-buffer)))) - bounds - request-map))) - -(defun cider-eval-last-sexp-to-repl (&optional prefix) - "Evaluate the expression preceding point and insert its result in the REPL. -If invoked with a PREFIX argument, switch to the REPL buffer." - (interactive "P") - (cider--eval-last-sexp-to-repl prefix (cider--nrepl-pr-request-map))) - -(defun cider-pprint-eval-last-sexp-to-repl (&optional prefix) - "Evaluate expr before point and insert its pretty-printed result in the REPL. -If invoked with a PREFIX argument, switch to the REPL buffer." - (interactive "P") - (cider--eval-last-sexp-to-repl prefix (cider--nrepl-print-request-map fill-column))) - -(defun cider-eval-print-last-sexp (&optional pretty-print) - "Evaluate the expression preceding point. -Print its value into the current buffer. -With an optional PRETTY-PRINT prefix it pretty-prints the result." - (interactive "P") - (cider-interactive-eval nil - (cider-eval-print-handler) - (cider-last-sexp 'bounds) - (if pretty-print - (cider--nrepl-print-request-map fill-column) - (cider--nrepl-pr-request-map)))) - -(defun cider--pprint-eval-form (form) - "Pretty print FORM in popup buffer." - (let* ((buffer (current-buffer)) - (result-buffer (cider-popup-buffer cider-result-buffer nil 'clojure-mode 'ancillary)) - (handler (cider-popup-eval-handler result-buffer form buffer))) - (with-current-buffer buffer - (cider-interactive-eval (when (stringp form) form) - handler - (when (consp form) form) - (cider--nrepl-print-request-map fill-column))))) - -(defun cider-pprint-eval-last-sexp (&optional output-to-current-buffer) - "Evaluate the sexp preceding point and pprint its value. -If invoked with OUTPUT-TO-CURRENT-BUFFER, insert as comment in the current -buffer, else display in a popup buffer." - (interactive "P") - (if output-to-current-buffer - (cider-pprint-eval-last-sexp-to-comment) - (cider--pprint-eval-form (cider-last-sexp 'bounds)))) - -(defun cider--prompt-and-insert-inline-dbg () - "Insert a #dbg button at the current sexp." - (save-excursion - (let ((beg)) - (skip-chars-forward "\r\n[:blank:]") - (unless (looking-at-p "(") - (ignore-errors (backward-up-list))) - (setq beg (point)) - (let* ((cond (cider-read-from-minibuffer "Condition for debugging (leave empty for \"always\"): ")) - (button (propertize (concat "#dbg" - (unless (equal cond "") - (format " ^{:break/when %s}" cond))) - 'font-lock-face 'cider-fragile-button-face))) - (when (> (current-column) 30) - (insert "\n") - (indent-according-to-mode)) - (insert button) - (when (> (current-column) 40) - (insert "\n") - (indent-according-to-mode))) - (make-button beg (point) - 'help-echo "Breakpoint. Reevaluate this form to remove it." - :type 'cider-fragile)))) - -(defun cider-eval-dwim (&optional debug-it) - "If no region is active, call `cider-eval-defun-at-point' with DEBUG-IT. -If a region is active, run `cider-eval-region'. - -Always binds `clojure-toplevel-inside-comment-form' to t." - (interactive "P") - (let ((clojure-toplevel-inside-comment-form t)) - (if (use-region-p) - (cider-eval-region (region-beginning) (region-end)) - (cider-eval-defun-at-point debug-it)))) - -(defun cider-eval-defun-at-point (&optional debug-it) - "Evaluate the current toplevel form, and print result in the minibuffer. -With DEBUG-IT prefix argument, also debug the entire form as with the -command `cider-debug-defun-at-point'." - (interactive "P") - (let ((inline-debug (eq 16 (car-safe debug-it)))) - (when debug-it - (when (derived-mode-p 'clojurescript-mode) - (when (y-or-n-p (concat "The debugger doesn't support ClojureScript yet, and we need help with that." - " \nWould you like to read the Feature Request?")) - (browse-url "https://github.com/clojure-emacs/cider/issues/1416")) - (user-error "The debugger does not support ClojureScript")) - (when inline-debug - (cider--prompt-and-insert-inline-dbg))) - (cider-interactive-eval (when (and debug-it (not inline-debug)) - (concat "#dbg\n" (cider-defun-at-point))) - nil - (cider-defun-at-point 'bounds) - (cider--nrepl-pr-request-map)))) - -(defun cider--insert-closing-delimiters (code) - "Closes all open parenthesized or bracketed expressions of CODE." - (with-temp-buffer - (insert code) - (goto-char (point-max)) - (let ((matching-delimiter nil)) - (while (ignore-errors - (save-excursion - (backward-up-list 1) - (setq matching-delimiter (cdr (syntax-after (point))))) - t) - (insert-char matching-delimiter))) - (buffer-string))) - -(defun cider-eval-defun-up-to-point (&optional output-to-current-buffer) - "Evaluate the current toplevel form up to point. -If invoked with OUTPUT-TO-CURRENT-BUFFER, print the result in the current -buffer. It constructs an expression to eval in the following manner: - -- It find the code between the point and the start of the toplevel expression; -- It balances this bit of code by closing all open expressions; -- It evaluates the resulting code using `cider-interactive-eval'." - (interactive "P") - (let* ((beg-of-defun (save-excursion (beginning-of-defun-raw) (point))) - (code (buffer-substring-no-properties beg-of-defun (point))) - (code (cider--insert-closing-delimiters code))) - (cider-interactive-eval code - (when output-to-current-buffer - (cider-eval-print-handler)) - (list beg-of-defun (point)) - (cider--nrepl-pr-request-map)))) - -(defun cider--matching-delimiter (delimiter) - "Get the matching (opening/closing) delimiter for DELIMITER." - (pcase delimiter - (?\( ?\)) - (?\[ ?\]) - (?\{ ?\}) - (?\) ?\() - (?\] ?\[) - (?\} ?\{))) - -(defun cider-eval-sexp-up-to-point (&optional output-to-current-buffer) - "Evaluate the current sexp form up to point. -If invoked with OUTPUT-TO-CURRENT-BUFFER, print the result in the current -buffer. It constructs an expression to eval in the following manner: - -- It finds the code between the point and the start of the sexp expression; -- It balances this bit of code by closing the expression; -- It evaluates the resulting code using `cider-interactive-eval'." - (interactive "P") - (let* ((beg-of-sexp (save-excursion (up-list) (backward-list) (point))) - (beg-delimiter (save-excursion (up-list) (backward-list) (char-after))) - (beg-set? (save-excursion (up-list) (backward-list) (char-before))) - (code (buffer-substring-no-properties beg-of-sexp (point))) - (code (if (= beg-set? ?#) (concat (list beg-set?) code) code)) - (code (concat code (list (cider--matching-delimiter beg-delimiter))))) - (cider-interactive-eval code - (when output-to-current-buffer - (cider-eval-print-handler)) - (list beg-of-sexp (point)) - (cider--nrepl-pr-request-map)))) - -(defun cider-pprint-eval-defun-at-point (&optional output-to-current-buffer) - "Evaluate the \"top-level\" form at point and pprint its value. -If invoked with OUTPUT-TO-CURRENT-BUFFER, insert as comment in the current -buffer, else display in a popup buffer." - (interactive "P") - (if output-to-current-buffer - (cider-pprint-eval-defun-to-comment) - (cider--pprint-eval-form (cider-defun-at-point 'bounds)))) - -(defun cider-eval-ns-form (&optional undef-all) - "Evaluate the current buffer's namespace form. -When UNDEF-ALL is non-nil, unmap all symbols and aliases first." - (interactive "P") - (when-let ((ns (cider-get-ns-name))) - (save-excursion - (goto-char (match-beginning 0)) - (when undef-all - (cider-undef-all ns)) - (cider-eval-defun-at-point)))) - -(defun cider-read-and-eval (&optional value) - "Read a sexp from the minibuffer and output its result to the echo area. -If VALUE is non-nil, it is inserted into the minibuffer as initial input." - (interactive) - (let* ((form (cider-read-from-minibuffer "Clojure Eval: " value)) - (override cider-interactive-eval-override) - (ns-form (if (cider-ns-form-p form) "" (format "(ns %s)" (cider-current-ns))))) - (with-current-buffer (get-buffer-create cider-read-eval-buffer) - (erase-buffer) - (clojure-mode) - (unless (string= "" ns-form) - (insert ns-form "\n\n")) - (insert form) - (let ((cider-interactive-eval-override override)) - (cider-interactive-eval form - nil - nil - (cider--nrepl-pr-request-map)))))) - -(defun cider-read-and-eval-defun-at-point () - "Insert the toplevel form at point in the minibuffer and output its result. -The point is placed next to the function name in the minibuffer to allow -passing arguments." - (interactive) - (let* ((fn-name (cadr (split-string (cider-defun-at-point)))) - (form (format "(%s)" fn-name))) - (cider-read-and-eval (cons form (length form))))) - -(defun cider-kill-last-result () - "Save the last evaluated result into the kill ring." - (interactive) - (kill-new - (nrepl-dict-get (cider-nrepl-sync-request:eval "*1") "value"))) - -(defun cider-undef () - "Undefine a symbol from the current ns." - (interactive) - (cider-ensure-op-supported "undef") - (cider-read-symbol-name - "Undefine symbol: " - (lambda (sym) - (cider-nrepl-send-request - `("op" "undef" - "ns" ,(cider-current-ns) - "sym" ,sym) - (cider-interactive-eval-handler (current-buffer)))))) - -(defun cider-undef-all (&optional ns) - "Undefine all symbols and aliases from the namespace NS." - (interactive) - (cider-ensure-op-supported "undef-all") - (cider-nrepl-send-sync-request - `("op" "undef-all" - "ns" ,(or ns (cider-current-ns))))) - -;; Eval keymaps -(defvar cider-eval-pprint-commands-map - (let ((map (define-prefix-command 'cider-eval-pprint-commands-map))) - ;; single key bindings defined last for display in menu - (define-key map (kbd "e") #'cider-pprint-eval-last-sexp) - (define-key map (kbd "d") #'cider-pprint-eval-defun-at-point) - (define-key map (kbd "c e") #'cider-pprint-eval-last-sexp-to-comment) - (define-key map (kbd "c d") #'cider-pprint-eval-defun-to-comment) - - ;; duplicates with C- for convenience - (define-key map (kbd "C-e") #'cider-pprint-eval-last-sexp) - (define-key map (kbd "C-d") #'cider-pprint-eval-defun-at-point) - (define-key map (kbd "C-c e") #'cider-pprint-eval-last-sexp-to-comment) - (define-key map (kbd "C-c C-e") #'cider-pprint-eval-last-sexp-to-comment) - (define-key map (kbd "C-c d") #'cider-pprint-eval-defun-to-comment) - (define-key map (kbd "C-c C-d") #'cider-pprint-eval-defun-to-comment) - map)) - -(defvar cider-eval-commands-map - (let ((map (define-prefix-command 'cider-eval-commands-map))) - ;; single key bindings defined last for display in menu - (define-key map (kbd "w") #'cider-eval-last-sexp-and-replace) - (define-key map (kbd "r") #'cider-eval-region) - (define-key map (kbd "n") #'cider-eval-ns-form) - (define-key map (kbd "s") #'cider-eval-dwim) - (define-key map (kbd "d") #'cider-eval-defun-at-point) - (define-key map (kbd "e") #'cider-eval-last-sexp) - (define-key map (kbd "q") #'cider-tap-last-sexp) - (define-key map (kbd "l") #'cider-eval-list-at-point) - (define-key map (kbd "v") #'cider-eval-sexp-at-point) - (define-key map (kbd "t") #'cider-tap-sexp-at-point) - (define-key map (kbd "o") #'cider-eval-sexp-up-to-point) - (define-key map (kbd ".") #'cider-read-and-eval-defun-at-point) - (define-key map (kbd "z") #'cider-eval-defun-up-to-point) - (define-key map (kbd "c") #'cider-eval-last-sexp-in-context) - (define-key map (kbd "b") #'cider-eval-sexp-at-point-in-context) - (define-key map (kbd "k") #'cider-kill-last-result) - (define-key map (kbd "f") 'cider-eval-pprint-commands-map) - - ;; duplicates with C- for convenience - (define-key map (kbd "C-w") #'cider-eval-last-sexp-and-replace) - (define-key map (kbd "C-r") #'cider-eval-region) - (define-key map (kbd "C-n") #'cider-eval-ns-form) - (define-key map (kbd "C-s") #'cider-eval-dwim) - (define-key map (kbd "C-d") #'cider-eval-defun-at-point) - (define-key map (kbd "C-e") #'cider-eval-last-sexp) - (define-key map (kbd "C-q") #'cider-tap-last-sexp) - (define-key map (kbd "C-l") #'cider-eval-list-at-point) - (define-key map (kbd "C-v") #'cider-eval-sexp-at-point) - (define-key map (kbd "C-t") #'cider-tap-sexp-at-point) - (define-key map (kbd "C-o") #'cider-eval-sexp-up-to-point) - (define-key map (kbd "C-.") #'cider-read-and-eval-defun-at-point) - (define-key map (kbd "C-z") #'cider-eval-defun-up-to-point) - (define-key map (kbd "C-c") #'cider-eval-last-sexp-in-context) - (define-key map (kbd "C-b") #'cider-eval-sexp-at-point-in-context) - (define-key map (kbd "C-k") #'cider-kill-last-result) - (define-key map (kbd "C-f") 'cider-eval-pprint-commands-map) - map)) - -(defun cider--file-string (file) - "Read the contents of a FILE and return as a string." - (with-current-buffer (find-file-noselect file) - (save-restriction - (widen) - (substring-no-properties (buffer-string))))) - -(defun cider-load-buffer (&optional buffer callback undef-all) - "Load (eval) BUFFER's file in nREPL. -If no buffer is provided the command acts on the current buffer. If the -buffer is for a cljc file, and both a Clojure and ClojureScript REPL exists -for the project, it is evaluated in both REPLs. -Optional argument CALLBACK will override the default ‘cider-load-file-handler’. -When UNDEF-ALL is non-nil or called with \\[universal-argument], removes -all ns aliases and var mappings from the namespace before reloading it." - (interactive (list (current-buffer) nil (equal current-prefix-arg '(4)))) - (setq buffer (or buffer (current-buffer))) - ;; When cider-load-buffer or cider-load-file are called in programs the - ;; current context might not match the buffer's context. We use the caller - ;; context instead of the buffer's context because that's the common use - ;; case. For the other use case just let-bind the default-directory. - (let ((orig-default-directory default-directory)) - (with-current-buffer buffer - (check-parens) - (let ((default-directory orig-default-directory)) - (unless buffer-file-name - (user-error "Buffer `%s' is not associated with a file" (current-buffer))) - (when (and cider-save-file-on-load - (buffer-modified-p) - (or (eq cider-save-file-on-load t) - (y-or-n-p (format "Save file %s? " buffer-file-name)))) - (save-buffer)) - (remove-overlays nil nil 'cider-temporary t) - (when undef-all - (cider-undef-all (cider-current-ns))) - (cider--clear-compilation-highlights) - (cider--quit-error-window) - (let ((filename (buffer-file-name buffer)) - (ns-form (cider-ns-form))) - (cider-map-repls :auto - (lambda (repl) - (when ns-form - (cider-repl--cache-ns-form ns-form repl)) - (cider-request:load-file (cider--file-string filename) - (funcall cider-to-nrepl-filename-function - (cider--server-filename filename)) - (file-name-nondirectory filename) - repl - callback))) - (message "Loading %s..." filename)))))) - -(defun cider-load-file (filename &optional undef-all) - "Load (eval) the Clojure file FILENAME in nREPL. -If the file is a cljc file, and both a Clojure and ClojureScript REPL -exists for the project, it is evaluated in both REPLs. The heavy lifting -is done by `cider-load-buffer'. -When UNDEF-ALL is non-nil or called with \\[universal-argument], removes -all ns aliases and var mappings from the namespace before reloading it." - (interactive (list - (read-file-name "Load file: " nil nil nil - (when (buffer-file-name) - (file-name-nondirectory - (buffer-file-name)))) - (equal current-prefix-arg '(4)))) - (if-let* ((buffer (find-buffer-visiting filename))) - (cider-load-buffer buffer nil undef-all) - (cider-load-buffer (find-file-noselect filename) nil undef-all))) - -(defun cider-load-all-files (directory undef-all) - "Load all files in DIRECTORY (recursively). -Useful when the running nREPL on remote host. -When UNDEF-ALL is non-nil or called with \\[universal-argument], removes -all ns aliases and var mappings from the namespaces being reloaded" - (interactive "DLoad files beneath directory: \nP") - (mapcar (lambda (file) (cider-load-file file undef-all)) - (directory-files-recursively directory "\\.clj[cs]?$"))) - -(defalias 'cider-eval-file #'cider-load-file - "A convenience alias as some people are confused by the load-* names.") - -(defalias 'cider-eval-all-files #'cider-load-all-files - "A convenience alias as some people are confused by the load-* names.") - -(defalias 'cider-eval-buffer #'cider-load-buffer - "A convenience alias as some people are confused by the load-* names.") - -(defun cider-load-all-project-ns () - "Load all namespaces in the current project." - (interactive) - (cider-ensure-connected) - (cider-ensure-op-supported "ns-load-all") - (when (y-or-n-p "Are you sure you want to load all namespaces in the project? ") - (message "Loading all project namespaces...") - (let ((loaded-ns-count (length (cider-sync-request:ns-load-all)))) - (message "Loaded %d namespaces" loaded-ns-count)))) - -(provide 'cider-eval) - -;;; cider-eval.el ends here diff --git a/elpa/cider-1.12.0/cider-find.el b/elpa/cider-1.12.0/cider-find.el @@ -1,285 +0,0 @@ -;;; cider-find.el --- Functionality for finding things -*- lexical-binding: t -*- - -;; Copyright © 2013-2023 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; -;; Author: Bozhidar Batsov <bozhidar@batsov.dev> -;; Artur Malabarba <bruce.connor.am@gmail.com> - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; A bunch of commands for finding resources and definitions. - -;;; Code: - -(require 'cider-client) -(require 'cider-common) -(require 'cider-resolve) - -(require 'thingatpt) - -(defun cider--find-var-other-window (var &optional line) - "Find the definition of VAR, optionally at a specific LINE. - -Display the results in a different window." - (if-let* ((info (cider-var-info var))) - (progn - (if line (setq info (nrepl-dict-put info "line" line))) - (cider--jump-to-loc-from-info info t)) - (user-error "Symbol `%s' not resolved" var))) - -(defun cider--find-var (var &optional line) - "Find the definition of VAR, optionally at a specific LINE." - (if-let* ((info (cider-var-info var))) - (progn - (if line (setq info (nrepl-dict-put info "line" line))) - (cider--jump-to-loc-from-info info)) - (user-error "Symbol `%s' not resolved" var))) - -;;;###autoload -(defun cider-find-var (&optional arg var line) - "Find definition for VAR at LINE. -Prompt according to prefix ARG and `cider-prompt-for-symbol'. -A single or double prefix argument inverts the meaning of -`cider-prompt-for-symbol'. A prefix of `-` or a double prefix argument causes -the results to be displayed in a different window. The default value is -thing at point." - (interactive "P") - (if var - (cider--find-var var line) - (funcall (cider-prompt-for-symbol-function arg) - "Symbol" - (if (cider--open-other-window-p arg) - #'cider--find-var-other-window - #'cider--find-var)))) - -;;;###autoload -(defun cider-find-dwim-at-mouse (event) - "Find and display variable or resource at mouse EVENT." - (interactive "e") - (if-let* ((symbol-file (save-excursion - (mouse-set-point event) - (cider-symbol-at-point 'look-back)))) - (cider-find-dwim symbol-file) - (user-error "No variable or resource here"))) - -(defun cider--find-dwim (symbol-file callback &optional other-window) - "Find the SYMBOL-FILE at point. -CALLBACK upon failure to invoke prompt if not prompted previously. -Show results in a different window if OTHER-WINDOW is true." - (if-let* ((info (cider-var-info symbol-file))) - (cider--jump-to-loc-from-info info other-window) - (progn - (cider-ensure-op-supported "resource") - (if-let* ((resource (cider-sync-request:resource symbol-file)) - (buffer (cider-find-file resource))) - (cider-jump-to buffer 0 other-window) - (if (cider--prompt-for-symbol-p current-prefix-arg) - (error "Resource or var %s not resolved" symbol-file) - (let ((current-prefix-arg (if current-prefix-arg nil '(4)))) - (call-interactively callback))))))) - -(defun cider--find-dwim-interactive (prompt) - "Get interactive arguments for jump-to functions using PROMPT as needed." - (if (cider--prompt-for-symbol-p current-prefix-arg) - (list - (cider-read-from-minibuffer prompt (thing-at-point 'filename))) - (list (or (thing-at-point 'filename) "")))) ; No prompt. - -(defun cider-find-dwim-other-window (symbol-file) - "Jump to SYMBOL-FILE at point, place results in other window." - (interactive (cider--find-dwim-interactive "Jump to: ")) - (cider--find-dwim symbol-file 'cider-find-dwim-other-window t)) - -;;;###autoload -(defun cider-find-dwim (symbol-file) - "Find and display the SYMBOL-FILE at point. -SYMBOL-FILE could be a var or a resource. If thing at point is empty then -show Dired on project. If var is not found, try to jump to resource of the -same name. When called interactively, a prompt is given according to the -variable `cider-prompt-for-symbol'. A single or double prefix argument -inverts the meaning. A prefix of `-' or a double prefix argument causes -the results to be displayed in a different window. A default value of thing -at point is given when prompted." - (interactive (cider--find-dwim-interactive "Jump to: ")) - (cider--find-dwim symbol-file `cider-find-dwim - (cider--open-other-window-p current-prefix-arg))) - -;;;###autoload -(defun cider-find-resource (path) - "Find the resource at PATH. -Prompt for input as indicated by the variable `cider-prompt-for-symbol'. -A single or double prefix argument inverts the meaning of -`cider-prompt-for-symbol'. A prefix argument of `-` or a double prefix -argument causes the results to be displayed in other window. The default -value is thing at point." - (interactive - (list - (if (cider--prompt-for-symbol-p current-prefix-arg) - (completing-read "Resource: " - (cider-sync-request:resources-list) - nil nil - (thing-at-point 'filename)) - (or (thing-at-point 'filename) "")))) - (cider-ensure-op-supported "resource") - (when (= (length path) 0) - (error "Cannot find resource for empty path")) - (if-let* ((resource (cider-sync-request:resource path)) - (buffer (cider-find-file resource))) - (cider-jump-to buffer nil (cider--open-other-window-p current-prefix-arg)) - (if (cider--prompt-for-symbol-p current-prefix-arg) - (error "Cannot find resource %s" path) - (let ((current-prefix-arg (cider--invert-prefix-arg current-prefix-arg))) - (call-interactively 'cider-find-resource))))) - -(defun cider--invert-prefix-arg (arg) - "Invert the effect of prefix value ARG on `cider-prompt-for-symbol'. -This function preserves the `other-window' meaning of ARG." - (let ((narg (prefix-numeric-value arg))) - (pcase narg - (16 -1) ; empty empty -> - - (-1 16) ; - -> empty empty - (4 nil) ; empty -> no-prefix - (_ 4)))) ; no-prefix -> empty - -(defun cider--prefix-invert-prompt-p (arg) - "Test prefix value ARG for its effect on `cider-prompt-for-symbol`." - (let ((narg (prefix-numeric-value arg))) - (pcase narg - (16 t) ; empty empty - (4 t) ; empty - (_ nil)))) - -(defun cider--prompt-for-symbol-p (&optional prefix) - "Check if cider should prompt for symbol. -Tests againsts PREFIX and the value of `cider-prompt-for-symbol'. -Invert meaning of `cider-prompt-for-symbol' if PREFIX indicates it should be." - (if (cider--prefix-invert-prompt-p prefix) - (not cider-prompt-for-symbol) cider-prompt-for-symbol)) - -(defun cider--find-ns (ns &optional other-window) - "Find the file containing NS's definition. -Optionally open it in a different window if OTHER-WINDOW is truthy." - (if-let* ((path (cider-sync-request:ns-path ns))) - (cider-jump-to (cider-find-file path) nil other-window) - (user-error "Can't find namespace `%s'" ns))) - -;;;###autoload -(defun cider-find-ns (&optional arg ns) - "Find the file containing NS. -A prefix ARG of `-` or a double prefix argument causes -the results to be displayed in a different window." - (interactive "P") - (cider-ensure-connected) - (cider-ensure-op-supported "ns-path") - (if ns - (cider--find-ns ns) - (let* ((namespaces (cider-sync-request:ns-list)) - (ns (completing-read "Find namespace: " namespaces))) - (cider--find-ns ns (cider--open-other-window-p arg))))) - -(defun cider--find-keyword-in-buffer (buffer kw) - "Returns the point where `KW' is found in `BUFFER'. -Returns nil of no matching keyword is found. -Occurrences of `KW' as (or within) strings, comments, #_ forms, symbols, etc -are disregarded." - (with-current-buffer buffer - (save-excursion - (goto-char (point-min)) - (font-lock-ensure) ;; make the forthcoming `text-properties-at` call useful - (let ((found nil) - (continue t) - (current-point (point))) - (while continue - (setq found (and (search-forward-regexp kw nil 'noerror) - (member 'clojure-keyword-face (text-properties-at (1- (point)))))) - (setq continue (and (not found) - ;; if we haven't moved, there's nothing left to search: - (not (equal current-point (point))))) - (setq current-point (point))) - (when found - current-point))))) - -(defun cider--find-keyword-loc (kw) - "Given `KW', returns an nrepl-dict with url, dest, dest-point. - -Returns the dict in all cases. `dest-point' indicates success: -integer on successful finds, nil otherwise." - (let* ((simple-ns-qualifier (and - (string-match "^:\\(.+\\)/.+$" kw) - (match-string 1 kw))) - (auto-resolved-ns-qualifier (and - (string-match "^::\\(.+\\)/.+$" kw) - (match-string 1 kw))) - (kw-ns (or (and auto-resolved-ns-qualifier - (or (cider-resolve-alias (cider-current-ns) auto-resolved-ns-qualifier) - (user-error "Could not resolve alias: %S" auto-resolved-ns-qualifier))) - (and (string-match "^::" kw) - (cider-current-ns :no-default)) - simple-ns-qualifier - (user-error "Not a ns-qualified keyword: %S" kw))) - (kw-name (replace-regexp-in-string "^:+\\(.+/\\)?" "" kw)) - (beginning-of-symbol "\\_<") - (end-of-symbol "\\_>") ;; important: if searching for foo, we don't want to match foobar (a larger symbol) - (kw-to-find (concat beginning-of-symbol - "\\(" - (concat "::" kw-name) - "\\|" - (concat ":" kw-ns "/" kw-name) - "\\)" - end-of-symbol))) - (let* ((url (when kw-ns - (cider-sync-request:ns-path kw-ns t))) - (dest (when url - (cider-find-file url))) - (dest-point (when dest - (cider--find-keyword-in-buffer dest kw-to-find)))) - (nrepl-dict "url" url "dest" dest "dest-point" dest-point)))) - -;;;###autoload -(defun cider-find-keyword (&optional arg) - "Find the namespace of the keyword at point and its primary occurrence there. - -For instance - if the keyword at point is \":cider.demo/keyword\", this command -would find the namespace \"cider.demo\" and afterwards find the primary (most relevant or first) -mention of \"::keyword\" there. - -Prompt according to prefix ARG and `cider-prompt-for-symbol'. -A single or double prefix argument inverts the meaning of -`cider-prompt-for-symbol'. A prefix of `-` or a double prefix argument causes -the results to be displayed in a different window. The default value is -thing at point." - (interactive "P") - (cider-ensure-connected) - (let* ((kw (let ((kw-at-point (cider-symbol-at-point 'look-back))) - (if (or cider-prompt-for-symbol arg) - (read-string - (format "Keyword (default %s): " kw-at-point) - nil nil kw-at-point) - kw-at-point))) - (before (buffer-list)) - (result (cider--find-keyword-loc kw))) - (nrepl-dbind-response result (dest dest-point) - (if dest-point - (cider-jump-to dest dest-point arg) - (progn - (unless (memq dest before) - (kill-buffer dest)) - (user-error "Couldn't find a definition for %S" kw)))))) - -(provide 'cider-find) -;;; cider-find.el ends here diff --git a/elpa/cider-1.12.0/cider-format.el b/elpa/cider-1.12.0/cider-format.el @@ -1,154 +0,0 @@ -;;; cider-format.el --- Code and EDN formatting functionality -*- lexical-binding: t -*- - -;; Copyright © 2013-2023 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; -;; Author: Bozhidar Batsov <bozhidar@batsov.dev> -;; Artur Malabarba <bruce.connor.am@gmail.com> - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Middleware-powered code and EDN formatting functionality. - -;;; Code: - -(require 'map) -(require 'seq) -(require 'subr-x) - -(require 'cider-client) -(require 'cider-util) - - -;; Format - -(defun cider--format-reindent (formatted start) - "Reindent FORMATTED to align with buffer position START." - (let* ((start-column (save-excursion (goto-char start) (current-column))) - (indent-line (concat "\n" (make-string start-column ? )))) - (replace-regexp-in-string "\n" indent-line formatted))) - - -;;; Format region - -(defun cider--format-region (start end formatter) - "Format the contents of the given region. - -START and END represent the region's boundaries. - -FORMATTER is a function of one argument which is used to convert -the string contents of the region into a formatted string. - -Uses the following heuristic to try to maintain point position: - -- Take a snippet of text starting at current position, up to 64 chars. -- Search for the snippet, with lax whitespace, in the formatted text. - - If snippet is less than 64 chars (point was near end of buffer), search - from end instead of beginning. -- Place point at match beginning, or `point-min' if no match." - (let* ((original (buffer-substring-no-properties start end)) - (formatted (funcall formatter original)) - (indented (cider--format-reindent formatted start))) - (unless (equal original indented) - (let* ((pos (point)) - (pos-max (1+ (buffer-size))) - (l 64) - (endp (> (+ pos l) pos-max)) - (snippet (thread-last - (buffer-substring-no-properties - pos (min (+ pos l) pos-max)) - (regexp-quote) - (replace-regexp-in-string "[[:space:]\t\n\r]+" "[[:space:]\t\n\r]*")))) - (delete-region start end) - (insert indented) - (goto-char (if endp (point-max) (point-min))) - (funcall (if endp #'re-search-backward #'re-search-forward) snippet nil t) - (goto-char (or (match-beginning 0) start)) - (when (looking-at-p "\n") (forward-char)))))) - -;;;###autoload -(defun cider-format-region (start end) - "Format the Clojure code in the current region. -START and END represent the region's boundaries." - (interactive "r") - (cider-ensure-connected) - (cider--format-region start end - (lambda (buf) - (cider-sync-request:format-code buf cider-format-code-options)))) - - -;;; Format defun - -;;;###autoload -(defun cider-format-defun () - "Format the code in the current defun." - (interactive) - (cider-ensure-connected) - (let ((defun-bounds (cider-defun-at-point 't))) - (cider-format-region (car defun-bounds) (cadr defun-bounds)))) - - -;;; Format buffer - -(defun cider--format-buffer (formatter) - "Format the contents of the current buffer. - -Uses FORMATTER, a function of one argument, to convert the string contents -of the buffer into a formatted string." - (cider--format-region 1 (1+ (buffer-size)) formatter)) - -;;;###autoload -(defun cider-format-buffer () - "Format the Clojure code in the current buffer." - (interactive) - (check-parens) - (cider-ensure-connected) - (cider--format-buffer (lambda (buf) - (cider-sync-request:format-code buf cider-format-code-options)))) - - -;;; Format EDN - -;;;###autoload -(defun cider-format-edn-buffer () - "Format the EDN data in the current buffer." - (interactive) - (check-parens) - (cider-ensure-connected) - (cider--format-buffer (lambda (edn) - (cider-sync-request:format-edn edn fill-column)))) - -;;;###autoload -(defun cider-format-edn-region (start end) - "Format the EDN data in the current region. -START and END represent the region's boundaries." - (interactive "r") - (cider-ensure-connected) - (let* ((start-column (save-excursion (goto-char start) (current-column))) - (right-margin (- fill-column start-column))) - (cider--format-region start end - (lambda (edn) - (cider-sync-request:format-edn edn right-margin))))) - -;;;###autoload -(defun cider-format-edn-last-sexp () - "Format the EDN data of the last sexp." - (interactive) - (apply #'cider-format-edn-region (cider-sexp-at-point 'bounds))) - -(provide 'cider-format) -;;; cider-format.el ends here diff --git a/elpa/cider-1.12.0/cider-inspector.el b/elpa/cider-1.12.0/cider-inspector.el @@ -1,794 +0,0 @@ -;;; cider-inspector.el --- Object inspector -*- lexical-binding: t -*- - -;; Copyright © 2013-2014 Vital Reactor, LLC -;; Copyright © 2014-2023 Bozhidar Batsov and CIDER contributors - -;; Author: Ian Eslick <ian@vitalreactor.com> -;; Bozhidar Batsov <bozhidar@batsov.dev> - -;; 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/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Clojure object inspector inspired by SLIME. - -;;; Code: - -(require 'cl-lib) -(require 'easymenu) -(require 'seq) -(require 'cider-eval) - -;; =================================== -;; Inspector Key Map and Derived Mode -;; =================================== - -(defconst cider-inspector-buffer "*cider-inspect*") - -;;; Customization -(defgroup cider-inspector nil - "Presentation and behavior of the CIDER value inspector." - :prefix "cider-inspector-" - :group 'cider - :package-version '(cider . "0.10.0")) - -(defcustom cider-inspector-page-size 32 - "Default page size in paginated inspector view. -The page size can be also changed interactively within the inspector." - :type '(integer :tag "Page size" 32) - :package-version '(cider . "0.10.0")) - -(defcustom cider-inspector-max-atom-length 150 - "Default max length of nested atoms before they are truncated. -'Atom' here means any collection member that satisfies (complement coll?). -The max length can be also changed interactively within the inspector." - :type '(integer :tag "Max atom length" 150) - :package-version '(cider . "1.1.0")) - -(defcustom cider-inspector-max-coll-size 5 - "Default number of nested collection members to display before truncating. -The max size can be also changed interactively within the inspector." - :type '(integer :tag "Max collection size" 5) - :package-version '(cider . "1.1.0")) - -(defcustom cider-inspector-fill-frame nil - "Controls whether the CIDER inspector window fills its frame." - :type 'boolean - :package-version '(cider . "0.15.0")) - -(defcustom cider-inspector-skip-uninteresting t - "Controls whether to skip over uninteresting values in the inspector. -Only applies to navigation with `cider-inspector-prev-inspectable-object' -and `cider-inspector-next-inspectable-object', values are still inspectable -by clicking or navigating to them by other means." - :type 'boolean - :package-version '(cider . "0.25.0")) - -(defcustom cider-inspector-auto-select-buffer t - "Determines if the inspector buffer should be auto selected." - :type 'boolean - :package-version '(cider . "0.27.0")) - -(defvar cider-inspector-uninteresting-regexp - (concat "nil" ; nils are not interesting - "\\|:" clojure--sym-regexp ; nor keywords - ;; FIXME: This range also matches ",", is it on purpose? - "\\|[+-.0-9]+") ; nor numbers. Note: BigInts, ratios etc. are interesting - "Regexp of uninteresting and skippable values.") - -(defun cider-inspector-open-thing-at-point () - "Opens the thing at point if found, without prompting." - (interactive) - (if-let ((url (thing-at-point 'url))) - (browse-url url) - (if-let ((filename (thing-at-point 'filename))) - (find-file filename)))) - -(defvar cider-inspector-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map cider-popup-buffer-mode-map) - (define-key map (kbd "RET") #'cider-inspector-operate-on-point) - (define-key map [mouse-1] #'cider-inspector-operate-on-click) - (define-key map "l" #'cider-inspector-pop) - (define-key map "g" #'cider-inspector-refresh) - (define-key map "o" #'cider-inspector-open-thing-at-point) - ;; Page-up/down - (define-key map [next] #'cider-inspector-next-page) - (define-key map [prior] #'cider-inspector-prev-page) - (define-key map " " #'cider-inspector-next-page) - (define-key map (kbd "M-SPC") #'cider-inspector-prev-page) - (define-key map (kbd "S-SPC") #'cider-inspector-prev-page) - (define-key map "s" #'cider-inspector-set-page-size) - (define-key map "a" #'cider-inspector-set-max-atom-length) - (define-key map "c" #'cider-inspector-set-max-coll-size) - (define-key map "d" #'cider-inspector-def-current-val) - (define-key map "t" #'cider-inspector-tap-current-val) - (define-key map "1" #'cider-inspector-tap-at-point) - (define-key map [tab] #'cider-inspector-next-inspectable-object) - (define-key map "\C-i" #'cider-inspector-next-inspectable-object) - (define-key map "n" #'cider-inspector-next-inspectable-object) - (define-key map [(shift tab)] #'cider-inspector-previous-inspectable-object) - (define-key map "p" #'cider-inspector-previous-inspectable-object) - (define-key map ":" #'cider-inspect-expr-from-inspector) - (define-key map "f" #'forward-char) - (define-key map "b" #'backward-char) - (define-key map "9" #'cider-inspector-previous-sibling) - (define-key map "0" #'cider-inspector-next-sibling) - ;; Emacs translates S-TAB to BACKTAB on X. - (define-key map [backtab] #'cider-inspector-previous-inspectable-object) - (easy-menu-define cider-inspector-mode-menu map - "Menu for CIDER's inspector." - `("CIDER Inspector" - ["Inspect" cider-inspector-operate-on-point] - ["Pop" cider-inspector-pop] - ["Refresh" cider-inspector-refresh] - "--" - ["Next Inspectable Object" cider-inspector-next-inspectable-object] - ["Previous Inspectable Object" cider-inspector-previous-inspectable-object] - "--" - ["Next Page" cider-inspector-next-page] - ["Previous Page" cider-inspector-prev-page] - ["Set Page Size" cider-inspector-set-page-size] - ["Set Max Atom Length" cider-inspector-set-max-atom-length] - ["Set Max Collection Size" cider-inspector-set-max-coll-size] - ["Define Var" cider-inspector-def-current-val] - "--" - ["Quit" cider-popup-buffer-quit-function] - )) - map)) - -(define-derived-mode cider-inspector-mode special-mode "Inspector" - "Major mode for inspecting Clojure data structures. - -\\{cider-inspector-mode-map}" - (set-syntax-table clojure-mode-syntax-table) - (setq-local electric-indent-chars nil) - (setq-local sesman-system 'CIDER) - (visual-line-mode 1)) - -;;;###autoload -(defun cider-inspect-last-sexp () - "Inspect the result of the the expression preceding point." - (interactive) - (cider-inspect-expr (cider-last-sexp) (cider-current-ns))) - -;;;###autoload -(defun cider-inspect-defun-at-point () - "Inspect the result of the \"top-level\" expression at point." - (interactive) - (cider-inspect-expr (cider-defun-at-point) (cider-current-ns))) - -;;;###autoload -(defun cider-inspect-last-result () - "Inspect the most recent eval result." - (interactive) - (cider-inspect-expr "*1" (cider-current-ns))) - -;;;###autoload -(defun cider-inspect (&optional arg) - "Inspect the result of the preceding sexp. - -With a prefix argument ARG it inspects the result of the \"top-level\" form. -With a second prefix argument it prompts for an expression to eval and inspect." - (interactive "p") - (pcase arg - (1 (cider-inspect-last-sexp)) - (4 (cider-inspect-defun-at-point)) - (16 (call-interactively #'cider-inspect-expr)))) - -(defvar cider-inspector-location-stack nil - "A stack used to save point locations in inspector buffers. -These locations are used to emulate `save-excursion' between -`cider-inspector-push' and `cider-inspector-pop' operations.") - -(defvar cider-inspector-page-location-stack nil - "A stack used to save point locations in inspector buffers. -These locations are used to emulate `save-excursion' between -`cider-inspector-next-page' and `cider-inspector-prev-page' operations.") - -(defvar cider-inspector-last-command nil - "Contains the value of the most recently used `cider-inspector-*' command. -This is used as an alternative to the built-in `last-command'. Whenever we -invoke any command through \\[execute-extended-command] and its variants, -the value of `last-command' is not set to the command it invokes.") - -(defvar cider-inspector--current-repl nil - "Contains the reference to the REPL where inspector was last invoked from. -This is needed for internal inspector buffer operations (push, -pop) to execute against the correct REPL session.") - -;; Operations -;;;###autoload -(defun cider-inspect-expr (expr ns) - "Evaluate EXPR in NS and inspect its value. -Interactively, EXPR is read from the minibuffer, and NS the -current buffer's namespace." - (interactive (list (cider-read-from-minibuffer "Inspect expression: " (cider-sexp-at-point)) - (cider-current-ns))) - (setq cider-inspector--current-repl (cider-current-repl)) - (let ((result (cider-sync-request:inspect-expr - expr ns - cider-inspector-page-size - cider-inspector-max-atom-length - cider-inspector-max-coll-size - 'v2))) - (when (nrepl-dict-get result "value") - (cider-inspector--render-value result 'v2)))) - -(defun cider-inspect-expr-from-inspector () - "Performs `cider-inspect-expr' in a way that is suitable from the Inspector itself. -In particular, it does not read `cider-sexp-at-point'." - (interactive) - (let* ((ns (cider-current-ns)) - (prompt (format "Inspect expression in %s" - (substring-no-properties (funcall cider-repl-prompt-function ns))))) - (cider-inspect-expr (cider-read-from-minibuffer prompt nil 'skip-colon) - ns))) - -(defun cider-inspector-pop () - "Pop the last value off the inspector stack and render it. -See `cider-sync-request:inspect-pop' and `cider-inspector--render-value'." - (interactive) - (setq cider-inspector-last-command 'cider-inspector-pop) - (let ((result (cider-sync-request:inspect-pop 'v2))) - (when (nrepl-dict-get result "value") - (cider-inspector--render-value result 'v2)))) - -(defun cider-inspector-push (idx) - "Inspect the value at IDX in the inspector stack and render it. -See `cider-sync-request:inspect-push' and `cider-inspector--render-value'" - (interactive) - (let ((result (cider-sync-request:inspect-push idx 'v2))) - (when (nrepl-dict-get result "value") - (push (point) cider-inspector-location-stack) - (cider-inspector--render-value result 'v2) - (cider-inspector-next-inspectable-object 1)))) - -(defun cider-inspector-inspect-last-exception (index) - "Inspects the exception in the cause stack identified by INDEX." - (interactive) - (cl-assert (numberp index)) - (setq cider-inspector--current-repl (cider-current-repl)) - (let ((result (cider-sync-request:inspect-last-exception index 'v2))) - (when (nrepl-dict-get result "value") - (push (point) cider-inspector-location-stack) - (cider-inspector--render-value result 'v2) - (cider-inspector-next-inspectable-object 1)))) - -(defun cider-inspector-previous-sibling () - "Inspect the previous sibling value within a sequential parent. -See `cider-sync-request:inspect-previous-sibling' and `cider-inspector--render-value'" - (interactive) - (let ((result (cider-sync-request:inspect-previous-sibling 'v2))) - (when (nrepl-dict-get result "value") - (push (point) cider-inspector-location-stack) - (cider-inspector--render-value result 'v2) - (cider-inspector-next-inspectable-object 1)))) - -(defun cider-inspector-next-sibling () - "Inspect the next sibling value within a sequential parent. -See `cider-sync-request:inspect-next-sibling' and `cider-inspector--render-value'" - (interactive) - (let ((result (cider-sync-request:inspect-next-sibling 'v2))) - (when (nrepl-dict-get result "value") - (push (point) cider-inspector-location-stack) - (cider-inspector--render-value result 'v2) - (cider-inspector-next-inspectable-object 1)))) - -(defun cider-inspector-refresh () - "Re-render the currently inspected value. -See `cider-sync-request:inspect-refresh' and `cider-inspector--render-value'" - (interactive) - (let ((result (cider-sync-request:inspect-refresh 'v2))) - (when (nrepl-dict-get result "value") - (cider-inspector--render-value result 'v2)))) - -(defun cider-inspector-next-page () - "Jump to the next page when inspecting a paginated sequence/map. - -Does nothing if already on the last page." - (interactive) - (push (point) cider-inspector-page-location-stack) - (let ((result (cider-sync-request:inspect-next-page 'v2))) - (when (nrepl-dict-get result "value") - (cider-inspector--render-value result 'v2)))) - -(defun cider-inspector-prev-page () - "Jump to the previous page when expecting a paginated sequence/map. - -Does nothing if already on the first page." - (interactive) - (setq cider-inspector-last-command 'cider-inspector-prev-page) - (let ((result (cider-sync-request:inspect-prev-page 'v2))) - (when (nrepl-dict-get result "value") - (cider-inspector--render-value result 'v2)))) - -(defun cider-inspector-set-page-size (page-size) - "Set the page size in pagination mode to the specified PAGE-SIZE. - -Current page will be reset to zero." - (interactive (list (read-number "Page size: " cider-inspector-page-size))) - (let ((result (cider-sync-request:inspect-set-page-size page-size 'v2))) - (when (nrepl-dict-get result "value") - (cider-inspector--render-value result 'v2)))) - -(defun cider-inspector-set-max-atom-length (max-length) - "Set the max length of nested atoms to MAX-LENGTH." - (interactive (list (read-number "Max atom length: " cider-inspector-max-atom-length))) - (let ((result (cider-sync-request:inspect-set-max-atom-length max-length 'v2))) - (when (nrepl-dict-get result "value") - (cider-inspector--render-value result 'v2)))) - -(defun cider-inspector-set-max-coll-size (max-size) - "Set the number of nested collection members to display before truncating. -MAX-SIZE is the new value." - (interactive (list (read-number "Max collection size: " cider-inspector-max-coll-size))) - (let ((result (cider-sync-request:inspect-set-max-coll-size max-size 'v2))) - (when (nrepl-dict-get result "value") - (cider-inspector--render-value result 'v2)))) - -(defcustom cider-inspector-preferred-var-names nil - "The preferred var names to be suggested by `cider-inspector-def-current-val'. - -If you choose a different one while completing interactively, -it will be included (in the first position) the next time -you use `cider-inspector-def-current-val'." - :type '(repeat string) - :group 'cider - :package-version '(cider . "1.8.0")) - -(defun cider-inspector--read-var-name-from-user (ns) - "Reads a var name from the user, to be defined within NS. -Grows `cider-inspector-preferred-var-names' if the user chose a new name, -making that new name take precedence for subsequent usages." - (let ((v (completing-read (format "Name of the var to be defined in ns %s: " ns) - cider-inspector-preferred-var-names))) - (unless (member v cider-inspector-preferred-var-names) - (setq cider-inspector-preferred-var-names (cons v cider-inspector-preferred-var-names))) - v)) - -(defun cider-inspector-def-current-val (var-name ns) - "Defines a var with VAR-NAME in current namespace. - -Doesn't modify current page. When called interactively NS defaults to -current-namespace." - (interactive (let ((ns (cider-current-ns))) - (list (cider-inspector--read-var-name-from-user ns) - ns))) - (setq cider-inspector--current-repl (cider-current-repl)) - (when-let* ((result (cider-sync-request:inspect-def-current-val ns var-name 'v2)) - (value (nrepl-dict-get result "value"))) - (cider-inspector--render-value result 'v2) - (message "%s#'%s/%s = %s" cider-eval-result-prefix ns var-name value))) - -(defun cider-inspector-tap-current-val () - "Sends the current Inspector current value to `tap>'." - (interactive) - ;; NOTE: we don't set `cider-inspector--current-repl', because we mean to tap the current value of an existing Inspector, - ;; so whatever repl was used for it, should be used here. - (if cider-inspector--current-repl - (let ((response (cider-sync-request:inspect-tap-current-val))) - (nrepl-dbind-response response (value err) - (if value - (message "Successfully tapped the current Inspector value") - (error "Could not tap the current Inspector value: %s" err)))) - (user-error "No CIDER session found"))) - -(defun cider-inspector-tap-at-point () - "Sends the current Inspector current sub-value (per POINT) to `tap>'." - (interactive) - ;; NOTE: we don't set `cider-inspector--current-repl', because we mean to tap the current value of an existing Inspector, - ;; so whatever repl was used for it, should be used here. - (if cider-inspector--current-repl - (seq-let (property value) (cider-inspector-property-at-point) - (pcase property - (`cider-value-idx - (let* ((idx value) - (response (cider-sync-request:inspect-tap-indexed idx))) - (nrepl-dbind-response response (value err) - (if value - (message "Successfully tapped the Inspector item at point") - (error "Could not tap the Inspector item at point: %s" err))))) - (_ (error "No object at point")))) - (user-error "No CIDER session found"))) - -;; nREPL interactions -(defun cider-sync-request:inspect-pop (&optional v2) - "Move one level up in the inspector stack, -V2 indicates if the entire response should be returned -instead of just its \"value\" entry." - (let ((result (thread-first '("op" "inspect-pop") - (cider-nrepl-send-sync-request cider-inspector--current-repl)))) - (if v2 - result - (nrepl-dict-get result "value")))) - -(defun cider-sync-request:inspect-push (idx &optional v2) - "Inspect the inside value specified by IDX, -V2 indicates if the entire response should be returned -instead of just its \"value\" entry." - (let ((result (thread-first `("op" "inspect-push" - "idx" ,idx) - (cider-nrepl-send-sync-request cider-inspector--current-repl)))) - (if v2 - result - (nrepl-dict-get result "value")))) - -(defun cider-sync-request:inspect-previous-sibling (&optional v2) - "Inspect the previous sibling value within a sequential parent, -V2 indicates if the entire response should be returned -instead of just its \"value\" entry." - (let ((result (thread-first `("op" "inspect-previous-sibling") - (cider-nrepl-send-sync-request cider-inspector--current-repl)))) - (if v2 - result - (nrepl-dict-get result "value")))) - -;;;###autoload -(defun cider-sync-request:inspect-last-exception (index &optional v2) - "Inspects the exception in the cause stack identified by INDEX, -V2 indicates if the entire response should be returned -instead of just its \"value\" entry." - (cl-assert (numberp index)) - (let ((result (thread-first `("op" "inspect-last-exception" - "index" ,index) - (cider-nrepl-send-sync-request cider-inspector--current-repl)))) - (if v2 - result - (nrepl-dict-get result "value")))) - -(defun cider-sync-request:inspect-next-sibling (&optional v2) - "Inspect the next sibling value within a sequential parent, -V2 indicates if the entire response should be returned -instead of just its \"value\" entry." - (let ((result (thread-first `("op" "inspect-next-sibling") - (cider-nrepl-send-sync-request cider-inspector--current-repl)))) - (if v2 - result - (nrepl-dict-get result "value")))) - -(defun cider-sync-request:inspect-refresh (&optional v2) - "Re-render the currently inspected value, -V2 indicates if the entire response should be returned -instead of just its \"value\" entry." - (let ((result (thread-first '("op" "inspect-refresh") - (cider-nrepl-send-sync-request cider-inspector--current-repl)))) - (if v2 - result - (nrepl-dict-get result "value")))) - -(defun cider-sync-request:inspect-next-page (&optional v2) - "Jump to the next page in paginated collection view, -V2 indicates if the entire response should be returned -instead of just its \"value\" entry." - (let ((result (thread-first '("op" "inspect-next-page") - (cider-nrepl-send-sync-request cider-inspector--current-repl)))) - (if v2 - result - (nrepl-dict-get result "value")))) - -(defun cider-sync-request:inspect-prev-page (&optional v2) - "Jump to the previous page in paginated collection view, -V2 indicates if the entire response should be returned -instead of just its \"value\" entry." - (let ((result (thread-first '("op" "inspect-prev-page") - (cider-nrepl-send-sync-request cider-inspector--current-repl)))) - (if v2 - result - (nrepl-dict-get result "value")))) - -(defun cider-sync-request:inspect-set-page-size (page-size &optional v2) - "Set the page size in paginated view to PAGE-SIZE, -V2 indicates if the entire response should be returned -instead of just its \"value\" entry." - (let ((result (thread-first `("op" "inspect-set-page-size" - "page-size" ,page-size) - (cider-nrepl-send-sync-request cider-inspector--current-repl)))) - (if v2 - result - (nrepl-dict-get result "value")))) - -(defun cider-sync-request:inspect-set-max-atom-length (max-length &optional v2) - "Set the max length of nested atoms to MAX-LENGTH, -V2 indicates if the entire response should be returned -instead of just its \"value\" entry." - (let ((result (thread-first `("op" "inspect-set-max-atom-length" - "max-atom-length" ,max-length) - (cider-nrepl-send-sync-request cider-inspector--current-repl)))) - (if v2 - result - (nrepl-dict-get result "value")))) - -(defun cider-sync-request:inspect-set-max-coll-size (max-size &optional v2) - "Set the number of nested collection members to display before truncating. -MAX-SIZE is the new value, V2 indicates if the entire response should be returned -instead of just its \"value\" entry." - (let ((result (thread-first `("op" "inspect-set-max-coll-size" - "max-coll-size" ,max-size) - (cider-nrepl-send-sync-request cider-inspector--current-repl)))) - (if v2 - result - (nrepl-dict-get result "value")))) - -(defun cider-sync-request:inspect-def-current-val (ns var-name &optional v2) - "Defines a var with VAR-NAME in NS with the current inspector value, -V2 indicates if the entire response should be returned -instead of just its \"value\" entry." - (let ((result (thread-first `("op" "inspect-def-current-value" - "ns" ,ns - "var-name" ,var-name) - (cider-nrepl-send-sync-request cider-inspector--current-repl)))) - (if v2 - result - (nrepl-dict-get result "value")))) - -(defun cider-sync-request:inspect-tap-current-val () - "Sends current inspector value to tap>." - (cider-nrepl-send-sync-request '("op" "inspect-tap-current-value") cider-inspector--current-repl)) - -(defun cider-sync-request:inspect-tap-indexed (idx) - "Sends current inspector sub-value to tap>, per IDX." - (cl-assert idx) - (cider-nrepl-send-sync-request `("op" "inspect-tap-indexed" - "idx" ,idx) - cider-inspector--current-repl)) - -(defun cider-sync-request:inspect-expr (expr ns page-size max-atom-length max-coll-size &optional v2) - "Evaluate EXPR in context of NS and inspect its result. -Set the page size in paginated view to PAGE-SIZE, maximum length of atomic -collection members to MAX-ATOM-LENGTH, and maximum size of nested collections to -MAX-COLL-SIZE if non nil, -V2 indicates if the entire response should be returned -instead of just its \"value\" entry." - (let ((result (thread-first (append (nrepl--eval-request expr ns) - `("inspect" "true" - ,@(when page-size - `("page-size" ,page-size)) - ,@(when max-atom-length - `("max-atom-length" ,max-atom-length)) - ,@(when max-coll-size - `("max-coll-size" ,max-coll-size)))) - (cider-nrepl-send-sync-request cider-inspector--current-repl)))) - (if v2 - result - (nrepl-dict-get result "value")))) - -;; Render Inspector from Structured Values -(defun cider-inspector--render-value (dict-or-value &optional v2) - "Render DICT-OR-VALUE, depending on V2." - (let* ((value (if v2 - (nrepl-dict-get dict-or-value "value") - dict-or-value)) - (fragments (when v2 - (nrepl-dict-get dict-or-value "doc-fragments"))) - (block-tags (when v2 - (nrepl-dict-get dict-or-value "doc-block-tags-fragments"))) - (font-size (when-let* ((b (get-buffer cider-inspector-buffer)) - (variable 'text-scale-mode-amount) - (continue (local-variable-p variable b))) - ;; The font size is lost between inspector 'screens', - ;; because on each re-rendering, we wipe everything, including the mode. - ;; Enabling cider-inspector-mode is the specific step that loses the font size. - (buffer-local-value variable b))) - (truncate-lines-defined (when-let* ((b (get-buffer cider-inspector-buffer))) - (local-variable-p 'truncate-lines b))) - (truncate-lines-p (when-let* ((b (get-buffer cider-inspector-buffer)) - (continue truncate-lines-defined)) - (buffer-local-value 'truncate-lines b)))) - (cider-make-popup-buffer cider-inspector-buffer 'cider-inspector-mode 'ancillary) - (cider-inspector-render cider-inspector-buffer value - :font-size font-size - :truncate-lines-defined truncate-lines-defined - :truncate-lines-p truncate-lines-p - :fragments fragments - :block-tags block-tags)) - (cider-popup-buffer-display cider-inspector-buffer cider-inspector-auto-select-buffer) - (when cider-inspector-fill-frame (delete-other-windows)) - (ignore-errors (cider-inspector-next-inspectable-object 1)) - (with-current-buffer cider-inspector-buffer - (when (eq cider-inspector-last-command 'cider-inspector-pop) - (setq cider-inspector-last-command nil) - ;; Prevents error message being displayed when we try to pop - ;; from the top-level of a data structure - (when cider-inspector-location-stack - (goto-char (pop cider-inspector-location-stack)))) - - (when (eq cider-inspector-last-command 'cider-inspector-prev-page) - (setq cider-inspector-last-command nil) - ;; Prevents error message being displayed when we try to - ;; go to a prev-page from the first page - (when cider-inspector-page-location-stack - (goto-char (pop cider-inspector-page-location-stack)))))) - -(cl-defun cider-inspector-render (buffer str &key font-size truncate-lines-defined truncate-lines-p fragments block-tags) - "Render STR in BUFFER." - (with-current-buffer buffer - (cider-inspector-mode) - (when font-size - (text-scale-set font-size)) - (when truncate-lines-defined - (setq-local truncate-lines truncate-lines-p)) - (let ((inhibit-read-only t)) - (condition-case nil - (cider-inspector-render* (car (read-from-string str)) - fragments - block-tags) - (error (insert "\nInspector error for: " str)))) - (goto-char (point-min)))) - -(defvar cider-inspector-looking-at-java-p nil) - -(defun cider-inspector-render* (elements &optional fragments block-tags) - "Render ELEMENTS, and FRAGMENTS, BLOCK-TAGS if present." - (setq cider-inspector-looking-at-java-p nil) - (dolist (el elements) - (cider-inspector-render-el* el)) - (when fragments - (insert "\n\n") - (insert (cider--render-docstring (list "doc-fragments" fragments - "doc-block-tags-fragments" block-tags))))) - -(defconst cider--inspector-java-headers - ;; NOTE "--- Static fields:" "--- Instance fields:" are for objects, - ;; and don't deserve Java syntax highlighting (they can contain a Clojure value like `:foo/bar`, for instance) - '("--- Interfaces:" - "--- Fields:" ;; rendered only for Class objects (and not other objects) - see previous comment - "--- Constructors:" - "--- Methods:" - "--- Imports:")) - -(defun cider-inspector-render-el* (el) - "Render EL." - (let ((header-p (or (member el cider--inspector-java-headers) - (and (stringp el) - (string-prefix-p "--- " el))))) - ;; Headers reset the Java syntax coloring: - (when header-p - (setq cider-inspector-looking-at-java-p nil)) - - (cond ((symbolp el) (insert (symbol-name el))) - ((stringp el) (insert (if cider-inspector-looking-at-java-p - (cider-font-lock-as 'java-mode el) - (let ((trimmed-el (replace-regexp-in-string (regexp-quote "<non-inspectable value>") - "" - el))) - (propertize trimmed-el 'font-lock-face (if header-p - 'font-lock-comment-face - 'font-lock-keyword-face)))))) - ((and (consp el) (eq (car el) :newline)) - (insert "\n")) - ((and (consp el) (eq (car el) :value)) - (cider-inspector-render-value (cadr el) (cl-caddr el))) - (t (message "Unrecognized inspector object: %s" el)))) - - ;; Java-related headers indicate that the next elements to be rendered - ;; should be syntax-colored as Java: - (when (member el cider--inspector-java-headers) - (setq cider-inspector-looking-at-java-p t))) - -(defun cider-inspector-render-value (value idx) - "Render VALUE at IDX." - (cider-propertize-region - (list 'cider-value-idx idx - 'mouse-face 'highlight) - (cider-inspector-render-el* (cider-font-lock-as-clojure value)))) - - -;; =================================================== -;; Inspector Navigation (lifted from SLIME inspector) -;; =================================================== - -(defun cider-find-inspectable-object (direction limit) - "Find the next/previous inspectable object. -DIRECTION can be either 'next or 'prev. -LIMIT is the maximum or minimum position in the current buffer. - -Return a list of two values: If an object could be found, the -starting position of the found object and T is returned; -otherwise LIMIT and NIL is returned." - (let ((finder (cl-ecase direction - (next 'next-single-property-change) - (prev 'previous-single-property-change)))) - (let ((prop nil) (curpos (point))) - (while (and (not prop) (not (= curpos limit))) - (let ((newpos (funcall finder curpos 'cider-value-idx nil limit))) - (setq prop (get-text-property newpos 'cider-value-idx)) - (setq curpos newpos))) - (list curpos (and prop t))))) - -(defun cider-inspector-next-inspectable-object (arg) - "Move point to the next inspectable object. -With optional ARG, move across that many objects. -If ARG is negative, move backwards." - (interactive "p") - (let ((maxpos (point-max)) (minpos (point-min)) - (previously-wrapped-p nil)) - ;; Forward. - (while (> arg 0) - (seq-let (pos foundp) (cider-find-inspectable-object 'next maxpos) - (if foundp - (progn (goto-char pos) - (unless (and cider-inspector-skip-uninteresting - (looking-at-p cider-inspector-uninteresting-regexp)) - (setq arg (1- arg)) - (setq previously-wrapped-p nil))) - (if (not previously-wrapped-p) ; cycle detection - (progn (goto-char minpos) (setq previously-wrapped-p t)) - (error "No inspectable objects"))))) - ;; Backward. - (while (< arg 0) - (seq-let (pos foundp) (cider-find-inspectable-object 'prev minpos) - ;; CIDER-OPEN-INSPECTOR inserts the title of an inspector page - ;; as a presentation at the beginning of the buffer; skip - ;; that. (Notice how this problem can not arise in ``Forward.'') - (if (and foundp (/= pos minpos)) - (progn (goto-char pos) - (unless (and cider-inspector-skip-uninteresting - (looking-at-p cider-inspector-uninteresting-regexp)) - (setq arg (1+ arg)) - (setq previously-wrapped-p nil))) - (if (not previously-wrapped-p) ; cycle detection - (progn (goto-char maxpos) (setq previously-wrapped-p t)) - (error "No inspectable objects"))))))) - -(defun cider-inspector-previous-inspectable-object (arg) - "Move point to the previous inspectable object. -With optional ARG, move across that many objects. -If ARG is negative, move forwards." - (interactive "p") - (cider-inspector-next-inspectable-object (- arg))) - -(defun cider-inspector-property-at-point () - "Return property at point." - (let* ((properties '(cider-value-idx cider-range-button - cider-action-number)) - (find-property - (lambda (point) - (cl-loop for property in properties - for value = (get-text-property point property) - when value - return (list property value))))) - (or (funcall find-property (point)) - (funcall find-property (max (point-min) (1- (point))))))) - -(defun cider-inspector-operate-on-point () - "Invoke the command for the text at point. -1. If point is on a value then recursively call the inspector on -that value. -2. If point is on an action then call that action. -3. If point is on a range-button fetch and insert the range." - (interactive) - (seq-let (property value) (cider-inspector-property-at-point) - (pcase property - (`cider-value-idx - (cider-inspector-push value)) - ;; TODO: range and action handlers - (_ (error "No object at point"))))) - -(defun cider-inspector-operate-on-click (event) - "Move to EVENT's position and operate the part." - (interactive "@e") - (let ((point (posn-point (event-end event)))) - (cond ((and point - (or (get-text-property point 'cider-value-idx))) - (goto-char point) - (cider-inspector-operate-on-point)) - (t - (error "No clickable part here"))))) - -(provide 'cider-inspector) - -;;; cider-inspector.el ends here diff --git a/elpa/cider-1.12.0/cider-jar.el b/elpa/cider-1.12.0/cider-jar.el @@ -1,141 +0,0 @@ -;;; cider-jar.el --- Jar functionality for Clojure -*- lexical-binding: t -*- - -;; Copyright © 2022 Arne Brasseur -;; -;; Author: Arne Brasseur <arne@arnebrasseur.net> - -;; 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/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Dealing with JAR (Java archive) files, which are really just zip files in -;; disguise. In particular downloading and retrieving the cider-nrepl jar. - -;;; Code: - -(require 'url) -(require 'arc-mode) -(require 'map) - - -(defvar cider-jar-cache-dir (expand-file-name "cider-cache" user-emacs-directory) - "Location where we store downloaded files for later use.") - -(defvar cider-jar-content-cache (make-hash-table :test #'equal) - "Nested hash table of jar-path -> file-path -> bool. -This provides an efficient check to see if a file exists in a jar or not.") - -(defun cider-jar-clojars-url (group artifact version) - "URL to download a specific jar from Clojars. -GROUP, ARTIFACT, and VERSION are the components of the Maven coordinates." - (concat "https://repo.clojars.org/" group "/" artifact "/" - version - "/cider-nrepl-" - version - ".jar")) - -(defun cider-jar-find-or-fetch (group artifact version) - "Download the given jar off clojars and cache it. - -GROUP, ARTIFACT, and VERSION are the components of the Maven coordinates. -Returns the path to the jar." - (let* ((m2-path (expand-file-name (concat "~/.m2/repository/" group "/" artifact "/" version "/" artifact "-" version ".jar"))) - (clojars-url (cider-jar-clojars-url group artifact version)) - (cache-path (expand-file-name (replace-regexp-in-string "https://" "" clojars-url) cider-jar-cache-dir))) - (cond - ((file-exists-p m2-path) m2-path) - ((file-exists-p cache-path) cache-path) - (t - (make-directory (file-name-directory cache-path) t) - (url-copy-file clojars-url cache-path) - cache-path)))) - -(defun cider-jar--archive-zip-summarize () - "Forked version of `archive-zip-summarize'. -Only read the information we need, and be version independent." - (goto-char (- (point-max) (- 22 18))) - (search-backward-regexp "[P]K\005\006") - (let ((p (archive-l-e (+ (point) 16) 4)) - files) - (when (or (= p #xffffffff) (= p -1)) - ;; If the offset of end-of-central-directory is 0xFFFFFFFF, this - ;; is a Zip64 extended ZIP file format, and we need to glean the - ;; info from Zip64 records instead. - ;; - ;; First, find the Zip64 end-of-central-directory locator. - (search-backward "PK\006\007") - (setq p (+ (point-min) - (archive-l-e (+ (point) 8) 8))) - (goto-char p) - ;; We should be at Zip64 end-of-central-directory record now. - (or (string= "PK\006\006" (buffer-substring p (+ p 4))) - (error "Unrecognized ZIP file format")) - ;; Offset to central directory: - (setq p (archive-l-e (+ p 48) 8))) - (setq p (+ p (point-min))) - (while (string= "PK\001\002" (buffer-substring p (+ p 4))) - (let* ((fnlen (archive-l-e (+ p 28) 2)) - (exlen (archive-l-e (+ p 30) 2)) - (fclen (archive-l-e (+ p 32) 2)) - (efnname (let ((str (buffer-substring (+ p 46) (+ p 46 fnlen)))) - (decode-coding-string - str archive-file-name-coding-system)))) - (setq files (cons efnname files) - p (+ p 46 fnlen exlen fclen)))) - files)) - -(defun cider-jar-contents (jarfile) - "Get the list of filenames in a jar (or zip) file. -JARFILE is the location of the archive." - (with-temp-buffer - (set-buffer-multibyte nil) - (setq buffer-file-coding-system 'binary) - (insert-file-contents-literally jarfile nil) - (cider-jar--archive-zip-summarize))) - -(defun cider-jar-contents-cached (jarfile) - "Like cider-jar-contents, but cached. - -Instead of returning a list of strings this returns a hash table of string -keys and values `t`, for quick lookup. JARFILE is the location of the -archive." - (let ((m (map-elt cider-jar-content-cache jarfile))) - (if m - m - (let ((m (make-hash-table :test #'equal))) - (seq-do (lambda (path) - (puthash path t m)) - (cider-jar-contents jarfile)) - (puthash jarfile m cider-jar-content-cache) - m)))) - -(defun cider-jar-contains-p (jarfile name) - "Does the JARFILE contain a file with the given NAME?" - (map-elt (cider-jar-contents-cached jarfile) name)) - -(defun cider-jar-retrieve-resource (jarfile name) - "Extract a file NAME from a JARFILE as a string." - (make-directory archive-tmpdir :make-parents) - (when (cider-jar-contains-p jarfile name) - (let ((default-directory archive-tmpdir)) - (with-temp-buffer - (set-buffer-multibyte nil) - (setq buffer-file-coding-system 'binary) - (archive-zip-extract jarfile name) - (buffer-substring-no-properties (point-min) (point-max)))))) - -(provide 'cider-jar) -;;; cider-jar.el ends here diff --git a/elpa/cider-1.12.0/cider-log.el b/elpa/cider-1.12.0/cider-log.el @@ -1,1429 +0,0 @@ -;;; cider-log.el --- Log inspection functionality for Clojure -*- lexical-binding: t -*- - -;; Copyright © 2023 Bozhidar Batsov and CIDER contributors - -;; Author: r0man <roman@burningswell.com> - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Log inspection functionality for Clojure. -;; -;; Please, refer to the online documentation for more details -;; https://docs.cider.mx/cider/debugging/logging.html. - -;;; Code: - -(require 'cider-inspector) -(require 'cider-stacktrace) -(require 'cl-lib) -(require 'logview nil t) -(require 'org) -(require 'seq) -(require 'transient) - -(defcustom cider-log-framework-name nil - "The name of the current log framework." - :group 'cider - :package-version '(cider . "1.8.0") - :safe #'stringp - :type 'string) - -(defcustom cider-log-appender-id "cider-log" - "The name of the default log appender." - :group 'cider - :package-version '(cider . "1.8.0") - :safe #'stringp - :type 'string) - -(defcustom cider-log-buffer "*cider-log*" - "The name of the log buffer." - :group 'cider - :package-version '(cider . "1.8.0") - :safe #'stringp - :type 'string) - -(defcustom cider-log-event-buffer "*cider-log-event*" - "The name of the log event buffer." - :group 'cider - :package-version '(cider . "1.8.0") - :safe #'stringp - :type 'string) - -(defcustom cider-log-max-message-length 500 - "The maximum length of the log message to display." - :group 'cider - :package-version '(cider . "1.8.0") - :safe #'integerp - :type 'integer) - -(defcustom cider-log-pagination-limit 250 - "The maximum number of log events to return when searching events." - :group 'cider - :package-version '(cider . "1.8.0") - :safe #'integerp - :type 'integer) - -(defcustom cider-log-pagination-offset 0 - "The offset from which to return results when searching events." - :group 'cider - :package-version '(cider . "1.8.0") - :safe #'integerp - :type 'integer) - -(defcustom cider-log-use-logview (fboundp 'logview-mode) - "Whether to use `logview-mode' or not." - :group 'cider - :package-version '(cider . "1.8.0") - :safe #'booleanp - :type 'boolean) - -(defvar logview-mode-map) -(declare-function logview--guess-submode "logview" () t) -(declare-function logview-initialized-p "logview" () t) -(declare-function logview-mode "logview" () t) - -(defvar cider-log--initialized-once-p nil - "Set to t if log framework and appender have been initialized once.") - -(defvar cider-log-framework nil - "The current log framework to use.") - -(defvar cider-log-appender nil - "The current log appender.") - -(defvar cider-log-appender-size 100000 - "The size of the log appender.") - -(defvar cider-log-appender-threshold 10 - "The threshold in percent of the log appender.") - -(defvar-local cider-log-consumer nil - "The current log consumer.") - -;; Filters - -(defvar cider-log--end-time-filter nil) -(defvar cider-log--exceptions-filter nil) -(defvar cider-log--level-filter nil) -(defvar cider-log--loggers-filter nil) -(defvar cider-log--pattern-filter nil) -(defvar cider-log--start-time-filter nil) -(defvar cider-log--threads-filter nil) - -(defun cider-log--bold (s) - "Return S with a bold face." - (when s (propertize (format "%s" s) 'face 'bold))) - -(defun cider-log-buffer-clear-p (&optional buffer) - "Return non-nil if BUFFER is not empty, otherwise nil." - (when-let (buffer (get-buffer (or buffer cider-log-buffer))) - (> (buffer-size buffer) 0))) - -(defun cider-log--description-clear-events-buffer () - "Return the description for the set framework action." - (format "Clear %s buffer" - (if cider-log-buffer - (cider-log--format-value cider-log-buffer) - (propertize "n/a" 'face 'font-lock-comment-face)))) - -(defun cider-log--description-set-framework () - "Return the description for the set framework action." - (format "Select framework %s" - (if cider-log-framework-name - (cider-log--format-value cider-log-framework-name) - (propertize "n/a" 'face 'font-lock-comment-face)))) - -(defun cider-log--description-set-buffer () - "Return the description for the set buffer action." - (format "Select buffer %s" - (if cider-log-buffer - (cider-log--format-value cider-log-buffer) - (propertize "n/a" 'face 'font-lock-comment-face)))) - -(defun cider-log--buffers-in-major-mode (expected) - "Return all buffers which are in the EXPECTED major mode." - (seq-filter (lambda (buffer) - (with-current-buffer buffer - (equal expected major-mode))) - (buffer-list))) - -(defun cider-log--format-time (time) - "Format TIME in ISO8601 format." - (format-time-string "%FT%T%z" time)) - -(defun cider-log--format-value (value) - "Format the VALUE for display in a transient menu." - (cond ((null value) "") - ((or (listp value) (vectorp value)) - (string-join (seq-map #'cider-log--format-value value) - (propertize ", " 'face 'font-lock-comment-face))) - (t (propertize (format "%s" value) 'face 'transient-value)))) - -(defun cider-log--strip-whitespace (s) - "Replace multiple white space characters in S with a single one." - (replace-regexp-in-string "[\n ]+" " " s)) - -;; NREPL - -(defun cider-request:log-add-consumer (framework appender consumer &optional callback) - "Add CONSUMER to the APPENDER of FRAMEWORK and call CALLBACK on log events." - (cider-ensure-op-supported "cider/log-add-consumer") - (thread-first `("op" "cider/log-add-consumer" - "framework" ,(cider-log-framework-id framework) - "appender" ,(cider-log-appender-id appender) - "filters" ,(cider-log-consumer-filters consumer)) - (cider-nrepl-send-request callback))) - -(defun cider-request:log-analyze-stacktrace (framework appender event &optional callback) - "Analyze the EVENT stacktrace of the APPENDER of FRAMEWORK and call CALLBACK." - (cider-ensure-op-supported "cider/log-analyze-stacktrace") - (thread-first `("op" "cider/log-analyze-stacktrace" - "framework" ,(cider-log-framework-id framework) - "appender" ,(cider-log-appender-id appender) - "event" ,(cider-log-event-id event)) - (cider-nrepl-send-request callback))) - -(defun cider-sync-request:log-update-consumer (framework appender consumer) - "Add CONSUMER to the APPENDER of FRAMEWORK and call CALLBACK on log events." - (cider-ensure-op-supported "cider/log-update-consumer") - (thread-first `("op" "cider/log-update-consumer" - "framework" ,(cider-log-framework-id framework) - "appender" ,(cider-log-appender-id appender) - "consumer" ,(cider-log-consumer-id consumer) - "filters" ,(cider-log-consumer-filters consumer)) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "cider/log-update-consumer"))) - -(defun cider-sync-request:log-add-appender (framework appender) - "Add the APPENDER to the log FRAMEWORK." - (cider-ensure-op-supported "cider/log-add-appender") - (thread-first `("op" "cider/log-add-appender" - "framework" ,(cider-log-framework-id framework) - "appender" ,(cider-log-appender-id appender) - "filters" ,(cider-log-appender-filters appender) - "size" ,(cider-log-appender-size appender) - "threshold" ,(cider-log-appender-threshold appender)) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "cider/log-add-appender"))) - -(defun cider-sync-request:log-update-appender (framework appender) - "Update the APPENDER of the log FRAMEWORK." - (cider-ensure-op-supported "cider/log-update-appender") - (thread-first `("op" "cider/log-update-appender" - "framework" ,(cider-log-framework-id framework) - "appender" ,(cider-log-appender-id appender) - "filters" ,(cider-log-appender-filters appender) - "size" ,(cider-log-appender-size appender) - "threshold" ,(cider-log-appender-threshold appender)) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "cider/log-update-appender"))) - -(defun cider-sync-request:log-clear (framework appender) - "Clear the log events for FRAMEWORK and APPENDER." - (cider-ensure-op-supported "cider/log-clear-appender") - (thread-first `("op" "cider/log-clear-appender" - "framework" ,(cider-log-framework-id framework) - "appender" ,(cider-log-appender-id appender)) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "cider/log-clear-appender"))) - -(defun cider-sync-request:log-inspect-event (framework appender event) - "Inspect the log event with the ID in the APPENDER of the log FRAMEWORK." - (cider-ensure-op-supported "cider/log-inspect-event") - (thread-first `("op" "cider/log-inspect-event" - "framework" ,(cider-log-framework-id framework) - "appender" ,(cider-log-appender-id appender) - "event" ,(cider-log-event-id event)) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "value"))) - -(defun cider-sync-request:log-format-event (framework appender event) - "Format the log EVENT from the APPENDER of the log FRAMEWORK." - (cider-ensure-op-supported "cider/log-format-event") - (thread-first - (seq-mapcat #'identity - (map-merge 'list - (cider--nrepl-print-request-map fill-column) - `(("op" "cider/log-format-event") - ("framework" ,(cider-log-framework-id framework)) - ("appender" ,(cider-log-appender-id appender)) - ("event" ,(cider-log-event-id event))))) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "cider/log-format-event"))) - -(defun cider-sync-request:log-frameworks () - "Return the available log frameworks." - (cider-ensure-op-supported "cider/log-frameworks") - (thread-first `("op" "cider/log-frameworks") - (cider-nrepl-send-sync-request) - (nrepl-dict-get "cider/log-frameworks"))) - -(cl-defun cider-sync-request:log-search (framework appender &key filters limit offset) - "Search log events of FRAMEWORK and APPENDER using FILTERS, LIMIT and OFFSET." - (cider-ensure-op-supported "cider/log-search") - (thread-first `("op" "cider/log-search" - "framework" ,(cider-log-framework-id framework) - "appender" ,(cider-log-appender-id appender) - "filters" ,filters - "limit" ,limit - "offset" ,offset) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "cider/log-search"))) - -(defun cider-sync-request:log-exceptions (framework appender) - "Return the Cider log exceptions for FRAMEWORK and APPENDER." - (cider-ensure-op-supported "cider/log-exceptions") - (thread-first `("op" "cider/log-exceptions" - "framework" ,(cider-log-framework-id framework) - "appender" ,(cider-log-appender-id appender)) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "cider/log-exceptions"))) - -(defun cider-sync-request:log-levels (framework appender) - "Return the Cider log levels for FRAMEWORK and APPENDER." - (cider-ensure-op-supported "cider/log-levels") - (thread-first `("op" "cider/log-levels" - "framework" ,(cider-log-framework-id framework) - "appender" ,(cider-log-appender-id appender)) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "cider/log-levels"))) - -(defun cider-sync-request:log-loggers (framework appender) - "Return the Cider loggers for FRAMEWORK and APPENDER." - (cider-ensure-op-supported "cider/log-loggers") - (thread-first `("op" "cider/log-loggers" - "framework" ,(cider-log-framework-id framework) - "appender" ,(cider-log-appender-id appender)) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "cider/log-loggers"))) - -(defun cider-sync-request:log-remove-appender (framework appender) - "Remove the APPENDER from the log FRAMEWORK." - (cider-ensure-op-supported "cider/log-remove-appender") - (thread-first `("op" "cider/log-remove-appender" - "framework" ,(cider-log-framework-id framework) - "appender" ,(cider-log-appender-id appender)) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "cider/log-remove-appender"))) - -(defun cider-sync-request:log-remove-consumer (framework appender consumer) - "Remove the CONSUMER from the APPENDER of the log FRAMEWORK." - (cider-ensure-op-supported "cider/log-remove-consumer") - (thread-first `("op" "cider/log-remove-consumer" - "framework" ,(cider-log-framework-id framework) - "appender" ,(cider-log-appender-id appender) - "consumer" ,(cider-log-consumer-id consumer)) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "cider/log-remove-consumer"))) - -(defun cider-sync-request:log-threads (framework appender) - "Return the threads for FRAMEWORK and APPENDER." - (cider-ensure-op-supported "cider/log-threads") - (thread-first `("op" "cider/log-threads" - "framework" ,(cider-log-framework-id framework) - "appender" ,(cider-log-appender-id appender)) - (cider-nrepl-send-sync-request) - (nrepl-dict-get "cider/log-threads"))) - -(defun cider-log--completion-extra-properties (keys &optional separator) - "Return the completion properties for NREPL dictionaries. - -The KEYS are used to lookup the values and are joined by SEPARATOR." - `(:annotation-function - ,(lambda (identifier) - (when-let (dict (cadr (assoc identifier minibuffer-completion-table))) - (let ((annotation (string-join (seq-map (lambda (key) (nrepl-dict-get dict key)) keys) - (or separator " ")))) - (unless (string-blank-p annotation) - (propertize (format " - %s" (cider-log--strip-whitespace annotation)) - 'face 'font-lock-comment-face))))))) - -(defun cider-log--read-appender-id (prompt initial-input history) - "Read a appender from the minibuffer using PROMPT, INITIAL-INPUT and HISTORY." - (let ((table (when cider-log-framework - (when-let (framework (cider-log-framework-reload cider-log-framework)) - (seq-map #'cider-log-appender-id (cider-log-framework-appenders framework)))))) - (completing-read (or prompt "Log appender: ") table nil nil - (or initial-input cider-log-appender-id) - history cider-log-appender-id))) - -(defun cider-log--read-buffer (&optional prompt initial-input history) - "Read the log buffer name using PROMPT, INITIAL-INPUT and HISTORY." - (let ((table (seq-map #'buffer-name (cider-log--buffers-in-major-mode 'cider-log-mode)))) - (completing-read (or prompt "Buffer: ") table nil nil - (or initial-input cider-log-buffer) - history cider-log-buffer))) - -(defun cider-log--read-exceptions (&optional prompt initial-input history) - "Read a list of exceptions using PROMPT, INITIAL-INPUT and HISTORY." - (let ((table (when (cider-log-appender-attached-p) - (nrepl-dict-keys (cider-sync-request:log-exceptions - cider-log-framework cider-log-appender))))) - (completing-read-multiple (or prompt "Exceptions: ") table nil nil initial-input history))) - -(defun cider-log--read-framework-name (&optional prompt initial-input history) - "Read a framework name using PROMPT, INITIAL-INPUT and HISTORY." - (let ((completion-extra-properties (cider-log--completion-extra-properties '("name"))) - (frameworks (cider-sync-request:log-frameworks))) - (completing-read (or prompt "Log framework: ") - (seq-map (lambda (framework) - (list (cider-log-framework-name framework) framework)) - frameworks) - nil nil initial-input history))) - -(defun cider-log--read-level (&optional prompt initial-input history) - "Read a log level using PROMPT, INITIAL-INPUT and HISTORY." - (let ((table (when cider-log-framework (cider-log-framework-level-names cider-log-framework)))) - (completing-read (or prompt "Level: ") table nil nil initial-input history))) - -(defun cider-log--read-loggers (&optional prompt initial-input history) - "Read a list of loggers using PROMPT, INITIAL-INPUT and HISTORY." - (let ((table (when (cider-log-appender-attached-p) - (nrepl-dict-keys (cider-sync-request:log-loggers - cider-log-framework cider-log-appender))))) - (completing-read-multiple (or "Loggers: " prompt) table nil nil initial-input history))) - -(defun cider-log--read-number-N0 (&optional prompt initial-input history) - "Read a natural number (including zero) using PROMPT, INITIAL-INPUT and HISTORY." - (when-let (value (transient-read-number-N0 (or prompt "Number: ") initial-input history)) - (string-to-number value))) - -(defun cider-log--read-number-N+ (&optional prompt initial-input history) - "Read a natural number (excluding zero) using PROMPT, INITIAL-INPUT and HISTORY." - (when-let (value (transient-read-number-N+ (or prompt "Number: ") initial-input history)) - (string-to-number value))) - -(defun cider-log--read-threads (&optional prompt initial-input history) - "Read a list of threads using PROMPT, INITIAL-INPUT and HISTORY." - (let ((table (when (cider-log-appender-attached-p) - (nrepl-dict-keys (cider-sync-request:log-threads - cider-log-framework cider-log-appender))))) - (completing-read-multiple (or prompt "Threads: ") table nil nil initial-input history))) - -(defun cider-log--read-time (&optional prompt initial-input _) - "Read a time from the minibuffer using PROMPT and INITIAL-INPUT." - (cider-log--format-time (org-read-date t 'to-time nil prompt nil initial-input))) - -;; Log Framework - -(defun cider-log-framework-appender (framework id) - "Return the appender of the log FRAMEWORK with the given ID." - (seq-find (lambda (appender) (equal id (cider-log-appender-id appender))) - (cider-log-framework-appenders framework))) - -(defun cider-log-framework-appenders (framework) - "Return the appenders of the log FRAMEWORK." - (nrepl-dict-get framework "appenders")) - -(defun cider-log-framework-id (framework) - "Return the id of the log FRAMEWORK." - (nrepl-dict-get framework "id")) - -(defun cider-log-framework-javadoc-url (framework) - "Return the Javadoc URL of the log FRAMEWORK." - (nrepl-dict-get framework "javadoc-url")) - -(defun cider-log-framework-name (framework) - "Return the name of the log FRAMEWORK." - (nrepl-dict-get framework "name")) - -(defun cider-log-framework-level-names (framework) - "Return the log level names of the log FRAMEWORK." - (seq-map (lambda (level) (nrepl-dict-get level "name")) - (nrepl-dict-get framework "levels"))) - -(defun cider-log-framework-website-url (framework) - "Return the website URL of the log FRAMEWORK." - (nrepl-dict-get framework "website-url")) - -(defun cider-log-framework-display-name (framework) - "Return the display name of the log FRAMEWORK." - (cider-log--bold (cider-log-framework-name framework))) - -(defun cider-log-framework-add-appender (framework appender) - "Add the APPENDER to the log FRAMEWORK." - (cider-sync-request:log-add-appender framework appender)) - -(defun cider-log-framework-by-id (frameworks id) - "Find the log framework in FRAMEWORKS by ID." - (seq-find (lambda (framework) (equal id (cider-log-framework-id framework))) frameworks)) - -(defun cider-log-framework-by-name (frameworks name) - "Find the log framework in FRAMEWORKS by NAME." - (seq-find (lambda (framework) (equal name (cider-log-framework-name framework))) frameworks)) - -(defun cider-log-framework-reload (framework) - "Reload the log FRAMEWORK." - (cider-log-framework-by-id - (cider-sync-request:log-frameworks) - (cider-log-framework-id framework))) - -;; Log Appender - -(defun cider-log-appender-attached-p (&optional framework appender) - "Return non-nil if the log APPENDER is attached to FRAMEWORK, otherwise nil." - (when-let ((framework (or framework - (cider-log-framework-by-name - (cider-sync-request:log-frameworks) - cider-log-framework-name))) - (appender-id (if appender - (cider-log-appender-id appender) - cider-log-appender-id))) - (cider-log-framework-appender framework appender-id))) - -(defun cider-log-appender-consumers (appender) - "Return the consumers of the log APPENDER." - (nrepl-dict-get appender "consumers")) - -(defun cider-log-appender-id (appender) - "Return the id of the log APPENDER." - (nrepl-dict-get appender "id")) - -(defun cider-log-appender-size (appender) - "Return the size of the log APPENDER." - (nrepl-dict-get appender "size")) - -(defun cider-log-appender-threshold (appender) - "Return the threshold of the log APPENDER." - (nrepl-dict-get appender "threshold")) - -(defun cider-log-appender-filters (appender) - "Return the filters of the log APPENDER." - (nrepl-dict-get appender "filters")) - -(defun cider-log-appender-display-name (appender) - "Return the display name of the log APPENDER." - (cider-log--bold (cider-log-appender-id appender))) - -(defun cider-log-appender-consumer (appender consumer) - "Find the consumer in the log APPENDER by the id slot of CONSUMER." - (let ((id (cider-log-consumer-id consumer))) - (seq-find (lambda (consumer) (equal id (cider-log-consumer-id consumer))) - (cider-log-appender-consumers appender)))) - -(defun cider-log-appender-reload (framework appender) - "Reload the APPENDER of the log FRAMEWORK." - (when-let (framework (cider-log-framework-reload framework)) - (cider-log-framework-appender framework (cider-log-appender-id appender)))) - -;; Log Consumer - -(defun cider-log-consumer-attached-p (&optional framework appender consumer) - "Return non-nil if the CONSUMER is attached to the APPENDER of FRAMEWORK." - (when-let ((framework (or framework cider-log-framework)) - (appender (or appender cider-log-appender)) - (consumer (or consumer cider-log-consumer))) - (cider-log-consumer-reload framework appender consumer))) - -(defun cider-log-consumer-id (consumer) - "Return the id of the log CONSUMER." - (nrepl-dict-get consumer "id")) - -(defun cider-log-consumer-filters (consumer) - "Return the filters of the log CONSUMER." - (nrepl-dict-get consumer "filters")) - -(defun cider-log-consumer-buffers (consumer) - "Find all buffers in which `cider-log-consumer' is bound to CONSUMER." - (seq-filter (lambda (buffer) - (with-current-buffer buffer - (and (nrepl-dict-p cider-log-consumer) - (equal (cider-log-consumer-id consumer) - (cider-log-consumer-id cider-log-consumer))))) - (buffer-list))) - -(defun cider-log-consumer-display-name (consumer) - "Return the display name of the log CONSUMER." - (cider-log--bold (cider-log-consumer-id consumer))) - -(defun cider-log-consumer-reload (framework appender consumer) - "Reload the CONSUMER attached to APPENDER of the log FRAMEWORK." - (when-let (appender (cider-log-appender-reload framework appender)) - (cider-log-appender-consumer appender consumer))) - -(defun cider-log--consumer-add (framework appender consumer buffer) - "Add the CONSUMER to the APPENDER of FRAMEWORK and write events to BUFFER." - (cider-request:log-add-consumer - framework appender consumer - (lambda (msg) - (nrepl-dbind-response msg (cider/log-add-consumer cider/log-consumer cider/log-event status) - (cond ((member "done" status) - (with-current-buffer (get-buffer-create buffer) - (setq-local cider-log-framework framework) - (setq-local cider-log-appender appender) - (setq cider-log-consumer cider/log-add-consumer) - (switch-to-buffer buffer))) - ((member "cider/log-event" status) - (let* ((consumer (nrepl-dict "id" cider/log-consumer)) - (buffers (cider-log-consumer-buffers consumer))) - (when (seq-empty-p buffers) - (message "WARNING: No buffers found for %s log consumer %s of appender %s." - (cider-log-framework-display-name framework) - (cider-log-consumer-display-name consumer) - (cider-log-appender-display-name appender)) - (cider-sync-request:log-remove-consumer framework appender consumer)) - (seq-doseq (buffer buffers) - (with-current-buffer buffer - (cider-log--insert-events buffer (list cider/log-event)) - (when (and cider-log-use-logview (not (logview-initialized-p))) - (let ((framework cider-log-framework) - (appender cider-log-appender) - (consumer cider-log-consumer)) - (logview--guess-submode) - (cider-log-mode) - ;; Restore buffer local vars reset by calling major mode. - (setq-local cider-log-framework framework - cider-log-appender appender - cider-log-consumer consumer)))))))))))) - -(defun cider-log--remove-current-buffer-consumer () - "Cleanup the log consumer of the current buffer." - (when-let ((framework cider-log-framework) - (appender cider-log-appender) - (consumer cider-log-consumer)) - (setq-local cider-log-consumer nil) - (when-let (consumer (cider-log-consumer-reload framework appender consumer)) - (cider-sync-request:log-remove-consumer framework appender consumer) - consumer))) - -;; Event - -(defun cider-log-event-id (event) - "Return the id of the log EVENT." - (nrepl-dict-get event "id")) - -(defun cider-log-event-exception (event) - "Return the exception of the log EVENT." - (nrepl-dict-get event "exception")) - -(defun cider-log-event--format-logback (event) - "Format the log EVENT in logview's Logback format." - (nrepl-dbind-response event (_exception level logger message thread timestamp) - (propertize (format "%s [%s] %s %s - %s\n" - (if (numberp timestamp) - (format-time-string "%F %T.%3N" (/ timestamp 1000)) - (format "%s" timestamp)) - thread - (upcase level) - logger - (if (and (stringp message) - (numberp cider-log-max-message-length)) - (substring message 0 (min (length message) cider-log-max-message-length)) - "")) - :cider-log-event event))) - -(defun cider-log-event--pretty-print (framework appender event) - "Format the log EVENT of FRAMEWORK and APPENDER." - (when-let (event (cider-sync-request:log-format-event framework appender event)) - (cider-popup-buffer cider-log-event-buffer cider-auto-select-error-buffer - 'clojure-mode 'ancillary) - (with-current-buffer cider-log-event-buffer - (let ((inhibit-read-only t)) - (erase-buffer) - (insert event) - (goto-char (point-min)))))) - -(defun cider-log-event--inspect (framework appender event) - "Inspect the log EVENT of FRAMEWORK and APPENDER." - (thread-last (cider-sync-request:log-inspect-event framework appender event) - (cider-inspector--render-value))) - -(defun cider-log--insert-events (buffer events) - "Insert the log EVENTS into BUFFER." - (with-current-buffer (get-buffer-create buffer) - (let ((windows (seq-filter (lambda (window) (= (window-point window) (point-max))) - (get-buffer-window-list buffer)))) - (save-excursion - (let ((inhibit-read-only t)) - (goto-char (point-max)) - (seq-doseq (event events) - (insert (cider-log-event--format-logback event))))) - (seq-doseq (window windows) - (set-window-point window (point-max)))))) - -(defun cider-log-event--show-stacktrace (framework appender event) - "Show the stacktrace of the log EVENT of FRAMEWORK and APPENDER." - (when (and framework appender event (cider-log-event-exception event)) - (let ((auto-select-buffer cider-auto-select-error-buffer) - (causes nil)) - (cider-request:log-analyze-stacktrace - framework appender event - (lambda (response) - (nrepl-dbind-response response (class status) - (cond (class (setq causes (cons response causes))) - (status (when causes - (cider-stacktrace-render - (cider-popup-buffer cider-error-buffer - auto-select-buffer - #'cider-stacktrace-mode - 'ancillary) - (reverse causes))))))))))) - -(defun cider-log-event-next-line (&optional n) - "Move N lines forward." - (interactive "p") - (let ((n (or n 1))) - (forward-line n) - (beginning-of-line) - (when-let ((framework cider-log-framework) - (appender cider-log-appender) - (event (cider-log-event-at-point))) - (let ((cider-auto-select-error-buffer nil)) - (save-window-excursion - (when (get-buffer-window cider-error-buffer) - (cider-log-event--show-stacktrace framework appender event)) - (when (get-buffer-window cider-inspector-buffer) - (cider-log-event--inspect framework appender event)) - (when (get-buffer-window cider-log-event-buffer) - (cider-log-event--pretty-print framework appender event))))))) - -(defun cider-log-event-previous-line (&optional n) - "Move N lines backward." - (interactive "p") - (cider-log-event-next-line (- (or n 1)))) - -(defun cider-log--set-filters (filters) - "Set the filter variables from the NREPL dict FILTERS." - (when filters - (setq cider-log--end-time-filter (nrepl-dict-get filters "end-time") - cider-log--exceptions-filter (nrepl-dict-get filters "exceptions") - cider-log--level-filter (nrepl-dict-get filters "level") - cider-log--loggers-filter (nrepl-dict-get filters "loggers") - cider-log--pattern-filter (nrepl-dict-get filters "pattern") - cider-log--start-time-filter (nrepl-dict-get filters "start-time") - cider-log--threads-filter (nrepl-dict-get filters "threads")))) - -(defun cider-log--ensure-initialized (framework &optional appender consumer) - "Ensure that the given FRAMEWORK, APPENDER and CONSUMER are initialized." - (setq cider-log-framework framework - cider-log-framework-name (cider-log-framework-name framework)) - (when appender - (setq cider-log-appender appender - cider-log-appender-id (cider-log-appender-id appender) - cider-log-appender-size (cider-log-appender-size appender) - cider-log-appender-threshold (cider-log-appender-threshold appender)) - (cider-log--set-filters (cider-log-appender-filters appender))) - (when consumer - (setq cider-log-consumer consumer) - (cider-log--set-filters (cider-log-consumer-filters appender))) - (when (and appender (not cider-log--initialized-once-p)) - (unless (cider-log-appender-reload framework appender) - (setq cider-log-appender (cider-sync-request:log-add-appender framework appender)) - (setq cider-log--initialized-once-p t)))) - -(defun cider-log-kill-buffer-hook-handler () - "Called from `kill-buffer-hook' to remove the consumer." - (when (eq 'cider-log-mode major-mode) - (when-let ((framework cider-log-framework) - (appender cider-log-appender) - (consumer cider-log-consumer)) - (cider-log--remove-current-buffer-consumer) - (message "Removed %s event consumer %s from appender %s." - (cider-log-framework-display-name framework) - (cider-log-consumer-display-name consumer) - (cider-log-appender-display-name appender))))) - -(defun cider-log-select-framework () - "Select the log framework." - (let ((frameworks (cider-sync-request:log-frameworks))) - (cond ((= 1 (length frameworks)) - (car frameworks)) - (t (let ((name (cider-log--read-framework-name))) - (cider-log-framework-by-name frameworks name)))))) - -(defun cider-log--current-framework () - "Return the log framework by the name bound to `cider-log-framework-name'." - (when cider-log-framework-name - (let ((frameworks (cider-sync-request:log-frameworks))) - (cider-log-framework-by-name frameworks cider-log-framework-name)))) - -(defun cider-log--framework () - "Return the current log framework, or select it." - (or (cider-log--current-framework) (cider-log-select-framework))) - -(defun cider-log--appender () - "Return the current log appender." - (when cider-log-appender-id - (nrepl-dict "id" cider-log-appender-id - "filters" (cider-log--filters) - "size" cider-log-appender-size - "threshold" cider-log-appender-threshold))) - -(defun cider-log--consumer () - "Return the current log consumer." - (let ((consumer (nrepl-dict "filters" (cider-log--filters)))) - (when cider-log-consumer - (nrepl-dict-put consumer "id" (cider-log-consumer-id cider-log-consumer))) - consumer)) - -(defun cider-log--event-options () - "Return the current log consumer." - (nrepl-dict "filters" (cider-log--filters) - "limit" cider-log-pagination-limit - "offset" cider-log-pagination-offset)) - -(defun cider-log--filters () - "Return the log event filters." - (nrepl-dict - "end-time" cider-log--end-time-filter - "exceptions" cider-log--exceptions-filter - "level" cider-log--level-filter - "loggers" cider-log--loggers-filter - "pattern" cider-log--pattern-filter - "start-time" cider-log--start-time-filter - "threads" cider-log--threads-filter)) - -(defun cider-log-event-at-point () - "Return the log event at point." - (get-text-property (point) :cider-log-event)) - -;;;###autoload (autoload 'cider-log-info "cider-log-info" "Show the Cider log current log buffer, framework, appender and consumer." t) -(defun cider-log-info () - "Show the current log buffer, framework, appender and consumer." - (interactive) - (message "%s" - (string-join - (list (when cider-log-buffer - (format "Buffer: %s" (cider-log--bold cider-log-buffer))) - (when cider-log-framework-name - (format "Framework: %s" (cider-log--bold cider-log-framework-name))) - (when cider-log-appender-id - (format "Appender: %s" (cider-log--bold cider-log-appender-id))) - (when-let (id (and cider-log-consumer (cider-log-consumer-id cider-log-consumer))) - (format "Consumer: %s" (cider-log--bold id)))) - " "))) - -;; Major mode - -(defvar cider-log-mode-map - (let ((map (make-sparse-keymap)) - (parent (if cider-log-use-logview logview-mode-map special-mode-map))) - (set-keymap-parent map parent) - (define-key map (kbd "C-c M-l a") #'cider-log-appender) - (define-key map (kbd "C-c M-l c") #'cider-log-consumer) - (define-key map (kbd "C-c M-l e") #'cider-log-event) - (define-key map (kbd "C-c M-l f") #'cider-log-framework) - (define-key map (kbd "C-c M-l i") #'cider-log-info) - (define-key map (kbd "C-c M-l l") #'cider-log) - (define-key map (kbd "E") 'cider-log-show-stacktrace) - (define-key map (kbd "F") 'cider-log-print-event) - (define-key map (kbd "I") 'cider-log-inspect-event) - (define-key map (kbd "RET") 'cider-log-inspect-event) - (define-key map (kbd "n") 'cider-log-event-next-line) - (define-key map (kbd "p") 'cider-log-event-previous-line) - map) - "The Cider log stream mode key map.") - -(defun cider-log--setup-mode () - "Setup CIDER log mode." - (use-local-map cider-log-mode-map) - (setq-local electric-indent-chars nil) - (setq-local logview-show-ellipses nil) - (setq-local sesman-system 'CIDER) - (setq-local truncate-lines t) - (when (fboundp 'evil-set-initial-state) - (evil-set-initial-state 'cider-log-mode 'emacs))) - -(defvar cider-log--mode-doc - "Major mode for inspecting Clojure log events. - -CIDER Log Mode allows you to capture, debug, inspect and view log events -emitted by Java logging frameworks. The captured log events can be -searched, streamed to the client, pretty printed and are integrated with -the CIDER Inspector and the CIDER stacktrace mode. - -\\{cider-log-mode-map}") - -(if cider-log-use-logview - (define-derived-mode cider-log-mode logview-mode "Cider Log" cider-log--mode-doc - (cider-log--setup-mode)) - (define-derived-mode cider-log-mode special-mode "Cider Log" cider-log--mode-doc - (cider-log--setup-mode))) - -;; Transient Lisp Variable - -(defclass cider-log--lisp-variable (transient-lisp-variable) ()) - -(cl-defmethod transient-init-value ((obj cider-log--lisp-variable)) - "Set the initial value of the object OBJ." - (let* ((prefix-value (oref transient--prefix value)) - (value (cdr (assoc (oref obj variable) prefix-value))) - (new-value (if (assoc (oref obj variable) prefix-value) - value - (symbol-value (oref obj variable))))) - (funcall (oref obj set-value) - (oref obj variable) - (oset obj value new-value)))) - -(cl-defmethod transient-infix-set ((obj cider-log--lisp-variable) value) - "Set the value of infix object OBJ to VALUE." - (funcall (oref obj set-value) - (oref obj variable) - (oset obj value value))) - -(cl-defmethod transient-infix-value ((obj cider-log--lisp-variable)) - "Return the value of the suffix object OBJ." - (cons (oref obj variable) (oref obj value))) - -(cl-defmethod transient-format-value ((obj cider-log--lisp-variable)) - "Format OBJ's value for display and return the result." - (propertize (prin1-to-string (oref obj value)) - 'face 'transient-value)) - -(cl-defmethod transient-format-value ((obj cider-log--lisp-variable)) - "Format OBJ's value for display and return the result." - (cider-log--format-value (oref obj value))) - -;; Transient options - -(transient-define-infix cider-log--appender-size-option () - :always-read t - :argument "--size=" - :class 'cider-log--lisp-variable - :description "Appender size" - :key "=s" - :prompt "Size: " - :reader #'cider-log--read-number-N+ - :variable 'cider-log-appender-size) - -(transient-define-infix cider-log--appender-threshold-option () - :always-read t - :argument "--threshold=" - :class 'cider-log--lisp-variable - :description "Appender threshold" - :key "=t" - :prompt "Threshold: " - :reader #'cider-log--read-number-N+ - :variable 'cider-log-appender-threshold) - -(transient-define-infix cider-log--buffer-option () - :always-read t - :class 'cider-log--lisp-variable - :description "Buffer" - :key "=b" - :prompt "Log buffer: " - :reader #'cider-log--read-buffer - :variable 'cider-log-buffer) - -(transient-define-infix cider-log--end-time-option () - :argument "--end-time=" - :class 'cider-log--lisp-variable - :description "Filter by end time" - :key "-e" - :prompt "End time: " - :reader #'cider-log--read-time - :variable 'cider-log--end-time-filter) - -(transient-define-infix cider-log--exceptions-option () - :argument "--exceptions=" - :class 'cider-log--lisp-variable - :description "Filter by exceptions" - :key "-E" - :multi-value t - :prompt "Exceptions: " - :reader #'cider-log--read-exceptions - :variable 'cider-log--exceptions-filter) - -(transient-define-infix cider-log--level-option () - :argument "--level=" - :class 'cider-log--lisp-variable - :description "Filter by level" - :key "-l" - :prompt "Log Level: " - :reader #'cider-log--read-level - :variable 'cider-log--level-filter) - -(transient-define-infix cider-log--limit-option () - :always-read t - :argument "--limit=" - :class 'cider-log--lisp-variable - :description "Limit" - :key "=l" - :prompt "Limit: " - :reader #'cider-log--read-number-N+ - :variable 'cider-log-pagination-limit) - -(transient-define-infix cider-log--logger-option () - :argument "--loggers=" - :class 'cider-log--lisp-variable - :description "Filter by loggers" - :key "-L" - :multi-value t - :prompt "Loggers: " - :reader #'cider-log--read-loggers - :variable 'cider-log--loggers-filter) - -(transient-define-infix cider-log--offset-option () - :always-read t - :argument "--offset=" - :class 'cider-log--lisp-variable - :description "Offset" - :key "=o" - :prompt "Offset: " - :reader #'cider-log--read-number-N0 - :variable 'cider-log-pagination-offset) - -(transient-define-infix cider-log--pattern-option () - :argument "--pattern=" - :class 'cider-log--lisp-variable - :description "Filter by regex pattern" - :key "-r" - :prompt "Regex pattern: " - :reader #'read-string - :variable 'cider-log--pattern-filter) - -(transient-define-infix cider-log--start-time-option () - :argument "--start-time=" - :class 'cider-log--lisp-variable - :description "Filter by start time" - :key "-s" - :prompt "Start time: " - :reader #'cider-log--read-time - :variable 'cider-log--start-time-filter) - -(transient-define-infix cider-log--threads-option () - :argument "--threads=" - :class 'cider-log--lisp-variable - :description "Filter by threads" - :key "-t" - :multi-value t - :prompt "Threads: " - :reader #'cider-log--read-threads - :variable 'cider-log--threads-filter) - -;; Framework actions - -(transient-define-suffix cider-log-browse-javadocs (framework) - "Browse the Javadoc of the log FRAMEWORK." - :description "Browse Java documentation" - (interactive (list (cider-log--framework))) - (browse-url (or (cider-log-framework-javadoc-url framework) - (user-error (format "The %s framework does not have Javadocs." - (cider-log-framework-name framework)))))) - -(transient-define-suffix cider-log-browse-website (framework) - "Browse the website of the log FRAMEWORK." - :description "Browse website" - (interactive (list (cider-log--framework))) - (browse-url (or (cider-log-framework-website-url framework) - (user-error (format "The %s framework does not have a website." - (cider-log-framework-name framework)))))) - -(transient-define-suffix cider-log-set-framework (framework-name) - "Set the current log framework to FRAMEWORK-NAME." - :description #'cider-log--description-set-framework - (interactive (list (cider-log--read-framework-name))) - (setq cider-log-framework-name framework-name)) - -(transient-define-suffix cider-log-set-buffer (buffer) - "Set the current log buffer to BUFFER." - :description #'cider-log--description-set-buffer - (interactive (list (cider-log--read-buffer))) - (setq cider-log-buffer buffer)) - -;; Appender actions - -(transient-define-suffix cider-log-clear-appender (framework appender) - "Clear the log events of the APPENDER of FRAMEWORK." - :description "Clear log appender" - :inapt-if-not #'cider-log-appender-attached-p - (interactive (list (cider-log--framework) (cider-log--appender))) - (cider-sync-request:log-clear framework appender) - (message "Cleared the %s log appender of the %s framework." - (cider-log-appender-display-name appender) - (cider-log-framework-display-name framework))) - -(transient-define-suffix cider-log-kill-appender (framework appender) - "Remove the log APPENDER from FRAMEWORK." - :description "Kill log appender" - :inapt-if-not #'cider-log-appender-attached-p - (interactive (list (cider-log--framework) (cider-log--appender))) - (cider-sync-request:log-remove-appender framework appender) - (setq-local cider-log-consumer nil) - (message "Log appender %s removed from the %s framework." - (cider-log-framework-display-name framework) - (cider-log-appender-display-name appender))) - -(transient-define-suffix cider-log--do-add-appender (framework appender) - "Add the APPENDER to the log FRAMEWORK." - :description "Add log appender" - :inapt-if #'cider-log-appender-attached-p - (interactive (list (cider-log--framework) (cider-log--appender))) - (setq cider-log-appender (cider-sync-request:log-add-appender framework appender)) - (message "Log appender %s added to the %s framework." - (cider-log-appender-display-name appender) - (cider-log-framework-display-name framework))) - -(transient-define-suffix cider-log--do-update-appender (framework appender) - "Update the APPENDER of the log FRAMEWORK." - :description "Update log appender" - :inapt-if-not #'cider-log-appender-attached-p - (interactive (list (cider-log--framework) (cider-log--appender))) - (setq cider-log-appender (cider-sync-request:log-update-appender framework appender)) - (message "Updated log appender %s of the %s framework." - (cider-log-appender-display-name appender) - (cider-log-framework-display-name framework))) - -;; Consumer actions - -(transient-define-suffix cider-log--do-add-consumer (framework appender consumer buffer) - "Add the CONSUMER to the APPENDER of the log FRAMEWORK and write events to BUFFER." - :description "Add log consumer" - :inapt-if #'cider-log-consumer-attached-p - (interactive (list (cider-log--framework) - (cider-log--appender) - (cider-log--consumer) - (current-buffer))) - (cider-log--consumer-add framework appender consumer buffer)) - -(transient-define-suffix cider-log-kill-consumer (framework appender consumer) - "Remove the CONSUMER listening to the APPENDER of the log FRAMEWORK." - :description "Kill log consumer" - :inapt-if-not #'cider-log-consumer-attached-p - (interactive (list (cider-log--framework) (cider-log--appender) (cider-log--consumer))) - (cider-sync-request:log-remove-consumer framework appender consumer) - (setq-local cider-log-consumer nil) - (message "Removed %s log consumer %s for appender %s." - (cider-log-framework-display-name framework) - (cider-log-consumer-display-name consumer) - (cider-log-appender-display-name appender))) - -(transient-define-suffix cider-log--do-update-consumer (framework appender consumer) - "Update the CONSUMER listening to the APPENDER of the log FRAMEWORK." - :description "Update log consumer" - :inapt-if-not #'cider-log-consumer-attached-p - (interactive (list (cider-log--framework) - (cider-log--appender) - (cider-log--consumer))) - (setq cider-log-consumer (cider-sync-request:log-update-consumer framework appender consumer)) - (message "Updated %s log consumer %s for appender %s." - (cider-log-framework-display-name framework) - (cider-log-consumer-display-name consumer) - (cider-log-appender-display-name appender))) - -;; Event actions - -(transient-define-suffix cider-log-show-stacktrace (framework appender event) - "Show the stacktrace of the log EVENT of FRAMEWORK and APPENDER." - :description "Show log event stacktrace" - :if #'cider-log-event-at-point - :inapt-if-not (lambda () - (when-let (event (cider-log-event-at-point)) - (cider-log-event-exception event))) - (interactive (list (cider-log--framework) (cider-log--appender) (cider-log-event-at-point))) - (cider-log-event--show-stacktrace framework appender event)) - -(transient-define-suffix cider-log-print-event (framework appender event) - "Format the log EVENT of FRAMEWORK and APPENDER." - :description "Pretty print log event at point" - :if #'cider-log-event-at-point - (interactive (list (cider-log--framework) (cider-log--appender) (cider-log-event-at-point))) - (if event - (cider-log-event--pretty-print framework appender event) - (user-error "No log event found at point"))) - -(transient-define-suffix cider-log-inspect-event (framework appender event) - "Inspect the log EVENT of FRAMEWORK and APPENDER." - :description "Inspect log event at point" - :if #'cider-log-event-at-point - (interactive (list (cider-log--framework) (cider-log--appender) (cider-log-event-at-point))) - (cider-log-event--inspect framework appender event)) - -(transient-define-suffix cider-log-clear-event-buffer (buffer) - "Clear the Cider log events in BUFFER." - :description #'cider-log--description-clear-events-buffer - :inapt-if-not #'cider-log-buffer-clear-p - (interactive (list cider-log-buffer)) - (when (get-buffer buffer) - (with-current-buffer buffer - (let ((inhibit-read-only t)) - (erase-buffer))))) - -(transient-define-suffix cider-log-switch-to-buffer (buffer) - "Switch to the Cider log event BUFFER." - :description "Switch to the log event buffer" - (interactive (list cider-log-buffer)) - (when (get-buffer-create buffer) - (switch-to-buffer-other-window buffer))) - -(transient-define-suffix cider-log--do-search-events (framework appender filters) - "Search the log events of FRAMEWORK and APPENDER which match FILTERS." - :description "Search log events" - :inapt-if-not #'cider-log-appender-attached-p - (interactive (list (cider-log--framework) (cider-log--appender) (cider-log--filters))) - (with-current-buffer (get-buffer-create cider-log-buffer) - (let ((consumer (nrepl-dict "filters" (cider-log--filters))) - (inhibit-read-only t)) - (cider-log--remove-current-buffer-consumer) - (erase-buffer) - (let ((events (cider-sync-request:log-search - framework appender - :filters filters - :limit cider-log-pagination-limit - :offset cider-log-pagination-offset))) - (seq-doseq (event (nreverse events)) - (insert (cider-log-event--format-logback event))) - (cider-log-mode) - (setq-local cider-log-framework framework) - (setq-local cider-log-appender appender) - (when (seq-empty-p events) - (message "No log events found.")) - (cider-log--consumer-add framework appender consumer (current-buffer)))))) - -;; Log Framework Transient - -;;;###autoload (autoload 'cider-log-framework "cider-log" "Show the Cider log framework menu." t) -(transient-define-prefix cider-log-framework (framework) - "Show the Cider log framework menu." - [["Cider Log Framework\n\nActions:" - ("b" cider-log-set-buffer) - ("j" cider-log-browse-javadocs) - ("s" cider-log-set-framework) - ("w" cider-log-browse-website)]] - (interactive (list (cider-log--framework))) - (cider-log--ensure-initialized framework) - (transient-setup 'cider-log-framework)) - -;; Log Appender Transients - -(defun cider-log--appender-interactive-list () - "Return the interactive arguments for a appender transient." - (let ((framework (cider-log--current-framework))) - (list framework (cider-log-framework-appender framework cider-log-appender-id)))) - -(transient-define-prefix cider-log-add-appender (framework appender) - "Show the menu to add a Cider log appender." - :history-key 'cider-log-appender - ["Cider Log Appender\n\nSettings:" - (cider-log--appender-size-option) - (cider-log--appender-threshold-option)] - ["Filters:" - (cider-log--end-time-option) - (cider-log--exceptions-option) - (cider-log--level-option) - (cider-log--logger-option) - (cider-log--pattern-option) - (cider-log--start-time-option) - (cider-log--threads-option)] - ["Actions" - ("a" cider-log--do-add-appender)] - (interactive (cider-log--appender-interactive-list)) - (cider-log--ensure-initialized framework appender) - (transient-setup 'cider-log-add-appender)) - -(transient-define-prefix cider-log-update-appender (framework appender) - "Show the menu to update a Cider log appender." - :history-key 'cider-log-appender - ["Cider Log Appender\n\nSettings:" - (cider-log--appender-size-option) - (cider-log--appender-threshold-option)] - ["Filters:" - (cider-log--end-time-option) - (cider-log--exceptions-option) - (cider-log--level-option) - (cider-log--logger-option) - (cider-log--pattern-option) - (cider-log--start-time-option) - (cider-log--threads-option)] - ["Actions" - ("u" cider-log--do-update-appender)] - (interactive (cider-log--appender-interactive-list)) - (cider-log--ensure-initialized framework appender) - (transient-setup 'cider-log-update-appender)) - -;;;###autoload (autoload 'cider-log-appender "cider-log" "Show the Cider log appender menu." t) -(transient-define-prefix cider-log-appender (framework appender) - "Show the Cider log appender menu." - :history-key 'cider-log-appender - ["Cider Log Appender\n\nSettings:" - (cider-log--appender-size-option) - (cider-log--appender-threshold-option)] - ["Filters:" - (cider-log--end-time-option) - (cider-log--exceptions-option) - (cider-log--level-option) - (cider-log--logger-option) - (cider-log--pattern-option) - (cider-log--start-time-option) - (cider-log--threads-option)] - ["Actions" - ("a" cider-log--do-add-appender) - ("c" cider-log-clear-appender) - ("k" cider-log-kill-appender) - ("u" cider-log--do-update-appender)] - (interactive (cider-log--appender-interactive-list)) - (cider-log--ensure-initialized framework appender) - (transient-setup 'cider-log-appender)) - -;; Log Consumer Transient Menu - -(defun cider-log--consumer-interactive-list () - "Return the interactive arguments for a consumer transient." - (let* ((framework (cider-log--current-framework)) - (appender (cider-log-framework-appender framework cider-log-appender-id))) - (list framework appender - (if (and appender cider-log-consumer) - (seq-find (lambda (consumer) - (equal (cider-log-consumer-id cider-log-consumer) - (cider-log-consumer-id consumer))) - (cider-log-appender-consumers appender)) - (nrepl-dict "filters" (cider-log--filters)))))) - -(transient-define-prefix cider-log-add-consumer (framework appender consumer) - "Show the menu to add a Cider log consumer." - :history-key 'cider-log-consumer - ["Cider Log Consumer\n\nFilters:" - (cider-log--end-time-option) - (cider-log--exceptions-option) - (cider-log--level-option) - (cider-log--logger-option) - (cider-log--pattern-option) - (cider-log--start-time-option) - (cider-log--threads-option)] - ["Actions" - ("a" cider-log--do-add-consumer)] - (interactive (cider-log--consumer-interactive-list)) - (cider-log--ensure-initialized framework appender consumer) - (transient-setup 'cider-log-add-consumer)) - -(transient-define-prefix cider-log-update-consumer (framework appender consumer) - "Show the menu to update a Cider log consumer." - :history-key 'cider-log-consumer - ["Cider Log Consumer\n\nFilters:" - (cider-log--end-time-option) - (cider-log--exceptions-option) - (cider-log--level-option) - (cider-log--logger-option) - (cider-log--pattern-option) - (cider-log--start-time-option) - (cider-log--threads-option)] - ["Actions" - ("u" cider-log--do-update-consumer)] - (interactive (cider-log--consumer-interactive-list)) - (cider-log--ensure-initialized framework appender consumer) - (transient-setup 'cider-log-update-consumer)) - -;;;###autoload (autoload 'cider-log-consumer "cider-log" "Show the Cider log consumer menu." t) -(transient-define-prefix cider-log-consumer (framework appender consumer) - "Show the Cider log consumer menu." - :history-key 'cider-log-consumer - ["Cider Log Consumer\n\nFilters:" - (cider-log--end-time-option) - (cider-log--exceptions-option) - (cider-log--level-option) - (cider-log--logger-option) - (cider-log--pattern-option) - (cider-log--start-time-option) - (cider-log--threads-option)] - ["Actions" - ("a" cider-log--do-add-consumer) - ("k" cider-log-kill-consumer) - ("u" cider-log--do-update-consumer)] - (interactive (cider-log--consumer-interactive-list)) - (cider-log--ensure-initialized framework appender consumer) - (transient-setup 'cider-log-consumer)) - -;; Log Event Transient Menu - -(transient-define-prefix cider-log-event-search (framework appender) - "Search the search log events menu." - :history-key 'cider-log-event - ["Cider Log Event\n\nPagination:" - (cider-log--limit-option) - (cider-log--offset-option)] - ["Filters:" - (cider-log--end-time-option) - (cider-log--exceptions-option) - (cider-log--level-option) - (cider-log--logger-option) - (cider-log--pattern-option) - (cider-log--start-time-option) - (cider-log--threads-option)] - ["Actions" - ("s" cider-log--do-search-events)] - (interactive (list (cider-log--framework) (cider-log--appender))) - (cider-log--ensure-initialized framework appender) - (transient-setup 'cider-log-event-search)) - -;;;###autoload (autoload 'cider-log-event "cider-log" "Show the Cider log event menu." t) -(transient-define-prefix cider-log-event (framework appender) - "Show the Cider log event menu." - :history-key 'cider-log-event - ["Cider Log Event\n\nPagination:" - (cider-log--limit-option) - (cider-log--offset-option)] - ["Filters:" - (cider-log--end-time-option) - (cider-log--exceptions-option) - (cider-log--level-option) - (cider-log--logger-option) - (cider-log--pattern-option) - (cider-log--start-time-option) - (cider-log--threads-option)] - ["Actions" - ("c" cider-log-clear-event-buffer) - ("e" cider-log-show-stacktrace) - ("i" cider-log-inspect-event) - ("p" cider-log-print-event) - ("s" cider-log--do-search-events)] - (interactive (list (cider-log--framework) (cider-log--appender))) - (cider-log--ensure-initialized framework appender) - (transient-setup 'cider-log-event)) - -;; Main Transient Menu - -;;;###autoload (autoload 'cider-log "cider-log" "Show the Cider log menu." t) -(transient-define-prefix cider-log (framework appender) - "Show the Cider log menu." - [["Framework Actions" - ("fs" cider-log-set-framework) - ("fb" cider-log-set-buffer) - ("fj" cider-log-browse-javadocs) - ("fw" cider-log-browse-website)] - ["Appender Actions" - ("aa" "Add log appender" cider-log-add-appender - :inapt-if cider-log-appender-attached-p) - ("ac" cider-log-clear-appender) - ("ak" cider-log-kill-appender) - ("am" "Manage appender" cider-log-appender) - ("au" "Update log appender" cider-log-update-appender - :inapt-if-not cider-log-appender-attached-p)] - ["Consumer Actions" - ("ca" "Add log consumer" cider-log-add-consumer - :inapt-if cider-log-consumer-attached-p) - ("ck" cider-log-kill-consumer) - ("cm" "Manage consumer" cider-log-consumer) - ("cu" "Update log consumer" cider-log-update-consumer - :inapt-if-not cider-log-consumer-attached-p)] - ["Event Actions" - ("eb" cider-log-switch-to-buffer) - ("ec" cider-log-clear-event-buffer) - ("ee" cider-log-show-stacktrace) - ("ei" cider-log-inspect-event) - ("ep" cider-log-print-event) - ("es" "Search log events" cider-log-event-search - :inapt-if-not cider-log-appender-attached-p)]] - (interactive (list (cider-log--framework) (cider-log--appender))) - (cider-log--ensure-initialized framework appender) - (transient-setup 'cider-log)) - -(add-hook 'kill-buffer-hook #'cider-log-kill-buffer-hook-handler) - -(provide 'cider-log) - -;;; cider-log.el ends here diff --git a/elpa/cider-1.12.0/cider-macroexpansion.el b/elpa/cider-1.12.0/cider-macroexpansion.el @@ -1,204 +0,0 @@ -;;; cider-macroexpansion.el --- Macro expansion support -*- lexical-binding: t -*- - -;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2023 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; -;; Author: Tim King <kingtim@gmail.com> -;; Phil Hagelberg <technomancy@gmail.com> -;; Bozhidar Batsov <bozhidar@batsov.dev> -;; Artur Malabarba <bruce.connor.am@gmail.com> -;; Hugo Duncan <hugo@hugoduncan.org> -;; Steve Purcell <steve@sanityinc.com> - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Macro expansion support. - -;;; Code: - -(require 'cider-mode) -(require 'subr-x) - -(defconst cider-macroexpansion-buffer "*cider-macroexpansion*") - -(defcustom cider-macroexpansion-display-namespaces 'tidy - "Determines if namespaces are displayed in the macroexpansion buffer. -Possible values are: - - 'qualified ;=> Vars are fully-qualified in the expansion - 'none ;=> Vars are displayed without namespace qualification - 'tidy ;=> Vars that are :refer-ed or defined in the current namespace are - displayed with their simple name, non-referred vars from other - namespaces are referred using the alias for that namespace (if - defined), other vars are displayed fully qualified." - :type '(choice (const :tag "Suppress namespaces" none) - (const :tag "Show fully-qualified namespaces" qualified) - (const :tag "Show namespace aliases" tidy)) - :group 'cider - :package-version '(cider . "0.7.0")) - -(defcustom cider-macroexpansion-print-metadata nil - "Determines if metadata is included in macroexpansion results." - :type 'boolean - :group 'cider - :package-version '(cider . "0.9.0")) - -(defun cider-sync-request:macroexpand (expander expr &optional display-namespaces) - "Macroexpand, using EXPANDER, the given EXPR. -The default for DISPLAY-NAMESPACES is taken from -`cider-macroexpansion-display-namespaces'." - (cider-ensure-op-supported "macroexpand") - (let ((result (thread-first `("op" "macroexpand" - "expander" ,expander - "code" ,expr - "ns" ,(cider-current-ns) - "display-namespaces" ,(or display-namespaces - (symbol-name cider-macroexpansion-display-namespaces))) - (nconc (when cider-macroexpansion-print-metadata - '("print-meta" "true"))) - (cider-nrepl-send-sync-request)))) - (nrepl-dbind-response result (expansion status) - (if (member "macroexpand-error" status) - (user-error "Macroexpansion failed. Check *cider-error* for more details") - expansion)))) - -(defun cider-macroexpand-undo (&optional arg) - "Undo the last macroexpansion, using `undo-only'. -ARG is passed along to `undo-only'." - (interactive) - (let ((inhibit-read-only t)) - (undo-only arg))) - -(defvar cider-last-macroexpand-expression nil - "Specify the last macroexpansion performed. -This variable specifies both what was expanded and the expander.") - -(defun cider-macroexpand-expr (expander expr) - "Macroexpand, use EXPANDER, the given EXPR." - (when-let* ((expansion (cider-sync-request:macroexpand expander expr))) - (setq cider-last-macroexpand-expression expr) - (cider-initialize-macroexpansion-buffer expansion (cider-current-ns)))) - -(defun cider-macroexpand-expr-inplace (expander) - "Substitute the form preceding point with its macroexpansion using EXPANDER." - (interactive) - (let* ((expansion (cider-sync-request:macroexpand expander (cider-last-sexp))) - (bounds (cons (save-excursion (clojure-backward-logical-sexp 1) (point)) (point)))) - (cider-redraw-macroexpansion-buffer - expansion (current-buffer) (car bounds) (cdr bounds)))) - -(defun cider-macroexpand-again () - "Repeat the last macroexpansion." - (interactive) - (cider-initialize-macroexpansion-buffer cider-last-macroexpand-expression (cider-current-ns))) - -;;;###autoload -(defun cider-macroexpand-1 (&optional prefix) - "Invoke \\=`macroexpand-1\\=` on the expression preceding point. -If invoked with a PREFIX argument, use \\=`macroexpand\\=` instead of -\\=`macroexpand-1\\=`." - (interactive "P") - (let ((expander (if prefix "macroexpand" "macroexpand-1"))) - (cider-macroexpand-expr expander (cider-last-sexp)))) - -(defun cider-macroexpand-1-inplace (&optional prefix) - "Perform inplace \\=`macroexpand-1\\=` on the expression preceding point. -If invoked with a PREFIX argument, use \\=`macroexpand\\=` instead of -\\=`macroexpand-1\\=`." - (interactive "P") - (let ((expander (if prefix "macroexpand" "macroexpand-1"))) - (cider-macroexpand-expr-inplace expander))) - -;;;###autoload -(defun cider-macroexpand-all () - "Invoke \\=`macroexpand-all\\=` on the expression preceding point." - (interactive) - (cider-macroexpand-expr "macroexpand-all" (cider-last-sexp))) - -(defun cider-macroexpand-all-inplace () - "Perform inplace \\=`macroexpand-all\\=` on the expression preceding point." - (interactive) - (cider-macroexpand-expr-inplace "macroexpand-all")) - -(defun cider-initialize-macroexpansion-buffer (expansion ns) - "Create a new Macroexpansion buffer with EXPANSION and namespace NS." - (pop-to-buffer (cider-create-macroexpansion-buffer)) - (setq cider-buffer-ns ns) - (setq buffer-undo-list nil) - (let ((inhibit-read-only t) - (buffer-undo-list t)) - (erase-buffer) - (insert (format "%s" expansion)) - (goto-char (point-max)) - (font-lock-ensure))) - -(defun cider-redraw-macroexpansion-buffer (expansion buffer start end) - "Redraw the macroexpansion with new EXPANSION. -Text in BUFFER from START to END is replaced with new expansion, -and point is placed after the expanded form." - (with-current-buffer buffer - (let ((buffer-read-only nil)) - (goto-char start) - (delete-region start end) - (insert (format "%s" expansion)) - (goto-char start) - (indent-sexp) - (forward-sexp)))) - -(declare-function cider-mode "cider-mode") - -(defun cider-create-macroexpansion-buffer () - "Create a new macroexpansion buffer." - (with-current-buffer (cider-popup-buffer cider-macroexpansion-buffer 'select 'clojure-mode 'ancillary) - (cider-mode -1) - (cider-macroexpansion-mode 1) - (current-buffer))) - -(declare-function cider-find-var "cider-find") - -(defvar cider-macroexpansion-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "g") #'cider-macroexpand-again) - (define-key map (kbd "q") #'cider-popup-buffer-quit-function) - (define-key map (kbd "d") #'cider-doc) - (define-key map (kbd "j") #'cider-javadoc) - (define-key map (kbd ".") #'cider-find-var) - (define-key map (kbd "m") #'cider-macroexpand-1-inplace) - (define-key map (kbd "a") #'cider-macroexpand-all-inplace) - (define-key map (kbd "u") #'cider-macroexpand-undo) - (define-key map [remap undo] #'cider-macroexpand-undo) - (easy-menu-define cider-macroexpansion-mode-menu map - "Menu for CIDER's doc mode" - '("Macroexpansion" - ["Restart expansion" cider-macroexpand-again] - ["Macroexpand-1" cider-macroexpand-1-inplace] - ["Macroexpand-all" cider-macroexpand-all-inplace] - ["Macroexpand-undo" cider-macroexpand-undo] - ["Go to source" cider-find-var] - ["Go to doc" cider-doc] - ["Go to Javadoc" cider-docview-javadoc] - ["Quit" cider-popup-buffer-quit-function])) - map)) - -(define-minor-mode cider-macroexpansion-mode - "Minor mode for CIDER macroexpansion." - :lighter " Macroexpand") - -(provide 'cider-macroexpansion) - -;;; cider-macroexpansion.el ends here diff --git a/elpa/cider-1.12.0/cider-mode.el b/elpa/cider-1.12.0/cider-mode.el @@ -1,1107 +0,0 @@ -;;; cider-mode.el --- Minor mode for REPL interactions -*- lexical-binding: t -*- - -;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2023 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; -;; Author: Tim King <kingtim@gmail.com> -;; Phil Hagelberg <technomancy@gmail.com> -;; Bozhidar Batsov <bozhidar@batsov.dev> -;; Artur Malabarba <bruce.connor.am@gmail.com> -;; Hugo Duncan <hugo@hugoduncan.org> -;; Steve Purcell <steve@sanityinc.com> - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Minor mode for REPL interactions. - -;;; Code: - -(require 'clojure-mode) -(require 'cider-eval) -(require 'cider-test) ; required only for the menu -(require 'cider-eldoc) -(require 'cider-resolve) -(require 'cider-doc) ; required only for the menu -(require 'cider-profile) ; required only for the menu -(require 'cider-completion) -(require 'cider-completion-context) -(require 'cider-inspector) -(require 'cider-find) -(require 'cider-xref-backend) -(require 'subr-x) - -(defcustom cider-mode-line-show-connection t - "If the mode-line lighter should detail the connection." - :group 'cider - :type 'boolean - :package-version '(cider "0.10.0")) - -(defun cider--modeline-info () - "Return info for the cider mode modeline. -Info contains the connection type, project name and host:port endpoint." - (if-let* ((current-connection (ignore-errors (cider-current-repl)))) - (with-current-buffer current-connection - (concat - (symbol-name cider-repl-type) - (when cider-mode-line-show-connection - (format ":%s@%s:%s" - (or (cider--project-name nrepl-project-dir) "<no project>") - (pcase (plist-get nrepl-endpoint :host) - ("localhost" "") - (x x)) - (plist-get nrepl-endpoint :port))))) - "not connected")) - -;;;###autoload -(defcustom cider-mode-line - '(:eval (format " cider[%s]" (cider--modeline-info))) - "Mode line lighter for cider mode. - -The value of this variable is a mode line template as in -`mode-line-format'. See Info Node `(elisp)Mode Line Format' for details -about mode line templates. - -Customize this variable to change how cider mode displays its status in the -mode line. The default value displays the current connection. Set this -variable to nil to disable the mode line entirely." - :group 'cider - :type 'sexp - :risky t - :package-version '(cider "0.7.0")) - - -;;; Switching between REPL & source buffers - -(defun cider--switch-to-repl-buffer (repl-buffer &optional set-namespace) - "Select the REPL-BUFFER, when possible in an existing window. -When SET-NAMESPACE is t, sets the namespace in the REPL buffer to -that of the namespace in the Clojure source buffer." - (let ((buffer (current-buffer))) - ;; first we switch to the REPL buffer - (if cider-repl-display-in-current-window - (pop-to-buffer-same-window repl-buffer) - (pop-to-buffer repl-buffer)) - ;; then if necessary we update its namespace - (when set-namespace - (cider-repl-set-ns (with-current-buffer buffer (cider-current-ns)))) - (goto-char (point-max)))) - -(defun cider-switch-to-repl-buffer (&optional set-namespace) - "Switch to current REPL buffer, when possible in an existing window. -The type of the REPL is inferred from the mode of current buffer. With a -prefix arg SET-NAMESPACE sets the namespace in the REPL buffer to that of -the namespace in the Clojure source buffer" - (interactive "P") - (cider--switch-to-repl-buffer - (cider-current-repl nil 'ensure) - set-namespace)) - -(declare-function cider-load-buffer "cider-eval") - -(defun cider-load-buffer-and-switch-to-repl-buffer (&optional set-namespace) - "Load the current buffer into the matching REPL buffer and switch to it. -When SET-NAMESPACE is true, we'll also set the REPL's ns to match that of the -Clojure buffer." - (interactive "P") - (cider-load-buffer) - (cider-switch-to-repl-buffer set-namespace)) - -(defun cider-switch-to-last-clojure-buffer () - "Switch to the last Clojure buffer. -The default keybinding for this command is -the same as variable `cider-switch-to-repl-buffer', -so that it is very convenient to jump between a -Clojure buffer and the REPL buffer." - (interactive) - (if (derived-mode-p 'cider-repl-mode) - (let* ((a-buf) - (the-buf (let ((repl-type (cider-repl-type-for-buffer))) - (seq-find (lambda (b) - (unless (with-current-buffer b (derived-mode-p 'cider-repl-mode)) - (when-let* ((type (cider-repl-type-for-buffer b))) - (unless a-buf - (setq a-buf b)) - (or (eq type 'multi) - (eq type repl-type))))) - (buffer-list))))) - (if-let* ((buf (or the-buf a-buf))) - (if cider-repl-display-in-current-window - (pop-to-buffer-same-window buf) - (pop-to-buffer buf)) - (user-error "No Clojure buffer found"))) - (user-error "Not in a CIDER REPL buffer"))) - -(defun cider-find-and-clear-repl-output (&optional clear-repl) - "Find the current REPL buffer and clear it. -With a prefix argument CLEAR-REPL the command clears the entire REPL -buffer. Returns to the buffer in which the command was invoked. See also -the related commands `cider-repl-clear-buffer' and -`cider-repl-clear-output'." - (interactive "P") - (let ((origin-buffer (current-buffer))) - (switch-to-buffer (cider-current-repl nil 'ensure)) - (if clear-repl - (cider-repl-clear-buffer) - (cider-repl-clear-output)) - (switch-to-buffer origin-buffer))) - -;;; cider-run -(defvar cider--namespace-history nil - "History of user input for namespace prompts.") - -(defun cider--var-namespace (var) - "Return the namespace of VAR. -VAR is a fully qualified Clojure variable name as a string." - (replace-regexp-in-string "\\(?:#'\\)?\\(.*\\)/.*" "\\1" var)) - -(defun cider-run (&optional function) - "Run -main or FUNCTION, prompting for its namespace if necessary. -With a prefix argument, prompt for function to run instead of -main." - (interactive (list (when current-prefix-arg (read-string "Function name: ")))) - (cider-ensure-connected) - (let ((name (or function "-main"))) - (when-let* ((response (cider-nrepl-send-sync-request - `("op" "ns-list-vars-by-name" - "name" ,name)))) - (if-let* ((vars (split-string (substring (nrepl-dict-get response "var-list") 1 -1)))) - (cider-interactive-eval - (if (= (length vars) 1) - (concat "(" (car vars) ")") - (let* ((completions (mapcar #'cider--var-namespace vars)) - (def (or (car cider--namespace-history) - (car completions)))) - (format "(#'%s/%s)" - (completing-read (format "Namespace (%s): " def) - completions nil t nil - 'cider--namespace-history def) - name)))) - (user-error "No %s var defined in any namespace" (cider-propertize name 'fn)))))) - -;;; Insert (and eval) in REPL functionality -(defvar cider-insert-commands-map - (let ((map (define-prefix-command 'cider-insert-commands-map))) - ;; single key bindings defined last for display in menu - (define-key map (kbd "e") #'cider-insert-last-sexp-in-repl) - (define-key map (kbd "d") #'cider-insert-defun-in-repl) - (define-key map (kbd "r") #'cider-insert-region-in-repl) - (define-key map (kbd "n") #'cider-insert-ns-form-in-repl) - - ;; duplicates with C- for convenience - (define-key map (kbd "C-e") #'cider-insert-last-sexp-in-repl) - (define-key map (kbd "C-d") #'cider-insert-defun-in-repl) - (define-key map (kbd "C-r") #'cider-insert-region-in-repl) - (define-key map (kbd "C-n") #'cider-insert-ns-form-in-repl) - map)) - -(defcustom cider-switch-to-repl-on-insert t - "Whether to switch to the REPL when inserting a form into the REPL." - :type 'boolean - :group 'cider - :package-version '(cider . "0.21.0")) - -(defcustom cider-invert-insert-eval-p nil - "Whether to invert the behavior of evaling. -Default behavior when inserting is to NOT eval the form and only eval with -a prefix. This allows to invert this so that default behavior is to insert -and eval and the prefix is required to prevent evaluation." - :type 'boolean - :group 'cider - :package-version '(cider . "0.18.0")) - -(defun cider-insert-in-repl (form eval) - "Insert FORM in the REPL buffer and switch to it. -If EVAL is non-nil the form will also be evaluated. Use -`cider-invert-insert-eval-p' to invert this behavior." - (while (string-match "\\`[ \t\n\r]+\\|[ \t\n\r]+\\'" form) - (setq form (replace-match "" t t form))) - (when cider-switch-to-repl-on-insert - (cider-switch-to-repl-buffer)) - (let ((repl (cider-current-repl))) - (with-selected-window (or (get-buffer-window repl t) - (selected-window)) - (with-current-buffer repl - (goto-char (point-max)) - (let ((beg (point))) - (insert form) - (indent-region beg (point)) - (font-lock-ensure beg (point))) - (when (if cider-invert-insert-eval-p - (not eval) - eval) - (cider-repl-return)) - (goto-char (point-max)))))) - -(defun cider-insert-last-sexp-in-repl (&optional arg) - "Insert the expression preceding point in the REPL buffer. -If invoked with a prefix ARG eval the expression after inserting it." - (interactive "P") - (cider-insert-in-repl (cider-last-sexp) arg)) - -(defun cider-insert-defun-in-repl (&optional arg) - "Insert the top level form at point in the REPL buffer. -If invoked with a prefix ARG eval the expression after inserting it." - (interactive "P") - (cider-insert-in-repl (cider-defun-at-point) arg)) - -(defun cider-insert-region-in-repl (start end &optional arg) - "Insert the current region in the REPL buffer. -START and END represent the region's boundaries. -If invoked with a prefix ARG eval the expression after inserting it." - (interactive "rP") - (cider-insert-in-repl - (buffer-substring-no-properties start end) arg)) - -(defun cider-insert-ns-form-in-repl (&optional arg) - "Insert the current buffer's ns form in the REPL buffer. -If invoked with a prefix ARG eval the expression after inserting it." - (interactive "P") - (cider-insert-in-repl (cider-ns-form) arg)) - - - -;;; The menu-bar -(defconst cider-mode-menu - `("CIDER" - ["Start or connect to any REPL" cider - :help "A simple wrapper around all commands for starting/connecting to a REPL."] - ("Clojure" - ["Start a Clojure REPL" cider-jack-in - :help "Starts an nREPL server and connects a Clojure REPL to it."] - ["Connect to a Clojure REPL" cider-connect - :help "Connects to a REPL that's already running."]) - ("ClojureScript" - ["Start a ClojureScript REPL" cider-jack-in-cljs - :help "Starts an nREPL server and connects a ClojureScript REPL to it."] - ["Connect to a ClojureScript REPL" cider-connect-clojurescript - :help "Connects to a ClojureScript REPL that's already running."] - ["Create a ClojureScript REPL from a Clojure REPL" cider-jack-in-sibling-clojurescript]) - "--" - ["Quit" cider-quit :active (cider-connected-p)] - ["Restart" cider-restart :active (cider-connected-p)] - "--" - ["Connection info" cider-describe-connection - :active (cider-connected-p)] - ["Select any CIDER buffer" cider-selector] - "--" - ["Configure CIDER" (customize-group 'cider)] - "--" - ["A sip of CIDER" cider-drink-a-sip] - ["View user manual" cider-view-manual] - ["View quick reference card" cider-view-refcard] - ["Report a bug" cider-report-bug] - ["Version info" cider-version] - "--" - ["Close ancillary buffers" cider-close-ancillary-buffers - :active (seq-remove #'null cider-ancillary-buffers)] - ("nREPL" :active (cider-connected-p) - ["List nREPL middleware" cider-list-nrepl-middleware] - ["Describe nREPL session" cider-describe-nrepl-session] - ["Toggle message logging" nrepl-toggle-message-logging])) - "Menu for CIDER mode.") - -(defconst cider-mode-eval-menu - '("CIDER Eval" :visible (cider-connected-p) - ["Eval top-level sexp" cider-eval-defun-at-point] - ["Eval top-level sexp to point" cider-eval-defun-up-to-point] - ["Eval top-level sexp to comment" cider-eval-defun-to-comment] - ["Eval top-level sexp and pretty-print to comment" cider-pprint-eval-defun-to-comment] - "--" - ["Eval current list" cider-eval-list-at-point] - ["Eval current sexp" cider-eval-sexp-at-point] - ["Eval and tap current sexp" cider-tap-sexp-at-point] - ["Eval current sexp to point" cider-eval-sexp-up-to-point] - ["Eval current sexp in context" cider-eval-sexp-at-point-in-context] - "--" - ["Eval last sexp" cider-eval-last-sexp] - ["Eval and tap last sexp" cider-tap-last-sexp] - ["Eval last sexp in context" cider-eval-last-sexp-in-context] - ["Eval last sexp and insert" cider-eval-print-last-sexp - :keys "\\[universal-argument] \\[cider-eval-last-sexp]"] - ["Eval last sexp in popup buffer" cider-pprint-eval-last-sexp] - ["Eval last sexp and replace" cider-eval-last-sexp-and-replace] - ["Eval last sexp to REPL" cider-eval-last-sexp-to-repl] - ["Eval last sexp and pretty-print to REPL" cider-pprint-eval-last-sexp-to-repl] - ["Eval last sexp and pretty-print to comment" cider-pprint-eval-last-sexp-to-comment] - "--" - ["Eval selected region if active, otherwise top-level sexp" cider-eval-dwim] - ["Eval selected region" cider-eval-region] - ["Eval ns form" cider-eval-ns-form] - "--" - ["Interrupt evaluation" cider-interrupt] - "--" - ["Insert last sexp in REPL" cider-insert-last-sexp-in-repl] - ["Insert last sexp in REPL and eval" (cider-insert-last-sexp-in-repl t) - :keys "\\[universal-argument] \\[cider-insert-last-sexp-in-repl]"] - ["Insert top-level sexp in REPL" cider-insert-defun-in-repl] - ["Insert region in REPL" cider-insert-region-in-repl] - ["Insert ns form in REPL" cider-insert-ns-form-in-repl] - "--" - ["Load this buffer" cider-load-buffer] - ["Load this buffer and switch to REPL" cider-load-buffer-and-switch-to-repl-buffer] - ["Load another file" cider-load-file] - ["Recursively load all files in directory" cider-load-all-files] - ["Load all project files" cider-load-all-project-ns] - ["Refresh loaded code" cider-ns-refresh] - ["Require and reload" cider-ns-reload] - ["Require and reload all" cider-ns-reload-all] - ["Run project (-main function)" cider-run]) - "Menu for CIDER mode eval commands.") - -(defconst cider-mode-interactions-menu - `("CIDER Interactions" :visible (cider-connected-p) - ["Complete symbol" complete-symbol] - "--" - ("REPL" - ["Set REPL to this ns" cider-repl-set-ns] - ["Switch to REPL" cider-switch-to-repl-buffer] - ["REPL Pretty Print" cider-repl-toggle-pretty-printing - :style toggle :selected cider-repl-use-pretty-printing] - ["Clear latest output" cider-find-and-clear-repl-output] - ["Clear all output" (cider-find-and-clear-repl-output t) - :keys "\\[universal-argument] \\[cider-find-and-clear-repl-output]"] - "--" - ["Configure the REPL" (customize-group 'cider-repl)]) - ,cider-doc-menu - ("Find (jump to)" - ["Find definition" cider-find-var] - ["Find namespace" cider-find-ns] - ["Find resource" cider-find-resource] - ["Find keyword" cider-find-keyword] - ["Go back" cider-pop-back]) - ("Xref" - ["Find fn references" cider-xref-fn-refs] - ["Find fn references and select" cider-xref-fn-refs-select] - ["Find fn dependencies" cider-xref-fn-defs] - ["Find fn dependencies and select" cider-xref-fn-defs-select]) - ("Browse" - ["Browse namespace" cider-browse-ns] - ["Browse all namespaces" cider-browse-ns-all] - ["Browse spec" cider-browse-spec] - ["Browse all specs" cider-browse-spec-all] - ["Browse REPL input history" cider-repl-history] - ["Browse classpath" cider-classpath] - ["Browse classpath entry" cider-open-classpath-entry]) - ("Format" - ["Format EDN last sexp" cider-format-edn-last-sexp] - ["Format EDN region" cider-format-edn-region] - ["Format EDN buffer" cider-format-edn-buffer]) - ("Macroexpand" - ["Macroexpand-1" cider-macroexpand-1] - ["Macroexpand-all" cider-macroexpand-all]) - ,cider-test-menu - ("Debug" - ["Inspect" cider-inspect] - ["Toggle var tracing" cider-toggle-trace-var] - ["Toggle ns tracing" cider-toggle-trace-ns] - "--" - ["Debug top-level form" cider-debug-defun-at-point - :keys "\\[universal-argument] \\[cider-eval-defun-at-point]"] - ["List instrumented defs" cider-browse-instrumented-defs] - "--" - ["Configure the Debugger" (customize-group 'cider-debug)]) - ,cider-profile-menu - ("Misc" - ["Clojure Cheatsheet" cider-cheatsheet] - ["Flush completion cache" cider-completion-flush-caches])) - "Menu for CIDER interactions.") - - -(declare-function cider-ns-refresh "cider-ns") -(declare-function cider-ns-reload "cider-ns") -(declare-function cider-ns-reload-all "cider-ns") -(declare-function cider-browse-ns "cider-browse-ns") -(declare-function cider-eval-ns-form "cider-eval") -(declare-function cider-repl-set-ns "cider-repl") -(declare-function cider-find-ns "cider-find") - -(defvar cider-ns-map - (let ((map (define-prefix-command 'cider-ns-map))) - (define-key map (kbd "b") #'cider-browse-ns) - (define-key map (kbd "M-b") #'cider-browse-ns) - (define-key map (kbd "e") #'cider-eval-ns-form) - (define-key map (kbd "M-e") #'cider-eval-ns-form) - (define-key map (kbd "f") #'cider-find-ns) - (define-key map (kbd "M-f") #'cider-find-ns) - (define-key map (kbd "n") #'cider-repl-set-ns) - (define-key map (kbd "M-n") #'cider-repl-set-ns) - (define-key map (kbd "r") #'cider-ns-refresh) - (define-key map (kbd "M-r") #'cider-ns-refresh) - (define-key map (kbd "l") #'cider-ns-reload) - (define-key map (kbd "M-l") #'cider-ns-reload-all) - map) - "CIDER NS keymap.") - -;; Those declares are needed, because we autoload all those commands when first -;; used. That optimizes CIDER's initial load time. -(declare-function cider-macroexpand-1 "cider-macroexpansion") -(declare-function cider-macroexpand-all "cider-macroexpansion") -(declare-function cider-selector "cider-selector") -(declare-function cider-toggle-trace-ns "cider-tracing") -(declare-function cider-toggle-trace-var "cider-tracing") -(declare-function cider-find-resource "cider-find") -(declare-function cider-find-keyword "cider-find") -(declare-function cider-find-var "cider-find") -(declare-function cider-find-dwim-at-mouse "cider-find") -(declare-function cider-xref-fn-refs "cider-xref") -(declare-function cider-xref-fn-refs-select "cider-xref") -(declare-function cider-xref-fn-deps "cider-xref") -(declare-function cider-xref-fn-deps-select "cider-xref") - -(defconst cider--has-many-mouse-buttons (not (memq window-system '(mac ns))) - "Non-nil if system binds forward and back buttons to <mouse-8> and <mouse-9>. - -As it stands Emacs fires these events on <mouse-8> and <mouse-9> on 'x' and -'w32'systems while on macOS it presents them on <mouse-4> and <mouse-5>.") - -(defcustom cider-use-xref t - "Enable xref integration." - :type 'boolean - :safe #'booleanp - :group 'cider - :version '(cider . "1.2.0")) - -(defcustom cider-xref-fn-depth -90 - "The depth to use when adding the CIDER xref function to the relevant hook. -By convention this is a number between -100 and 100, lower numbers indicating a -higher precedence." - :type 'integer - :group 'cider - :version '(cider . "1.2.0")) - -(defconst cider-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-c C-d") 'cider-doc-map) - (unless cider-use-xref - (define-key map (kbd "M-.") #'cider-find-var) - (define-key map (kbd "M-,") #'cider-pop-back)) - (define-key map (kbd (if cider--has-many-mouse-buttons "<mouse-8>" "<mouse-4>")) #'xref-pop-marker-stack) - (define-key map (kbd (if cider--has-many-mouse-buttons "<mouse-9>" "<mouse-5>")) #'cider-find-dwim-at-mouse) - (define-key map (kbd "C-c C-.") #'cider-find-ns) - (define-key map (kbd "C-c C-:") #'cider-find-keyword) - (define-key map (kbd "C-c M-.") #'cider-find-resource) - (define-key map (kbd "M-TAB") #'complete-symbol) - (define-key map (kbd "C-M-x") #'cider-eval-defun-at-point) - (define-key map (kbd "C-c C-c") #'cider-eval-defun-at-point) - (define-key map (kbd "C-x C-e") #'cider-eval-last-sexp) - (define-key map (kbd "C-c C-e") #'cider-eval-last-sexp) - (define-key map (kbd "C-c C-p") #'cider-pprint-eval-last-sexp) - (define-key map (kbd "C-c C-f") #'cider-pprint-eval-defun-at-point) - (define-key map (kbd "C-c C-v") 'cider-eval-commands-map) - (define-key map (kbd "C-c C-j") 'cider-insert-commands-map) - (define-key map (kbd "C-c M-;") #'cider-eval-defun-to-comment) - (define-key map (kbd "C-c M-e") #'cider-eval-last-sexp-to-repl) - (define-key map (kbd "C-c M-p") #'cider-insert-last-sexp-in-repl) - (define-key map (kbd "C-c M-:") #'cider-read-and-eval) - (define-key map (kbd "C-c C-u") #'cider-undef) - (define-key map (kbd "C-c C-M-u") #'cider-undef-all) - (define-key map (kbd "C-c C-m") #'cider-macroexpand-1) - (define-key map (kbd "C-c M-m") #'cider-macroexpand-all) - (define-key map (kbd "C-c M-n") 'cider-ns-map) - (define-key map (kbd "C-c M-i") #'cider-inspect) - (define-key map (kbd "C-c M-t v") #'cider-toggle-trace-var) - (define-key map (kbd "C-c M-t n") #'cider-toggle-trace-ns) - (define-key map (kbd "C-c C-z") #'cider-switch-to-repl-buffer) - (define-key map (kbd "C-c M-z") #'cider-load-buffer-and-switch-to-repl-buffer) - (define-key map (kbd "C-c C-o") #'cider-find-and-clear-repl-output) - (define-key map (kbd "C-c C-k") #'cider-load-buffer) - (define-key map (kbd "C-c C-l") #'cider-load-file) - (define-key map (kbd "C-c C-M-l") #'cider-load-all-files) - (define-key map (kbd "C-c C-b") #'cider-interrupt) - (define-key map (kbd "C-c ,") 'cider-test-commands-map) - (define-key map (kbd "C-c C-t") 'cider-test-commands-map) - (define-key map (kbd "C-c M-s") #'cider-selector) - (define-key map (kbd "C-c M-d") #'cider-describe-connection) - (define-key map (kbd "C-c C-=") 'cider-profile-map) - (define-key map (kbd "C-c C-? r") #'cider-xref-fn-refs) - (define-key map (kbd "C-c C-? C-r") #'cider-xref-fn-refs-select) - (define-key map (kbd "C-c C-? d") #'cider-xref-fn-deps) - (define-key map (kbd "C-c C-? C-d") #'cider-xref-fn-deps-select) - (define-key map (kbd "C-c C-q") #'cider-quit) - (define-key map (kbd "C-c M-r") #'cider-restart) - ;; NOTE: all cider-log* vars are autoloaded. Please do not add a require. - (define-key map (kbd "C-c M-l a") #'cider-log-appender) - (define-key map (kbd "C-c M-l c") #'cider-log-consumer) - (define-key map (kbd "C-c M-l e") #'cider-log-event) - (define-key map (kbd "C-c M-l f") #'cider-log-framework) - (define-key map (kbd "C-c M-l i") #'cider-log-info) - (define-key map (kbd "C-c M-l l") #'cider-log) - (dolist (variable '(cider-mode-interactions-menu - cider-mode-eval-menu - cider-mode-menu)) - (easy-menu-do-define (intern (format "%s-open" variable)) - map - (get variable 'variable-documentation) - (cider--menu-add-help-strings (symbol-value variable)))) - map)) - -;; This menu works as an easy entry-point into CIDER. Even if cider.el isn't -;; loaded yet, this will be shown in Clojure buffers next to the "Clojure" -;; menu. -;;;###autoload -(with-eval-after-load 'clojure-mode - (easy-menu-define cider-clojure-mode-menu-open clojure-mode-map - "Menu for Clojure mode. - This is displayed in `clojure-mode' buffers, if `cider-mode' is not active." - `("CIDER" :visible (not cider-mode) - ["Start a Clojure REPL" cider-jack-in-clj - :help "Starts an nREPL server and connects a Clojure REPL to it."] - ["Connect to a Clojure REPL" cider-connect-clj - :help "Connects to a REPL that's already running."] - ["Start a ClojureScript REPL" cider-jack-in-cljs - :help "Starts an nREPL server and connects a ClojureScript REPL to it."] - ["Connect to a ClojureScript REPL" cider-connect-cljs - :help "Connects to a ClojureScript REPL that's already running."] - ["Start a Clojure REPL, and a ClojureScript REPL" cider-jack-in-clj&cljs - :help "Starts an nREPL server, connects a Clojure REPL to it, and then a ClojureScript REPL."] - "--" - ["View user manual" cider-view-manual]))) - -;;; Dynamic indentation -(defcustom cider-dynamic-indentation t - "Whether CIDER should aid Clojure(Script) indentation. -If non-nil, CIDER uses runtime information (such as the \":style/indent\" -metadata) to improve standard `clojure-mode' indentation. -If nil, CIDER won't interfere with `clojure-mode's indentation. - -Toggling this variable only takes effect after a file is closed and -re-visited." - :type 'boolean - :package-version '(cider . "0.11.0") - :group 'cider) - -(defun cider--get-symbol-indent (symbol-name) - "Return the indent metadata for SYMBOL-NAME in the current namespace." - (let* ((ns (let ((clojure-cache-ns t)) ; we force ns caching here for performance reasons - ;; silence bytecode warning of unused lexical var - (ignore clojure-cache-ns) - (cider-current-ns)))) - (if-let* ((meta (cider-resolve-var ns symbol-name)) - (indent (or (nrepl-dict-get meta "style/indent") - (nrepl-dict-get meta "indent")))) - (let ((format (format ":indent metadata on ‘%s’ is unreadable! \nERROR: %%s" - symbol-name))) - (with-demoted-errors format - (cider--deep-vector-to-list (read indent)))) - ;; There's no indent metadata, but there might be a clojure-mode - ;; indent-spec with fully-qualified namespace. - (when (string-match cider-resolve--prefix-regexp symbol-name) - (when-let* ((sym (intern-soft (replace-match (save-match-data - (cider-resolve-alias ns (match-string 1 symbol-name))) - t t symbol-name 1)))) - (get sym 'clojure-indent-function)))))) - - -;;; Dynamic font locking -(defcustom cider-font-lock-dynamically '(macro core deprecated) - "Specifies how much dynamic font-locking CIDER should use. -Dynamic font-locking this refers to applying syntax highlighting to vars -defined in the currently active nREPL connection. This is done in addition -to `clojure-mode's usual (static) font-lock, so even if you set this -variable to nil you'll still see basic syntax highlighting. - -The value is a list of symbols, each one indicates a different type of var -that should be font-locked: - `macro' (default): Any defined macro gets the `font-lock-keyword-face'. - `function': Any defined function gets the `font-lock-function-face'. - `var': Any non-local var gets the `font-lock-variable-name-face'. - `deprecated' (default): Any deprecated var gets the `cider-deprecated-face' - face. - `core' (default): Any symbol from clojure.core/cljs.core. The selected face will depend on type. - Note that while rendering `core', all types of vars (`macro', `function', `var', `deprecated') - will be honored, regardless of the user's customization value. - -The value can also be t, which means to font-lock as much as possible." - :type '(choice (set :tag "Fine-tune font-locking" - (const :tag "Any defined macro" macro) - (const :tag "Any defined function" function) - (const :tag "Any defined var" var) - (const :tag "Any defined deprecated" deprecated) - (const :tag "Any symbol from clojure.core" core)) - (const :tag "Font-lock as much as possible" t)) - :group 'cider - :package-version '(cider . "0.10.0")) - -(defcustom cider-font-lock-reader-conditionals t - "Apply font-locking to unused reader conditional expressions. -The result depends on the buffer CIDER connection type." - :type 'boolean - :group 'cider - :package-version '(cider . "0.15.0")) - -(defface cider-deprecated-face - '((((background light)) :background "light goldenrod") - (((background dark)) :background "#432")) - "Face used on deprecated vars." - :group 'cider) - -(defface cider-instrumented-face - '((((type graphic)) :box (:color "#c00" :line-width -1)) - (t :underline t :background "#800")) - "Face used to mark code being debugged." - :group 'cider-debug - :group 'cider - :package-version '(cider . "0.10.0")) - -(defface cider-traced-face - '((((type graphic)) :box (:color "cyan" :line-width -1)) - (t :underline t :background "#066")) - "Face used to mark code being traced." - :group 'cider - :package-version '(cider . "0.11.0")) - -(defface cider-reader-conditional-face - '((t (:inherit font-lock-comment-face))) - "Face used to mark unused reader conditional expressions." - :group 'cider - :package-version '(cider . "0.15.0")) - -(defconst cider-reader-conditionals-regexp "\\(?:#\\?@?[[:space:]\n]*(\\)" - "Regexp for matching reader conditionals with a non-capturing group. -Starts from the reader macro characters to the opening parentheses.") - -(defvar cider--reader-conditionals-match-data (list nil nil) - "Reusable list for `match-data` in reader conditionals font lock matchers.") - -(defun cider--search-reader-conditionals (limit) - "Matcher for finding reader conditionals. -Search is done with the given LIMIT." - (when (and cider-font-lock-reader-conditionals - (cider-connected-p)) - (when (search-forward-regexp cider-reader-conditionals-regexp limit t) - (let ((start (match-beginning 0)) - (state (syntax-ppss))) - (if (or (nth 3 state) (nth 4 state)) ; inside string or comment? - (cider--search-reader-conditionals limit) - (when (<= (point) limit) - (ignore-errors - (let ((md (match-data nil cider--reader-conditionals-match-data))) - (setf (nth 0 md) start) - (setf (nth 1 md) (point)) - (set-match-data md) - t)))))))) - -(defun cider--anchored-search-suppressed-forms-internal (repl-types limit) - "Helper function for `cider--anchored-search-suppressed-forms`. -REPL-TYPES is a list of strings repl-type strings. LIMIT is the same as -the LIMIT in `cider--anchored-search-suppressed-forms`" - (when (= (length repl-types) 1) - (let ((type (car repl-types)) - (expr (read (current-buffer))) - (start (save-excursion (backward-sexp) (point)))) - (when (<= (point) limit) - (forward-sexp) - (if (not (string-equal (symbol-name expr) (concat ":" type))) - (ignore-errors - (cl-assert (<= (point) limit)) - (let ((md (match-data nil cider--reader-conditionals-match-data))) - (setf (nth 0 md) start) - (setf (nth 1 md) (point)) - (set-match-data md) - t)) - (cider--anchored-search-suppressed-forms-internal repl-types limit)))))) - -(defun cider--anchored-search-suppressed-forms (limit) - "Matcher for finding unused reader conditional expressions. -An unused reader conditional expression is an expression for a platform -that does not match the CIDER connection for the buffer. Search is done -with the given LIMIT." - (let ((repl-types (seq-uniq (seq-map - (lambda (repl) - (symbol-name (cider-repl-type repl))) - (cider-repls)))) - (result 'retry)) - (while (and (eq result 'retry) (<= (point) limit)) - (condition-case condition - (setq result - (cider--anchored-search-suppressed-forms-internal - repl-types limit)) - (invalid-read-syntax - (setq result 'retry)) - (wrong-type-argument - (setq result 'retry)) - (scan-error - (setq result 'retry)) - (end-of-file - (setq result nil)) - (error - (setq result nil) - (message - "Error during fontification while searching for forms: %S" - condition)))) - (if (eq result 'retry) (setq result nil)) - result)) - -(defconst cider--reader-conditionals-font-lock-keywords - '((cider--search-reader-conditionals - (cider--anchored-search-suppressed-forms - (save-excursion - (let* ((state (syntax-ppss)) - (list-pt (nth 1 state))) - (when list-pt - (goto-char list-pt) - (forward-list) - (backward-char) - (point)))) - nil - (0 'cider-reader-conditional-face t)))) - "Font Lock keywords for unused reader conditionals in CIDER mode.") - -(defun cider--unless-local-match (value) - "Return VALUE, unless `match-string' is a local var." - (unless (or (get-text-property (point) 'cider-block-dynamic-font-lock) - (member (match-string 0) - (get-text-property (point) 'cider-locals))) - value)) - -(defun cider--compile-font-lock-keywords (symbols-plist core-plist) - "Return a list of font-lock rules for symbols in SYMBOLS-PLIST, CORE-PLIST." - (let ((cider-font-lock-dynamically (if (eq cider-font-lock-dynamically t) - '(function var macro core deprecated) - cider-font-lock-dynamically)) - deprecated enlightened - macros functions vars instrumented traced) - (cl-labels ((handle-plist - (plist) - ;; Note that (memq 'function cider-font-lock-dynamically) and similar statements are evaluated differently - ;; for `core' - they're always truthy for `core' (see related core-handling code some lines below): - (let ((do-function (memq 'function cider-font-lock-dynamically)) - (do-var (memq 'var cider-font-lock-dynamically)) - (do-macro (memq 'macro cider-font-lock-dynamically)) - (do-deprecated (memq 'deprecated cider-font-lock-dynamically))) - (while plist - (let ((sym (pop plist)) - (meta (pop plist))) - (pcase (nrepl-dict-get meta "cider/instrumented") - (`nil nil) - (`"\"breakpoint-if-interesting\"" - (push sym instrumented)) - (`"\"light-form\"" - (push sym enlightened))) - ;; The ::traced keywords can be inlined by MrAnderson, so - ;; we catch that case too. - ;; FIXME: This matches values too, not just keys. - (when (seq-find (lambda (k) (and (stringp k) - (string-match (rx "clojure.tools.trace/traced" eos) k))) - meta) - (push sym traced)) - (when (and do-deprecated (nrepl-dict-get meta "deprecated")) - (push sym deprecated)) - (let ((is-macro (nrepl-dict-get meta "macro")) - (is-function (or (nrepl-dict-get meta "fn") - (nrepl-dict-get meta "arglists")))) - (cond ((and do-macro is-macro) - (push sym macros)) - ((and do-function is-function) - (push sym functions)) - ((and do-var (not is-function) (not is-macro)) - (push sym vars))))))))) - ;; For core members, we override `cider-font-lock-dynamically', since all core members should get the same treatment: - (when (memq 'core cider-font-lock-dynamically) - (let ((cider-font-lock-dynamically '(function var macro core deprecated))) - (handle-plist core-plist))) - (handle-plist symbols-plist)) - `( - ,@(when macros - `((,(concat (rx (or "(" "#'")) ; Can't take the value of macros. - "\\(" (regexp-opt macros 'symbols) "\\)") - 1 (cider--unless-local-match font-lock-keyword-face)))) - ,@(when functions - `((,(regexp-opt functions 'symbols) 0 - (cider--unless-local-match font-lock-function-name-face)))) - ,@(when vars - `((,(regexp-opt vars 'symbols) 0 - (cider--unless-local-match font-lock-variable-name-face)))) - ,@(when deprecated - `((,(regexp-opt deprecated 'symbols) 0 - (cider--unless-local-match 'cider-deprecated-face) append))) - ,@(when enlightened - `((,(regexp-opt enlightened 'symbols) 0 - (cider--unless-local-match 'cider-enlightened-face) append))) - ,@(when instrumented - `((,(regexp-opt instrumented 'symbols) 0 - (cider--unless-local-match 'cider-instrumented-face) append))) - ,@(when traced - `((,(regexp-opt traced 'symbols) 0 - (cider--unless-local-match 'cider-traced-face) append)))))) - -(defconst cider--static-font-lock-keywords - (eval-when-compile - `((,(regexp-opt '("#break" "#dbg" "#light") 'symbols) 0 font-lock-warning-face))) - "Default expressions to highlight in CIDER mode.") - -(defvar-local cider--dynamic-font-lock-keywords nil) - -(defun cider-refresh-dynamic-font-lock (&optional ns) - "Ensure that the current buffer has up-to-date font-lock rules. -NS defaults to `cider-current-ns', and it can also be a dict describing the -namespace itself." - (interactive) - (when (and cider-font-lock-dynamically - font-lock-mode) - (font-lock-remove-keywords nil cider--dynamic-font-lock-keywords) - (when-let* ((ns (or ns (cider-current-ns))) - (symbols (cider-resolve-ns-symbols ns))) - (setq-local cider--dynamic-font-lock-keywords - (cider--compile-font-lock-keywords - symbols (cider-resolve-ns-symbols (cider-resolve-core-ns)))) - (font-lock-add-keywords nil cider--dynamic-font-lock-keywords 'end)) - (font-lock-flush))) - - -;;; Detecting local variables -(defun cider--read-locals-from-next-sexp () - "Return a list of all locals inside the next logical sexp." - (save-excursion - (ignore-errors - (clojure-forward-logical-sexp 1) - (let ((out nil) - (end (point))) - (forward-sexp -1) - ;; FIXME: This returns locals found inside the :or clause of a - ;; destructuring map. - (while (search-forward-regexp "\\_<[^:&]\\(\\sw\\|\\s_\\)*\\_>" end 'noerror) - (push (match-string-no-properties 0) out)) - out)))) - -(defun cider--read-locals-from-bindings-vector () - "Return a list of all locals inside the next bindings vector." - (save-excursion - (ignore-errors - (cider-start-of-next-sexp) - (when (eq (char-after) ?\[) - (forward-char 1) - (let ((out nil)) - (setq out (append (cider--read-locals-from-next-sexp) out)) - (while (ignore-errors (clojure-forward-logical-sexp 3) - (unless (eobp) - (forward-sexp -1) - t)) - (setq out (append (cider--read-locals-from-next-sexp) out))) - out))))) - -(defun cider--read-locals-from-arglist () - "Return a list of all locals in current form's arglist(s)." - (let ((out nil)) - (save-excursion - (ignore-errors - (cider-start-of-next-sexp) - ;; Named fn - (when (looking-at-p "\\s_\\|\\sw") - (cider-start-of-next-sexp 1)) - ;; Docstring - (when (eq (char-after) ?\") - (cider-start-of-next-sexp 1)) - ;; Attribute map - (when (eq (char-after) ?{) - (cider-start-of-next-sexp 1)) - ;; The arglist - (pcase (char-after) - (?\[ (setq out (cider--read-locals-from-next-sexp))) - ;; FIXME: This returns false positives. It takes all arglists of a - ;; function and returns all args it finds. The logic should be changed - ;; so that each arglist applies to its own scope. - (?\( (ignore-errors - (while (eq (char-after) ?\() - (save-excursion - (forward-char 1) - (setq out (append (cider--read-locals-from-next-sexp) out))) - (cider-start-of-next-sexp 1))))))) - out)) - -(defun cider--parse-and-apply-locals (end &optional outer-locals) - "Figure out local variables between point and END. -A list of these variables is set as the `cider-locals' text property over -the code where they are in scope. -Optional argument OUTER-LOCALS is used to specify local variables defined -before point." - (while (search-forward-regexp "(\\(ns\\_>\\|def\\|fn\\|for\\b\\|loop\\b\\|with-\\|do[a-z]+\\|\\([a-z]+-\\)?let\\b\\)" - end 'noerror) - (goto-char (match-beginning 0)) - (let ((sym (match-string 1)) - (sexp-end (save-excursion - (or (ignore-errors (forward-sexp 1) - (point)) - end)))) - ;; #1324: Don't do dynamic font-lock in `ns' forms, they are special - ;; macros where nothing is evaluated, so we'd get a lot of false - ;; positives. - (if (equal sym "ns") - (add-text-properties (point) sexp-end '(cider-block-dynamic-font-lock t)) - (forward-char 1) - (forward-sexp 1) - (let ((locals (append outer-locals - (pcase sym - ((or "fn" "def" "") (cider--read-locals-from-arglist)) - (_ (cider--read-locals-from-bindings-vector)))))) - (add-text-properties (point) sexp-end (list 'cider-locals locals)) - (clojure-forward-logical-sexp 1) - (cider--parse-and-apply-locals sexp-end locals))) - (goto-char sexp-end)))) - -(defun cider--update-locals-for-region (beg end) - "Update the `cider-locals' text property for region from BEG to END." - (save-excursion - (goto-char beg) - ;; If the inside of a `ns' form changed, reparse it from the start. - (when (and (not (bobp)) - (get-text-property (1- (point)) 'cider-block-dynamic-font-lock)) - (ignore-errors (beginning-of-defun-raw))) - (save-excursion - ;; Move up until we reach a sexp that encloses the entire region (or - ;; a top-level sexp), and set that as the new BEG. - (goto-char end) - (while (and (or (> (point) beg) - (not (eq (char-after) ?\())) - (condition-case nil - (progn (backward-up-list) t) - (scan-error nil)))) - (setq beg (min beg (point))) - ;; If there are locals above the current sexp, reapply them to the - ;; current sexp. - (let ((locals-above (when (> beg (point-min)) - (get-text-property (1- beg) 'cider-locals)))) - (condition-case nil - (clojure-forward-logical-sexp 1) - (error (goto-char end))) - (add-text-properties beg (point) `(cider-locals ,locals-above)) - ;; Extend the region being font-locked to include whole sexps. - (setq end (max end (point))) - (goto-char beg) - (ignore-errors - (cider--parse-and-apply-locals end locals-above)))))) - -(defun cider--docview-as-string (sym info) - "Return a string of what would be displayed by `cider-docview-render'. -SYM and INFO is passed to `cider-docview-render'" - (with-temp-buffer - (cider-docview-render (current-buffer) sym info :compact :for-tooltip) ;; :compact because we don't want huge tooltips - especially for Java - (goto-char (point-max)) - (forward-line -1) - (replace-regexp-in-string - "[`']" "\\\\=\\&" - (buffer-substring-no-properties (point-min) (1- (point)))))) - -(defcustom cider-use-tooltips t - "If non-nil, CIDER displays mouse-over tooltips. -It does this as well as the `help-echo' mechanism." - :group 'cider - :type 'boolean - :package-version '(cider "0.12.0")) - -(defvar cider--debug-mode-response) -(defvar cider--debug-mode) - -(defun cider--help-echo (_ obj pos) - "Return the help-echo string for OBJ at POS. -See \(info \"(elisp) Special Properties\")" - (while-no-input - (when (and (bufferp obj) - (cider-connected-p) - cider-use-tooltips - (not (eq help-at-pt-display-when-idle t))) - (with-current-buffer obj - (ignore-errors - (save-excursion - (goto-char pos) - (when-let* ((sym (cider-symbol-at-point))) - (if (member sym (get-text-property (point) 'cider-locals)) - (concat (format "`%s' is a local" sym) - (when cider--debug-mode - (let* ((locals (nrepl-dict-get cider--debug-mode-response "locals")) - (local-val (cadr (assoc sym locals)))) - (format " with value:\n%s" local-val)))) - (let* ((info (cider-sync-request:info sym nil nil (cider-completion-get-context t))) - (candidates (nrepl-dict-get info "candidates"))) - (if candidates - (concat "There were ambiguities resolving this symbol:\n\n" - (mapconcat (lambda (x) (cider--docview-as-string sym x)) - candidates - (concat "\n\n" (make-string 60 ?-) "\n\n"))) - (cider--docview-as-string sym info))))))))))) - -(defun cider--wrap-fontify-locals (func) - "Return a function that will call FUNC after parsing local variables. -The local variables are stored in a list under the `cider-locals' text -property." - (lambda (beg end &rest rest) - (with-silent-modifications - (remove-text-properties beg end '(cider-locals nil cider-block-dynamic-font-lock nil)) - (when cider-use-tooltips - (add-text-properties beg end '(help-echo cider--help-echo))) - (when cider-font-lock-dynamically - (cider--update-locals-for-region beg end))) - (apply func beg end rest))) - - -;;; Minor-mode definition -(defvar x-gtk-use-system-tooltips) - -;;;###autoload -(define-minor-mode cider-mode - "Minor mode for REPL interaction from a Clojure buffer. - -\\{cider-mode-map}" - :init-value nil - :lighter cider-mode-line - :keymap cider-mode-map - (if cider-mode - (progn - (setq-local sesman-system 'CIDER) - (cider-eldoc-setup) - (add-hook 'completion-at-point-functions #'cider-complete-at-point nil t) - (font-lock-add-keywords nil cider--static-font-lock-keywords) - (cider-refresh-dynamic-font-lock) - (font-lock-add-keywords nil cider--reader-conditionals-font-lock-keywords) - ;; `font-lock-mode' might get enabled after `cider-mode'. - (add-hook 'font-lock-mode-hook #'cider-refresh-dynamic-font-lock nil 'local) - (setq-local font-lock-fontify-region-function - (cider--wrap-fontify-locals font-lock-fontify-region-function)) - ;; GTK tooltips look bad, and we have no control over the face. - (setq-local x-gtk-use-system-tooltips nil) - ;; `tooltip' has variable-width by default, which looks terrible. - (set-face-attribute 'tooltip nil :inherit 'unspecified) - (when cider-dynamic-indentation - (setq-local clojure-get-indent-function #'cider--get-symbol-indent)) - (setq-local clojure-expected-ns-function #'cider-expected-ns) - (when cider-use-xref - (add-hook 'xref-backend-functions #'cider--xref-backend cider-xref-fn-depth 'local)) - (setq next-error-function #'cider-jump-to-compilation-error)) - ;; Mode cleanup - (mapc #'kill-local-variable '(next-error-function - x-gtk-use-system-tooltips - font-lock-fontify-region-function - clojure-get-indent-function)) - (remove-hook 'completion-at-point-functions #'cider-complete-at-point t) - (when cider-use-xref - (remove-hook 'xref-backend-functions #'cider--xref-backend 'local)) - (remove-hook 'font-lock-mode-hook #'cider-refresh-dynamic-font-lock 'local) - (font-lock-add-keywords nil cider--reader-conditionals-font-lock-keywords) - (font-lock-remove-keywords nil cider--dynamic-font-lock-keywords) - (font-lock-remove-keywords nil cider--static-font-lock-keywords) - (font-lock-flush) - (remove-hook 'completion-at-point-functions #'cider-complete-at-point t))) - -(defun cider-set-buffer-ns (ns) - "Set this buffer's namespace to NS and refresh font-locking." - (setq-local cider-buffer-ns ns) - (when (or cider-mode (derived-mode-p 'cider-repl-mode)) - (cider-refresh-dynamic-font-lock ns))) - -(provide 'cider-mode) - -;;; cider-mode.el ends here diff --git a/elpa/cider-1.12.0/cider-ns.el b/elpa/cider-1.12.0/cider-ns.el @@ -1,273 +0,0 @@ -;;; cider-ns.el --- Namespace manipulation functionality -*- lexical-binding: t -*- - -;; Copyright © 2013-2023 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; -;; Author: Bozhidar Batsov <bozhidar@batsov.dev> -;; Artur Malabarba <bruce.connor.am@gmail.com> - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Smart code refresh functionality based on ideas from: -;; http://thinkrelevance.com/blog/2013/06/04/clojure-workflow-reloaded -;; -;; Note that refresh with clojure.tools.namespace.repl is a smarter way to -;; reload code: the traditional way to reload Clojure code without restarting -;; the JVM is (require ... :reload) or an editor/IDE feature that does the same -;; thing. -;; -;; This has several problems: -;; -;; If you modify two namespaces which depend on each other, you must remember to -;; reload them in the correct order to avoid compilation errors. -;; -;; If you remove definitions from a source file and then reload it, those -;; definitions are still available in memory. If other code depends on those -;; definitions, it will continue to work but will break the next time you -;; restart the JVM. -;; -;; If the reloaded namespace contains defmulti, you must also reload all of the -;; associated defmethod expressions. -;; -;; If the reloaded namespace contains defprotocol, you must also reload any -;; records or types implementing that protocol and replace any existing -;; instances of those records/types with new instances. -;; -;; If the reloaded namespace contains macros, you must also reload any -;; namespaces which use those macros. -;; -;; If the running program contains functions which close over values in the -;; reloaded namespace, those closed-over values are not updated (This is common -;; in web applications which construct the "handler stack" as a composition of -;; functions.) - -;;; Code: - -(require 'map) -(require 'seq) -(require 'subr-x) - -(require 'cider-client) -(require 'cider-eval) -(require 'cider-popup) -(require 'cider-stacktrace) -(require 'cider-util) - -(defcustom cider-ns-save-files-on-refresh 'prompt - "Controls whether to prompt to save files before refreshing. -If nil, files are not saved. -If 'prompt, the user is prompted to save files if they have been modified. -If t, save the files without confirmation." - :type '(choice (const prompt :tag "Prompt to save files if they have been modified") - (const nil :tag "Don't save the files") - (const t :tag "Save the files without confirmation")) - :group 'cider - :package-version '(cider . "0.15.0")) - -(defcustom cider-ns-save-files-on-refresh-modes '(clojure-mode) - "Controls which files might be saved before refreshing. -If a list of modes, any buffers visiting files on the classpath whose major -mode is derived from any of the modes might be saved. -If t, all buffers visiting files on the classpath might be saved." - :type '(choice listp - (const t)) - :group 'cider - :package-version '(cider . "0.21.0")) - -(defconst cider-ns-refresh-log-buffer "*cider-ns-refresh-log*") - -(defcustom cider-ns-refresh-show-log-buffer nil - "Controls when to display the refresh log buffer. -If non-nil, the log buffer will be displayed every time `cider-ns-refresh' is -called. If nil, the log buffer will still be written to, but will never be -displayed automatically. Instead, the most relevant information will be -displayed in the echo area." - :type '(choice (const :tag "always" t) - (const :tag "never" nil)) - :group 'cider - :package-version '(cider . "0.10.0")) - -(defcustom cider-ns-refresh-before-fn nil - "Clojure function for `cider-ns-refresh' to call before reloading. -If nil, nothing will be invoked before reloading. Must be a -namespace-qualified function of zero arity. Any thrown exception will -prevent reloading from occurring." - :type 'string - :group 'cider - :package-version '(cider . "0.10.0")) - -(defcustom cider-ns-refresh-after-fn nil - "Clojure function for `cider-ns-refresh' to call after reloading. -If nil, nothing will be invoked after reloading. Must be a -namespace-qualified function of zero arity." - :type 'string - :group 'cider - :package-version '(cider . "0.10.0")) - -(defun cider-ns-refresh--handle-response (response log-buffer) - "Refresh LOG-BUFFER with RESPONSE." - (nrepl-dbind-response response (out err reloading status error error-ns after before) - (cl-flet* ((log (message &optional face) - (cider-emit-into-popup-buffer log-buffer message face t)) - - (log-echo (message &optional face) - (log message face) - (unless cider-ns-refresh-show-log-buffer - (let ((message-truncate-lines t)) - (message "cider-ns-refresh: %s" message))))) - (cond - (out - (log out)) - - (err - (log err 'font-lock-warning-face)) - - ((member "invoking-before" status) - (log-echo (format "Calling %s\n" before) 'font-lock-string-face)) - - ((member "invoked-before" status) - (log-echo (format "Successfully called %s\n" before) 'font-lock-string-face)) - - ((member "invoked-not-resolved" status) - (log-echo "Could not resolve refresh function\n" 'font-lock-string-face)) - - (reloading - (log-echo (format "Reloading %s\n" reloading) 'font-lock-string-face)) - - ((member "reloading" (nrepl-dict-keys response)) - (log-echo "Nothing to reload\n" 'font-lock-string-face)) - - ((member "ok" status) - (log-echo "Reloading successful\n" 'font-lock-string-face)) - - (error-ns - (log-echo (format "Error reloading %s\n" error-ns) 'font-lock-warning-face)) - - ((member "invoking-after" status) - (log-echo (format "Calling %s\n" after) 'font-lock-string-face)) - - ((member "invoked-after" status) - (log-echo (format "Successfully called %s\n" after) 'font-lock-string-face)))) - - (with-selected-window (or (get-buffer-window cider-ns-refresh-log-buffer) - (selected-window)) - (with-current-buffer cider-ns-refresh-log-buffer - (goto-char (point-max)))) - - (when (member "error" status) - (cider--render-stacktrace-causes error)))) - -(defun cider-ns-refresh--save-modified-buffers () - "Ensure any relevant modified buffers are saved before refreshing. -Its behavior is controlled by `cider-ns-save-files-on-refresh' and -`cider-ns-save-files-on-refresh-modes'." - (when cider-ns-save-files-on-refresh - (let ((dirs (seq-filter #'file-directory-p - (cider-classpath-entries)))) - (save-some-buffers - (not (eq cider-ns-save-files-on-refresh 'prompt)) - (lambda () - (and (seq-some #'derived-mode-p cider-ns-save-files-on-refresh-modes) - (seq-some (lambda (dir) - (file-in-directory-p buffer-file-name dir)) - dirs))))))) - -;;;###autoload -(defun cider-ns-reload (&optional prompt) - "Send a (require 'ns :reload) to the REPL. - -With an argument PROMPT, it prompts for a namespace name. This is the -Clojure out of the box reloading experience and does not rely on -org.clojure/tools.namespace. See Commentary of this file for a longer list -of differences. From the Clojure doc: \":reload forces loading of all the -identified libs even if they are already loaded\"." - (interactive "P") - (when-let ((ns (if prompt - (string-remove-prefix "'" (read-from-minibuffer "Namespace: " (cider-get-ns-name))) - (cider-get-ns-name)))) - (cider-interactive-eval (format "(require '%s :reload)" ns)))) - -;;;###autoload -(defun cider-ns-reload-all (&optional prompt) - "Send a (require 'ns :reload-all) to the REPL. - -With an argument PROMPT, it prompts for a namespace name. This is the -Clojure out of the box reloading experience and does not rely on -org.clojure/tools.namespace. See Commentary of this file for a longer list -of differences. From the Clojure doc: \":reload-all implies :reload and -also forces loading of all libs that the identified libs directly or -indirectly load via require\"." - (interactive "P") - (when-let ((ns (if prompt - (string-remove-prefix "'" (read-from-minibuffer "Namespace: " (cider-get-ns-name))) - (cider-get-ns-name)))) - (cider-interactive-eval (format "(require '%s :reload-all)" ns)))) - -;;;###autoload -(defun cider-ns-refresh (&optional mode) - "Reload modified and unloaded namespaces on the classpath. - -With a single prefix argument, or if MODE is `refresh-all', reload all -namespaces on the classpath unconditionally. - -With a double prefix argument, or if MODE is `clear', clear the state of -the namespace tracker before reloading. This is useful for recovering from -some classes of error (for example, those caused by circular dependencies) -that a normal reload would not otherwise recover from. The trade-off of -clearing is that stale code from any deleted files may not be completely -unloaded. - -With a negative prefix argument, or if MODE is `inhibit-fns', prevent any -refresh functions (defined in `cider-ns-refresh-before-fn' and -`cider-ns-refresh-after-fn') from being invoked." - (interactive "p") - (cider-ensure-connected) - (cider-ensure-op-supported "refresh") - (cider-ns-refresh--save-modified-buffers) - (let ((clear? (member mode '(clear 16))) - (refresh-all? (member mode '(refresh-all 4))) - (inhibit-refresh-fns (member mode '(inhibit-fns -1)))) - (cider-map-repls :clj - (lambda (conn) - ;; Inside the lambda, so the buffer is not created if we error out. - (let ((log-buffer (or (get-buffer cider-ns-refresh-log-buffer) - (cider-make-popup-buffer cider-ns-refresh-log-buffer)))) - (when cider-ns-refresh-show-log-buffer - (cider-popup-buffer-display log-buffer)) - (when inhibit-refresh-fns - (cider-emit-into-popup-buffer log-buffer - "inhibiting refresh functions\n" - nil - t)) - (when clear? - (cider-nrepl-send-sync-request '("op" "refresh-clear") conn)) - (cider-nrepl-send-request - (thread-last - (map-merge 'list - `(("op" ,(if refresh-all? "refresh-all" "refresh"))) - (cider--nrepl-print-request-map fill-column) - (when (and (not inhibit-refresh-fns) cider-ns-refresh-before-fn) - `(("before" ,cider-ns-refresh-before-fn))) - (when (and (not inhibit-refresh-fns) cider-ns-refresh-after-fn) - `(("after" ,cider-ns-refresh-after-fn)))) - (seq-mapcat #'identity)) - (lambda (response) - (cider-ns-refresh--handle-response response log-buffer)) - conn)))))) - -(provide 'cider-ns) -;;; cider-ns.el ends here diff --git a/elpa/cider-1.12.0/cider-overlays.el b/elpa/cider-1.12.0/cider-overlays.el @@ -1,362 +0,0 @@ -;;; cider-overlays.el --- Managing CIDER overlays -*- lexical-binding: t; -*- - -;; Copyright © 2015-2023 Bozhidar Batsov, Artur Malabarba and CIDER contributors - -;; Author: Artur Malabarba <bruce.connor.am@gmail.com> - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; Use `cider--make-overlay' to place a generic overlay at point. Or use -;; `cider--make-result-overlay' to place an interactive eval result overlay at -;; the end of a specified line. - -;;; Code: - -(require 'cider-common) -(require 'subr-x) -(require 'cl-lib) - - -;;; Customization -(defface cider-result-overlay-face - '((((class color) (background light)) - :background "grey90" :box (:line-width -1 :color "yellow")) - (((class color) (background dark)) - :background "grey10" :box (:line-width -1 :color "black"))) - "Face used to display evaluation results at the end of line. -If `cider-overlays-use-font-lock' is non-nil, this face is -applied with lower priority than the syntax highlighting." - :group 'cider - :package-version '(cider "0.9.1")) - -(defface cider-error-overlay-face - '((((class color) (background light)) - :background "orange red" - :extend t) - (((class color) (background dark)) - :background "firebrick" - :extend t)) - "Like `cider-result-overlay-face', but for evaluation errors." - :group 'cider - :package-version '(cider "0.25.0")) - -(defcustom cider-result-use-clojure-font-lock t - "If non-nil, interactive eval results are font-locked as Clojure code." - :group 'cider - :type 'boolean - :package-version '(cider . "0.10.0")) - -(defcustom cider-overlays-use-font-lock t - "If non-nil, results overlays are font-locked as Clojure code. -If nil, apply `cider-result-overlay-face' to the entire overlay instead of -font-locking it." - :group 'cider - :type 'boolean - :package-version '(cider . "0.10.0")) - -(defcustom cider-use-overlays 'both - "Whether to display evaluation results with overlays. -If t, use overlays determined by `cider-result-overlay-position'. -If `errors-only', use overlays determined by `cider-result-overlay-position', -but only for error messages - other messages will be displayed on the echo area. -If nil, display on the echo area. -If `both', display on both places. - -Only applies to evaluation commands. To configure the debugger overlays, -see `cider-debug-use-overlays'." - :type '(choice (const :tag "Display using overlays" t) - (const :tag "Display in echo area" nil) - (const :tag "Both" both)) - :group 'cider - :package-version '(cider . "0.10.0")) - -(defcustom cider-result-overlay-position 'at-eol - "Where to display result overlays for inline evaluation and the debugger. -If 'at-eol, display at the end of the line. -If 'at-point, display at the end of the respective sexp." - :group 'cider - :type ''(choice (const :tag "End of line" at-eol) - (const :tag "End of sexp" at-point)) - :package-version '(cider . "0.23.0")) - -(defcustom cider-eval-result-prefix "=> " - "The prefix displayed in the minibuffer before a result value." - :type 'string - :group 'cider - :package-version '(cider . "0.5.0")) - -(defcustom cider-eval-result-duration 'command - "Duration, in seconds, of CIDER's eval-result overlays. -If nil, overlays last indefinitely. -If the symbol `command', they're erased after the next command. -If the symbol `change', they last until the next change to the buffer. -Also see `cider-use-overlays'." - :type '(choice (integer :tag "Duration in seconds") - (const :tag "Until next command" command) - (const :tag "Until next buffer change" change) - (const :tag "Last indefinitely" nil)) - :group 'cider - :package-version '(cider . "0.10.0")) - - -;;; Overlay logic -(defun cider--delete-overlay (ov &rest _) - "Safely delete overlay OV. -Never throws errors, and can be used in an overlay's modification-hooks." - (ignore-errors (delete-overlay ov))) - -(defun cider--make-overlay (l r type &rest props) - "Place an overlay between L and R and return it. -TYPE is a symbol put on the overlay's category property. It is used to -easily remove all overlays from a region with: - (remove-overlays start end 'category TYPE) -PROPS is a plist of properties and values to add to the overlay." - (let ((o (make-overlay l (or r l) (current-buffer)))) - (overlay-put o 'category type) - (overlay-put o 'cider-temporary t) - (while props (overlay-put o (pop props) (pop props))) - (push #'cider--delete-overlay (overlay-get o 'modification-hooks)) - o)) - -(defun cider--remove-result-overlay (&rest _) - "Remove result overlay from current buffer. -This function also removes itself from `post-command-hook' and -`after-change-functions'." - (let ((hook (pcase cider-eval-result-duration - (`command 'post-command-hook) - (`change 'after-change-functions)))) - (remove-hook hook #'cider--remove-result-overlay 'local)) - (remove-overlays nil nil 'category 'result)) - -(defun cider--remove-result-overlay-after-command () - "Add `cider--remove-result-overlay' locally to `post-command-hook'. -This function also removes itself from `post-command-hook'." - (remove-hook 'post-command-hook #'cider--remove-result-overlay-after-command 'local) - (add-hook 'post-command-hook #'cider--remove-result-overlay nil 'local)) - -(defface cider-fringe-good-face - '((((class color) (background light)) :foreground "lightgreen") - (((class color) (background dark)) :foreground "darkgreen")) - "Face used on the fringe indicator for successful evaluation." - :group 'cider) - -(defconst cider--fringe-overlay-good - (propertize " " 'display '(left-fringe empty-line cider-fringe-good-face)) - "The before-string property that adds a green indicator on the fringe.") - -(defcustom cider-use-fringe-indicators t - "Whether to display evaluation indicators on the left fringe." - :safe #'booleanp - :group 'cider - :type 'boolean - :package-version '(cider . "0.13.0")) - -(defun cider--make-fringe-overlay (&optional end) - "Place an eval indicator at the fringe before a sexp. -END is the position where the sexp ends, and defaults to point." - (when cider-use-fringe-indicators - (with-current-buffer (if (markerp end) - (marker-buffer end) - (current-buffer)) - (save-excursion - (if end - (goto-char end) - (setq end (point))) - (clojure-forward-logical-sexp -1) - ;; Create the green-circle overlay. - (cider--make-overlay (point) end 'cider-fringe-indicator - 'before-string cider--fringe-overlay-good))))) - -(cl-defun cider--make-result-overlay (value &rest props &key where duration (type 'result) - (format (concat " " cider-eval-result-prefix "%s ")) - (prepend-face 'cider-result-overlay-face) - &allow-other-keys) - "Place an overlay displaying VALUE at the position determined by WHERE. -VALUE is used as the overlay's after-string property, meaning it is -displayed at the end of the overlay. -Return nil if the overlay was not placed or if it might not be visible, and -return the overlay otherwise. - -Return the overlay if it was placed successfully, and nil if it failed. - -This function takes some optional keyword arguments: - - If WHERE is a number or a marker, apply the overlay as determined by - `cider-result-overlay-position'. If it is a cons cell, the car and cdr - determine the start and end of the overlay. - DURATION takes the same possible values as the - `cider-eval-result-duration' variable. - TYPE is passed to `cider--make-overlay' (defaults to `result'). - FORMAT is a string passed to `format'. It should have - exactly one %s construct (for VALUE). - -All arguments beyond these (PROPS) are properties to be used on the -overlay." - (declare (indent 1)) - (while (keywordp (car props)) - (setq props (cdr (cdr props)))) - ;; If the marker points to a dead buffer, don't do anything. - (let ((buffer (cond - ((markerp where) (marker-buffer where)) - ((markerp (car-safe where)) (marker-buffer (car where))) - (t (current-buffer))))) - (with-current-buffer buffer - (save-excursion - (when (number-or-marker-p where) - (goto-char where)) - ;; Make sure the overlay is actually at the end of the sexp. - (skip-chars-backward "\r\n[:blank:]") - (let* ((beg (if (consp where) - (car where) - (save-excursion - (clojure-backward-logical-sexp 1) - (point)))) - (end (if (consp where) - (cdr where) - (pcase cider-result-overlay-position - ('at-eol (line-end-position)) - ('at-point (point))))) - ;; Specify `default' face, otherwise unformatted text will - ;; inherit the face of the following text. - (display-string (format (propertize format 'face 'default) value)) - (o nil)) - ;; Remove any overlay at the position we're creating a new one, if it - ;; exists. - (remove-overlays beg end 'category type) - (funcall (if cider-overlays-use-font-lock - #'font-lock-prepend-text-property - #'put-text-property) - 0 (length display-string) - 'face prepend-face - display-string) - ;; If the display spans multiple lines or is very long, display it at - ;; the beginning of the next line. - (when (or (string-match "\n." display-string) - (> (string-width display-string) - (- (window-width) (current-column)))) - (setq display-string (concat " \n" display-string))) - ;; Put the cursor property only once we're done manipulating the - ;; string, since we want it to be at the first char. - (put-text-property 0 1 'cursor 0 display-string) - (when (> (string-width display-string) (* 3 (window-width))) - (setq display-string - (concat (substring display-string 0 (* 3 (window-width))) - (substitute-command-keys - "...\nResult truncated. Type `\\[cider-inspect-last-result]' to inspect it.")))) - ;; Create the result overlay. - (setq o (apply #'cider--make-overlay - beg end type - 'after-string display-string - props)) - (pcase duration - ((pred numberp) (run-at-time duration nil #'cider--delete-overlay o)) - (`command - ;; Since the previous overlay was already removed above, we should - ;; remove the hook to remove all overlays after this function - ;; ends. Otherwise, we would inadvertently remove the newly created - ;; overlay too. - (remove-hook 'post-command-hook 'cider--remove-result-overlay 'local) - ;; If inside a command-loop, tell `cider--remove-result-overlay' - ;; to only remove after the *next* command. - (if this-command - (add-hook 'post-command-hook - #'cider--remove-result-overlay-after-command - nil 'local) - (cider--remove-result-overlay-after-command))) - (`change - (add-hook 'after-change-functions - #'cider--remove-result-overlay - nil 'local))) - (when-let* ((win (get-buffer-window buffer))) - ;; Left edge is visible. - (when (and (<= (window-start win) (point) (window-end win)) - ;; Right edge is visible. This is a little conservative - ;; if the overlay contains line breaks. - (or (< (+ (current-column) (string-width value)) - (window-width win)) - (not truncate-lines))) - o))))))) - - -;;; Displaying eval result -(defun cider--display-interactive-eval-result (value value-type &optional point overlay-face) - "Display the result VALUE of an interactive eval operation. -VALUE is syntax-highlighted and displayed in the echo area. -VALUE-TYPE is one of: `value', `error'. -OVERLAY-FACE is the face applied to the overlay, which defaults to -`cider-result-overlay-face' if nil. -If POINT and `cider-use-overlays' are non-nil, it is also displayed in an -overlay at the end of the line containing POINT. -Note that, while POINT can be a number, it's preferable to be a marker, as -that will better handle some corner cases where the original buffer is not -focused." - (cl-assert (symbolp value-type)) ;; We assert because for avoiding confusion with the optional args. - (let* ((font-value (if cider-result-use-clojure-font-lock - (cider-font-lock-as-clojure value) - value)) - (font-value (string-trim-right font-value)) - (used-overlay (when (and point - cider-use-overlays - (if (equal 'error value-type) - t - (not (equal 'errors-only cider-use-overlays)))) - (cider--make-result-overlay font-value - :where point - :duration cider-eval-result-duration - :prepend-face (or overlay-face 'cider-result-overlay-face))))) - (message - "%s" - (propertize (format "%s%s" cider-eval-result-prefix font-value) - ;; The following hides the message from the echo-area, but - ;; displays it in the Messages buffer. We only hide the message - ;; if the user wants to AND if the overlay succeeded. - 'invisible (and used-overlay - (not (eq cider-use-overlays 'both))))))) - - -;;; Fragile buttons -(defface cider-fragile-button-face - '((((type graphic)) - :box (:line-width 3 :style released-button) - :inherit font-lock-warning-face) - (t :inverse-video t)) - "Face for buttons that vanish when clicked." - :package-version '(cider . "0.12.0") - :group 'cider) - -(define-button-type 'cider-fragile - 'action #'cider--overlay-destroy - 'follow-link t - 'face nil - 'modification-hooks '(cider--overlay-destroy) - 'help-echo "RET: delete this.") - -(defun cider--overlay-destroy (ov &rest r) - "Delete overlay OV and its underlying text. -If any other arguments are given (collected in R), only actually do anything -if the first one is non-nil. This is so it works in `modification-hooks'." - (unless (and r (not (car r))) - (let ((inhibit-modification-hooks t) - (beg (copy-marker (overlay-start ov))) - (end (copy-marker (overlay-end ov)))) - (delete-overlay ov) - (delete-region beg end) - (goto-char beg) - (when (= (char-after) (char-before) ?\n) - (delete-char 1))))) - -(provide 'cider-overlays) -;;; cider-overlays.el ends here diff --git a/elpa/cider-1.12.0/cider-pkg.el b/elpa/cider-1.12.0/cider-pkg.el @@ -1,2 +0,0 @@ -;; Generated package description from cider.el -*- no-byte-compile: t -*- -(define-package "cider" "1.12.0" "Clojure Interactive Development Environment that Rocks" '((emacs "26") (clojure-mode "5.18.1") (parseedn "1.2.0") (queue "0.2") (spinner "1.7") (seq "2.22") (sesman "0.3.2") (transient "0.4.1")) :commit "2bafc1ec67308de500ce7ce8ac8f79eae449dee8" :authors '(("Tim King" . "kingtim@gmail.com") ("Phil Hagelberg" . "technomancy@gmail.com") ("Bozhidar Batsov" . "bozhidar@batsov.dev") ("Artur Malabarba" . "bruce.connor.am@gmail.com") ("Hugo Duncan" . "hugo@hugoduncan.org") ("Steve Purcell" . "steve@sanityinc.com")) :maintainer '("Bozhidar Batsov" . "bozhidar@batsov.dev") :keywords '("languages" "clojure" "cider") :url "https://www.github.com/clojure-emacs/cider") diff --git a/elpa/cider-1.12.0/cider-popup.el b/elpa/cider-1.12.0/cider-popup.el @@ -1,157 +0,0 @@ -;;; cider-popup.el --- Creating and quitting popup buffers -*- lexical-binding: t; -*- - -;; Copyright © 2015-2023 Bozhidar Batsov, Artur Malabarba and CIDER contributors - -;; Author: Artur Malabarba <bruce.connor.am@gmail.com> - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; Common functionality for dealing with popup buffers. - -;;; Code: - -(require 'subr-x) - -(define-minor-mode cider-popup-buffer-mode - "Mode for CIDER popup buffers." - :lighter (" cider-tmp") - :keymap '(("q" . cider-popup-buffer-quit-function))) - -(defvar-local cider-popup-buffer-quit-function #'cider-popup-buffer-quit - "The function that is used to quit a temporary popup buffer.") - -(defun cider-popup-buffer-quit-function (&optional kill-buffer-p) - "Wrapper to invoke the function `cider-popup-buffer-quit-function'. -KILL-BUFFER-P is passed along." - (interactive) - (funcall cider-popup-buffer-quit-function kill-buffer-p)) - -(defun cider-popup-buffer (name &optional select mode ancillary) - "Create new popup buffer called NAME. -If SELECT is non-nil, select the newly created window. -If major MODE is non-nil, enable it for the popup buffer. -If ANCILLARY is non-nil, the buffer is added to `cider-ancillary-buffers' -and automatically removed when killed." - (thread-first (cider-make-popup-buffer name mode ancillary) - (buffer-name) - (cider-popup-buffer-display select))) - -(defun cider-popup-buffer-display (buffer-name &optional select) - "Display the buffer identified by BUFFER-NAME. -If SELECT is non-nil, select the buffer. - -You can customize how the window will be chosen/created -by adding BUFFER-NAME to the `special-display-buffer-names' list." - (let ((buffer-name (if (bufferp buffer-name) ;; ensure buffer-name is a string - (buffer-name buffer-name) - buffer-name))) - ;; if `buffer-name' belongs to `special-display-buffer-names', - ;; delegate to that mechanism the displaying of the buffer, - ;; otherwise the displaying would happen twice (ance through `special-display-buffer-names', - ;; another time through `cider-popup-buffer-display'): - (if (and (boundp 'special-display-buffer-names) - (seq-find (lambda (entry) - (equal (car entry) buffer-name)) - special-display-buffer-names)) - (progn - (display-buffer buffer-name) - (when select - (when-let ((window (get-buffer-window buffer-name))) - (select-window window)))) - (let ((window (get-buffer-window buffer-name 'visible))) - (when window - (with-current-buffer buffer-name - (set-window-point window (point)))) - ;; If the buffer we are popping up is already displayed in the selected - ;; window, the below `inhibit-same-window' logic will cause it to be - ;; displayed twice - so we early out in this case. Note that we must check - ;; `selected-window', as async request handlers are executed in the context - ;; of the current connection buffer (i.e. `current-buffer' is dynamically - ;; bound to that). - (unless (eq window (selected-window)) - ;; Non nil `inhibit-same-window' ensures that current window is not covered - ;; Non nil `inhibit-switch-frame' ensures that the other frame is not selected - ;; if that's where the buffer is being shown. - (funcall (if select #'pop-to-buffer #'display-buffer) - buffer-name `(nil . ((inhibit-same-window . - ;; A non-nil value prevents the same window from being used for display: - ,pop-up-windows) - (reusable-frames . - ;; choose any visible frame - visible))))))) - (get-buffer buffer-name))) - -(defun cider-popup-buffer-quit (&optional kill) - "Quit the current (temp) window. -Bury its buffer using `quit-restore-window'. -If prefix argument KILL is non-nil, kill the buffer instead of burying it." - (interactive) - (quit-restore-window (selected-window) (if kill 'kill 'append))) - -(defvar-local cider-popup-output-marker nil) - -(defvar cider-ancillary-buffers nil - "A list ancillary buffers created by the various CIDER commands. -We track them mostly to be able to clean them up on quit.") - -(defun cider-make-popup-buffer (name &optional mode ancillary) - "Create a temporary buffer called NAME using major MODE (if specified). -If ANCILLARY is non-nil, the buffer is added to `cider-ancillary-buffers' -and automatically removed when killed." - (with-current-buffer (get-buffer-create name) - (kill-all-local-variables) - (setq buffer-read-only nil) - (erase-buffer) - (when mode - (funcall mode)) - (cider-popup-buffer-mode 1) - (setq cider-popup-output-marker (point-marker)) - (setq buffer-read-only t) - (when ancillary - (add-to-list 'cider-ancillary-buffers name) - (add-hook 'kill-buffer-hook - (lambda () - (setq cider-ancillary-buffers - (remove name cider-ancillary-buffers))) - nil 'local)) - (current-buffer))) - -(defun cider-emit-into-popup-buffer (buffer value &optional face inhibit-indent) - "Emit into BUFFER the provided VALUE optionally using FACE. -Indent emitted value (usually a sexp) unless INHIBIT-INDENT is specified -and non-nil." - ;; Long string output renders Emacs unresponsive and users might intentionally - ;; kill the frozen popup buffer. Therefore, we don't re-create the buffer and - ;; silently ignore the output. - (when (buffer-live-p buffer) - (with-current-buffer buffer - (let ((inhibit-read-only t) - (buffer-undo-list t) - (moving (= (point) cider-popup-output-marker))) - (save-excursion - (goto-char cider-popup-output-marker) - (let ((value-str (format "%s" value))) - (when face - (add-face-text-property 0 (length value-str) face nil value-str)) - (insert value-str)) - (unless inhibit-indent - (indent-sexp)) - (set-marker cider-popup-output-marker (point))) - (when moving (goto-char cider-popup-output-marker)))))) - -(provide 'cider-popup) - -;;; cider-popup.el ends here diff --git a/elpa/cider-1.12.0/cider-profile.el b/elpa/cider-1.12.0/cider-profile.el @@ -1,216 +0,0 @@ -;;; cider-profile.el --- CIDER support for profiling -*- lexical-binding: t; -*- - -;; Copyright © 2014-2023 Edwin Watkeys and CIDER contributors - -;; Author: Edwin Watkeys <edw@poseur.com> -;; Juan E. Maya <jmayaalv@gmail.com> - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; Provides coarse-grained interactive profiling support. -;; Based on earlier work by Edwin Watkeys (https://github.com/thunknyc/nrepl-profile). - -;;; Code: - -(require 'cider-client) -(require 'cider-popup) -(require 'cider-eval) - -(defconst cider-profile-buffer "*cider-profile*") - -(defvar cider-profile-map - (let ((map (define-prefix-command 'cider-profile-map))) - (define-key map (kbd "t") #'cider-profile-toggle) - (define-key map (kbd "C-t") #'cider-profile-toggle) - (define-key map (kbd "c") #'cider-profile-clear) - (define-key map (kbd "C-c") #'cider-profile-clear) - (define-key map (kbd "S") #'cider-profile-summary) - (define-key map (kbd "C-S") #'cider-profile-summary) - (define-key map (kbd "s") #'cider-profile-var-summary) - (define-key map (kbd "C-s") #'cider-profile-var-summary) - (define-key map (kbd "n") #'cider-profile-ns-toggle) - (define-key map (kbd "C-n") #'cider-profile-ns-toggle) - (define-key map (kbd "v") #'cider-profile-var-profiled-p) - (define-key map (kbd "C-v") #'cider-profile-var-profiled-p) - (define-key map (kbd "+") #'cider-profile-samples) - (define-key map (kbd "C-+") #'cider-profile-samples) - map) - "CIDER profiler keymap.") - -(defconst cider-profile-menu - '("Profile" - ["Toggle var profiling" cider-profile-toggle] - ["Toggle namespace profiling" cider-profile-ns-toggle] - "--" - ["Display var profiling status" cider-profile-var-profiled-p] - ["Display max sample count" cider-profile-samples] - ["Display var summary" cider-profile-var-summary] - ["Display summary" cider-profile-summary] - ["Clear data" cider-profile-clear]) - "CIDER profiling submenu.") - -(defun cider-profile--make-response-handler (handler &optional buffer) - "Make a response handler using value handler HANDLER for connection BUFFER. - -Optional argument BUFFER defaults to current buffer." - (nrepl-make-response-handler - (or buffer (current-buffer)) handler nil nil nil)) - -;;;###autoload -(defun cider-profile-samples (&optional query) - "Displays current max-sample-count. -If optional QUERY is specified, set max-sample-count and display new value." - (interactive "P") - (cider-ensure-op-supported "set-max-samples") - (cider-ensure-op-supported "get-max-samples") - (if (not (null query)) - (cider-nrepl-send-request - (let ((max-samples (if (numberp query) query '()))) - (message "query: %s" max-samples) - `("op" "set-max-samples" "max-samples" ,max-samples)) - (cider-profile--make-response-handler - (lambda (_buffer value) - (let ((value (if (zerop (length value)) "unlimited" value))) - (message "max-sample-count is now %s" value))))) - (cider-nrepl-send-request - '("op" "get-max-samples") - (cider-profile--make-response-handler - (lambda (_buffer value) - (let ((value (if (zerop (length value)) "unlimited" value))) - (message "max-sample-count is now %s" value)))))) - query) - -;;;###autoload -(defun cider-profile-var-profiled-p (query) - "Displays the profiling status of var under point. -Prompts for var if none under point or QUERY is present." - (interactive "P") - (cider-ensure-op-supported "is-var-profiled") - (cider-read-symbol-name - "Report profiling status for var: " - (lambda (sym) - (let ((ns (cider-current-ns))) - (cider-nrepl-send-request - `("op" "is-var-profiled" - "ns" ,ns - "sym" ,sym) - (cider-profile--make-response-handler - (lambda (_buffer value) - (pcase value - ("profiled" (message "Profiling is currently enabled for %s/%s" ns sym)) - ("unprofiled" (message "Profiling is currently disabled for %s/%s" ns sym)) - ("unbound" (message "%s/%s is unbound" ns sym))))))))) - query) - -;;;###autoload -(defun cider-profile-ns-toggle (&optional query) - "Toggle profiling for the ns associated with optional QUERY. - -If optional argument QUERY is non-nil, prompt for ns. Otherwise use -current ns." - (interactive "P") - (cider-ensure-op-supported "toggle-profile-ns") - (let ((ns (if query - (completing-read "Toggle profiling for ns: " - (cider-sync-request:ns-list)) - (cider-current-ns)))) - (cider-nrepl-send-request - `("op" "toggle-profile-ns" - "ns" ,ns) - (cider-profile--make-response-handler - (lambda (_buffer value) - (pcase value - ("profiled" (message "Profiling enabled for %s" ns)) - ("unprofiled" (message "Profiling disabled for %s" ns))))))) - query) - -;;;###autoload -(defun cider-profile-toggle (query) - "Toggle profiling for the given QUERY. -Defaults to the symbol at point. -With prefix arg or no symbol at point, prompts for a var." - (interactive "P") - (cider-ensure-op-supported "toggle-profile") - (cider-read-symbol-name - "Toggle profiling for var: " - (lambda (sym) - (let ((ns (cider-current-ns))) - (cider-nrepl-send-request - `("op" "toggle-profile" - "ns" ,ns - "sym" ,sym) - (cider-profile--make-response-handler - (lambda (_buffer value) - (pcase value - ("profiled" (message "Profiling enabled for %s/%s" ns sym)) - ("unprofiled" (message "Profiling disabled for %s/%s" ns sym)) - ("unbound" (message "%s/%s is unbound" ns sym))))))))) - query) - -(defun cider-profile-display-stats (stats-response) - "Displays the STATS-RESPONSE on `cider-profile-buffer`." - (let ((table (nrepl-dict-get stats-response "err"))) - (if cider-profile-buffer - (let ((buffer (cider-make-popup-buffer cider-profile-buffer))) - (with-current-buffer buffer - (let ((inhibit-read-only t)) (insert table))) - (display-buffer buffer) - (let ((window (get-buffer-window buffer))) - (set-window-point window 0) - (select-window window) - (fit-window-to-buffer window))) - (cider-emit-interactive-eval-err-output table)))) - -;;;###autoload -(defun cider-profile-summary () - "Display a summary of currently collected profile data." - (interactive) - (cider-ensure-op-supported "profile-summary") - (cider-profile-display-stats - (cider-nrepl-send-sync-request '("op" "profile-summary")))) - -;;;###autoload -(defun cider-profile-var-summary (query) - "Display profile data for var under point QUERY. -Defaults to the symbol at point. With prefix arg or no symbol at point, -prompts for a var." - (interactive "P") - (cider-ensure-op-supported "profile-var-summary") - (cider-read-symbol-name - "Profile-summary for var: " - (lambda (sym) - (cider-profile-display-stats - (cider-nrepl-send-sync-request - `("op" "profile-var-summary" - "ns" ,(cider-current-ns) - "sym" ,sym))))) - query) - -;;;###autoload -(defun cider-profile-clear () - "Clear any collected profile data." - (interactive) - (cider-ensure-op-supported "clear-profile") - (cider-nrepl-send-request - '("op" "clear-profile") - (cider-profile--make-response-handler - (lambda (_buffer value) - (when (equal value "cleared") - (message "Cleared profile data")))))) - -(provide 'cider-profile) - -;;; cider-profile.el ends here diff --git a/elpa/cider-1.12.0/cider-repl-history.el b/elpa/cider-1.12.0/cider-repl-history.el @@ -1,721 +0,0 @@ -;;; cider-repl-history.el --- REPL input history browser -*- lexical-binding: t; -*- - -;; Copyright (c) 2017-2023 John Valente and browse-kill-ring authors - -;; 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/>. - -;; This file is not part of GNU Emacs. - -;; Based heavily on browse-kill-ring -;; https://github.com/browse-kill-ring/browse-kill-ring - -;;; Commentary: - -;; REPL input history browser for CIDER. - -;; Allows you to browse the full input history for your REPL buffer, and -;; insert previous commands at the prompt. - -;;; Code: - -(require 'cl-lib) -(require 'cider-popup) -(require 'clojure-mode) -(require 'derived) -(require 'pulse) -(require 'sesman) - -(defconst cider-repl-history-buffer "*cider-repl-history*") - -(defgroup cider-repl-history nil - "A package for browsing and inserting the items in the CIDER command history." - :prefix "cider-repl-history-" - :group 'cider) - -(defvar cider-repl-history-display-styles - '((separated . cider-repl-history-insert-as-separated) - (one-line . cider-repl-history-insert-as-one-line))) - -(defcustom cider-repl-history-display-style 'separated - "How to display the CIDER command history items. - -If `one-line', then replace newlines with \"\\n\" for display. - -If `separated', then display `cider-repl-history-separator' between -entries." - :type '(choice (const :tag "One line" one-line) - (const :tag "Separated" separated)) - :package-version '(cider . "0.15.0")) - -(defcustom cider-repl-history-quit-action 'quit-window - "What action to take when `cider-repl-history-quit' is called. - -If `bury-buffer', then simply bury the *cider-repl-history* buffer, but keep -the window. - -If `bury-and-delete-window', then bury the buffer, and (if there is -more than one window) delete the window. - -If `delete-and-restore', then restore the window configuration to what it was -before `cider-repl-history' was called, and kill the *cider-repl-history* -buffer. - -If `quit-window', then restore the window configuration to what -it was before `cider-repl-history' was called, and bury *cider-repl-history*. -This is the default. - -If `kill-and-delete-window', then kill the *cider-repl-history* buffer, and -delete the window on close. - -Otherwise, it should be a function to call." - ;; Note, if you use one of the non-"delete" options, after you "quit", - ;; the *cider-repl-history* buffer is still available. If you are using - ;; `cider-repl-history-show-preview', and you switch to *cider-repl-history* (i.e., - ;; with C-x b), it will not give the preview unless and until you "update" - ;; the *cider-repl-history* buffer. - ;; - ;; This really should not be an issue, because there's no reason to "switch" - ;; back to the buffer. If you want to get it back, you can just do C-c M-p - ;; from the REPL buffer. - - ;; If you get in this situation and find it annoying, you can either disable - ;; the preview, or set `cider-repl-history-quit-action' to 'delete-and-restore. - ;; Then you will simply not have the *cider-repl-history* buffer after you quit, - ;; and it won't be an issue. - - :type '(choice (const :tag "Bury buffer" - :value bury-buffer) - (const :tag "Bury buffer and delete window" - :value bury-and-delete-window) - (const :tag "Delete window" - :value delete-and-restore) - (const :tag "Save and restore" - :value quit-window) - (const :tag "Kill buffer and delete window" - :value kill-and-delete-window) - function) - :package-version '(cider . "0.15.0")) - -(defcustom cider-repl-history-resize-window nil - "Whether to resize the `cider-repl-history' window to fit its contents. -Value is either t, meaning yes, or a cons pair of integers, - (MAXIMUM . MINIMUM) for the size of the window. MAXIMUM defaults to -the window size chosen by `pop-to-buffer'; MINIMUM defaults to -`window-min-height'." - :type '(choice (const :tag "No" nil) - (const :tag "Yes" t) - (cons (integer :tag "Maximum") (integer :tag "Minimum"))) - :package-version '(cider . "0.15.0")) - -(defcustom cider-repl-history-separator ";;;;;;;;;;" - "The string separating entries in the `separated' style. -See `cider-repl-history-display-style'." - ;; The (default) separator is a Clojure comment, to preserve fontification - ;; in the buffer. - :type 'string - :package-version '(cider . "0.15.0")) - -(defcustom cider-repl-history-recenter nil - "If non-nil, then always keep the current entry at the top of the window." - :type 'boolean - :package-version '(cider . "0.15.0")) - -(defcustom cider-repl-history-highlight-current-entry nil - "If non-nil, highlight the currently selected command history entry." - :type 'boolean - :package-version '(cider . "0.15.0")) - -(defcustom cider-repl-history-highlight-inserted-item nil - "If non-nil, then temporarily highlight the inserted command history entry. -The value selected controls how the inserted item is highlighted, -possible values are `solid' (highlight the inserted text for a -fixed period of time), or `pulse' (fade out the highlighting gradually). -Setting this variable to the value t will select the default -highlighting style, which currently `pulse'. - -The variable `cider-repl-history-inserted-item-face' contains the -face used for highlighting." - :type '(choice (const nil) (const t) (const solid) (const pulse)) - :package-version '(cider . "0.15.0")) - -(defcustom cider-repl-history-separator-face 'bold - "The face in which to highlight the `cider-repl-history-separator'." - :type 'face - :package-version '(cider . "0.15.0")) - -(defcustom cider-repl-history-current-entry-face 'highlight - "The face in which to highlight the command history current entry." - :type 'face - :package-version '(cider . "0.15.0")) - -(defcustom cider-repl-history-inserted-item-face 'highlight - "The face in which to highlight the inserted item." - :type 'face - :package-version '(cider . "0.15.0")) - -(defcustom cider-repl-history-maximum-display-length nil - "Whether or not to limit the length of displayed items. - -If this variable is an integer, the display of the command history will be -limited to that many characters. -Setting this variable to nil means no limit." - :type '(choice (const :tag "None" nil) - integer) - :package-version '(cider . "0.15.0")) - -(defcustom cider-repl-history-display-duplicates t - "If non-nil, then display duplicate items in the command history." - :type 'boolean - :package-version '(cider . "0.15.0")) - -(defcustom cider-repl-history-display-duplicate-highest t - "If non-nil, then display most recent duplicate items in the command history. -Only takes effect when `cider-repl-history-display-duplicates' is nil." - :type 'boolean - :package-version '(cider . "0.15.0")) - -(defcustom cider-repl-history-text-properties nil - "If non-nil, maintain text properties of the command history items." - :type 'boolean - :package-version '(cider . "0.15.0")) - -(defcustom cider-repl-history-hook nil - "A list of functions to call after `cider-repl-history'." - :type 'hook - :package-version '(cider . "0.15.0")) - -(defcustom cider-repl-history-show-preview nil - "If non-nil, show a preview of the inserted text in the REPL buffer. - -The REPL buffer would show a preview of what the buffer would look like -if the item under point were inserted." - - :type 'boolean - :package-version '(cider . "0.15.0")) - -(defvar cider-repl-history-repl-window nil - "The window in which chosen command history data will be inserted. -It is probably not a good idea to set this variable directly; simply -call `cider-repl-history' again.") - -(defvar cider-repl-history-repl-buffer nil - "The buffer in which chosen command history data will be inserted. -It is probably not a good idea to set this variable directly; simply -call `cider-repl-history' again.") - -(defvar cider-repl-history-preview-overlay nil - "Overlay used to preview what would happen if the user inserted the given text.") - -(defvar cider-repl-history-previous-overlay nil - "Previous overlay within *cider-repl-history* buffer.") - - -(defun cider-repl-history-get-history () - "Function to retrieve history from the REPL buffer." - (if cider-repl-history-repl-buffer - (buffer-local-value - 'cider-repl-input-history - cider-repl-history-repl-buffer) - (error "Variable `cider-repl-history-repl-buffer' not bound to a buffer"))) - -(defun cider-repl-history-resize-window () - "Resize the *cider-repl-history* window if needed. -Controlled by variable `cider-repl-history-resize-window'." - (when cider-repl-history-resize-window - (apply #'fit-window-to-buffer (selected-window) - (if (consp cider-repl-history-resize-window) - (list (car cider-repl-history-resize-window) - (or (cdr cider-repl-history-resize-window) - window-min-height)) - (list nil window-min-height))))) - -(defun cider-repl-history-read-regexp (msg use-default-p) - "Get a regular expression from the user. -Prompts with MSG; previous entry is default if USE-DEFAULT-P." - (let* ((default (car regexp-history)) - (prompt (if (and default use-default-p) - (format "%s for regexp (default `%s'): " - msg - default) - (format "%s (regexp): " msg))) - (input - (read-from-minibuffer prompt nil nil nil 'regexp-history - (if use-default-p nil default)))) - (if (equal input "") - (if use-default-p default nil) - input))) - -(defun cider-repl-history-clear-preview () - "Clear the preview, if one is present." - (interactive) - (when cider-repl-history-preview-overlay - (cl-assert (overlayp cider-repl-history-preview-overlay)) - (delete-overlay cider-repl-history-preview-overlay))) - -(defun cider-repl-history-cleanup-on-exit () - "Function called when the user is finished with `cider-repl-history'. -This function performs any cleanup that is required when the user -has finished interacting with the *cider-repl-history* buffer. For now -the only cleanup performed is to remove the preview overlay, if -it's turned on." - (cider-repl-history-clear-preview)) - -(defun cider-repl-history-quit () - "Take the action specified by `cider-repl-history-quit-action'." - (interactive) - (cider-repl-history-cleanup-on-exit) - (pcase cider-repl-history-quit-action - (`delete-and-restore - (quit-restore-window (selected-window) 'kill)) - (`quit-window - (quit-window)) - (`kill-and-delete-window - (kill-buffer (current-buffer)) - (unless (= (count-windows) 1) - (delete-window))) - (`bury-and-delete-window - (bury-buffer) - (unless (= (count-windows) 1) - (delete-window))) - (_ - (funcall cider-repl-history-quit-action)))) - -(defun cider-repl-history-preview-overlay-setup (orig-buf) - "Setup the preview overlay in ORIG-BUF." - (when cider-repl-history-show-preview - (with-current-buffer orig-buf - (let* ((will-replace (region-active-p)) - (start (if will-replace - (min (point) (mark)) - (point))) - (end (if will-replace - (max (point) (mark)) - (point)))) - (cider-repl-history-clear-preview) - (setq cider-repl-history-preview-overlay - (make-overlay start end orig-buf)) - (overlay-put cider-repl-history-preview-overlay - 'invisible t))))) - -(defun cider-repl-history-highlight-inserted (start end) - "Insert the text between START and END." - (pcase cider-repl-history-highlight-inserted-item - ((or `pulse `t) - (let ((pulse-delay .05) (pulse-iterations 10)) - (with-no-warnings - (pulse-momentary-highlight-region - start end cider-repl-history-inserted-item-face)))) - (`solid - (let ((o (make-overlay start end))) - (overlay-put o 'face cider-repl-history-inserted-item-face) - (sit-for 0.5) - (delete-overlay o))))) - -(defun cider-repl-history-insert-and-highlight (str) - "Helper function to insert STR at point, highlighting it if appropriate." - (let ((before-insert (point))) - (let (deactivate-mark) - (insert-for-yank str)) - (cider-repl-history-highlight-inserted - before-insert - (point)))) - -(defun cider-repl-history-target-overlay-at (_position &optional no-error) - "Return overlay at POSITION that has property `cider-repl-history-target'. -If no such overlay, raise an error unless NO-ERROR is true, in which -case return nil." - (let ((ovs (overlays-at (point)))) - (catch 'cider-repl-history-target-overlay-at - (dolist (ov ovs) - (when (overlay-get ov 'cider-repl-history-target) - (throw 'cider-repl-history-target-overlay-at ov))) - (unless no-error - (error "No CIDER history item here"))))) - -(defun cider-repl-history-current-string (pt &optional no-error) - "Find the string to insert into the REPL by looking for the overlay at PT. -Might error unless NO-ERROR set." - (let ((o (cider-repl-history-target-overlay-at pt t))) - (if o - (overlay-get o 'cider-repl-history-target) - (unless no-error - (error "No CIDER history item in this buffer"))))) - -(defun cider-repl-history-do-insert (_buf pt) - "Helper function to insert text from BUF at PT into the REPL buffer. -Also kills *cider-repl-history*." - ;; Note: as mentioned at the top, this file is based on browse-kill-ring, - ;; which has numerous insertion options. The functionality of - ;; browse-kill-ring allows users to insert at point, and move point to the end - ;; of the inserted text; or insert at the beginning or end of the buffer, - ;; while leaving point alone. And each of these had the option of leaving the - ;; history buffer in place, or getting rid of it. That was appropriate for a - ;; generic paste tool, but for inserting a previous command into an - ;; interpreter, I felt the only useful option would be inserting it at the end - ;; and quitting the history buffer, so that is all that's provided. - (let ((str (cider-repl-history-current-string pt))) - (cider-repl-history-quit) - (with-selected-window cider-repl-history-repl-window - (with-current-buffer cider-repl-history-repl-buffer - (let ((max (point-max))) - (if (= max (point)) - (cider-repl-history-insert-and-highlight str) - (save-excursion - (goto-char max) - (cider-repl-history-insert-and-highlight str)))))))) - -(defun cider-repl-history-insert-and-quit () - "Insert the item into the REPL buffer, and close *cider-repl-history*. - -The text is always inserted at the very bottom of the REPL buffer. If your -cursor is already at the bottom, it is advanced to the end of the inserted -text. If your cursor is somewhere else, the cursor is not moved, but the -text is still inserted at the end." - (interactive) - (cider-repl-history-do-insert (current-buffer) (point))) - -(defun cider-repl-history-mouse-insert (e) - "Insert the item at E into the REPL buffer, and close *cider-repl-history*. - -The text is always inserted at the very bottom of the REPL buffer. If your -cursor is already at the bottom, it is advanced to the end of the inserted -text. If your cursor is somewhere else, the cursor is not moved, but the -text is still inserted at the end." - (interactive "e") - (let* ((data (save-excursion - (mouse-set-point e) - (cons (current-buffer) (point)))) - (buf (car data)) - (pt (cdr data))) - (cider-repl-history-do-insert buf pt))) - -(defun cider-repl-history-clear-highlighted-entry () - "Clear the highlighted entry, when one exists." - (when cider-repl-history-previous-overlay - (cl-assert (overlayp cider-repl-history-previous-overlay) - nil "not an overlay") - (overlay-put cider-repl-history-previous-overlay 'face nil))) - -(defun cider-repl-history-update-highlighted-entry () - "Update highlighted entry, when feature is turned on." - (when cider-repl-history-highlight-current-entry - (if-let* ((current-overlay (cider-repl-history-target-overlay-at (point) t))) - (unless (equal cider-repl-history-previous-overlay current-overlay) - ;; We've changed overlay. Clear current highlighting, - ;; and highlight the new overlay. - (cl-assert (overlay-get current-overlay 'cider-repl-history-target) t) - (cider-repl-history-clear-highlighted-entry) - (setq cider-repl-history-previous-overlay current-overlay) - (overlay-put current-overlay 'face - cider-repl-history-current-entry-face)) - ;; No overlay at point. Just clear all current highlighting. - (cider-repl-history-clear-highlighted-entry)))) - -(defun cider-repl-history-forward (&optional arg) - "Move forward by ARG command history entries." - (interactive "p") - (beginning-of-line) - (while (not (zerop arg)) - (let ((o (cider-repl-history-target-overlay-at (point) t))) - (cond - ((>= arg 0) - (setq arg (1- arg)) - ;; We're on a cider-repl-history overlay, skip to the end of it. - (when o - (goto-char (overlay-end o)) - (setq o nil)) - (while (not (or o (eobp))) - (goto-char (next-overlay-change (point))) - (setq o (cider-repl-history-target-overlay-at (point) t)))) - (t - (setq arg (1+ arg)) - (when o - (goto-char (overlay-start o)) - (setq o nil)) - (while (not (or o (bobp))) - (goto-char (previous-overlay-change (point))) - (setq o (cider-repl-history-target-overlay-at (point) t))))))) - (when cider-repl-history-recenter - (recenter 1))) - -(defun cider-repl-history-previous (&optional arg) - "Move backward by ARG command history entries." - (interactive "p") - (cider-repl-history-forward (- arg))) - -(defun cider-repl-history-search-forward (regexp &optional backwards) - "Move to the next command history entry matching REGEXP from point. -If optional arg BACKWARDS is non-nil, move to the previous matching -entry." - (interactive - (list (cider-repl-history-read-regexp "Search forward" t) - current-prefix-arg)) - (let ((orig (point))) - (cider-repl-history-forward (if backwards -1 1)) - (let ((over (cider-repl-history-target-overlay-at (point) t))) - (while (and over - (not (if backwards (bobp) (eobp))) - (not (string-match regexp - (overlay-get over - 'cider-repl-history-target)))) - (cider-repl-history-forward (if backwards -1 1)) - (setq over (cider-repl-history-target-overlay-at (point) t))) - (unless (and over - (string-match regexp - (overlay-get over - 'cider-repl-history-target))) - (goto-char orig) - (message "No more command history entries matching %s" regexp))))) - -(defun cider-repl-history-search-backward (regexp) - "Move to the previous command history entry matching REGEXP from point." - (interactive - (list (cider-repl-history-read-regexp "Search backward" t))) - (cider-repl-history-search-forward regexp t)) - -(defun cider-repl-history-elide (str) - ;; FIXME: Use `truncate-string-to-width'? - "If STR is too long, abbreviate it with an ellipsis. -Otherwise, return it unchanged." - (if (and cider-repl-history-maximum-display-length - (> (length str) - cider-repl-history-maximum-display-length)) - (concat (substring str 0 (- cider-repl-history-maximum-display-length 3)) - (propertize "..." 'cider-repl-history-extra t)) - str)) - -(defmacro cider-repl-history-add-overlays-for (item &rest body) - "Add overlays for ITEM, and execute BODY." - (let ((beg (cl-gensym "cider-repl-history-add-overlays-")) - (end (cl-gensym "cider-repl-history-add-overlays-"))) - `(let ((,beg (point)) - (,end - (progn - ,@body - (point)))) - (let ((o (make-overlay ,beg ,end))) - (overlay-put o 'cider-repl-history-target ,item) - (overlay-put o 'mouse-face 'highlight))))) - -(defun cider-repl-history-insert-as-separated (items) - "Insert ITEMS into the current buffer, with separators between items." - (while items - (let* ((origitem (car items)) - (item (cider-repl-history-elide origitem)) - ) ;; (len (length item)) - (cider-repl-history-add-overlays-for origitem (insert item)) - ;; When the command history has items with read-only text property at - ;; **the end of** string, cider-repl-history-setup fails with error - ;; `Text is read-only'. So inhibit-read-only here. - ;; See http://bugs.debian.org/225082 - (let ((inhibit-read-only t)) - (insert "\n") - (when (cdr items) - (insert (propertize cider-repl-history-separator - 'cider-repl-history-extra t - 'cider-repl-history-separator t)) - (insert "\n")))) - (setq items (cdr items)))) - -(defun cider-repl-history-insert-as-one-line (items) - "Insert ITEMS into the current buffer, formatting each item as a single line. - -An explicit newline character will replace newlines so that the text retains its -spacing when it's actually inserted into the REPL buffer." - (dolist (item items) - (cider-repl-history-add-overlays-for - item - (let* ((item (cider-repl-history-elide item)) - (len (length item)) - (start 0) - (newl (propertize "\\n" 'cider-repl-history-extra t))) - (while (and (< start len) - (string-match "\n" item start)) - (insert (substring item start (match-beginning 0)) - newl) - (setq start (match-end 0))) - (insert (substring item start len)))) - (insert "\n"))) - -(defun cider-repl-history-preview-update-text (preview-text) - "Update `cider-repl-history-preview-overlay' to show `PREVIEW-TEXT`." - ;; If preview-text is nil, replacement should be nil too. - (cl-assert (overlayp cider-repl-history-preview-overlay)) - (let ((replacement (when preview-text - (propertize preview-text 'face 'highlight)))) - (overlay-put cider-repl-history-preview-overlay - 'before-string replacement))) - -(defun cider-repl-history-preview-update-by-position (&optional pt) - "Update `cider-repl-history-preview-overlay' to match item at PT. - -This function is called whenever the selection in the *cider-repl-history* -buffer is adjusted, the `cider-repl-history-preview-overlay' -is updated to preview the text of the selection at PT (or the -current point if not specified)." - (let ((new-text (cider-repl-history-current-string - (or pt (point)) t))) - (cider-repl-history-preview-update-text new-text))) - -(defun cider-repl-history-undo-other-window () - "Undo the most recent change in the other window's buffer. -You most likely want to use this command for undoing an insertion of -text from the *cider-repl-history* buffer." - (interactive) - (with-current-buffer cider-repl-history-repl-buffer - (undo))) - -(defun cider-repl-history-setup (repl-win repl-buf history-buf &optional regexp) - "Setup. -REPL-WIN and REPL-BUF are where to insert commands; -HISTORY-BUF is the history, and optional arg REGEXP is a filter." - (cider-repl-history-preview-overlay-setup repl-buf) - (with-current-buffer history-buf - (unwind-protect - (progn - (cider-repl-history-mode) - (setq buffer-read-only nil) - (when (eq 'one-line cider-repl-history-display-style) - (setq truncate-lines t)) - (let ((inhibit-read-only t)) - (erase-buffer)) - (setq cider-repl-history-repl-buffer repl-buf) - (setq cider-repl-history-repl-window repl-win) - (let* ((cider-repl-history-maximum-display-length - (if (and cider-repl-history-maximum-display-length - (<= cider-repl-history-maximum-display-length 3)) - 4 - cider-repl-history-maximum-display-length)) - (cider-command-history (cider-repl-history-get-history)) - (items (mapcar - (if cider-repl-history-text-properties - #'copy-sequence - #'substring-no-properties) - cider-command-history))) - (unless cider-repl-history-display-duplicates - ;; display highest or lowest duplicate. - ;; if `cider-repl-history-display-duplicate-highest' is t, - ;; display highest (most recent) duplicate. - (cl-delete-duplicates - items - :test #'equal - :from-end cider-repl-history-display-duplicate-highest)) - (when (stringp regexp) - (setq items (delq nil - (mapcar - #'(lambda (item) - (when (string-match regexp item) - item)) - items)))) - (funcall (or (cdr (assq cider-repl-history-display-style - cider-repl-history-display-styles)) - (error "Invalid `cider-repl-history-display-style': %s" - cider-repl-history-display-style)) - items) - (when cider-repl-history-show-preview - (cider-repl-history-preview-update-by-position (point-min)) - ;; Local post-command-hook, only happens in *cider-repl-history* - (add-hook 'post-command-hook - #'cider-repl-history-preview-update-by-position - nil t) - (add-hook 'kill-buffer-hook - #'cider-repl-history-cleanup-on-exit - nil t)) - (when cider-repl-history-highlight-current-entry - (add-hook 'post-command-hook - #'cider-repl-history-update-highlighted-entry - nil t)) - (message - (let ((entry (if (= 1 (length cider-command-history)) - "entry" - "entries"))) - (concat - (if (and (not regexp) - cider-repl-history-display-duplicates) - (format "%s %s in the command history." - (length cider-command-history) entry) - (format "%s (of %s) %s in the command history shown." - (length items) (length cider-command-history) entry)) - (substitute-command-keys - (concat " Type \\[cider-repl-history-quit] to quit. " - "\\[describe-mode] for help."))))) - (set-buffer-modified-p nil) - (goto-char (point-min)) - (cider-repl-history-forward 0) - (setq mode-name (if regexp - (concat "History [" regexp "]") - "History")) - (run-hooks 'cider-repl-history-hook))) - (setq buffer-read-only t)))) - -(defun cider-repl-history-update () - "Update the history buffer to reflect the latest state of the command history." - (interactive) - (cl-assert (eq major-mode 'cider-repl-history-mode)) - (cider-repl-history-setup cider-repl-history-repl-window - cider-repl-history-repl-buffer - (current-buffer)) - (cider-repl-history-resize-window)) - -(defun cider-repl-history-occur (regexp) - "Display all command history entries matching REGEXP." - (interactive - (list (cider-repl-history-read-regexp - "Display command history entries matching" nil))) - (cl-assert (eq major-mode 'cider-repl-history-mode)) - (cider-repl-history-setup cider-repl-history-repl-window - cider-repl-history-repl-buffer - (current-buffer) - regexp) - (cider-repl-history-resize-window)) - -(defvar cider-repl-history-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "n") #'cider-repl-history-forward) - (define-key map (kbd "p") #'cider-repl-history-previous) - (define-key map (kbd "SPC") #'cider-repl-history-insert-and-quit) - (define-key map (kbd "RET") #'cider-repl-history-insert-and-quit) - (define-key map [(mouse-2)] #'cider-repl-history-mouse-insert) - (define-key map (kbd "l") #'cider-repl-history-occur) - (define-key map (kbd "s") #'cider-repl-history-search-forward) - (define-key map (kbd "r") #'cider-repl-history-search-backward) - (define-key map (kbd "g") #'cider-repl-history-update) - (define-key map (kbd "q") #'cider-repl-history-quit) - (define-key map (kbd "U") #'cider-repl-history-undo-other-window) - (define-key map (kbd "?") #'describe-mode) - (define-key map (kbd "h") #'describe-mode) - map)) - -(put 'cider-repl-history-mode 'mode-class 'special) -(define-derived-mode cider-repl-history-mode clojure-mode "History" - "Major mode for browsing the entries in the command input history." - (setq-local sesman-system 'CIDER)) - -;;;###autoload -(defun cider-repl-history () - "Display items in the CIDER command history in another buffer." - (interactive) - (when (eq major-mode 'cider-repl-history-mode) - (user-error "Already viewing the CIDER command history")) - - (let* ((repl-win (selected-window)) - (repl-buf (window-buffer repl-win)) - (buf (get-buffer-create cider-repl-history-buffer))) - (cider-repl-history-setup repl-win repl-buf buf) - (pop-to-buffer buf) - (cider-repl-history-resize-window))) - -(provide 'cider-repl-history) - -;;; cider-repl-history.el ends here diff --git a/elpa/cider-1.12.0/cider-repl.el b/elpa/cider-1.12.0/cider-repl.el @@ -1,2069 +0,0 @@ -;;; cider-repl.el --- CIDER REPL mode interactions -*- lexical-binding: t -*- - -;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2023 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; -;; Author: Tim King <kingtim@gmail.com> -;; Phil Hagelberg <technomancy@gmail.com> -;; Bozhidar Batsov <bozhidar@batsov.dev> -;; Artur Malabarba <bruce.connor.am@gmail.com> -;; Hugo Duncan <hugo@hugoduncan.org> -;; Steve Purcell <steve@sanityinc.com> -;; Reid McKenzie <me@arrdem.com> - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; This functionality concerns `cider-repl-mode' and REPL interaction. For -;; REPL/connection life-cycle management see cider-connection.el. - -;;; Code: - -(require 'cl-lib) -(require 'easymenu) -(require 'image) -(require 'map) -(require 'seq) -(require 'subr-x) - -(require 'clojure-mode) -(require 'sesman) - -(require 'cider-client) -(require 'cider-doc) -(require 'cider-test) -(require 'cider-eldoc) ; for cider-eldoc-setup -(require 'cider-common) -(require 'cider-util) -(require 'cider-resolve) - -(declare-function cider-inspect "cider-inspector") - - -(defgroup cider-repl nil - "Interaction with the REPL." - :prefix "cider-repl-" - :group 'cider) - -(defface cider-repl-prompt-face - '((t (:inherit font-lock-keyword-face))) - "Face for the prompt in the REPL buffer.") - -(defface cider-repl-stdout-face - '((t (:inherit font-lock-string-face))) - "Face for STDOUT output in the REPL buffer.") - -(defface cider-repl-stderr-face - '((t (:inherit font-lock-warning-face))) - "Face for STDERR output in the REPL buffer." - :package-version '(cider . "0.6.0")) - -(defface cider-repl-input-face - '((t (:bold t))) - "Face for previous input in the REPL buffer.") - -(defface cider-repl-result-face - '((t ())) - "Face for the result of an evaluation in the REPL buffer.") - -(defcustom cider-repl-pop-to-buffer-on-connect t - "Controls whether to pop to the REPL buffer on connect. - -When set to nil the buffer will only be created, and not displayed. When -set to `display-only' the buffer will be displayed, but it will not become -focused. Otherwise the buffer is displayed and focused." - :type '(choice (const :tag "Create the buffer, but don't display it" nil) - (const :tag "Create and display the buffer, but don't focus it" - display-only) - (const :tag "Create, display, and focus the buffer" t))) - -(defcustom cider-repl-display-in-current-window nil - "Controls whether the REPL buffer is displayed in the current window." - :type 'boolean) - -(make-obsolete-variable 'cider-repl-scroll-on-output 'scroll-conservatively "0.21") - -(defcustom cider-repl-use-pretty-printing t - "Control whether results in the REPL are pretty-printed or not. -The REPL will use the printer specified in `cider-print-fn'. -The `cider-toggle-pretty-printing' command can be used to interactively -change the setting's value." - :type 'boolean) - -(make-obsolete-variable 'cider-repl-pretty-print-width 'cider-print-options "0.21") - -(defcustom cider-repl-use-content-types nil - "Control whether REPL results are presented using content-type information. -The `cider-repl-toggle-content-types' command can be used to interactively -change the setting's value." - :type 'boolean - :package-version '(cider . "0.17.0")) - -(defcustom cider-repl-auto-detect-type t - "Control whether to auto-detect the REPL type using track-state information. -If you disable this you'll have to manually change the REPL type between -Clojure and ClojureScript when invoking REPL type changing forms. -Use `cider-set-repl-type' to manually change the REPL type." - :type 'boolean - :safe #'booleanp - :package-version '(cider . "0.18.0")) - -(defcustom cider-repl-use-clojure-font-lock t - "Non-nil means to use Clojure mode font-locking for input and result. -Nil means that `cider-repl-input-face' and `cider-repl-result-face' -will be used." - :type 'boolean - :package-version '(cider . "0.10.0")) - -(defcustom cider-repl-require-ns-on-set nil - "Controls whether to require the ns before setting it in the REPL." - :type 'boolean - :package-version '(cider . "0.22.0")) - -(defcustom cider-repl-result-prefix "" - "The prefix displayed in the REPL before a result value. -By default there's no prefix, but you can specify something -like \"=>\" if want results to stand out more." - :type 'string - :group 'cider - :package-version '(cider . "0.5.0")) - -(defcustom cider-repl-tab-command 'cider-repl-indent-and-complete-symbol - "Select the command to be invoked by the TAB key. -The default option is `cider-repl-indent-and-complete-symbol'. If -you'd like to use the default Emacs behavior use -`indent-for-tab-command'." - :type 'symbol) - -(make-obsolete-variable 'cider-repl-print-length 'cider-print-options "0.21") -(make-obsolete-variable 'cider-repl-print-level 'cider-print-options "0.21") - -(defvar cider-repl-require-repl-utils-code - '((clj . "(when-let [requires (resolve 'clojure.main/repl-requires)] - (clojure.core/apply clojure.core/require @requires))") - (cljs . "(require '[cljs.repl :refer [apropos dir doc find-doc print-doc pst source]])"))) - -(defcustom cider-repl-init-code (list (cdr (assoc 'clj cider-repl-require-repl-utils-code))) - "Clojure code to evaluate when starting a REPL. -Will be evaluated with bindings for set!-able vars in place. - -See also `cider-repl-eval-init-code'." - :type '(list string) - :package-version '(cider . "0.21.0")) - -(defcustom cider-repl-display-help-banner t - "When non-nil a bit of help text will be displayed on REPL start." - :type 'boolean - :package-version '(cider . "0.11.0")) - -;; See https://github.com/clojure-emacs/cider/issues/3219 for more details -(defcustom cider-repl-display-output-before-window-boundaries nil - "Controls whether to display output emitted before the REPL window boundaries. - -If the prompt is on the first line of the window, then scroll the window -down by a single line to make the emitted output visible. - -That behavior is desirable, but rarely needed and it slows down printing -output a lot (e.g. 10x) that's why it's disable by default starting with -CIDER 1.7." - :type 'boolean - :package-version '(cider . "1.7.0")) - - -;;;; REPL buffer local variables -(defvar-local cider-repl-input-start-mark nil) - -(defvar-local cider-repl-prompt-start-mark nil) - -(defvar-local cider-repl-old-input-counter 0 - "Counter used to generate unique `cider-old-input' properties. -This property value must be unique to avoid having adjacent inputs be -joined together.") - -(defvar-local cider-repl-input-history '() - "History list of strings read from the REPL buffer.") - -(defvar-local cider-repl-input-history-items-added 0 - "Variable counting the items added in the current session.") - -(defvar-local cider-repl-output-start nil - "Marker for the start of output. -Currently its only purpose is to facilitate `cider-repl-clear-buffer'.") - -(defvar-local cider-repl-output-end nil - "Marker for the end of output. -Currently its only purpose is to facilitate `cider-repl-clear-buffer'.") - -(defun cider-repl-tab () - "Invoked on TAB keystrokes in `cider-repl-mode' buffers." - (interactive) - (funcall cider-repl-tab-command)) - -(defun cider-repl-reset-markers () - "Reset all REPL markers." - (dolist (markname '(cider-repl-output-start - cider-repl-output-end - cider-repl-prompt-start-mark - cider-repl-input-start-mark)) - (set markname (make-marker)) - (set-marker (symbol-value markname) (point)))) - - -;;; REPL init - -(defvar-local cider-repl-ns-cache nil - "A dict holding information about all currently loaded namespaces. -This cache is stored in the connection buffer.") - -(defvar cider-mode) -(declare-function cider-refresh-dynamic-font-lock "cider-mode") - -(defun cider-repl--state-handler (response) - "Handle server state contained in RESPONSE." - (with-demoted-errors "Error in `cider-repl--state-handler': %s" - (when (member "state" (nrepl-dict-get response "status")) - (nrepl-dbind-response response (repl-type changed-namespaces session) - (when (and repl-type - cider-repl-auto-detect-type - ;; tooling sessions always run on the JVM so they are not a valid criterion: - (not (equal session nrepl-tooling-session))) - (cider-set-repl-type repl-type)) - (when (eq (cider-maybe-intern repl-type) 'cljs) - (setq cider-repl-cljs-upgrade-pending nil)) - (unless (nrepl-dict-empty-p changed-namespaces) - (setq cider-repl-ns-cache (nrepl-dict-merge cider-repl-ns-cache changed-namespaces)) - (let ((this-repl (current-buffer))) - (dolist (b (buffer-list)) - (with-current-buffer b - (when (or cider-mode (derived-mode-p 'cider-repl-mode)) - ;; We only cider-refresh-dynamic-font-lock (and set `cider-eldoc-last-symbol') - ;; for Clojure buffers directly related to this repl - ;; (specifically, we omit 'friendly' sessions because a given buffer may be friendly to multiple repls, - ;; so we don't want a buffer to mix up font locking rules from different repls). - ;; Note that `sesman--linked-sessions' only queries for the directly linked sessions. - ;; That has the additional advantage of running very/predictably fast, since it won't run our - ;; `cider--sesman-friendly-session-p' logic, which can be slow for its non-cached path. - (when (member this-repl (car (sesman--linked-sessions 'CIDER))) - ;; Metadata changed, so signatures may have changed too. - (setq cider-eldoc-last-symbol nil) - (when-let* ((ns-dict (or (nrepl-dict-get changed-namespaces (cider-current-ns)) - (let ((ns-dict (cider-resolve--get-in (cider-current-ns)))) - (when (seq-find (lambda (ns) (nrepl-dict-get changed-namespaces ns)) - (nrepl-dict-get ns-dict "aliases")) - ns-dict))))) - (cider-refresh-dynamic-font-lock ns-dict)))))))))))) - -(defun cider-repl-require-repl-utils () - "Require standard REPL util functions into the current REPL." - (interactive) - (let* ((current-repl (cider-current-repl nil 'ensure)) - (require-code (cdr (assoc (cider-repl-type current-repl) cider-repl-require-repl-utils-code)))) - (nrepl-send-sync-request - (lax-plist-put - (nrepl--eval-request require-code (cider-current-ns)) - "inhibit-cider-middleware" "true") - current-repl))) - -(defun cider-repl-init-eval-handler (&optional callback) - "Make an nREPL evaluation handler for use during REPL init. -Run CALLBACK once the evaluation is complete." - (nrepl-make-response-handler (current-buffer) - (lambda (_buffer _value)) - (lambda (buffer out) - (cider-repl-emit-stdout buffer out)) - (lambda (buffer err) - (cider-repl-emit-stderr buffer err)) - (lambda (buffer) - (cider-repl-emit-prompt buffer) - (when callback - (funcall callback))))) - -(defun cider-repl-eval-init-code (&optional callback) - "Evaluate `cider-repl-init-code' in the current REPL. -Run CALLBACK once the evaluation is complete." - (interactive) - (let* ((request (map-merge 'hash-table - (cider--repl-request-map fill-column) - '(("inhibit-cider-middleware" "true"))))) - (cider-nrepl-request:eval - ;; Ensure we evaluate _something_ so the initial namespace is correctly set - (thread-first (or cider-repl-init-code '("nil")) - (string-join "\n")) - (cider-repl-init-eval-handler callback) - nil - (line-number-at-pos (point)) - (cider-column-number-at-pos (point)) - (thread-last - request - (map-pairs) - (seq-mapcat #'identity))))) - -(defun cider-repl-init (buffer &optional callback) - "Initialize the REPL in BUFFER. -BUFFER must be a REPL buffer with `cider-repl-mode' and a running -client process connection. CALLBACK will be run once the REPL is -fully initialized." - (when cider-repl-display-in-current-window - (add-to-list 'same-window-buffer-names (buffer-name buffer))) - (pcase cider-repl-pop-to-buffer-on-connect - (`display-only - (let ((orig-buffer (current-buffer))) - (display-buffer buffer) - ;; User popup-rules (specifically `:select nil') can cause the call to - ;; `display-buffer' to reset the current Emacs buffer to the clj/cljs - ;; buffer that the user ran `jack-in' from - we need the current-buffer - ;; to be the repl to initialize, so reset it back here to be resilient - ;; against user config - (set-buffer orig-buffer))) - ((pred identity) (pop-to-buffer buffer))) - (with-current-buffer buffer - (cider-repl--insert-banner) - (cider-repl--insert-startup-commands) - (when-let* ((window (get-buffer-window buffer t))) - (with-selected-window window - (recenter (- -1 scroll-margin)))) - (cider-repl-eval-init-code callback)) - buffer) - -(defun cider-repl--insert-banner () - "Insert the banner in the current REPL buffer." - (insert-before-markers - (propertize (cider-repl--banner) 'font-lock-face 'font-lock-comment-face)) - (when cider-repl-display-help-banner - (insert-before-markers - (propertize (cider-repl--help-banner) 'font-lock-face 'font-lock-comment-face)))) - -(defun cider-repl--insert-startup-commands () - "Insert the values from params specified in PARAM-TUPLES. -PARAM-TUPLES are tuples of (param-key description) or (param-key -description transform) where transform is called with the param-value if -present." - (cl-labels - ((emit-comment - (contents) - (insert-before-markers - (propertize - (if (string-blank-p contents) ";;\n" (concat ";; " contents "\n")) - 'font-lock-face 'font-lock-comment-face)))) - (let ((jack-in-command (plist-get cider-launch-params :jack-in-cmd)) - (cljs-repl-type (plist-get cider-launch-params :cljs-repl-type)) - (cljs-init-form (plist-get cider-launch-params :repl-init-form))) - (when jack-in-command - ;; spaces to align with the banner - (emit-comment (concat " Startup: " jack-in-command))) - (when (or cljs-repl-type cljs-init-form) - (emit-comment "") - (when cljs-repl-type - (emit-comment (concat "ClojureScript REPL type: " (symbol-name cljs-repl-type)))) - (when cljs-init-form - (emit-comment (concat "ClojureScript REPL init form: " cljs-init-form))) - (emit-comment ""))))) - -(defun cider-repl--banner () - "Generate the welcome REPL buffer banner." - (cond - ((cider--clojure-version) (cider-repl--clojure-banner)) - ((cider--babashka-version) (cider-repl--babashka-banner)) - (t (cider-repl--basic-banner)))) - -(defun cider-repl--clojure-banner () - "Generate the welcome REPL buffer banner for Clojure(Script)." - (format ";; Connected to nREPL server - nrepl://%s:%s -;; CIDER %s, nREPL %s -;; Clojure %s, Java %s -;; Docs: (doc function-name) -;; (find-doc part-of-name) -;; Source: (source function-name) -;; Javadoc: (javadoc java-object-or-class) -;; Exit: <C-c C-q> -;; Results: Stored in vars *1, *2, *3, an exception in *e; -" - (plist-get nrepl-endpoint :host) - (plist-get nrepl-endpoint :port) - (cider--version) - (cider--nrepl-version) - (cider--clojure-version) - (cider--java-version))) - -(defun cider-repl--babashka-banner () - "Generate the welcome REPL buffer banner for Babashka." - (format ";; Connected to nREPL server - nrepl://%s:%s -;; CIDER %s, babashka.nrepl %s -;; Babashka %s -;; Docs: (doc function-name) -;; (find-doc part-of-name) -;; Source: (source function-name) -;; Javadoc: (javadoc java-object-or-class) -;; Exit: <C-c C-q> -;; Results: Stored in vars *1, *2, *3, an exception in *e; -" - (plist-get nrepl-endpoint :host) - (plist-get nrepl-endpoint :port) - (cider--version) - (cider--babashka-nrepl-version) - (cider--babashka-version))) - -(defun cider-repl--basic-banner () - "Generate a basic banner with minimal info." - (format ";; Connected to nREPL server - nrepl://%s:%s -;; CIDER %s -" - (plist-get nrepl-endpoint :host) - (plist-get nrepl-endpoint :port) - (cider--version))) - -(defun cider-repl--help-banner () - "Generate the help banner." - (substitute-command-keys - ";; ====================================================================== -;; If you're new to CIDER it is highly recommended to go through its -;; user manual first. Type <M-x cider-view-manual> to view it. -;; In case you're seeing any warnings you should consult the manual's -;; \"Troubleshooting\" section. -;; -;; Here are a few tips to get you started: -;; -;; * Press <\\[describe-mode]> to see a list of the keybindings available (this -;; will work in every Emacs buffer) -;; * Press <\\[cider-repl-handle-shortcut]> to quickly invoke some REPL command -;; * Press <\\[cider-switch-to-last-clojure-buffer]> to switch between the REPL and a Clojure file -;; * Press <\\[cider-find-var]> to jump to the source of something (e.g. a var, a -;; Java method) -;; * Press <\\[cider-doc]> to view the documentation for something (e.g. -;; a var, a Java method) -;; * Print CIDER's refcard and keep it close to your keyboard. -;; -;; CIDER is super customizable - try <M-x customize-group cider> to -;; get a feel for this. If you're thirsty for knowledge you should try -;; <M-x cider-drink-a-sip>. -;; -;; If you think you've encountered a bug (or have some suggestions for -;; improvements) use <M-x cider-report-bug> to report it. -;; -;; Above all else - don't panic! In case of an emergency - procure -;; some (hard) cider and enjoy it responsibly! -;; -;; You can remove this message with the <M-x cider-repl-clear-help-banner> command. -;; You can disable it from appearing on start by setting -;; `cider-repl-display-help-banner' to nil. -;; ====================================================================== -")) - - -;;; REPL interaction - -(defun cider-repl--in-input-area-p () - "Return t if in input area." - (<= cider-repl-input-start-mark (point))) - -(defun cider-repl--current-input (&optional until-point-p) - "Return the current input as string. -The input is the region from after the last prompt to the end of -buffer. If UNTIL-POINT-P is non-nil, the input is until the current -point." - (buffer-substring-no-properties cider-repl-input-start-mark - (if until-point-p - (point) - (point-max)))) - -(defun cider-repl-previous-prompt () - "Move backward to the previous prompt." - (interactive) - (cider-repl--find-prompt t)) - -(defun cider-repl-next-prompt () - "Move forward to the next prompt." - (interactive) - (cider-repl--find-prompt)) - -(defun cider-repl--find-prompt (&optional backward) - "Find the next prompt. -If BACKWARD is non-nil look backward." - (let ((origin (point)) - (cider-repl-prompt-property 'field)) - (while (progn - (cider-search-property-change cider-repl-prompt-property backward) - (not (or (cider-end-of-proprange-p cider-repl-prompt-property) (bobp) (eobp))))) - (unless (cider-end-of-proprange-p cider-repl-prompt-property) - (goto-char origin)))) - -(defun cider-search-property-change (prop &optional backward) - "Search forward for a property change to PROP. -If BACKWARD is non-nil search backward." - (cond (backward - (goto-char (previous-single-char-property-change (point) prop))) - (t - (goto-char (next-single-char-property-change (point) prop))))) - -(defun cider-end-of-proprange-p (property) - "Return t if at the the end of a property range for PROPERTY." - (and (get-char-property (max (point-min) (1- (point))) property) - (not (get-char-property (point) property)))) - -(defun cider-repl--mark-input-start () - "Mark the input start." - (set-marker cider-repl-input-start-mark (point) (current-buffer))) - -(defun cider-repl--mark-output-start () - "Mark the output start." - (set-marker cider-repl-output-start (point)) - (set-marker cider-repl-output-end (point))) - -(defun cider-repl-mode-beginning-of-defun (&optional arg) - "Move to the beginning of defun. -If given a negative value of ARG, move to the end of defun." - (if (and arg (< arg 0)) - (cider-repl-mode-end-of-defun (- arg)) - (dotimes (_ (or arg 1)) - (cider-repl-previous-prompt)))) - -(defun cider-repl-mode-end-of-defun (&optional arg) - "Move to the end of defun. -If given a negative value of ARG, move to the beginning of defun." - (if (and arg (< arg 0)) - (cider-repl-mode-beginning-of-defun (- arg)) - (dotimes (_ (or arg 1)) - (cider-repl-next-prompt)))) - -(defun cider-repl-beginning-of-defun () - "Move to beginning of defun." - (interactive) - ;; We call `beginning-of-defun' if we're at the start of a prompt - ;; already, to trigger `cider-repl-mode-beginning-of-defun' by means - ;; of the locally bound `beginning-of-defun-function', in order to - ;; jump to the start of the previous prompt. - (if (and (not (cider-repl--at-prompt-start-p)) - (cider-repl--in-input-area-p)) - (goto-char cider-repl-input-start-mark) - (beginning-of-defun-raw))) - -(defun cider-repl-end-of-defun () - "Move to end of defun." - (interactive) - ;; C.f. `cider-repl-beginning-of-defun' - (if (and (not (= (point) (point-max))) - (cider-repl--in-input-area-p)) - (goto-char (point-max)) - (end-of-defun))) - -(defun cider-repl-bol-mark () - "Set the mark and go to the beginning of line or the prompt." - (interactive) - (unless mark-active - (set-mark (point))) - (move-beginning-of-line 1)) - -(defun cider-repl--at-prompt-start-p () - "Return t if point is at the start of prompt. -This will not work on non-current prompts." - (= (point) cider-repl-input-start-mark)) - -(defmacro cider-save-marker (marker &rest body) - "Save MARKER and execute BODY." - (declare (debug t)) - (let ((pos (make-symbol "pos"))) - `(let ((,pos (marker-position ,marker))) - (prog1 (progn . ,body) - (set-marker ,marker ,pos))))) - -(put 'cider-save-marker 'lisp-indent-function 1) - -(defun cider-repl-prompt-default (namespace) - "Return a prompt string that mentions NAMESPACE." - (format "%s> " namespace)) - -(defun cider-repl-prompt-abbreviated (namespace) - "Return a prompt string that abbreviates NAMESPACE." - (format "%s> " (cider-abbreviate-ns namespace))) - -(defun cider-repl-prompt-lastname (namespace) - "Return a prompt string with the last name in NAMESPACE." - (format "%s> " (cider-last-ns-segment namespace))) - -(defcustom cider-repl-prompt-function #'cider-repl-prompt-default - "A function that returns a prompt string. -Takes one argument, a namespace name. -For convenience, three functions are already provided for this purpose: -`cider-repl-prompt-lastname', `cider-repl-prompt-abbreviated', and -`cider-repl-prompt-default'." - :type '(choice (const :tag "Full namespace" cider-repl-prompt-default) - (const :tag "Abbreviated namespace" cider-repl-prompt-abbreviated) - (const :tag "Last name in namespace" cider-repl-prompt-lastname) - (function :tag "Custom function")) - :package-version '(cider . "0.9.0")) - -(defun cider-repl--insert-prompt (namespace) - "Insert the prompt (before markers!), taking into account NAMESPACE. -Set point after the prompt. -Return the position of the prompt beginning." - (goto-char cider-repl-input-start-mark) - (cider-save-marker cider-repl-output-start - (cider-save-marker cider-repl-output-end - (unless (bolp) (insert-before-markers "\n")) - (let ((prompt-start (point)) - (prompt (funcall cider-repl-prompt-function namespace))) - (cider-propertize-region - '(font-lock-face cider-repl-prompt-face read-only t intangible t - field cider-repl-prompt - rear-nonsticky (field read-only font-lock-face intangible)) - (insert-before-markers prompt)) - (set-marker cider-repl-prompt-start-mark prompt-start) - prompt-start)))) - -(defun cider-repl--ansi-color-apply (string) - "Like `ansi-color-apply', but does not withhold non-SGR seqs found in STRING. - -Workaround for Emacs bug#53808 whereby partial ANSI control seqs present in -the input stream may block the whole colorization process." - (let* ((result (ansi-color-apply string)) - - ;; The STRING may end with a possible incomplete ANSI control seq which - ;; the call to `ansi-color-apply' stores in the `ansi-color-context' - ;; fragment. If the fragment is not an incomplete ANSI color control - ;; sequence (aka SGR seq) though then flush it out and appended it to - ;; the result. - (fragment-flush? - (when-let (fragment (and ansi-color-context (cadr ansi-color-context))) - (save-match-data - ;; Check if fragment is indeed an SGR seq in the making. The SGR - ;; seq is defined as starting with ESC followed by [ followed by - ;; zero or more [:digit:]+; followed by one or more digits and - ;; ending with m. - (when (string-match - (rx (sequence ?\e - (? (and (or ?\[ eol) - (or (+ (any (?0 . ?9))) eol) - (* (sequence ?\; (+ (any (?0 . ?9))))) - (or ?\; eol))))) - fragment) - (let* ((sgr-end-pos (match-end 0)) - (fragment-matches-whole? (or (= sgr-end-pos 0) - (= sgr-end-pos (length fragment))))) - (when (not fragment-matches-whole?) - ;; Definitely not an partial SGR seq, flush it out of - ;; `ansi-color-context'. - t))))))) - - (if (not fragment-flush?) - result - - (progn - ;; Temporarily replace the ESC char in the fragment so that is flushed - ;; out of `ansi-color-context' by `ansi-color-apply' and append it to - ;; the result. - (aset (cadr ansi-color-context) 0 ?\0) - (let ((result-fragment (ansi-color-apply ""))) - (aset result-fragment 0 ?\e) - (concat result result-fragment)))))) - -(defvar-local cider-repl--ns-forms-plist nil - "Plist holding ns->ns-form mappings within each connection.") - -(defun cider-repl--ns-form-changed-p (ns-form connection) - "Return non-nil if NS-FORM for CONNECTION changed since last eval." - (when-let* ((ns (cider-ns-from-form ns-form))) - (not (string= ns-form - (lax-plist-get - (buffer-local-value 'cider-repl--ns-forms-plist connection) - ns))))) - -(defvar cider-repl--root-ns-highlight-template "\\_<\\(%s\\)[^$/: \t\n()]+" - "Regexp used to highlight root ns in REPL buffers.") - -(defvar-local cider-repl--root-ns-regexp nil - "Cache of root ns regexp in REPLs.") - -(defvar-local cider-repl--ns-roots nil - "List holding all past root namespaces seen during interactive eval.") - -(defun cider-repl--cache-ns-form (ns-form connection) - "Given NS-FORM cache root ns in CONNECTION." - (with-current-buffer connection - (when-let* ((ns (cider-ns-from-form ns-form))) - ;; cache ns-form - (setq cider-repl--ns-forms-plist - (lax-plist-put cider-repl--ns-forms-plist ns ns-form)) - ;; cache ns roots regexp - (when (string-match "\\([^.]+\\)" ns) - (let ((root (match-string-no-properties 1 ns))) - (unless (member root cider-repl--ns-roots) - (push root cider-repl--ns-roots) - (let ((roots (mapconcat - ;; Replace _ or - with regexp pattern to accommodate "raw" namespaces - (lambda (r) (replace-regexp-in-string "[_-]+" "[_-]+" r)) - cider-repl--ns-roots "\\|"))) - (setq cider-repl--root-ns-regexp - (format cider-repl--root-ns-highlight-template roots))))))))) - -(defvar cider-repl-spec-keywords-regexp - (concat - (regexp-opt '("In:" " val:" - " at:" "fails at:" - " spec:" "fails spec:" - " predicate:" "fails predicate:")) - "\\|^" - (regexp-opt '(":clojure.spec.alpha/spec" - ":clojure.spec.alpha/value") - "\\(")) - "Regexp matching clojure.spec `explain` keywords.") - -(defun cider-repl-highlight-spec-keywords (string) - "Highlight clojure.spec `explain` keywords in STRING. -Foreground of `clojure-keyword-face' is used for highlight." - (cider-add-face cider-repl-spec-keywords-regexp - 'clojure-keyword-face t nil string) - string) - -(defun cider-repl-highlight-current-project (string) - "Fontify project's root namespace to make stacktraces more readable. -Foreground of `cider-stacktrace-ns-face' is used to propertize matched -namespaces. STRING is REPL's output." - (cider-add-face cider-repl--root-ns-regexp 'cider-stacktrace-ns-face - t nil string) - string) - -(defun cider-repl-add-locref-help-echo (string) - "Set help-echo property of STRING to `cider-locref-help-echo'." - (put-text-property 0 (length string) 'help-echo 'cider-locref-help-echo string) - string) - -(defvar cider-repl-preoutput-hook `(,(if (< emacs-major-version 29) - 'cider-repl--ansi-color-apply - 'ansi-color-apply) - cider-repl-highlight-current-project - cider-repl-highlight-spec-keywords - cider-repl-add-locref-help-echo) - "Hook run on output string before it is inserted into the REPL buffer. -Each functions takes a string and must return a modified string. Also see -`cider-run-chained-hook'.") - -(defcustom cider-repl-buffer-size-limit nil - "The max size of the REPL buffer. -Setting this to nil removes the limit." - :group 'cider - :type 'integer - :package-version '(cider . "0.26.0")) - -(defun cider-start-of-next-prompt (point) - "Return the position of the first char of the next prompt from POINT." - (let ((next-prompt-or-input (next-single-char-property-change point 'field))) - (if (eq (get-char-property next-prompt-or-input 'field) 'cider-repl-prompt) - next-prompt-or-input - (next-single-char-property-change next-prompt-or-input 'field)))) - -(defun cider-repl-trim-top-of-buffer (buffer) - "Trims REPL output from beginning of BUFFER. -Trims by one fifth of `cider-repl-buffer-size-limit'. -Also clears remaining partial input or results." - (with-current-buffer buffer - (let* ((to-trim (ceiling (* cider-repl-buffer-size-limit 0.2))) - (start-of-next-prompt (cider-start-of-next-prompt to-trim)) - (inhibit-read-only t)) - (cider-repl--clear-region (point-min) start-of-next-prompt)))) - -(defun cider-repl-trim-buffer () - "Trim the currently visited REPL buffer partially from the top. -See also `cider-repl-clear-buffer'." - (interactive) - (if cider-repl-buffer-size-limit - (cider-repl-trim-top-of-buffer (current-buffer)) - (user-error "The variable `cider-repl-buffer-size-limit' is not set"))) - -(defun cider-repl-maybe-trim-buffer (buffer) - "Clear portion of printed output in BUFFER. -Clear the part where `cider-repl-buffer-size-limit' is exceeded." - (when (> (buffer-size) cider-repl-buffer-size-limit) - (cider-repl-trim-top-of-buffer buffer))) - -(defun cider-repl--emit-output (buffer string face) - "Using BUFFER, emit STRING as output font-locked using FACE. -Before inserting, run `cider-repl-preoutput-hook' on STRING." - (with-current-buffer buffer - (save-excursion - (cider-save-marker cider-repl-output-start - (goto-char cider-repl-output-end) - (setq string (propertize string - 'font-lock-face face - 'rear-nonsticky '(font-lock-face))) - (setq string (cider-run-chained-hook 'cider-repl-preoutput-hook string)) - (insert-before-markers string)) - (when (and (= (point) cider-repl-prompt-start-mark) - (not (bolp))) - (insert-before-markers "\n") - (set-marker cider-repl-output-end (1- (point)))))) - (when cider-repl-display-output-before-window-boundaries - ;; FIXME: The code below is super slow, that's why it's disabled by default. - (when-let* ((window (get-buffer-window buffer t))) - ;; If the prompt is on the first line of the window, then scroll the window - ;; down by a single line to make the emitted output visible. - (when (and (pos-visible-in-window-p cider-repl-prompt-start-mark window) - (< 1 cider-repl-prompt-start-mark) - (not (pos-visible-in-window-p (1- cider-repl-prompt-start-mark) window))) - (with-selected-window window - (scroll-down 1)))))) - -(defun cider-repl--emit-interactive-output (string face) - "Emit STRING as interactive output using FACE." - (cider-repl--emit-output (cider-current-repl) string face)) - -(defun cider-repl-emit-interactive-stdout (string) - "Emit STRING as interactive output." - (cider-repl--emit-interactive-output string 'cider-repl-stdout-face)) - -(defun cider-repl-emit-interactive-stderr (string) - "Emit STRING as interactive err output." - (cider-repl--emit-interactive-output string 'cider-repl-stderr-face)) - -(defun cider-repl-emit-stdout (buffer string) - "Using BUFFER, emit STRING as standard output." - (cider-repl--emit-output buffer string 'cider-repl-stdout-face)) - -(defun cider-repl-emit-stderr (buffer string) - "Using BUFFER, emit STRING as error output." - (cider-repl--emit-output buffer string 'cider-repl-stderr-face)) - -(defun cider-repl-emit-prompt (buffer) - "Emit the REPL prompt into BUFFER." - (with-current-buffer buffer - (save-excursion - (cider-repl--insert-prompt cider-buffer-ns)))) - -(defun cider-repl-emit-result (buffer string show-prefix &optional bol) - "Emit into BUFFER the result STRING and mark it as an evaluation result. -If SHOW-PREFIX is non-nil insert `cider-repl-result-prefix' at the beginning -of the line. If BOL is non-nil insert at the beginning of the line." - (with-current-buffer buffer - (save-excursion - (cider-save-marker cider-repl-output-start - (goto-char cider-repl-output-end) - (when (and bol (not (bolp))) - (insert-before-markers "\n")) - (when show-prefix - (insert-before-markers (propertize cider-repl-result-prefix 'font-lock-face 'font-lock-comment-face))) - (if cider-repl-use-clojure-font-lock - (insert-before-markers (cider-font-lock-as-clojure string)) - (cider-propertize-region - '(font-lock-face cider-repl-result-face rear-nonsticky (font-lock-face)) - (insert-before-markers string))))))) - -(defun cider-repl-newline-and-indent () - "Insert a newline, then indent the next line. -Restrict the buffer from the prompt for indentation, to avoid being -confused by strange characters (like unmatched quotes) appearing -earlier in the buffer." - (interactive) - (save-restriction - (narrow-to-region cider-repl-prompt-start-mark (point-max)) - (insert "\n") - (lisp-indent-line))) - -(defun cider-repl-indent-and-complete-symbol () - "Indent the current line and perform symbol completion. -First indent the line. If indenting doesn't move point, complete -the symbol." - (interactive) - (let ((pos (point))) - (lisp-indent-line) - (when (= pos (point)) - (if (save-excursion (re-search-backward "[^() \n\t\r]+\\=" nil t)) - (completion-at-point))))) - -(defun cider-repl-kill-input () - "Kill all text from the prompt to point." - (interactive) - (cond ((< (marker-position cider-repl-input-start-mark) (point)) - (kill-region cider-repl-input-start-mark (point))) - ((= (point) (marker-position cider-repl-input-start-mark)) - (cider-repl-delete-current-input)))) - -(defun cider-repl--input-complete-p (start end) - "Return t if the region from START to END is a complete sexp." - (save-excursion - (goto-char start) - (cond ((looking-at-p "\\s *[@'`#]?[(\"]") - (ignore-errors - (save-restriction - (narrow-to-region start end) - ;; Keep stepping over blanks and sexps until the end of - ;; buffer is reached or an error occurs. Tolerate extra - ;; close parens. - (cl-loop do (skip-chars-forward " \t\r\n)") - until (eobp) - do (forward-sexp)) - t))) - (t t)))) - -(defun cider-repl--display-image (buffer image &optional show-prefix bol) - "Insert IMAGE into BUFFER at the current point. - -For compatibility with the rest of CIDER's REPL machinery, supports -SHOW-PREFIX and BOL." - (with-current-buffer buffer - (save-excursion - (cider-save-marker cider-repl-output-start - (goto-char cider-repl-output-end) - (when (and bol (not (bolp))) - (insert-before-markers "\n")) - (when show-prefix - (insert-before-markers - (propertize cider-repl-result-prefix 'font-lock-face 'font-lock-comment-face))) - ;; The below is inlined from `insert-image' and changed to use - ;; `insert-before-markers' rather than `insert' - (let ((start (point)) - (props (nconc `(display ,image rear-nonsticky (display)) - (when (boundp 'image-map) - `(keymap ,image-map))))) - (insert-before-markers " ") - (add-text-properties start (point) props))))) - t) - -(defcustom cider-repl-image-margin 10 - "Specifies the margin to be applied to images displayed in the REPL. -Either a single number of pixels - interpreted as a symmetric margin, or -pair of numbers `(x . y)' encoding an arbitrary margin." - :type '(choice integer (vector integer integer)) - :package-version '(cider . "0.17.0")) - -(defun cider-repl--image (data type datap) - "A helper for creating images with CIDER's image options. -DATA is either the path to an image or its base64 coded data. TYPE is a -symbol indicating the image type. DATAP indicates whether the image is the -raw image data or a filename. Returns an image instance with a margin per -`cider-repl-image-margin'." - (create-image data type datap - :margin cider-repl-image-margin)) - -(defun cider-repl-handle-jpeg (_type buffer image &optional show-prefix bol) - "A handler for inserting a jpeg IMAGE into a repl BUFFER. -Part of the default `cider-repl-content-type-handler-alist'." - (cider-repl--display-image buffer - (cider-repl--image image 'jpeg t) - show-prefix bol)) - -(defun cider-repl-handle-png (_type buffer image &optional show-prefix bol) - "A handler for inserting a png IMAGE into a repl BUFFER. -Part of the default `cider-repl-content-type-handler-alist'." - (cider-repl--display-image buffer - (cider-repl--image image 'png t) - show-prefix bol)) - -(defun cider-repl-handle-svg (_type buffer image &optional show-prefix bol) - "A handler for inserting an svg IMAGE into a repl BUFFER. -Part of the default `cider-repl-content-type-handler-alist'." - (cider-repl--display-image buffer - (cider-repl--image image 'svg t) - show-prefix bol)) - -(defun cider-repl-handle-external-body (type buffer _ &optional _show-prefix _bol) - "Handler for slurping external content into BUFFER. -Handles an external-body TYPE by issuing a slurp request to fetch the content." - (if-let* ((args (cadr type)) - (access-type (nrepl-dict-get args "access-type"))) - (nrepl-send-request - (list "op" "slurp" "url" (nrepl-dict-get args access-type)) - (cider-repl-handler buffer) - (cider-current-repl))) - nil) - -(defvar cider-repl-content-type-handler-alist - `(("message/external-body" . ,#'cider-repl-handle-external-body) - ("image/jpeg" . ,#'cider-repl-handle-jpeg) - ("image/png" . ,#'cider-repl-handle-png) - ("image/svg+xml" . ,#'cider-repl-handle-svg)) - "Association list from content-types to handlers. -Handlers must be functions of two required and two optional arguments - the -REPL buffer to insert into, the value of the given content type as a raw -string, the REPL's show prefix as any and an `end-of-line' flag. - -The return value of the handler should be a flag, indicating whether or not -the REPL is ready for a prompt to be displayed. Most handlers should return -t, as the content-type response is (currently) an alternative to the -value response. However for handlers which themselves issue subsequent -nREPL ops, it may be convenient to prevent inserting a prompt.") - -(defun cider--maybe-get-state-cljs () - "Invokes `cider/get-state' when it's possible to do so." - (when-let ((conn (cider-current-repl 'cljs))) - (when (nrepl-op-supported-p "cider/get-state" conn) - (nrepl-send-request '("op" "cider/get-state") - (lambda (_response) - ;; No action is necessary: this request results in `cider-repl--state-handler` being called. - ) - conn)))) - -(defun cider--maybe-get-state-for-shadow-cljs (buffer &optional err) - "Refresh the changed namespaces metadata given BUFFER and ERR (stderr string). - -This is particularly necessary for shadow-cljs because: - -* it has a particular nREPL implementation; and -* one may have saved files (which triggers recompilation, - and therefore the need for recomputing changed namespaces) - without sending a nREPL message (this can particularly happen - if the file was edited outside Emacs)." - (with-current-buffer buffer - (when (and (eq cider-repl-type 'cljs) - (eq cider-cljs-repl-type 'shadow) - (not cider-repl-cljs-upgrade-pending) - (if err - (string-match-p "Build completed\\." err) - t)) - (cider--maybe-get-state-cljs)))) - -(defun cider--maybe-get-state-for-figwheel-main (buffer out) - "Refresh the changed namespaces metadata given BUFFER and OUT (stdout string)." - (with-current-buffer buffer - (when (and (eq cider-repl-type 'cljs) - (eq cider-cljs-repl-type 'figwheel-main) - (not cider-repl-cljs-upgrade-pending) - (string-match-p "Successfully compiled build" out)) - (cider--maybe-get-state-cljs)))) - -(defun cider--shadow-cljs-handle-stderr (buffer err) - "Refresh the changed namespaces metadata given BUFFER and ERR." - (cider--maybe-get-state-for-shadow-cljs buffer err)) - -(defun cider--shadow-cljs-handle-done (buffer) - "Refresh the changed namespaces metadata given BUFFER." - (cider--maybe-get-state-for-shadow-cljs buffer)) - -(defvar cider--repl-stdout-functions (list #'cider--maybe-get-state-for-figwheel-main) - "Functions to be invoked each time new stdout is received on a repl buffer. - -Good for, for instance, monitoring specific strings that may be logged, -and responding to them.") - -(defvar cider--repl-stderr-functions (list #'cider--shadow-cljs-handle-stderr) - "Functions to be invoked each time new stderr is received on a repl buffer. - -Good for, for instance, monitoring specific strings that may be logged, -and responding to them.") - -(defvar cider--repl-done-functions (list #'cider--shadow-cljs-handle-done) - "Functions to be invoked each time a given REPL interaction is complete.") - -(defun cider-repl-handler (buffer) - "Make an nREPL evaluation handler for the REPL BUFFER." - (let ((show-prompt t)) - (nrepl-make-response-handler - buffer - (lambda (buffer value) - (cider-repl-emit-result buffer value t)) - (lambda (buffer out) - (dolist (f cider--repl-stdout-functions) - (funcall f buffer out)) - (cider-repl-emit-stdout buffer out)) - (lambda (buffer err) - (dolist (f cider--repl-stderr-functions) - (funcall f buffer err)) - (cider-repl-emit-stderr buffer err)) - (lambda (buffer) - (when show-prompt - (cider-repl-emit-prompt buffer)) - (when cider-repl-buffer-size-limit - (cider-repl-maybe-trim-buffer buffer)) - (dolist (f cider--repl-done-functions) - (funcall f buffer))) - nrepl-err-handler - (lambda (buffer value content-type) - (if-let* ((content-attrs (cadr content-type)) - (content-type* (car content-type)) - (handler (cdr (assoc content-type* - cider-repl-content-type-handler-alist)))) - (setq show-prompt (funcall handler content-type buffer value nil t)) - (cider-repl-emit-result buffer value t t))) - (lambda (buffer warning) - (cider-repl-emit-stderr buffer warning))))) - -(defun cider--repl-request-map (right-margin) - "Map to be merged into REPL eval requests. -RIGHT-MARGIN is as in `cider--nrepl-print-request-map'." - (map-merge 'hash-table - (cider--nrepl-print-request-map right-margin) - (unless cider-repl-use-pretty-printing - '(("nrepl.middleware.print/print" "cider.nrepl.pprint/pr"))) - (when cider-repl-use-content-types - (cider--nrepl-content-type-map)))) - -(defun cider-repl--send-input (&optional newline) - "Go to the end of the input and send the current input. -If NEWLINE is true then add a newline at the end of the input." - (unless (cider-repl--in-input-area-p) - (error "No input at point")) - (let ((input (cider-repl--current-input))) - (if (string-blank-p input) - ;; don't evaluate a blank string, but erase it and emit - ;; a fresh prompt to acknowledge to the user. - (progn - (cider-repl--replace-input "") - (cider-repl-emit-prompt (current-buffer))) - ;; otherwise evaluate the input - (goto-char (point-max)) - (let ((end (point))) ; end of input, without the newline - (cider-repl--add-to-input-history input) - (when newline - (insert "\n")) - (let ((inhibit-modification-hooks t)) - (add-text-properties cider-repl-input-start-mark - (point) - `(cider-old-input - ,(cl-incf cider-repl-old-input-counter)))) - (unless cider-repl-use-clojure-font-lock - (let ((overlay (make-overlay cider-repl-input-start-mark end))) - ;; These properties are on an overlay so that they won't be taken - ;; by kill/yank. - (overlay-put overlay 'read-only t) - (overlay-put overlay 'font-lock-face 'cider-repl-input-face)))) - (let ((input-start (save-excursion (cider-repl-beginning-of-defun) (point)))) - (goto-char (point-max)) - (cider-repl--mark-input-start) - (cider-repl--mark-output-start) - (cider-nrepl-request:eval - input - (cider-repl-handler (current-buffer)) - (cider-current-ns) - (line-number-at-pos input-start) - (cider-column-number-at-pos input-start) - (thread-last - (cider--repl-request-map fill-column) - (map-pairs) - (seq-mapcat #'identity))))))) - -(defun cider-repl-return (&optional end-of-input) - "Evaluate the current input string, or insert a newline. -Send the current input only if a whole expression has been entered, -i.e. the parenthesis are matched. -When END-OF-INPUT is non-nil, send the input even if the parentheses -are not balanced." - (interactive "P") - (cond - (end-of-input - (cider-repl--send-input)) - ((and (get-text-property (point) 'cider-old-input) - (< (point) cider-repl-input-start-mark)) - (cider-repl--grab-old-input end-of-input)) - ((cider-repl--input-complete-p cider-repl-input-start-mark (point-max)) - (cider-repl--send-input t)) - (t - (cider-repl-newline-and-indent) - (message "[input not complete]")))) - -(defun cider-repl--grab-old-input (replace) - "Resend the old REPL input at point. -If REPLACE is non-nil the current input is replaced with the old -input; otherwise the new input is appended. The old input has the -text property `cider-old-input'." - (cl-multiple-value-bind (beg end) (cider-property-bounds 'cider-old-input) - (let ((old-input (buffer-substring beg end)) ;;preserve - ;;properties, they will be removed later - (offset (- (point) beg))) - ;; Append the old input or replace the current input - (cond (replace (goto-char cider-repl-input-start-mark)) - (t (goto-char (point-max)) - (unless (eq (char-before) ?\ ) - (insert " ")))) - (delete-region (point) (point-max)) - (save-excursion - (insert old-input) - (when (equal (char-before) ?\n) - (delete-char -1))) - (forward-char offset)))) - -(defun cider-repl-closing-return () - "Evaluate the current input string after closing input. -Closes all open parentheses or bracketed expressions." - (interactive) - (goto-char (point-max)) - (save-restriction - (narrow-to-region cider-repl-input-start-mark (point)) - (let ((matching-delimiter nil)) - (while (ignore-errors - (save-excursion - (backward-up-list 1) - (setq matching-delimiter (cdr (syntax-after (point))))) - t) - (insert-char matching-delimiter)))) - (cider-repl-return)) - -(defun cider-repl-toggle-pretty-printing () - "Toggle pretty-printing in the REPL." - (interactive) - (setq cider-repl-use-pretty-printing (not cider-repl-use-pretty-printing)) - (message "Pretty printing in REPL %s." - (if cider-repl-use-pretty-printing "enabled" "disabled"))) - -(defun cider-repl-toggle-content-types () - "Toggle content-type rendering in the REPL." - (interactive) - (setq cider-repl-use-content-types (not cider-repl-use-content-types)) - (message "Content-type support in REPL %s." - (if cider-repl-use-content-types "enabled" "disabled"))) - -(defun cider-repl-toggle-clojure-font-lock () - "Toggle pretty-printing in the REPL." - (interactive) - (setq cider-repl-use-clojure-font-lock (not cider-repl-use-clojure-font-lock)) - (message "Clojure font-locking in REPL %s." - (if cider-repl-use-clojure-font-lock "enabled" "disabled"))) - -(defun cider-repl-switch-to-other () - "Switch between the Clojure and ClojureScript REPLs for the current project." - (interactive) - ;; FIXME: implement cycling as session can hold more than two REPLs - (let* ((this-repl (cider-current-repl nil 'ensure)) - (other-repl (car (seq-remove (lambda (r) (eq r this-repl)) (cider-repls nil t))))) - (if other-repl - (switch-to-buffer other-repl) - (user-error "No other REPL in current session (%s)" - (car (sesman-current-session 'CIDER)))))) - -(defvar cider-repl-clear-buffer-hook) - -(defun cider-repl--clear-region (start end) - "Delete the output and its overlays between START and END." - (mapc #'delete-overlay (overlays-in start end)) - (delete-region start end)) - -(defun cider-repl-clear-buffer () - "Clear the currently visited REPL buffer completely. -See also the related commands `cider-repl-clear-output' and -`cider-find-and-clear-repl-output'." - (interactive) - (let ((inhibit-read-only t)) - (cider-repl--clear-region (point-min) cider-repl-prompt-start-mark) - (cider-repl--clear-region cider-repl-output-start cider-repl-output-end) - (when (< (point) cider-repl-input-start-mark) - (goto-char cider-repl-input-start-mark)) - (recenter t)) - (run-hooks 'cider-repl-clear-buffer-hook)) - -(defun cider-repl-clear-output (&optional clear-repl) - "Delete the output inserted since the last input. -With a prefix argument CLEAR-REPL it will clear the entire REPL buffer instead." - (interactive "P") - (if clear-repl - (cider-repl-clear-buffer) - (let ((inhibit-read-only t)) - (cider-repl--clear-region cider-repl-output-start cider-repl-output-end) - (save-excursion - (goto-char cider-repl-output-end) - (insert-before-markers - (propertize ";; output cleared\n" 'font-lock-face 'font-lock-comment-face)))))) - -(defun cider-repl-clear-banners () - "Delete the REPL banners." - (interactive) - ;; TODO: Improve the boundaries detecting logic - ;; probably it should be based on text properties - ;; the current implementation will clear warnings as well - (let ((start (point-min)) - (end (save-excursion - (goto-char (point-min)) - (cider-repl-next-prompt) - (forward-line -1) - (end-of-line) - (point)))) - (when (< start end) - (let ((inhibit-read-only t)) - (cider-repl--clear-region start (1+ end)))))) - -(defun cider-repl-clear-help-banner () - "Delete the help REPL banner." - (interactive) - ;; TODO: Improve the boundaries detecting logic - ;; probably it should be based on text properties - (let ((start (save-excursion - (goto-char (point-min)) - (search-forward ";; =") - (beginning-of-line) - (point))) - (end (save-excursion - (goto-char (point-min)) - (cider-repl-next-prompt) - (search-backward ";; =") - (end-of-line) - (point)))) - (when (< start end) - (let ((inhibit-read-only t)) - (cider-repl--clear-region start (1+ end)))))) - -(defun cider-repl-switch-ns-handler (buffer) - "Make an nREPL evaluation handler for the REPL BUFFER's ns switching." - (nrepl-make-response-handler buffer - (lambda (_buffer _value)) - (lambda (buffer out) - (cider-repl-emit-stdout buffer out)) - (lambda (buffer err) - (cider-repl-emit-stderr buffer err)) - (lambda (buffer) - (cider-repl-emit-prompt buffer)))) - -(defun cider-repl-set-ns (ns) - "Switch the namespace of the REPL buffer to NS. -If called from a cljc buffer act on both the Clojure and ClojureScript REPL -if there are more than one REPL present. If invoked in a REPL buffer the -command will prompt for the name of the namespace to switch to." - (interactive (list (if (or (derived-mode-p 'cider-repl-mode) - (null (cider-ns-form))) - (completing-read "Switch to namespace: " - (cider-sync-request:ns-list)) - (cider-current-ns)))) - (when (or (not ns) (equal ns "")) - (user-error "No namespace selected")) - (cider-map-repls :auto - (lambda (connection) - ;; NOTE: `require' and `in-ns' are special forms in ClojureScript. - ;; That's why we eval them separately instead of combining them with `do'. - (when cider-repl-require-ns-on-set - (cider-sync-tooling-eval (format "(require '%s)" ns) nil connection)) - (let ((f (if (equal 'cljs - (with-current-buffer connection - cider-repl-type)) - ;; For cljs, don't use cider-tooling-eval, because Piggieback will later change the ns (issue #3503): - #'cider-nrepl-request:eval - ;; When possible, favor cider-tooling-eval because it preserves *1, etc (commit 5f705b): - #'cider-tooling-eval))) - (funcall f (format "(in-ns '%s)" ns) - (cider-repl-switch-ns-handler connection)))))) - - -;;; Location References - -(defcustom cider-locref-regexp-alist - '((stdout-stacktrace "[ \t]\\(at \\([^$(]+\\).*(\\([^:()]+\\):\\([0-9]+\\))\\)" 1 2 3 4) - (aviso-stacktrace "^[ \t]*\\(\\([^$/ \t]+\\).*? +\\([^:]+\\): +\\([0-9]+\\)\\)" 1 2 3 4) - (print-stacktrace "\\[\\([^][$ \t]+\\).* +\\([^ \t]+\\) +\\([0-9]+\\)\\]" 0 1 2 3) - (timbre-log "\\(TRACE\\|INFO\\|DEBUG\\|WARN\\|ERROR\\) +\\(\\[\\([^:]+\\):\\([0-9]+\\)\\]\\)" 2 3 nil 4) - (cljs-message "at line \\([0-9]+\\) +\\(.*\\)$" 0 nil 2 1) - (warning "warning,? +\\(\\([^\n:]+\\):\\([0-9]+\\):[0-9]+\\)" 1 nil 2 3) - (compilation ".*compiling:(\\([^\n:)]+\\):\\([0-9]+\\):[0-9]+)" 0 nil 1 2)) - "Alist holding regular expressions for inline location references. -Each element in the alist has the form (NAME REGEXP HIGHLIGHT VAR FILE -LINE), where NAME is the identifier of the regexp, REGEXP - regexp matching -a location, HIGHLIGHT - sub-expression matching region to highlight on -mouse-over, VAR - sub-expression giving Clojure VAR to look up. FILE is -currently only used when VAR is nil and must be full resource path in that -case." - :type '(alist :key-type sexp) - :package-version '(cider. "0.16.0")) - -(defun cider--locref-at-point-1 (reg-list) - "Workhorse for getting locref at point. -REG-LIST is an entry in `cider-locref-regexp-alist'." - (beginning-of-line) - (when (re-search-forward (nth 1 reg-list) (point-at-eol) t) - (let ((ix-highlight (or (nth 2 reg-list) 0)) - (ix-var (nth 3 reg-list)) - (ix-file (nth 4 reg-list)) - (ix-line (nth 5 reg-list))) - (list - :type (car reg-list) - :highlight (cons (match-beginning ix-highlight) (match-end ix-highlight)) - :var (and ix-var - (replace-regexp-in-string "_" "-" - (match-string-no-properties ix-var) - nil t)) - :file (and ix-file (match-string-no-properties ix-file)) - :line (and ix-line (string-to-number (match-string-no-properties ix-line))))))) - -(defun cider-locref-at-point (&optional pos) - "Return a plist of components of the location reference at POS. -Limit search to current line only and return nil if no location has been -found. Returned keys are :type, :highlight, :var, :file, :line, where -:highlight is a cons of positions, :var and :file are strings or nil, :line -is a number. See `cider-locref-regexp-alist' for how to specify regexes -for locref look up." - (save-excursion - (goto-char (or pos (point))) - ;; Regexp lookup on long lines can result in significant hangs #2532. We - ;; assume that lines longer than 300 don't contain source references. - (when (< (- (point-at-eol) (point-at-bol)) 300) - (seq-some (lambda (rl) (cider--locref-at-point-1 rl)) - cider-locref-regexp-alist)))) - -(defun cider-jump-to-locref-at-point (&optional pos) - "Identify location reference at POS and navigate to it. -This function is used from help-echo property inside REPL buffers and uses -regexes from `cider-locref-regexp-alist' to infer locations at point." - (interactive) - (if-let* ((loc (cider-locref-at-point pos))) - (let* ((var (plist-get loc :var)) - (line (plist-get loc :line)) - (file (or - ;; 1) retrieve from info middleware - (when var - (or (cider-sync-request:ns-path var) - (nrepl-dict-get (cider-sync-request:info var) "file"))) - (when-let* ((file (plist-get loc :file))) - ;; 2) file detected by the regexp - (let ((file-from-regexp (if (file-name-absolute-p file) - file - ;; when not absolute, expand within the current project - (when-let* ((proj (clojure-project-dir))) - (expand-file-name file proj))))) - (or (when (file-readable-p file-from-regexp) - file-from-regexp) - ;; 3) infer ns from the abbreviated path - ;; (common in reflection warnings) - (let ((ns (cider-path-to-ns file))) - (cider-sync-request:ns-path ns)))))))) - (if file - (cider--jump-to-loc-from-info (nrepl-dict "file" file "line" line) t) - (error "No source location for %s - you may need to adjust `cider-locref-regexp-alist' to match your logging format" var))) - (user-error "No location reference at point"))) - -(defvar cider-locref-hoover-overlay - (let ((o (make-overlay 1 1))) - (overlay-put o 'category 'cider-error-hoover) - ;; (overlay-put o 'face 'highlight) - (overlay-put o 'pointer 'hand) - (overlay-put o 'mouse-face 'highlight) - (overlay-put o 'follow-link 'mouse) - (overlay-put o 'keymap - (let ((map (make-sparse-keymap))) - (define-key map [return] #'cider-jump-to-locref-at-point) - (define-key map [mouse-2] #'cider-jump-to-locref-at-point) - map)) - o) - "Overlay used during hoovering on location references in REPL buffers. -One for all REPLs.") - -(defun cider-locref-help-echo (_win buffer pos) - "Function for help-echo property in REPL buffers. -WIN, BUFFER and POS are the window, buffer and point under mouse position." - (with-current-buffer buffer - (if-let* ((hl (plist-get (cider-locref-at-point pos) :highlight))) - (move-overlay cider-locref-hoover-overlay (car hl) (cdr hl) buffer) - (delete-overlay cider-locref-hoover-overlay)) - nil)) - - -;;; History - -(defcustom cider-repl-wrap-history nil - "T to wrap history around when the end is reached." - :type 'boolean) - -;; These two vars contain the state of the last history search. We -;; only use them if `last-command' was `cider-repl--history-replace', -;; otherwise we reinitialize them. - -(defvar cider-repl-input-history-position -1 - "Newer items have smaller indices.") - -(defvar cider-repl-history-pattern nil - "The regexp most recently used for finding input history.") - -(defun cider-repl--add-to-input-history (string) - "Add STRING to the input history. -Empty strings and duplicates are ignored." - (unless (or (equal string "") - (equal string (car cider-repl-input-history))) - (push string cider-repl-input-history) - (cl-incf cider-repl-input-history-items-added))) - -(defun cider-repl-delete-current-input () - "Delete all text after the prompt." - (goto-char (point-max)) - (delete-region cider-repl-input-start-mark (point-max))) - -(defun cider-repl--replace-input (string) - "Replace the current REPL input with STRING." - (cider-repl-delete-current-input) - (insert-and-inherit string)) - -(defun cider-repl--position-in-history (start-pos direction regexp) - "Return the position of the history item starting at START-POS. -Search in DIRECTION for REGEXP. -Return -1 resp the length of the history if no item matches." - ;; Loop through the history list looking for a matching line - (let* ((step (cl-ecase direction - (forward -1) - (backward 1))) - (history cider-repl-input-history) - (len (length history))) - (cl-loop for pos = (+ start-pos step) then (+ pos step) - if (< pos 0) return -1 - if (<= len pos) return len - if (string-match-p regexp (nth pos history)) return pos))) - -(defun cider-repl--history-replace (direction &optional regexp) - "Replace the current input with the next line in DIRECTION. -DIRECTION is 'forward' or 'backward' (in the history list). -If REGEXP is non-nil, only lines matching REGEXP are considered." - (setq cider-repl-history-pattern regexp) - (let* ((min-pos -1) - (max-pos (length cider-repl-input-history)) - (pos0 (cond ((cider-history-search-in-progress-p) - cider-repl-input-history-position) - (t min-pos))) - (pos (cider-repl--position-in-history pos0 direction (or regexp ""))) - (msg nil)) - (cond ((and (< min-pos pos) (< pos max-pos)) - (cider-repl--replace-input (nth pos cider-repl-input-history)) - (setq msg (format "History item: %d" pos))) - ((not cider-repl-wrap-history) - (setq msg (cond ((= pos min-pos) "End of history") - ((= pos max-pos) "Beginning of history")))) - (cider-repl-wrap-history - (setq pos (if (= pos min-pos) max-pos min-pos)) - (setq msg "Wrapped history"))) - (when (or (<= pos min-pos) (<= max-pos pos)) - (when regexp - (setq msg (concat msg "; no matching item")))) - (message "%s%s" msg (cond ((not regexp) "") - (t (format "; current regexp: %s" regexp)))) - (setq cider-repl-input-history-position pos) - (setq this-command 'cider-repl--history-replace))) - -(defun cider-history-search-in-progress-p () - "Return t if a current history search is in progress." - (eq last-command 'cider-repl--history-replace)) - -(defun cider-terminate-history-search () - "Terminate the current history search." - (setq last-command this-command)) - -(defun cider-repl-previous-input () - "Cycle backwards through input history. -If the `last-command' was a history navigation command use the -same search pattern for this command. -Otherwise use the current input as search pattern." - (interactive) - (cider-repl--history-replace 'backward (cider-repl-history-pattern t))) - -(defun cider-repl-next-input () - "Cycle forwards through input history. -See `cider-previous-input'." - (interactive) - (cider-repl--history-replace 'forward (cider-repl-history-pattern t))) - -(defun cider-repl-forward-input () - "Cycle forwards through input history." - (interactive) - (cider-repl--history-replace 'forward (cider-repl-history-pattern))) - -(defun cider-repl-backward-input () - "Cycle backwards through input history." - (interactive) - (cider-repl--history-replace 'backward (cider-repl-history-pattern))) - -(defun cider-repl-previous-matching-input (regexp) - "Find the previous input matching REGEXP." - (interactive "sPrevious element matching (regexp): ") - (cider-terminate-history-search) - (cider-repl--history-replace 'backward regexp)) - -(defun cider-repl-next-matching-input (regexp) - "Find then next input matching REGEXP." - (interactive "sNext element matching (regexp): ") - (cider-terminate-history-search) - (cider-repl--history-replace 'forward regexp)) - -(defun cider-repl-history-pattern (&optional use-current-input) - "Return the regexp for the navigation commands. -If USE-CURRENT-INPUT is non-nil, use the current input." - (cond ((cider-history-search-in-progress-p) - cider-repl-history-pattern) - (use-current-input - (cl-assert (<= cider-repl-input-start-mark (point))) - (let ((str (cider-repl--current-input t))) - (cond ((string-match-p "^[ \n]*$" str) nil) - (t (concat "^" (regexp-quote str)))))) - (t nil))) - -;;; persistent history -(defcustom cider-repl-history-size 500 - "The maximum number of items to keep in the REPL history." - :type 'integer - :safe #'integerp) - -(defcustom cider-repl-history-file nil - "File to save the persistent REPL history to." - :type 'string - :safe #'stringp) - -(defun cider-repl--history-read-filename () - "Ask the user which file to use, defaulting `cider-repl-history-file'." - (read-file-name "Use CIDER REPL history file: " - cider-repl-history-file)) - -(defun cider-repl--history-read (filename) - "Read history from FILENAME and return it. -It does not yet set the input history." - (if (file-readable-p filename) - (with-temp-buffer - (insert-file-contents filename) - (when (> (buffer-size (current-buffer)) 0) - (read (current-buffer)))) - '())) - -(defun cider-repl-history-load (&optional filename) - "Load history from FILENAME into current session. -FILENAME defaults to the value of `cider-repl-history-file' but user -defined filenames can be used to read special history files. - -The value of `cider-repl-input-history' is set by this function." - (interactive (list (cider-repl--history-read-filename))) - (let ((f (or filename cider-repl-history-file))) - ;; TODO: probably need to set cider-repl-input-history-position as well. - ;; in a fresh connection the newest item in the list is currently - ;; not available. After sending one input, everything seems to work. - (setq cider-repl-input-history (cider-repl--history-read f)))) - -(defun cider-repl--history-write (filename) - "Write history to FILENAME. -Currently coding system for writing the contents is hardwired to -utf-8-unix." - (let* ((mhist (cider-repl--histories-merge cider-repl-input-history - cider-repl-input-history-items-added - (cider-repl--history-read filename))) - ;; newest items are at the beginning of the list, thus 0 - (hist (cl-subseq mhist 0 (min (length mhist) cider-repl-history-size)))) - (unless (file-writable-p filename) - (error (format "History file not writable: %s" filename))) - (let ((print-length nil) (print-level nil)) - (with-temp-file filename - ;; TODO: really set cs for output - ;; TODO: does cs need to be customizable? - (insert ";; -*- coding: utf-8-unix -*-\n") - (insert ";; Automatically written history of CIDER REPL session\n") - (insert ";; Edit at your own risk\n\n") - (prin1 (mapcar #'substring-no-properties hist) (current-buffer)))))) - -(defun cider-repl-history-save (&optional filename) - "Save the current REPL input history to FILENAME. -FILENAME defaults to the value of `cider-repl-history-file'." - (interactive (list (cider-repl--history-read-filename))) - (let* ((file (or filename cider-repl-history-file))) - (cider-repl--history-write file))) - -(defun cider-repl-history-just-save () - "Just save the history to `cider-repl-history-file'. -This function is meant to be used in hooks to avoid lambda -constructs." - (cider-repl-history-save cider-repl-history-file)) - -;; SLIME has different semantics and will not save any duplicates. -;; we keep track of how many items were added to the history in the -;; current session in `cider-repl--add-to-input-history' and merge only the -;; new items with the current history found in the file, which may -;; have been changed in the meantime by another session. -(defun cider-repl--histories-merge (session-hist n-added-items file-hist) - "Merge histories from SESSION-HIST adding N-ADDED-ITEMS into FILE-HIST." - (append (cl-subseq session-hist 0 n-added-items) - file-hist)) - - -;;; REPL shortcuts -(defcustom cider-repl-shortcut-dispatch-char ?\, - "Character used to distinguish REPL commands from Lisp forms." - :type '(character)) - -(defvar cider-repl-shortcuts (make-hash-table :test 'equal)) - -(defun cider-repl-add-shortcut (name handler) - "Add a REPL shortcut command, defined by NAME and HANDLER." - (puthash name handler cider-repl-shortcuts)) - -(declare-function cider-toggle-trace-ns "cider-tracing") -(declare-function cider-undef "cider-eval") -(declare-function cider-browse-ns "cider-browse-ns") -(declare-function cider-classpath "cider-classpath") -(declare-function cider-repl-history "cider-repl-history") -(declare-function cider-run "cider-mode") -(declare-function cider-ns-refresh "cider-ns") -(declare-function cider-ns-reload "cider-ns") -(declare-function cider-find-var "cider-find") -(declare-function cider-version "cider") -(declare-function cider-test-run-loaded-tests "cider-test") -(declare-function cider-test-run-project-tests "cider-test") -(declare-function cider-sideloader-start "cider-eval") -(cider-repl-add-shortcut "clear-output" #'cider-repl-clear-output) -(cider-repl-add-shortcut "clear" #'cider-repl-clear-buffer) -(cider-repl-add-shortcut "clear-banners" #'cider-repl-clear-banners) -(cider-repl-add-shortcut "clear-help-banner" #'cider-repl-clear-help-banner) -(cider-repl-add-shortcut "trim" #'cider-repl-trim-buffer) -(cider-repl-add-shortcut "ns" #'cider-repl-set-ns) -(cider-repl-add-shortcut "toggle-pprint" #'cider-repl-toggle-pretty-printing) -(cider-repl-add-shortcut "toggle-font-lock" #'cider-repl-toggle-clojure-font-lock) -(cider-repl-add-shortcut "toggle-content-types" #'cider-repl-toggle-content-types) -(cider-repl-add-shortcut "browse-ns" (lambda () (interactive) (cider-browse-ns (cider-current-ns)))) -(cider-repl-add-shortcut "classpath" #'cider-classpath) -(cider-repl-add-shortcut "history" #'cider-repl-history) -(cider-repl-add-shortcut "trace-ns" #'cider-toggle-trace-ns) -(cider-repl-add-shortcut "sideloader-start" #'cider-sideloader-start) -(cider-repl-add-shortcut "undef" #'cider-undef) -(cider-repl-add-shortcut "refresh" #'cider-ns-refresh) -(cider-repl-add-shortcut "reload" #'cider-ns-reload) -(cider-repl-add-shortcut "find-var" #'cider-find-var) -(cider-repl-add-shortcut "doc" #'cider-doc) -(cider-repl-add-shortcut "help" #'cider-repl-shortcuts-help) -(cider-repl-add-shortcut "test-ns" #'cider-test-run-ns-tests) -(cider-repl-add-shortcut "test-all" #'cider-test-run-loaded-tests) -(cider-repl-add-shortcut "test-project" #'cider-test-run-project-tests) -(cider-repl-add-shortcut "test-ns-with-filters" #'cider-test-run-ns-tests-with-filters) -(cider-repl-add-shortcut "test-all-with-filters" (lambda () (interactive) (cider-test-run-loaded-tests 'prompt-for-filters))) -(cider-repl-add-shortcut "test-project-with-filters" (lambda () (interactive) (cider-test-run-project-tests 'prompt-for-filters))) -(cider-repl-add-shortcut "test-report" #'cider-test-show-report) -(cider-repl-add-shortcut "run" #'cider-run) -(cider-repl-add-shortcut "conn-info" #'cider-describe-connection) -(cider-repl-add-shortcut "version" #'cider-version) -(cider-repl-add-shortcut "require-repl-utils" #'cider-repl-require-repl-utils) -;; So many ways to quit :-) -(cider-repl-add-shortcut "adios" #'cider-quit) -(cider-repl-add-shortcut "sayonara" #'cider-quit) -(cider-repl-add-shortcut "quit" #'cider-quit) -(cider-repl-add-shortcut "restart" #'cider-restart) - -(defconst cider-repl-shortcuts-help-buffer "*CIDER REPL Shortcuts Help*") - -(defun cider-repl-shortcuts-help () - "Display a help buffer." - (interactive) - (ignore-errors (kill-buffer cider-repl-shortcuts-help-buffer)) - (with-current-buffer (get-buffer-create cider-repl-shortcuts-help-buffer) - (insert "CIDER REPL shortcuts:\n\n") - (maphash (lambda (k v) (insert (format "%s:\n\t%s\n" k v))) cider-repl-shortcuts) - (goto-char (point-min)) - (help-mode) - (display-buffer (current-buffer) t)) - (cider-repl-handle-shortcut) - (current-buffer)) - -(defun cider-repl--available-shortcuts () - "Return the available REPL shortcuts." - (cider-util--hash-keys cider-repl-shortcuts)) - -(defun cider-repl-handle-shortcut () - "Execute a REPL shortcut." - (interactive) - (if (> (point) cider-repl-input-start-mark) - (insert (string cider-repl-shortcut-dispatch-char)) - (let ((command (completing-read "Command: " - (cider-repl--available-shortcuts)))) - (if (not (equal command "")) - (let ((command-func (gethash command cider-repl-shortcuts))) - (if command-func - (call-interactively command-func) - (error "Unknown command %S. Available commands: %s" - command-func - (mapconcat #'identity (cider-repl--available-shortcuts) ", ")))) - (error "No command selected"))))) - -(defun cider--sesman-friendly-session-p (session &optional debug) - "Check if SESSION is a friendly session, DEBUG optionally. - -The checking is done as follows: - -* If the current buffer's name equals to the value of `cider-test-report-buffer', - only accept the given session's repl if it equals `cider-test--current-repl' -* Consider if the buffer belongs to `cider-ancillary-buffers' -* Consider the buffer's filename, strip any Docker/TRAMP details from it -* Check if that filename belongs to the classpath, - or to the classpath roots (e.g. the project root dir) -* As a fallback, check if the buffer's ns form - matches any of the loaded namespaces." - (setcdr session (seq-filter #'buffer-live-p (cdr session))) - (when-let ((repl (cadr session))) - (cond - ((equal (buffer-name) - cider-test-report-buffer) - (or (not cider-test--current-repl) - (not (buffer-live-p cider-test--current-repl)) - (equal repl - cider-test--current-repl))) - - ((member (buffer-name) cider-ancillary-buffers) - t) - - (t - (when-let* ((proc (get-buffer-process repl)) - (file (file-truename (or (buffer-file-name) default-directory)))) - ;; With avfs paths look like /path/to/.avfs/path/to/some.jar#uzip/path/to/file.clj - (when (string-match-p "#uzip" file) - (let ((avfs-path (directory-file-name (expand-file-name (or (getenv "AVFSBASE") "~/.avfs/"))))) - (setq file (replace-regexp-in-string avfs-path "" file t t)))) - (when-let ((tp (cider-tramp-prefix (current-buffer)))) - (setq file (string-remove-prefix tp file))) - (when (process-live-p proc) - (let* ((classpath (or (process-get proc :cached-classpath) - (let ((cp (with-current-buffer repl - (cider-classpath-entries)))) - (process-put proc :cached-classpath cp) - cp))) - (ns-list (when (nrepl-op-supported-p "ns-list" repl) - (or (process-get proc :all-namespaces) - (let ((ns-list (with-current-buffer repl - (cider-sync-request:ns-list)))) - (process-put proc :all-namespaces ns-list) - ns-list)))) - (classpath-roots (or (process-get proc :cached-classpath-roots) - (let ((cp (thread-last classpath - (seq-filter (lambda (path) (not (string-match-p "\\.jar$" path)))) - (mapcar #'file-name-directory) - (seq-remove #'null) - (seq-uniq)))) - (process-put proc :cached-classpath-roots cp) - cp)))) - (or (seq-find (lambda (path) (string-prefix-p path file)) - classpath) - (seq-find (lambda (path) (string-prefix-p path file)) - classpath-roots) - (when-let* ((cider-path-translations (cider--all-path-translations)) - (translated (cider--translate-path file 'to-nrepl :return-all))) - (seq-find (lambda (translated-path) - (or (seq-find (lambda (path) - (string-prefix-p path translated-path)) - classpath) - (seq-find (lambda (path) - (string-prefix-p path translated-path)) - classpath-roots))) - translated)) - (when-let ((ns (condition-case nil - (substring-no-properties (cider-current-ns :no-default - ;; important - don't query the repl, - ;; avoiding a recursive invocation of `cider--sesman-friendly-session-p`: - :no-repl-check)) - (error nil)))) - ;; if the ns form matches with a ns of all runtime namespaces, we can consider the buffer to match - ;; (this is a bit lax, but also quite useful) - (with-current-buffer repl - (or (when cider-repl-ns-cache ;; may be nil on repl startup - (member ns (nrepl-dict-keys cider-repl-ns-cache))) - (member ns ns-list)))) - (when debug - (list file "was not determined to belong to classpath:" classpath "or classpath-roots:" classpath-roots)))))))))) - -(defun cider-debug-sesman-friendly-session-p () - "`message's debugging information relative to friendly sessions. - -This is useful for when one sees 'No linked CIDER sessions' -in an unexpected place." - (interactive) - (message (prin1-to-string (mapcar (lambda (session) - (cider--sesman-friendly-session-p session t)) - (sesman--all-system-sessions 'CIDER))))) - -(cl-defmethod sesman-friendly-session-p ((_system (eql CIDER)) session) - "Check if SESSION is a friendly session." - (cider--sesman-friendly-session-p session)) - - -;;;;; CIDER REPL mode -(defvar cider-repl-mode-hook nil - "Hook executed when entering `cider-repl-mode'.") - -(defvar cider-repl-mode-syntax-table - (copy-syntax-table clojure-mode-syntax-table)) - -(declare-function cider-eval-last-sexp "cider-eval") -(declare-function cider-toggle-trace-ns "cider-tracing") -(declare-function cider-toggle-trace-var "cider-tracing") -(declare-function cider-find-resource "cider-find") -(declare-function cider-find-ns "cider-find") -(declare-function cider-find-keyword "cider-find") -(declare-function cider-find-var "cider-find") -(declare-function cider-switch-to-last-clojure-buffer "cider-mode") -(declare-function cider-macroexpand-1 "cider-macroexpansion") -(declare-function cider-macroexpand-all "cider-macroexpansion") -(declare-function cider-selector "cider-selector") -(declare-function cider-jack-in-clj "cider") -(declare-function cider-jack-in-cljs "cider") -(declare-function cider-connect-clj "cider") -(declare-function cider-connect-cljs "cider") - -(defvar cider-repl-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-c C-d") 'cider-doc-map) - (define-key map (kbd "C-c ,") 'cider-test-commands-map) - (define-key map (kbd "C-c C-t") 'cider-test-commands-map) - (define-key map (kbd "M-.") #'cider-find-var) - (define-key map (kbd "C-c C-.") #'cider-find-ns) - (define-key map (kbd "C-c C-:") #'cider-find-keyword) - (define-key map (kbd "M-,") #'cider-pop-back) - (define-key map (kbd "C-c M-.") #'cider-find-resource) - (define-key map (kbd "RET") #'cider-repl-return) - (define-key map (kbd "TAB") #'cider-repl-tab) - (define-key map (kbd "C-<return>") #'cider-repl-closing-return) - (define-key map (kbd "C-j") #'cider-repl-newline-and-indent) - (define-key map (kbd "C-c C-o") #'cider-repl-clear-output) - (define-key map (kbd "C-c M-n") #'cider-repl-set-ns) - (define-key map (kbd "C-c C-u") #'cider-repl-kill-input) - (define-key map (kbd "C-S-a") #'cider-repl-bol-mark) - (define-key map [S-home] #'cider-repl-bol-mark) - (define-key map (kbd "C-<up>") #'cider-repl-backward-input) - (define-key map (kbd "C-<down>") #'cider-repl-forward-input) - (define-key map (kbd "M-p") #'cider-repl-previous-input) - (define-key map (kbd "M-n") #'cider-repl-next-input) - (define-key map (kbd "M-r") #'cider-repl-previous-matching-input) - (define-key map (kbd "M-s") #'cider-repl-next-matching-input) - (define-key map (kbd "C-c C-n") #'cider-repl-next-prompt) - (define-key map (kbd "C-c C-p") #'cider-repl-previous-prompt) - (define-key map (kbd "C-c C-b") #'cider-interrupt) - (define-key map (kbd "C-c C-c") #'cider-interrupt) - (define-key map (kbd "C-c C-m") #'cider-macroexpand-1) - (define-key map (kbd "C-c M-m") #'cider-macroexpand-all) - (define-key map (kbd "C-c C-s") #'sesman-map) - (define-key map (kbd "C-c C-z") #'cider-switch-to-last-clojure-buffer) - (define-key map (kbd "C-c M-o") #'cider-repl-switch-to-other) - (define-key map (kbd "C-c M-s") #'cider-selector) - (define-key map (kbd "C-c M-d") #'cider-describe-connection) - (define-key map (kbd "C-c C-q") #'cider-quit) - (define-key map (kbd "C-c M-r") #'cider-restart) - (define-key map (kbd "C-c M-i") #'cider-inspect) - (define-key map (kbd "C-c M-p") #'cider-repl-history) - (define-key map (kbd "C-c M-t v") #'cider-toggle-trace-var) - (define-key map (kbd "C-c M-t n") #'cider-toggle-trace-ns) - (define-key map (kbd "C-c C-x") 'cider-start-map) - (define-key map (kbd "C-x C-e") #'cider-eval-last-sexp) - (define-key map (kbd "C-c C-r") 'clojure-refactor-map) - (define-key map (kbd "C-c C-v") 'cider-eval-commands-map) - (define-key map (kbd "C-c M-j") #'cider-jack-in-clj) - (define-key map (kbd "C-c M-J") #'cider-jack-in-cljs) - (define-key map (kbd "C-c M-c") #'cider-connect-clj) - (define-key map (kbd "C-c M-C") #'cider-connect-cljs) - - (define-key map (string cider-repl-shortcut-dispatch-char) #'cider-repl-handle-shortcut) - (easy-menu-define cider-repl-mode-menu map - "Menu for CIDER's REPL mode" - `("REPL" - ["Complete symbol" complete-symbol] - "--" - ,cider-doc-menu - "--" - ("Find" - ["Find definition" cider-find-var] - ["Find namespace" cider-find-ns] - ["Find resource" cider-find-resource] - ["Find keyword" cider-find-keyword] - ["Go back" cider-pop-back]) - "--" - ["Switch to Clojure buffer" cider-switch-to-last-clojure-buffer] - ["Switch to other REPL" cider-repl-switch-to-other] - "--" - ("Macroexpand" - ["Macroexpand-1" cider-macroexpand-1] - ["Macroexpand-all" cider-macroexpand-all]) - "--" - ,cider-test-menu - "--" - ["Run project (-main function)" cider-run] - ["Inspect" cider-inspect] - ["Toggle var tracing" cider-toggle-trace-var] - ["Toggle ns tracing" cider-toggle-trace-ns] - ["Refresh loaded code" cider-ns-refresh] - "--" - ["Set REPL ns" cider-repl-set-ns] - ["Toggle pretty printing" cider-repl-toggle-pretty-printing] - ["Toggle Clojure font-lock" cider-repl-toggle-clojure-font-lock] - ["Toggle rich content types" cider-repl-toggle-content-types] - ["Require REPL utils" cider-repl-require-repl-utils] - "--" - ["Browse classpath" cider-classpath] - ["Browse classpath entry" cider-open-classpath-entry] - ["Browse namespace" cider-browse-ns] - ["Browse all namespaces" cider-browse-ns-all] - ["Browse spec" cider-browse-spec] - ["Browse all specs" cider-browse-spec-all] - "--" - ["Next prompt" cider-repl-next-prompt] - ["Previous prompt" cider-repl-previous-prompt] - ["Clear output" cider-repl-clear-output] - ["Clear buffer" cider-repl-clear-buffer] - ["Trim buffer" cider-repl-trim-buffer] - ["Clear banners" cider-repl-clear-banners] - ["Clear help banner" cider-repl-clear-help-banner] - ["Kill input" cider-repl-kill-input] - "--" - ["Interrupt evaluation" cider-interrupt] - "--" - ["Connection info" cider-describe-connection] - "--" - ["Close ancillary buffers" cider-close-ancillary-buffers] - ["Quit" cider-quit] - ["Restart" cider-restart] - "--" - ["Clojure Cheatsheet" cider-cheatsheet] - "--" - ["A sip of CIDER" cider-drink-a-sip] - ["View user manual" cider-view-manual] - ["View quick reference card" cider-view-refcard] - ["Report a bug" cider-report-bug] - ["Version info" cider-version])) - map)) - -(sesman-install-menu cider-repl-mode-map) - -(defun cider-repl-wrap-fontify-function (func) - "Return a function that will call FUNC narrowed to input region." - (lambda (beg end &rest rest) - (when (and cider-repl-input-start-mark - (> end cider-repl-input-start-mark)) - (save-restriction - (narrow-to-region cider-repl-input-start-mark (point-max)) - (let ((font-lock-dont-widen t)) - (apply func (max beg cider-repl-input-start-mark) end rest)))))) - -(declare-function cider-complete-at-point "cider-completion") -(defvar cider--static-font-lock-keywords) - -(defun cider-repl-setup-paredit () - "Override the paredit-RET binding in cider-repl-mode." - (let ((oldmap (cdr (assoc 'paredit-mode minor-mode-map-alist))) - (newmap (make-sparse-keymap))) - (set-keymap-parent newmap oldmap) - (define-key newmap (kbd "RET") nil) - (make-local-variable 'minor-mode-overriding-map-alist) - (push `(paredit-mode . ,newmap) minor-mode-overriding-map-alist))) - -(define-derived-mode cider-repl-mode fundamental-mode "REPL" - "Major mode for Clojure REPL interactions. - -\\{cider-repl-mode-map}" - (clojure-mode-variables) - (clojure-font-lock-setup) - (font-lock-add-keywords nil cider--static-font-lock-keywords) - (setq-local sesman-system 'CIDER) - (setq-local font-lock-fontify-region-function - (cider-repl-wrap-fontify-function font-lock-fontify-region-function)) - (setq-local font-lock-unfontify-region-function - (cider-repl-wrap-fontify-function font-lock-unfontify-region-function)) - (set-syntax-table cider-repl-mode-syntax-table) - (cider-eldoc-setup) - ;; At the REPL, we define beginning-of-defun and end-of-defun to be - ;; the start of the previous prompt or next prompt respectively. - ;; Notice the interplay with `cider-repl-beginning-of-defun'. - (setq-local beginning-of-defun-function #'cider-repl-mode-beginning-of-defun) - (setq-local end-of-defun-function #'cider-repl-mode-end-of-defun) - (setq-local prettify-symbols-alist clojure--prettify-symbols-alist) - ;; apply dir-local variables to REPL buffers - (hack-dir-local-variables-non-file-buffer) - (when cider-repl-history-file - (condition-case nil - (cider-repl-history-load cider-repl-history-file) - (error - (message "Malformed cider-repl-history-file: %s" cider-repl-history-file))) - (add-hook 'kill-buffer-hook #'cider-repl-history-just-save t t) - (add-hook 'kill-emacs-hook #'cider-repl-history-just-save)) - (add-hook 'completion-at-point-functions #'cider-complete-at-point nil t) - (add-hook 'paredit-mode-hook (lambda () (clojure-paredit-setup cider-repl-mode-map))) - (cider-repl-setup-paredit)) - -(provide 'cider-repl) - -;;; cider-repl.el ends here diff --git a/elpa/cider-1.12.0/cider-resolve.el b/elpa/cider-1.12.0/cider-resolve.el @@ -1,130 +0,0 @@ -;;; cider-resolve.el --- Resolve clojure symbols according to current nREPL connection -*- lexical-binding: t; -*- - -;; Copyright © 2015-2023 Bozhidar Batsov, Artur Malabarba and CIDER contributors - -;; Author: Artur Malabarba <bruce.connor.am@gmail.com> - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; The ns cache is a dict of namespaces stored in the connection buffer. This -;; file offers functions to easily get information about variables from this -;; cache, given the variable's name and the file's namespace. This -;; functionality is similar to that offered by the `cider-var-info' function -;; (and others). The difference is that all functions in this file operate -;; without contacting the server (they still rely on an active connection -;; buffer, but no messages are actually exchanged). - -;; For this reason, the functions here are well suited for very -;; performance-sentitive operations, such as font-locking or -;; indentation. Meanwhile, operations like code-jumping are better off -;; communicating with the middleware, just in the off chance that the cache is -;; outdated. - -;; Below is a typical entry on this cache dict. Note that clojure.core symbols -;; are excluded from the refers to save space. - -;; "cider.nrepl.middleware.track-state" -;; (dict "aliases" -;; (dict "cljs" "cider.nrepl.middleware.util.cljs" -;; "misc" "cider.nrepl.middleware.util.misc" -;; "set" "clojure.set") -;; "interns" (dict a -;; "assoc-state" (dict "arglists" -;; (("response" -;; (dict "as" "msg" "keys" -;; ("session"))))) -;; "filter-core" (dict "arglists" -;; (("refers"))) -;; "make-transport" (dict "arglists" -;; (((dict "as" "msg" "keys" -;; ("transport"))))) -;; "ns-as-map" (dict "arglists" -;; (("ns"))) -;; "ns-cache" (dict) -;; "relevant-meta" (dict "arglists" -;; (("var"))) -;; "update-vals" (dict "arglists" -;; (("m" "f"))) -;; "wrap-tracker" (dict "arglists" -;; (("handler")))) -;; "refers" (dict "set-descriptor!" "#'nrepl.middleware/set-descriptor!")) - -;;; Code: - -(require 'cider-client) -(require 'nrepl-dict) -(require 'cider-util) - -(defvar cider-repl-ns-cache) - -(defun cider-resolve--get-in (&rest keys) - "Return (nrepl-dict-get-in cider-repl-ns-cache KEYS)." - (when-let* ((conn (cider-current-repl))) - (with-current-buffer conn - (nrepl-dict-get-in cider-repl-ns-cache keys)))) - -(defun cider-resolve-alias (ns alias) - "Return the namespace that ALIAS refers to in namespace NS. -If it doesn't point anywhere, returns ALIAS." - (or (cider-resolve--get-in ns "aliases" alias) - alias)) - -(defconst cider-resolve--prefix-regexp "\\`\\(?:#'\\)?\\([^/]+\\)/") - -(defun cider-resolve-var (ns var) - "Return a dict of the metadata of a clojure var VAR in namespace NS. -VAR is a string. -Return nil only if VAR cannot be resolved." - (let* ((var-ns (when (string-match cider-resolve--prefix-regexp var) - (cider-resolve-alias ns (match-string 1 var)))) - (name (replace-regexp-in-string cider-resolve--prefix-regexp "" var))) - (or - (cider-resolve--get-in (or var-ns ns) "interns" name) - (unless var-ns - ;; If the var had no prefix, it might be referred. - (if-let* ((referral (cider-resolve--get-in ns "refers" name))) - (cider-resolve-var ns referral) - ;; Or it might be from core. - (unless (equal ns "clojure.core") - (cider-resolve-var "clojure.core" name))))))) - -(defun cider-resolve-core-ns () - "Return a dict of the core namespace for current connection. -This will be clojure.core or cljs.core depending on the return value of the -function `cider-repl-type'." - (when-let* ((repl (cider-current-repl))) - (with-current-buffer repl - (cider-resolve--get-in (if (eq cider-repl-type 'cljs) - "cljs.core" - "clojure.core"))))) - -(defun cider-resolve-ns-symbols (ns) - "Return a plist of all valid symbols in NS. -Each entry's value is the metadata of the var that the symbol refers to. -NS can be the namespace name, or a dict of the namespace itself." - (when-let* ((dict (if (stringp ns) - (cider-resolve--get-in ns) - ns))) - (nrepl-dbind-response dict (interns _refers aliases) - (append (cdr interns) - (nrepl-dict-flat-map (lambda (alias namespace) - (nrepl-dict-flat-map (lambda (sym meta) - (list (concat alias "/" sym) meta)) - (cider-resolve--get-in namespace "interns"))) - aliases))))) - -(provide 'cider-resolve) -;;; cider-resolve.el ends here diff --git a/elpa/cider-1.12.0/cider-scratch.el b/elpa/cider-1.12.0/cider-scratch.el @@ -1,100 +0,0 @@ -;;; cider-scratch.el --- *scratch* buffer for Clojure -*- lexical-binding: t -*- - -;; Copyright © 2014-2023 Bozhidar Batsov and CIDER contributors -;; -;; Author: Tim King <kingtim@gmail.com> -;; Phil Hagelberg <technomancy@gmail.com> -;; Bozhidar Batsov <bozhidar@batsov.dev> -;; Artur Malabarba <bruce.connor.am@gmail.com> -;; Hugo Duncan <hugo@hugoduncan.org> -;; Steve Purcell <steve@sanityinc.com> - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Imitate Emacs's *scratch* buffer. - -;;; Code: - -(require 'cider-eval) -(require 'clojure-mode) -(require 'easymenu) - -(defcustom cider-scratch-initial-message - ";; This buffer is for Clojure experiments and evaluation.\n -;; Press C-j to evaluate the last expression.\n -;; You can also press C-u C-j to evaluate the expression and pretty-print its result.\n\n" - "The initial message displayed in new scratch buffers." - :type 'string - :group 'cider - :package-version '(cider . "0.18.0")) - -(defvar cider-clojure-interaction-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map clojure-mode-map) - (define-key map (kbd "C-j") #'cider-eval-print-last-sexp) - (define-key map [remap paredit-newline] #'cider-eval-print-last-sexp) - (define-key map [remap paredit-C-j] #'cider-eval-print-last-sexp) - (easy-menu-define cider-clojure-interaction-mode-menu map - "Menu for Clojure Interaction mode" - '("Clojure Interaction" - (["Eval and print last sexp" #'cider-eval-print-last-sexp] - "--" - ["Reset" #'cider-scratch-reset]))) - map)) - -(defconst cider-scratch-buffer-name "*cider-scratch*") - -;;;###autoload -(defun cider-scratch () - "Go to the scratch buffer named `cider-scratch-buffer-name'." - (interactive) - (pop-to-buffer (cider-scratch-find-or-create-buffer))) - -(defun cider-scratch-find-or-create-buffer () - "Find or create the scratch buffer." - (or (get-buffer cider-scratch-buffer-name) - (cider-scratch--create-buffer))) - -(define-derived-mode cider-clojure-interaction-mode clojure-mode "Clojure Interaction" - "Major mode for typing and evaluating Clojure forms. -Like `clojure-mode' except that \\[cider-eval-print-last-sexp] evals the Lisp expression -before point, and prints its value into the buffer, advancing point. - -\\{cider-clojure-interaction-mode-map}" - (setq-local sesman-system 'CIDER)) - -(defun cider-scratch--insert-welcome-message () - "Insert the welcome message for the scratch buffer." - (insert cider-scratch-initial-message)) - -(defun cider-scratch--create-buffer () - "Create a new scratch buffer." - (with-current-buffer (get-buffer-create cider-scratch-buffer-name) - (cider-clojure-interaction-mode) - (cider-scratch--insert-welcome-message) - (current-buffer))) - -(defun cider-scratch-reset () - "Reset the current scratch buffer." - (interactive) - (erase-buffer) - (cider-scratch--insert-welcome-message)) - -(provide 'cider-scratch) - -;;; cider-scratch.el ends here diff --git a/elpa/cider-1.12.0/cider-selector.el b/elpa/cider-1.12.0/cider-selector.el @@ -1,174 +0,0 @@ -;;; cider-selector.el --- Buffer selection command inspired by SLIME's selector -*- lexical-binding: t -*- - -;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2023 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; -;; Author: Tim King <kingtim@gmail.com> -;; Phil Hagelberg <technomancy@gmail.com> -;; Bozhidar Batsov <bozhidar@batsov.dev> -;; Artur Malabarba <bruce.connor.am@gmail.com> -;; Hugo Duncan <hugo@hugoduncan.org> -;; Steve Purcell <steve@sanityinc.com> - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Buffer selection command inspired by SLIME's selector. - -;;; Code: - -(require 'cider-client) -(require 'cider-eval) -(require 'cider-scratch) -(require 'cider-profile) - -(defconst cider-selector-help-buffer "*CIDER Selector Help*" - "The name of the selector's help buffer.") - -(defvar cider-selector-methods nil - "List of buffer-selection methods for the `cider-selector' command. -Each element is a list (KEY DESCRIPTION FUNCTION). -DESCRIPTION is a one-line description of what the key selects.") - -(defvar cider-selector-other-window nil - "If non-nil use `switch-to-buffer-other-window'. -Not meant to be set by users. It's used internally -by `cider-selector'.") - -(defun cider-selector--recently-visited-buffer (mode &optional consider-visible-p) - "Return the most recently visited buffer, deriving its `major-mode' from MODE. -CONSIDER-VISIBLE-P will allow handling of visible windows as well. -First pass only considers buffers that are not already visible. -Second pass will attempt one of visible ones for scenarios where the window -is visible, but not focused." - (cl-loop for buffer in (buffer-list) - when (and (with-current-buffer buffer - (derived-mode-p mode)) - ;; names starting with space are considered hidden by Emacs - (not (string-match-p "^ " (buffer-name buffer))) - (or consider-visible-p - (null (get-buffer-window buffer 'visible)))) - return buffer - finally (if consider-visible-p - (error "Can't find unshown buffer in %S" mode) - (cider-selector--recently-visited-buffer mode t)))) - -;;;###autoload -(defun cider-selector (&optional other-window) - "Select a new buffer by type, indicated by a single character. -The user is prompted for a single character indicating the method by -which to choose a new buffer. The `?' character describes the -available methods. OTHER-WINDOW provides an optional target. -See `def-cider-selector-method' for defining new methods." - (interactive) - (message "Select [%s]: " - (apply #'string (mapcar #'car cider-selector-methods))) - (let* ((cider-selector-other-window other-window) - (ch (save-window-excursion - (select-window (minibuffer-window)) - (read-char))) - (method (cl-find ch cider-selector-methods :key #'car))) - (cond (method - (funcall (cl-caddr method))) - (t - (message "No method for character: ?\\%c" ch) - (ding) - (sleep-for 1) - (discard-input) - (cider-selector))))) - -(defmacro def-cider-selector-method (key description &rest body) - "Define a new `cider-select' buffer selection method. -KEY is the key the user will enter to choose this method. - -DESCRIPTION is a one-line sentence describing how the method -selects a buffer. - -BODY is a series of forms which are evaluated when the selector -is chosen. The returned buffer is selected with -`switch-to-buffer'." - (let ((method `(lambda () - (let ((buffer (progn ,@body))) - (cond ((not (and buffer (get-buffer buffer))) - (message "No such buffer: %S" buffer) - (ding)) - ((get-buffer-window buffer) - (select-window (get-buffer-window buffer))) - (cider-selector-other-window - (switch-to-buffer-other-window buffer)) - (t - (switch-to-buffer buffer))))))) - `(setq cider-selector-methods - (cl-sort (cons (list ,key ,description ,method) - (cl-remove ,key cider-selector-methods :key #'car)) - #'< :key #'car)))) - -(def-cider-selector-method ?? "Selector help buffer." - (ignore-errors (kill-buffer cider-selector-help-buffer)) - (with-current-buffer (get-buffer-create cider-selector-help-buffer) - (insert "CIDER Selector Methods:\n\n") - (cl-loop for (key line nil) in cider-selector-methods - do (insert (format "%c:\t%s\n" key line))) - (goto-char (point-min)) - (help-mode) - (display-buffer (current-buffer) t)) - (cider-selector) - (current-buffer)) - -(cl-pushnew (list ?4 "Select in other window" (lambda () (cider-selector t))) - cider-selector-methods :key #'car) - -(def-cider-selector-method ?c - "Most recently visited clojure-mode buffer." - (cider-selector--recently-visited-buffer 'clojure-mode)) - -(def-cider-selector-method ?e - "Most recently visited emacs-lisp-mode buffer." - (cider-selector--recently-visited-buffer 'emacs-lisp-mode)) - -(def-cider-selector-method ?q "Abort." - (top-level)) - -(def-cider-selector-method ?r - "Current REPL buffer or as a fallback, the most recently -visited cider-repl-mode buffer." - (or (cider-current-repl) - (cider-selector--recently-visited-buffer 'cider-repl-mode))) - -(def-cider-selector-method ?m - "Current connection's *nrepl-messages* buffer." - (nrepl-messages-buffer (cider-current-repl))) - -(def-cider-selector-method ?x - "*cider-error* buffer." - cider-error-buffer) - -(def-cider-selector-method ?p - "*cider-profile* buffer." - cider-profile-buffer) - -(def-cider-selector-method ?d - "*cider-doc* buffer." - cider-doc-buffer) - -(def-cider-selector-method ?s - "*cider-scratch* buffer." - (cider-scratch-find-or-create-buffer)) - -(provide 'cider-selector) - -;;; cider-selector.el ends here diff --git a/elpa/cider-1.12.0/cider-stacktrace.el b/elpa/cider-1.12.0/cider-stacktrace.el @@ -1,980 +0,0 @@ -;;; cider-stacktrace.el --- Stacktrace navigator -*- lexical-binding: t -*- - -;; Copyright © 2014-2023 Jeff Valk, Bozhidar Batsov and CIDER contributors - -;; Author: Jeff Valk <jv@jeffvalk.com> - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Stacktrace filtering and stack frame source navigation - -;;; Code: - -(require 'button) -(require 'cl-lib) -(require 'easymenu) -(require 'map) -(require 'seq) -(require 'subr-x) - -(require 'cider-common) -(require 'cider-client) -(require 'cider-popup) -(require 'cider-util) - -;; Variables - -(defgroup cider-stacktrace nil - "Stacktrace filtering and navigation." - :prefix "cider-stacktrace-" - :group 'cider) - -(defcustom cider-stacktrace-fill-column t - "Fill column for error messages in stacktrace display. -If nil, messages will not be wrapped. If truthy but non-numeric, -`fill-column' will be used." - :type 'list - :package-version '(cider . "0.7.0")) - -(defcustom cider-stacktrace-default-filters '(tooling dup) - "Frame types to omit from initial stacktrace display." - :type 'list - :package-version '(cider . "0.6.0")) - -(defcustom cider-stacktrace-navigate-to-other-window t - "If truthy, navigating from a stack frame will use other window. -Pick nil if you prefer the same window as *cider-error*." - :type 'boolean - :package-version '(cider . "1.8.0")) - -(make-obsolete 'cider-stacktrace-print-length 'cider-stacktrace-print-options "0.20") -(make-obsolete 'cider-stacktrace-print-level 'cider-stacktrace-print-options "0.20") -(make-obsolete-variable 'cider-stacktrace-print-options 'cider-print-options "0.21") - -(defvar cider-stacktrace-detail-max 2 - "The maximum detail level for causes.") - -(defvar-local cider-stacktrace-hidden-frame-count 0) -(defvar-local cider-stacktrace-filters nil) -(defvar-local cider-stacktrace-cause-visibility nil) -(defvar-local cider-stacktrace-positive-filters nil) - -(defconst cider-error-buffer "*cider-error*") - -(make-obsolete 'cider-visit-error-buffer 'cider-selector "0.18") - -(defcustom cider-stacktrace-suppressed-errors '() - "Errors that won't make the stacktrace buffer 'pop-over' your active window. -The error types are represented as strings." - :type 'list - :package-version '(cider . "0.12.0")) - -;; Faces - -(defface cider-stacktrace-error-class-face - '((t (:inherit font-lock-warning-face))) - "Face for exception class names." - :package-version '(cider . "0.6.0")) - -(defface cider-stacktrace-error-message-face - '((t (:inherit font-lock-doc-face))) - "Face for exception messages." - :package-version '(cider . "0.7.0")) - -(defface cider-stacktrace-filter-active-face - '((t (:inherit button :underline t :weight normal))) - "Face for filter buttons representing frames currently visible." - :package-version '(cider . "0.6.0")) - -(defface cider-stacktrace-filter-inactive-face - '((t (:inherit button :underline nil :weight normal))) - "Face for filter buttons representing frames currently filtered out." - :package-version '(cider . "0.6.0")) - -(defface cider-stacktrace-face - '((t (:inherit default))) - "Face for stack frame text." - :package-version '(cider . "0.6.0")) - -(defface cider-stacktrace-ns-face - '((t (:inherit font-lock-comment-face))) - "Face for stack frame namespace name." - :package-version '(cider . "0.6.0")) - -(defface cider-stacktrace-fn-face - '((t (:inherit default :weight bold))) - "Face for stack frame function name." - :package-version '(cider . "0.6.0")) - -(defface cider-stacktrace-promoted-button-face - '((((type graphic)) - :box (:line-width 3 :style released-button) - :inherit error) - (t :inverse-video t)) - "A button with this face represents a promoted (non-suppressed) error type." - :package-version '(cider . "0.12.0")) - -(defface cider-stacktrace-suppressed-button-face - '((((type graphic)) - :box (:line-width 3 :style pressed-button) - :inherit widget-inactive) - (t :inverse-video t)) - "A button with this face represents a suppressed error type." - :package-version '(cider . "0.12.0")) - -;; Colors & Theme Support - -(defvar cider-stacktrace-frames-background-color - (cider-scale-background-color) - "Background color for stacktrace frames.") - -(advice-add 'enable-theme :after #'cider--stacktrace-adapt-to-theme) -(advice-add 'disable-theme :after #'cider--stacktrace-adapt-to-theme) -(defun cider--stacktrace-adapt-to-theme (&rest _) - "When theme is changed, update `cider-stacktrace-frames-background-color'." - (setq cider-stacktrace-frames-background-color - (cider-scale-background-color))) - - -;; Mode & key bindings - -(defvar cider-stacktrace-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "M-p") #'cider-stacktrace-previous-cause) - (define-key map (kbd "M-n") #'cider-stacktrace-next-cause) - (define-key map (kbd "M-.") #'cider-stacktrace-jump) - (define-key map "q" #'cider-popup-buffer-quit-function) - (define-key map "j" #'cider-stacktrace-toggle-java) - (define-key map "c" #'cider-stacktrace-toggle-clj) - (define-key map "r" #'cider-stacktrace-toggle-repl) - (define-key map "t" #'cider-stacktrace-toggle-tooling) - (define-key map "d" #'cider-stacktrace-toggle-duplicates) - (define-key map "p" #'cider-stacktrace-show-only-project) - (define-key map "a" #'cider-stacktrace-toggle-all) - (define-key map "1" #'cider-stacktrace-cycle-cause-1) - (define-key map "2" #'cider-stacktrace-cycle-cause-2) - (define-key map "3" #'cider-stacktrace-cycle-cause-3) - (define-key map "4" #'cider-stacktrace-cycle-cause-4) - (define-key map "5" #'cider-stacktrace-cycle-cause-5) - (define-key map "0" #'cider-stacktrace-cycle-all-causes) - (define-key map (kbd "TAB") #'cider-stacktrace-cycle-current-cause) - (define-key map [backtab] #'cider-stacktrace-cycle-all-causes) - (easy-menu-define cider-stacktrace-mode-menu map - "Menu for CIDER's stacktrace mode" - '("Stacktrace" - ["Previous cause" cider-stacktrace-previous-cause] - ["Next cause" cider-stacktrace-next-cause] - "--" - ["Jump to frame source" cider-stacktrace-jump] - "--" - ["Cycle current cause detail" cider-stacktrace-cycle-current-cause] - ["Cycle cause #1 detail" cider-stacktrace-cycle-cause-1] - ["Cycle cause #2 detail" cider-stacktrace-cycle-cause-2] - ["Cycle cause #3 detail" cider-stacktrace-cycle-cause-3] - ["Cycle cause #4 detail" cider-stacktrace-cycle-cause-4] - ["Cycle cause #5 detail" cider-stacktrace-cycle-cause-5] - ["Cycle all cause detail" cider-stacktrace-cycle-all-causes] - "--" - ["Show/hide Java frames" cider-stacktrace-toggle-java] - ["Show/hide Clojure frames" cider-stacktrace-toggle-clj] - ["Show/hide REPL frames" cider-stacktrace-toggle-repl] - ["Show/hide tooling frames" cider-stacktrace-toggle-tooling] - ["Show/hide duplicate frames" cider-stacktrace-toggle-duplicates] - ["Toggle only project frames" cider-stacktrace-show-only-project] - ["Show/hide all frames" cider-stacktrace-toggle-all])) - map)) - -(define-derived-mode cider-stacktrace-mode special-mode "Stacktrace" - "Major mode for filtering and navigating CIDER stacktraces. - -\\{cider-stacktrace-mode-map}" - (when cider-special-mode-truncate-lines - (setq-local truncate-lines t)) - (setq-local sesman-system 'CIDER) - (setq-local electric-indent-chars nil) - (setq-local cider-stacktrace-hidden-frame-count 0) - (setq-local cider-stacktrace-filters cider-stacktrace-default-filters) - (setq-local cider-stacktrace-cause-visibility (make-vector 10 0)) - (buffer-disable-undo)) - - -;; Stacktrace filtering - -(defvar cider-stacktrace--all-negative-filters - '(clj tooling dup java repl) - "Filters that remove stackframes.") - -(defvar cider-stacktrace--all-positive-filters - '(project all) - "Filters that ensure stackframes are shown.") - -(defun cider-stacktrace--face-for-filter (filter neg-filters pos-filters) - "Return whether we should mark the FILTER is active or not. - -NEG-FILTERS and POS-FILTERS are lists of filters to check FILTER's type. - -NEG-FILTERS dictate which frames should be hidden while POS-FILTERS can -override this and ensure that those frames are shown." - (cond ((member filter cider-stacktrace--all-negative-filters) - (if (member filter neg-filters) - 'cider-stacktrace-filter-active-face - 'cider-stacktrace-filter-inactive-face)) - ((member filter cider-stacktrace--all-positive-filters) - (if (member filter pos-filters) - 'cider-stacktrace-filter-active-face - 'cider-stacktrace-filter-inactive-face)))) - -(defun cider-stacktrace-indicate-filters (filters pos-filters) - "Update enabled state of filter buttons. - -Find buttons with a 'filter property; if filter is a member of FILTERS, or -if filter is nil ('show all') and the argument list is non-nil, fontify the -button as disabled. Upon finding text with a 'hidden-count property, stop -searching and update the hidden count text. POS-FILTERS is the list of -positive filters to always include." - (with-current-buffer cider-error-buffer - (save-excursion - (goto-char (point-min)) - (let ((inhibit-read-only t)) - ;; Toggle buttons - (while (not (or (get-text-property (point) 'hidden-count) (eobp))) - (let ((button (button-at (point)))) - (when button - (let* ((filter (button-get button 'filter)) - (face (cider-stacktrace--face-for-filter filter - filters - pos-filters))) - (button-put button 'face face))) - (goto-char (or (next-property-change (point)) - (point-max))))) - ;; Update hidden count - (when (and (get-text-property (point) 'hidden-count) - (re-search-forward "[0-9]+" (line-end-position) t)) - (replace-match - (number-to-string cider-stacktrace-hidden-frame-count))))))) - -(defun cider-stacktrace-frame-p () - "Indicate if the text at point is a stack frame." - (get-text-property (point) 'cider-stacktrace-frame)) - -(defun cider-stacktrace-collapsed-p () - "Indicate if the stackframe was collapsed." - (get-text-property (point) 'collapsed)) - -(defun cider-stacktrace--should-hide-p (neg-filters pos-filters flags) - "Decide whether a stackframe should be hidden or not. -NEG-FILTERS dictate which frames should be hidden while POS-FILTERS can -override this and ensure that those frames are shown. -Argument FLAGS are the flags set on the stackframe, ie: clj dup, etc." - (let ((neg (seq-intersection neg-filters flags)) - (pos (seq-intersection pos-filters flags)) - (all (memq 'all pos-filters))) - (cond (all nil) ;; if all filter is on then we should not hide - ((and pos neg) nil) ;; if hidden and "resurrected" we should not hide - (pos nil) - (neg t) - (t nil)))) - -(defun cider-stacktrace--apply-filters (neg-filters pos-filters) - "Set visibility on stack frames. -Should be called by `cider-stacktrace-apply-filters' which has the logic of -how to interpret the combinations of the positive and negative filters. -For instance, the presence of the positive filter `project' requires all of -the other negative filters to be applied so that only project frames are -shown. NEG-FILTERS are the tags that should be hidden. POS-FILTERS are -the tags that must be shown." - (with-current-buffer cider-error-buffer - (save-excursion - (goto-char (point-min)) - (let ((inhibit-read-only t) - (hidden 0)) - (while (not (eobp)) - (when (and (cider-stacktrace-frame-p) - (not (cider-stacktrace-collapsed-p))) - (let* ((flags (get-text-property (point) 'flags)) - (hide (cider-stacktrace--should-hide-p neg-filters - pos-filters - flags))) - (when hide (cl-incf hidden)) - (put-text-property (point) (line-beginning-position 2) - 'invisible hide))) - (forward-line 1)) - (setq cider-stacktrace-hidden-frame-count hidden))) - (cider-stacktrace-indicate-filters neg-filters pos-filters))) - -(defun cider-stacktrace-apply-filters (filters) - "Takes a single list of filters and applies them. -Update `cider-stacktrace-hidden-frame-count' and indicate -filters applied. Currently collapsed stacktraces are ignored, and do not -contribute to the hidden count. FILTERS is the list of filters to be -applied, positive and negative all together. This function defines how -those choices interact and separates them into positive and negative -filters for the resulting machinery." - (let ((neg-filters (seq-intersection filters cider-stacktrace--all-negative-filters)) - (pos-filters (seq-intersection filters cider-stacktrace--all-positive-filters))) - ;; project and all are mutually exclusive. when both are present we check to - ;; see the most recent one (as cons onto the list would put it) and use that - ;; interaction. - (cond - ((memq 'all (memq 'project pos-filters)) ;; project is most recent - (cider-stacktrace--apply-filters cider-stacktrace--all-negative-filters '(project))) - ((memq 'project (memq 'all pos-filters)) ;; all is most recent - (cider-stacktrace--apply-filters nil '(all))) - ((memq 'all pos-filters) (cider-stacktrace--apply-filters nil '(all))) - ((memq 'project pos-filters) (cider-stacktrace--apply-filters cider-stacktrace--all-negative-filters - pos-filters)) - (t (cider-stacktrace--apply-filters neg-filters pos-filters))))) - -(defun cider-stacktrace-apply-cause-visibility () - "Apply `cider-stacktrace-cause-visibility' to causes and reapply filters." - (with-current-buffer cider-error-buffer - (save-excursion - (goto-char (point-min)) - (cl-flet ((next-detail (end) - (when-let* ((pos (next-single-property-change (point) 'detail))) - (when (< pos end) - (goto-char pos))))) - (let ((inhibit-read-only t)) - ;; For each cause... - (while (cider-stacktrace-next-cause) - (let* ((num (get-text-property (point) 'cause)) - (level (elt cider-stacktrace-cause-visibility num)) - (cause-end (cadr (cider-property-bounds 'cause)))) - ;; For each detail level within the cause, set visibility. - (while (next-detail cause-end) - (let* ((detail (get-text-property (point) 'detail)) - (detail-end (cadr (cider-property-bounds 'detail))) - (hide (if (> detail level) t nil))) - (add-text-properties (point) detail-end - (list 'invisible hide - 'collapsed hide)))))))) - (cider-stacktrace-apply-filters cider-stacktrace-filters)))) - -;;; Internal/Middleware error suppression - -(defun cider-stacktrace-some-suppressed-errors-p (error-types) - "Return intersection of ERROR-TYPES and CIDER-STACKTRACE-SUPPRESSED-ERRORS. -I.e, Return non-nil if the seq ERROR-TYPES shares any elements with -`cider-stacktrace-suppressed-errors'. This means that even a -'well-behaved' (ie, promoted) error type will be 'guilty by association' if -grouped with a suppressed error type." - (seq-intersection error-types cider-stacktrace-suppressed-errors)) - -(defun cider-stacktrace-suppress-error (error-type) - "Destructively add ERROR-TYPE to the `cider-stacktrace-suppressed-errors' set." - (setq cider-stacktrace-suppressed-errors - (cl-adjoin error-type cider-stacktrace-suppressed-errors :test 'equal))) - -(defun cider-stacktrace-promote-error (error-type) - "Destructively remove ERROR-TYPE from `cider-stacktrace-suppressed-errors'." - (setq cider-stacktrace-suppressed-errors - (remove error-type cider-stacktrace-suppressed-errors))) - -(defun cider-stacktrace-suppressed-error-p (error-type) - "Return non-nil if ERROR-TYPE is in `cider-stacktrace-suppressed-errors'." - (member error-type cider-stacktrace-suppressed-errors)) - -;; Interactive functions - -(defun cider-stacktrace-previous-cause () - "Move point to the previous exception cause, if one exists." - (interactive) - (with-current-buffer cider-error-buffer - (when-let* ((pos (previous-single-property-change (point) 'cause))) - (goto-char pos)))) - -(defun cider-stacktrace-next-cause () - "Move point to the next exception cause, if one exists." - (interactive) - (with-current-buffer cider-error-buffer - (when-let* ((pos (next-single-property-change (point) 'cause))) - (goto-char pos)))) - -(defun cider-stacktrace-cycle-cause (num &optional level) - "Update element NUM of `cider-stacktrace-cause-visibility'. -If LEVEL is specified, it is used, otherwise its current value is incremented. -When it reaches 3, it wraps to 0." - (let ((level (or level (1+ (elt cider-stacktrace-cause-visibility num))))) - (aset cider-stacktrace-cause-visibility num (mod level 3)) - (cider-stacktrace-apply-cause-visibility))) - -(defun cider-stacktrace-cycle-all-causes () - "Cycle the visibility of all exception causes." - (interactive) - (with-current-buffer cider-error-buffer - (save-excursion - ;; Find nearest cause. - (unless (get-text-property (point) 'cause) - (cider-stacktrace-next-cause) - (unless (get-text-property (point) 'cause) - (cider-stacktrace-previous-cause))) - ;; Cycle its level, and apply that to all causes. - (let* ((num (get-text-property (point) 'cause)) - (level (1+ (elt cider-stacktrace-cause-visibility num)))) - (setq-local cider-stacktrace-cause-visibility - (make-vector 10 (mod level 3))) - (cider-stacktrace-apply-cause-visibility))))) - -(defun cider-stacktrace-cycle-current-cause () - "Cycle the visibility of current exception at point, if any." - (interactive) - (with-current-buffer cider-error-buffer - (when-let* ((num (get-text-property (point) 'cause))) - (cider-stacktrace-cycle-cause num)))) - -(defun cider-stacktrace-cycle-cause-1 () - "Cycle the visibility of exception cause #1." - (interactive) - (cider-stacktrace-cycle-cause 1)) - -(defun cider-stacktrace-cycle-cause-2 () - "Cycle the visibility of exception cause #2." - (interactive) - (cider-stacktrace-cycle-cause 2)) - -(defun cider-stacktrace-cycle-cause-3 () - "Cycle the visibility of exception cause #3." - (interactive) - (cider-stacktrace-cycle-cause 3)) - -(defun cider-stacktrace-cycle-cause-4 () - "Cycle the visibility of exception cause #4." - (interactive) - (cider-stacktrace-cycle-cause 4)) - -(defun cider-stacktrace-cycle-cause-5 () - "Cycle the visibility of exception cause #5." - (interactive) - (cider-stacktrace-cycle-cause 5)) - -(defun cider-stacktrace-toggle (flag) - "Update `cider-stacktrace-filters' to add or remove FLAG, and apply filters." - (cider-stacktrace-apply-filters - (setq cider-stacktrace-filters - (if (memq flag cider-stacktrace-filters) - (remq flag cider-stacktrace-filters) - (cons flag cider-stacktrace-filters))))) - -(defun cider-stacktrace-toggle-all () - "Toggle `all' in filter list." - (interactive) - (cider-stacktrace-toggle 'all)) - -(defun cider-stacktrace-show-only-project () - "Display only the stackframes from the project." - (interactive) - (cider-stacktrace-toggle 'project)) - -(defun cider-stacktrace-toggle-java () - "Toggle display of Java stack frames." - (interactive) - (cider-stacktrace-toggle 'java)) - -(defun cider-stacktrace-toggle-clj () - "Toggle display of Clojure stack frames." - (interactive) - (cider-stacktrace-toggle 'clj)) - -(defun cider-stacktrace-toggle-repl () - "Toggle display of REPL stack frames." - (interactive) - (cider-stacktrace-toggle 'repl)) - -(defun cider-stacktrace-toggle-tooling () - "Toggle display of tooling stack frames. - -These include: - - * Clojure compiler and runtime internals - * may be `.clj' or `.java' files. - * nREPL internals - * CIDER internals." - (interactive) - (cider-stacktrace-toggle 'tooling)) - -(defun cider-stacktrace-toggle-duplicates () - "Toggle display of stack frames that are duplicates of their descendents." - (interactive) - (cider-stacktrace-toggle 'dup)) - -;; Text button functions - -(defun cider-stacktrace-filter (button) - "Apply filter(s) indicated by the BUTTON." - (with-temp-message "Filters may also be toggled with the keyboard." - (let ((flag (button-get button 'filter))) - (cond ((member flag cider-stacktrace--all-negative-filters) - (cider-stacktrace-toggle flag)) - ((member flag cider-stacktrace--all-positive-filters) - (cider-stacktrace-show-only-project)) - (t (cider-stacktrace-toggle-all)))) - (sit-for 5))) - -(defun cider-stacktrace-toggle-suppression (button) - "Toggle stacktrace pop-over/pop-under behavior for the `error-type' in BUTTON. -Achieved by destructively manipulating `cider-stacktrace-suppressed-errors'." - (with-current-buffer cider-error-buffer - (let ((inhibit-read-only t) - (suppressed (button-get button 'suppressed)) - (error-type (button-get button 'error-type))) - (if suppressed - (progn - (cider-stacktrace-promote-error error-type) - (button-put button 'face 'cider-stacktrace-promoted-button-face) - (button-put button 'help-echo "Click to suppress these stacktraces.")) - (cider-stacktrace-suppress-error error-type) - (button-put button 'face 'cider-stacktrace-suppressed-button-face) - (button-put button 'help-echo "Click to promote these stacktraces.")) - (button-put button 'suppressed (not suppressed))))) - -(defun cider-stacktrace-navigate (button) - "Navigate to the stack frame source represented by the BUTTON." - (let* ((var (button-get button 'var)) - (class (button-get button 'class)) - (method (button-get button 'method)) - (info (or (and var (cider-var-info var)) - (and class method (cider-member-info class method)) - (nrepl-dict))) - ;; Stacktrace returns more accurate line numbers, but if the function's - ;; line was unreliable, then so is the stacktrace by the same amount. - ;; Set `line-shift' to the number of lines from the beginning of defn. - (line-shift (- (or (button-get button 'line) 0) - (or (nrepl-dict-get info "line") 1))) - (file (or - (nrepl-dict-get info "file") - (button-get button 'file))) - ;; give priority to `info` files as `info` returns full paths. - (info (nrepl-dict-put info "file" file))) - (cider--jump-to-loc-from-info info cider-stacktrace-navigate-to-other-window) - (forward-line line-shift) - (back-to-indentation))) - -(declare-function cider-find-var "cider-find") - -(defun cider-stacktrace-jump (&optional arg) - "Find definition for stack frame at point, if available. -The prefix ARG and `cider-prompt-for-symbol' decide whether to -prompt and whether to use a new window. Similar to `cider-find-var'." - (interactive "P") - (let ((button (button-at (point)))) - (if (and button (button-get button 'line)) - (cider-stacktrace-navigate button) - (cider-find-var arg)))) - - -;; Rendering -(defvar cider-use-tooltips) -(defun cider-stacktrace-tooltip (tooltip) - "Return TOOLTIP if `cider-use-tooltips' is set to true, nil otherwise." - (when cider-use-tooltips tooltip)) - -(defun cider-stacktrace-emit-indented (text &optional indent fill fontify) - "Insert TEXT, and optionally FILL and FONTIFY as clojure the entire block. -INDENT is a string to insert before each line. When INDENT is nil, first -line is not indented and INDENT defaults to a white-spaced string with -length given by `current-column'." - (let ((text (if fontify - (cider-font-lock-as-clojure text) - text)) - (do-first indent) - (indent (or indent (make-string (current-column) ? ))) - (beg (point))) - (insert text) - (goto-char beg) - (when do-first - (insert indent)) - (forward-line) - (while (not (eobp)) - (insert indent) - (forward-line)) - (when (and fill cider-stacktrace-fill-column) - (when (and (numberp cider-stacktrace-fill-column)) - (setq-local fill-column cider-stacktrace-fill-column)) - (setq-local fill-prefix indent) - (fill-region beg (point))))) - -(defun cider-stacktrace-render-filters (buffer special-filters filters) - "Emit into BUFFER toggle buttons for each of the FILTERS. -SPECIAL-FILTERS are filters that show stack certain stack frames, hiding -others." - (with-current-buffer buffer - (insert " Show: ") - (dolist (filter special-filters) - (insert-text-button (car filter) - 'filter (cadr filter) - 'follow-link t - 'action #'cider-stacktrace-filter - 'help-echo (cider-stacktrace-tooltip - (format "Toggle %s stack frames" - (car filter)))) - (insert " ")) - (insert "\n") - (insert " Hide: ") - (dolist (filter filters) - (insert-text-button (car filter) - 'filter (cadr filter) - 'follow-link t - 'action #'cider-stacktrace-filter - 'help-echo (cider-stacktrace-tooltip - (format "Toggle %s stack frames" - (car filter)))) - (insert " ")) - - (let ((hidden "(0 frames hidden)")) - (put-text-property 0 (length hidden) 'hidden-count t hidden) - (insert " " hidden "\n")))) - -(defun cider-stacktrace-render-suppression-toggle (buffer error-types) - "Emit toggle buttons for each of the ERROR-TYPES leading this stacktrace BUFFER." - (with-current-buffer buffer - (when error-types - (insert " This is a CIDER middleware error. - It may be a due to a bug, or perhaps simply to bad user input. - If you believe it's a bug, please submit an issue report via `") - (insert-text-button "M-x cider-report-bug" - 'follow-link t - 'action (lambda (_button) (cider-report-bug)) - 'help-echo (cider-stacktrace-tooltip - "Report bug to the CIDER team.")) - (insert "`.\n\n") - (insert "\ - If these stacktraces are occurring frequently, consider using the - button(s) below to suppress these types of errors for the duration of - your current CIDER session. The stacktrace buffer will still be - generated, but it will \"pop under\" your current buffer instead of - \"popping over\". The button toggles this behavior.\n\n ") - (dolist (error-type error-types) - (let ((suppressed (cider-stacktrace-suppressed-error-p error-type))) - (insert-text-button (format "%s %s" (if suppressed "Promote" "Suppress") error-type) - 'follow-link t - 'error-type error-type - 'action #'cider-stacktrace-toggle-suppression - 'suppressed suppressed - 'face (if suppressed - 'cider-stacktrace-suppressed-button-face - 'cider-stacktrace-promoted-button-face) - 'help-echo (cider-stacktrace-tooltip - (format "Click to %s these stacktraces." - (if suppressed "promote" "suppress"))))) - (insert " "))))) - -(defun cider-stacktrace-render-frame (buffer frame) - "Emit into BUFFER function call site info for the stack FRAME. -This associates text properties to enable filtering and source navigation." - (with-current-buffer buffer - (if (null frame) ;; Probably caused by OmitStackTraceInFastThrow - (let ((url "https://docs.cider.mx/cider/troubleshooting.html#empty-java-stacktraces")) - (insert " No stacktrace available!\n Please see ") - (insert-text-button url - 'url url - 'follow-link t - 'action (lambda (x) (browse-url (button-get x 'url))))) - (nrepl-dbind-response frame (file line flags class method name var ns fn) - (when (or class file fn method ns name) - (let ((flags (mapcar #'intern flags))) ; strings -> symbols - (insert-text-button (format "%26s:%5d %s/%s" - (if (member 'repl flags) "REPL" file) (or line -1) - (if (member 'clj flags) ns class) - (if (member 'clj flags) fn method)) - 'var var 'class class 'method method - 'name name 'file file 'line line - 'flags flags 'follow-link t - 'action #'cider-stacktrace-navigate - 'help-echo (cider-stacktrace-tooltip - "View source at this location") - 'font-lock-face 'cider-stacktrace-face - 'type 'cider-plain-button) - (save-excursion - (let ((p4 (point)) - (p1 (search-backward " ")) - (p2 (search-forward "/")) - (p3 (search-forward-regexp "[^/$]+"))) - (put-text-property p1 p4 'font-lock-face 'cider-stacktrace-ns-face) - (put-text-property p2 p3 'font-lock-face 'cider-stacktrace-fn-face) - (put-text-property (line-beginning-position) (line-end-position) - 'cider-stacktrace-frame t))) - (insert "\n"))))))) - -(defun cider-stacktrace-render-compile-error (buffer cause) - "Emit into BUFFER the compile error CAUSE, and enable jumping to it." - (with-current-buffer buffer - (nrepl-dbind-response cause (file path line column) - (let ((indent " ") - (message-face 'cider-stacktrace-error-message-face)) - (insert indent) - (insert (propertize "Error compiling " 'font-lock-face message-face)) - (insert-text-button path 'compile-error t - 'file file 'line line 'column column 'follow-link t - 'action (lambda (_button) - (cider-jump-to (cider-find-file file) - (cons line column))) - 'help-echo (cider-stacktrace-tooltip - "Jump to the line that caused the error")) - (insert (propertize (format " at (%d:%d)" line column) - 'font-lock-face message-face)))))) - -(defun cider-stacktrace--toggle-visibility (id) - "Toggle visibility of the region with ID invisibility prop. -ID can also be a button, in which case button's property :id is used -instead. This function can be used directly in button actions." - (let ((id (if (or (numberp id) (symbolp id)) - ;; There is no proper way to identify buttons. Assuming that - ;; id's can be either numbers or symbols. - id - (button-get id :id)))) - (if (and (consp buffer-invisibility-spec) - (assoc id buffer-invisibility-spec)) - (remove-from-invisibility-spec (cons id t)) - (add-to-invisibility-spec (cons id t))))) - -(defun cider-stacktrace--insert-named-group (indent name &rest vals) - "Insert named group with the ability to toggle visibility. -NAME is a string naming the group. VALS are strings to be inserted after -the NAME. The whole group is prefixed by string INDENT." - (let* ((str (and vals (replace-regexp-in-string "\n+\\'" "" (apply #'concat vals)))) - (id (and str - (string-match "\n" str) - (cl-gensym name)))) - (insert indent) - (if id - (let* ((beg-link (string-match "[^ :]" name)) - (end-link (string-match "[ :]" name (1+ beg-link)))) - (insert (substring name 0 beg-link)) - (insert-text-button (substring name beg-link end-link) - :id id - 'face '((:weight bold) (:underline t)) - 'follow-link t - 'help-echo "Toggle visibility" - 'action #'cider-stacktrace--toggle-visibility) - (insert (substring name end-link))) - (insert (propertize name 'face '((:weight bold))))) - (let ((pos (point))) - (when str - (cider-stacktrace-emit-indented (concat str "\n") nil nil t) - (when id - (remove-from-invisibility-spec (cons id t)) - (let ((hide-beg (save-excursion (goto-char pos) (point-at-eol))) - (hide-end (1- (point-at-bol)))) - (overlay-put (make-overlay hide-beg hide-end) 'invisible id))))))) - -(defun cider-stacktrace--emit-spec-problems (spec-data indent) - "Emit SPEC-DATA indented with INDENT." - (nrepl-dbind-response spec-data (spec value problems) - (insert "\n") - (cider-stacktrace--insert-named-group indent " Spec: " spec) - (cider-stacktrace--insert-named-group indent " Value: " value) - (insert "\n") - (cider-stacktrace--insert-named-group indent "Problems: \n") - (let ((indent2 (concat indent " "))) - (dolist (prob problems) - (nrepl-dbind-response prob (in val predicate reason spec at extra) - (insert "\n") - (when (not (string= val value)) - (cider-stacktrace--insert-named-group indent2 " val: " val)) - (when in - (cider-stacktrace--insert-named-group indent2 " in: " in)) - (cider-stacktrace--insert-named-group indent2 "failed: " predicate) - (when spec - (cider-stacktrace--insert-named-group indent2 " spec: " spec)) - (when at - (cider-stacktrace--insert-named-group indent2 " at: " at)) - (when reason - (cider-stacktrace--insert-named-group indent2 "reason: " reason)) - (when extra - (cider-stacktrace--insert-named-group indent2 "extras: \n") - (cider-stacktrace-emit-indented extra (concat indent2 " ") nil t))))))) - -(declare-function cider-inspector-inspect-last-exception "cider-inspector") - -(defun cider-stacktrace--inspect-class (event) - "Mouse handler for EVENT." - (interactive "e") - (let* ((pos (posn-point (event-end event))) - (window (posn-window (event-end event))) - (buffer (window-buffer window)) - (inspect-index (with-current-buffer buffer - (get-text-property pos 'inspect-index)))) - (cider-inspector-inspect-last-exception inspect-index))) - -(defun cider-stacktrace--inspect-class-kbd () - "Keyboard handler." - (interactive) - (when-let ((inspect-index (get-text-property (point) 'inspect-index))) - (cider-inspector-inspect-last-exception inspect-index))) - -(defvar cider-stacktrace-exception-map - (let ((map (make-sparse-keymap))) - (define-key map [mouse-1] #'cider-stacktrace--inspect-class) - (define-key map (kbd "p") #'cider-stacktrace--inspect-class-kbd) - (define-key map (kbd "i") #'cider-stacktrace--inspect-class-kbd) - map)) - -(defun cider-stacktrace-render-cause (buffer cause num note &optional inspect-index) - "Emit into BUFFER the CAUSE NUM, exception class, message, data, and NOTE, -make INSPECT-INDEX actionable if present." - (with-current-buffer buffer - (nrepl-dbind-response cause (class message data spec stacktrace) - (let ((indent " ") - (class-face 'cider-stacktrace-error-class-face) - (message-face 'cider-stacktrace-error-message-face)) - (cider-propertize-region `(cause ,num) - ;; Detail level 0: exception class - (cider-propertize-region `(detail - 0 - - inspect-index - ,inspect-index - - keymap - ,cider-stacktrace-exception-map) - (insert (format "%d. " num) - (propertize note 'font-lock-face 'font-lock-comment-face) " " - (propertize class 'font-lock-face class-face 'mouse-face 'highlight) - "\n")) - ;; Detail level 1: message + ex-data - (cider-propertize-region '(detail 1) - (if (equal class "clojure.lang.Compiler$CompilerException") - (cider-stacktrace-render-compile-error buffer cause) - (cider-stacktrace-emit-indented - (propertize (or message "(No message)") - 'font-lock-face message-face) - indent t)) - (insert "\n") - (when spec - (cider-stacktrace--emit-spec-problems spec (concat indent " "))) - (when data - (cider-stacktrace-emit-indented data indent nil t))) - ;; Detail level 2: stacktrace - (cider-propertize-region '(detail 2) - (insert "\n") - (let ((beg (point)) - (bg `(:background ,cider-stacktrace-frames-background-color :extend t))) - (dolist (frame stacktrace) - (cider-stacktrace-render-frame buffer frame)) - (overlay-put (make-overlay beg (point)) 'font-lock-face bg))) - ;; Add line break between causes, even when collapsed. - (cider-propertize-region '(detail 0) - (insert "\n"))))))) - -(defun cider-stacktrace-initialize (causes) - "Set and apply CAUSES initial visibility, filters, and cursor position." - (nrepl-dbind-response (car causes) (class) - (let ((compile-error-p (equal class "clojure.lang.Compiler$CompilerException"))) - ;; Partially display outermost cause if it's a compiler exception (the - ;; description reports reader location of the error). - (when compile-error-p - (cider-stacktrace-cycle-cause (length causes) 1)) - ;; Fully display innermost cause. This also applies visibility/filters. - (cider-stacktrace-cycle-cause 1 cider-stacktrace-detail-max) - ;; Move point (DWIM) to the compile error location if present, or to the - ;; first stacktrace frame in displayed cause otherwise. If the error - ;; buffer is visible in a window, ensure that window is selected while moving - ;; point, so as to move both the buffer's and the window's point. - (with-selected-window (or (get-buffer-window cider-error-buffer) - (selected-window)) - (with-current-buffer cider-error-buffer - (goto-char (point-min)) - (if compile-error-p - (goto-char (next-single-property-change (point) 'compile-error)) - (progn - (while (cider-stacktrace-next-cause)) - (when-let (position (next-single-property-change (point) 'flags)) - (goto-char position))))))))) - -(defun cider-stacktrace-render (buffer causes &optional error-types) - "Emit into BUFFER useful stacktrace information for the CAUSES. -Takes an optional ERROR-TYPES list which will render a 'suppression' toggle -that alters the pop-over/pop-under behavorior of the stacktrace buffers -created by these types of errors. The suppressed errors set can be customized -through the `cider-stacktrace-suppressed-errors' variable." - (with-current-buffer buffer - (let ((inhibit-read-only t)) - (erase-buffer) - (insert "\n") - ;; Stacktrace filters - (cider-stacktrace-render-filters - buffer - `(("Project-Only" project) ("All" all)) - `(("Clojure" clj) ("Java" java) ("REPL" repl) - ("Tooling" tooling) ("Duplicates" dup))) - (insert "\n") - ;; Option to suppress internal/middleware errors - (when error-types - (cider-stacktrace-render-suppression-toggle buffer error-types) - (insert "\n\n")) - ;; Stacktrace exceptions & frames - (let* ((causes-length (length causes)) - (num causes-length)) - (dolist (cause causes) - (let ((note (if (= num causes-length) "Unhandled" "Caused by"))) - (cider-stacktrace-render-cause buffer cause num note (- causes-length num)) - (setq num (1- num)))))) - (cider-stacktrace-initialize causes) - (font-lock-refresh-defaults))) - -(defun cider-stacktrace--analyze-stacktrace-op (stacktrace) - "Return the Cider NREPL op to analyze STACKTRACE." - (list "op" "analyze-stacktrace" "stacktrace" stacktrace)) - -(defun cider-stacktrace--stacktrace-request (stacktrace) - "Return the Cider NREPL request to analyze STACKTRACE." - (thread-last - (map-merge 'list - (list (cider-stacktrace--analyze-stacktrace-op stacktrace)) - (cider--nrepl-print-request-map fill-column)) - (seq-mapcat #'identity))) - -(defun cider-stacktrace--analyze-render (causes) - "Render the CAUSES of the stacktrace analysis result." - (let ((buffer (get-buffer-create cider-error-buffer))) - (with-current-buffer buffer - (cider-stacktrace-mode) - (cider-stacktrace-render buffer (reverse causes)) - (display-buffer buffer cider-jump-to-pop-to-buffer-actions)))) - -(defun cider-stacktrace-analyze-string (stacktrace) - "Analyze the STACKTRACE string and show the result." - (when (stringp stacktrace) - (set-text-properties 0 (length stacktrace) nil stacktrace)) - (let (causes) - (cider-nrepl-send-request - (cider-stacktrace--stacktrace-request stacktrace) - (lambda (response) - (setq causes (nrepl-dbind-response response (class status) - (cond (class (cons response causes)) - ((and (member "done" status) causes) - (cider-stacktrace--analyze-render causes))))))))) - -(defun cider-stacktrace-analyze-at-point () - "Analyze the stacktrace at point." - (interactive) - (cond ((thing-at-point 'sentence) - (cider-stacktrace-analyze-string (thing-at-point 'sentence))) - ((thing-at-point 'paragraph) - (cider-stacktrace-analyze-string (thing-at-point 'paragraph))) - (t (cider-stacktrace-analyze-in-region (region-beginning) (region-end))))) - -(defun cider-stacktrace-analyze-in-region (beg end) - "Analyze the stacktrace in the region between BEG and END." - (interactive (list (region-beginning) (region-end))) - (let ((stacktrace (buffer-substring beg end))) - (cider-stacktrace-analyze-string stacktrace))) - -(provide 'cider-stacktrace) - -;;; cider-stacktrace.el ends here diff --git a/elpa/cider-1.12.0/cider-test.el b/elpa/cider-1.12.0/cider-test.el @@ -1,942 +0,0 @@ -;;; cider-test.el --- Test result viewer -*- lexical-binding: t -*- - -;; Copyright © 2014-2023 Jeff Valk, Bozhidar Batsov and CIDER contributors - -;; Author: Jeff Valk <jv@jeffvalk.com> - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; This provides execution, reporting, and navigation support for Clojure tests, -;; specifically using the `clojure.test' machinery. This functionality replaces -;; the venerable `clojure-test-mode' (deprecated in June 2014), and relies on -;; nREPL middleware for report running and session support. - -;;; Code: - -(require 'ansi-color) -(require 'button) -(require 'cl-lib) -(require 'easymenu) -(require 'map) -(require 'seq) -(require 'subr-x) - -(require 'cider-common) -(require 'cider-client) -(require 'cider-popup) -(require 'cider-stacktrace) -(require 'cider-overlays) -(require 'cider-util) - -;;; Variables - -(defgroup cider-test nil - "Presentation and navigation for test results." - :prefix "cider-test-" - :group 'cider) - -(defcustom cider-test-show-report-on-success nil - "Whether to show the `*cider-test-report*` buffer on passing tests." - :type 'boolean - :package-version '(cider . "0.8.0")) - -(defcustom cider-auto-select-test-report-buffer t - "Determines if the test-report buffer should be auto-selected." - :type 'boolean - :package-version '(cider . "0.9.0")) - -(make-obsolete 'cider-test-defining-forms nil "1.8.0") - -(defvar cider-test--current-repl nil - "Contains the reference to the REPL where the tests were last invoked from. -This is needed for *cider-test-report* navigation -to work against the correct REPL session.") - -(defvar cider-test-last-summary nil - "The summary of the last run test.") - -(defvar cider-test-last-results nil - "The results of the last run test.") - -(defconst cider-test-report-buffer "*cider-test-report*" - "Buffer name in which to display test reports.") - -;;; Faces - -(defface cider-test-failure-face - '((((class color) (background light)) - :background "orange red") - (((class color) (background dark)) - :background "firebrick")) - "Face for failed tests." - :package-version '(cider . "0.7.0")) - -(defface cider-test-error-face - '((((class color) (background light)) - :background "orange1") - (((class color) (background dark)) - :background "orange4")) - "Face for erring tests." - :package-version '(cider . "0.7.0")) - -(defface cider-test-success-face - '((((class color) (background light)) - :foreground "black" - :background "green") - (((class color) (background dark)) - :foreground "black" - :background "green")) - "Face for passing tests." - :package-version '(cider . "0.7.0")) - - -;; Colors & Theme Support - -(defvar cider-test-items-background-color - (cider-scale-background-color) - "Background color for test assertion items.") - -(advice-add 'enable-theme :after #'cider--test-adapt-to-theme) -(advice-add 'disable-theme :after #'cider--test-adapt-to-theme) -(defun cider--test-adapt-to-theme (&rest _) - "When theme is changed, update `cider-test-items-background-color'." - (setq cider-test-items-background-color (cider-scale-background-color))) - -(defun cider-test-toggle-fail-fast () - "Toggles `cider-test-fail-fast' t <-> nil for the current buffer." - (interactive) - (setq-local cider-test-fail-fast (not cider-test-fail-fast))) - -;;; Report mode & key bindings -;; -;; The primary mode of interacting with test results is the report buffer, which -;; allows navigation among tests, jumping to test definitions, expected/actual -;; diff-ing, and cause/stacktrace inspection for test errors. - -(defvar cider-test-commands-map - (let ((map (define-prefix-command 'cider-test-commands-map))) - ;; Duplicates of keys below with C- for convenience - (define-key map (kbd "C-r") #'cider-test-rerun-failed-tests) - (define-key map (kbd "C-t") #'cider-test-run-test) - (define-key map (kbd "C-a") #'cider-test-rerun-test) - (define-key map (kbd "C-n") #'cider-test-run-ns-tests) - (define-key map (kbd "C-s") #'cider-test-run-ns-tests-with-filters) - (define-key map (kbd "C-l") #'cider-test-run-loaded-tests) - (define-key map (kbd "C-p") #'cider-test-run-project-tests) - (define-key map (kbd "C-b") #'cider-test-show-report) - (define-key map (kbd "C-f") #'cider-test-toggle-fail-fast) - ;; Single-key bindings defined last for display in menu - (define-key map (kbd "r") #'cider-test-rerun-failed-tests) - (define-key map (kbd "t") #'cider-test-run-test) - (define-key map (kbd "a") #'cider-test-rerun-test) - (define-key map (kbd "n") #'cider-test-run-ns-tests) - (define-key map (kbd "s") #'cider-test-run-ns-tests-with-filters) - (define-key map (kbd "l") #'cider-test-run-loaded-tests) - (define-key map (kbd "p") #'cider-test-run-project-tests) - (define-key map (kbd "b") #'cider-test-show-report) - (define-key map (kbd "f") #'cider-test-toggle-fail-fast) - map)) - -(defconst cider-test-menu - '("Test" - ["Run test" cider-test-run-test] - ["Run namespace tests" cider-test-run-ns-tests] - ["Run namespace tests with filters" cider-test-run-ns-tests-with-filters] - ["Run all loaded tests" cider-test-run-loaded-tests] - ["Run all loaded tests with filters" (apply-partially cider-test-run-loaded-tests 'prompt-for-filters)] - ["Run all project tests" cider-test-run-project-tests] - ["Run all project tests with filters" (apply-partially cider-test-run-project-tests 'prompt-for-filters)] - ["Run tests after load-file" cider-auto-test-mode - :style toggle :selected cider-auto-test-mode] - "--" - ["Interrupt running tests" cider-interrupt] - ["Rerun failed/erring tests" cider-test-rerun-failed-tests] - ["Show test report" cider-test-show-report] - "--" - ["Configure testing" (customize-group 'cider-test)]) - "CIDER test submenu.") - -(defvar cider-test-report-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-c ,") 'cider-test-commands-map) - (define-key map (kbd "C-c C-t") 'cider-test-commands-map) - (define-key map (kbd "M-p") #'cider-test-previous-result) - (define-key map (kbd "M-n") #'cider-test-next-result) - (define-key map (kbd "M-.") #'cider-test-jump) - (define-key map (kbd "<backtab>") #'cider-test-previous-result) - (define-key map (kbd "TAB") #'cider-test-next-result) - (define-key map (kbd "RET") #'cider-test-jump) - (define-key map (kbd "t") #'cider-test-jump) - (define-key map (kbd "d") #'cider-test-ediff) - (define-key map (kbd "e") #'cider-test-stacktrace) - ;; `f' for "run failed". - (define-key map "f" #'cider-test-rerun-failed-tests) - (define-key map "n" #'cider-test-run-ns-tests) - (define-key map "s" #'cider-test-run-ns-tests-with-filters) - (define-key map "l" #'cider-test-run-loaded-tests) - (define-key map "p" #'cider-test-run-project-tests) - ;; `g' generally reloads the buffer. The closest thing we have to that is - ;; "run the test at point". But it's not as nice as rerunning all tests in - ;; this buffer. - (define-key map "g" #'cider-test-run-test) - (define-key map "q" #'cider-popup-buffer-quit-function) - (easy-menu-define cider-test-report-mode-menu map - "Menu for CIDER's test result mode" - '("Test-Report" - ["Previous result" cider-test-previous-result] - ["Next result" cider-test-next-result] - "--" - ["Rerun current test" cider-test-run-test] - ["Rerun failed/erring tests" cider-test-rerun-failed-tests] - ["Run all ns tests" cider-test-run-ns-tests] - ["Run all ns tests with filters" cider-test-run-ns-tests-with-filters] - ["Run all loaded tests" cider-test-run-loaded-tests] - ["Run all loaded tests with filters" (apply-partially cider-test-run-loaded-tests 'prompt-for-filters)] - ["Run all project tests" cider-test-run-project-tests] - ["Run all project tests with filters" (apply-partially cider-test-run-project-tests 'prompt-for-filters)] - "--" - ["Jump to test definition" cider-test-jump] - ["Display test error" cider-test-stacktrace] - ["Display expected/actual diff" cider-test-ediff])) - map)) - -(define-derived-mode cider-test-report-mode fundamental-mode "Test Report" - "Major mode for presenting Clojure test results. - -\\{cider-test-report-mode-map}" - (setq buffer-read-only t) - (when cider-special-mode-truncate-lines - (setq-local truncate-lines t)) - (setq-local sesman-system 'CIDER) - (setq-local electric-indent-chars nil) - (buffer-disable-undo)) - -;; Report navigation - -(defun cider-test-show-report () - "Show the test report buffer, if one exists." - (interactive) - (if-let* ((report-buffer (get-buffer cider-test-report-buffer))) - (switch-to-buffer report-buffer) - (message "No test report buffer"))) - -(defun cider-test-previous-result () - "Move point to the previous test result, if one exists." - (interactive) - (with-current-buffer (get-buffer cider-test-report-buffer) - (when-let* ((pos (previous-single-property-change (point) 'type))) - (if (get-text-property pos 'type) - (goto-char pos) - (when-let* ((pos (previous-single-property-change pos 'type))) - (goto-char pos)))))) - -(defun cider-test-next-result () - "Move point to the next test result, if one exists." - (interactive) - (with-current-buffer (get-buffer cider-test-report-buffer) - (when-let* ((pos (next-single-property-change (point) 'type))) - (if (get-text-property pos 'type) - (goto-char pos) - (when-let* ((pos (next-single-property-change pos 'type))) - (goto-char pos)))))) - -(declare-function cider-find-var "cider-find") - -(defun cider-test-jump (&optional arg) - "Find definition for test at point, if available. -The prefix ARG and `cider-prompt-for-symbol' decide whether to -prompt and whether to use a new window. Similar to `cider-find-var'." - (interactive "P") - (let ((ns (get-text-property (point) 'ns)) - (var (get-text-property (point) 'var)) - (line (get-text-property (point) 'line))) - (if (and ns var) - (cider-find-var arg (concat ns "/" var) line) - (cider-find-var arg)))) - -;;; Error stacktraces - -(defvar cider-auto-select-error-buffer) - -(defun cider-test-stacktrace-for (ns var index) - "Display stacktrace for the erring NS VAR test with the assertion INDEX." - (let (causes) - (cider-nrepl-send-request - (thread-last - (map-merge 'list - `(("op" "test-stacktrace") - ("ns" ,ns) - ("var" ,var) - ("index" ,index)) - (cider--nrepl-print-request-map fill-column)) - (seq-mapcat #'identity)) - (lambda (response) - (nrepl-dbind-response response (class status) - (cond (class (setq causes (cons response causes))) - (status (when causes - (cider-stacktrace-render - (cider-popup-buffer cider-error-buffer - cider-auto-select-error-buffer - #'cider-stacktrace-mode - 'ancillary) - (reverse causes))))))) - cider-test--current-repl))) - -(defun cider-test-stacktrace () - "Display stacktrace for the erring test at point." - (interactive) - (let ((ns (get-text-property (point) 'ns)) - (var (get-text-property (point) 'var)) - (index (get-text-property (point) 'index)) - (err (get-text-property (point) 'error))) - (if (and err ns var index) - (cider-test-stacktrace-for ns var index) - (message "No test error at point")))) - - -;;; Expected vs actual diffing - -(defvar cider-test-ediff-buffers nil - "The expected/actual buffers used to display diff.") - -(defun cider-test--extract-from-actual (actual n) - "Extract form N from ACTUAL, ignoring outermost not. - -ACTUAL is a string like \"(not (= 3 4))\", of the sort returned by -clojure.test. - -N = 1 => 3, N = 2 => 4, etc." - (with-temp-buffer - (insert actual) - (clojure-mode) - (goto-char (point-min)) - (re-search-forward "(" nil t 2) - (clojure-forward-logical-sexp n) - (forward-whitespace 1) - (let ((beg (point))) - (clojure-forward-logical-sexp) - (buffer-substring beg (point))))) - -(defun cider-test-ediff () - "Show diff of the expected vs actual value for the test at point. -With the actual value, the outermost '(not ...)' s-expression is removed." - (interactive) - (let* ((expected-buffer (generate-new-buffer " *expected*")) - (actual-buffer (generate-new-buffer " *actual*")) - (diffs (get-text-property (point) 'diffs)) - (actual* (get-text-property (point) 'actual)) - (expected (cond (diffs (get-text-property (point) 'expected)) - (actual* (cider-test--extract-from-actual actual* 1)))) - (actual (cond (diffs (caar diffs)) - (actual* (cider-test--extract-from-actual actual* 2))))) - (if (not (and expected actual)) - (message "No test failure at point") - (with-current-buffer expected-buffer - (insert expected) - (clojure-mode)) - (with-current-buffer actual-buffer - (insert actual) - (clojure-mode)) - (apply #'ediff-buffers - (setq cider-test-ediff-buffers - (list (buffer-name expected-buffer) - (buffer-name actual-buffer))))))) - -(defun cider-test-ediff-cleanup () - "Cleanup expected/actual buffers used for diff." - (interactive) - (mapc (lambda (b) (when (get-buffer b) (kill-buffer b))) - cider-test-ediff-buffers)) - -(add-hook 'ediff-cleanup-hook #'cider-test-ediff-cleanup) - - -;;; Report rendering - -(defun cider-test-type-face (type) - "Return the font lock face for the test result TYPE." - (pcase type - ("pass" 'cider-test-success-face) - ("fail" 'cider-test-failure-face) - ("error" 'cider-test-error-face) - (_ 'default))) - -(defun cider-test-type-simple-face (type) - "Return a face for the test result TYPE using the highlight color as foreground." - (let ((face (cider-test-type-face type))) - `(:foreground ,(face-attribute face :background)))) - -(defun cider-test-render-summary (buffer summary &optional elapsed-time) - "Emit into BUFFER the report SUMMARY statistics." - (with-current-buffer buffer - (nrepl-dbind-response summary (ns var test pass fail error) - (let ((ms (nrepl-dict-get elapsed-time "ms"))) - (insert (format "Tested %d namespaces%s\n" ns (if ms - (format " in %s ms" ms) - "")))) - (insert (format "Ran %d assertions, in %d test functions\n" test var)) - (unless (zerop fail) - (cider-insert (format "%d failures" fail) 'cider-test-failure-face t)) - (unless (zerop error) - (cider-insert (format "%d errors" error) 'cider-test-error-face t)) - (when (zerop (+ fail error)) - (cider-insert (format "%d passed" pass) 'cider-test-success-face t)) - (when cider-test-fail-fast - (cider-insert "cider-test-fail-fast: " 'font-lock-comment-face nil) - (cider-insert "t" 'font-lock-constant-face t)) - (insert "\n\n")))) - -(defun cider-test--string-contains-newline (input-string) - "Returns whether INPUT-STRING contains an escaped newline." - (when (stringp input-string) - (and (string-match-p "\\\\n" input-string) - t))) - -(defvar cider-test-var-keymap - (let ((map (make-sparse-keymap))) - (define-key map [mouse-1] #'cider-test-jump) - map)) - -(defun cider-test-render-assertion (buffer test) - "Emit into BUFFER report detail for the TEST assertion." - (with-current-buffer buffer - (nrepl-dbind-response test (var context type message expected actual diffs error gen-input) - (cl-flet ((insert-label (s) - (cider-insert (format "%8s: " s) 'font-lock-comment-face)) - (insert-align-label (s) - (insert (format "%12s" s))) - (insert-rect (s) - (let ((start (point))) - (insert-rectangle (thread-first - s - cider-font-lock-as-clojure - (split-string "\n"))) - (ansi-color-apply-on-region start (point))) - (beginning-of-line))) - (cider-propertize-region (cider-intern-keys (cdr test)) - (let ((beg (point)) - (type-face (cider-test-type-simple-face type)) - (bg `(:background ,cider-test-items-background-color :extend t))) - (cider-insert (capitalize type) type-face nil " in ") - (cider-propertize-region `(keymap ,cider-test-var-keymap) - (cider-insert (propertize var 'mouse-face 'highlight) - 'font-lock-function-name-face t)) - (when context (cider-insert context 'font-lock-doc-face t)) - (when message (cider-insert message 'font-lock-string-face t)) - (when expected - (insert-label "expected") - (insert-rect expected) - ;; Only place a newline between expected and actual when the values are deemed 'dense', - ;; otherwise favor compact output: - (when (or (cider-test--string-contains-newline expected) - (cider-test--string-contains-newline actual)) - (insert "\n"))) - (if diffs - (dolist (d diffs) - (cl-destructuring-bind (actual (removed added)) d - (insert-label "actual") - (insert-rect actual) - (insert "\n") - (insert-label "diff") - (insert "- ") - (insert-rect removed) - (insert-align-label "+ ") - (insert-rect added) - (insert "\n"))) - (when actual - (insert-label "actual") - (insert-rect actual))) - (when error - (insert-label "error") - (insert-text-button error - 'follow-link t - 'action '(lambda (_button) (cider-test-stacktrace)) - 'help-echo "View causes and stacktrace") - (insert "\n")) - (when gen-input - (insert-label "input") - (insert (cider-font-lock-as-clojure gen-input))) - (overlay-put (make-overlay beg (point)) 'font-lock-face bg)) - (insert "\n")))))) - -(defun cider-test-non-passing (tests) - "For a list of TESTS, each an `nrepl-dict`, return only those that did not pass." - (seq-filter (lambda (test) - (unless (equal (nrepl-dict-get test "type") "pass") - test)) - tests)) - -(defun cider-test-render-report (buffer summary results &optional elapsed-time ns-elapsed-time var-elapsed-time) - "Emit into BUFFER the report for the SUMMARY, and test RESULTS." - (with-current-buffer buffer - (let ((inhibit-read-only t)) - (cider-test-report-mode) - (cider-insert "Test Summary" 'bold t) - (dolist (ns (nrepl-dict-keys results)) - (insert (cider-propertize ns 'ns) - (or (let ((ms (nrepl-dict-get (nrepl-dict-get ns-elapsed-time ns) - "ms"))) - (propertize (format " %s ms" ms) 'face 'font-lock-comment-face)) - "") - "\n") - (when var-elapsed-time - (when-let ((pairs (nrepl-dict-get var-elapsed-time ns))) - (nrepl-dict-map (lambda (var meta) - (insert " " ;; indentation - we're showing a var within a ns - (cider-propertize var 'font-lock-function-name-face) - (or (when-let* ((elapsed (nrepl-dict-get meta "elapsed-time")) - (ms (nrepl-dict-get elapsed "ms"))) - (propertize (format " %s ms" ms) 'face 'font-lock-comment-face)) - "") - "\n")) - pairs)))) - (cider-insert "\n") - (cider-test-render-summary buffer summary elapsed-time) - (nrepl-dbind-response summary (fail error) - (unless (zerop (+ fail error)) - (cider-insert "Results" 'bold t "\n") - ;; Results are a nested dict, keyed first by ns, then var. Within each - ;; var is a sequence of test assertion results. - (nrepl-dict-map - (lambda (ns vars) - (nrepl-dict-map - (lambda (_var tests) - (let* ((problems (cider-test-non-passing tests)) - (count (length problems))) - (when (< 0 count) - (insert (format "%s\n%d non-passing tests:\n\n" - (cider-propertize ns 'ns) count)) - (dolist (test problems) - (cider-test-render-assertion buffer test))))) - vars)) - results))) - ;; Replace any newline chars with actual newlines to make long error - ;; messages more readable - (goto-char (point-min)) - (while (search-forward "\\n" nil t) - (replace-match " -")) - (goto-char (point-min)) - (current-buffer)))) - - -;;; Message echo - -(defun cider-test-echo-running (ns &optional test) - "Echo a running message for the test NS, which may be a keyword. -The optional arg TEST denotes an individual test name." - (if test - (message "Running test %s in %s..." - (cider-propertize test 'bold) - (cider-propertize ns 'ns)) - (message "Running tests in %s..." - (concat (cider-propertize - (cond ((stringp ns) ns) - ((eq :non-passing ns) "failing") - ((eq :loaded ns) "all loaded") - ((eq :project ns) "all project")) - 'ns) - (unless (stringp ns) " namespaces"))))) - -(defun cider-test-echo-summary (summary results &optional elapsed-time) - "Echo SUMMARY statistics for a test run returning RESULTS in ELAPSED-TIME." - (nrepl-dbind-response summary (ns test var fail error) - (if (nrepl-dict-empty-p results) - (message (concat (propertize "No assertions (or no tests) were run." 'face 'cider-test-error-face) - "Did you forget to use `is' in your tests?")) - (let* ((ms (nrepl-dict-get elapsed-time "ms")) - (ms (if ms - (propertize (format " in %s ms" ms ) 'face 'font-lock-comment-face) - "."))) - (message (propertize - "%sRan %d assertions, in %d test functions. %d failures, %d errors%s" - 'face (cond ((not (zerop error)) 'cider-test-error-face) - ((not (zerop fail)) 'cider-test-failure-face) - (t 'cider-test-success-face))) - (concat (if (= 1 ns) ; ns count from summary - (cider-propertize (car (nrepl-dict-keys results)) 'ns) - (propertize (format "%d namespaces" ns) 'face 'default)) - (propertize ": " 'face 'default)) - test var fail error ms))))) - -;;; Test definition highlighting -;; -;; On receipt of test results, failing/erring test definitions are highlighted. -;; Highlights are cleared on the next report run, and may be cleared manually -;; by the user. - -;; NOTE If keybindings specific to test sources are desired, it would be -;; straightforward to turn this into a `cider-test-mode' minor mode, which we -;; enable on test sources, much like the legacy `clojure-test-mode'. At present, -;; though, there doesn't seem to be much value in this, since the report buffer -;; provides the primary means of interacting with test results. - -(defun cider-test-highlight-problem (buffer test) - "Highlight the BUFFER test definition for the non-passing TEST." - (with-current-buffer buffer - ;; we don't need the file name here, as we always operate on the current - ;; buffer and the line data is correct even for vars that were - ;; defined interactively - (nrepl-dbind-response test (type line message expected actual) - (when line - (save-excursion - (goto-char (point-min)) - (forward-line (1- line)) - (search-forward "(" nil t) - (let ((beg (point))) - (forward-sexp) - (cider--make-overlay beg (point) 'cider-test - 'font-lock-face (cider-test-type-face type) - 'type type - 'help-echo message - 'message message - 'expected expected - 'actual actual))))))) - -(defun cider-find-var-file (ns var) - "Return the buffer visiting the file in which the NS VAR is defined. -Or nil if not found." - (when-let* ((info (cider-var-info (concat ns "/" var))) - (file (nrepl-dict-get info "file"))) - (cider-find-file file))) - -(defun cider-test-highlight-problems (results) - "Highlight all non-passing tests in the test RESULTS." - (nrepl-dict-map - (lambda (ns vars) - (nrepl-dict-map - (lambda (var tests) - (when-let* ((buffer (cider-find-var-file ns var))) - (dolist (test tests) - (nrepl-dbind-response test (type) - (unless (equal "pass" type) - (cider-test-highlight-problem buffer test)))))) - vars)) - results)) - -(defun cider-test-clear-highlights () - "Clear highlighting of non-passing tests from the last test run." - (interactive) - (when cider-test-last-results - (nrepl-dict-map - (lambda (ns vars) - (dolist (var (nrepl-dict-keys vars)) - (when-let* ((buffer (cider-find-var-file ns var))) - (with-current-buffer buffer - (remove-overlays nil nil 'category 'cider-test))))) - cider-test-last-results))) - - -;;; Test namespaces -;; -;; Test namespace inference exists to enable DWIM test running functions: the -;; same "run-tests" function should be able to be used in a source file, and in -;; its corresponding test namespace. To provide this, we need to map the -;; relationship between those namespaces. - -(defcustom cider-test-infer-test-ns 'cider-test-default-test-ns-fn - "Function to infer the test namespace for NS. -The default implementation uses the simple Leiningen convention of appending -'-test' to the namespace name." - :type 'symbol - :package-version '(cider . "0.7.0")) - -(defun cider-test-default-test-ns-fn (ns) - "For a NS, return the test namespace, which may be the argument itself. -This uses the Leiningen convention of appending '-test' to the namespace name." - (when ns - (let ((suffix "-test")) - (if (string-suffix-p suffix ns) - ns - (concat ns suffix))))) - - -;;; Test execution - -(defcustom cider-test-default-include-selectors '() - "List of include selector strings to use when executing tests if none provided." - :type '(repeat string) - :package-version '(cider . "1.1.0")) - -(defcustom cider-test-default-exclude-selectors '() - "List of exclude selector strings to use when executing tests if none provided." - :type '(repeat string) - :package-version '(cider . "1.1.0")) - -(declare-function cider-emit-interactive-eval-output "cider-eval") -(declare-function cider-emit-interactive-eval-err-output "cider-eval") - -(defun cider-test--prompt-for-selectors (message) - "Prompt for test selectors with MESSAGE. -The selectors can be either keywords or strings." - (mapcar - (lambda (string) (replace-regexp-in-string "^:+" "" string)) - (split-string - (cider-read-from-minibuffer message)))) - -(defcustom cider-test-fail-fast t - "Controls whether to stop a test run on failure/error." - :type 'boolean - :package-version '(cider . "1.8.0")) - -(defun cider-test-execute (ns &optional tests silent prompt-for-filters) - "Run tests for NS, which may be a keyword, optionally specifying TESTS. -This tests a single NS, or multiple namespaces when using keywords `:project', -`:loaded' or `:non-passing'. Optional TESTS are only honored when a single -namespace is specified. Upon test completion, results are echoed and a test -report is optionally displayed. When test failures/errors occur, their sources -are highlighted. -If SILENT is non-nil, suppress all messages other then test results. -If PROMPT-FOR-FILTERS is non-nil, prompt the user for a test selector filters. -The include/exclude selectors will be used to filter the tests before -running them." - (cider-test-clear-highlights) - (let ((include-selectors - (if prompt-for-filters - (cider-test--prompt-for-selectors - "Test selectors to include (space separated): ") - cider-test-default-include-selectors)) - (exclude-selectors - (if prompt-for-filters - (cider-test--prompt-for-selectors - "Test selectors to exclude (space separated): ") - cider-test-default-exclude-selectors))) - (cider-map-repls :clj-strict - (lambda (conn) - (unless silent - (if (and tests (= (length tests) 1)) - ;; we generate a different message when running individual tests - (cider-test-echo-running ns (car tests)) - (cider-test-echo-running ns))) - (setq cider-test--current-repl conn) - (let* ((retest? (eq :non-passing ns)) - (request `("op" ,(cond ((stringp ns) "test") - ((eq :project ns) "test-all") - ((eq :loaded ns) "test-all") - (retest? "retest"))))) - ;; we add optional parts of the request only when relevant - (when (and (listp include-selectors) include-selectors) - (setq request (append request `("include" ,include-selectors)))) - (when (and (listp exclude-selectors) exclude-selectors) - (setq request (append request `("exclude" ,exclude-selectors)))) - (when (stringp ns) - (setq request (append request `("ns" ,ns)))) - (when (stringp ns) - (setq request (append request `("tests" ,tests)))) - (when (or (stringp ns) (eq :project ns)) - (setq request (append request `("load?" ,"true")))) - (when (and cider-test-fail-fast - (not retest?)) - (setq request (append request `("fail-fast" ,"true")))) - (cider-nrepl-send-request - request - (lambda (response) - (nrepl-dbind-response response (summary results status out err elapsed-time ns-elapsed-time var-elapsed-time) - (cond ((member "namespace-not-found" status) - (unless silent - (message "No test namespace: %s" (cider-propertize ns 'ns)))) - (out (cider-emit-interactive-eval-output out)) - (err (cider-emit-interactive-eval-err-output err)) - (results - (nrepl-dbind-response summary (error fail) - (setq cider-test-last-summary summary) - (setq cider-test-last-results results) - (cider-test-highlight-problems results) - (cider-test-echo-summary summary results elapsed-time) - (if (or (not (zerop (+ error fail))) - cider-test-show-report-on-success) - (let ((b (cider-popup-buffer - cider-test-report-buffer - cider-auto-select-test-report-buffer))) - (with-current-buffer b - ;; Change the default-directory so that it doesn't affect `sesman--linked-sessions` logic: - (setq-local default-directory - (with-current-buffer "*Messages*" default-directory))) - (cider-test-render-report - b - summary - results - elapsed-time - ns-elapsed-time - var-elapsed-time)) - (when (get-buffer cider-test-report-buffer) - (with-current-buffer cider-test-report-buffer - (let ((inhibit-read-only t)) - (erase-buffer))) - (cider-test-render-report - cider-test-report-buffer - summary - results - elapsed-time - ns-elapsed-time)))))))) - conn)))))) - -(defun cider-test-rerun-failed-tests () - "Rerun failed and erring tests from the last test run." - (interactive) - (if cider-test-last-summary - (nrepl-dbind-response cider-test-last-summary (fail error) - (if (not (zerop (+ error fail))) - (cider-test-execute :non-passing) - (message "No prior failures to retest"))) - (message "No prior results to retest"))) - -(defun cider-test-run-loaded-tests (prompt-for-filters) - "Run all tests defined in currently loaded namespaces. - -If PROMPT-FOR-FILTERS is non-nil, prompt the user for a test selectors to -filter the tests with." - (interactive "P") - (cider-test-execute :loaded nil nil prompt-for-filters)) - -(defun cider-test-run-project-tests (prompt-for-filters) - "Run all tests defined in all project namespaces, loading these as needed. - -If PROMPT-FOR-FILTERS is non-nil, prompt the user for a test selectors to -filter the tests with." - (interactive "P") - (cider-test-execute :project nil nil prompt-for-filters)) - -(defun cider-test-run-ns-tests-with-filters (suppress-inference) - "Run tests filtered by selectors for the current Clojure namespace context. - -With a prefix arg SUPPRESS-INFERENCE it will try to run the tests in the -current ns." - (interactive "P") - (cider-test-run-ns-tests suppress-inference nil 't)) - -(defun cider-test-run-ns-tests (suppress-inference &optional silent prompt-for-filters) - "Run all tests for the current Clojure namespace context. - -If SILENT is non-nil, suppress all messages other then test results. -With a prefix arg SUPPRESS-INFERENCE it will try to run the tests in the -current ns. If PROMPT-FOR-FILTERS is non-nil, prompt the user for -test selectors to filter the tests with." - (interactive "P") - (if-let* ((ns (if suppress-inference - (cider-current-ns t) - (funcall cider-test-infer-test-ns (cider-current-ns t))))) - (cider-test-execute ns nil silent prompt-for-filters) - (if (eq major-mode 'cider-test-report-mode) - (when (y-or-n-p (concat "Test report does not define a namespace. " - "Rerun failed/erring tests?")) - (cider-test-rerun-failed-tests)) - (unless silent - (message "No namespace to test in current context"))))) - -(defvar cider-test-last-test-ns nil - "The ns of the last test ran with `cider-test-run-test'.") -(defvar cider-test-last-test-var nil - "The var of the last test ran with `cider-test-run-test'.") - -(defun cider-test-update-last-test (ns var) - "Update the last test by setting NS and VAR. - -See `cider-test-rerun-test'." - (setq cider-test-last-test-ns ns - cider-test-last-test-var var)) - -(defun cider--test-var-p (ns var) - "Determines if the VAR in NS is a test." - (if (cider-nrepl-op-supported-p "cider/get-state") - (cider-resolve--get-in ns "interns" var "test") - (equal "true" - (nrepl-dict-get (cider-sync-tooling-eval - (format "(clojure.core/-> %s var clojure.core/meta (clojure.core/contains? :test))" - var) - ns) - "value")))) - -(defun cider--extract-test-var-at-point () - "Find ns and var for the test at point. -The test ns/var exist as text properties on report items and on highlighted -failed/erred test definitions. - -When not found, a test definition at point -or in a corresponding test namespace is searched." - (let* ((ns-from-text-property (get-text-property (point) 'ns)) - (var-from-text-property (when ns-from-text-property - ;; we're in a `cider-test-report-mode' buffer - ;; or on a highlighted failed/erred test definition - (get-text-property (point) 'var)))) - (or (when (and var-from-text-property - ;; Slightly redundant check. However querying `cider-resolve--get-in` is cheap: - (cider--test-var-p ns-from-text-property var-from-text-property)) - (list ns-from-text-property var-from-text-property)) - (when-let* ((n (cider-get-ns-name)) - (v (cadr (clojure-find-def)))) - (or (when (cider--test-var-p n v) - (list n v)) - (let ((derived-ns (funcall cider-test-infer-test-ns n)) - (derived-var (concat v "-test"))) - ;; deftest foo-test: - (or (when (cider--test-var-p derived-ns derived-var) - (list derived-ns derived-var)) - ;; deftest foo (less usual, but quite frequent): - (when (cider--test-var-p derived-ns v) - (list derived-ns v))))))))) - -(defun cider-test-run-test () - "Run the test at point. -The test ns/var exist as text properties on report items and on highlighted -failed/erred test definitions. - -When not found, a test definition at point -or in a corresponding test namespace is searched." - (interactive) - (let* ((found (cider--extract-test-var-at-point)) - (found-ns (car found)) - (found-var (cadr found))) - (if (not found-var) - (message "No test found at point") - (cider-test-update-last-test found-ns (list found-var)) - (cider-test-execute found-ns (list found-var))))) - -(defun cider-test-rerun-test () - "Re-run the test that was previously ran." - (interactive) - (if (and cider-test-last-test-ns cider-test-last-test-var) - (cider-test-execute cider-test-last-test-ns cider-test-last-test-var) - (user-error "No test to re-run"))) - -;;; Auto-test mode -(defun cider--test-silently () - "Like `cider-test-run-tests', but with less feedback. -Only notify the user if there actually were any tests to run and only after -the results are received." - (when (cider-connected-p) - (let ((cider-auto-select-test-report-buffer nil) - (cider-test-show-report-on-success nil)) - (cider-test-run-ns-tests nil 'soft)))) - -;;;###autoload -(define-minor-mode cider-auto-test-mode - "Toggle automatic testing of Clojure files. - -When enabled this reruns tests every time a Clojure file is loaded. -Only runs tests corresponding to the loaded file's namespace and does -nothing if no tests are defined or if the file failed to load." - :init-value nil :lighter (cider-mode " Test") :keymap nil - :global t - (if cider-auto-test-mode - (add-hook 'cider-file-loaded-hook #'cider--test-silently) - (remove-hook 'cider-file-loaded-hook #'cider--test-silently))) - -(provide 'cider-test) - -;;; cider-test.el ends here diff --git a/elpa/cider-1.12.0/cider-tracing.el b/elpa/cider-1.12.0/cider-tracing.el @@ -1,90 +0,0 @@ -;;; cider-tracing.el --- Executing tracing functionality -*- lexical-binding: t -*- - -;; Copyright © 2013-2023 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; -;; Author: Bozhidar Batsov <bozhidar@batsov.dev> -;; Artur Malabarba <bruce.connor.am@gmail.com> - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; A couple of commands for tracing the execution of functions. - -;;; Code: - -(require 'cider-client) -(require 'cider-common) ; for `cider-prompt-for-symbol-function' -(require 'cider-util) ; for `cider-propertize' -(require 'cider-connection) ; for `cider-map-repls' -(require 'nrepl-dict) - -(defun cider-sync-request:toggle-trace-var (sym) - "Toggle var tracing for SYM." - (thread-first `("op" "toggle-trace-var" - "ns" ,(cider-current-ns) - "sym" ,sym) - (cider-nrepl-send-sync-request))) - -(defun cider--toggle-trace-var (sym) - "Toggle var tracing for SYM." - (let* ((trace-response (cider-sync-request:toggle-trace-var sym)) - (var-name (nrepl-dict-get trace-response "var-name")) - (var-status (nrepl-dict-get trace-response "var-status"))) - (pcase var-status - ("not-found" (error "Var %s not found" (cider-propertize sym 'fn))) - ("not-traceable" (error "Var %s can't be traced because it's not bound to a function" (cider-propertize var-name 'fn))) - (_ (message "Var %s %s" (cider-propertize var-name 'fn) var-status))))) - -;;;###autoload -(defun cider-toggle-trace-var (arg) - "Toggle var tracing. -Prompts for the symbol to use, or uses the symbol at point, depending on -the value of `cider-prompt-for-symbol'. With prefix arg ARG, does the -opposite of what that option dictates." - (interactive "P") - (cider-ensure-op-supported "toggle-trace-var") - (funcall (cider-prompt-for-symbol-function arg) - "Toggle trace for var" - #'cider--toggle-trace-var)) - -(defun cider-sync-request:toggle-trace-ns (ns) - "Toggle namespace tracing for NS." - (thread-first `("op" "toggle-trace-ns" - "ns" ,ns) - (cider-nrepl-send-sync-request))) - -;;;###autoload -(defun cider-toggle-trace-ns (query) - "Toggle ns tracing. -Defaults to the current ns. With prefix arg QUERY, prompts for a ns." - (interactive "P") - (cider-map-repls :clj-strict - (lambda (conn) - (with-current-buffer conn - (cider-ensure-op-supported "toggle-trace-ns") - (let ((ns (if query - (completing-read "Toggle trace for ns: " - (cider-sync-request:ns-list)) - (cider-current-ns)))) - (let* ((trace-response (cider-sync-request:toggle-trace-ns ns)) - (ns-status (nrepl-dict-get trace-response "ns-status"))) - (pcase ns-status - ("not-found" (error "Namespace %s not found" (cider-propertize ns 'ns))) - (_ (message "Namespace %s %s" (cider-propertize ns 'ns) ns-status))))))))) - -(provide 'cider-tracing) -;;; cider-tracing.el ends here diff --git a/elpa/cider-1.12.0/cider-util.el b/elpa/cider-1.12.0/cider-util.el @@ -1,817 +0,0 @@ -;; cider-util.el --- Common utility functions that don't belong anywhere else -*- lexical-binding: t -*- - -;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2023 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; -;; Author: Tim King <kingtim@gmail.com> -;; Phil Hagelberg <technomancy@gmail.com> -;; Bozhidar Batsov <bozhidar@batsov.dev> -;; Artur Malabarba <bruce.connor.am@gmail.com> -;; Hugo Duncan <hugo@hugoduncan.org> -;; Steve Purcell <steve@sanityinc.com> - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Common utility functions that don't belong anywhere else. - -;;; Code: - -;; Built-ins -(require 'ansi-color) -(require 'color) -(require 'seq) -(require 'subr-x) -(require 'thingatpt) - -;; clojure-mode and CIDER -(require 'clojure-mode) - -(defalias 'cider-pop-back #'pop-tag-mark) - -(defcustom cider-font-lock-max-length 10000 - "The max length of strings to fontify in `cider-font-lock-as'. - -Setting this to nil removes the fontification restriction." - :group 'cider - :type 'boolean - :package-version '(cider . "0.10.0")) - -(defun cider-util--hash-keys (hashtable) - "Return a list of keys in HASHTABLE." - (let ((keys '())) - (maphash (lambda (k _v) (setq keys (cons k keys))) hashtable) - keys)) - -(defun cider-util--clojure-buffers () - "Return a list of all existing `clojure-mode' buffers." - (seq-filter - (lambda (buffer) (with-current-buffer buffer (derived-mode-p 'clojure-mode))) - (buffer-list))) - -(defun cider-current-dir () - "Return the directory of the current buffer." - (if buffer-file-name - (file-name-directory buffer-file-name) - default-directory)) - -(defun cider-in-string-p () - "Return non-nil if point is in a string." - (let ((beg (save-excursion (beginning-of-defun-raw) (point)))) - (nth 3 (parse-partial-sexp beg (point))))) - -(defun cider-in-comment-p () - "Return non-nil if point is in a comment." - (let ((beg (save-excursion (beginning-of-defun-raw) (point)))) - (nth 4 (parse-partial-sexp beg (point))))) - -(defun cider--tooling-file-p (file-name) - "Return t if FILE-NAME is not a 'real' source file. -Currently, only check if the relative file name starts with 'form-init' -which nREPL uses for temporary evaluation file names." - (let ((fname (file-name-nondirectory file-name))) - (string-match-p "^form-init" fname))) - -(defun cider--cljc-buffer-p (&optional buffer) - "Return non-nil if the current buffer is visiting a cljc file. - -If BUFFER is provided act on that buffer instead." - (with-current-buffer (or buffer (current-buffer)) - (or (derived-mode-p 'clojurec-mode)))) - - -;;; Thing at point - -(defun cider--text-or-limits (bounds start end) - "Returns the substring or the bounds of text. -If BOUNDS is non-nil, returns the list (START END) of character -positions. Else returns the substring from START to END." - (funcall (if bounds #'list #'buffer-substring-no-properties) - start end)) - -(defun cider-defun-at-point (&optional bounds) - "Return the text of the top level sexp at point. -If BOUNDS is non-nil, return a list of its starting and ending position -instead." - (save-excursion - (save-match-data - (if (derived-mode-p 'cider-repl-mode) - (goto-char (point-max)) ;; in repls, end-of-defun won't work, so we perform the closest reasonable thing - (end-of-defun)) - (let ((end (point))) - (clojure-backward-logical-sexp 1) - (cider--text-or-limits bounds (point) end))))) - -(defun cider-get-ns-name () - "Calls `clojure-find-ns', suppressing any errors. -Therefore, possibly returns nil, -so please handle that value from any callsites." - (clojure-find-ns :supress-errors)) - -(defun cider-ns-form () - "Retrieve the ns form." - (when (cider-get-ns-name) - (save-excursion - (goto-char (match-beginning 0)) - (cider-defun-at-point)))) - -(defun cider-symbol-at-point (&optional look-back) - "Return the name of the symbol at point, otherwise nil. -Ignores the REPL prompt. If LOOK-BACK is non-nil, move backwards trying to -find a symbol if there isn't one at point. -Does not strip the : from keywords, nor attempt to expand :: auto-resolved -keywords." - (or (when-let* ((str (thing-at-point 'symbol))) - (unless (text-property-any 0 (length str) 'field 'cider-repl-prompt str) - ;; remove font-locking - (setq str (substring-no-properties str)) - (if (member str '("." "..")) - str - ;; Remove prefix quotes, and trailing . from constructors like Record. - (thread-last - str - ;; constructors (Foo.) - (string-remove-suffix ".") - ;; quoted symbols ('sym) - (string-remove-prefix "'") - ;; var references (#'inc 2) - (string-remove-prefix "#'"))))) - (when look-back - (save-excursion - (ignore-errors - (when (looking-at "(") - (forward-char 1)) - (while (not (looking-at "\\sw\\|\\s_\\|\\`")) - (forward-sexp -1))) - (cider-symbol-at-point))))) - - -;;; sexp navigation -(defun cider-sexp-at-point (&optional bounds) - "Return the sexp at point as a string, otherwise nil. -If BOUNDS is non-nil, return a list of its starting and ending position -instead." - (when-let* ((b (or (and (equal (char-after) ?\() - (member (char-before) '(?\' ?\, ?\@)) - ;; hide stuff before ( to avoid quirks with '( etc. - (save-restriction - (narrow-to-region (point) (point-max)) - (bounds-of-thing-at-point 'sexp))) - (bounds-of-thing-at-point 'sexp)))) - (funcall (if bounds #'list #'buffer-substring-no-properties) - (car b) (cdr b)))) - -(defun cider-list-at-point (&optional bounds) - "Return the list (compound form) at point as a string, otherwise nil. -If BOUNDS is non-nil, return a list of its starting and ending position -instead." - (when-let* ((b (or (and (equal (char-after) ?\() - (member (char-before) '(?\' ?\, ?\@)) - ;; hide stuff before ( to avoid quirks with '( etc. - (save-restriction - (narrow-to-region (point) (point-max)) - (bounds-of-thing-at-point 'list))) - (bounds-of-thing-at-point 'list)))) - (funcall (if bounds #'list #'buffer-substring-no-properties) - (car b) (cdr b)))) - -(defun cider-last-sexp (&optional bounds) - "Return the sexp preceding the point. -If BOUNDS is non-nil, return a list of its starting and ending position -instead." - (apply (if bounds #'list #'buffer-substring-no-properties) - (save-excursion - (clojure-backward-logical-sexp 1) - (list (point) - (progn (clojure-forward-logical-sexp 1) - (point)))))) - -(defun cider-start-of-next-sexp (&optional skip) - "Move to the start of the next sexp. -Skip any non-logical sexps like ^metadata or #reader macros. -If SKIP is an integer, also skip that many logical sexps first. -Can only error if SKIP is non-nil." - (while (clojure--looking-at-non-logical-sexp) - (forward-sexp 1)) - (when (and skip (> skip 0)) - (dotimes (_ skip) - (forward-sexp 1) - (cider-start-of-next-sexp)))) - -(defun cider-second-sexp-in-list () - "Return the second sexp in the list at point." - (condition-case nil - (save-excursion - (backward-up-list) - (forward-char) - (forward-sexp 2) - (cider-sexp-at-point)) - (error nil))) - -;;; Text properties - -(defun cider-maybe-intern (name) - "If NAME is a symbol, return it; otherwise, intern it." - (if (symbolp name) name (intern name))) - -(defun cider-intern-keys (plist) - "Copy PLIST, with any non-symbol keys replaced with symbols." - (when plist - (cons (cider-maybe-intern (pop plist)) - (cons (pop plist) (cider-intern-keys plist))))) - -(defmacro cider-propertize-region (props &rest body) - "Execute BODY and add PROPS to all the inserted text. -More precisely, PROPS are added to the region between the point's -positions before and after executing BODY." - (declare (indent 1) - (debug (sexp body))) - (let ((start (make-symbol "start"))) - `(let ((,start (point))) - (prog1 (progn ,@body) - (add-text-properties ,start (point) ,props))))) - -(put 'cider-propertize-region 'lisp-indent-function 1) - -(defun cider-property-bounds (prop) - "Return the the positions of the previous and next change to PROP. -PROP is the name of a text property." - (let ((end (next-single-char-property-change (point) prop))) - (list (previous-single-char-property-change end prop) end))) - -(defun cider-insert (text &optional face break more-text) - "Insert TEXT with FACE, optionally followed by a line BREAK and MORE-TEXT." - (insert (if face (propertize text 'font-lock-face face) text)) - (when more-text (insert more-text)) - (when break (insert "\n"))) - - -;;; Hooks - -(defun cider-run-chained-hook (hook arg) - "Like `run-hook-with-args' but pass intermediate return values through. -HOOK is a name of a hook (a symbol). You can use `add-hook' or -`remove-hook' to add functions to this variable. ARG is passed to first -function. Its return value is passed to the second function and so forth -till all functions are called or one of them returns nil. Return the value -return by the last called function." - (let ((functions (copy-sequence (symbol-value hook)))) - (while (and functions arg) - (if (eq (car functions) t) - ;; global value of the hook - (let ((functions (default-value hook))) - (while (and functions arg) - (setq arg (funcall (car functions) arg)) - (setq functions (cdr functions)))) - (setq arg (funcall (car functions) arg))) - (setq functions (cdr functions))) - arg)) - - -;;; Font lock - -(defvar cider--mode-buffers nil - "A list of buffers for different major modes.") - -(defun cider--make-buffer-for-mode (mode) - "Return a temp buffer using `major-mode' MODE. -This buffer is not designed to display anything to the user. For that, use -`cider-make-popup-buffer' instead." - (setq cider--mode-buffers (seq-filter (lambda (x) (buffer-live-p (cdr x))) - cider--mode-buffers)) - (or (cdr (assq mode cider--mode-buffers)) - (let ((b (generate-new-buffer (format " *cider-temp %s*" mode)))) - (push (cons mode b) cider--mode-buffers) - (with-current-buffer b - ;; suppress major mode hooks as we care only about their font-locking - ;; otherwise modes like whitespace-mode and paredit might interfere - (setq-local delay-mode-hooks t) - (setq delayed-mode-hooks nil) - (funcall mode)) - b))) - -(defun cider-ansi-color-string-p (string) - "Return non-nil if STRING is an ANSI string." - (string-match "^\\[" string)) - -(defun cider-font-lock-as (mode string) - "Use MODE to font-lock the STRING." - (let ((string (if (cider-ansi-color-string-p string) - (substring-no-properties (ansi-color-apply string)) - string))) - (if (or (null cider-font-lock-max-length) - (< (length string) cider-font-lock-max-length)) - (with-current-buffer (cider--make-buffer-for-mode mode) - (erase-buffer) - (insert string) - ;; don't try to font-lock unbalanced Clojure code - (when (eq mode 'clojure-mode) - (check-parens)) - (font-lock-fontify-region (point-min) (point-max)) - (buffer-string)) - string))) - -(defun cider-font-lock-region-as (mode beg end &optional buffer) - "Use MODE to font-lock text between BEG and END. - -Unless you specify a BUFFER it will default to the current one." - (with-current-buffer (or buffer (current-buffer)) - (let ((text (buffer-substring beg end))) - (delete-region beg end) - (goto-char beg) - (insert (cider-font-lock-as mode text))))) - -(defun cider-font-lock-as-clojure (string) - "Font-lock STRING as Clojure code." - ;; If something goes wrong (e.g. the code is not balanced) - ;; we simply return the string. - (condition-case nil - (cider-font-lock-as 'clojure-mode string) - (error string))) - -;; Button allowing use of `font-lock-face', ignoring any inherited `face' -(define-button-type 'cider-plain-button - 'face nil) - -(defun cider-add-face (regexp face &optional foreground-only sub-expr object) - "Propertize all occurrences of REGEXP with FACE. -If FOREGROUND-ONLY is non-nil, change only the foreground of matched -regions. SUB-EXPR is a sub-expression of REGEXP to be -propertized (defaults to 0). OBJECT is an object to be -propertized (defaults to current buffer)." - (setq sub-expr (or sub-expr 0)) - (when (and regexp face) - (let ((beg 0) - (end 0)) - (with-current-buffer (or (and (bufferp object) object) - (current-buffer)) - (while (if (stringp object) - (string-match regexp object end) - (re-search-forward regexp nil t)) - (setq beg (match-beginning sub-expr) - end (match-end sub-expr)) - (if foreground-only - (let ((face-spec (list (cons 'foreground-color - (face-attribute face :foreground nil t))))) - (font-lock-prepend-text-property beg end 'face face-spec object)) - (put-text-property beg end 'face face object))))))) - - -;;; Colors - -(defun cider-scale-background-color () - "Scale the current background color to get a slighted muted version." - (let ((color (frame-parameter nil 'background-color)) - (darkp (eq (frame-parameter nil 'background-mode) 'dark))) - (unless (equal "unspecified-bg" color) - (color-lighten-name color (if darkp 5 -5))))) - -(defvar cider-version) -(defvar cider-codename) - -(defun cider--pkg-version () - "Extract CIDER's package version from its package metadata." - ;; Use `cond' below to avoid a compiler unused return value warning - ;; when `package-get-version' returns nil. See #3181. - ;; FIXME: Inline the logic from package-get-version and adapt it - (cond ((fboundp 'package-get-version) - (package-get-version)))) - -(defun cider--version () - "Retrieve CIDER's version. -A codename is added to stable versions." - (if (string-match-p "-snapshot" cider-version) - (let ((pkg-version (cider--pkg-version))) - (if pkg-version - ;; snapshot versions include the MELPA package version - (format "%s (package: %s)" cider-version pkg-version) - cider-version)) - ;; stable versions include the codename of the release - (format "%s (%s)" cider-version cider-codename))) - - -;;; Strings - -(defun cider-join-into-alist (candidates &optional separator) - "Make an alist from CANDIDATES. -The keys are the elements joined with SEPARATOR and values are the original -elements. Useful for `completing-read' when candidates are complex -objects." - (mapcar (lambda (el) - (if (listp el) - (cons (string-join el (or separator ":")) el) - (cons el el))) - candidates)) - -(defun cider-add-to-alist (symbol car cadr) - "Add '(CAR CADR) to the alist stored in SYMBOL. -If CAR already corresponds to an entry in the alist, destructively replace -the entry's second element with CADR. - -This can be used, for instance, to update the version of an injected -plugin or dependency with: - (cider-add-to-alist 'cider-jack-in-lein-plugins - \"plugin/artifact-name\" \"THE-NEW-VERSION\")" - (let ((alist (symbol-value symbol))) - (if-let* ((cons (assoc car alist))) - (setcdr cons (list cadr)) - (set symbol (cons (list car cadr) alist))))) - -(defun cider-namespace-qualified-p (sym) - "Return t if SYM is namespace-qualified." - (string-match-p "[^/]+/" sym)) - -(defvar cider-version) - -(defconst cider-manual-url "https://docs.cider.mx/cider/%s" - "The URL to CIDER's manual.") - -(defun cider-version-sans-patch () - "Return the version sans that patch." - (string-join (seq-take (split-string cider-version "\\.") 2) ".")) - -(defun cider--manual-version () - "Convert the version to a ReadTheDocs-friendly version." - (if (string-match-p "-snapshot" cider-version) - "" - (concat (cider-version-sans-patch) "/"))) - -(defun cider-manual-url () - "The CIDER manual's url." - (format cider-manual-url (cider--manual-version))) - -;;;###autoload -(defun cider-view-manual () - "View the manual in your default browser." - (interactive) - (browse-url (cider-manual-url))) - -(defun cider--manual-button (label section-id) - "Return a button string that links to the online manual. -LABEL is the displayed string, and SECTION-ID is where it points -to." - (with-temp-buffer - (insert-text-button - label - 'follow-link t - 'action (lambda (&rest _) (interactive) - (browse-url (concat (cider-manual-url) - section-id)))) - (buffer-string))) - -(defconst cider-refcard-url "https://github.com/clojure-emacs/cider/raw/%s/refcard/cider-refcard.pdf" - "The URL to CIDER's refcard.") - -(defun cider--github-version () - "Convert the version to a GitHub-friendly version." - (if (string-match-p "-snapshot" cider-version) - "master" - (concat "v" cider-version))) - -(defun cider-refcard-url () - "The CIDER manual's url." - (format cider-refcard-url (cider--github-version))) - -(defun cider-view-refcard () - "View the refcard in your default browser." - (interactive) - (browse-url (cider-refcard-url))) - -(defconst cider-report-bug-url "https://github.com/clojure-emacs/cider/issues/new" - "The URL to report a CIDER issue.") - -(defun cider-report-bug () - "Report a bug in your default browser." - (interactive) - (browse-url cider-report-bug-url)) - -(defun cider--project-name (dir) - "Extracts a project name from DIR, possibly nil. -The project name is the final component of DIR if not nil." - (when dir - (file-name-nondirectory (directory-file-name dir)))) - -;;; Vectors -(defun cider--deep-vector-to-list (x) - "Convert vectors in X to lists. -If X is a sequence, return a list of `cider--deep-vector-to-list' applied to -each of its elements. -Any other value is just returned." - (if (sequencep x) - (mapcar #'cider--deep-vector-to-list x) - x)) - - -;;; Help mode - -;; Same as https://github.com/emacs-mirror/emacs/blob/86d083438dba60dc00e9e96414bf7e832720c05a/lisp/help-mode.el#L355 -;; the original function uses some buffer local variables, but the buffer used -;; is not configurable. It defaults to (help-buffer) - -(defun cider--help-setup-xref (item interactive-p buffer) - "Invoked from commands using the \"*Help*\" buffer to install some xref info. - -ITEM is a (FUNCTION . ARGS) pair appropriate for recreating the help -buffer after following a reference. INTERACTIVE-P is non-nil if the -calling command was invoked interactively. In this case the stack of -items for help buffer \"back\" buttons is cleared. Use BUFFER for the -buffer local variables. - -This should be called very early, before the output buffer is cleared, -because we want to record the \"previous\" position of point so we can -restore it properly when going back." - (with-current-buffer buffer - (when help-xref-stack-item - (push (cons (point) help-xref-stack-item) help-xref-stack) - (setq help-xref-forward-stack nil)) - (when interactive-p - (let ((tail (nthcdr 10 help-xref-stack))) - ;; Truncate the stack. - (if tail (setcdr tail nil)))) - (setq help-xref-stack-item item))) - -(defcustom cider-doc-xref-regexp - (eval-and-compile - (rx-to-string - `(or (: "`" (group-n 1 (+ (not space))) "`") ; `var` - (: "[[" (group-n 1 (+ (not space))) "]]") ; [[var]] - (group-n 1 (regexp ,clojure--sym-regexp) "/" (regexp ,clojure--sym-regexp))))) ;; Fully qualified - "The regexp used to search Clojure vars in doc buffers." - :type 'regexp - :safe #'stringp - :group 'cider - :package-version '(cider . "0.13.0")) - -(defun cider--find-symbol-xref () - "Parse and return the first clojure symbol in current buffer. -Use `cider-doc-xref-regexp' for the search. Set match data and return a -string of the Clojure symbol. Return nil if there are no more matches in -the buffer." - (when (re-search-forward cider-doc-xref-regexp nil t) - (match-string 1))) - -(declare-function cider-doc-lookup "cider-doc") -(declare-function cider--eldoc-remove-dot "cider-eldoc") - -;; Taken from: https://github.com/emacs-mirror/emacs/blob/65c8c7cb96c14f9c6accd03cc8851b5a3459049e/lisp/help-mode.el#L551-L565 -(defun cider--make-back-forward-xrefs (&optional buffer) - "Insert special references `back' and `forward', as in `help-make-xrefs'. - -Optional argument BUFFER is the buffer in which to insert references. -Default is current buffer." - (with-current-buffer (or buffer (current-buffer)) - (insert "\n") - (when (or help-xref-stack help-xref-forward-stack) - (insert "\n")) - ;; Make a back-reference in this buffer if appropriate. - (when help-xref-stack - (help-insert-xref-button help-back-label 'help-back - (current-buffer))) - ;; Make a forward-reference in this buffer if appropriate. - (when help-xref-forward-stack - (when help-xref-stack - (insert "\t")) - (help-insert-xref-button help-forward-label 'help-forward - (current-buffer))) - (when (or help-xref-stack help-xref-forward-stack) - (insert "\n")))) - -;; Similar to https://github.com/emacs-mirror/emacs/blob/65c8c7cb96c14f9c6accd03cc8851b5a3459049e/lisp/help-mode.el#L404 -(defun cider--doc-make-xrefs () - "Parse and hyperlink documentation cross-references in current buffer. -Find cross-reference information in a buffer and activate such cross -references for selection with `help-xref'. Cross-references are parsed -using `cider--find-symbol-xref'. - -Special references `back' and `forward' are made to go back and forth -through a stack of help buffers. Variables `help-back-label' and -`help-forward-label' specify the text for that." - (interactive "b") - - ;; parse the docstring and create xrefs for symbols - (save-excursion - (goto-char (point-min)) - (let ((symbol)) - (while (setq symbol (cider--find-symbol-xref)) - (replace-match "") - (insert-text-button symbol - 'type 'help-xref - 'help-function (apply-partially #'cider-doc-lookup - (cider--eldoc-remove-dot symbol)))))) - (cider--make-back-forward-xrefs)) - - -;;; Words of inspiration -(defun cider-user-first-name () - "Find the current user's first name." - (let ((name (if (string= (user-full-name) "") - (user-login-name) - (user-full-name)))) - (string-match "^[^ ]*" name) - (capitalize (match-string 0 name)))) - -(defvar cider-words-of-inspiration - `("The best way to predict the future is to invent it. -Alan Kay" - "A point of view is worth 80 IQ points. -Alan Kay" - "Lisp isn't a language, it's a building material. -Alan Kay" - "Simple things should be simple, complex things should be possible. -Alan Kay" - "Everything should be as simple as possible, but not simpler. -Albert Einstein" - "Measuring programming progress by lines of code is like measuring aircraft building progress by weight. -Bill Gates" - "Controlling complexity is the essence of computer programming. -Brian Kernighan" - "The unavoidable price of reliability is simplicity. -C.A.R. Hoare" - "You're bound to be unhappy if you optimize everything. -Donald Knuth" - "Simplicity is prerequisite for reliability. -Edsger W. Dijkstra" - "Elegance is not a dispensable luxury but a quality that decides between success and failure. -Edsger W. Dijkstra" - "Deleted code is debugged code. -Jeff Sickel" - "The key to performance is elegance, not battalions of special cases. -Jon Bentley and Doug McIlroy" - "First, solve the problem. Then, write the code. -John Johnson" - "Simplicity is the ultimate sophistication. -Leonardo da Vinci" - "Programming is not about typing... it's about thinking. -Rich Hickey" - "Design is about pulling things apart. -Rich Hickey" - "Programmers know the benefits of everything and the tradeoffs of nothing. -Rich Hickey" - "Code never lies, comments sometimes do. -Ron Jeffries" - "The true delight is in the finding out rather than in the knowing. -Isaac Asimov" - "If paredit is not for you, then you need to become the sort of person that paredit is for. -Phil Hagelberg" - "Express Yourself. -Madonna" - "Put on your red shoes and dance the blues. -David Bowie" - "Do. Or do not. There is no try. -Yoda" - "The enjoyment of one's tools is an essential ingredient of successful work. -Donald E. Knuth" - "Not all those who wander are lost. -J.R.R. Tolkien" - "The best way to learn is to do. -P.R. Halmos" - "If you wish to make an apple pie from scratch, you must first invent the universe. -Carl Sagan" - "Learn the rules like a pro, so you can break them like an artist. -Pablo Picasso" - "The only way of discovering the limits of the possible is to venture a little way past them into the impossible. -Arthur C. Clarke" - "Don't wish it were easier. Wish you were better. -Jim Rohn" - "One chord is fine. Two chords is pushing it. Three chords and you're into jazz. -Lou Reed" - "We are all apprentices in a craft where no one ever becomes a master. -Ernest Hemingway" - "A designer knows he has achieved perfection not when there is nothing left to add, but when there is nothing left to take away. -Antoine de Saint-Exupery" - "Clojure isn't a language, it's a building material." - "Think big!" - "Think bold!" - "Think fun!" - "Code big!" - "Code bold!" - "Code fun!" - "Take this REPL, fellow hacker, and may it serve you well." - "Let the hacking commence!" - "Hacks and glory await!" - "Hack and be merry!" - "Your hacking starts... NOW!" - "May the Source be with you!" - "May the Source shine upon thy REPL!" - "Code long and prosper!" - "Happy hacking!" - "nREPL server is up, CIDER REPL is online!" - "CIDER REPL operational!" - "Your imagination is the only limit to what you can do with this REPL!" - "This REPL is yours to command!" - "Fame is but a hack away!" - "The REPL is not enough, but it is such a perfect place to start..." - "Keep on codin' in the free world!" - "What we do in the REPL echoes in eternity!" - "Evaluating is believing." - "To infinity... and beyond." - "Showtime!" - "Unfortunately, no one can be told what CIDER is. You have to figure this out yourself." - "Procure a bottle of cider to achieve optimum programming results." - "In parentheses we trust!" - "Write you some Clojure for Great Good!" - "Oh, what a day... what a lovely day!" - "What a day! What cannot be accomplished on such a splendid day!" - "Home is where your REPL is." - "The worst day programming is better than the best day working." - "The only thing worse than a rebel without a cause is a REPL without a clause." - "In the absence of parentheses, chaos prevails." - "One REPL to rule them all, One REPL to find them, One REPL to bring them all, and in parentheses bind them!" - "A blank REPL promotes creativity." - "A blank REPL is infinitely better than a blank cheque." - "May your functions be pure, your code concise and your programs a joy to behold!" - ,(format "%s, I've a feeling we're not in Kansas anymore." - (cider-user-first-name)) - ,(format "%s, this could be the start of a beautiful program." - (cider-user-first-name))) - "Scientifically-proven optimal words of hackerish encouragement.") - -(defun cider-random-words-of-inspiration () - "Select a random entry from `cider-words-of-inspiration'." - (nth (random (length cider-words-of-inspiration)) - cider-words-of-inspiration)) - -(defun cider-inspire-me () - "Display a random inspiration message." - (interactive) - (message (cider-random-words-of-inspiration))) - -(defvar cider-tips - '("Press <\\[cider-connect]> to connect to a running nREPL server." - "Press <\\[cider-quit]> to quit the current connection." - "Press <\\[cider-view-manual]> to view CIDER's manual." - "Press <\\[cider-view-refcard]> to view CIDER's refcard." - "Press <\\[describe-mode]> to see a list of the keybindings available (this will work in every Emacs buffer)." - "Press <\\[cider-repl-handle-shortcut]> to quickly invoke some REPL command." - "Press <\\[cider-switch-to-last-clojure-buffer]> to switch between the REPL and a Clojure source buffer." - "Press <\\[cider-doc]> to view the documentation for something (e.g. a var, a Java method)." - "Press <\\[cider-find-resource]> to find a resource on the classpath." - "Press <\\[cider-find-var]> to jump to the source of something (e.g. a var, a Java method)." - "Press <\\[cider-selector]> to quickly select a CIDER buffer." - "Press <\\[cider-test-run-ns-tests]> to run the tests for the current namespace." - "Press <\\[cider-test-run-loaded-tests]> to run all loaded tests." - "Press <\\[cider-test-run-project-tests]> to run all tests for the current project." - "Press <\\[cider-apropos]> to look for a symbol by some search string." - "Press <\\[cider-apropos-documentation]> to look for a symbol that has some string in its docstring." - "Press <\\[cider-eval-defun-at-point]> to eval the top-level form at point." - "Press <\\[cider-eval-dwim]> to eval to run cider-eval-region if a region is active, and cider-eval-defun-at-point otherwise." - "Press <\\[cider-eval-defun-up-to-point]> to eval the top-level form up to the point." - "Press <\\[cider-eval-sexp-up-to-point]> to eval the current form up to the point." - "Press <\\[cider-eval-sexp-at-point]> to eval the current form around the point." - "Press <\\[cider-eval-sexp-at-point-in-context]> to eval the current form around the point in a user-provided context." - "Press <\\[cider-eval-buffer]> to eval the entire source buffer." - "Press <\\[cider-scratch]> to create a Clojure scratchpad. Pretty handy for prototyping." - "Press <\\[cider-read-and-eval]> to evaluate some Clojure expression directly in the minibuffer." - "Press <\\[cider-drink-a-sip]> to get more CIDER tips." - "Press <\\[cider-browse-ns-all]> to start CIDER's namespace browser." - "Press <\\[cider-classpath]> to start CIDER's classpath browser." - "Press <\\[cider-repl-history]> to start CIDER's REPL input history browser." - "Press <\\[cider-macroexpand-1]> to expand the preceding macro." - "Press <\\[cider-inspect]> to inspect the preceding expression's result." - "Press <C-u \\[cider-inspect]> to inspect the defun at point's result." - "Press <C-u C-u \\[cider-inspect]> to read Clojure code from the minibuffer and inspect its result." - "Press <\\[cider-ns-refresh]> to reload modified and unloaded namespaces." - "You can define Clojure functions to be called before and after `cider-ns-refresh' (see `cider-ns-refresh-before-fn' and `cider-ns-refresh-after-fn'." - "Press <\\[cider-describe-connection]> to view information about the connection." - "Press <\\[cider-undef]> to undefine a symbol in the current namespace." - "Press <\\[cider-interrupt]> to interrupt an ongoing evaluation." - "Use <M-x customize-group RET cider RET> to see every possible setting you can customize." - "Use <M-x customize-group RET cider-repl RET> to see every possible REPL setting you can customize." - "Enable `eldoc-mode' to display function & method signatures in the minibuffer." - "Enable `cider-enlighten-mode' to display the locals of a function when it's executed." - "Use <\\[cider-close-ancillary-buffers]> to close all ancillary buffers created by CIDER (e.g. *cider-doc*)." - "Exploring CIDER's menu-bar entries is a great way to discover features." - "Keep in mind that some commands don't have a keybinding by default. Explore CIDER!" - "Tweak `cider-repl-prompt-function' to customize your REPL prompt." - "Tweak `cider-eldoc-ns-function' to customize the way namespaces are displayed by eldoc." - "For no middleware, low-tech and reliable namespace reloading use <\\[cider-ns-reload]>." - "Press <\\[cider-load-buffer-and-switch-to-repl-buffer]> to load the current buffer and switch to the REPL buffer afterwards.") - "Some handy CIDER tips." - ) - -(defun cider-random-tip () - "Select a random tip from `cider-tips'." - (substitute-command-keys (nth (random (length cider-tips)) cider-tips))) - -(defun cider-drink-a-sip () - "Show a random tip." - (interactive) - (message (cider-random-tip))) - -(defun cider-column-number-at-pos (pos) - "Analog to `line-number-at-pos'. -Return buffer column number at position POS." - (save-excursion - (goto-char pos) - ;; we have to adjust the column number by 1 to account for the fact - ;; that Emacs starts counting columns from 0 and Clojure from 1 - (1+ (current-column)))) - -(defun cider-propertize (text kind) - "Propertize TEXT as KIND. -KIND can be the symbols `ns', `var', `emph', `fn', or a face name." - (propertize text 'face (pcase kind - (`fn 'font-lock-function-name-face) - (`method 'font-lock-function-name-face) - (`special-form 'font-lock-keyword-face) - (`macro 'font-lock-keyword-face) - (`var 'font-lock-variable-name-face) - (`ns 'font-lock-type-face) - (`emph 'font-lock-keyword-face) - (face face)))) - -(defun cider--menu-add-help-strings (menu-list) - "Add a :help entries to items in MENU-LIST." - (mapcar (lambda (x) - (cond - ((listp x) (cider--menu-add-help-strings x)) - ((and (vectorp x) - (not (plist-get (append x nil) :help)) - (functionp (elt x 1))) - (vconcat x `[:help ,(documentation (elt x 1))])) - (t x))) - menu-list)) - -(provide 'cider-util) - -;;; cider-util.el ends here diff --git a/elpa/cider-1.12.0/cider-xref-backend.el b/elpa/cider-1.12.0/cider-xref-backend.el @@ -1,166 +0,0 @@ -;;; cider-xref-backend.el --- CIDER's backend for Emacs' xref functionality -*- lexical-binding: t -*- - -;; Copyright © 2013-2023 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; -;; Author: Bozhidar Batsov <bozhidar@batsov.dev> -;; Artur Malabarba <bruce.connor.am@gmail.com> - -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; CIDER's backend for Emacs' xref functionality. - -;;; Code: - -(require 'cider-client) -(require 'cider-common) -(require 'cider-doc) ;; for cider--abbreviate-file-protocol -(require 'cider-resolve) - -(require 'seq) -(require 'thingatpt) - -;;; xref integration -;; -;; xref.el was introduced in Emacs 25.1. -;; CIDER's xref backend was added in CIDER 1.2. -(defun cider--xref-backend () - "Used for xref integration." - ;; Check if `cider-nrepl` middleware is loaded. Allows fallback to other xref - ;; backends, if cider-nrepl is not loaded. - (when (or - ;; the main requirement: - (cider-nrepl-op-supported-p "ns-path" nil 'skip-ensure) - ;; the fallback, used for bare nrepl or babashka integrations: - (cider-nrepl-op-supported-p "lookup" nil 'skip-ensure)) - 'cider)) - -(cl-defmethod xref-backend-identifier-at-point ((_backend (eql cider))) - "Return the relevant identifier at point." - (cider-symbol-at-point 'look-back)) - -(defun cider--xref-extract-file (dict) - "Extracts the best possible file path from DICT." - (or (nrepl-dict-get dict "file-url") ;; This is the primary choice, it has a protocol and indicates an absolute path - ;; fall back in case it was absent or we're running an older cider-nrepl: - (nrepl-dict-get dict "file"))) - -(defun cider--xref-extract-friendly-file-name (dict) - "Extracts the best possible friendly file name from DICT. -These are used for presentation purposes." - (let* ((s (or (nrepl-dict-get dict "file") ;; these are shorter and relative, which look better in UIs. - (nrepl-dict-get dict "file-url"))) - (s (cider--abbreviate-file-protocol s)) - (line (nrepl-dict-get dict "line")) - (column (nrepl-dict-get dict "column"))) - (concat s - (when line - ":") - (when line - (prin1-to-string line)) - (when (and line column) - ":") - (when column - (prin1-to-string column))))) - -(defun cider--var-to-xref-location (var) - "Get location of definition of VAR." - (when-let* ((info (cider-var-info var)) - (line (nrepl-dict-get info "line")) - (file (cider--xref-extract-file info)) - (buf (cider--find-buffer-for-file file))) - (xref-make-buffer-location - buf - (with-current-buffer buf - (save-excursion - (goto-char 0) - (forward-line (1- line)) - (back-to-indentation) - (point)))))) - -(cl-defmethod xref-backend-definitions ((_backend (eql cider)) var) - "Find definitions of VAR." - (cider-ensure-connected) - (when-let* ((loc (cider--var-to-xref-location var))) - (list (xref-make var loc)))) - -(cl-defmethod xref-backend-identifier-completion-table ((_backend (eql cider))) - "Return the completion table for identifiers." - (cider-ensure-connected) - (when-let* ((ns (cider-current-ns)) - (results (cider-sync-request:ns-vars ns))) - results)) - -(cl-defmethod xref-backend-references ((_backend (eql cider)) var) - "Find references of VAR." - (cider-ensure-connected) - (cider-ensure-op-supported "fn-refs") - (when-let* ((ns (cider-current-ns)) - (results (cider-sync-request:fn-refs ns var)) - (previously-existing-buffers (buffer-list))) - (thread-last results - (mapcar (lambda (info) - (let* ((filename (cider--xref-extract-file info)) - (column (nrepl-dict-get info "column")) - (line (nrepl-dict-get info "line")) - (friendly-name (cider--xref-extract-friendly-file-name info)) - ;; translate .jar urls and such: - (buf (cider--find-buffer-for-file filename)) - (bfn (and buf (buffer-file-name buf))) - (loc (when buf - ;; favor `xref-make-file-location' when possible, since that way, we can close their buffers. - (if bfn - (xref-make-file-location bfn line (or column 0)) - (xref-make-buffer-location buf (with-current-buffer buf - (save-excursion - (goto-char 0) - (forward-line line) - (move-to-column (or column 0)) - (point))))))) - (should-be-closed (and - buf - ;; if a buffer did not exist before, - ;; then it is a side-effect of invoking `cider--find-buffer-for-file'. - (not (member buf previously-existing-buffers)) - bfn - ;; only buffers with a normally reachable filename are safe to close. - ;; buffers not backed by such files may include .jars, TRAMP files, etc. - ;; Sadly this means we will still 'leak' some open buffers, but it's what we can do atm. - (file-exists-p bfn)))) - (when should-be-closed - (kill-buffer buf)) - (when loc - (xref-make friendly-name loc))))) - (seq-filter #'identity)))) - -(cl-defmethod xref-backend-apropos ((_backend (eql cider)) pattern) - "Find all symbols that match regexp PATTERN." - (cider-ensure-connected) - (cider-ensure-op-supported "apropos") - (when-let* ((ns (cider-current-ns)) - (results (cider-sync-request:apropos pattern ns t t completion-ignore-case))) - (mapcar (lambda (info) - (let* ((symbol (nrepl-dict-get info "name")) - (loc (cider--var-to-xref-location symbol)) - (type (nrepl-dict-get info "type")) - (doc (nrepl-dict-get info "doc"))) - (xref-make (format "[%s] %s\n %s" (propertize symbol 'face 'bold) (capitalize type) doc) - loc))) - results))) - -(provide 'cider-xref-backend) -;;; cider-xref-backend.el ends here diff --git a/elpa/cider-1.12.0/cider-xref.el b/elpa/cider-1.12.0/cider-xref.el @@ -1,185 +0,0 @@ -;;; cider-xref.el --- Xref functionality for Clojure -*- lexical-binding: t -*- - -;; Copyright © 2019-2023 Bozhidar Batsov and CIDER contributors -;; -;; Author: Bozhidar Batsov <bozhidar@batsov.dev> - -;; 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/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Xref (find usages) functionality for Clojure. The implementation is based on -;; ideas from this article https://metaredux.com/posts/2019/05/04/discovering-runtime-function-references-in-clojure.html. -;; -;; Keep in mind that you won't get references in namespaces that haven't been loaded yet. - -;;; Code: - -(require 'cider-doc) -(require 'cider-find) -(require 'cider-util) -(require 'subr-x) - -(require 'cider-client) -(require 'cider-popup) -(require 'nrepl-dict) - -(require 'clojure-mode) -(require 'apropos) -(require 'button) - -(defconst cider-xref-buffer "*cider-xref*") - -(defcustom cider-xref-actions '(("display-doc" . cider-doc-lookup) - ("find-def" . cider--find-var) - ("lookup-on-clojuredocs" . cider-clojuredocs-lookup)) - "Controls the actions to be applied on the symbol found by an xref search. -The first action key in the list will be selected as default. If the list -contains only one action key, the associated action function will be -applied automatically. An action function can be any function that receives -the symbol found by the xref search as argument." - :type '(alist :key-type string :value-type function) - :group 'cider - :package-version '(cider . "0.22.0")) - -(defun cider-xref-doc (button) - "Display documentation for the symbol represented at BUTTON." - (cider-doc-lookup (button-get button 'apropos-symbol))) - -(defun cider-xref-result (result) - "Emit a RESULT into current buffer." - (let ((var-name (nrepl-dict-get result "name"))) - (cider-propertize-region (list 'apropos-symbol var-name - 'action #'cider-xref-doc - 'help-echo "Display doc") - (insert-text-button var-name 'type 'apropos-symbol)) - (when-let ((doc (nrepl-dict-get result "doc"))) - (when (not (string-equal "(not documented)" doc)) - (insert "\n ") - (let ((beg (point))) - (insert (propertize doc 'font-lock-face 'font-lock-doc-face)) - (fill-region beg (point))))) - (insert "\n") - (if-let* ((file-url (cider--xref-extract-file result)) - (friendly-file (cider--xref-extract-friendly-file-name result)) - (line (nrepl-dict-get result "line"))) - (progn - (insert " " - (propertize var-name - 'font-lock-face 'font-lock-function-name-face) - " is defined in ") - (insert-text-button friendly-file - 'follow-link t - 'action (lambda (_x) - (cider-xref-source file-url line var-name))) - (insert ".")) - (insert "Definition location unavailable.")) - (insert "\n"))) - -(defun cider-xref-source (file-url line name) - "Find source for FILE-URL, LINE and NAME." - (interactive) - (if file-url - (if-let* ((buffer (and (not (cider--tooling-file-p file-url)) - (cider-find-file file-url)))) - (cider-jump-to buffer (if line - (cons line nil) - name) - nil) - (user-error - (substitute-command-keys - "Can't find the source because it wasn't defined with `cider-eval-buffer'"))) - (error "No source location for %s" name))) - -(declare-function cider-mode "cider-mode") - -(defun cider-show-xref (summary results) - "Show SUMMARY and RESULTS in a pop-up buffer." - (with-current-buffer (cider-popup-buffer cider-xref-buffer 'select 'apropos-mode 'ancillary) - (let ((inhibit-read-only t)) - (if (boundp 'header-line-format) - (setq-local header-line-format summary) - (insert summary "\n\n")) - (dolist (result results) - (cider-xref-result result)) - (goto-char (point-min))))) - -;;;###autoload -(defun cider-xref-fn-refs (&optional ns symbol) - "Show all functions that reference the var matching NS and SYMBOL." - (interactive) - (cider-ensure-connected) - (cider-ensure-op-supported "fn-refs") - (if-let* ((ns (or ns (cider-current-ns))) - (symbol (or symbol (cider-symbol-at-point))) - (results (cider-sync-request:fn-refs ns symbol))) - (cider-show-xref (format "Showing %d functions that reference %s in currently loaded namespaces" (length results) symbol) results) - (message "No references found for %S in currently loaded namespaces" symbol))) - -;;;###autoload -(defun cider-xref-fn-deps (&optional ns symbol) - "Show all functions referenced by the var matching NS and SYMBOL." - (interactive) - (cider-ensure-connected) - (cider-ensure-op-supported "fn-deps") - (if-let* ((ns (or ns (cider-current-ns))) - (symbol (or symbol (cider-symbol-at-point))) - (results (cider-sync-request:fn-deps ns symbol))) - (cider-show-xref (format "Showing %d function dependencies for %s" (length results) symbol) results) - (message "No dependencies found for %S" symbol))) - -(defun cider-xref-act-on-symbol (symbol) - "Apply selected action on SYMBOL." - (let* ((first-action-key (car (car cider-xref-actions))) - (action-key (if (= 1 (length cider-xref-actions)) - first-action-key - (completing-read (format "Choose action to apply to `%s` (default %s): " - symbol first-action-key) - cider-xref-actions nil nil nil nil first-action-key))) - (action-fn (cdr (assoc action-key cider-xref-actions)))) - (if action-fn - (funcall action-fn symbol) - (user-error "Unknown action `%s`" action-key)))) - -;;;###autoload -(defun cider-xref-fn-refs-select (&optional ns symbol) - "Displays the references for NS and SYMBOL using completing read." - (interactive) - (cider-ensure-connected) - (cider-ensure-op-supported "fn-refs") - (if-let* ((ns (or ns (cider-current-ns))) - (symbol (or symbol (cider-symbol-at-point))) - (results (mapcar (lambda (d) (nrepl-dict-get d "name")) (cider-sync-request:fn-refs ns symbol))) - (summary (format "References for %s" symbol))) - (cider-xref-act-on-symbol (completing-read (concat summary ": ") results)) - (message "No references for %S found" symbol))) - -;;;###autoload -(defun cider-xref-fn-deps-select (&optional ns symbol) - "Displays the function dependencies for NS and SYMBOL using completing read." - (interactive) - (cider-ensure-connected) - (cider-ensure-op-supported "fn-deps") - (if-let* ((ns (or ns (cider-current-ns))) - (symbol (or symbol (cider-symbol-at-point))) - (results (mapcar (lambda (d) (nrepl-dict-get d "name")) (cider-sync-request:fn-deps ns symbol))) - (summary (format "Dependencies for %s" symbol))) - (cider-xref-act-on-symbol (completing-read (concat summary ": ") results)) - (message "No dependencies for %S found" symbol))) - -(provide 'cider-xref) - -;;; cider-xref.el ends here diff --git a/elpa/cider-1.12.0/cider.el b/elpa/cider-1.12.0/cider.el @@ -1,2165 +0,0 @@ -;;; cider.el --- Clojure Interactive Development Environment that Rocks -*- lexical-binding: t -*- - -;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2023 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; -;; Author: Tim King <kingtim@gmail.com> -;; Phil Hagelberg <technomancy@gmail.com> -;; Bozhidar Batsov <bozhidar@batsov.dev> -;; Artur Malabarba <bruce.connor.am@gmail.com> -;; Hugo Duncan <hugo@hugoduncan.org> -;; Steve Purcell <steve@sanityinc.com> -;; Maintainer: Bozhidar Batsov <bozhidar@batsov.dev> -;; URL: https://www.github.com/clojure-emacs/cider -;; Version: 1.12.0 -;; Package-Requires: ((emacs "26") (clojure-mode "5.18.1") (parseedn "1.2.0") (queue "0.2") (spinner "1.7") (seq "2.22") (sesman "0.3.2") (transient "0.4.1")) -;; Keywords: languages, clojure, cider - -;; 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/>. - -;; This file is not part of GNU Emacs. - -;;; Commentary: - -;; Provides a Clojure interactive development environment for Emacs, built on -;; top of nREPL. See https://docs.cider.mx for more details. - -;;; Installation: - -;; CIDER is available as a package in melpa.org and stable.melpa.org. First, make sure you've -;; enabled one of the repositories in your Emacs config: - -;; (add-to-list 'package-archives -;; '("melpa" . "https://melpa.org/packages/")) -;; -;; or -;; -;; (add-to-list 'package-archives -;; '("melpa-stable" . "https://stable.melpa.org/packages/") t) - -;; Afterwards, installing CIDER is as easy as: - -;; M-x package-install cider - -;;; Usage: - -;; You can start CIDER with one of the following commands: - -;; M-x cider-jack-in-clj -;; M-x cider-jack-in-cljs -;; -;; M-x cider-connect-sibling-clj -;; M-x cider-connect-sibling-cljs -;; -;; M-x cider-connect-clj -;; M-x cider-connect-cljs - -;;; Code: - -(defgroup cider nil - "Clojure Interactive Development Environment that Rocks." - :prefix "cider-" - :group 'applications - :link '(url-link :tag "GitHub" "https://github.com/clojure-emacs/cider") - :link '(url-link :tag "Homepage" "https://cider.mx") - :link '(url-link :tag "Documentation" "https://docs.cider.mx") - :link '(emacs-commentary-link :tag "Commentary" "cider")) - -(require 'cider-client) -(require 'cider-eldoc) -(require 'cider-repl) -(require 'cider-repl-history) -(require 'cider-connection) -(require 'cider-mode) -(require 'cider-common) -(require 'cider-debug) -(require 'cider-util) - -(require 'cl-lib) -(require 'tramp-sh) -(require 'subr-x) -(require 'seq) -(require 'sesman) -(require 'package) - -(defconst cider-version "1.12.0" - "The current version of CIDER.") - -(defconst cider-codename "Split" - "Codename used to denote stable releases.") - -(defcustom cider-lein-command - "lein" - "The command used to execute Leiningen." - :type 'string) - -(defcustom cider-lein-global-options - nil - "Command global options used to execute Leiningen (e.g.: -o for offline)." - :type 'string - :safe #'stringp) - -(defcustom cider-lein-parameters - "repl :headless :host localhost" - "Params passed to Leiningen to start an nREPL server via `cider-jack-in'." - :type 'string - :safe #'stringp) - -(defcustom cider-boot-command - "boot" - "The command used to execute Boot." - :type 'string - :package-version '(cider . "0.9.0")) - -(defcustom cider-boot-global-options - nil - "Command global options used to execute Boot (e.g.: -c for checkouts)." - :type 'string - :safe #'stringp - :package-version '(cider . "0.14.0")) - -(defcustom cider-boot-parameters - "repl -s -b localhost wait" - "Params passed to boot to start an nREPL server via `cider-jack-in'." - :type 'string - :safe #'stringp - :package-version '(cider . "0.9.0")) - -(defcustom cider-clojure-cli-command - (if (and (eq system-type 'windows-nt) - (null (executable-find "clojure"))) - "powershell" - "clojure") - "The command used to execute clojure with tools.deps (requires Clojure 1.9+). -Don't use clj here, as it doesn't work when spawned from Emacs due to it -using rlwrap. If on Windows and no \"clojure\" executable is found we -default to \"powershell\"." - :type 'string - :safe #'stringp - :package-version '(cider . "0.17.0")) - -(defcustom cider-clojure-cli-global-options - nil - "Command line options used to execute clojure with tools.deps." - :type 'string - :safe #'stringp - :package-version '(cider . "0.17.0")) - -(defcustom cider-clojure-cli-parameters - nil - "Params passed to clojure cli to start an nREPL server via `cider-jack-in'." - :type 'string - :safe #'stringp - :package-version '(cider . "1.8.0")) - -(defcustom cider-clojure-cli-aliases - nil - "A list of aliases to include when using the clojure cli. -Alias names should be of the form \":foo:bar\". -Leading \"-A\" \"-M\" \"-T\" or \"-X\" are stripped from aliases -then concatenated into the \"-M[your-aliases]:cider/nrepl\" form." - :type 'string - :safe #'stringp - :package-version '(cider . "1.1")) - -(defcustom cider-shadow-cljs-command - "npx shadow-cljs" - "The command used to execute shadow-cljs. - -By default we favor the project-specific shadow-cljs over the system-wide." - :type 'string - :safe #'stringp - :package-version '(cider . "0.17.0")) - -(defcustom cider-shadow-cljs-global-options - "" - "Command line options used to execute shadow-cljs (e.g.: -v for verbose mode)." - :type 'string - :safe #'stringp - :package-version '(cider . "0.17.0")) - -(defcustom cider-shadow-cljs-parameters - "server" - "Params passed to shadow-cljs to start an nREPL server via `cider-jack-in'." - :type 'string - :safe #'stringp - :package-version '(cider . "0.17.0")) - -(defcustom cider-gradle-command - "./gradlew" - "The command used to execute Gradle." - :type 'string - :safe #'stringp - :package-version '(cider . "0.10.0")) - -(defcustom cider-gradle-global-options - "" - "Command line options used to execute Gradle (e.g.: -m for dry run)." - :type 'string - :safe #'stringp - :package-version '(cider . "0.14.0")) - -(defcustom cider-gradle-parameters - "clojureRepl" - "Params passed to gradle to start an nREPL server via `cider-jack-in'." - :type 'string - :safe #'stringp - :package-version '(cider . "0.10.0")) - -(defcustom cider-babashka-command - "bb" - "The command used to execute Babashka." - :type 'string - :safe #'stringp - :package-version '(cider . "1.2.0")) - -(defcustom cider-babashka-global-options - nil - "Command line options used to execute Babashka." - :type 'string - :safe #'stringp - :package-version '(cider . "1.2.0")) - -(defcustom cider-babashka-parameters - "nrepl-server localhost:0" - "Params passed to babashka to start an nREPL server via `cider-jack-in'." - :type 'string - :safe #'stringp - :package-version '(cider . "1.2.0")) - -(defcustom cider-nbb-command - "nbb" - "The command used to execute nbb." - :type 'string - :safe #'stringp - :package-version '(cider . "1.6.0")) - -(defcustom cider-nbb-global-options - nil - "Command line options used to execute nbb." - :type 'string - :safe #'stringp - :package-version '(cider . "1.6.0")) - -(defcustom cider-nbb-parameters - "nrepl-server" - "Params passed to nbb to start an nREPL server via `cider-jack-in'." - :type 'string - :safe #'stringp - :package-version '(cider . "1.6.0")) - -(make-obsolete-variable 'cider-lein-global-options 'cider-lein-parameters "1.8.0") -(make-obsolete-variable 'cider-boot-global-options 'cider-boot-parameters "1.8.0") -(make-obsolete-variable 'cider-clojure-cli-global-options 'cider-clojure-cli-parameters "1.8.0") -(make-obsolete-variable 'cider-shadow-cljs-global-options 'cider-shadow-cljs-parameters "1.8.0") -(make-obsolete-variable 'cider-gradle-global-options 'cider-gradle-parameters "1.8.0") -(make-obsolete-variable 'cider-babashka-global-options 'cider-babashka-parameters "1.8.0") -(make-obsolete-variable 'cider-nbb-global-options 'cider-nbb-parameters "1.8.0") - -(defcustom cider-jack-in-default - (if (executable-find "clojure") 'clojure-cli 'lein) - "The default tool to use when doing `cider-jack-in' outside a project. -This value will only be consulted when no identifying file types, i.e. -project.clj for leiningen or build.boot for boot, could be found. - -As the Clojure CLI is bundled with Clojure itself, it's the default. -In the absence of the Clojure CLI (e.g. on Windows), we fallback -to Leiningen." - :type '(choice (const lein) - (const boot) - (const clojure-cli) - (const shadow-cljs) - (const gradle) - (const babashka) - (const nbb)) - :safe #'symbolp - :package-version '(cider . "0.9.0")) - -(defcustom cider-preferred-build-tool - nil - "Allow choosing a build system when there are many. -When there are project markers from multiple build systems (e.g. lein and -boot) the user is prompted to select one of them. When non-nil, this -variable will suppress this behavior and will select whatever build system -is indicated by the variable if present. Note, this is only when CIDER -cannot decide which of many build systems to use and will never override a -command when there is no ambiguity." - :type '(choice (const lein) - (const boot) - (const clojure-cli) - (const shadow-cljs) - (const gradle) - (const babashka) - (const nbb) - (const :tag "Always ask" nil)) - :safe #'symbolp - :package-version '(cider . "0.13.0")) - -(defcustom cider-allow-jack-in-without-project 'warn - "Controls what happens when doing `cider-jack-in' outside a project. -When set to 'warn you'd prompted to confirm the command. -When set to t `cider-jack-in' will quietly continue. -When set to nil `cider-jack-in' will fail." - :type '(choice (const :tag "always" t) - (const warn) - (const :tag "never" nil)) - :safe #'symbolp - :package-version '(cider . "0.15.0")) - -(defcustom cider-known-endpoints nil - "A list of connection endpoints where each endpoint is a list. -For example: \\='((\"label\" \"host\" \"port\")). -The label is optional so that \\='(\"host\" \"port\") will suffice. -This variable is used by `cider-connect'." - :type '(repeat (list (string :tag "label") - (string :tag "host") - (string :tag "port")))) - -(defcustom cider-connected-hook nil - "List of functions to call when connected to Clojure nREPL server." - :type 'hook - :package-version '(cider . "0.9.0")) - -(defcustom cider-disconnected-hook nil - "List of functions to call when disconnected from the Clojure nREPL server." - :type 'hook - :package-version '(cider . "0.9.0")) - -(defcustom cider-inject-dependencies-at-jack-in t - "When nil, do not inject repl dependencies at `cider-jack-in' time. -The repl dependendcies are most likely to be nREPL middlewares." - :type 'boolean - :safe #'booleanp - :version '(cider . "0.11.0")) - -(defcustom cider-offer-to-open-cljs-app-in-browser t - "When nil, do not offer to open ClojureScript apps in a browser on connect." - :type 'boolean - :safe #'booleanp - :version '(cider . "0.15.0")) - -(defvar cider-ps-running-lein-nrepls-command "ps u | grep leiningen" - "Process snapshot command used in `cider-locate-running-nrepl-ports'.") - -(defvar cider-ps-running-lein-nrepl-path-regexp-list - '("\\(?:leiningen.original.pwd=\\)\\(.+?\\) -D" - "\\(?:-classpath +:?\\(.+?\\)/self-installs\\)") - "Regexp list to get project paths. -Extract project paths from output of `cider-ps-running-lein-nrepls-command'. -Sub-match 1 must be the project path.") - -(defvar cider-host-history nil - "Completion history for connection hosts.") - -(defvar cider-jack-in-universal-options - '((clojure-cli (:prefix-arg 1 :cmd (:jack-in-type clj :project-type clojure-cli :edit-project-dir t))) - (lein (:prefix-arg 2 :cmd (:jack-in-type clj :project-type lein :edit-project-dir t))) - (babashka (:prefix-arg 3 :cmd (:jack-in-type clj :project-type babashka :edit-project-dir t))) - (nbb (:prefix-arg 4 :cmd (:jack-in-type cljs :project-type nbb :cljs-repl-type nbb :edit-project-dir t)))) - "The list of project tools that are supported by the universal jack in command. - -Each item in the list consists of the tool name and its plist options. - -The plist supports the following keys - -- :prefix-arg the numerical prefix arg to use to jack in to the tool. - -- :cmd a plist of instructions how to invoke the jack in command, with keys - - - :jack-in-type 'clj to start a clj repl and 'cljs for a cljs repl. - - - &rest the same set of params supported by the `cider-jack-in-clj' and - `cider-jack-in-cljs' commands.") - -;;;###autoload -(defun cider-version () - "Display CIDER's version." - (interactive) - (message "CIDER %s" (cider--version))) - -(defun cider-jack-in-command (project-type) - "Determine the command `cider-jack-in' needs to invoke for the PROJECT-TYPE." - (pcase project-type - ('lein cider-lein-command) - ('boot cider-boot-command) - ('clojure-cli cider-clojure-cli-command) - ('babashka cider-babashka-command) - ('shadow-cljs cider-shadow-cljs-command) - ('gradle cider-gradle-command) - ('nbb cider-nbb-command) - (_ (user-error "Unsupported project type `%S'" project-type)))) - -(defcustom cider-enrich-classpath nil - "If t, use enrich-classpath for adding sources/javadocs to the classpath. - -enrich-classpath is a Clojure CLI shim, and Leiningen plugin. - -This classpath expansion is done in a clean manner, -without interfering with classloaders." - :type 'boolean - :package-version '(cider . "1.2.0") - :safe #'booleanp) - -(defun cider--get-enrich-classpath-lein-script () - "Returns the location of enrich-classpath's lein.sh wrapper script." - (when-let ((cider-location (locate-library "cider.el" t))) - (concat (file-name-directory cider-location) - "lein.sh"))) - -(defun cider--get-enrich-classpath-clojure-cli-script () - "Returns the location of enrich-classpath's clojure.sh wrapper script." - (when-let ((cider-location (locate-library "cider.el" t))) - (concat (file-name-directory cider-location) - "clojure.sh"))) - -(defun cider-jack-in-resolve-command (project-type) - "Determine the resolved file path to `cider-jack-in-command'. -Throws an error if PROJECT-TYPE is unknown." - (pcase project-type - ('lein (let ((r (cider--resolve-command cider-lein-command))) - (if (and cider-enrich-classpath - (not (eq system-type 'windows-nt)) - (executable-find (cider--get-enrich-classpath-lein-script))) - (concat "bash " ;; don't assume lein.sh is executable - MELPA might change that - (cider--get-enrich-classpath-lein-script) - " " - r) - r))) - ('boot (cider--resolve-command cider-boot-command)) - ('clojure-cli (if (and cider-enrich-classpath - (not (eq system-type 'windows-nt)) - (executable-find (cider--get-enrich-classpath-clojure-cli-script))) - (concat "bash " ;; don't assume clojure.sh is executable - MELPA might change that - (cider--get-enrich-classpath-clojure-cli-script) - " " - (cider--resolve-command cider-clojure-cli-command)) - (cider--resolve-command cider-clojure-cli-command))) - ('babashka (cider--resolve-command cider-babashka-command)) - ;; here we have to account for the possibility that the command is either - ;; "npx shadow-cljs" or just "shadow-cljs" - ('shadow-cljs (let ((parts (split-string cider-shadow-cljs-command))) - (when-let* ((command (cider--resolve-command (car parts)))) - (mapconcat #'identity (cons command (cdr parts)) " ")))) - ;; TODO: Address the duplicated code below. - ;; here we have to account for the possibility that the command is either - ;; "nbb" (default) or "npx nbb". - ('nbb (let ((parts (split-string cider-nbb-command))) - (when-let* ((command (cider--resolve-command (car parts)))) - (mapconcat #'identity (cons command (cdr parts)) " ")))) - ;; here we have to account for use of the Gradle wrapper which is - ;; a shell script within their project, so if they have a clearly - ;; relative path like "./gradlew" use locate file instead of checking - ;; the exec-path - ('gradle (cider--resolve-project-command cider-gradle-command)) - (_ (user-error "Unsupported project type `%S'" project-type)))) - -(defun cider-jack-in-global-options (project-type) - "Determine the command line options for `cider-jack-in' for the PROJECT-TYPE." - (pcase project-type - ('lein cider-lein-global-options) - ('boot cider-boot-global-options) - ('clojure-cli cider-clojure-cli-global-options) - ('babashka cider-babashka-global-options) - ('shadow-cljs cider-shadow-cljs-global-options) - ('gradle cider-gradle-global-options) - ('nbb cider-nbb-global-options) - (_ (user-error "Unsupported project type `%S'" project-type)))) - -(defun cider-jack-in-params (project-type) - "Determine the commands params for `cider-jack-in' for the PROJECT-TYPE." - ;; The format of these command-line strings must consider different shells, - ;; different values of IFS, and the possibility that they'll be run remotely - ;; (e.g. with TRAMP). Using `", "` causes problems with TRAMP, for example. - ;; Please be careful when changing them. - (pcase project-type - ('lein cider-lein-parameters) - ('boot cider-boot-parameters) - ('clojure-cli cider-clojure-cli-parameters) - ('babashka cider-babashka-parameters) - ('shadow-cljs cider-shadow-cljs-parameters) - ('gradle cider-gradle-parameters) - ('nbb cider-nbb-parameters) - (_ (user-error "Unsupported project type `%S'" project-type)))) - - -;;; Jack-in dependencies injection -(defvar cider-jack-in-dependencies nil - "List of dependencies where elements are lists of artifact name and version.") -(put 'cider-jack-in-dependencies 'risky-local-variable t) - -(defcustom cider-injected-nrepl-version "1.0.0" - "The version of nREPL injected on jack-in. -We inject the newest known version of nREPL just in case -your version of Boot or Leiningen is bundling an older one." - :type 'string - :package-version '(cider . "1.2.0") - :safe #'stringp) - -(defvar cider-jack-in-cljs-dependencies nil - "List of dependencies where elements are lists of artifact name and version. -Added to `cider-jack-in-dependencies' when doing `cider-jack-in-cljs'.") -(put 'cider-jack-in-cljs-dependencies 'risky-local-variable t) -(cider-add-to-alist 'cider-jack-in-cljs-dependencies "cider/piggieback" "0.5.3") - -(defvar cider-jack-in-dependencies-exclusions nil - "List of exclusions for jack in dependencies. -Elements of the list are artifact name and list of exclusions to apply for -the artifact.") -(put 'cider-jack-in-dependencies-exclusions 'risky-local-variable t) - -(defconst cider-clojure-artifact-id "org.clojure/clojure" - "Artifact identifier for Clojure.") - -(defconst cider-minimum-clojure-version "1.8.0" - "Minimum supported version of Clojure.") - -(defconst cider-latest-clojure-version "1.10.1" - "Latest supported version of Clojure.") - -(defconst cider-required-middleware-version "0.44.0" - "The CIDER nREPL version that's known to work properly with CIDER.") - -(defcustom cider-injected-middleware-version cider-required-middleware-version - "The version of cider-nrepl injected on jack-in. -Should be newer than the required version for optimal results." - :type 'string - :package-version '(cider . "1.2.0") - :safe #'stringp) - -(defcustom cider-jack-in-auto-inject-clojure nil - "Version of clojure to auto-inject into REPL. -If nil, do not inject Clojure into the REPL. If `latest', inject -`cider-latest-clojure-version', which should approximate to the most recent -version of Clojure. If `minimal', inject `cider-minimum-clojure-version', -which will be the lowest version CIDER supports. If a string, use this as -the version number. If it is a list, the first element should be a string, -specifying the artifact ID, and the second element the version number." - :type '(choice (const :tag "None" nil) - (const :tag "Latest" latest) - (const :tag "Minimal" minimal) - (string :tag "Specific Version") - (list :tag "Artifact ID and Version" - (string :tag "Artifact ID") - (string :tag "Version")))) - -(defvar-local cider-jack-in-cmd nil - "The custom command used to start a nrepl server. -This is used by `cider-jack-in`. - -If this variable is set, its value will be -used as the command to start the nrepl server -instead of the default command inferred from -the project type. - -This allows for fine-grained control over the jack-in process. -The value should be a string representing the command to start -the nrepl server, such as \"nbb nrepl-server\".") - -(defvar cider-jack-in-lein-plugins nil - "List of Leiningen plugins to be injected at jack-in. -Each element is a list of artifact name and version, followed optionally by -keyword arguments. The only keyword argument currently accepted is -`:predicate', which should be given a function that takes the list (name, -version, and keyword arguments) and returns non-nil to indicate that the -plugin should actually be injected. (This is useful primarily for packages -that extend CIDER, not for users. For example, a refactoring package might -want to inject some middleware only when within a project context.)") -(put 'cider-jack-in-lein-plugins 'risky-local-variable t) - -(defvar cider-jack-in-lein-middlewares nil - "List of Leiningen :middleware values to be injected at jack-in. - -Necessary for plugins which require an explicit middleware name to be specified. - -Can also facilitate using middleware in a specific order.") -(put 'cider-jack-in-lein-middlewares 'risky-local-variable t) - -(defvar cider-jack-in-cljs-lein-plugins nil - "List of Leiningen plugins to be injected at jack-in. -Added to `cider-jack-in-lein-plugins' (which see) when doing -`cider-jack-in-cljs'.") -(put 'cider-jack-in-cljs-lein-plugins 'risky-local-variable t) - -(defun cider-jack-in-normalized-lein-plugins () - "Return a normalized list of Leiningen plugins to be injected. -See `cider-jack-in-lein-plugins' for the format, except that the list -returned by this function does not include keyword arguments." - (let ((plugins (if cider-enrich-classpath - (append cider-jack-in-lein-plugins - `(("cider/cider-nrepl" ,cider-injected-middleware-version) - ("mx.cider/lein-enrich-classpath" "1.18.6"))) - (append cider-jack-in-lein-plugins - `(("cider/cider-nrepl" ,cider-injected-middleware-version)))))) - (thread-last - plugins - (seq-filter - (lambda (spec) - (if-let* ((pred (plist-get (seq-drop spec 2) :predicate))) - (funcall pred spec) - t))) - (mapcar - (lambda (spec) - (seq-take spec 2)))))) - -(defvar cider-jack-in-nrepl-middlewares nil - "List of Clojure variable names. -Each of these Clojure variables should hold a vector of nREPL middlewares. -Instead of a string, an element can be a list containing a string followed -by optional keyword arguments. The only keyword argument currently -accepted is `:predicate', which should be given a function that takes the -list (string and keyword arguments) and returns non-nil to indicate that -the middlewares should actually be injected.") -(put 'cider-jack-in-nrepl-middlewares 'risky-local-variable t) -(add-to-list 'cider-jack-in-nrepl-middlewares "cider.nrepl/cider-middleware") - -(defvar cider-jack-in-cljs-nrepl-middlewares nil - "List of Clojure variable names. -Added to `cider-jack-in-nrepl-middlewares' (which see) when doing -`cider-jack-in-cljs'.") -(put 'cider-jack-in-cljs-nrepl-middlewares 'risky-local-variable t) -(add-to-list 'cider-jack-in-cljs-nrepl-middlewares "cider.piggieback/wrap-cljs-repl") - -(defun cider-jack-in-normalized-nrepl-middlewares () - "Return a normalized list of middleware variable names. -See `cider-jack-in-nrepl-middlewares' for the format, except that the list -returned by this function only contains strings." - (thread-last - cider-jack-in-nrepl-middlewares - (seq-filter - (lambda (spec) - (or (not (listp spec)) - (if-let* ((pred (plist-get (cdr spec) :predicate))) - (funcall pred spec) - t)))) - (mapcar - (lambda (spec) - (if (listp spec) - (car spec) - spec))))) - -(defun cider--list-as-boot-artifact (list) - "Return a boot artifact string described by the elements of LIST. -LIST should have the form (ARTIFACT-NAME ARTIFACT-VERSION). The returned -string is quoted for passing as argument to an inferior shell." - (concat "-d " (shell-quote-argument (format "%s:%s" (car list) (cadr list))))) - -(defun cider--jack-in-required-dependencies () - "Returns the required CIDER deps. -They are normally added to `cider-jack-in-dependencies', -unless it's a Lein project." - `(("nrepl/nrepl" ,cider-injected-nrepl-version) - ("cider/cider-nrepl" ,cider-injected-middleware-version))) - -(defun cider-boot-dependencies (dependencies) - "Return a list of boot artifact strings created from DEPENDENCIES." - (concat (mapconcat #'cider--list-as-boot-artifact dependencies " ") - (unless (seq-empty-p dependencies) " "))) - -(defun cider-boot-middleware-task (params middlewares) - "Create a command to add MIDDLEWARES with corresponding PARAMS." - (concat "cider.tasks/add-middleware " - (mapconcat (lambda (middleware) - (format "-m %s" (shell-quote-argument middleware))) - middlewares - " ") - " " params)) - -(defun cider-boot-jack-in-dependencies (global-opts params dependencies middlewares) - "Create boot jack-in dependencies. -Does so by concatenating GLOBAL-OPTS, DEPENDENCIES, -and MIDDLEWARES. PARAMS and MIDDLEWARES are passed on to -`cider-boot-middleware-task` before concatenating and DEPENDENCIES - are passed on to `cider-boot-dependencies`." - (concat global-opts - (unless (seq-empty-p global-opts) " ") - "-i \"(require 'cider.tasks)\" " ;; Note the space at the end here - (cider-boot-dependencies (append (cider--jack-in-required-dependencies) dependencies)) - (cider-boot-middleware-task params middlewares))) - -(defun cider--gradle-dependency-notation (dependency) - "Returns Gradle's GAV dependency syntax. -For a \"group/artifact\" \"version\") DEPENDENCY list -return as group:artifact:version notation." - (let ((group-artifact (replace-regexp-in-string "/" ":" (car dependency))) - (version (cadr dependency))) - (format "%s:%s" group-artifact version))) - -(defun cider--gradle-jack-in-property (dependencies) - "Returns Clojurephant's dependency jack-in property. -For DEPENDENCIES, translates to Gradle's dependency notation -using `cider--gradle-dependency-notation`.''" - (if (seq-empty-p dependencies) - "" - (shell-quote-argument - (concat "-Pdev.clojurephant.jack-in.nrepl=" - (mapconcat #'cider--gradle-dependency-notation dependencies ","))))) - -(defun cider--gradle-middleware-params (middlewares) - "Returns Gradle-formatted middleware params. -Given a list of MIDDLEWARES symbols, this returns -the Gradle parameters expected by Clojurephant's -ClojureNRepl task." - (mapconcat (lambda (middleware) - (shell-quote-argument (concat "--middleware=" middleware))) - middlewares - " ")) - -(defun cider-gradle-jack-in-dependencies (global-opts params dependencies middlewares) - "Create gradle jack in dependencies. -Does so by concatenating GLOBAL-OPTS, DEPENDENCIES, -and MIDDLEWARES. GLOBAL-OPTS and PARAMS are taken as-is. -DEPENDENCIES are translated into Gradle's typical -group:artifact:version notation and MIDDLEWARES are -prepared as arguments to Clojurephant's ClojureNRepl task." - (concat global-opts - (unless (seq-empty-p global-opts) " ") - (cider--gradle-jack-in-property (append (cider--jack-in-required-dependencies) dependencies)) - " " - params - (unless (seq-empty-p params) " ") - (cider--gradle-middleware-params middlewares))) - -(defun cider--lein-artifact-exclusions (exclusions) - "Return an exclusions vector described by the elements of EXCLUSIONS." - (if exclusions - (format " :exclusions [%s]" (mapconcat #'identity exclusions " ")) - "")) - -(defun cider--list-as-lein-artifact (list &optional exclusions) - "Return an artifact string described by the elements of LIST. -LIST should have the form (ARTIFACT-NAME ARTIFACT-VERSION). Optionally a list -of EXCLUSIONS can be provided as well. The returned -string is quoted for passing as argument to an inferior shell." - (shell-quote-argument (format "[%s %S%s]" (car list) (cadr list) (cider--lein-artifact-exclusions exclusions)))) - -(defun cider--extract-lein-profiles (lein-params) - "Extracts a list of ('with-profile ...' and a repl command from LEIN-PARAMS). - -If no `with-profile' call was found, -returns an empty string as the first member." - (or (when-let* ((pattern "\\(with-profiles?\\s-+\\S-+\\)") - (match-start (string-match pattern lein-params)) - (match-end (match-end 0))) - (list (concat (substring lein-params match-start match-end) " ") - (string-trim (substring lein-params match-end)))) - (list "" lein-params))) - -(defun cider-lein-jack-in-dependencies (global-opts params dependencies dependencies-exclusions lein-plugins &optional lein-middlewares) - "Create lein jack-in dependencies. -Does so by concatenating GLOBAL-OPTS, DEPENDENCIES, with DEPENDENCIES-EXCLUSIONS -removed, LEIN-PLUGINS, LEIN-MIDDLEWARES and finally PARAMS." - (concat - global-opts - (unless (seq-empty-p global-opts) " ") - (mapconcat #'identity - (append (seq-map (lambda (dep) - (let ((exclusions (cadr (assoc (car dep) dependencies-exclusions)))) - (concat "update-in :dependencies conj " - (cider--list-as-lein-artifact dep exclusions)))) - dependencies) - (seq-map (lambda (plugin) - (concat "update-in :plugins conj " - (cider--list-as-lein-artifact plugin))) - lein-plugins) - (seq-map (lambda (middleware) - (concat "update-in :middleware conj " - middleware)) - lein-middlewares)) - " -- ") - " -- " - (if (not cider-enrich-classpath) - params - ;; enrich-classpath must be applied after the `with-profile` call, if present, - ;; so that it can also process the classpath that is typically expanded by the presence of a set of profiles: - (let* ((profiles-and-repl-call (cider--extract-lein-profiles params)) - (profiles (car profiles-and-repl-call)) - (repl-call (nth 1 profiles-and-repl-call))) - (concat profiles - "update-in :middleware conj cider.enrich-classpath.plugin-v2/middleware -- " - repl-call))))) - -(defun cider--dedupe-deps (deps) - "Removes the duplicates in DEPS." - (cl-delete-duplicates deps :test 'equal)) - -(defun cider--jack-in-cmd-powershell-p (command) - "Returns whether COMMAND is PowerShell." - (or (string-equal command "powershell") - (string-equal command "pwsh"))) - -(defun cider--shell-quote-argument (argument &optional command) - "Quotes ARGUMENT like `shell-quote-argument', suitable for use with COMMAND. - -Uses `shell-quote-argument' to quote the ARGUMENT, unless COMMAND is given -and refers to PowerShell, in which case it uses (some limited) PowerShell -rules to quote it." - (if (cider--jack-in-cmd-powershell-p command) - ;; please add more PowerShell quoting rules as necessary. - (format "'%s'" (replace-regexp-in-string "\"" "\"\"" argument)) - (shell-quote-argument argument))) - -(defun cider--powershell-encode-command (cmd-params) - "Base64 encode the powershell command and jack-in CMD-PARAMS for clojure-cli." - (let* ((quoted-params cmd-params) - (command (format "clojure %s" quoted-params)) - (utf-16le-command (encode-coding-string command 'utf-16le))) - (format "-encodedCommand %s" (base64-encode-string utf-16le-command t)))) - -(defun cider-clojure-cli-jack-in-dependencies (global-options params dependencies &optional command) - "Create Clojure tools.deps jack-in dependencies. -Does so by concatenating DEPENDENCIES, PARAMS and GLOBAL-OPTIONS into a -suitable `clojure` invocation and quoting, also accounting for COMMAND if -provided. The main is placed in an inline alias :cider/nrepl so that if -your aliases contain any mains, the cider/nrepl one will be the one used." - (let* ((all-deps (thread-last - dependencies - (append (cider--jack-in-required-dependencies)) - ;; Duplicates are never OK since they would result in - ;; `java.lang.IllegalArgumentException: Duplicate key [...]`: - (cider--dedupe-deps) - (seq-map (lambda (dep) - (if (listp (cadr dep)) - (format "%s {%s}" - (car dep) - (seq-reduce - (lambda (acc v) - (concat acc (format " :%s \"%s\" " (car v) (cdr v)))) - (cadr dep) - "")) - (format "%s {:mvn/version \"%s\"}" (car dep) (cadr dep))))))) - (middleware (mapconcat - (apply-partially #'format "%s") - (cider-jack-in-normalized-nrepl-middlewares) - ",")) - (main-opts (format "\"-m\" \"nrepl.cmdline\" \"--middleware\" \"[%s]\"" middleware)) - (deps (format "{:deps {%s} :aliases {:cider/nrepl {:main-opts [%s]}}}" - (string-join all-deps " ") main-opts)) - (deps-quoted (cider--shell-quote-argument deps command))) - (format "%s-Sdeps %s -M%s:cider/nrepl%s" - ;; TODO: global-options are deprecated and should be removed in CIDER 2.0 - (if global-options (format "%s " global-options) "") - deps-quoted - (if cider-clojure-cli-aliases - ;; remove exec-opts flags -A -M -T or -X from cider-clojure-cli-aliases - ;; concatenated with :cider/nrepl to ensure :cider/nrepl comes last - (let ((aliases (format "%s" (replace-regexp-in-string "^-\\(A\\|M\\|T\\|X\\)" "" cider-clojure-cli-aliases)))) - (if (string-prefix-p ":" aliases) - aliases - (concat ":" aliases))) - "") - (if params (format " %s" params) "")))) - -(defun cider-shadow-cljs-jack-in-dependencies (global-opts params dependencies) - "Create shadow-cljs jack-in deps. -Does so by concatenating GLOBAL-OPTS, DEPENDENCIES finally PARAMS." - (let ((dependencies (append (cider--jack-in-required-dependencies) dependencies))) - (concat - global-opts - (unless (seq-empty-p global-opts) " ") - (mapconcat #'identity - (seq-map (lambda (dep) (format "-d %s:%s" (car dep) (cadr dep))) dependencies) - " ") - " " - params))) - -(defun cider-add-clojure-dependencies-maybe (dependencies) - "Return DEPENDENCIES with an added Clojure dependency if requested. -See also `cider-jack-in-auto-inject-clojure'." - (if cider-jack-in-auto-inject-clojure - (if (consp cider-jack-in-auto-inject-clojure) - (cons cider-jack-in-auto-inject-clojure dependencies) - (cons (list cider-clojure-artifact-id - (cond - ((stringp cider-jack-in-auto-inject-clojure) - cider-jack-in-auto-inject-clojure) - ((eq cider-jack-in-auto-inject-clojure 'minimal) - cider-minimum-clojure-version) - ((eq cider-jack-in-auto-inject-clojure 'latest) - cider-latest-clojure-version))) - dependencies)) - dependencies)) - -(defun cider-inject-jack-in-dependencies (global-opts params project-type &optional command) - "Return GLOBAL-OPTS and PARAMS with injected REPL dependencies. -These are set in `cider-jack-in-dependencies', `cider-jack-in-lein-plugins' -and `cider-jack-in-nrepl-middlewares' are injected from the CLI according -to the used PROJECT-TYPE, and COMMAND if provided. Eliminates the need for -hacking profiles.clj or the boot script for supporting CIDER with its nREPL -middleware and dependencies." - (pcase project-type - ('lein (cider-lein-jack-in-dependencies - global-opts - params - (cider-add-clojure-dependencies-maybe - (append `(("nrepl/nrepl" ,cider-injected-nrepl-version)) cider-jack-in-dependencies)) - cider-jack-in-dependencies-exclusions - (cider-jack-in-normalized-lein-plugins) - cider-jack-in-lein-middlewares)) - ('boot (cider-boot-jack-in-dependencies - global-opts - params - (cider-add-clojure-dependencies-maybe - cider-jack-in-dependencies) - (cider-jack-in-normalized-nrepl-middlewares))) - ('clojure-cli (cider-clojure-cli-jack-in-dependencies - global-opts - params - (cider-add-clojure-dependencies-maybe - cider-jack-in-dependencies) - command)) - ('babashka (concat - global-opts - (unless (seq-empty-p global-opts) " ") - params)) - ('shadow-cljs (cider-shadow-cljs-jack-in-dependencies - global-opts - params - (cider-add-clojure-dependencies-maybe - cider-jack-in-dependencies))) - ('gradle (cider-gradle-jack-in-dependencies - global-opts - params - (cider-add-clojure-dependencies-maybe - cider-jack-in-dependencies) - (cider-jack-in-normalized-nrepl-middlewares))) - ('nbb (concat - global-opts - (unless (seq-empty-p global-opts) " ") - params)) - (_ (error "Unsupported project type `%S'" project-type)))) - - -;;; ClojureScript REPL creation - -(defcustom cider-check-cljs-repl-requirements t - "When non-nil will run the requirement checks for the different cljs repls. -Generally you should not disable this unless you run into some faulty check." - :type 'boolean - :safe #'booleanp - :package-version '(cider . "0.17.0")) - -(defun cider-clojurescript-present-p () - "Return non nil when ClojureScript is present." - (or - ;; This is nil for example for nbb. - (cider-library-present-p "cljs.core") - ;; demunge is not defined currently for normal cljs repls. - ;; So we end up making the two checks - (nrepl-dict-get (cider-sync-tooling-eval "cljs.core/demunge") "value"))) - -(defun cider-verify-clojurescript-is-present () - "Check whether ClojureScript is present." - (unless (cider-clojurescript-present-p) - (user-error "ClojureScript is not available. See https://docs.cider.mx/cider/basics/clojurescript for details"))) - -(defun cider-verify-piggieback-is-present () - "Check whether the piggieback middleware is present." - (unless (cider-library-present-p "cider.piggieback") - (user-error "Piggieback 0.4.x (aka cider/piggieback) is not available. See https://docs.cider.mx/cider/basics/clojurescript for details"))) - -(defun cider-check-node-requirements () - "Check whether we can start a Node ClojureScript REPL." - (cider-verify-piggieback-is-present) - (unless (executable-find "node") - (user-error "Node.js is not present on the exec-path. Make sure you've installed it and your exec-path is properly set"))) - -(defun cider-check-figwheel-requirements () - "Check whether we can start a Figwheel ClojureScript REPL." - (cider-verify-piggieback-is-present) - (unless (cider-library-present-p "figwheel-sidecar.repl") - (user-error "Figwheel-sidecar is not available. Please check https://docs.cider.mx/cider/basics/clojurescript for details"))) - -(defun cider-check-figwheel-main-requirements () - "Check whether we can start a Figwheel ClojureScript REPL." - (cider-verify-piggieback-is-present) - (unless (cider-library-present-p "figwheel.main") - (user-error "Figwheel-main is not available. Please check https://docs.cider.mx/cider/basics/clojurescript for details"))) - -(defun cider-check-weasel-requirements () - "Check whether we can start a Weasel ClojureScript REPL." - (cider-verify-piggieback-is-present) - (unless (cider-library-present-p "weasel.repl.server") - (user-error "Weasel in not available. Please check https://docs.cider.mx/cider/basics/clojurescript/#browser-connected-clojurescript-repl for details"))) - -(defun cider-check-boot-requirements () - "Check whether we can start a Boot ClojureScript REPL." - (cider-verify-piggieback-is-present) - (unless (cider-library-present-p "adzerk.boot-cljs-repl") - (user-error "The Boot ClojureScript REPL is not available. Please check https://github.com/adzerk-oss/boot-cljs-repl/blob/master/README.md for details"))) - -(defun cider-check-krell-requirements () - "Check whether we can start a Krell ClojureScript REPL." - (cider-verify-piggieback-is-present) - (unless (cider-library-present-p "krell.repl") - (user-error "The Krell ClojureScript REPL is not available. Please check https://github.com/vouch-opensource/krell for details"))) - -(defun cider-check-shadow-cljs-requirements () - "Check whether we can start a shadow-cljs REPL." - (unless (cider-library-present-p "shadow.cljs.devtools.api") - (user-error "The shadow-cljs ClojureScript REPL is not available. Please check https://docs.cider.mx/cider/basics/clojurescript for details"))) - -(defun cider-normalize-cljs-init-options (options) - "Normalize the OPTIONS string used for initializing a ClojureScript REPL." - (if (or (string-prefix-p "{" options) - (string-prefix-p "(" options) - (string-prefix-p "[" options) - (string-prefix-p ":" options) - (string-prefix-p "\"" options)) - options - (concat ":" options))) - -(defcustom cider-shadow-watched-builds nil - "Defines the list of builds `shadow-cljs' should watch." - :type '(repeat string) - :safe #'listp - :package-version '(cider . "1.0")) - -(defcustom cider-shadow-default-options nil - "Defines default `shadow-cljs' options." - :type 'string - :safe (lambda (s) (or (null s) (stringp s))) - :package-version '(cider . "0.18.0")) - -(defun cider--shadow-parse-builds (hash) - "Parses the build names of a shadow-cljs.edn HASH map. -The default options of `browser-repl' and `node-repl' are also included." - (let* ((builds (when (hash-table-p hash) - (gethash :builds hash))) - (build-keys (when (hash-table-p builds) - (hash-table-keys builds)))) - (append build-keys '(browser-repl node-repl)))) - -(defun cider--shadow-get-builds () - "Extract build names from the shadow-cljs.edn config file in the project root." - (let ((shadow-edn (concat (clojure-project-dir) "shadow-cljs.edn"))) - (when (file-readable-p shadow-edn) - (with-temp-buffer - (insert-file-contents shadow-edn) - (condition-case err - (let ((hash (car (parseedn-read '((shadow/env . identity) - (env . identity)))))) - (cider--shadow-parse-builds hash)) - (error - (user-error "Found an error while reading %s with message: %s" - shadow-edn - (error-message-string err)))))))) - -(defun cider-shadow-select-cljs-init-form () - "Generate the init form for a shadow-cljs select-only REPL. -We have to prompt the user to select a build, that's why this is a command, -not just a string." - (let ((form "(do (require '[shadow.cljs.devtools.api :as shadow]) (shadow/nrepl-select %s))") - (options (or cider-shadow-default-options - (completing-read "Select shadow-cljs build: " - (cider--shadow-get-builds))))) - (format form (cider-normalize-cljs-init-options options)))) - -(defun cider-shadow-cljs-init-form () - "Generate the init form for a shadow-cljs REPL. -We have to prompt the user to select a build, that's why -this is a command, not just a string." - (let* ((shadow-require "(require '[shadow.cljs.devtools.api :as shadow])") - - (default-build (cider-normalize-cljs-init-options - (or cider-shadow-default-options - (car cider-shadow-watched-builds) - (completing-read "Select shadow-cljs build: " - (cider--shadow-get-builds))))) - - (watched-builds (or (mapcar #'cider-normalize-cljs-init-options cider-shadow-watched-builds) - (list default-build))) - - (watched-builds-form (mapconcat (lambda (build) (format "(shadow/watch %s)" build)) - watched-builds - " ")) - ;; form used for user-defined builds - (user-build-form "(do %s %s (shadow/nrepl-select %s))") - ;; form used for built-in builds like :browser-repl and :node-repl - (default-build-form "(do %s (shadow/%s))")) - (if (member default-build '(":browser-repl" ":node-repl")) - (format default-build-form shadow-require (string-remove-prefix ":" default-build)) - (format user-build-form shadow-require watched-builds-form default-build)))) - -(defcustom cider-figwheel-main-default-options nil - "Defines the `figwheel.main/start' options. - -Note that figwheel-main/start can also accept a map of options, refer to -Figwheel for details." - :type 'string - :safe (lambda (s) (or (null s) (stringp s))) - :package-version '(cider . "0.18.0")) - -(defun cider--figwheel-main-get-builds () - "Extract build names from the <build-id>.cljs.edn config files. -Fetches them in the project root." - (when-let ((project-dir (clojure-project-dir))) - (let ((builds (directory-files project-dir nil ".*\\.cljs\\.edn"))) - (mapcar (lambda (f) (string-match "^\\(.*\\)\\.cljs\\.edn" f) - (match-string 1 f)) - builds)))) - -(defun cider-figwheel-main-init-form () - "Produce the figwheel-main ClojureScript init form." - (let ((form "(do (require 'figwheel.main) (figwheel.main/start %s))") - (builds (cider--figwheel-main-get-builds))) - (cond - (cider-figwheel-main-default-options - (format form (cider-normalize-cljs-init-options (string-trim cider-figwheel-main-default-options)))) - - (builds - (format form (cider-normalize-cljs-init-options (completing-read "Select figwheel-main build: " builds)))) - - (t (user-error "No figwheel-main build files (<build-id>.cljs.edn) were found"))))) - -(defcustom cider-custom-cljs-repl-init-form nil - "The form used to start a custom ClojureScript REPL. -When set it becomes the return value of the `cider-custom-cljs-repl-init-form' -function, which normally prompts for the init form. - -This defcustom is mostly intended for use with .dir-locals.el for -cases where it doesn't make sense to register a new ClojureScript REPL type." - :type 'string - :safe (lambda (s) (or (null s) (stringp s))) - :package-version '(cider . "0.23.0")) - -(defun cider-custom-cljs-repl-init-form () - "The form used to start a custom ClojureScript REPL. -Defaults to the value of `cider-custom-cljs-repl-init-form'. -If it's nil the function will prompt for a form. -The supplied string will be wrapped in a do form if needed." - (or - cider-custom-cljs-repl-init-form - (let ((form (read-from-minibuffer "Please, provide a form to start a ClojureScript REPL: "))) - ;; TODO: We should probably make this more robust (e.g. by using a regexp or - ;; parsing the form). - (if (string-prefix-p "(do" form) - form - (format "(do %s)" form))))) - -(defvar cider-cljs-repl-types - '((figwheel "(do (require 'figwheel-sidecar.repl-api) (figwheel-sidecar.repl-api/start-figwheel!) (figwheel-sidecar.repl-api/cljs-repl))" - cider-check-figwheel-requirements) - (figwheel-main cider-figwheel-main-init-form cider-check-figwheel-main-requirements) - (figwheel-connected "(figwheel-sidecar.repl-api/cljs-repl)" - cider-check-figwheel-requirements) - (browser "(do (require 'cljs.repl.browser) (cider.piggieback/cljs-repl (cljs.repl.browser/repl-env)))") - (node "(do (require 'cljs.repl.node) (cider.piggieback/cljs-repl (cljs.repl.node/repl-env)))" - cider-check-node-requirements) - (weasel "(do (require 'weasel.repl.websocket) (cider.piggieback/cljs-repl (weasel.repl.websocket/repl-env :ip \"127.0.0.1\" :port 9001)))" - cider-check-weasel-requirements) - (boot "(do (require 'adzerk.boot-cljs-repl) (adzerk.boot-cljs-repl/start-repl))" - cider-check-boot-requirements) - (shadow cider-shadow-cljs-init-form cider-check-shadow-cljs-requirements) - (shadow-select cider-shadow-select-cljs-init-form cider-check-shadow-cljs-requirements) - (krell "(require '[clojure.edn :as edn] - '[clojure.java.io :as io] - '[cider.piggieback] - '[krell.api :as krell] - '[krell.repl]) -(def config (edn/read-string (slurp (io/file \"build.edn\")))) -(apply cider.piggieback/cljs-repl (krell.repl/repl-env) (mapcat identity config))" - cider-check-krell-requirements) - ;; native cljs repl, no form required. - (nbb) - (custom cider-custom-cljs-repl-init-form nil)) - "A list of supported ClojureScript REPLs. - -For each one we have its name, and then, if the repl is not a native -ClojureScript REPL, the form we need to evaluate in a Clojure REPL to -switch to the ClojureScript REPL and functions to verify their -requirements. - -The form, if any, should be either a string or a function producing a -string.") - -(defun cider-register-cljs-repl-type (type &optional init-form requirements-fn) - "Register a new ClojureScript REPL type. - -Types are defined by the following: - -- TYPE - symbol identifier that will be used to refer to the REPL type -- INIT-FORM - (optional) string or function (symbol) producing string -- REQUIREMENTS-FN - function to check whether the REPL can be started. -This param is optional. - -All this function does is modifying `cider-cljs-repl-types'. -It's intended to be used in your Emacs config." - (unless (symbolp type) - (user-error "The REPL type must be a symbol")) - (unless (or (null init-form) (stringp init-form) (symbolp init-form)) - (user-error "The init form must be a string or a symbol referring to a function or nil")) - (unless (or (null requirements-fn) (symbolp requirements-fn)) - (user-error "The requirements-fn must be a symbol referring to a function")) - (add-to-list 'cider-cljs-repl-types (list type init-form requirements-fn))) - -(defcustom cider-default-cljs-repl nil - "The default ClojureScript REPL to start. -This affects commands like `cider-jack-in-cljs'. Generally it's -intended to be set via .dir-locals.el for individual projects, as its -relatively unlikely you'd like to use the same type of REPL in each project -you're working on." - :type '(choice (const :tag "Figwheel" figwheel) - (const :tag "Figwheel Main" figwheel-main) - (const :tag "Browser" browser) - (const :tag "Node" node) - (const :tag "Weasel" weasel) - (const :tag "Boot" boot) - (const :tag "Shadow" shadow) - (const :tag "Shadow w/o Server" shadow-select) - (const :tag "Krell" krell) - (const :tag "Nbb" nbb) - (const :tag "Custom" custom)) - :safe #'symbolp - :package-version '(cider . "0.17.0")) - -(make-obsolete-variable 'cider-cljs-lein-repl 'cider-default-cljs-repl "0.17") -(make-obsolete-variable 'cider-cljs-boot-repl 'cider-default-cljs-repl "0.17") -(make-obsolete-variable 'cider-cljs-gradle-repl 'cider-default-cljs-repl "0.17") - -(defvar cider--select-cljs-repl-history nil) -(defun cider-select-cljs-repl (&optional default) - "Select the ClojureScript REPL to use with `cider-jack-in-cljs'. -DEFAULT is the default ClojureScript REPL to offer in completion." - (let ((repl-types (mapcar #'car cider-cljs-repl-types))) - (intern (completing-read "Select ClojureScript REPL type: " repl-types - nil nil nil 'cider--select-cljs-repl-history - (or default (car cider--select-cljs-repl-history)))))) - -(defun cider-cljs-repl-form (repl-type) - "Get the cljs REPL form for REPL-TYPE, if any." - (if-let* ((repl-type-info (seq-find - (lambda (entry) - (eq (car entry) repl-type)) - cider-cljs-repl-types))) - (when-let ((repl-form (cadr repl-type-info))) - ;; repl-form can be either a string or a function producing a string - (if (symbolp repl-form) - (funcall repl-form) - repl-form)) - (user-error "No ClojureScript REPL type %s found. Please make sure that `cider-cljs-repl-types' has an entry for it" repl-type))) - -(defun cider-verify-cljs-repl-requirements (&optional repl-type) - "Verify that the requirements for REPL-TYPE are met. -Return REPL-TYPE if requirements are met." - (let ((repl-type (or repl-type - cider-default-cljs-repl - (cider-select-cljs-repl)))) - (when cider-check-cljs-repl-requirements - (when-let* ((fun (nth 2 (seq-find - (lambda (entry) - (eq (car entry) repl-type)) - cider-cljs-repl-types)))) - (funcall fun))) - repl-type)) - -(defun cider--check-cljs (&optional cljs-type no-error) - "Verify that all cljs requirements are met for CLJS-TYPE connection. -Return REPL-TYPE of requirement are met, and throw an ‘user-error’ otherwise. -When NO-ERROR is non-nil, don't throw an error, issue a message and return -nil." - (if no-error - (condition-case ex - (progn - (cider-verify-clojurescript-is-present) - (cider-verify-cljs-repl-requirements cljs-type)) - (error - (message "Invalid ClojureScript dependency: %S" ex) - nil)) - (cider-verify-clojurescript-is-present) - (cider-verify-cljs-repl-requirements cljs-type))) - -(defun cider--offer-to-open-app-in-browser (server-buffer) - "Look for a server address in SERVER-BUFFER and offer to open it." - (when (buffer-live-p server-buffer) - (with-current-buffer server-buffer - (save-excursion - (goto-char (point-min)) - (when-let* ((url (and (search-forward-regexp "http://localhost:[0-9]+" nil 'noerror) - (match-string 0)))) - (when (y-or-n-p (format "Visit ‘%s’ in a browser? " url)) - (browse-url url))))))) - - -;;; User Level Connectors - -;;;###autoload (autoload 'cider-start-map "cider" "CIDER jack-in and connect keymap." t 'keymap) -(defvar cider-start-map - (let ((map (define-prefix-command 'cider-start-map))) - (define-key map (kbd "x") #'cider) - (define-key map (kbd "C-x") #'cider) - (define-key map (kbd "j j") #'cider-jack-in-clj) - (define-key map (kbd "j s") #'cider-jack-in-cljs) - (define-key map (kbd "j m") #'cider-jack-in-clj&cljs) - (define-key map (kbd "j u") #'cider-jack-in-universal) - (define-key map (kbd "j n") #'cider-start-nrepl-server) - (define-key map (kbd "C-j j") #'cider-jack-in-clj) - (define-key map (kbd "C-j s") #'cider-jack-in-cljs) - (define-key map (kbd "C-j m") #'cider-jack-in-clj&cljs) - (define-key map (kbd "C-j n") #'cider-start-nrepl-server) - (define-key map (kbd "C-j C-j") #'cider-jack-in-clj) - (define-key map (kbd "C-j C-s") #'cider-jack-in-cljs) - (define-key map (kbd "C-j C-m") #'cider-jack-in-clj&cljs) - (define-key map (kbd "C-j C-n") #'cider-start-nrepl-server) - (define-key map (kbd "c j") #'cider-connect-clj) - (define-key map (kbd "c s") #'cider-connect-cljs) - (define-key map (kbd "c m") #'cider-connect-clj&cljs) - (define-key map (kbd "C-c j") #'cider-connect-clj) - (define-key map (kbd "C-c s") #'cider-connect-cljs) - (define-key map (kbd "C-c m") #'cider-connect-clj&cljs) - (define-key map (kbd "C-c C-j") #'cider-connect-clj) - (define-key map (kbd "C-c C-s") #'cider-connect-cljs) - (define-key map (kbd "C-c C-m") #'cider-connect-clj&cljs) - (define-key map (kbd "s j") #'cider-connect-sibling-clj) - (define-key map (kbd "s s") #'cider-connect-sibling-cljs) - (define-key map (kbd "C-s j") #'cider-connect-sibling-clj) - (define-key map (kbd "C-s s") #'cider-connect-sibling-cljs) - (define-key map (kbd "C-s C-j") #'cider-connect-sibling-clj) - (define-key map (kbd "C-s C-s") #'cider-connect-sibling-cljs) - map) - "CIDER jack-in and connect keymap.") - -(defun cider--start-nrepl-server (params &optional on-port-callback) - "Start an nREPL server. -PARAMS is a plist optionally containing :project-dir and :jack-in-cmd. -ON-PORT-CALLBACK (optional) is a function of one argument (server buffer) -which is called by the process filter once the port of the connection has -been determined." - (nrepl-start-server-process - (plist-get params :project-dir) - (plist-get params :jack-in-cmd) - on-port-callback)) - -(defun cider--update-params (params) - "Fill-in the passed in PARAMS plist needed to start an nREPL server. -Updates :project-dir and :jack-in-cmd. -Also checks whether a matching session already exists." - (thread-first - params - (cider--update-project-dir) - (cider--check-existing-session) - (cider--update-jack-in-cmd))) - -;;;###autoload -(defun cider-jack-in-clj (params) - "Start an nREPL server for the current project and connect to it. -PARAMS is a plist optionally containing :project-dir and :jack-in-cmd. -With the prefix argument, allow editing of the jack in command; with a -double prefix prompt for all these parameters." - (interactive "P") - (let ((params (cider--update-params params))) - (cider--start-nrepl-server - params - (lambda (server-buffer) - (cider-connect-sibling-clj params server-buffer))))) - -(defun cider-start-nrepl-server (params) - "Start an nREPL server for the current project, but don't connect to it. -PARAMS is a plist optionally containing :project-dir and :jack-in-cmd. -With the prefix argument, allow editing of the start server command; with a -double prefix prompt for all these parameters." - (interactive "P") - (cider--start-nrepl-server (cider--update-params params))) - -;;;###autoload -(defun cider-jack-in-cljs (params) - "Start an nREPL server for the current project and connect to it. -PARAMS is a plist optionally containing :project-dir, :jack-in-cmd and -:cljs-repl-type (e.g. 'shadow, 'node, 'figwheel, etc). - -With the prefix argument, -allow editing of the jack in command; with a double prefix prompt for all -these parameters." - (interactive "P") - (let ((cider-enrich-classpath nil) ;; ensure it's disabled for cljs projects, for now - (cider-jack-in-dependencies (append cider-jack-in-dependencies cider-jack-in-cljs-dependencies)) - (cider-jack-in-lein-plugins (append cider-jack-in-lein-plugins cider-jack-in-cljs-lein-plugins)) - (cider-jack-in-nrepl-middlewares (append cider-jack-in-nrepl-middlewares cider-jack-in-cljs-nrepl-middlewares)) - (orig-buffer (current-buffer))) - ;; cider--update-jack-in-cmd relies indirectly on the above dynamic vars - (let ((params (thread-first - params - (cider--update-project-dir) - (cider--check-existing-session) - (cider--update-jack-in-cmd)))) - (nrepl-start-server-process - (plist-get params :project-dir) - (plist-get params :jack-in-cmd) - (lambda (server-buffer) - (with-current-buffer orig-buffer - (cider-connect-sibling-cljs params server-buffer))))))) - -;;;###autoload -(defun cider-jack-in-clj&cljs (&optional params soft-cljs-start) - "Start an nREPL server and connect with clj and cljs REPLs. -PARAMS is a plist optionally containing :project-dir, :jack-in-cmd and -:cljs-repl-type (e.g. 'shadow, 'node, 'fighweel, etc). - -With the prefix argument, allow for editing of the jack in command; -with a double prefix prompt for all these parameters. - -When SOFT-CLJS-START is non-nil, start cljs REPL -only when the ClojureScript dependencies are met." - (interactive "P") - (let ((cider-enrich-classpath nil) ;; ensure it's disabled for cljs projects, for now - (cider-jack-in-dependencies (append cider-jack-in-dependencies cider-jack-in-cljs-dependencies)) - (cider-jack-in-lein-plugins (append cider-jack-in-lein-plugins cider-jack-in-cljs-lein-plugins)) - (cider-jack-in-nrepl-middlewares (append cider-jack-in-nrepl-middlewares cider-jack-in-cljs-nrepl-middlewares)) - (orig-buffer (current-buffer))) - ;; cider--update-jack-in-cmd relies indirectly on the above dynamic vars - (let ((params (thread-first - params - (cider--update-project-dir) - (cider--check-existing-session) - (cider--update-jack-in-cmd) - (cider--update-cljs-type) - ;; already asked, don't ask on sibling connect - (plist-put :do-prompt nil)))) - (nrepl-start-server-process - (plist-get params :project-dir) - (plist-get params :jack-in-cmd) - (lambda (server-buffer) - (with-current-buffer orig-buffer - (let ((clj-repl (cider-connect-sibling-clj params server-buffer))) - (if soft-cljs-start - (when (cider--check-cljs (plist-get params :cljs-repl-type) 'no-error) - (cider-connect-sibling-cljs params clj-repl)) - (cider-connect-sibling-cljs params clj-repl))))))))) - -;;;###autoload -(defun cider-connect-sibling-clj (params &optional other-repl) - "Create a Clojure REPL with the same server as OTHER-REPL. -PARAMS is for consistency with other connection commands and is currently -ignored. OTHER-REPL defaults to `cider-current-repl' and in programs can -also be a server buffer, in which case a new session with a REPL for that -server is created." - (interactive "P") - (cider-nrepl-connect - (let* ((other-repl (or other-repl (cider-current-repl 'any 'ensure))) - (other-params (cider--gather-connect-params nil other-repl)) - (ses-name (unless (nrepl-server-p other-repl) - (sesman-session-name-for-object 'CIDER other-repl)))) - (thread-first - params - (cider--update-do-prompt) - (append other-params) - (plist-put :repl-init-function nil) - (plist-put :repl-type 'clj) - (plist-put :session-name ses-name))))) - -;;;###autoload -(defun cider-connect-sibling-cljs (params &optional other-repl) - "Create a ClojureScript REPL with the same server as OTHER-REPL. -PARAMS is a plist optionally containing :cljs-repl-type (e.g. 'node, -'figwheel, 'shadow, etc). - -All other parameters are inferred from the OTHER-REPL. -OTHER-REPL defaults to `cider-current-repl' but in programs can also be a -server buffer, in which case a new session for that server is created." - (interactive "P") - (let* ((other-repl (or other-repl (cider-current-repl 'any 'ensure))) - (other-params (cider--gather-connect-params nil other-repl)) - ;; type-related params from the JVM conn are undesired for a cljs conn: - (other-params (thread-first other-params (map-delete :repl-type) (map-delete :cljs-repl-type))) - (ses-name (unless (nrepl-server-p other-repl) - (sesman-session-name-for-object 'CIDER other-repl)))) - (cider-nrepl-connect - (thread-first - params - (cider--update-do-prompt) - (append other-params) - (cider--update-cljs-type) - (cider--update-cljs-init-function) - (plist-put :session-name ses-name) - (plist-put :repl-type 'cljs))))) - -;;;###autoload -(defun cider-connect-clj (&optional params) - "Initialize a Clojure connection to an nREPL server. -PARAMS is a plist optionally containing :host, :port and :project-dir. On -prefix argument, prompt for all the parameters." - (interactive "P") - (cider-nrepl-connect - (thread-first - params - (cider--update-project-dir) - (cider--update-host-port) - (cider--check-existing-session) - (plist-put :repl-init-function nil) - (plist-put :session-name nil) - (plist-put :repl-type 'clj)))) - -;;;###autoload -(defun cider-connect-cljs (&optional params) - "Initialize a ClojureScript connection to an nREPL server. -PARAMS is a plist optionally containing :host, :port, :project-dir and -:cljs-repl-type (e.g. 'shadow, 'node, 'figwheel, etc). - -On prefix, prompt for all the -parameters regardless of their supplied or default values." - (interactive "P") - (cider-nrepl-connect - (thread-first - params - (cider--update-project-dir) - (cider--update-host-port) - (cider--check-existing-session) - (cider--update-cljs-type) - (cider--update-cljs-init-function) - (plist-put :session-name nil) - (plist-put :repl-type 'cljs)))) - -;;;###autoload -(defun cider-connect-clj&cljs (params &optional soft-cljs-start) - "Initialize a Clojure and ClojureScript connection to an nREPL server. -PARAMS is a plist optionally containing :host, :port, :project-dir and -:cljs-repl-type (e.g. 'shadow, 'node, 'figwheel, etc). When SOFT-CLJS-START is -non-nil, don't start if ClojureScript requirements are not met." - (interactive "P") - (let* ((params (thread-first - params - (cider--update-project-dir) - (cider--update-host-port) - (cider--check-existing-session) - (cider--update-cljs-type))) - (clj-params (thread-first - params - copy-sequence - (map-delete :cljs-repl-type))) - (clj-repl (cider-connect-clj clj-params))) - (when (if soft-cljs-start - (cider--check-cljs (plist-get params :cljs-repl-type) 'no-error) - t) - (cider-connect-sibling-cljs params clj-repl)))) - -(defvar cider-connection-init-commands - '(cider-jack-in-clj - cider-jack-in-cljs - cider-jack-in-clj&cljs - cider-connect-clj - cider-connect-cljs - cider-connect-clj&cljs - cider-connect-sibling-clj - cider-connect-sibling-cljs) - "A list of all user-level connection init commands in CIDER.") - -;;;###autoload -(defun cider () - "Start a connection of any type interactively." - (interactive) - (when-let* ((command (intern (completing-read "Select command: " cider-connection-init-commands)))) - (call-interactively command))) - - -;;; PARAMS updating - -(defun cider--update-do-prompt (params) - "Update :do-prompt in PARAMS." - (cond ((equal params '(4)) (list :edit-jack-in-command t)) - ((equal params '(16)) (list :do-prompt t)) - (t params))) - -(defun cider--update-project-dir (params) - "Update :project-dir in PARAMS. - -Params is a plist with the following keys (non-exhaustive) - - :edit-project-dir prompt (optional) ask user to confirm the project root - directory." - (let* ((params (cider--update-do-prompt params)) - (proj-dir (if (or (plist-get params :do-prompt) - (plist-get params :edit-project-dir)) - (read-directory-name "Project: " - (clojure-project-dir (cider-current-dir))) - (plist-get params :project-dir))) - (orig-buffer (current-buffer))) - (if (or (null proj-dir) - (file-in-directory-p default-directory proj-dir)) - (plist-put params :project-dir - (or proj-dir - (clojure-project-dir (cider-current-dir)))) - ;; If proj-dir is not a parent of default-directory, transfer all local - ;; variables and hack dir-local variables into a temporary buffer and keep - ;; that buffer within `params` for the later use by other --update- - ;; functions. The context buffer should not be used outside of the param - ;; initialization pipeline. Therefore, we don't bother with making it - ;; unique or killing it anywhere. - (let ((context-buf-name " *cider-context-buffer*")) - (when (get-buffer context-buf-name) - (kill-buffer context-buf-name)) - (with-current-buffer (get-buffer-create context-buf-name) - (dolist (pair (buffer-local-variables orig-buffer)) - (pcase pair - (`(,name . ,value) ;ignore unbound variables - (ignore-errors (set (make-local-variable name) value)))) - (setq-local buffer-file-name nil)) - (let ((default-directory proj-dir)) - (hack-dir-local-variables-non-file-buffer) - (thread-first - params - (plist-put :project-dir proj-dir) - (plist-put :--context-buffer (current-buffer))))))))) - -(defun cider--update-cljs-type (params) - "Update :cljs-repl-type in PARAMS." - (with-current-buffer (or (plist-get params :--context-buffer) - (current-buffer)) - (let ((params (cider--update-do-prompt params)) - (inferred-type (or (plist-get params :cljs-repl-type) - cider-default-cljs-repl))) - (plist-put params :cljs-repl-type - (if (plist-get params :do-prompt) - (cider-select-cljs-repl inferred-type) - (or inferred-type - (cider-select-cljs-repl))))))) - -(defcustom cider-edit-jack-in-command nil - "When truthy allow the user to edit the command." - :type 'boolean - :safe #'booleanp - :version '(cider . "0.22.0")) - -(defvar cider--jack-in-nrepl-params-history nil - "History list for user-specified jack-in nrepl command params.") - -(defvar cider--jack-in-cmd-history nil - "History list for user-specified jack-in commands.") - -(defun cider--format-cmd (command-resolved command cmd-params) - "Format COMMAND-RESOLVED or COMMAND followed by CMD-PARAMS." - (format "%s %s" command-resolved - (if (cider--jack-in-cmd-powershell-p command) - (cider--powershell-encode-command cmd-params) - cmd-params))) - -(defun cider--update-jack-in-cmd (params) - "Update :jack-in-cmd key in PARAMS. - -PARAMS is a plist with the following keys (non-exhaustive list) - -:project-type optional, the project type to create the command for; see -`cider-jack-in-command' for the list of valid types)." - (cond - ((plist-get params :jack-in-cmd) params) - (cider-jack-in-cmd (plist-put params :jack-in-cmd cider-jack-in-cmd)) - (t (let* ((params (cider--update-do-prompt params)) - (project-dir (plist-get params :project-dir)) - (params-project-type (plist-get params :project-type)) - (project-type (or params-project-type - (cider-project-type project-dir))) - (command (cider-jack-in-command project-type)) - (command-resolved (cider-jack-in-resolve-command project-type)) - ;; TODO: global-options are deprecated and should be removed in CIDER 2.0 - (command-global-opts (cider-jack-in-global-options project-type)) - (command-params (cider-jack-in-params project-type))) - (if command-resolved - (with-current-buffer (or (plist-get params :--context-buffer) - (current-buffer)) - (let* ((command-params (if (plist-get params :do-prompt) - (read-string "nREPL server command: " - command-params - 'cider--jack-in-nrepl-params-history) - command-params)) - (cmd-params (if cider-inject-dependencies-at-jack-in - (cider-inject-jack-in-dependencies command-global-opts command-params - project-type command) - command-params))) - (if (or project-dir cider-allow-jack-in-without-project) - (when (or project-dir - (eq cider-allow-jack-in-without-project t) - (and (null project-dir) - (eq cider-allow-jack-in-without-project 'warn) - (or params-project-type - (y-or-n-p "Are you sure you want to run `cider-jack-in' without a Clojure project? ")))) - (let* ((cmd (cider--format-cmd command-resolved command cmd-params)) - (edited-command (if (or cider-edit-jack-in-command - (plist-get params :edit-jack-in-command)) - (read-string "jack-in command: " cmd 'cider--jack-in-cmd-history) - cmd))) - (plist-put params :jack-in-cmd edited-command))) - (user-error "`cider-jack-in' is not allowed without a Clojure project")))) - (user-error "The %s executable isn't on your `exec-path'" command)))))) - -(defun cider--update-host-port (params) - "Update :host and :port; or :socket-file in PARAMS." - (with-current-buffer (or (plist-get params :--context-buffer) - (current-buffer)) - (let* ((params (cider--update-do-prompt params)) - (host (plist-get params :host)) - (port (plist-get params :port)) - (endpoint (if (plist-get params :do-prompt) - (cider-select-endpoint) - (if (and host port) - (cons host port) - (cider-select-endpoint))))) - (if (equal "local-unix-domain-socket" (car endpoint)) - (plist-put params :socket-file (cdr endpoint)) - (thread-first - params - (plist-put :host (car endpoint)) - (plist-put :port (cdr endpoint))))))) - -(defun cider--update-cljs-init-function (params) - "Update repl type and any init PARAMS for cljs connections. - -The updated params are: - -:cider-repl-cljs-upgrade-pending nil if it is a cljs REPL, or t -when the init form is required to be sent to the REPL to switch -over to cljs. - -:repl-init-form The form that can switch the REPL over to cljs. - -:repl-init-function The fn that switches the REPL over to cljs." - (with-current-buffer (or (plist-get params :--context-buffer) - (current-buffer)) - (let* ((cljs-type (plist-get params :cljs-repl-type)) - (repl-init-form (cider-cljs-repl-form cljs-type))) - (if (null repl-init-form) - (plist-put params :cider-repl-cljs-upgrade-pending nil) - - (thread-first - params - (plist-put :cider-repl-cljs-upgrade-pending t) - (plist-put :repl-init-function - (lambda () - (cider--check-cljs cljs-type) - (cider-nrepl-send-request - (list "op" "eval" - "ns" (cider-current-ns) - "code" repl-init-form) - (cider-repl-handler (current-buffer))) - (when (and (buffer-live-p nrepl-server-buffer) - cider-offer-to-open-cljs-app-in-browser) - (cider--offer-to-open-app-in-browser nrepl-server-buffer)))) - (plist-put :repl-init-form repl-init-form)))))) - -(defun cider--check-existing-session (params) - "Ask for confirmation if a session with similar PARAMS already exists. -If no session exists or user chose to proceed, return PARAMS. If the user -canceled the action, signal quit." - (let* ((proj-dir (plist-get params :project-dir)) - (host (plist-get params :host)) - (port (plist-get params :port)) - (session (seq-find (lambda (ses) - (let ((ses-params (cider--gather-session-params ses))) - (and (equal proj-dir (plist-get ses-params :project-dir)) - (or (null port) - (equal port (plist-get ses-params :port))) - (or (null host) - (equal host (plist-get ses-params :host)))))) - (sesman-current-sessions 'CIDER '(project))))) - (when session - (unless (y-or-n-p - (concat - "A CIDER session with the same connection parameters already exists (" (car session) "). " - "Are you sure you want to create a new session instead of using `cider-connect-sibling-clj(s)'? ")) - (let ((debug-on-quit nil)) - (signal 'quit nil))))) - params) - - -;;; Aliases - -;;;###autoload -(defalias 'cider-jack-in #'cider-jack-in-clj) -;;;###autoload -(defalias 'cider-connect #'cider-connect-clj) - - -;;; Helpers - -(defun cider-current-host () - "Retrieve the current host." - (or (when (stringp buffer-file-name) - (file-remote-p buffer-file-name 'host)) - "localhost")) - -(defun cider-select-endpoint () - "Interactively select the host and port to connect to." - (dolist (endpoint cider-known-endpoints) - (unless (stringp (or (nth 2 endpoint) - (nth 1 endpoint))) - (user-error "The port for %s in `cider-known-endpoints' should be a string" - (nth 0 endpoint)))) - (let* ((ssh-hosts (cider--ssh-hosts)) - (hosts (seq-uniq (append (when cider-host-history - ;; history elements are strings of the form "host:port" - (list (split-string (car cider-host-history) ":"))) - (list (list (cider-current-host))) - cider-known-endpoints - ssh-hosts - ;; always add localhost - '(("localhost") - ("local-unix-domain-socket"))))) - (sel-host (cider--completing-read-host hosts)) - (host (car sel-host)) - (port (or (cadr sel-host) - (if (equal host "local-unix-domain-socket") - (cider--completing-read-socket-file) - (cider--completing-read-port host (cider--infer-ports host ssh-hosts)))))) - (cons host port))) - -(defun cider--ssh-hosts () - "Retrieve all ssh host from local configuration files." - (seq-map (lambda (s) (list (replace-regexp-in-string ":$" "" s))) - ;; `tramp-completion-mode' is obsoleted in 26 - (cl-progv (if (version< emacs-version "26") - '(tramp-completion-mode) - '(non-essential)) '(t) - (tramp-completion-handle-file-name-all-completions "" "/ssh:")))) - -(defun cider--completing-read-host (hosts) - "Interactively select host from HOSTS. -Each element in HOSTS is one of: (host), (host port) or (label host port). -Return a list of the form (HOST PORT), where PORT can be nil." - (let* ((hosts (cider-join-into-alist hosts)) - (sel-host (completing-read "Host: " hosts nil nil nil - 'cider-host-history (caar hosts))) - (host (or (cdr (assoc sel-host hosts)) (list sel-host)))) - ;; remove the label - (if (= 3 (length host)) (cdr host) host))) - -(defun cider--tramp-file-name (vec) - "A simple compatibility wrapper around `make-tramp-file-name'. -Tramp version starting 26.1 is using a `cl-defstruct' rather than vanilla VEC." - (if (version< emacs-version "26.1") - vec - (with-no-warnings - (make-tramp-file-name :method (elt vec 0) - :host (elt vec 2))))) - -(defcustom cider-infer-remote-nrepl-ports nil - "When true, cider will use ssh to try to infer nREPL ports on remote hosts." - :type 'boolean - :safe #'booleanp - :package-version '(cider . "0.19.0")) - -(defun cider--infer-ports (host ssh-hosts) - "Infer nREPL ports on HOST. -Return a list of elements of the form (directory port). SSH-HOSTS is a list -of remote SSH hosts." - (let ((localp (or (nrepl-local-host-p host) - (not (assoc-string host ssh-hosts))))) - (if localp - ;; change dir: current file might be remote - (let* ((change-dir-p (file-remote-p default-directory)) - (default-directory (if change-dir-p "~/" default-directory))) - (cider-locate-running-nrepl-ports (unless change-dir-p default-directory))) - (when cider-infer-remote-nrepl-ports - (let ((vec (vector "sshx" nil host "" nil)) - ;; change dir: user might want to connect to a different remote - (dir (when (file-remote-p default-directory) - (with-parsed-tramp-file-name default-directory cur - (when (string= cur-host host) default-directory))))) - (tramp-maybe-open-connection (cider--tramp-file-name vec)) - (with-current-buffer (tramp-get-connection-buffer (cider--tramp-file-name vec)) - (cider-locate-running-nrepl-ports dir))))))) - -(defun cider--completing-read-port (host ports) - "Interactively select port for HOST from PORTS." - (let* ((ports (cider-join-into-alist ports)) - (sel-port (completing-read (format "Port for %s: " host) ports - nil nil nil nil (caar ports))) - (port (or (cdr (assoc sel-port ports)) sel-port)) - (port (if (listp port) (cadr port) port))) - (if (stringp port) (string-to-number port) port))) - -(defun cider--completing-read-socket-file () - "Interactively select unix domain socket file name." - (read-file-name "Socket File: " nil nil t nil - (lambda (filename) - "Predicate: auto-complete only socket-files and directories" - (let ((filetype (string-to-char - (file-attribute-modes - (file-attributes - filename))))) - (or (eq ?s filetype) - (eq ?d filetype)))))) - -(defun cider--path->path-port-pairs (path) - "Given PATH, returns all the possible <path, port> pairs." - (thread-last path - cider--file-path - nrepl-extract-ports - (mapcar (lambda (port) - (list path port))) - ;; remove nils that may have been returned due to permission errors: - (seq-filter #'identity))) - -(defun cider--invoke-running-nrepl-path (f) - "Invokes F safely. - -Necessary since we run some OS-specific commands that may fail." - (condition-case nil - (let* ((x (funcall f))) - (mapcar (lambda (v) - (if (and (listp v) - (not (file-exists-p (car v)))) - nil - v)) - x)) - (error nil))) - -(defun cider-locate-running-nrepl-ports (&optional dir) - "Locate ports of running nREPL servers. -When DIR is non-nil also look for nREPL port files in DIR. Return a list -of list of the form (project-dir port)." - (let* ((pairs (cider--running-nrepl-paths)) - (pairs (if-let (c (and dir (clojure-project-dir dir))) - (append (cider--path->path-port-pairs c) pairs) - pairs))) - (thread-last pairs - (delq nil) - (mapcar (lambda (x) - (list (file-name-nondirectory (directory-file-name (car x))) - (nth 1 x)))) - (seq-uniq)))) - -(defun cider--running-lein-nrepl-paths () - "Retrieve project paths of running lein nREPL servers. -Use `cider-ps-running-lein-nrepls-command' and -`cider-ps-running-lein-nrepl-path-regexp-list'." - (unless (eq system-type 'windows-nt) - (let (paths) - (with-temp-buffer - (insert (shell-command-to-string cider-ps-running-lein-nrepls-command)) - (dolist (regexp cider-ps-running-lein-nrepl-path-regexp-list) - (goto-char 1) - (while (re-search-forward regexp nil t) - (setq paths (cons (match-string 1) paths))))) - (seq-mapcat (lambda (path) - (cider--path->path-port-pairs path)) - paths)))) - -(defun cider--running-non-lein-nrepl-paths () - "Retrieve (directory, port) pairs of running nREPL servers other than Lein ones." - (unless (eq system-type 'windows-nt) - (let* ((bb-indicator "--nrepl-server") - (non-lein-nrepl-pids - (thread-last (split-string - (shell-command-to-string - ;; some of the `ps u` lines we intend to catch: - ;; <username> 15411 0.0 0.0 37915744 16084 s000 S+ 3:02PM 0:00.02 bb --nrepl-server - ;; <username> 13835 0.1 11.2 37159036 7528432 s009 S+ 2:47PM 6:41.29 java -cp src -m nrepl.cmdline - (format "ps u | grep -E 'java|%s' | grep -E 'nrepl.cmdline|%s' | grep -v -E 'leiningen|grep'" - bb-indicator - bb-indicator)) - "\n") - (mapcar (lambda (s) - (nth 1 (split-string s " ")))) - (seq-filter #'identity)))) - (when non-lein-nrepl-pids - (thread-last non-lein-nrepl-pids - (mapcar (lambda (pid) - (let* ( - ;; -a: This flag is used to combine conditions with AND instead of OR - ;; -d: Lists only the file descriptors that match the given <descriptor> - ;; -n: Inhibits the conversion of network numbers to host names. - ;; -Fn: output file entry information as separate lines, with 'n' designating network info. - ;; -p: specifies the <PID>. - (directory (thread-last (split-string (shell-command-to-string (concat "lsof -a -d cwd -n -Fn -p " pid)) - "\n") - (seq-map (lambda (s) - (when (string-prefix-p "n" s) - (replace-regexp-in-string "^n" "" s)))) - (seq-filter #'identity) - car)) - ;; -a: This flag is used to combine conditions with AND instead of OR - ;; -n: Inhibits the conversion of network numbers to host names. - ;; -P: (important!) Ensure ports are shown as numbers, even if they have a well-known name. - ;; -Fn: output file entry information as separate lines, with 'n' designating network info. - ;; -i: this option selects the listing of all network files. - ;; -p: specifies the <PID>. - (port (thread-last (split-string (shell-command-to-string (concat "lsof -n -P -Fn -i -a -p " pid)) - "\n") - (seq-map (lambda (s) - (when (string-prefix-p "n" s) - (replace-regexp-in-string ".*:" "" s)))) - (seq-filter #'identity) - (seq-filter (lambda (s) - (condition-case nil - (numberp (read s)) - (error nil)))) - car))) - (list directory port)))) - (seq-filter #'cadr)))))) - -(defun cider--running-local-nrepl-paths () - "Retrieve project paths of running nREPL servers. -Do it by looping over the open REPL buffers." - (thread-last (buffer-list) - (seq-filter - (lambda (b) - (string-prefix-p "*cider-repl" (buffer-name b)))) - (seq-map - (lambda (b) - (with-current-buffer b - (when-let ((dir (plist-get (cider--gather-connect-params) :project-dir)) - (port (plist-get (cider--gather-connect-params) :port))) - (list dir (prin1-to-string port)))))) - (seq-filter #'identity))) - -(defun cider--running-nrepl-paths () - "Retrieve project paths of running nREPL servers. -Search for lein or java processes including nrepl.command nREPL." - (append (cider--invoke-running-nrepl-path #'cider--running-lein-nrepl-paths) - (cider--invoke-running-nrepl-path #'cider--running-local-nrepl-paths) - (cider--invoke-running-nrepl-path #'cider--running-non-lein-nrepl-paths))) - -(defun cider--identify-buildtools-present (&optional project-dir) - "Identify build systems present by their build files in PROJECT-DIR. -PROJECT-DIR defaults to current project." - (let* ((default-directory (or project-dir (clojure-project-dir (cider-current-dir)))) - (build-files '((lein . "project.clj") - (boot . "build.boot") - (clojure-cli . "deps.edn") - (babashka . "bb.edn") - (shadow-cljs . "shadow-cljs.edn") - (gradle . "build.gradle") - (gradle . "build.gradle.kts") - (nbb . "nbb.edn")))) - (delq nil - (mapcar (lambda (candidate) - (when (file-exists-p (cdr candidate)) - (car candidate))) - build-files)))) - -(defun cider-project-type (&optional project-dir) - "Determine the type of the project in PROJECT-DIR. -When multiple project file markers are present, check for a preferred build -tool in `cider-preferred-build-tool', otherwise prompt the user to choose. -PROJECT-DIR defaults to the current project." - (let* ((choices (cider--identify-buildtools-present project-dir)) - (multiple-project-choices (> (length choices) 1)) - ;; this needs to be a string to be used in `completing-read' - (default (symbol-name (car choices))) - ;; `cider-preferred-build-tool' used to be a string prior to CIDER - ;; 0.18, therefore the need for `cider-maybe-intern' - (preferred-build-tool (cider-maybe-intern cider-preferred-build-tool))) - (cond ((and multiple-project-choices - (member preferred-build-tool choices)) - preferred-build-tool) - (multiple-project-choices - (intern - (completing-read - (format "Which command should be used (default %s): " default) - choices nil t nil nil default))) - (choices - (car choices)) - ;; TODO: Move this fallback outside the project-type check - ;; if we're outside a project we fallback to whatever tool - ;; is specified in `cider-jack-in-default' (normally clojure-cli) - ;; `cider-jack-in-default' used to be a string prior to CIDER - ;; 0.18, therefore the need for `cider-maybe-intern' - (t (cider-maybe-intern cider-jack-in-default))))) - -;;;###autoload -(defun cider-jack-in-universal (arg) - "Start and connect to an nREPL server for the current project or ARG project id. - -If a project is found in current dir, call `cider-jack-in' passing ARG as -first parameter, of which see. Otherwise, ask user which project type to -start an nREPL server and connect to without a project. - -But if invoked with a numeric prefix ARG, then start an nREPL server for -the project type denoted by ARG number and connect to it, even if there is -no project for it in the current dir. - -The supported project tools and their assigned numeric prefix ids are -sourced from `cider-jack-in-universal-options', of which see. - -You can pass a numeric prefix argument n with `M-n` or `C-u n`. - -For example, to jack in to leiningen which is assigned to prefix arg 2 type - -M-2 \\[cider-jack-in-universal]." - (interactive "P") - (let ((cpt (clojure-project-dir (cider-current-dir)))) - (if (or (integerp arg) (null cpt)) - (let* ((project-types-available (mapcar #'car cider-jack-in-universal-options)) - (project-type (if (null arg) - (intern (completing-read - "No project found in current dir, select project type to jack in: " - project-types-available - nil t)) - - (or (seq-some (lambda (elt) - (cl-destructuring-bind - (project-type (&key prefix-arg &allow-other-keys)) elt - (when (= arg prefix-arg) - project-type))) - cider-jack-in-universal-options) - (error ":cider-jack-in-universal :unsupported-prefix-argument %S :no-such-project" - arg)))) - (project-options (cadr (seq-find (lambda (elt) (equal project-type (car elt))) - cider-jack-in-universal-options))) - (jack-in-opts (plist-get project-options :cmd)) - (jack-in-type (plist-get jack-in-opts :jack-in-type))) - (pcase jack-in-type - ('clj (cider-jack-in-clj jack-in-opts)) - ('cljs (cider-jack-in-cljs jack-in-opts)) - (_ (error ":cider-jack-in-universal :jack-in-type-unsupported %S" jack-in-type)))) - - (cider-jack-in-clj arg)))) - - -;; TODO: Implement a check for command presence over tramp -(defun cider--resolve-command (command) - "Find COMMAND in exec path (see variable `exec-path'). -Return nil if not found. In case `default-directory' is non-local we -assume the command is available." - (when-let* ((command (or (and (file-remote-p default-directory) command) - (executable-find command) - (executable-find (concat command ".bat"))))) - (shell-quote-argument command))) - -(defun cider--resolve-project-command (command) - "Find COMMAND in project dir or exec path (see variable `exec-path'). -If COMMAND starts with ./ or ../ resolve relative to `clojure-project-dir', -otherwise resolve via `cider--resolve-command'." - (if (string-match-p "\\`\\.\\{1,2\\}/" command) - (locate-file command (list (clojure-project-dir)) '("" ".bat") 'executable) - (cider--resolve-command command))) - -(defcustom cider-connection-message-fn #'cider-random-words-of-inspiration - "The function to use to generate the message displayed on connect. -When set to nil no additional message will be displayed. A good -alternative to the default is `cider-random-tip'." - :type 'function - :group 'cider - :package-version '(cider . "0.11.0")) - -(defun cider--maybe-inspire-on-connect () - "Display an inspiration connection message." - (when cider-connection-message-fn - (message "Connected! %s" (funcall cider-connection-message-fn)))) - -(add-hook 'cider-connected-hook #'cider--maybe-inspire-on-connect) - -;;;###autoload -(with-eval-after-load 'clojure-mode - (define-key clojure-mode-map (kbd "C-c M-x") #'cider) - (define-key clojure-mode-map (kbd "C-c M-j") #'cider-jack-in-clj) - (define-key clojure-mode-map (kbd "C-c M-J") #'cider-jack-in-cljs) - (define-key clojure-mode-map (kbd "C-c M-c") #'cider-connect-clj) - (define-key clojure-mode-map (kbd "C-c M-C") #'cider-connect-cljs) - (define-key clojure-mode-map (kbd "C-c C-x") 'cider-start-map) - (define-key clojure-mode-map (kbd "C-c C-s") 'sesman-map) - (require 'sesman) - (sesman-install-menu clojure-mode-map) - (add-hook 'clojure-mode-hook (lambda () (setq-local sesman-system 'CIDER)))) - -(provide 'cider) - -;;; cider.el ends here diff --git a/elpa/cider-1.12.0/clojure.sh b/elpa/cider-1.12.0/clojure.sh @@ -1,54 +0,0 @@ -#!/usr/bin/env bash -set -Eeuo pipefail -# This wrapper script adds enrich-classpath's (https://github.com/clojure-emacs/enrich-classpath) functionalities to the `clojure` binary. -# It works by accepting the `clojure` binary as the first argument, and whatever arguments you'd pass to `clojure` as the rest. -# sample usage: clojure.sh clojure -Asome-alias <<< "(System/getProperty \"java.class.path\")" - -clojure="$1" -# remove it from "$@"/"$*": -shift - -file="deps.edn" - -if [ ! -e $file ]; then - echo "$file not found." - $clojure "$@" -elif [[ "$*" == *Spath* ]]; then - echo "-Spath was passed; skipping enrich-classpath." - $clojure "$@" -elif [[ "$*" == *Scp* ]]; then - echo "-Scp was passed; skipping enrich-classpath." - $clojure "$@" -else - - here="$PWD" - there=$(mktemp -d -t mytempdir.XXXXXX) - - # copy any relevant file to the temporary folder - files_to_copy=( ".tool-versions" # asdf runtime versions configuration - ) - for file_to_copy in "${files_to_copy[@]}"; do - if [ -e "$file_to_copy" ]; then - cp "$file_to_copy" "$there" - fi - done - - # don't let local deps.edn files interfere: - cd "$there" - - # enrich-classpath will emit a command starting by "clojure", or print a stacktrace: - output=$(2>&1 "$clojure" -Sforce -Srepro -J-XX:-OmitStackTraceInFastThrow -J-Dclojure.main.report=stderr -Sdeps '{:deps {mx.cider/tools.deps.enrich-classpath {:mvn/version "1.18.6"}}}' -M -m cider.enrich-classpath.clojure "$clojure" "$here" "true" "$@") - cmd=$(tail -n1 <(echo "$output")) - - cd "$here" - - if grep --silent "^$clojure" <<< "$cmd"; then - # eval is necessary because $cmd contains arguments that have been processed through pr-str. - eval "$cmd" - else - # Print errors: - echo "$output" - $clojure "$@" - fi - -fi diff --git a/elpa/cider-1.12.0/codespell.txt b/elpa/cider-1.12.0/codespell.txt @@ -1,5 +0,0 @@ -edn -hist -juxt -nd -debbugs diff --git a/elpa/cider-1.12.0/dev/deps.edn b/elpa/cider-1.12.0/dev/deps.edn @@ -1,5 +0,0 @@ -;; This file cannot live at CIDER's project root, because its presence can affect clojure-mode logic, making some tests fail. -{:deps {cider/orchard {:mvn/version "RELEASE"}} - :paths ["."] - :aliases {:gen {:jvm-opts ["-Dclojure.main.report=stderr"] - :main-opts ["-m" "generate-html-fragments"]}}} diff --git a/elpa/cider-1.12.0/dev/docker-sample-project/.dir-locals.el b/elpa/cider-1.12.0/dev/docker-sample-project/.dir-locals.el @@ -1,4 +0,0 @@ -((nil . ((eval . (customize-set-variable 'cider-path-translations - (list - (cons "/src" (clojure-project-dir)) - (cons "/root/.m2" (concat (getenv "HOME") "/.m2")))))))) diff --git a/elpa/cider-1.12.0/dev/docker-sample-project/Dockerfile b/elpa/cider-1.12.0/dev/docker-sample-project/Dockerfile @@ -1,9 +0,0 @@ -FROM clojure:temurin-17-lein-bullseye -ENV DEBIAN_FRONTEND=noninteractive -ENV NREPL_PORT=7888 -WORKDIR /root/app -COPY . /root/app -RUN lein deps -EXPOSE 7888 -RUN lein classpath -CMD ["lein", "repl", ":headless", ":host", "0.0.0.0", ":port", "7888"] diff --git a/elpa/cider-1.12.0/dev/docker-sample-project/Makefile b/elpa/cider-1.12.0/dev/docker-sample-project/Makefile @@ -1,5 +0,0 @@ -build: - DOCKER_BUILDKIT=0 docker build --no-cache -t cider-docker-dev . - -run: build - docker run -v $$PWD/src:/app/src -p 7888:7888 cider-docker-dev diff --git a/elpa/cider-1.12.0/dev/docker-sample-project/README.md b/elpa/cider-1.12.0/dev/docker-sample-project/README.md @@ -1,14 +0,0 @@ -This project spins up a Clojure project within a Docker image. - -The Docker image exposes an nREPL server. - -This way, for development purposes, we can exercise CIDER's Docker-related capabilities. - -To get started: - -* From a terminal tab, run `make run` to run the Docker image - * Note that it has a volume mapping for `src`, so any local changes will be visible in the Docker image. - * Also note that the root of this subproject has a .dir-locals.el setting up `cider-path-translations`. -* `M-x cider-connect-clj`, choose localhost, 7888 -* `M-x cider-load-buffer` the foo.clj namespace. -* From now on, you can `M-.` (jump to definition) recursively, starting from `clj-http.client`. diff --git a/elpa/cider-1.12.0/dev/docker-sample-project/project.clj b/elpa/cider-1.12.0/dev/docker-sample-project/project.clj @@ -1,5 +0,0 @@ -(defproject cider-docker-dev "0" - :dependencies [[org.clojure/clojure "1.11.1"] - [clj-http "3.12.3"]] - :source-paths ["src"] - :plugins [[cider/cider-nrepl "0.44.0"]]) diff --git a/elpa/cider-1.12.0/dev/docker-sample-project/src/bar.clj b/elpa/cider-1.12.0/dev/docker-sample-project/src/bar.clj @@ -1,2 +0,0 @@ -(ns bar - (:require [foo])) diff --git a/elpa/cider-1.12.0/dev/docker-sample-project/src/foo.clj b/elpa/cider-1.12.0/dev/docker-sample-project/src/foo.clj @@ -1,3 +0,0 @@ -(ns foo - (:require - [clj-http.client :as client])) diff --git a/elpa/cider-1.12.0/dev/generate_html_fragments.clj b/elpa/cider-1.12.0/dev/generate_html_fragments.clj @@ -1,33 +0,0 @@ -(ns generate-html-fragments - "This script writes test/File.edn files, backing docstring-related Elisp tests." - (:require - [clojure.java.io :as io] - [clojure.pprint :refer [pprint]] - [orchard.java]) - (:import - (java.io File))) - -;; Ensure that it is requireable - if Orchard internally falls back to other ns, this script won't work properly: -(require 'orchard.java.parser-next) - -(defn -main [& _] - (doseq [class-symbol [`Thread `String `Object `File 'java.util.Map] - :let [{:keys [members] :as x} (orchard.java/source-info class-symbol) - members (->> members vals (map vals) (reduce into)) - all (conj members x) - filename (str "../test" File/separator (-> class-symbol eval .getSimpleName) ".edn")]] - (-> filename io/file .delete) - (with-open [w (io/writer filename :append true)] - (.write w "[") - (doseq [{:keys [doc-fragments doc-first-sentence-fragments doc-block-tags-fragments] :as i} all - :when (or (seq doc-fragments) - (seq doc-first-sentence-fragments) - (seq doc-block-tags-fragments))] - (.write w (with-out-str - (pprint (select-keys i [:doc-fragments - :doc-first-sentence-fragments - :doc-block-tags-fragments])))) - (.write w "\n")) - (.write w "]")) - (println "Processed" (-> filename io/file str))) - (shutdown-agents)) diff --git a/elpa/cider-1.12.0/dev/tramp-sample-project/Dockerfile b/elpa/cider-1.12.0/dev/tramp-sample-project/Dockerfile @@ -1,45 +0,0 @@ -FROM clojure:temurin-17-lein-bullseye -ENV DEBIAN_FRONTEND=noninteractive -ENV NREPL_PORT=7888 - -RUN apt-get update \ - && apt-get install -y openssh-server locales \ - && mkdir /var/run/sshd - -RUN sed -i '/en_US.UTF-8/s/^# //g' /etc/locale.gen && \ - locale-gen -ENV LANG en_US.UTF-8 -ENV LANGUAGE en_US:en -ENV LC_ALL en_US.UTF-8 - -RUN locale-gen en_US.UTF-8 -RUN locale-gen en en_US en_US.UTF-8 -RUN dpkg-reconfigure locales - -RUN echo 'root:cider' | chpasswd - -RUN sed -i 's/^#* *PasswordAuthentication .*/PasswordAuthentication yes/' /etc/ssh/sshd_config -RUN sed -i 's/^#* *PermitRootLogin .*/PermitRootLogin yes/' /etc/ssh/sshd_config -RUN sed -i 's/^#* *ChallengeResponseAuthentication .*/ChallengeResponseAuthentication yes/' /etc/ssh/sshd_config - -# SSH login fix. Otherwise user is kicked off after login -RUN sed 's@session\s*required\s*pam_loginuid.so@session optional pam_loginuid.so@g' -i /etc/pam.d/sshd - -EXPOSE 22 - -CMD ["/usr/sbin/sshd", "-D"] - -WORKDIR /usr/src/app - -COPY . /usr/src/app - -RUN lein deps - -RUN echo "export JAVA_HOME=${JAVA_HOME}" >> /root/.bashrc -RUN echo "export JAVA_CMD=${JAVA_HOME}/bin/java" >> /root/.bashrc -RUN echo "export LEIN_HOME=${LEIN_HOME}" >> /root/.bashrc -RUN echo "export LEIN_JAVA_CMD=${LEIN_JAVA_CMD}" >> /root/.bashrc -RUN echo "export LEIN_JVM_OPTS=${LEIN_JVM_OPTS}" >> /root/.bashrc -RUN echo "export LEIN_ROOT=${LEIN_ROOT}" >> /root/.bashrc -RUN echo "export NREPL_PORT=${NREPL_PORT}" >> /root/.bashrc -RUN echo "export PATH=${PATH}" >> /root/.bashrc diff --git a/elpa/cider-1.12.0/dev/tramp-sample-project/Makefile b/elpa/cider-1.12.0/dev/tramp-sample-project/Makefile @@ -1,10 +0,0 @@ -build: - DOCKER_BUILDKIT=0 docker build --no-cache -t cider-tramp-dev . - -run: build - docker run -p 7888:7888 -p 8022:22 cider-tramp-dev - -ssh: - ssh-keygen -R "[localhost]:8022" - echo "Password is: cider" - ssh root@localhost -p 8022 diff --git a/elpa/cider-1.12.0/dev/tramp-sample-project/README.md b/elpa/cider-1.12.0/dev/tramp-sample-project/README.md @@ -1,26 +0,0 @@ -This project spins up a Clojure project within a Docker image. - -The Docker image exposes a SSH server. - -This way, for development purposes, we can SSH into it with TRAMP and exercise CIDER's TRAMP-related capabilities. - -## Some ways to get started: - -### `cider-jack-in` from a tramp buffer -* `M-:` `(async-shell-command "make run")` to run the Docker image -* `M-:` `(find-file "/sshx:root@localhost#8022:/usr/src/app/src/foo.clj")` -* `M-x` `cider-jack-in` -* Enter password: `cider` - -### Manually create a remote repl and connect to it -* In one terminal tab, run `make run` to run the Docker image -* Once it's ready, from another tab, run `make ssh` and start a repl manually from there - * The password is `cider` - * `cd /usr/src/app; lein repl :headless :host 0.0.0.0 :port 7888` - -Now, from emacs you can `cider-connect` to localhost. - -* `M-:`, `(dired "/sshx:root@localhost#8022:/usr/src/app")` -* `M-x cider-connect` (choose `localhost`, `7888`) - -NOTE: Do not visit `foo.clj` directly - do it from dired instead. diff --git a/elpa/cider-1.12.0/dev/tramp-sample-project/project.clj b/elpa/cider-1.12.0/dev/tramp-sample-project/project.clj @@ -1,6 +0,0 @@ -(defproject cider-tramp-dev "0" - :dependencies [[org.clojure/clojure "1.11.1"] - [clj-http "3.12.3"]] - :source-paths ["src"] - :plugins [[cider/cider-nrepl "0.44.0"] - [refactor-nrepl "3.9.0"]]) diff --git a/elpa/cider-1.12.0/dev/tramp-sample-project/src/foo.clj b/elpa/cider-1.12.0/dev/tramp-sample-project/src/foo.clj @@ -1,3 +0,0 @@ -(ns foo - (:require - [clj-http.client :as client])) diff --git a/elpa/cider-1.12.0/lein.sh b/elpa/cider-1.12.0/lein.sh @@ -1,45 +0,0 @@ -#!/usr/bin/env bash -# there's no -Ee -o pipefail, intentionally - -# This wrapper script invokes lein with the provided args (which must include the enrich-classpath middleware), -# detecting success, and invoking in return the generated `java` command. -# It falls back to lein with the same args, except that the enrich middleware will be replaced with a no-op middleware. -# By having all this logic as a .sh script (vs. inline in Elisp), we can keep using the same process/async machinery, -# which is concise and results in a non-blocking UX. - -lein="$1" -shift - -output=$(2>&1 "$lein" "$@") -cmd=$(grep "\s-cp\s"<<< "$output") - -function cache_root() { - local cache_dir="${XDG_CACHE_HOME:-$HOME/.cache}" - cache_dir="${cache_dir/#\~/$HOME}" - mkdir -p "$cache_dir" 2>/dev/null - if [[ -w "$cache_dir" ]]; then - echo "${cache_dir%/}" - else - return 1 - fi -} - -if grep --silent "\s-cp\s"<<< "$cmd"; then - eval "$cmd" -else - # Print errors: - if cache_dir=$(cache_root); then - logfile="$cache_dir"/cider-enrich-classpath-error.log - echo "$output" >> "$logfile" - echo "Could not activate enrich-classpath. Error report available at $logfile" - fi - no_enrich=() - for arg in "$@"; do - if [ "$arg" == "cider.enrich-classpath.plugin-v2/middleware" ]; then - no_enrich+=("cider.enrich-classpath.fallback/middleware") - else - no_enrich+=("$arg") - fi - done - $lein "${no_enrich[@]}" -fi diff --git a/elpa/cider-1.12.0/nrepl-client.el b/elpa/cider-1.12.0/nrepl-client.el @@ -1,1508 +0,0 @@ -;;; nrepl-client.el --- Client for Clojure nREPL -*- lexical-binding: t -*- - -;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2023 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; -;; Author: Tim King <kingtim@gmail.com> -;; Phil Hagelberg <technomancy@gmail.com> -;; Bozhidar Batsov <bozhidar@batsov.dev> -;; Artur Malabarba <bruce.connor.am@gmail.com> -;; Hugo Duncan <hugo@hugoduncan.org> -;; Steve Purcell <steve@sanityinc.com> -;; Reid McKenzie <me@arrdem.com> -;; -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. -;; -;; This file is not part of GNU Emacs. -;; -;;; Commentary: -;; -;; Provides an Emacs Lisp client to connect to Clojure nREPL servers. -;; -;; A connection is an abstract idea of the communication between Emacs (client) -;; and nREPL server. On the Emacs side connections are represented by two -;; running processes. The two processes are the server process and client -;; process (the connection to the server). Each of these is represented by its -;; own process buffer, filter and sentinel. -;; -;; The nREPL communication process can be broadly represented as follows: -;; -;; 1) The server process is started as an Emacs subprocess (usually by -;; `cider-jack-in', which in turn fires up an nREPL server). Note that -;; if a connection was established using `cider-connect' there won't be -;; a server process. -;; -;; 2) The server's process filter (`nrepl-server-filter') detects the -;; connection port from the first plain text response from the server and -;; starts a communication process (socket connection) as another Emacs -;; subprocess. This is the nREPL client process (`nrepl-client-filter'). -;; All requests and responses handling happens through this client -;; connection. -;; -;; 3) Requests are sent by `nrepl-send-request' and -;; `nrepl-send-sync-request'. A request is simply a list containing a -;; requested operation name and the parameters required by the -;; operation. Each request has an associated callback that is called once -;; the response for the request has arrived. Besides the above functions -;; there are specialized request senders for each type of common -;; operations. Examples are `nrepl-request:eval', `nrepl-request:clone', -;; `nrepl-sync-request:describe'. -;; -;; 4) Responses from the server are decoded in `nrepl-client-filter' and are -;; physically represented by alists whose structure depends on the type of -;; the response. After having been decoded, the data from the response is -;; passed over to the callback that was registered by the original -;; request. -;; -;; Please see the comments in dedicated sections of this file for more detailed -;; description. - -;;; Code: -(require 'seq) -(require 'subr-x) -(require 'cl-lib) -(require 'nrepl-dict) -(require 'queue) -(require 'sesman) -(require 'tramp) - - -;;; Custom - -(defgroup nrepl nil - "Interaction with the Clojure nREPL Server." - :prefix "nrepl-" - :group 'applications) - -;; (defcustom nrepl-buffer-name-separator " " -;; "Used in constructing the REPL buffer name. -;; The `nrepl-buffer-name-separator' separates cider-repl from the project name." -;; :type '(string) -;; :group 'nrepl) -(make-obsolete-variable 'nrepl-buffer-name-separator 'cider-session-name-template "0.18") - -;; (defcustom nrepl-buffer-name-show-port nil -;; "Show the connection port in the nrepl REPL buffer name, if set to t." -;; :type 'boolean -;; :group 'nrepl) -(make-obsolete-variable 'nrepl-buffer-name-show-port 'cider-session-name-template "0.18") - -(defcustom nrepl-connected-hook nil - "List of functions to call when connecting to the nREPL server." - :type 'hook) - -(defcustom nrepl-disconnected-hook nil - "List of functions to call when disconnected from the nREPL server." - :type 'hook) - -(defcustom nrepl-force-ssh-for-remote-hosts nil - "If non-nil, do not attempt a direct connection for remote hosts." - :type 'boolean) - -(defcustom nrepl-use-ssh-fallback-for-remote-hosts nil - "If non-nil, Use ssh as a fallback to connect to remote hosts. -It will attempt to connect via ssh to remote hosts when unable to connect -directly." - :type 'boolean) - -(defcustom nrepl-sync-request-timeout 10 - "The number of seconds to wait for a sync response. -Setting this to nil disables the timeout functionality." - :type 'integer) - -(defcustom nrepl-hide-special-buffers nil - "Control the display of some special buffers in buffer switching commands. -When true some special buffers like the server buffer will be hidden." - :type 'boolean) - -;;; Buffer Local Declarations - -;; These variables are used to track the state of nREPL connections -(defvar-local nrepl-connection-buffer nil) -(defvar-local nrepl-server-buffer nil) -(defvar-local nrepl-messages-buffer nil) -(defvar-local nrepl-endpoint nil) -(defvar-local nrepl-project-dir nil) -(defvar-local nrepl-is-server nil) -(defvar-local nrepl-server-command nil) -(defvar-local nrepl-tunnel-buffer nil) - -(defvar-local nrepl-session nil - "Current nREPL session id.") - -(defvar-local nrepl-tooling-session nil - "Current nREPL tooling session id. -To be used for tooling calls (i.e. completion, eldoc, etc)") - -(defvar-local nrepl-request-counter 0 - "Continuation serial number counter.") - -(defvar-local nrepl-pending-requests nil) - -(defvar-local nrepl-completed-requests nil) - -(defvar-local nrepl-last-sync-response nil - "Result of the last sync request.") - -(defvar-local nrepl-last-sync-request-timestamp nil - "The time when the last sync request was initiated.") - -(defvar-local nrepl-ops nil - "Available nREPL server ops (from describe).") - -(defvar-local nrepl-versions nil - "Version information received from the describe op.") - -(defvar-local nrepl-aux nil - "Auxiliary information received from the describe op.") - -;;; nREPL Buffer Names - -(defconst nrepl-message-buffer-name-template "*nrepl-messages %s(%r:%S)*") -(defconst nrepl-error-buffer-name "*nrepl-error*") -(defconst nrepl-repl-buffer-name-template "*cider-repl %s(%r:%S)*") -(defconst nrepl-server-buffer-name-template "*nrepl-server %s*") -(defconst nrepl-tunnel-buffer-name-template "*nrepl-tunnel %s*") - -(declare-function cider-format-connection-params "cider-connection") -(defun nrepl-make-buffer-name (template params &optional dup-ok) - "Generate a buffer name using TEMPLATE and PARAMS. -TEMPLATE and PARAMS are as in `cider-format-connection-params'. If -optional DUP-OK is non-nil, the returned buffer is not \"uniquified\" by a -call to `generate-new-buffer-name'." - (let ((name (cider-format-connection-params template params))) - (if dup-ok - name - (generate-new-buffer-name name)))) - -(defun nrepl--make-hidden-name (buffer-name) - "Apply a prefix to BUFFER-NAME that will hide the buffer." - (concat (if nrepl-hide-special-buffers " " "") buffer-name)) - -(defun nrepl-repl-buffer-name (params &optional dup-ok) - "Return the name of the repl buffer. -PARAMS and DUP-OK are as in `nrepl-make-buffer-name'." - (nrepl-make-buffer-name nrepl-repl-buffer-name-template params dup-ok)) - -(defun nrepl-server-buffer-name (params) - "Return the name of the server buffer. -PARAMS is as in `nrepl-make-buffer-name'." - (nrepl-make-buffer-name (nrepl--make-hidden-name nrepl-server-buffer-name-template) - params)) - -(defun nrepl-tunnel-buffer-name (params) - "Return the name of the tunnel buffer. -PARAMS is as in `nrepl-make-buffer-name'." - (nrepl-make-buffer-name (nrepl--make-hidden-name nrepl-tunnel-buffer-name-template) - params)) - -(defun nrepl-messages-buffer-name (params) - "Return the name for the message buffer given connection PARAMS." - (nrepl-make-buffer-name nrepl-message-buffer-name-template params)) - -;;; Utilities -(defun nrepl-op-supported-p (op connection) - "Return t iff the given operation OP is supported by the nREPL CONNECTION." - (when (buffer-live-p connection) - (with-current-buffer connection - (and nrepl-ops (nrepl-dict-get nrepl-ops op))))) - -(defun nrepl-aux-info (key connection) - "Return KEY's aux info, as returned via the :describe op for CONNECTION." - (with-current-buffer connection - (and nrepl-aux (nrepl-dict-get nrepl-aux key)))) - -(defun nrepl-local-host-p (host) - "Return t if HOST is local." - (string-match-p tramp-local-host-regexp host)) - -(defun nrepl-extract-port (dir) - "Read port from applicable repl-port file in directory DIR." - (condition-case nil - (or (nrepl--port-from-file (expand-file-name "repl-port" dir)) - (nrepl--port-from-file (expand-file-name ".nrepl-port" dir)) - (nrepl--port-from-file (expand-file-name "target/repl-port" dir)) - (nrepl--port-from-file (expand-file-name ".shadow-cljs/nrepl.port" dir))) - ;; This operation can hit permission errors, particularly on macOS: - (error nil))) - -(defun nrepl-extract-ports (dir) - "Read ports from applicable repl-port files in directory DIR." - (condition-case nil - (delq nil - (list (nrepl--port-from-file (expand-file-name "repl-port" dir)) - (nrepl--port-from-file (expand-file-name ".nrepl-port" dir)) - (nrepl--port-from-file (expand-file-name "target/repl-port" dir)) - (nrepl--port-from-file (expand-file-name ".shadow-cljs/nrepl.port" dir)))) - ;; This operation can hit permission errors, particularly on macOS: - (error nil))) - -(make-obsolete 'nrepl-extract-port 'nrepl-extract-ports "1.5.0") - -(defun nrepl--port-string-to-number (s) - "Converts `S' from string to number when suitable." - (when (string-match "^\\([0-9]+\\)" s) - (string-to-number (match-string 0 s)))) - -(defun nrepl--port-from-file (file) - "Attempts to read port from a file named by FILE. - -Discards it if it can be determined that the port is not active." - (when (file-exists-p file) - (when-let* ((port-string (with-temp-buffer - (insert-file-contents file) - (buffer-string))) - ;; extract the number, most of all for not passing garbage to `lsof' (which might even be a security risk): - (port-number (nrepl--port-string-to-number port-string))) - (if (eq system-type 'windows-nt) - port-string - (when (not (equal "" - (shell-command-to-string (format "lsof -i:%s" port-number)))) - port-string))))) - -(defun nrepl--ssh-file-name-matches-host-p (file-name host) - "Return t, if FILE-NAME is a tramp-file-name on HOST via ssh." - (when (tramp-tramp-file-p file-name) - (with-parsed-tramp-file-name file-name v - (and (member v-method '("ssh" "sshx")) - (member host (list v-host (concat v-host "#" v-port))))))) - -;;; Bencode - -(cl-defstruct (nrepl-response-queue - (:include queue) - (:constructor nil) - (:constructor nrepl-response-queue (&optional stub))) - stub) - -(put 'nrepl-response-queue 'function-documentation - "Create queue object used by nREPL to store decoded server responses. -The STUB slot stores a stack of nested, incompletely parsed objects.") - -(defun nrepl--bdecode-list (&optional stack) - "Decode a bencode list or dict starting at point. -STACK is as in `nrepl--bdecode-1'." - ;; skip leading l or d - (forward-char 1) - (let* ((istack (nrepl--bdecode-1 stack)) - (pos0 (point)) - (info (car istack))) - (while (null info) - (setq istack (nrepl--bdecode-1 (cdr istack)) - pos0 (point) - info (car istack))) - (cond ((eq info :e) - (cons nil (cdr istack))) - ((eq info :stub) - (goto-char pos0) - istack) - (t istack)))) - -(defun nrepl--bdecode-1 (&optional stack) - "Decode one elementary bencode object starting at point. -Bencoded object is either list, dict, integer or string. See -http://en.wikipedia.org/wiki/Bencode#Encoding_algorithm for the encoding -rules. - -STACK is a list of so far decoded components of the current message. Car -of STACK is the innermost incompletely decoded object. The algorithm pops -this list when inner object was completely decoded or grows it by one when -new list or dict was encountered. - -The returned value is of the form (INFO . STACK) where INFO is -:stub, nil, :end or :eob and STACK is either an incomplete parsing state as -above (INFO is :stub, nil or :eob) or a list of one component representing -the completely decoded message (INFO is :end). INFO is nil when an -elementary non-root object was successfully decoded. INFO is :end when this -object is a root list or dict." - (cond - ;; list - ((eq (char-after) ?l) - (nrepl--bdecode-list (cons () stack))) - ;; dict - ((eq (char-after) ?d) - (nrepl--bdecode-list (cons '(dict) stack))) - ;; end of a list or a dict - ((eq (char-after) ?e) - (forward-char 1) - (cons (if (cdr stack) :e :end) - (nrepl--push (nrepl--nreverse (car stack)) - (cdr stack)))) - ;; string - ((looking-at "\\([0-9]+\\):") - (let ((pos0 (point)) - (beg (goto-char (match-end 0))) - (end (byte-to-position (+ (position-bytes (point)) - (string-to-number (match-string 1)))))) - (if (null end) - (progn (goto-char pos0) - (cons :stub stack)) - (goto-char end) - ;; normalise any platform-specific newlines - (let* ((original (buffer-substring-no-properties beg end)) - (result (replace-regexp-in-string "\r\n\\|\n\r\\|\r" "\n" original))) - (cons nil (nrepl--push result stack)))))) - ;; integer - ((looking-at "i\\(-?[0-9]+\\)e") - (goto-char (match-end 0)) - (cons nil (nrepl--push (string-to-number (match-string 1)) - stack))) - ;; should happen in tests only as eobp is checked in nrepl-bdecode. - ((eobp) - (cons :eob stack)) - ;; truncation in the middle of an integer or in 123: string prefix - ((looking-at-p "[0-9i]") - (cons :stub stack)) - ;; else, throw a quiet error - (t - (message "Invalid bencode message detected. See the %s buffer for details." - nrepl-error-buffer-name) - (nrepl-log-error - (format "Decoder error at position %d (`%s'):" - (point) (buffer-substring (point) (min (+ (point) 10) (point-max))))) - (nrepl-log-error (buffer-string)) - (ding) - ;; Ensure loop break and clean queues' states in nrepl-bdecode: - (goto-char (point-max)) - (cons :end nil)))) - -(defun nrepl--bdecode-message (&optional stack) - "Decode one full message starting at point. -STACK is as in `nrepl--bdecode-1'. Return a cons (INFO . STACK)." - (let* ((istack (nrepl--bdecode-1 stack)) - (info (car istack)) - (stack (cdr istack))) - (while (or (null info) - (eq info :e)) - (setq istack (nrepl--bdecode-1 stack) - info (car istack) - stack (cdr istack))) - istack)) - -(defun nrepl--ensure-fundamental-mode () - "Enable `fundamental-mode' if it is not enabled already." - (when (not (eq 'fundamental-mode major-mode)) - (fundamental-mode))) - -(defun nrepl-bdecode (string-q &optional response-q) - "Decode STRING-Q and place the results into RESPONSE-Q. -STRING-Q is either a queue of strings or a string. RESPONSE-Q is a queue of -server requests (nREPL dicts). STRING-Q and RESPONSE-Q are modified by side -effects. - -Return a cons (STRING-Q . RESPONSE-Q) where STRING-Q is the original queue -containing the remainder of the input strings which could not be -decoded. RESPONSE-Q is the original queue with successfully decoded messages -enqueued and with slot STUB containing a nested stack of an incompletely -decoded message or nil if the strings were completely decoded." - (with-current-buffer (get-buffer-create " *nrepl-decoding*") - ;; Don't needlessly call `fundamental-mode', to prevent needlessly firing - ;; hooks. This fixes an issue with evil-mode where the cursor loses its - ;; correct color. - (nrepl--ensure-fundamental-mode) - (erase-buffer) - (if (queue-p string-q) - (while (queue-head string-q) - (insert (queue-dequeue string-q))) - (insert string-q) - (setq string-q (queue-create))) - (goto-char 1) - (unless response-q - (setq response-q (nrepl-response-queue))) - (let ((istack (nrepl--bdecode-message - (nrepl-response-queue-stub response-q)))) - (while (and (eq (car istack) :end) - (not (eobp))) - (queue-enqueue response-q (cadr istack)) - (setq istack (nrepl--bdecode-message))) - (unless (eobp) - (queue-enqueue string-q (buffer-substring (point) (point-max)))) - (if (not (eq (car istack) :end)) - (setf (nrepl-response-queue-stub response-q) (cdr istack)) - (queue-enqueue response-q (cadr istack)) - (setf (nrepl-response-queue-stub response-q) nil)) - (erase-buffer) - (cons string-q response-q)))) - -(defun nrepl-bencode (object) - "Encode OBJECT with bencode. -Integers, lists and nrepl-dicts are treated according to bencode -specification. Everything else is encoded as string." - (cond - ((integerp object) (format "i%de" object)) - ((nrepl-dict-p object) (format "d%se" (mapconcat #'nrepl-bencode (cdr object) ""))) - ((listp object) (format "l%se" (mapconcat #'nrepl-bencode object ""))) - (t (format "%s:%s" (string-bytes object) object)))) - -;;; Client: Process Filter - -(defvar nrepl-response-handler-functions nil - "List of functions to call on each nREPL message. -Each of these functions should be a function with one argument, which will -be called by `nrepl-client-filter' on every response received. The current -buffer will be connection (REPL) buffer of the process. These functions -should take a single argument, a dict representing the message. See -`nrepl--dispatch-response' for an example. - -These functions are called before the message's own callbacks, so that they -can affect the behavior of the callbacks. Errors signaled by these -functions are demoted to messages, so that they don't prevent the -callbacks from running.") - -(defun nrepl-client-filter (proc string) - "Decode message(s) from PROC contained in STRING and dispatch them." - (let ((string-q (process-get proc :string-q))) - (queue-enqueue string-q string) - ;; Start decoding only if the last letter is 'e' - (when (eq ?e (aref string (1- (length string)))) - (let ((response-q (process-get proc :response-q))) - (nrepl-bdecode string-q response-q) - (while (queue-head response-q) - (with-current-buffer (process-buffer proc) - (let ((response (queue-dequeue response-q))) - (with-demoted-errors "Error in one of the `nrepl-response-handler-functions': %s" - (run-hook-with-args 'nrepl-response-handler-functions response)) - (nrepl--dispatch-response response)))))))) - -(defun nrepl--dispatch-response (response) - "Dispatch the RESPONSE to associated callback. -First we check the callbacks of pending requests. If no callback was found, -we check the completed requests, since responses could be received even for -older requests with \"done\" status." - (nrepl-dbind-response response (id) - (nrepl-log-message response 'response) - (let ((callback (or (gethash id nrepl-pending-requests) - (gethash id nrepl-completed-requests)))) - (if callback - (funcall callback response) - (error "[nREPL] No response handler with id %s found for %s" id (buffer-name)))))) - -(defun nrepl-client-sentinel (process message) - "Handle sentinel events from PROCESS. -Notify MESSAGE and if the process is closed run `nrepl-disconnected-hook' -and kill the process buffer." - (if (string-match "deleted\\b" message) - (message "[nREPL] Connection closed") - (message "[nREPL] Connection closed unexpectedly (%s)" - (substring message 0 -1))) - (when (equal (process-status process) 'closed) - (when-let* ((client-buffer (process-buffer process))) - (sesman-remove-object 'CIDER nil client-buffer - (not (process-get process :keep-server)) - 'no-error) - (nrepl--clear-client-sessions client-buffer) - (with-current-buffer client-buffer - (goto-char (point-max)) - (insert-before-markers - (propertize - (format "\n*** Closed on %s ***\n" (replace-regexp-in-string " +" - " " - (current-time-string))) - 'face 'cider-repl-stderr-face)) - (run-hooks 'nrepl-disconnected-hook) - (let ((server-buffer nrepl-server-buffer)) - (when (and (buffer-live-p server-buffer) - (not (process-get process :keep-server))) - (setq nrepl-server-buffer nil) - (nrepl--maybe-kill-server-buffer server-buffer))))))) - -;;; Network - -(defun nrepl--unix-connect (socket-file &optional no-error) - "If SOCKET-FILE is given, try to `make-network-process'. -If NO-ERROR is non-nil, show messages instead of throwing an error." - (if (not socket-file) - (unless no-error - (error "[nREPL] Socket file not provided")) - (message "[nREPL] Establishing unix socket connection to %s ..." socket-file) - (condition-case nil - (prog1 (list :proc (make-network-process :name "nrepl-connection" :buffer nil - :family 'local :service socket-file) - :host "local-unix-domain-socket" - :port socket-file - :socket-file socket-file) - (message "[nREPL] Unix socket connection to %s established" socket-file)) - (error (let ((msg (format "[nREPL] Unix socket connection to %s failed" socket-file))) - (if no-error - (message msg) - (error msg)) - nil))))) - -(defun nrepl-connect (host port) - "Connect to the nREPL server identified by HOST and PORT. -For local hosts use a direct connection. For remote hosts, if -`nrepl-force-ssh-for-remote-hosts' is nil, attempt a direct connection -first. If `nrepl-force-ssh-for-remote-hosts' is non-nil or the direct -connection failed (and `nrepl-use-ssh-fallback-for-remote-hosts' is -non-nil), try to start a SSH tunneled connection. Return a plist of the -form (:proc PROC :host \"HOST\" :port PORT) that might contain additional -key-values depending on the connection type." - (let ((localp (if host - (nrepl-local-host-p host) - (not (file-remote-p default-directory))))) - (if localp - (nrepl--direct-connect (or host "localhost") port) - ;; we're dealing with a remote host - (if (and host (not nrepl-force-ssh-for-remote-hosts)) - (or (nrepl--direct-connect host port 'no-error) - ;; direct connection failed - ;; fallback to ssh tunneling if enabled - (and nrepl-use-ssh-fallback-for-remote-hosts - (message "[nREPL] Falling back to SSH tunneled connection ...") - (nrepl--ssh-tunnel-connect host port)) - ;; fallback is either not enabled or it failed as well - (if (and (null nrepl-use-ssh-fallback-for-remote-hosts) - (not localp)) - (error "[nREPL] Direct connection to %s:%s failed; try setting `nrepl-use-ssh-fallback-for-remote-hosts' to t" - host port) - (error "[nREPL] Cannot connect to %s:%s" host port))) - ;; `nrepl-force-ssh-for-remote-hosts' is non-nil - (nrepl--ssh-tunnel-connect host port))))) - -(defun nrepl--direct-connect (host port &optional no-error) - "If HOST and PORT are given, try to `open-network-stream'. -If NO-ERROR is non-nil, show messages instead of throwing an error." - (if (not (and host port)) - (unless no-error - (unless host - (error "[nREPL] Host not provided")) - (unless port - (error "[nREPL] Port not provided"))) - (message "[nREPL] Establishing direct connection to %s:%s ..." host port) - (condition-case nil - (prog1 (list :proc (open-network-stream "nrepl-connection" nil host port) - :host host :port port) - (message "[nREPL] Direct connection to %s:%s established" host port)) - (error (let ((msg (format "[nREPL] Direct connection to %s:%s failed" host port))) - (if no-error - (message msg) - (error msg)) - nil))))) - -(defun nrepl--ssh-tunnel-connect (host port) - "Connect to a remote machine identified by HOST and PORT through SSH tunnel." - (message "[nREPL] Establishing SSH tunneled connection to %s:%s ..." host port) - (let* ((file-name (or (buffer-file-name) nrepl-project-dir)) - (remote-dir (cond - ;; If current buffer is a TRAMP buffer and its host is - ;; the same as HOST, reuse its connection parameters for - ;; SSH tunnel. - ((nrepl--ssh-file-name-matches-host-p file-name host) file-name) - ;; Otherwise, if HOST was provided, use it for connection. - (host (format "/ssh:%s:" host)) - ;; Use default directory as fallback. - (t default-directory))) - (ssh (or (executable-find "ssh") - (error "[nREPL] Cannot locate 'ssh' executable"))) - (cmd (nrepl--ssh-tunnel-command ssh remote-dir port)) - (tunnel-buf (nrepl-tunnel-buffer-name - `((:host ,host) (:port ,port)))) - (tunnel (start-process-shell-command "nrepl-tunnel" tunnel-buf cmd))) - (process-put tunnel :waiting-for-port t) - (set-process-filter tunnel (nrepl--ssh-tunnel-filter port)) - (while (and (process-live-p tunnel) - (process-get tunnel :waiting-for-port)) - (accept-process-output nil 0.005)) - (if (not (process-live-p tunnel)) - (error "[nREPL] SSH port forwarding failed. Check the '%s' buffer" tunnel-buf) - (message "[nREPL] SSH port forwarding established to localhost:%s" port) - (let ((endpoint (nrepl--direct-connect "localhost" port))) - (thread-first - endpoint - (plist-put :tunnel tunnel) - (plist-put :remote-host host)))))) - -(defun nrepl--ssh-tunnel-command (ssh dir port) - "Command string to open SSH tunnel to the host associated with DIR's PORT." - (with-parsed-tramp-file-name dir v - ;; this abuses the -v option for ssh to get output when the port - ;; forwarding is set up, which is used to synchronise on, so that - ;; the port forwarding is up when we try to connect. - (format-spec - "%s -v -N -L %p:localhost:%p %u'%h' %n" - `((?s . ,ssh) - (?p . ,port) - (?h . ,v-host) - (?u . ,(if v-user (format "-l '%s' " v-user) "")) - (?n . ,(if v-port (format "-p '%s' " v-port) "")))))) - -(autoload 'comint-watch-for-password-prompt "comint" "(autoload).") - -(defun nrepl--ssh-tunnel-filter (port) - "Return a process filter that waits for PORT to appear in process output." - (let ((port-string (format "LOCALHOST:%s" port))) - (lambda (proc string) - (when (string-match-p port-string string) - (process-put proc :waiting-for-port nil)) - (when (and (process-live-p proc) - (buffer-live-p (process-buffer proc))) - (with-current-buffer (process-buffer proc) - (let ((moving (= (point) (process-mark proc)))) - (save-excursion - (goto-char (process-mark proc)) - (insert string) - (set-marker (process-mark proc) (point)) - (comint-watch-for-password-prompt string)) - (if moving (goto-char (process-mark proc))))))))) - -;;; Client: Process Handling - -(defun nrepl--kill-process (proc) - "Attempt to kill PROC tree. -On MS-Windows, using the standard API is highly likely to leave the child -processes still running in the background as orphans. As a workaround, an -attempt is made to delegate the task to the `taskkill` program, which comes -with windows since at least Windows XP, and fallback to the Emacs API if it -can't be found. - -It is expected that the `(process-status PROC)` return value after PROC is -killed is `exit` when `taskkill` is used and `signal` otherwise." - (cond - ((and (eq system-type 'windows-nt) - (process-live-p proc) - (executable-find "taskkill")) - ;; try to use `taskkill` if available - (with-temp-buffer - (call-process-shell-command (format "taskkill /PID %s /T /F" (process-id proc)) - nil (buffer-name) ) - ;; useful for debugging. - ;;(message ":PROCESS-KILL-OUPUT %s" (buffer-string)) - )) - - ((memq system-type '(cygwin windows-nt)) - ;; fallback, this is considered to work better than `kill-process` on - ;; MS-Windows. - (interrupt-process proc)) - - (t (kill-process proc)))) - -(defun nrepl-kill-server-buffer (server-buf) - "Kill SERVER-BUF and its process." - (when (buffer-live-p server-buf) - (let ((proc (get-buffer-process server-buf))) - (when (process-live-p proc) - (set-process-query-on-exit-flag proc nil) - (nrepl--kill-process proc)) - (kill-buffer server-buf)))) - -(defun nrepl--maybe-kill-server-buffer (server-buf) - "Kill SERVER-BUF and its process. -Do not kill the server if there is a REPL connected to that server." - (when (buffer-live-p server-buf) - (with-current-buffer server-buf - ;; Don't kill if there is at least one REPL connected to it. - (when (not (seq-find (lambda (b) - (eq (buffer-local-value 'nrepl-server-buffer b) - server-buf)) - (buffer-list))) - (nrepl-kill-server-buffer server-buf))))) - -(defun nrepl-start-client-process (&optional host port server-proc buffer-builder socket-file) - "Create new client process identified by either HOST and PORT or SOCKET-FILE. -If SOCKET-FILE is non-nil, it takes precedence. In remote buffers, HOST -and PORT are taken from the current tramp connection. SERVER-PROC must be -a running nREPL server process within Emacs. BUFFER-BUILDER is a function -of one argument (endpoint returned by `nrepl-connect') which returns a -client buffer. Return the newly created client process." - (let* ((endpoint (if socket-file - (nrepl--unix-connect (expand-file-name socket-file)) - (nrepl-connect host port))) - (client-proc (plist-get endpoint :proc)) - (builder (or buffer-builder (error "`buffer-builder' must be provided"))) - (client-buf (funcall builder endpoint))) - - (set-process-buffer client-proc client-buf) - - (set-process-filter client-proc #'nrepl-client-filter) - (set-process-sentinel client-proc #'nrepl-client-sentinel) - (set-process-coding-system client-proc 'utf-8-unix 'utf-8-unix) - - (process-put client-proc :string-q (queue-create)) - (process-put client-proc :response-q (nrepl-response-queue)) - - (with-current-buffer client-buf - (when-let* ((server-buf (and server-proc (process-buffer server-proc)))) - (setq nrepl-project-dir (buffer-local-value 'nrepl-project-dir server-buf) - nrepl-server-buffer server-buf)) - (setq nrepl-endpoint endpoint - nrepl-tunnel-buffer (when-let* ((tunnel (plist-get endpoint :tunnel))) - (process-buffer tunnel)) - nrepl-pending-requests (make-hash-table :test 'equal) - nrepl-completed-requests (make-hash-table :test 'equal))) - - (with-current-buffer client-buf - (nrepl--init-client-sessions client-proc) - (nrepl--init-capabilities client-buf) - (run-hooks 'nrepl-connected-hook)) - - client-proc)) - -(defun nrepl--init-client-sessions (client) - "Initialize CLIENT connection nREPL sessions. -We create two client nREPL sessions per connection - a main session and a -tooling session. The main session is general purpose and is used for pretty -much every request that needs a session. The tooling session is used only -for functionality that's implemented in terms of the \"eval\" op, so that -eval requests for functionality like pretty-printing won't clobber the -values of *1, *2, etc." - (let* ((client-conn (process-buffer client)) - (response-main (nrepl-sync-request:clone client-conn)) - (response-tooling (nrepl-sync-request:clone client-conn t))) ; t for tooling - (nrepl-dbind-response response-main (new-session err) - (if new-session - (with-current-buffer client-conn - (setq nrepl-session new-session)) - (error "Could not create new session (%s)" err))) - (nrepl-dbind-response response-tooling (new-session err) - (if new-session - (with-current-buffer client-conn - (setq nrepl-tooling-session new-session)) - (error "Could not create new tooling session (%s)" err))))) - -(defun nrepl--init-capabilities (conn-buffer) - "Store locally in CONN-BUFFER the capabilities of nREPL server." - (let ((description (nrepl-sync-request:describe conn-buffer))) - (nrepl-dbind-response description (ops versions aux) - (with-current-buffer conn-buffer - (setq nrepl-ops ops) - (setq nrepl-versions versions) - (setq nrepl-aux aux))))) - -(defun nrepl--clear-client-sessions (conn-buffer) - "Clear information about nREPL sessions in CONN-BUFFER. -CONN-BUFFER refers to a (presumably) dead connection, -which we can eventually reuse." - (with-current-buffer conn-buffer - (setq nrepl-session nil) - (setq nrepl-tooling-session nil))) - -;;; Client: Response Handling -;; After being decoded, responses (aka, messages from the server) are dispatched -;; to handlers. Handlers are constructed with `nrepl-make-response-handler'. - -(defvar nrepl-err-handler nil - "Evaluation error handler.") - -(defun nrepl--mark-id-completed (id) - "Move ID from `nrepl-pending-requests' to `nrepl-completed-requests'. -It is safe to call this function multiple times on the same ID." - ;; FIXME: This should go away eventually when we get rid of - ;; pending-request hash table - (when-let* ((handler (gethash id nrepl-pending-requests))) - (puthash id handler nrepl-completed-requests) - (remhash id nrepl-pending-requests))) - -(declare-function cider-repl--emit-interactive-output "cider-repl") -(defun nrepl-notify (msg type) - "Handle \"notification\" server request. -MSG is a string to be displayed. TYPE is the type of the message. All -notifications are currently displayed with `message' function and emitted -to the REPL." - (let* ((face (pcase type - ((or "message" `nil) 'font-lock-builtin-face) - ("warning" 'warning) - ("error" 'error))) - (msg (if face - (propertize msg 'face face) - (format "%s: %s" (upcase type) msg)))) - (cider-repl--emit-interactive-output msg (or face 'font-lock-builtin-face)) - (message msg))) - -(defvar cider-buffer-ns) -(defvar cider-print-quota) -(defvar cider-special-mode-truncate-lines) -(declare-function cider-need-input "cider-client") -(declare-function cider-set-buffer-ns "cider-mode") - -(defun nrepl-make-response-handler (buffer value-handler stdout-handler - stderr-handler done-handler - &optional eval-error-handler - content-type-handler - truncated-handler) - "Make a response handler for connection BUFFER. -A handler is a function that takes one argument - response received from -the server process. The response is an alist that contains at least 'id' -and 'session' keys. Other standard response keys are 'value', 'out', 'err', -and 'status'. - -The presence of a particular key determines the type of the response. For -example, if 'value' key is present, the response is of type 'value', if -'out' key is present the response is 'stdout' etc. - -Depending on the type, the handler dispatches the appropriate value to one -of the supplied handlers: VALUE-HANDLER, STDOUT-HANDLER, STDERR-HANDLER, -DONE-HANDLER, EVAL-ERROR-HANDLER, CONTENT-TYPE-HANDLER, and -TRUNCATED-HANDLER. - -Handlers are functions of the buffer and the value they handle, except for -the optional CONTENT-TYPE-HANDLER which should be a function of the buffer, -content, the content-type to be handled as a list `(type attrs)'. - -If the optional EVAL-ERROR-HANDLER is nil, the default `nrepl-err-handler' -is used. If any of the other supplied handlers are nil nothing happens for -the corresponding type of response." - (lambda (response) - (nrepl-dbind-response response (content-type content-transfer-encoding body - value ns out err status id) - (when (buffer-live-p buffer) - (with-current-buffer buffer - (when (and ns (not (derived-mode-p 'clojure-mode))) - (cider-set-buffer-ns ns)))) - (cond ((and content-type content-type-handler) - (funcall content-type-handler buffer - (if (string= content-transfer-encoding "base64") - (base64-decode-string body) - body) - content-type)) - (value - (when value-handler - (funcall value-handler buffer value))) - (out - (when stdout-handler - (funcall stdout-handler buffer out))) - (err - (when stderr-handler - (funcall stderr-handler buffer err))) - (status - (when (and truncated-handler (member "nrepl.middleware.print/truncated" status)) - (let ((warning (format "\n... output truncated to %sB ..." - (file-size-human-readable cider-print-quota)))) - (funcall truncated-handler buffer warning))) - (when (member "notification" status) - (nrepl-dbind-response response (msg type) - (nrepl-notify msg type))) - (when (member "interrupted" status) - (message "Evaluation interrupted.")) - (when (member "eval-error" status) - (funcall (or eval-error-handler nrepl-err-handler))) - (when (member "namespace-not-found" status) - (message "Namespace `%s' not found." ns)) - (when (member "need-input" status) - (cider-need-input buffer)) - (when (member "done" status) - (nrepl--mark-id-completed id) - (when done-handler - (funcall done-handler buffer)))))))) - -;;; Client: Request Core API - -;; Requests are messages from an nREPL client (like CIDER) to an nREPL server. -;; Requests can be asynchronous (sent with `nrepl-send-request') or -;; synchronous (send with `nrepl-send-sync-request'). The request is a pair list -;; of operation name and operation parameters. The core operations are described -;; at https://github.com/nrepl/nrepl/blob/master/doc/ops.md. CIDER adds -;; many more operations through nREPL middleware. See -;; https://github.com/clojure-emacs/cider-nrepl#supplied-nrepl-middleware for -;; the up-to-date list. - -(defun nrepl-next-request-id (connection) - "Return the next request id for CONNECTION." - (with-current-buffer connection - (number-to-string (cl-incf nrepl-request-counter)))) - -(defun nrepl-send-request (request callback connection &optional tooling) - "Send REQUEST and register response handler CALLBACK using CONNECTION. -REQUEST is a pair list of the form (\"op\" \"operation\" \"par1-name\" -\"par1\" ... ). See the code of `nrepl-request:clone', -`nrepl-request:stdin', etc. This expects that the REQUEST does not have a -session already in it. This code will add it as appropriate to prevent -connection/session drift. -Return the ID of the sent message. -Optional argument TOOLING Set to t if desiring the tooling session rather than -the standard session." - (with-current-buffer connection - (when-let* ((session (if tooling nrepl-tooling-session nrepl-session))) - (setq request (append request `("session" ,session)))) - (let* ((id (nrepl-next-request-id connection)) - (request (cons 'dict (lax-plist-put request "id" id))) - (message (nrepl-bencode request))) - (nrepl-log-message request 'request) - (puthash id callback nrepl-pending-requests) - (process-send-string nil message) - id))) - -(defvar nrepl-ongoing-sync-request nil - "Dynamically bound to t while a sync request is ongoing.") - -(declare-function cider-repl-emit-interactive-stderr "cider-repl") -(declare-function cider--render-stacktrace-causes "cider-eval") - -(defun nrepl-send-sync-request (request connection &optional abort-on-input tooling) - "Send REQUEST to the nREPL server synchronously using CONNECTION. -Hold till final \"done\" message has arrived and join all response messages -of the same \"op\" that came along. -If ABORT-ON-INPUT is non-nil, the function will return nil at the first -sign of user input, so as not to hang the interface. -If TOOLING, use the tooling session rather than the standard session." - (let* ((time0 (current-time)) - (response (cons 'dict nil)) - (nrepl-ongoing-sync-request t) - status) - (nrepl-send-request request - (lambda (resp) (nrepl--merge response resp)) - connection - tooling) - (while (and (not (member "done" status)) - (not (and abort-on-input - (input-pending-p)))) - (setq status (nrepl-dict-get response "status")) - ;; If we get a need-input message then the repl probably isn't going - ;; anywhere, and we'll just timeout. So we forward it to the user. - (if (member "need-input" status) - (progn (cider-need-input (current-buffer)) - ;; If the used took a few seconds to respond, we might - ;; unnecessarily timeout, so let's reset the timer. - (setq time0 (current-time))) - ;; break out in case we don't receive a response for a while - (when (and nrepl-sync-request-timeout - (time-less-p - nrepl-sync-request-timeout - (time-subtract nil time0))) - (error "Sync nREPL request timed out %s after %s secs" request nrepl-sync-request-timeout))) - ;; Clean up the response, otherwise we might repeatedly ask for input. - (nrepl-dict-put response "status" (remove "need-input" status)) - (accept-process-output nil 0.01)) - ;; If we couldn't finish, return nil. - (when (member "done" status) - (nrepl-dbind-response response (ex err eval-error pp-stacktrace id) - (when (and ex err) - (cond (eval-error (funcall nrepl-err-handler)) - (pp-stacktrace (cider--render-stacktrace-causes - pp-stacktrace (remove "done" status))))) ;; send the error type - (when id - (with-current-buffer connection - (nrepl--mark-id-completed id))) - response)))) - -(defun nrepl-request:stdin (input callback connection) - "Send a :stdin request with INPUT using CONNECTION. -Register CALLBACK as the response handler." - (nrepl-send-request `("op" "stdin" - "stdin" ,input) - callback - connection)) - -(defun nrepl-request:interrupt (pending-request-id callback connection) - "Send an :interrupt request for PENDING-REQUEST-ID. -The request is dispatched using CONNECTION. -Register CALLBACK as the response handler." - (nrepl-send-request `("op" "interrupt" - "interrupt-id" ,pending-request-id) - callback - connection)) - -(define-minor-mode cider-enlighten-mode nil - :lighter (cider-mode " light") - :global t) - -(defun nrepl--eval-request (input &optional ns line column) - "Prepare :eval request message for INPUT. -NS provides context for the request. -If LINE and COLUMN are non-nil and current buffer is a file buffer, \"line\", -\"column\" and \"file\" are added to the message." - (nconc (and ns `("ns" ,ns)) - `("op" "eval" - "code" ,(substring-no-properties input)) - (when cider-enlighten-mode - '("enlighten" "true")) - (let ((file (or (buffer-file-name) (buffer-name)))) - (when (and line column file) - `("file" ,file - "line" ,line - "column" ,column))))) - -(defun nrepl-request:eval (input callback connection &optional ns line column additional-params tooling) - "Send the request INPUT and register the CALLBACK as the response handler. -The request is dispatched via CONNECTION. If NS is non-nil, -include it in the request. LINE and COLUMN, if non-nil, define the position -of INPUT in its buffer. A CONNECTION uniquely determines two connections -available: the standard interaction one and the tooling session. If the -tooling is desired, set TOOLING to true. -ADDITIONAL-PARAMS is a plist to be appended to the request message." - (nrepl-send-request (append (nrepl--eval-request input ns line column) additional-params) - callback - connection - tooling)) - -(defun nrepl-sync-request:clone (connection &optional tooling) - "Sent a :clone request to create a new client session. -The request is dispatched via CONNECTION. -Optional argument TOOLING Tooling is set to t if wanting the tooling session -from CONNECTION." - (nrepl-send-sync-request '("op" "clone") - connection - nil tooling)) - -(defun nrepl-sync-request:close (connection) - "Sent a :close request to close CONNECTION's SESSION." - (nrepl-send-sync-request '("op" "close") connection) - (nrepl-send-sync-request '("op" "close") connection nil t)) ;; close tooling session - -(defun nrepl-sync-request:describe (connection) - "Perform :describe request for CONNECTION and SESSION." - (nrepl-send-sync-request '("op" "describe") - connection)) - -(defun nrepl-sync-request:ls-sessions (connection) - "Perform :ls-sessions request for CONNECTION." - (nrepl-send-sync-request '("op" "ls-sessions") connection)) - -(defun nrepl-sync-request:ls-middleware (connection) - "Perform :ls-middleware request for CONNECTION." - (nrepl-send-sync-request '("op" "ls-middleware") connection)) - -(defun nrepl-sync-request:eval (input connection &optional ns tooling) - "Send the INPUT to the nREPL server synchronously. -The request is dispatched via CONNECTION. -If NS is non-nil, include it in the request -If TOOLING is non-nil the evaluation is done using the tooling nREPL -session." - (nrepl-send-sync-request - (nrepl--eval-request input ns) - connection - nil - tooling)) - -(defun nrepl-sessions (connection) - "Get a list of active sessions on the nREPL server using CONNECTION." - (nrepl-dict-get (nrepl-sync-request:ls-sessions connection) "sessions")) - -(defun nrepl-middleware (connection) - "Get a list of middleware on the nREPL server using CONNECTION." - (nrepl-dict-get (nrepl-sync-request:ls-middleware connection) "middleware")) - -;;; Server - -;; The server side process is started by `nrepl-start-server-process' and has a -;; very simple filter that pipes its output directly into its process buffer -;; (*nrepl-server*). The main purpose of this process is to start the actual -;; nrepl communication client (`nrepl-client-filter') when the message "nREPL -;; server started on port ..." is detected. - -;; internal variables used for state transfer between nrepl-start-server-process -;; and nrepl-server-filter. -(defvar-local nrepl-on-port-callback nil) - -(defun nrepl-server-p (buffer-or-process) - "Return t if BUFFER-OR-PROCESS is an nREPL server." - (let ((buffer (if (processp buffer-or-process) - (process-buffer buffer-or-process) - buffer-or-process))) - (buffer-local-value 'nrepl-is-server buffer))) - -(defun nrepl-start-server-process (directory cmd on-port-callback) - "Start nREPL server process in DIRECTORY using shell command CMD. -Return a newly created process. Set `nrepl-server-filter' as the process -filter, which starts REPL process with its own buffer once the server has -started. ON-PORT-CALLBACK is a function of one argument (server buffer) -which is called by the process filter once the port of the connection has -been determined." - (let* ((default-directory (or directory default-directory)) - (serv-buf (get-buffer-create - (nrepl-server-buffer-name - `(:project-dir ,default-directory))))) - (with-current-buffer serv-buf - (setq nrepl-is-server t - nrepl-project-dir default-directory - nrepl-server-command cmd - nrepl-on-port-callback on-port-callback)) - (let ((serv-proc (start-file-process-shell-command - "nrepl-server" serv-buf cmd))) - (set-process-filter serv-proc #'nrepl-server-filter) - (set-process-sentinel serv-proc #'nrepl-server-sentinel) - (set-process-coding-system serv-proc 'utf-8-unix 'utf-8-unix) - (message "[nREPL] Starting server via %s" - (propertize cmd 'face 'font-lock-keyword-face)) - serv-proc))) - -(defconst nrepl-listening-unix-address-regexp - (rx - (and "nREPL server listening on" (+ " ") - "nrepl+unix:" (group-n 1 (+ not-newline))))) - -(defconst nrepl-listening-inet-address-regexp - (rx (or - ;; standard - (and "nREPL server started on port " (group-n 1 (+ (any "0-9")))) - ;; babashka - (and "Started nREPL server at " - (group-n 2 (+? any)) ":" (group-n 1 (+ (any "0-9")))))) - "A regexp to search an nREPL's stdout for the address it is listening on. - -If it matches, the address components can be extracted using the following -match groups: -1 for the port, and -2 for the host (babashka only).") - -(defun cider--process-plist-put (proc prop val) - "Change value in PROC's plist of PROP to VAL. -Value is changed using `plist-put`, of which see." - (thread-first - proc - (process-plist) - (plist-put prop val) - (thread-last (set-process-plist proc)))) - -(defun nrepl-server-filter (process output) - "Process nREPL server output from PROCESS contained in OUTPUT. - -The PROCESS plist is updated as (non-exhaustive list): - -:cider--nrepl-server-ready set to t when the server is successfully brought -up." - ;; In Windows this can be false: - (let ((server-buffer (process-buffer process))) - (when (buffer-live-p server-buffer) - (with-current-buffer server-buffer - ;; auto-scroll on new output - (let ((moving (= (point) (process-mark process)))) - (save-excursion - (goto-char (process-mark process)) - (insert output) - (ansi-color-apply-on-region (process-mark process) (point)) - (set-marker (process-mark process) (point))) - (when moving - (goto-char (process-mark process)) - (when-let* ((win (get-buffer-window))) - (set-window-point win (point))))) - ;; detect the port the server is listening on from its output - (when (null nrepl-endpoint) - (let ((end (cond - ((string-match nrepl-listening-unix-address-regexp output) - (let ((path (match-string 1 output))) - (message "[nREPL] server started on nrepl+unix:%s" path) - (list :host "local-unix-domain-socket" - :port path - :socket-file path))) - ((string-match nrepl-listening-inet-address-regexp output) - (let ((host (or (match-string 2 output) - (file-remote-p default-directory 'host) - "localhost")) - (port (string-to-number (match-string 1 output)))) - (message "[nREPL] server started on %s" port) - (list :host host :port port)))))) - (when end - (setq nrepl-endpoint end) - (cider--process-plist-put process :cider--nrepl-server-ready t) - (when nrepl-on-port-callback - (funcall nrepl-on-port-callback (process-buffer process)))))))))) - -(defmacro emacs-bug-46284/when-27.1-windows-nt (&rest body) - "Only evaluate BODY when Emacs bug #46284 has been detected." - (when (and (eq system-type 'windows-nt) - (string= emacs-version "27.1")) - (cons 'progn body))) - - -(declare-function cider--close-connection "cider-connection") -(defun nrepl-server-sentinel (process event) - "Handle nREPL server PROCESS EVENT. -If the nREPL PROCESS failed to initiate and encountered a fatal EVENT -signal, raise an 'error'. Additionally, if the EVENT signal is SIGHUP, -close any existing client connections." - ;; only interested on fatal signals. - (when (not (process-live-p process)) - (emacs-bug-46284/when-27.1-windows-nt - ;; There is a bug in emacs 27.1 (since fixed) that sets all EVENT - ;; descriptions for signals to "unknown signal". We correct this by - ;; resetting it back to its canonical value. - (when (eq (process-status process) 'signal) - (cl-case (process-exit-status process) - ;; SIGHUP==1 emacs nt/inc/ms-w32.h - (1 (setq event "Hangup")) - ;; SIGINT==2 x86_64-w64-mingw32/include/signal.h - (2 (setq event "Interrupt")) - ;; SIGKILL==9 emacs nt/inc/ms-w32.h - (9 (setq event "Killed"))))) - (let* ((server-buffer (process-buffer process)) - (clients (seq-filter (lambda (b) - (eq (buffer-local-value 'nrepl-server-buffer b) - server-buffer)) - (buffer-list)))) - - ;; see https://github.com/clojure-emacs/cider/pull/3333 - (when (string-match-p "^hangup" event) - (mapc #'cider--close-connection clients)) - - (if (process-get process :cider--nrepl-server-ready) - (progn - (when server-buffer (kill-buffer server-buffer)) - (message "nREPL server exited.")) - (let ((problem (when (and server-buffer (buffer-live-p server-buffer)) - (with-current-buffer server-buffer - (buffer-substring (point-min) (point-max)))))) - (error "Could not start nREPL server: %s (%S)" problem (string-trim event))))))) - -;;; Messages - -(defcustom nrepl-log-messages nil - "If non-nil, log protocol messages to an nREPL messages buffer. -This is extremely useful for debug purposes, as it allows you to inspect -the communication between Emacs and an nREPL server. Enabling the logging -might have a negative impact on performance, so it's not recommended to -keep it enabled unless you need to debug something." - :type 'boolean - :safe #'booleanp) - -(defconst nrepl-message-buffer-max-size 1000000 - "Maximum size for the nREPL message buffer. -Defaults to 1000000 characters, which should be an insignificant -memory burden, while providing reasonable history.") - -(defconst nrepl-message-buffer-reduce-denominator 4 - "Divisor by which to reduce message buffer size. -When the maximum size for the nREPL message buffer is exceeded, the size of -the buffer is reduced by one over this value. Defaults to 4, so that 1/4 -of the buffer is removed, which should ensure the buffer's maximum is -reasonably utilized, while limiting the number of buffer shrinking -operations.") - -(defvar nrepl-messages-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "n") #'next-line) - (define-key map (kbd "p") #'previous-line) - (define-key map (kbd "TAB") #'forward-button) - (define-key map (kbd "RET") #'nrepl-log-expand-button) - (define-key map (kbd "e") #'nrepl-log-expand-button) - (define-key map (kbd "E") #'nrepl-log-expand-all-buttons) - (define-key map (kbd "<backtab>") #'backward-button) - map)) - -(define-derived-mode nrepl-messages-mode special-mode "nREPL Messages" - "Major mode for displaying nREPL messages. - -\\{nrepl-messages-mode-map}" - (when cider-special-mode-truncate-lines - (setq-local truncate-lines t)) - (setq-local sesman-system 'CIDER) - (setq-local electric-indent-chars nil) - (setq-local comment-start ";") - (setq-local comment-end "") - (setq-local paragraph-start "(-->\\|(<--") - (setq-local paragraph-separate "(<--")) - -(defun nrepl-decorate-msg (msg type) - "Decorate nREPL MSG according to its TYPE." - (pcase type - (`request (cons '--> (cdr msg))) - (`response (cons '<-- (cdr msg))))) - -(defun nrepl-log-message (msg type) - "Log the nREPL MSG. -TYPE is either request or response. The message is logged to a buffer -described by `nrepl-message-buffer-name-template'." - (when nrepl-log-messages - ;; append a time-stamp to the message before logging it - ;; the time-stamps are quite useful for debugging - (setq msg (cons (car msg) - (lax-plist-put (cdr msg) "time-stamp" - (format-time-string "%Y-%m-%0d %H:%M:%S.%N")))) - (with-current-buffer (nrepl-messages-buffer (current-buffer)) - (setq buffer-read-only nil) - (when (> (buffer-size) nrepl-message-buffer-max-size) - (goto-char (/ (buffer-size) nrepl-message-buffer-reduce-denominator)) - (re-search-forward "^(" nil t) - (delete-region (point-min) (- (point) 1))) - (goto-char (point-max)) - (nrepl-log-pp-object (nrepl-decorate-msg msg type) - (nrepl-log--message-color (lax-plist-get (cdr msg) "id")) - t) - (when-let* ((win (get-buffer-window))) - (set-window-point win (point-max))) - (setq buffer-read-only t)))) - -(defun nrepl-toggle-message-logging () - "Toggle the value of `nrepl-log-messages' between nil and t. - -This in effect enables or disables the logging of nREPL messages." - (interactive) - (setq nrepl-log-messages (not nrepl-log-messages)) - (if nrepl-log-messages - (message "nREPL message logging enabled") - (message "nREPL message logging disabled"))) - -(defcustom nrepl-message-colors - '("red" "brown" "coral" "orange" "green" "deep sky blue" "blue" "dark violet") - "Colors used in the messages buffer." - :type '(repeat color)) - -(defun nrepl-log-expand-button (&optional button) - "Expand the objects hidden in BUTTON's :nrepl-object property. -BUTTON defaults the button at point." - (interactive) - (if-let* ((button (or button (button-at (point))))) - (let* ((start (overlay-start button)) - (end (overlay-end button)) - (obj (overlay-get button :nrepl-object)) - (inhibit-read-only t)) - (save-excursion - (goto-char start) - (delete-overlay button) - (delete-region start end) - (nrepl-log-pp-object obj) - (delete-char -1))) - (error "No button at point"))) - -(defun nrepl-log-expand-all-buttons () - "Expand all buttons in nREPL log buffer." - (interactive) - (if (not (eq major-mode 'nrepl-messages-mode)) - (user-error "Not in a `nrepl-messages-mode'") - (save-excursion - (let* ((pos (point-min)) - (button (next-button pos))) - (while button - (setq pos (overlay-start button)) - (nrepl-log-expand-button button) - (setq button (next-button pos))))))) - -(defun nrepl-log--expand-button-mouse (event) - "Expand the text hidden under overlay button. -EVENT gives the button position on window." - (interactive "e") - (pcase (elt event 1) - (`(,window ,_ ,_ ,_ ,_ ,point . ,_) - (with-selected-window window - (nrepl-log-expand-button (button-at point)))))) - -(defun nrepl-log-insert-button (label object) - "Insert button with LABEL and :nrepl-object property as OBJECT." - (insert-button label - :nrepl-object object - 'action #'nrepl-log-expand-button - 'face 'link - 'help-echo "RET: Expand object." - ;; Workaround for bug#1568 (don't use local-map here; it - ;; overwrites major mode map.) - 'keymap `(keymap (mouse-1 . nrepl-log--expand-button-mouse))) - (insert "\n")) - -(defun nrepl-log--message-color (id) - "Return the color to use when pretty-printing the nREPL message with ID. -If ID is nil, return nil." - (when id - (thread-first - (string-to-number id) - (mod (length nrepl-message-colors)) - (nth nrepl-message-colors)))) - -(defun nrepl-log--pp-listlike (object &optional foreground button) - "Pretty print nREPL list like OBJECT. -FOREGROUND and BUTTON are as in `nrepl-log-pp-object'." - (cl-flet ((color (str) - (propertize str 'face - (append '(:weight ultra-bold) - (when foreground `(:foreground ,foreground)))))) - (let ((head (format "(%s" (car object)))) - (insert (color head)) - (if (null (cdr object)) - (insert ")\n") - (let* ((indent (+ 2 (- (current-column) (length head)))) - (sorted-pairs (sort (seq-partition (cl-copy-list (cdr object)) 2) - (lambda (a b) - (string< (car a) (car b))))) - (name-lengths (seq-map (lambda (pair) (length (car pair))) sorted-pairs)) - (longest-name (seq-max name-lengths)) - ;; Special entries are displayed first - (specialq (lambda (pair) (member (car pair) '("id" "op" "session" "time-stamp")))) - (special-pairs (seq-filter specialq sorted-pairs)) - (not-special-pairs (seq-remove specialq sorted-pairs)) - (all-pairs (seq-concatenate 'list special-pairs not-special-pairs)) - (sorted-object (apply #'seq-concatenate 'list all-pairs))) - (insert "\n") - (cl-loop for l on sorted-object by #'cddr - do (let ((indent-str (make-string indent ?\s)) - (name-str (propertize (car l) 'face - ;; Only highlight top-level keys. - (unless (eq (car object) 'dict) - 'font-lock-keyword-face))) - (spaces-str (make-string (- longest-name (length (car l))) ?\s))) - (insert (format "%s%s%s " indent-str name-str spaces-str)) - (nrepl-log-pp-object (cadr l) nil button))) - (when (eq (car object) 'dict) - (delete-char -1)) - (insert (color ")\n"))))))) - -(defun nrepl-log-pp-object (object &optional foreground button) - "Pretty print nREPL OBJECT, delimited using FOREGROUND. -If BUTTON is non-nil, try making a button from OBJECT instead of inserting -it into the buffer." - (let ((min-dict-fold-size 1) - (min-list-fold-size 10) - (min-string-fold-size 60)) - (if-let* ((head (car-safe object))) - ;; list-like objects - (cond - ;; top level dicts (always expanded) - ((memq head '(<-- -->)) - (nrepl-log--pp-listlike object foreground button)) - ;; inner dicts - ((eq head 'dict) - (if (and button (> (length object) min-dict-fold-size)) - (nrepl-log-insert-button "(dict ...)" object) - (nrepl-log--pp-listlike object foreground button))) - ;; lists - (t - (if (and button (> (length object) min-list-fold-size)) - (nrepl-log-insert-button (format "(%s ...)" (prin1-to-string head)) object) - (pp object (current-buffer))))) - ;; non-list objects - (if (stringp object) - (if (and button (> (length object) min-string-fold-size)) - (nrepl-log-insert-button (format "\"%s...\"" (substring object 0 min-string-fold-size)) object) - (insert (prin1-to-string object) "\n")) - (pp object (current-buffer)) - (insert "\n"))))) - -(declare-function cider--gather-connect-params "cider-connection") -(defun nrepl-messages-buffer (conn) - "Return or create the buffer for CONN. -The default buffer name is *nrepl-messages connection*." - (with-current-buffer conn - (or (and (buffer-live-p nrepl-messages-buffer) - nrepl-messages-buffer) - (setq nrepl-messages-buffer - (let ((buffer (get-buffer-create - (nrepl-messages-buffer-name - (cider--gather-connect-params))))) - (with-current-buffer buffer - (buffer-disable-undo) - (nrepl-messages-mode) - buffer)))))) - -(defun nrepl-error-buffer () - "Return or create the buffer. -The default buffer name is *nrepl-error*." - (or (get-buffer nrepl-error-buffer-name) - (let ((buffer (get-buffer-create nrepl-error-buffer-name))) - (with-current-buffer buffer - (buffer-disable-undo) - (nrepl--ensure-fundamental-mode) - buffer)))) - -(defun nrepl-log-error (msg) - "Log the given MSG to the buffer given by `nrepl-error-buffer'." - (with-current-buffer (nrepl-error-buffer) - (setq buffer-read-only nil) - (goto-char (point-max)) - (insert msg) - (when-let* ((win (get-buffer-window))) - (set-window-point win (point-max))) - (setq buffer-read-only t))) - -(make-obsolete 'nrepl-default-client-buffer-builder nil "0.18") - -(provide 'nrepl-client) - -;;; nrepl-client.el ends here diff --git a/elpa/cider-1.12.0/nrepl-dict.el b/elpa/cider-1.12.0/nrepl-dict.el @@ -1,205 +0,0 @@ -;;; nrepl-dict.el --- Dictionary functions for Clojure nREPL -*- lexical-binding: t -*- - -;; Copyright © 2012-2013 Tim King, Phil Hagelberg, Bozhidar Batsov -;; Copyright © 2013-2023 Bozhidar Batsov, Artur Malabarba and CIDER contributors -;; -;; Author: Tim King <kingtim@gmail.com> -;; Phil Hagelberg <technomancy@gmail.com> -;; Bozhidar Batsov <bozhidar@batsov.dev> -;; Artur Malabarba <bruce.connor.am@gmail.com> -;; Hugo Duncan <hugo@hugoduncan.org> -;; Steve Purcell <steve@sanityinc.com> -;; -;; This program is free software: you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. -;; -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. -;; -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <http://www.gnu.org/licenses/>. -;; -;; This file is not part of GNU Emacs. -;; -;;; Commentary: -;; -;; Provides functions to interact with and create `nrepl-dict's. These are -;; simply plists with an extra element at the head. - -;;; Code: -(require 'cl-lib) - - -(defun nrepl-dict (&rest key-vals) - "Create nREPL dict from KEY-VALS." - (cons 'dict key-vals)) - -(defun nrepl-dict-from-hash (hash) - "Create nREPL dict from HASH." - (let ((dict (nrepl-dict))) - (maphash (lambda (k v) (nrepl-dict-put dict k v)) hash) - dict)) - -(defun nrepl-dict-p (object) - "Return t if OBJECT is an nREPL dict." - (and (listp object) - (eq (car object) 'dict))) - -(defun nrepl-dict-empty-p (dict) - "Return t if nREPL dict DICT is empty." - (null (cdr dict))) - -(defun nrepl-dict-contains (dict key) - "Return nil if nREPL dict DICT doesn't contain KEY. -If DICT does contain KEY, then a non-nil value is returned. Due to the -current implementation, this return value is the tail of DICT's key-list -whose car is KEY. Comparison is done with `equal'." - (member key (nrepl-dict-keys dict))) - -(defun nrepl-dict-get (dict key &optional default) - "Get from DICT value associated with KEY, optional DEFAULT if KEY not in DICT. -If dict is nil, return nil. If DEFAULT not provided, and KEY not in DICT, -return nil. If DICT is not an nREPL dict object, an error is thrown." - (when dict - (if (nrepl-dict-p dict) - (if (nrepl-dict-contains dict key) - (lax-plist-get (cdr dict) key) - default) - (error "Not an nREPL dict object: %s" dict)))) - -(defun nrepl-dict-put (dict key value) - "Associate in DICT, KEY to VALUE. -Return new dict. Dict is modified by side effects." - (if (null dict) - `(dict ,key ,value) - (if (not (nrepl-dict-p dict)) - (error "Not an nREPL dict object: %s" dict) - (setcdr dict (lax-plist-put (cdr dict) key value)) - dict))) - -(defun nrepl-dict-keys (dict) - "Return all the keys in the nREPL DICT." - (if (nrepl-dict-p dict) - (cl-loop for l on (cdr dict) by #'cddr - collect (car l)) - (error "Not an nREPL dict object: %s" dict))) - -(defun nrepl-dict-vals (dict) - "Return all the values in the nREPL DICT." - (if (nrepl-dict-p dict) - (cl-loop for l on (cdr dict) by #'cddr - collect (cadr l)) - (error "Not an nREPL dict object: %s" dict))) - -(defun nrepl-dict-map (fn dict) - "Map FN on nREPL DICT. -FN must accept two arguments key and value." - (if (nrepl-dict-p dict) - (cl-loop for l on (cdr dict) by #'cddr - collect (funcall fn (car l) (cadr l))) - (error "Not an nREPL dict object: %s" dict))) - -(defun nrepl-dict-merge (dict1 dict2) - "Destructively merge DICT2 into DICT1. -Keys in DICT2 override those in DICT1." - (let ((base (or dict1 '(dict)))) - (nrepl-dict-map (lambda (k v) - (nrepl-dict-put base k v)) - (or dict2 '(dict))) - base)) - -(defun nrepl-dict-get-in (dict keys) - "Return the value in a nested DICT. -KEYS is a list of keys. Return nil if any of the keys is not present or if -any of the values is nil." - (let ((out dict)) - (while (and keys out) - (setq out (nrepl-dict-get out (pop keys)))) - out)) - -(defun nrepl-dict-flat-map (function dict) - "Map FUNCTION over DICT and flatten the result. -FUNCTION follows the same restrictions as in `nrepl-dict-map', and it must -also always return a sequence (since the result will be flattened)." - (when dict - (apply #'append (nrepl-dict-map function dict)))) - -(defun nrepl-dict-filter (function dict) - "For all key-values of DICT, return new dict where FUNCTION returns non-nil. - -FUNCTION should be a function taking two arguments, key and value." - (let ((new-map (nrepl-dict)) - (keys (nrepl-dict-keys dict))) - (dolist (key keys) - (let ((val (nrepl-dict-get dict key))) - (when (funcall function key val) - (nrepl-dict-put new-map key val)))) - new-map)) - - -;;; More specific functions -(defun nrepl--cons (car list-or-dict) - "Generic cons of CAR to LIST-OR-DICT." - (if (eq (car list-or-dict) 'dict) - (cons 'dict (cons car (cdr list-or-dict))) - (cons car list-or-dict))) - -(defun nrepl--nreverse (list-or-dict) - "Generic `nreverse' which works on LIST-OR-DICT." - (if (eq (car list-or-dict) 'dict) - (cons 'dict (nreverse (cdr list-or-dict))) - (nreverse list-or-dict))) - -(defun nrepl--push (obj stack) - "Cons OBJ to the top element of the STACK." - ;; stack is assumed to be a list - (if (eq (caar stack) 'dict) - (cons (cons 'dict (cons obj (cdar stack))) - (cdr stack)) - (cons (if (null stack) - obj - (cons obj (car stack))) - (cdr stack)))) - -(defun nrepl--merge (dict1 dict2 &optional no-join) - "Join nREPL dicts DICT1 and DICT2 in a meaningful way. -String values for non \"id\" and \"session\" keys are concatenated. Lists -are appended. nREPL dicts merged recursively. All other objects are -accumulated into a list. DICT1 is modified destructively and -then returned. -If NO-JOIN is given, return the first non nil dict." - (if no-join - (or dict1 dict2) - (cond ((null dict1) dict2) - ((null dict2) dict1) - ((stringp dict1) (concat dict1 dict2)) - ((nrepl-dict-p dict1) - (nrepl-dict-map - (lambda (k2 v2) - (nrepl-dict-put dict1 k2 - (nrepl--merge (nrepl-dict-get dict1 k2) v2 - (member k2 '("id" "session"))))) - dict2) - dict1) - ((and (listp dict2) (listp dict1)) (append dict1 dict2)) - ((listp dict1) (append dict1 (list dict2))) - (t `(,dict1 ,dict2))))) - - -;;; Dbind -(defmacro nrepl-dbind-response (response keys &rest body) - "Destructure an nREPL RESPONSE dict. -Bind the value of the provided KEYS and execute BODY." - (declare (debug (form (&rest symbolp) body))) - `(let ,(cl-loop for key in keys - collect `(,key (nrepl-dict-get ,response ,(format "%s" key)))) - ,@body)) -(put 'nrepl-dbind-response 'lisp-indent-function 2) - -(provide 'nrepl-dict) - -;;; nrepl-dict.el ends here diff --git a/elpa/geiser-0.30.signed b/elpa/geiser-0.30.signed @@ -1,2 +0,0 @@ -Good signature from 066DAFCB81E42C40 GNU ELPA Signing Agent (2019) <elpasign@elpa.gnu.org> (trust undefined) created at 2023-12-16T11:05:06+0100 using RSA -Good signature from 645357D2883A0966 GNU ELPA Signing Agent (2023) <elpasign@elpa.gnu.org> (trust undefined) created at 2023-12-16T11:05:06+0100 using EDDSA -\ No newline at end of file diff --git a/elpa/geiser-0.30/.dir-locals.el b/elpa/geiser-0.30/.dir-locals.el @@ -1,4 +0,0 @@ -((emacs-lisp-mode - (indent-tabs-mode . nil)) - (scheme-mode - (indent-tabs-mode . nil))) diff --git a/elpa/geiser-0.30/README-elpa b/elpa/geiser-0.30/README-elpa @@ -1,299 +0,0 @@ -1 Overview -══════════ - - Geiser is a generic Emacs/Scheme interaction mode, featuring an - enhanced REPL and a set of minor modes improving Emacs' basic scheme - major mode. The main functionalities provided are: - - • Evaluation of forms in the namespace of the current module. - • Macro expansion. - • File/module loading. - • Namespace-aware identifier completion (including local bindings, - names visible in the current module, and module names). - • Autodoc: the echo area shows information about the signature of the - procedure/macro around point automatically. - • Jump to definition of identifier at point. - • Access to documentation (including docstrings when the - implementation provides it). - • Listings of identifiers exported by a given module. - • Listings of callers/callees of procedures. - • Rudimentary support for debugging (list of evaluation/compilation - error in an Emacs' compilation-mode buffer). - • Support for inline images in schemes, such as Racket, that treat - them as first order values. - - If you're not in a hurry, [Geiser's website] contains a much nicer - manual. - - -[Geiser's website] <http://www.nongnu.org/geiser/> - - -2 Supported schemes -═══════════════════ - - Geiser needs Emacs 27.1 or better, and installing also at least one of - the supported scheme implementations. - - The following schemes are supported via an independent package, - installable from either NonGNU ELPA or MELPA: - - • Chez 9.4 or better, via [geiser-chez] - • Chibi 0.7.3 or better, via [geiser-chibi] - • Chicken 4.8.0 or better, via [geiser-chicken] - • Gambit 4.9.3 or better, via [geiser-gambit] - • Gauche 0.9.6 or better, via [geiser-gauche] - • Guile 2.2 or better, via [geiser-guile] - • Kawa 3.1, via [geiser-kawa] - • MIT/GNU Scheme, via [geiser-mit] - • Racket 6.0 or better, via [geiser-racket] - • Stklos 1.50, via [geiser-stklos] - - -[geiser-chez] <https://gitlab.com/emacs-geiser/chez> - -[geiser-chibi] <https://gitlab.com/emacs-geiser/chibi> - -[geiser-chicken] <https://gitlab.com/emacs-geiser/chicken> - -[geiser-gambit] <https://gitlab.com/emacs-geiser/gambit> - -[geiser-gauche] <https://gitlab.com/emacs-geiser/gauche> - -[geiser-guile] <https://gitlab.com/emacs-geiser/guile> - -[geiser-kawa] <https://gitlab.com/emacs-geiser/kawa> - -[geiser-mit] <https://gitlab.com/emacs-geiser/mit> - -[geiser-racket] <https://gitlab.com/emacs-geiser/racket> - -[geiser-stklos] <https://gitlab.com/emacs-geiser/stklos> - - -3 Installation -══════════════ - -3.0.1 Using ELPA -╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌ - - Geiser is available in the ELPA repositories [NonGNU ELPA] - (pre-configured by default as a source starting in Emacs 28) and - MELPA. So the easiest way is to use the ELPA package, and just type - - `M-x package-install RET geiser-<implementation>' - - inside emacs, or the corresponding `use-package' stanza, for, say - - ┌──── - │ (use-package geiser-mit :ensure t) - └──── - - All the concrete implementation packages depend on the base `geiser' - package, so it'll be installed for you. - - -[NonGNU ELPA] <https://elpa.nongnu.org/nongnu/geiser.html> - - -3.0.2 From a repository checkout -╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌╌ - - If you are not using MELPA, just put this repository's `elisp' - directory and the target's scheme directory in your load path and - require the latter: - - ┌──── - │ (add-to-list 'load-path "<geiser checkout dir>/elisp") - │ (add-to-list 'load-path "<geiser-mit checkout dir>") - │ (require 'geiser-mit) - └──── - - Some scheme implementations need additional installation steps to - fully support all geiser operations, so please do check their - corresponding web pages. - - -4 Basic configuration -═════════════════════ - - When opening a scheme file, Geiser will try to guess its Scheme, - defaulting to the first in the list - `geiser-active-implementations'. If you've installed more than one - geiser package, you can also use `C-c C-s' to select the - implementation by hand (on a per file basis). - - Check the geiser customization group for some other options with: - - ┌──── - │ M-x customize-group RET geiser RET - └──── - - In particular, customize `geiser-<impl>-binary', which should point to - an executable in your path. - - To start a REPL, run `M-x geiser'. - - -4.1 Completion at point -─────────────────────── - - Geiser offers identifier and module name completion, bound to `M-TAB' - and `M-`' respectively. Only names visible in the current module are - offered. - - While that is cool and all, things are even better: if you have - [Company] or [Corfu] installed, Geiser's completion will integrate - with it. Just enable global-company-mode/corfu-global-mode and, from - then on, any new scheme buffer or REPL will use it. Alternatively you - can activate company-mode or corfu-mode individually only in some - buffers. - - -[Company] <http://company-mode.github.io/> - -[Corfu] <https://github.com/minad/corfu> - - -4.2 Macro expansion with macrostep-geiser -───────────────────────────────────────── - - Geiser offers basic macro expansion in a dedicated buffer. If you - prefer in-buffer, step by step expansion, please take a look at Nikita - Bloshchanevich's [macrostep-geiser]. - - -[macrostep-geiser] <https://github.com/nbfalcon/macrostep-geiser> - - -5 Quick key reference -═════════════════════ - - (See also [the user's manual cheat sheet]') - - -[the user's manual cheat sheet] -<http://geiser.nongnu.org/geiser_5.html#Cheat-sheet> - -5.1 In Scheme buffers: -────────────────────── - - ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ - C-c C-s Specify Scheme implementation for buffer - C-c C-z Switch to REPL - C-c C-a Switch to REPL and current module - M-. Go to definition of identifier at point - M-, Go back to where M-. was last invoked - C-c C-e m Ask for a module and open its file - C-c C-e C-l Add a given directory to Scheme's load path - C-c C-e [ Toggle between () and [] for current form - c-c C-e \ Insert λ - C-c C-i Interrupt on-going evaluation - C-M-x Eval definition around point - C-c C-c Eval definition around point - C-c M-e Eval definition around point and switch to REPL - C-x C-e Eval sexp before point - C-c C-r Eval region - C-c M-r Eval region and switch to REPL - C-c C-b Eval buffer - C-c M-b Eval buffer and switch to REPL - C-c C-m x Macro-expand definition around point - C-c C-m e Macro-expand sexp before point - C-c C-m r Macro-expand region - C-c C-k Compile and load current buffer - C-c C-l Load scheme file - C-u C-c C-k Compile and load current buffer, restarting REPL - C-c C-d d See documentation for identifier at point - C-c C-d s See short documentation for identifier at point - C-c C-d i Look up manual for identifier at point - C-c C-d m See a list of a module's exported identifiers - C-c C-d a Toggle autodoc mode - C-c < Show callers of procedure at point - C-c > Show callees of procedure at point - M-TAB Complete identifier at point - M-`, C-. Complete module name at point - TAB Complete identifier at point or indent - (If geiser-mode-smart-tab-p is t) - ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ - - -5.2 In the REPL -─────────────── - - ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ - C-c C-z Start Scheme REPL, or jump to previous buffer - C-c M-o Clear scheme output - C-c C-q Kill Scheme process - C-c C-l Load scheme file - C-c C-k Nuke REPL: use it if the REPL becomes unresponsive - M-. Edit identifier at point - TAB, M-TAB Complete identifier at point - M-`, C-. Complete module name at point - M-p, M-n Prompt history, matching current prefix - C-c \ Insert λ - C-c [ Toggle between () and [] for current form - C-c C-m Set current module - C-c C-i Import module into current namespace - C-c C-r Add a given directory to scheme's load path - C-c C-d C-d See documentation for symbol at point - C-c C-d C-m See documentation for module - C-c C-d C-a Toggle autodoc mode - ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ - - -5.3 In the documentation browser: -───────────────────────────────── - - ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ - f Next page - b Previous page - TAB, n Next link - S-TAB, p Previous link - N Next section - P Previous section - k Kill current page and go to previous or next - g, r Refresh page - c Clear browsing history - ., M-. Edit identifier at point - z Switch to REPL - q Bury buffer - ━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━━ - - -5.4 In backtrace (evaluation/compile result) buffers: -───────────────────────────────────────────────────── - - • `M-g n', `M-g p', `C-x `' for error location navigation. - • `n', `p' for moving among errors in the buffer. - • `,' to pop-up the debugger actions menu. - • `q' to bury buffer. - - -6 How to support a new scheme implementation -════════════════════════════════════════════ - - Geiser works by running an instance of a REPL, or remotely connecting - to one, and evaluating the scheme code it sees there. Then, every time - it needs to perform some operation (like, say, printing autodoc, - jumping to a source location or expanding a macro), it asks the - running scheme instance for that information. - - So supporting a new scheme usually means writing a small scheme - library that provides that information on demand, and then some - standard elisp functions that invoke the procedures in that library. - - To see what elisp functions one needs to implement, just execute the - command `M-x geiser-implementation-help` inside emacs with a recent - version of geiser installed. And then take a look at, say, - [geiser-guile.el] for examples of how those functions are implemented - for concrete schemes. - - Not all schemes can provide introspective information to implement all - the functionality that geiser tries to offer. That is okay: you can - leave as many functions unimplemented as you see fit (there is even an - explicit list of unsupported features), and geiser will still know how - to use the ones that are implemented. - - -[geiser-guile.el] -<https://gitlab.com/emacs-geiser/guile/-/blob/master/geiser-guile.el> diff --git a/elpa/geiser-0.30/dir b/elpa/geiser-0.30/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 -* Geiser: (geiser). Emacs environment for Scheme hacking. diff --git a/elpa/geiser-0.30/doc/cheat.texi b/elpa/geiser-0.30/doc/cheat.texi @@ -1,251 +0,0 @@ -@node Cheat sheet, No hacker is an island, Between the parens, Top -@chapter Cheat sheet - -In the tables below, triple chords always accept a variant with the -third key not modified by @key{Control}; e.g., -@code{geiser-autodoc-show} is bound both to @kbd{C-c C-d C-s} and -@kbd{C-c C-d s}. - -@menu -* Scheme buffers:: -* REPL:: -* Documentation browser:: -@end menu - -@node Scheme buffers, REPL, Cheat sheet, Cheat sheet -@section Scheme buffers - -@multitable @columnfractions .20 .4 .4 -@headitem Key @tab Command @tab Description -@item C-c C-z -@tab @code{geiser-mode-switch-to-repl} -@tab Switch to REPL -@item C-c C-a -@tab @code{geiser-mode-switch-to-repl-and-enter} -@tab Switch to REPL and current module (also @kbd{C-u C-c C-z}) -@item C-c C-s -@tab @code{geiser-set-scheme} -@tab Specify Scheme implementation for buffer -@item @tab @tab -@item M-. -@tab @code{geiser-edit-symbol-at-point} -@tab Go to definition of identifier at point -@item M-, -@tab @code{geiser-pop-symbol-stack} -@tab Go back to where M-. was last invoked -@item C-c C-e C-m -@tab @code{geiser-edit-module} -@tab Ask for a module and open its file -@item C-c C-e C-l -@tab @code{geiser-add-to-load-path} -@tab Ask for a directory and add to Scheme load path -@item C-c C-e C-[ -@tab @code{geiser-squarify} -@tab Toggle between () and [] for current form -@item C-c C-\ -@tab @code{geiser-insert-lambda} -@tab Insert greek lambda or, with prefix, a lambda form -@item @tab @tab -@item C-c C-i -@tab @code{geiser-eval-interrupt} -@tab Interrupt ongoing evaluation -@item C-M-x -@tab @code{geiser-eval-definition} -@tab Eval definition around point -@item C-c C-c -@tab @code{geiser-eval-definition} -@tab Eval definition around point -@item C-c M-e -@tab @code{geiser-eval-definition-and-go} -@tab Eval definition around point and switch to REPL -@item C-c M-c -@tab @code{geiser-eval-definition-and-go} -@tab Eval definition around point and switch to REPL -@item C-x C-e -@tab @code{geiser-eval-last-sexp} -@tab Eval sexp before point -@item C-c C-r -@tab @code{geiser-eval-region} -@tab Eval region -@item C-c M-r -@tab @code{geiser-eval-region-and-go} -@tab Eval region and switch to REPL -@item C-c C-b -@tab @code{geiser-eval-buffer} -@tab Eval buffer -@item C-c M-b -@tab @code{geiser-eval-buffer-and-go} -@tab Eval buffer and switch to REPL -@item @tab @tab -@item C-c C-m C-x -@tab @code{geiser-expand-definition} -@tab Macro-expand definition around point -@item C-c C-m C-e -@tab @code{geiser-expand-last-sexp} -@tab Macro-expand sexp before point -@item C-c C-m C-r -@tab @code{geiser-expand-region} -@tab Macro-expand region -@item @tab @tab -@item C-c C-k -@tab @code{geiser-compile-current-buffer} -@tab Compile and load current file; with prefix, restart REPL before -@item C-c C-l -@tab @code{geiser-load-file} -@tab Load scheme file -@item M-g n, C-x ` -@tab @code{next-error} -@tab Jump to the location of next error -@item M-g p -@tab @code{previous-error} -@tab Jump to the location of previous error -@item @tab @tab -@item C-c C-d C-d -@tab @code{geiser-doc-symbol-at-point} -@tab See documentation for identifier at point -@item C-c C-d C-s -@tab @code{geiser-autodoc-show} -@tab Show signature or value for identifier at point in echo area -@item C-c C-d C-m -@tab @code{geiser-doc-module} -@tab See a list of a module's exported identifiers -@item C-c C-d C-i -@tab @code{geiser-doc-look-up-manual} -@tab Look up manual for symbol at point -@item C-c C-d C-a -@tab @code{geiser-autodoc-mode} -@tab Toggle autodoc mode -@item @tab @tab -@item C-c < -@tab @code{geiser-xref-callers} -@tab Show callers of procedure at point -@item C-c > -@tab @code{geiser-xref-callees} -@tab Show callees of procedure at point -@item @tab @tab -@item M-TAB -@tab @code{completion-at-point} -@tab Complete identifier at point -@item M-`, C-. -@tab @code{geiser-capf-complete-module} -@tab Complete module name at point -@end multitable - -@node REPL, Documentation browser, Scheme buffers, Cheat sheet -@section REPL - -@multitable @columnfractions .20 .4 .4 -@headitem Key @tab Command @tab Description -@item C-c C-z -@tab @code{geiser-repl-switch} -@tab Start Scheme REPL, or jump to previous buffer -@item C-c M-o -@tab @code{geiser-repl-clear-buffer} -@tab Clear REPL buffer -@item C-c C-k -@tab @code{geiser-repl-interrupt} -@tab Interrupt REPL evaluation (signalling inferior scheme) -@item C-c C-q -@tab @code{geiser-repl-exit} -@tab Kill Scheme process -@item M-. -@tab @code{geiser-edit-symbol-at-point} -@tab Edit identifier at point -@item C-c C-l -@tab @code{geiser-load-file} -@tab Load scheme file -@item TAB -@tab @code{geiser-repl-tab-dwim} -@tab Complete, indent, or go to next error -@item S-TAB (backtab) -@tab @code{geiser-repl--previous-error} -@tab Go to previous error in the REPL buffer -@item M-TAB -@tab @code{completion-at-point} -@tab Complete identifier at point -@item M-`, C-. -@tab @code{geiser-capf-complete-module} -@tab Complete module name at point -@item C-c [, C-c C-[ -@tab @code{geiser-squarify} -@tab Toggle between () and [] for current form -@item C-c \, C-c C-\ -@tab @code{geiser-insert-lambda} -@tab Insert greek lambda or, with prefix, a lambda form -@item C-c C-r -@tab @code{geiser-add-to-load-path} -@tab Ask for a directory and add to Scheme load path -@item M-p, M-n -@tab (comint commands) -@tab Prompt history, matching current prefix -@item C-c M-p, C-c M-n -@tab (comint commands) -@tab Previous/next prompt inputs -@item C-c C-m -@tab @code{geiser-repl-switch-to-module} -@tab Set current module -@item C-c C-i -@tab @code{geiser-repl-import-module} -@tab Import module into current namespace -@item C-c C-d C-d -@tab @code{geiser-doc-symbol-at-point} -@tab See documentation for symbol at point -@item C-c C-d C-i -@tab @code{geiser-doc-look-up-manual} -@tab Look up manual for symbol at point -@item C-c C-d C-m -@tab @code{geiser-repl--doc-module} -@tab See documentation for module -@item C-c C-d C-a -@tab @code{geiser-autodoc-mode} -@tab Toggle autodoc mode -@end multitable - -@node Documentation browser, , REPL, Cheat sheet -@section Documentation browser - -@multitable @columnfractions .20 .4 .4 -@headitem Key @tab Command @tab Description -@item TAB, n -@tab @code{forward-button} -@tab Next link -@item S-TAB, p -@tab @code{backward-button} -@tab Previous link -@item N -@tab @code{geiser-doc-next-section} -@tab Next section -@item P -@tab @code{geiser-doc-previous-section} -@tab Previous section -@item f -@tab @code{geiser-doc-next} -@tab Next page -@item b -@tab @code{geiser-doc-previous} -@tab Previous page -@item k -@tab @code{geiser-doc-kill-page} -@tab Kill current page and go to previous or next -@item g, r -@tab @code{geiser-doc-refresh} -@tab Refresh page -@item c -@tab @code{geiser-doc-clean-history} -@tab Clear browsing history -@item ., M-. -@tab @code{geiser-doc-edit-symbol-at-point} -@tab Edit identifier at point -@item z -@tab @code{geiser-doc-switch-to-repl} -@tab Switch to REPL -@item q -@tab @code{View-quit} -@tab Bury buffer -@end multitable - -@ifhtml -@html -<hr> -@end html -@end ifhtml diff --git a/elpa/geiser-0.30/doc/dir b/elpa/geiser-0.30/doc/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, "?" 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 -* Geiser: (geiser). Emacs environment for Scheme hacking. diff --git a/elpa/geiser-0.30/doc/geiser.css b/elpa/geiser-0.30/doc/geiser.css @@ -1,116 +0,0 @@ -html { - padding:0px;margin:0px; - background-color:white; - color:black; - font-family:sans-serif; - line-height:160% -} - -body { - padding:10px 10% 10px 10%; - margin:0px; - text-align:justify; - /* width: 750px; */ -} - -a { color:black; weight=normal } -a:hover { color: #a22 } - -hr { height:0; color:white } - -h2 { - font-size:120%; - text-transform:uppercase -} - -h3 { - font-size:100%; - text-transform:uppercase -} - -pre.code { - display:block; - padding:0px; - margin-bottom:0px -} - -code { - background-color:rgb(250, 250, 250); - border:1px solid rgb(200, 200, 200); - padding-left:4px; - padding-right:4px -} - -pre.example { - background-color:rgb(250, 250, 250); - border:1px solid rgb(200, 200, 200); - padding-left:4px; - padding-right:4px; -} - -table { width: 100%; } - -img { - display:block; - margin:10px auto 10px auto; - border:none -} - -img.floatleft { - float: left; - margin: 4px; - padding-right: 1em; -} - -img.floatright { - float: right; - margin: 4px; - padding-left: 1em; -} - -ul { - list-style-type:square; - padding-left:1em; - margin-left:1em -} - -kbd { - font-weight: bold; -} - -div.navigation { - background-color: #efebe7; - line-height: 100%; - top-margin: 5px; - padding: 3px; - /* background-color: #000000; */ - /* border-top-style: solid; */ - /* border-bottom-style: solid; */ - /* border-width: 0px; */ - /* border-top-width: 4px; */ - /* border-color: rgb(200, 200, 200); */ -} - -div.version { - /* background-color: #efebe7; */ - line-height: 100%; - padding: 3px; - margin-right: 3px; - font-size: smaller; - float: right; - font-style: italic; -} - -div.version a { - text-decoration: none; -} - -.navlink { - text-decoration: none; - /* color: white; */ -} - -.index-cp { - line-height:120%; - font-size: smaller; -} diff --git a/elpa/geiser-0.30/doc/geiser.texi b/elpa/geiser-0.30/doc/geiser.texi @@ -1,124 +0,0 @@ -\input texinfo @c -*-texinfo-*- -@c %**start of header -@setfilename geiser.info -@c %**end of header - -@include macros.texi - -@copying -This manual documents Geiser, an Emacs environment to hack in Scheme. - -Copyright @copyright{} 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2018, 2020, 2021 Jose Antonio Ortega Ruiz - -@quotation -Permission is granted to copy, distribute and/or modify this document -under the terms of the GNU Free Documentation License, Version 1.3 -or any later version published by the Free Software Foundation; -with no Invariant Sections, no Front-Cover Texts, and no Back-Cover Texts. -A copy of the license is available from the Free Software -Foundation Web site at @url{http://www.gnu.org/licenses/fdl.html}. - -@end quotation - -The document was typeset with -@uref{http://www.gnu.org/software/texinfo/index.html, GNU Texinfo}. -@end copying - -@dircategory Emacs -@direntry -* Geiser: (geiser). Emacs environment for Scheme hacking. -@end direntry - -@titlepage -@title Geiser User Manual -@subtitle Emacs and Scheme talk to each other -@author Jose Antonio Ortega Ruiz -@page -@vskip 0pt plus 1filll -@insertcopying -@end titlepage - -@c Output the table of the contents at the beginning. -@contents - -@ifnottex -@node Top, Introduction, (dir), (dir) -@top Geiser - -@menu -* Introduction:: -* Installation:: -* The REPL:: -* Between the parens:: -* Cheat sheet:: -* No hacker is an island:: -* Index:: - -@detailmenu - --- The Detailed Node Listing --- - -Introduction - -* Modus operandi:: -* Showing off:: - -Installation - -* Must needs:: -* The quick and easy way:: -* From the source's mouth:: -* Friends:: - -The REPL - -* Starting the REPL:: -* First aids:: -* Switching context:: -* Completion and error handling:: -* Autodoc and friends:: -* Seeing is believing:: -* Customization and tips:: - -Between the parens - -* Activating Geiser:: -* The source and the REPL:: -* Documentation helpers:: -* To eval or not to eval:: -* To err perchance to debug:: -* Jumping around:: -* Geiser writes for you:: - -Cheat sheet - -* Scheme buffers:: -* REPL:: -* Documentation browser:: - -@end detailmenu -@end menu - -@include top.texi - -@html -<br/> -<div class="navigation" align="right"> -<a class="navlink" href="https://gitlab.com/groups/emacs-geiser/-/issues">Bugs</a> -<a class="navlink" href="https://gitlab.com/emacs-geiser">Source</a> -<a class="navlink" href="http://lists.nongnu.org/mailman/listinfo/geiser-users">Mailing list</a> -</div> -@end html - -@end ifnottex - -@include intro.texi -@include install.texi -@include repl.texi -@include parens.texi -@include cheat.texi -@include thanks.texi -@include index.texi - -@bye - -@c geiser.texinfo ends here diff --git a/elpa/geiser-0.30/doc/img/autodoc-multi.png b/elpa/geiser-0.30/doc/img/autodoc-multi.png Binary files differ. diff --git a/elpa/geiser-0.30/doc/img/autodoc-req.png b/elpa/geiser-0.30/doc/img/autodoc-req.png Binary files differ. diff --git a/elpa/geiser-0.30/doc/img/autodoc-scm.png b/elpa/geiser-0.30/doc/img/autodoc-scm.png Binary files differ. diff --git a/elpa/geiser-0.30/doc/img/autodoc-var.png b/elpa/geiser-0.30/doc/img/autodoc-var.png Binary files differ. diff --git a/elpa/geiser-0.30/doc/img/docstring-racket.png b/elpa/geiser-0.30/doc/img/docstring-racket.png Binary files differ. diff --git a/elpa/geiser-0.30/doc/img/docstring.png b/elpa/geiser-0.30/doc/img/docstring.png Binary files differ. diff --git a/elpa/geiser-0.30/doc/img/eval-error.png b/elpa/geiser-0.30/doc/img/eval-error.png Binary files differ. diff --git a/elpa/geiser-0.30/doc/img/geiser-mode.png b/elpa/geiser-0.30/doc/img/geiser-mode.png Binary files differ. diff --git a/elpa/geiser-0.30/doc/img/guile-eval-error.png b/elpa/geiser-0.30/doc/img/guile-eval-error.png Binary files differ. diff --git a/elpa/geiser-0.30/doc/img/mod-completion.png b/elpa/geiser-0.30/doc/img/mod-completion.png Binary files differ. diff --git a/elpa/geiser-0.30/doc/img/repl-autodoc.png b/elpa/geiser-0.30/doc/img/repl-autodoc.png Binary files differ. diff --git a/elpa/geiser-0.30/doc/img/repl-images.png b/elpa/geiser-0.30/doc/img/repl-images.png Binary files differ. diff --git a/elpa/geiser-0.30/doc/img/repl-menu.png b/elpa/geiser-0.30/doc/img/repl-menu.png Binary files differ. diff --git a/elpa/geiser-0.30/doc/img/repl-mod.png b/elpa/geiser-0.30/doc/img/repl-mod.png Binary files differ. diff --git a/elpa/geiser-0.30/doc/img/repls.png b/elpa/geiser-0.30/doc/img/repls.png Binary files differ. diff --git a/elpa/geiser-0.30/doc/index.texi b/elpa/geiser-0.30/doc/index.texi @@ -1,14 +0,0 @@ -@c This is part of Geiser's user manual., , No hacker is an island, Top -@c Copyright (C) 2010, 2011, 2021 Jose Antonio Ortega Ruiz -@c See the file geiser.texi for copying conditions. - -@node Index, , No hacker is an island, Top -@unnumbered Index -@cindex recursion -@printindex cp - - -@c Local Variables: -@c mode: texinfo -@c TeX-master: "geiser" -@c End: diff --git a/elpa/geiser-0.30/doc/install.texi b/elpa/geiser-0.30/doc/install.texi @@ -1,157 +0,0 @@ -@node Installation, The REPL, Introduction, Top -@chapter Installation - -@menu -* Must needs:: -* The quick and easy way:: -* From the source's mouth:: -* Friends:: -@end menu - -@node Must needs, The quick and easy way, Installation, Installation -@section Must needs - -@cindex supported versions -@cindex versions supported -If Geiser came with any guarantees, you'd break all of them by not using -GNU Emacs @value{EMACS_VERSION} (or better: i regularly use it with a -recent Emacs snapshot) and at least one of the supported Schemes, -namely: - -@itemize @bullet -@supimpl{Chez, http://www.scheme.com, 9.4,chez} -@supimpl{Chibi, http://synthcode.com/scheme/chibi, 0.7.3,chibi} -@supimpl{Chicken, http://call-cc.org, 4.8.0, chicken} -@supimpl{Gambit, http://gambitscheme.org/wiki/index.php/Main_Page, 4.9.3, gambit} -@supimpl{Gauche, http://practical-scheme.net/gauche/, 0.9.6, gauche} -@supimpl{Guile, http://www.gnu.org/software/guile, 2.2, guile} -@supimpl{GNU Kawa, http://www.gnu.org/software/kawa/index.html, 3.1, kawa} -@supimpl{MIT/GNU Scheme, https://www.gnu.org/software/mit-scheme, 9.0, mit} -@supimpl{Racket, http://www.racket-lang.org, 7.0, racket} -@supimpl{Stklos, https://stklos.net/, 1.50, stklos} -@end itemize - -Since Geiser supports multiple REPLs, having all of them will just add -to the fun. - -You'll also need Geiser itself. The quickest installation is via your -favourite implementation's ELPA packages (as of this writing, they're -all available in MELPA and (most of them) also in NonGNU ELPA, which -comes included with the batteries of Emacs 28 or better). - -@node The quick and easy way, From the source's mouth, Must needs, Installation -@section The quick and easy way - -@cindex quick install -@cindex ELPA -@cindex NonGNU ELPA -Did i mention that the easiest way of installing Geiser is using its -@uref{http://emacswiki.org/emacs/ELPA, ELPA} package? If you're using -Emacs 24, @uref{http://emacswiki.org/emacs/ELPA, ELPA} is already there; -for earlier versions, the page i just linked to twice will tell you -where to find the goodies. - -ELPA packages live in repositories accessible via HTTP. You can find -Geiser's package in either -@uref{https://elpa.nongnu.org/nongnu/geiser.html, NonGNU ELPA} or, if -you like living on the bleeding edge, @uref{http://melpa.org/#/geiser, -MELPA} (directly from the git repo). To tell Emacs that an ELPA repo -exists, you add it to @code{package-archives}@footnote{If you're using -Emacs 28 or better, @code{package-archives} already comes with the -non-gnu archive preconfigured, so you're lucky in more than one way.}: - -@example -(require 'package) - -(add-to-list 'package-archives - '("nongnu" . "https://elpa.nongnu.org/nongnu/")) - -(package-initialize) -@end example - -And then installing your favourite Geiser is as easy as (if, say, you're -a MIT aficionado): - -@example -M-x package-install RET geiser-mit RET -@end example - -Rinse and repeat for each of the scheme implementations that you would -like to use. Some of them (e.g. Gambit or Chicken) have a bit of -additional setup, specific to them, so make sure you also check their -respective package documentation. - -With that, you are pretty much all set up. See @ref{The REPL} to start -using Geiser. - -@ifnotinfo -And, by the way, if you prefer to keep reading this manual within Emacs, -@kbd{C-h i m Geiser RET} will bring you to the info version of it that -you just installed! -@end ifnotinfo - -@node From the source's mouth, Friends, The quick and easy way, Installation -@section Installing from source - -All Geiser packages are ready to be used out of the box without much -more ado. For the sake of concreteness, let's assume you put its source -in the directory @file{~/lisp/geiser}. All you need to do is to add the -following line to your Emacs initialisation file (be it @file{~/.emacs}, -@file{~/.emacs.d/init.el} or any of its moral equivalents): - -@example -(add-to-list 'load-path "~/lisp/geiser/elisp") -@end example - -and, if your, say, @code{geiser-gambit} checkout lives in -@file{~/lisp/geiser-mit} add to that: - -@example -(add-to-list 'load-path "~/lisp/geiser-gambit") -@end example - -The autoloads defined in those packages should be enough to start -scheming. - -@node Friends, , From the source's mouth, Installation -@section Friends - -Although Geiser does not need them, it plays well with (and is enhanced -by) the following Emacs packages: - -@cindex ac-geiser -@cindex autocomplete -@cindex paredit -@cindex company -@cindex macrostep -@itemize @bullet -@item @uref{http://www.emacswiki.org/emacs/ParEdit, Paredit}. -@anchor{paredit} -Regardless of whether you use Geiser or not, you shouldn't be coding -in any Lisp dialect without the aid of Taylor Campbell's structured -editing mode. -@item @uref{http://company-mode.github.io/, Company}. -Nikolaj Schumacher's and Dmitry Gutov's @code{company-mode} provides a -generic front-end for completion engines (such as Geiser's), with pretty -and automatic completion lists. -@item @uref{https://github.com/nbfalcon/macrostep-geiser, macrostep-geiser} -provides support for in-buffer macro expansion, using the -@uref{https://github.com/joddie/macrostep, macrostep} package. -@item @uref{https://github.com/xiaohanyu/ac-geiser/, ac-geiser} -If you prefer @code{auto-complete-mode} to @code{company-mode}, Xiao -Hanyu's @code{ac-geiser}, which provides a Geiser plugin for the -popular @uref{https://www.emacswiki.org/emacs/AutoComplete, Emacs Auto -Completion Mode}, is the package for you. Like Geiser, -@code{ac-geiser} is available in MELPA, and also as an -@code{el-get} package. -@end itemize - -@noindent -You just need to install and setup them as usual, for every package's -definition of usual. Geiser will notice their presence and react -accordingly. - -@c Local Variables: -@c mode: texinfo -@c TeX-master: "geiser" -@c End: diff --git a/elpa/geiser-0.30/doc/intro.texi b/elpa/geiser-0.30/doc/intro.texi @@ -1,97 +0,0 @@ -@node Introduction, Installation, Top, Top -@chapter Introduction - -Geiser is an Emacs environment to hack and have fun in Scheme. If that's -enough for you, see @ref{Installation} to get it running and -@ref{The REPL} for the fun part. - -@menu -* Modus operandi:: -* Showing off:: -@end menu - -@node Modus operandi, Showing off, Introduction, Introduction -@section Modus operandi - -@cindex modus operandi -As already mentioned, Geiser relies on a running Scheme process to -obtain the information it makes accessible to the programmer. There's -little effort, on the Elisp side, to understand, say, the module system -used by the Scheme implementation at hand; instead, a generic interface -between the two worlds is defined, and each supported Scheme includes a -library implementing that API, together with some wee shims in Elisp -allowing the reuse of the Emacs-side framework, which constitutes the -bulk of the code. - -@cindex current module -@anchor{current-module} While being as generic as possible, the -Scheme-Elisp interface makes some assumptions about the capabilities and -interaction mode of the corresponding REPL. In particular, Geiser -expects the latter to support namespaces in the form of a module system, -and to provide a well-defined way to establish the REPL's current -namespace (or module), as well as the current file's module (or -namespace). Thus, all evaluations performed by Geiser either in the -REPL or in a source code buffer happen in the context of the current -namespace. Every time you switch to a different file, you're switching -namespaces automatically; at the REPL, you must request the switch -explicitly (usually just using means provided by the Scheme -implementation itself). - -If your favourite Scheme supports the above modus operandi, it has all -that's needed for a bare-bones Geiser mode. But Geiser can, and will, -use any metadata available: procedure arities and argument lists to -display interactive help, documentation strings, location information to -jump to definitions, export lists to provide completion, and so on and -so forth. Although this is not an all-or-none proposition (Geiser can -operate with just part of that functionality available), i initially -concentrated in supporting those Schemes with the richest (to my -knowledge) introspection capabilities, namely, Guile and Racket. Later -on, Dan Leslie added support for Chicken, and several other schemes -followed suit. - -@node Showing off, , Modus operandi, Introduction -@section Showing off -@cindex swanking -When working with a fully conniving Scheme, Geiser can offer the -following functionality: - -@itemize @bullet -@item -Form evaluation in the context of the current file's module. -@item -Macro expansion. -@item -File/module loading and/or compilation. -@item -Namespace-aware identifier completion (including local bindings, names -visible in the current module, and module names). -@item -Autodoc: the echo area shows information about the signature of the -procedure/macro around point automatically. -@item -Jump to definition of identifier at point. -@item -Access to documentation (including docstrings when the implementation -provides it). -@item -Listings of identifiers exported by a given module. -@item -Listings of callers/callees of procedures. -@item -Rudimentary support for debugging (when the REPL provides a -debugger) and error navigation. -@item -Support for multiple, simultaneous REPLs. -@item -Support for image display in those Schemes that treat them as first -class values. -@end itemize - -In the following pages, i'll try to explain what these features -actually are (i'm just swanking here), and how to use them for your -profit. But, before that, let's see how to install Geiser. - -@c Local Variables: -@c mode: texinfo -@c TeX-master: "geiser" -@c End: diff --git a/elpa/geiser-0.30/doc/macros.texi b/elpa/geiser-0.30/doc/macros.texi @@ -1,47 +0,0 @@ -@set VERSION 0.20 -@set VERSION_NICK -@set RELEASE_DATE December 2021 -@set EMACS_VERSION 24.4 -@set GITLAB https://gitlab.com/emacs-geiser/ - -@macro supimpl{NAME,URL,VERS,NM} -@item -@uref{\URL\, \NAME\} \VERS\ or better, via @uref{@value{GITLAB}\NM\, geiser-\NM\} -@end macro - -@macro altr{LINK, TXT, TLINK, TRAIL} -@ifhtml -@ref{\LINK\,,\TXT\}\TRAIL\ -@end ifhtml -@ifinfo -@pxref{\LINK\,\TXT\}\TRAIL\ -@end ifinfo -@iftex -@ref{\TLINK\}\TRAIL\ -@end iftex -@ifdocbook -@ref{\TLINK\}\TRAIL\ -@end ifdocbook -@end macro - -@macro img{FILE, ALIGN} -@ifhtml -@html -<img src="img/\FILE\.png" class="float\ALIGN\"/> -@end html -@end ifhtml -@ifdocbook -@image{img/\FILE\,,,,.png} -@end ifdocbook -@end macro - -@macro imgc{FILE} -@ifhtml -@html -<img src="img/\FILE\.png"/> -@end html -@end ifhtml -@ifdocbook -@image{img/\FILE\,,,,.png} -@end ifdocbook -@end macro diff --git a/elpa/geiser-0.30/doc/makefile b/elpa/geiser-0.30/doc/makefile @@ -1,37 +0,0 @@ -# Copyright (C) 2010, 2020, 2021, 2022, 2023 Jose Antonio Ortega Ruiz -# -# This file is free software; as a special exception the author gives -# unlimited permission to copy and/or distribute it, with or without -# modifications, as long as this notice is preserved. -# -# This program is distributed in the hope that it will be useful, but -# WITHOUT ANY WARRANTY, to the extent permitted by law; without even the -# implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. - -top_srcdir=.. -output_dir=html -port ?= 8082 - -clean: - rm -f $(output_dir)/*.html - rm -f *.info - -web: - rm -f $(output_dir)/*.html - texi2any --output=$(output_dir) \ - --html \ - --css-ref=geiser.css \ - --no-headers \ - --no-number-sections \ - --no-node-files \ - --split=chapter \ - $(CURDIR)/geiser.texi && \ - cp -r $(CURDIR)/img ${output_dir} - -http: web - cd $(output_dir) && python -m http.server $(port) - -info: geiser.info dir - -%.info: %.texi - makeinfo --no-split $< -o $@ diff --git a/elpa/geiser-0.30/doc/parens.texi b/elpa/geiser-0.30/doc/parens.texi @@ -1,664 +0,0 @@ -@node Between the parens, Cheat sheet, The REPL, Top -@chapter Between the parens - -A good REPL is a must, but just about half the story of a good Scheme -hacking environment. Well, perhaps a bit more than a half; but, at any -rate, one surely needs also a pleasant way of editing source code. Don't -pay attention to naysayers: Emacs comes with an excellent editor -included for about any language on Earth, and just the best one when -that language is sexpy (especially if you use -@ifhtml -@ref{paredit,,Paredit}). -@end ifhtml -@ifnothtml -Paredit). -@end ifnothtml -Geiser's support for writing Scheme code adds to Emacs' -@code{scheme-mode}, rather than supplanting it; and it does so by means -of a minor mode (unimaginatively dubbed @code{geiser-mode}) that defines -a bunch of new commands to try and, with the help of the same Scheme -process giving you the REPL, make those Scheme buffers come to life. - -@menu -* Activating Geiser:: -* The source and the REPL:: -* Documentation helpers:: -* To eval or not to eval:: -* To err perchance to debug:: -* Jumping around:: -* Geiser writes for you:: -@end menu - -@node Activating Geiser, The source and the REPL, Between the parens, Between the parens -@section Activating Geiser - -@cindex geiser-mode -@img{geiser-mode, right} -With Geiser installed following any of the -procedures described in @ref{The quick and easy way} or @ref{From the -source's mouth}, Emacs will automatically activate @i{geiser-mode} when -opening a Scheme buffer. Geiser also instructs Emacs to consider files -with the extension @file{rkt} part of the family, so that, in principle, -there's nothing you need to do to ensure that Geiser's extensions will -be available, out of the box, when you start editing Scheme code. - -Indications that everything is working according to plan include the -'Geiser' minor mode indicator in your mode-line and the appearance of a -new entry for Geiser in the menu bar. If, moreover, the mode-line -indicator is the name of a Scheme implementation, you're indeed in a -perfect world; otherwise, don't despair and keep on reading: i'll tell -you how to fix that in a moment. - -@cindex geiser-mode commands -The menu provides a good synopsis of everything Geiser brings to the -party, including those keyboard shortcuts we Emacsers love. If you're -seeing the name of your favourite Scheme implementation in the -mode-line, have a running REPL and are comfortable with Emacs, you can -stop reading now and, instead, discover Geiser's joys by yourself. I've -tried to make Geiser as self-documenting as any self-respecting Emacs -package should be. If you follow this route, make sure to take a look at -Geiser's customization buffers (@kbd{M-x customize-group @key{RET} -geiser}): there's lot of fine-tuning available there. You might also -want to take a glance at -@ifhtml -our @ref{Cheat sheet,,cheat sheet}. -@end ifhtml -@ifnothtml -the tables in @pxref{Cheat sheet, our cheat sheet}. -@end ifnothtml - -Since @i{geiser-mode} is a minor mode, you can toggle it with -@kbd{M-x geiser-mode}, and control its activation in hooks with the -functions @code{turn-on-geiser-mode} and @code{turn-off-geiser-mode}. -If, for some reason i cannot fathom, you prefer @i{geiser-mode} not -to be active by default, customizing @code{geiser-mode-auto-p} to -@code{nil} will do the trick. - -@cindex scheme file extensions -And if you happen to use a funky extension for your Scheme files that is -not recognised as such by Emacs, just tell her about it with: - -@example -(add-to-list 'auto-mode-alist '("\\.funky-extension\\'" . scheme-mode)) -@end example - -@cindex useless wretch -Now, @i{geiser-mode} is just a useless wretch unless there's a running -Scheme process backing it up. Meaning that virtually all the commands it -provides require a REPL up and running, preferably corresponding to -the correct Scheme implementation. In the following section, we'll see -how to make sure that that's actually the case. - -@node The source and the REPL, Documentation helpers, Activating Geiser, Between the parens -@section The source and the REPL - -As i've already mentioned a couple of times, @i{geiser-mode} needs a -running REPL to be operative. Thus, a common usage pattern will be -for you to first call @code{geiser} -@ifhtml -(or @ref{choosing-impl,,one of its variants}), -@end ifhtml -@ifnothtml -(or one of its variants, e.g. @code{run-guile}), -@end ifnothtml -and then open some Scheme files; -but there's nothing wrong in first opening a couple Scheme buffers and -then starting the REPL (you can even find it more convenient, since -pressing @kbd{C-c C-z} in a Scheme buffer will start the REPL for -you). Since Geiser supports more than one Scheme implementation, though, -there's the problem of knowing which of them is to be associated with -each Scheme source file. Serviceable as it is, @i{geiser-mode} will try -to guess the correct implementation for you, according to the algorithm -described below. -@ifhtml -If you find that Geiser is already guessing right the Scheme -implementation, feel free to skip to the @ref{switching-repl-buff,,next -subsection}. -@end ifhtml - -@subsubheading How Geiser associates a REPL to your Scheme buffer -@cindex scheme implementation, choosing -@anchor{repl-association} To determine what Scheme implementation -corresponds to a given source file, Geiser uses the following algorithm: - -@enumerate -@item -If the file-local variable @code{geiser-scheme-implementation} is -defined, its value is used. A common way of setting buffer-local -variables is to put them in a comment near the beginning of the file, -surrounded by @code{-*-} marks, as in: - -@example -;; -*- geiser-scheme-implementation: guile -*- -@end example - -@item -If you've customized @code{geiser-active-implementations} so that it's a -single-element -@ifhtml -list (as explained in @ref{choosing-impl,,here}), -@end ifhtml -@ifnothtml -list, -@end ifnothtml -that element is used as the chosen implementation. -@item -The contents of the file is scanned for hints on its associated -implementation. For instance, files that contain a @code{#lang} -directive will be considered Racket source code, while those with a -@code{define-module} form in them will be assigned to a Guile REPL. -@item -The current buffer's file name is checked against the rules given in -@code{geiser-implementations-alist}, and the first match is applied. You -can provide your own rules by customizing this variable, as explained -below. -@item -If we haven't been lucky this far and you have customized -@code{geiser-default-implementation} to the name of a supported -implementation, we'll follow your lead. -@item -See? That's the problem of being a smart aleck: one's always outsmarted -by people around. At this point, @i{geiser-mode} will humbly give up and -ask you to explicitly choose the Scheme implementation. -@end enumerate - -As you can see in the list above, there are several ways to influence -Geiser's guessing by means of customizable variables. The most direct (and -most impoverishing) is probably limiting the active implementations to a -single one, while customizing @code{geiser-implementations-alist} is the -most flexible (and, unsurprisingly, also the most complex). Here's the -default value for the latter variable: - -@example -(((regexp "\\.scm$") guile) - ((regexp "\\.ss$") racket) - ((regexp "\\.rkt$") racket)) -@end example - -@noindent -which describes the simple heuristic that files with @file{.scm} as -extension are by default associated to a Guile REPL while those ending -in @file{.ss} or @file{.rkt} correspond to Racket's implementation (with -the caveat that these rules are applied only if the previous heuristics -have failed to detect the correct implementation, and that they'll match -only if the corresponding implementation is active). You can add rules -to @code{geiser-implementations-alist} (or replace all of them) by -customizing it. Besides regular expressions, you can also use a -directory name; for instance, the following snippet: - -@example -(eval-after-load "geiser-impl" - '(add-to-list 'geiser-implementations-alist - '((dir "/home/jao/prj/frob") guile))) -@end example - -@noindent -will add a new rule that says that any file inside my -@file{/home/jao/prj/frob} directory (or, recursively, any of its -children) is to be assigned to Guile. Since rules are first matched, -first served, this new rule will take precedence over the default ones. - -@cindex autostart REPL -@cindex start REPL, automatically -A final tip: if you want Geiser to start automatically a REPL for you if -it notices that there's no one active when it enters @i{geiser-mode}, -you can customize @code{geiser-mode-start-repl-p} to @code{t}. - -@subsubheading Managing multiple scheme projects -@cindex dir-locals -@cindex project.el -@cindex projectile -@cindex projects -@anchor{repl-per-project} By default, Geiser will re-use a single REPL -for all buffers sharing the same scheme implementation. This works well -enough in many cases, but may become problematic (or at least annoying) -when working on multiple projects with separate dependencies and include -paths. - -@cindex geiser-repl-per-project-p -Geiser provides optional support for using separate REPLs for each -project, which can be enabled by customizing -@code{geiser-repl-current-project-function} and selecting your Emacs -project-management library of choice (eg. @code{project.el} or -@code{projectile}). With this configured, if you want new REPLs to -automatically associate themselves with the current project, so that all -Geiser commands will ignore REPLs that are not associated with the -project, customize the toggle @code{geiser-repl-per-project-p} to -@code{t} and you're all set up. - -@cindex geiser-repl-add-project-path-p -This can be very convenient when used with a @file{.dir-locals.el} in -the project root to set include paths, ensuring that Geiser REPLs will -always know where to find your project's modules or dependencies. -Geiser automatically handles the common case of the project root -belonging to the load path: unless you tell it otherwise (using the -customisable flag @code{geiser-repl-add-project-path-p}, which defaults -to @code{t}), it will add the result of calling -@code{geiser-repl-current-project-function} to the REPLs load path on -startup. - -@subsubheading Switching between source files and the REPL -@cindex switching to REPL -@cindex switching to source -@anchor{switching-repl-buff} Once you have a working @i{geiser-mode}, -you can switch from Scheme source buffers to the REPL or @kbd{C-c -C-z}. Those shortcuts map to the interactive command -@code{geiser-repl-switch}. - -@cindex switching to module -If you use a numeric prefix, as in @kbd{C-u C-c C-z}, besides being -teleported to the REPL, the latter will switch to the namespace of the -Scheme source file, as if you had used @kbd{C-c C-m} in the REPL, with -the source file's module as argument; -cf. discussion in -@altr{Switching context,,Switching context,. This} -command is also bound to @kbd{C-c C-a}. - -Once you're in the REPL, the same @kbd{C-c C-z} shortcut will bring -you back to the buffer you jumped from, provided you don't kill the -Scheme process in between. This is why the command is called -@i{geiser-repl-switch} instead of @i{switch-to-repl}, and what makes it -really handy, if you ask me. - -@cindex switching schemes -If for some reason you're not happy with the Scheme implementation that -Geiser has assigned to your file, you can change it with @kbd{C-c C-s}, -and you probably should take a look at -@ifhtml -@ref{repl-association,,the previous subsection} -@end ifhtml -@ifnothtml -the previous subsection -@end ifnothtml -to make sure that Geiser -doesn't get confused again. - -@subsubheading A note about context -As explained before (@pxref{Modus operandi}), all Geiser activities take -place in the context of the @i{current namespace}, which, for Scheme -buffers, corresponds to the module that the Scheme implementation -associates to the source file at hand (for instance, in Racket, there's -a one-to-one correspondence between paths and modules, while Guile -relies on explicit @code{define-module} forms in the source file). - -Now that we have @code{geiser-mode} happily alive in our Scheme buffers -and communicating with the right REPL instance, let us see what it -can do for us, besides jumping to and fro. - -@node Documentation helpers, To eval or not to eval, The source and the REPL, Between the parens -@section Documentation helpers - -@subsubheading Autodoc redux - -@cindex autodoc, in scheme buffers -The first thing you will notice by moving around Scheme source is that, -every now and then, the echo area lights up with the same autodoc -messages we know and love from our REPL forays. This happens every -time the Scheme process is able to recognise an identifier in the -buffer, and provide information either on its value (for variables) or -on its arity and the name of its formal arguments (for procedures and -macros). That information will only be available if the module the -identifier belongs to has been loaded in the running Scheme image. So it -can be the case that, at first, no autodoc is shown for identifiers -defined in the file you're editing. But as soon as you evaluate them -(either individually or collectively using any of the devices described -in @ref{To eval or not to eval}) their signatures will start appearing -in the echo area. - -@cindex disabling autodoc -@cindex manual autodoc -Autodoc activation is controlled by a minor mode, @code{geiser-autodoc}, -which you can toggle with @kbd{M-x geiser-autodoc-mode}, or its associated -keyboard shortcut, @kbd{C-c C-d a}. That @t{/A} indicator in the -mode-line is telling you that autodoc is active. If you prefer that it -be inactive by default (e.g., because you're connecting to a really -remote scheme and want to minimize network exchanges), just set -@code{geiser-mode-autodoc-p} to @code{nil} in your customization files. -Even when autodoc mode is off, you can use @code{geiser-autodoc-show}, -bound by default to @kbd{C-c C-d s}, to show the autodoc string for the -symbol at point. - -@cindex autodoc explained -@img{autodoc-scm, right} -The way autodoc displays information deserves -some explanation. It will first show the name of the module where the -identifier at hand is defined, followed by a colon and the identifier -itself. If the latter corresponds to a procedure or macro, it will be -followed by a list of argument names, starting with the ones that are -required. Then there comes a list of optional arguments, if any, -enclosed in parentheses. When an optional argument has a default value -(or a form defining its default value), autodoc will display it after -the argument name. When the optional arguments are keywords, their names -are prefixed with ``#:'' (i.e., their names @i{are} keywords). An -ellipsis (@dots{}) serves as a marker of an indeterminate number of -parameters, as is the case with @i{rest} arguments or when autodoc -cannot fathom the exact number of arguments (this is often the case with -macros defined using @code{syntax-case}). Another way in which autodoc -displays its ignorance is by using an underscore to display parameters -whose name is beyond its powers. - -@img{autodoc-multi, right} -It can also be the case that a function or -macro has more than one signature (e.g., functions defined using -@code{case-lambda}, or some @code{syntax-rules} macros, for which Geiser -has often the black magic necessary to retrieve their actual arities). -In those cases, autodoc shows all known signatures (using the above -rules for each one) separated by a vertical bar (|). - -As you have already noticed, the whole autodoc message is enclosed in -parentheses. After all, we're talking about Scheme here. - -@cindex autodoc for variables -@img{autodoc-var, right} -Finally, life is much easier when your cursor -is on a symbol corresponding to a plain variable: you'll see in the echo -area its name, preceded by the module where it's defined, and followed -by its value, with an intervening arrow for greater effect. This time, -there are no enclosing parentheses (i hope you see the logic in my -madness). - -@cindex autodoc customized -You can change the way Geiser displays the module/identifier combo by -customizing @code{geiser-autodoc-identifier-format}. For example, if you -wanted a tilde surrounded by spaces instead of a colon as a separator, -you would write something like: - -@example -(setq geiser-autodoc-identifier-format "%s ~ %s") -@end example - -@noindent -in your Emacs initialisation files. There's also a face -(@code{geiser-font-lock-autodoc-identifier}) that you can customize (for -instance, with @kbd{M-x customize-face}) to change the appearance of the -text. And another one (@code{geiser-font-lock-autodoc-current-arg}) that -controls how the current argument position is highlighted. - -@subsubheading Other documentation commands - -@anchor{doc-browser}Sometimes, autodoc won't provide enough information -for you to understand what a function does. In those cases, you can ask -Geiser to ask the running Scheme for further information on a given -identifier or module. - -@cindex documentation for symbol -@cindex docstrings, maybe -For symbols, the incantation is @kbd{M-x geiser-doc-symbol-at-point}, or -@kbd{C-c C-d C-d} for short. If the associated Scheme supports -docstrings (as, for instance, Guile does), you'll be teleported to a new -Emacs buffer displaying Geiser's documentation browser, filled with -information about the identifier, including its docstring (if any; -unfortunately, that an implementation supports docstrings doesn't mean -that they're used everywhere). - -@imgc{docstring} - -Pressing @kbd{q} in the documentation buffer will bring you back, -enlightened, to where you were. There's also a handful of other -navigation commands available in that buffer, which you can discover by -means of its menu or via the good old @kbd{C-h m} command. And feel free -to use the navigation buttons and hyperlinks that justify my calling -this buffer a documentation browser. - -For Racket, which does not support docstrings out of the box, this -command will provide less information, but the documentation browser -will display the corresponding contract when it's available, as well as -some other tidbits for re-exported identifiers. - -@imgc{docstring-racket} - -You can also ask Geiser to display information about a module, in the -form of a list of its exported identifiers, using @kbd{C-c C-d C-m}, -exactly as you would do in -@altr{repl-mod,the REPL,The REPL,.} - -In both cases, the documentation browser will show a couple of buttons -giving you access to further documentation. First, you'll see a button -named @i{source}: pressing it you'll jump to the symbol's definition. -The second button, dubbed @i{manual}, will open the Scheme -implementation's manual page for the symbol at hand. For Racket, that -will open your web browser displaying the corresponding reference's page -(using the HTML browser in Racket's configuration, which you can edit in -DrRacket's preferences dialog, or by setting -@code{plt:framework-pref:external-browser} directly in -@file{~/.racket/racket-prefs.rktd}), while in Guile a lookup will be -performed in the texinfo manual. - -@cindex Guile info nodes -For Guile, the manual lookup uses the info indexes in the standard -Guile info nodes, which are usually named ``guile'' or ``guile-2.0''. -If yours are named differently, just add your name to the customizable -variable @code{geiser-guile-manual-lookup-nodes}. - -A list of all navigation commands in the documentation browser is -available in -@altr{Documentation browser,our cheat-sheet,Documentation browser,.} - -@cindex opening manual pages -You can also skip the documentation browser and jump directly to the -manual page for the symbol at point with the command -@code{geiser-doc-look-up-manual}, bound to @kbd{C-c C-d i}. - -@node To eval or not to eval, To err perchance to debug, Documentation helpers, Between the parens -@section To eval or not to eval - -@cindex philosophy -@cindex incremental development -One of Geiser's main goals is to facilitate incremental development. -You might have noticed that i've made a big fuss of Geiser's ability to -recognize context, by dint of being aware of the namespace where its -operations happen. - -That awareness is especially important when evaluating code in your -scheme buffers, using the commands described below. They allow you to -send code to the running Scheme with a granularity ranging from whole -files to single s-expressions. That code will be evaluated in the module -associated with the file you're editing, allowing you to redefine values -and procedures to your heart's (and other modules') content. - -@cindex incremental development, evil -Macros are, of course, another kettle of fish: one needs to re-evaluate -uses of a macro after redefining it. That's not a limitation imposed by -Geiser, but a consequence of how macros work in Scheme (and other -Lisps). There's also the risk that you lose track of what's actually -defined and what's not during a given session. But, -@uref{https://jaortega.wordpress.com/2009/03/29/from-my-cold-prying-hands, -in my opinion}, those are limitations we lispers are aware of, and they -don't force us to throw the baby with the bathwater and ditch -incremental evaluation. Some people disagree; if you happen to find -@uref{https://blog.racket-lang.org/2009/03/the-drscheme-repl-isnt-the-one-in-emacs.html, -their arguments} convincing, you don't have to throw away Geiser -together with the baby: @kbd{M-x geiser-restart-repl} will let you -restart the REPL as many times as you see fit. Moreover, you can invoke -@kbd{geiser-compile-current-buffer} and @kbd{geiser-load-current-buffer} -with a prefix argument (that'd be something like @kbd{C-u C-c C-k} for -compilation, for instance), to tell Geiser to restart the REPL -associated with a buffer before compiling or loading its current -contents. - -@cindex evaluation -@cindex incremental development, not evil -For all of you auld bearded lispers still with me, here are some of the -commands performing incremental evaluation in Geiser. - -@code{geiser-eval-last-sexp}, bound to @kbd{C-x C-e}, will eval the -s-expression just before point. If you use a prefix, as in @kbd{C-u C-x -C-e}, besides evaluating it the expression is inserted in the the -buffer. - -@code{geiser-eval-definition}, bound to @kbd{C-M-x}, finds the topmost -definition containing point and sends it for evaluation. The variant -@code{geiser-eval-definition-and-go} (@kbd{C-c M-e}) works in the same -way, but it also teleports you to REPL after the evaluation. - -@code{geiser-eval-region}, bound to @kbd{C-c C-r}, evals the current -region. Again, there's an @i{and-go} version available, -@code{geiser-eval-region-and-go}, bound to @kbd{C-c M-r}. And, if you -want to extend the evaluated region to the whole buffer, there is -@code{geiser-eval-buffer}, bound to @kbd{C-c C-b} and its companion -@code{geiser-eval-buffer-and-go}, bound to @kbd{C-c M-b}. - -@cindex evaluating images -@cindex image display -For all the commands above, the result of the evaluation is displayed in -the minibuffer, unless it causes a (Scheme-side) error (@pxref{To err -perchance to debug}), or, for schemes supporting them (such as Racket), -the evaluation yields an image, in which case you'll see it in popping -up in the Geiser debug buffer (if your Emacs runs under the auspices of -a graphical toolkit), or via an external viewer if you set -@code{geiser-image-viewer} to the path of an appropriate visualization -program (see also @ref{Seeing is believing} for more on image support). - -At the risk of repeating myself, i'll remind you that all these -evaluations will take place in the namespace of the module corresponding -to the Scheme file from which you're sending your code, which, in -general, will be different from the REPL's current module. And, if all -goes according to plan, (re)defined variables and procedures should be -immediately visible inside and, if exported, outside their module. - -Besides evaluating expressions, definitions and regions, you can also -macro-expand them. The corresponding key bindings start with the prefix -@kbd{C-c C-m} and end, respectively, with @kbd{C-e}, @kbd{C-x} and -@kbd{C-r}. The result of the macro expansion always appears in a pop up -buffer. - -@cindex interrupt evaluation -All the evaluations and expansions performed by the commands above are -asynchronous@footnote{For local REPLs, where we can easily send an -interrupt signal to the scheme process; remote REPLs are another kettle -of fish in this regard, and generally interruptions are supported: -you'll just have to kill the connection if caught in a loop.}, so that -you can move around while the answer is being computed. The command -@code{geiser-eval-interrupt}, bound to @kbd{C-c C-i} will interrupt any -on-going evaluation and, when the scheme implementation supports a -debugger, bring you to a buffer where you can perform buffer actions in -the interrupted evaluation's context. - -Oh, didn't i mention we have support for debuggers? Let's talk about -that next. - -@node To err perchance to debug, Jumping around, To eval or not to eval, Between the parens -@section To err: perchance to debug - -@cindex to err is schemey -@cindex backtraces -When an error occurs during evaluation, it will be reported according to -the capabilities of the underlying Scheme REPL. - -@cindex error buffer -In most schemes, you'll be presented with a backtrace, in a new buffer -where file paths locating the origin of the error are click-able (you -can navigate them using the @key{TAB} key, and use @key{RET} or the -mouse to jump to the offending spot; or invoke Emacs' stock commands -@code{next-error} and @code{previous-error}, bound to @kbd{M-g n} and -@kbd{M-g p} by default). - -@imgc{eval-error} - -By default, Geiser will tele-transport your pointer to the debug buffer: -if you prefer to stay in the source buffer, set -@code{geiser-debug-jump-to-debug} to nil. - -For schemes with good debug support (Guile is one), the debug buffers -offer a @i{debugging menu}, accessible via the @code{,} (that's a comma) -key. If you press it, a transient menu will appear, offering you a -variety of actions, including showing local variable values or a more -detailed backtrace or frame display. This is the same interface you'll -encounter the in case of interrupted evaluations, either by your -explicit @kbd{C-c C-i} command or because a breakpoint has been -previously set. - -In addition, Geiser will sometimes report warnings for otherwise -successful evaluations. In those cases, it won't enter the debugger, -just report the warnings in a debug buffer. - -@node Jumping around, Geiser writes for you, To err perchance to debug, Between the parens -@section Jumping around - -@cindex jumping in scheme buffers -This one feature is as sweet as it is easy to explain: @kbd{M-.} -(@code{geiser-edit-symbol-at-point}) will open the file where the -identifier around point is defined and land your point on its -definition. To return to where you were, press @kbd{M-,} -(@code{geiser-pop-symbol-stack}). This command works also for module -names: Geiser first tries to locate a definition for the identifier at -point and, if that fails, a module with that name; if the latter -succeeds, the file where the module is defined will pop up. - -Sometimes, the underlying Scheme will tell Geiser only the file where -the symbol is defined, but Geiser will use some heuristics (read, -regular expressions) to locate the exact line and bring you there. Thus, -if you find Geiser systematically missing your definitions, send a -message to the @email{geiser-users@@nongnu.org, mailing list}, and we'll -try to make the algorithm smarter. - -@cindex jumping customized -You can control how the destination buffer pops up by setting -@code{geiser-edit-symbol-method} to either @code{nil} (to open the file -in the current window), @code{'window} (other window in the same frame) -or @code{'frame} (in a new frame). - -@node Geiser writes for you, , Jumping around, Between the parens -@section Geiser writes for you - -@cindex completion in scheme buffers -No self-respecting programming mode would be complete without -completion. In geiser-mode, identifier completion is bound to -@kbd{M-@key{TAB}}, and will offer all visible identifiers starting with -the prefix before point. Visible here means all symbols imported or -defined in the current namespace plus locally bound ones. E.g., if -you're at the end of the following partial expression: - -@example -(let ((default 42)) - (frob def -@end example - -@noindent -and press @kbd{M-@key{TAB}}, one of the possible completions will be -@code{default}. - -@cindex partial completion -After obtaining the list of completions from the running Scheme, Geiser -uses the standard Emacs completion machinery to display them. That -means, among other things, that partial completion is available: just -try to complete @code{d-s} or @code{w-o-t-s} to see why this is a good -thing. Partial completion won't work if you have disabled it globally in -your Emacs configuration: if you don't know what i'm talking about, -never mind: Geiser's partial completion will work for you out of the -box. - -@cindex smart tabs -If you find the @kbd{M} modifier annoying, you always have the option to -activate @code{geiser-smart-tab-mode}, which will make the @key{TAB} key -double duty as the regular Emacs indentation command (when the cursor is -not near a symbol) and Geiser's completion function. If you want this -smarty pants mode always on in Scheme buffers, customize -@code{geiser-mode-smart-tab-p} to @code{t}. - -@cindex completion for module names -Geiser also knows how to complete module names: if no completion for the -prefix at point is found among the currently visible bindings, it will -try to find a module name that matches it. You can also request -explicitly completion only over module names using @kbd{M-`} (that's a -backtick). - -Besides completion, there's also this little command, -@code{geiser-squarify}, which will toggle the delimiters of the -innermost list around point between round and square brackets. It is -bound to @kbd{C-c C-e [}. With a numeric prefix (as in, say, @kbd{M-2 -C-c C-e [}), it will perform that many toggles, forward for positive -values and backward for negative ones. - -@subheading Caveat about completion - -It is possible for Geiser to hang your Emacs process when trying to -complete symbols. This can happen in the REPL itself or even in a -Scheme buffer that is attached to the REPL process. For more details -on how to fix this problem, @ref{completion-caveat,,Caveat about -completion & the REPL} - -@c Local Variables: -@c mode: texinfo -@c TeX-master: "geiser" -@c End: diff --git a/elpa/geiser-0.30/doc/repl.texi b/elpa/geiser-0.30/doc/repl.texi @@ -1,534 +0,0 @@ -@node The REPL, Between the parens, Installation, Top -@chapter The REPL -@anchor{quick-start} -If you've followed the instructions in @ref{Installation}, your Emacs is -now ready to start playing. Otherwise, i'll wait for you: when you're -ready, just come back here and proceed to the following sections. - -@menu -* Starting the REPL:: -* First aids:: -* Switching context:: -* Completion and error handling:: -* Autodoc and friends:: -* Seeing is believing:: -* Customization and tips:: -@end menu - -@node Starting the REPL, First aids, The REPL, The REPL -@section Starting the REPL - -@cindex REPL -To start a Scheme REPL (meaning, a Scheme process offering you a -Read-Eval-Print Loop), Geiser provides the generic interactive command -@command{geiser}. If you invoke it (via, as is customary in Emacs, -@kbd{M-x geiser}), you'll be saluted by a prompt asking which one of -the supported implementations you want to launch---yes, you can stop the -asking, see -@altr{active-implementations,below,Customization and tips,.} -Tabbing for completion will offer you, as of this writing, @code{guile}, -@code{racket}, @code{chicken}, @code{mit}, @code{chibi} and @code{chez}. -Just choose your poison, and a new REPL buffer will pop up (by default, -the REPL will appear in a new window: if that annoys you, just set -@code{geiser-repl-use-other-window} to @code{nil} and the current window -will be used). - -@imgc{repls} - -If all went according to plan, you'll be facing an -implementation-dependent banner, followed by an interactive prompt. -Going according to plan includes having the executable of the Scheme you -chose in your path. If that's not the case, you can tell Emacs where it -is, as described in -@altr{impl-binary,a moment,Customization and tips,.} -Returning to our REPL, the first thing to notice is that the funny -prompt is telling you your current module: its name is the part just -after the @@ sign (in Guile, that means @code{guile-user}, while -Racket's and Chicken's top namespaces don't have a name; -cf. discussion in -@altr{Switching context,,Switching context,).} -Other than that, this is pretty much equivalent to having a -command-line interpreter in a terminal, with a bunch of add-ons that -we'll be reviewing below. You can start typing sexps right there: -Geiser will only dispatch them for evaluation when they're complete, -and will indent new lines properly until then. It will also keep -track of your input, maintaining a history file that will be reloaded -whenever you restart the REPL. - -@cindex REPL, faces -@cindex faces, in the REPL -If you're not happy with the faces Geiser is using for the REPL's prompt -and evaluated input, you can customise -@code{geiser-font-lock-repl-prompt} and -@code{geiser-font-lock-repl-input} to better-looking faces. - -@subsubheading Connecting to an external Scheme -@cindex remote REPL -@cindex connect to server -There's an alternative way of starting a Geiser REPL: you can connect to -an external Scheme process, provided it's running a REPL server at some -known port. How to make that happen depends on the Scheme implementation. - -@cindex Guile's REPL server -If you use Guile, you just need to start your Guile process (possibly -outside Emacs) passing to it the flag @code{--listen}. This flag accepts -an optional port as argument (as in @code{--listen=1969}), if you don't -want to use the default. - -@cindex Racket's REPL server -In Racket, you have to use the REPL server that comes with Geiser. To -that end, put Geiser's Racket @file{scheme} directory in Racket's -collection search path and invoke @code{start-geiser} (a procedure in -the module @code{geiser/server}) somewhere in your program, passing it -the desired port and, if desired, network interface name. This -procedure will start the REPL server in a separate thread. For an -example of how to do that, see the script @file{bin/geiser-racket.sh} in -the source distribution, or, if you've compiled Geiser, -@file{bin/geiser-racket-noinst} in the build directory, or, if you've -installed Geiser, @file{geiser-racket} in -@file{<installation-prefix>/bin}. These scripts start a new interactive -Racket that is also running a REPL server (they also load the errortrace -library to provide better diagnostics, but that's not strictly needed). - -With your external Scheme process running and serving, come back to -Emacs and execute @kbd{M-x geiser-connect}, @kbd{M-x connect-to-guile} -or @kbd{M-x connect-to-racket}. You'll be asked for a host and a port, -and, voila, you'll have a Geiser REPL that is served by the remote -Scheme process in a dedicated thread, meaning that your external program -can go on doing whatever it was doing while you tinker with it from -Emacs. Note, however, that all Scheme threads share the heap, so that -you'll be able to interact with those other threads in the running -Scheme from Emacs in a variety of ways. For starters, all your -(re)definitions will be visible everywhere. That's dangerous, but will -come in handy when you need to debug your running web server. - -@cindex remote connections -The connection between Emacs and the Scheme process goes over TCP, so it -can be as remote as you need, perhaps with the intervention of an SSH -tunnel. - -@node First aids, Switching context, Starting the REPL, The REPL -@section First aids - -@img{repl-menu, right} -@cindex REPL commands -A quick way of seeing what else Geiser's REPL can do for you, is to -display the corresponding entry up there in your menu bar. No, i don't -normally use menus either; but they can come in handy until you've -memorized Geiser's commands, as a learning device. And yes, i usually -run Emacs inside a terminal, but one can always use -@uref{http://www.emacswiki.org/emacs/LaCarte, La Carte} to access the -menus in a convenient enough fashion. - -Or just press @kbd{C-h m} and be done with that. - -Among the commands at your disposal, we find the familiar input -navigation keys, with a couple twists. By default, @kbd{M-p} and -@kbd{M-n} are bound to @i{matching} items in your input history. That -is, they'll find the previous or next sexp that starts with the current -input prefix (defined as the text between the end of the prompt and your -current position, a.k.a. @dfn{point}, in the buffer). For going up and -down the list unconditionally, just use @kbd{C-c M-p} and @kbd{C-c M-n}. -In addition, navigation is sexp-based rather than line-based. - -There are also a few commands to twiddle with the Scheme process. -@kbd{C-c C-q} will gently ask it to quit, while @kbd{C-u C-c C-q} will -mercilessly kill the process (but not before stowing your history in the -file system). Unless you're using a remote REPL, that is, in which case -both commands will just sever the connection and leave the remote -process alone. If worse comes to worst and the process is dead, @kbd{C-c -C-z} will restart it. However, the same shortcut, issued when the REPL is -alive, will bring you back to the buffer you came from, as explained -in -@altr{switching-repl-buff,this section,The source and the REPL,.} - -The remaining commands are meatier, and deserve sections of their own. - -@node Switching context, Completion and error handling, First aids, The REPL -@section Switching context - -@cindex current module, in REPL -@cindex ,enter vs. enter! -In tune with Geiser's -@ifhtml -@ref{current-module,,modus operandi}, -@end ifhtml -@ifnothtml -@i{modus operandi}, -@end ifnothtml -evaluations in the REPL take place in the namespace of the current -module. As noted above, the REPL's prompt tells you the name of the -current module. To switch to a different one, you can use the command -@command{geiser-repl-switch-to-module}, bound to @kbd{C-c C-m}. You'll -notice that Geiser simply uses a couple of meta-commands provided by -the Scheme REPL (the stock @command{,m} in Guile and Chicken and the -(geiser-defined) @command{,enter} in Racket), and that it doesn't even -try to hide that fact. That means that you can freely use said native -ways directly at the REPL, and Geiser will be happy to oblige. In -Racket, @command{,enter} works like Racket's standard @code{enter!} -form, but you can also provide a path string as its argument (e.g., -@command{,enter "/tmp/foo.rkt"} is equivalent to @command{,enter (file -"/tmp/foo.rkt")}). Like @code{enter!}, @command{,enter} accepts also -module names (as in, say, @command{,enter geiser/main}). As -mentioned, in Guile and Chicken, @command{,m} is used @i{as is}. - -@cindex current module, change -Once you enter a new module, only those bindings visible in its -namespace will be available to your evaluations. All Schemes supported -by Geiser provide a way to import new modules in the current namespace. -Again, there's a Geiser command, @command{geiser-repl-import-module}, to -invoke such functionality, bound this time to @kbd{C-c C-i}. And, again, -you'll see Geiser just introducing the native incantation for you, and -you're free to use such incantations by hand whenever you want. - -One convenience provided by these two Geiser commands is that completion -is available when introducing the new module name, using the -@kbd{@key{TAB}} key. Pressing it at the command's prompt will offer you -a prefix-aware list of available module names. - -@imgc{mod-completion} - -Which brings me to the next group of REPL commands. - -@node Completion and error handling, Autodoc and friends, Switching context, The REPL -@section Completion and error handling - -@cindex completion, at the REPL -We've already seen Geiser completion of module names in action at the -minibuffer. You won't be surprised to know that it's also available at -the REPL buffer itself. There, you can use either @kbd{C-.} or -@kbd{M-`} to complete module names, and @kbd{@key{TAB}} or -@kbd{M-@key{TAB}} to complete identifiers. Geiser will know what -identifiers are bound in the current module and show you a list of those -starting with the prefix at point. Needless to say, this is not a static -list, and it will grow as you define or import new bindings in the -namespace at hand. If no completion is found, @kbd{@key{TAB}} will try -to complete the prefix after point as a module name. - -REPL buffers use Emacs' compilation mode to highlight errors reported by -the Scheme interpreter, and you can use the @command{next-error} command -(@kbd{M-g n}) to jump to their location. By default, every time you -enter a new expression for evaluation old error messages are forgotten, -so that @kbd{M-g n} will always jump to errors related to the last -evaluation request, if any. If you prefer a not-so-forgetful REPL, set -the customization variable @code{geiser-repl-forget-old-errors-p} to -@code{nil}. Note, however, that even when that variable is left as -@kbd{t}, you can always jump to an old error by moving to its line at -the REPL and pressing @kbd{@key{RET}}. When your cursor is away from -the last prompt, @kbd{@key{TAB}} will move to the next error in the -buffer, and you can use @kbd{@key{BACKTAB}} everywhere to go to the -previous one. - -@subheading Caveat about completion & the REPL -@anchor{completion-caveat} - -It is possible for Geiser to hang your Emacs process when trying to -complete symbols. This can happen in the REPL itself or even in a -Scheme buffer that is attached to the REPL process. If this happens, -you've probably entered a module that changes the REPL prompt from -what Geiser was expecting to see. - -Unfortunately, there's no general solution for this issue right now (as -it is a daunting task to try to make a regexp that can encompass all -possible REPL prompts). The best solution for now is to fix this issue -on a case-by-case basis by adjusting your prompt regexp variable so -that it matches the default prompt as well as your Scheme module's -special prompt. - -For example, XREPL is a Racket module that implements a better Racket -REPL. You might be interested in toying around with some of its -functions, but when you try to enter XREPL via, say, @kbd{C-c C-m -xrepl}, you'll notice that the REPL prompt has changed to something -like this: - -@example -<pkgs>/xrepl-lib/xrepl/main> -@end example - -If you start typing symbols, and then you try to auto-complete those -symbols, your Emacs process may hang. This is because Geiser expects -the REPL prompt to match this regexp (for Racket): - -@example -"\\(mzscheme\\|racket\\)@@[^ ]*> " -@end example - -Therefore, we can fix this issue by changing our default prompt regexp -like so: - -@example -(setq geiser-racket--prompt-regexp "<pkgs>.*> \\|\\(mzscheme\\|racket\\)@@[^ ]*> ") -@end example - -Note that you may have to run @kbd{M-x geiser-reload} after setting -this variable so that your changes will take effect. - -Again, you'll have to change the regexp to fit every prompt that -causes this issue, but the only alternative (that we can think of -right now) is to create a regexp that will match every possible -prompt. Obviously, that is going to be more than a little -tricky. However, if you have a better solution than that, please share -it with the Geiser developers; we'll be more than happy to hear it. - -@node Autodoc and friends, Seeing is believing, Completion and error handling, The REPL -@section Autodoc and friends - -Oftentimes, there's more you'll want to know about an identifier -besides its name: What module does it belong to? Is it a procedure and, -if so, what arguments does it take? Geiser tries to help you answering -those questions too. - -@cindex autodoc, in the REPL -Actually, if you've been playing with the REPL as you read, you might -have notice some frantic activity taking place in the echo area every -now and then. That was Geiser trying to be helpful (while, hopefully, -not being clippy), or, more concretely, what i call, for want of a -better name, its @dfn{autodoc} mode. Whenever it's active (did you -notice that @i{A} in the mode-line?), Geiser's gerbils will be scanning -what you type and showing (unless you silence them with @kbd{C-c C-d C-a}) -information about the identifier nearest to point. - -@imgc{repl-autodoc} - -If that identifier corresponds to a variable visible in the current -namespace, you'll see the module it belongs to and its value. For -procedures and macros, autodoc will display, instead of their value, the -argument names (or an underscore if Geiser cannot determine the name -used in the definition). Optional arguments are surrounded by -parentheses. When the optional argument has a default value, it's -represented by a list made up of its name and that value. When the -argument is a keyword argument, its name has ``#:'' as a prefix. - -@cindex help on identifier -If that's not enough documentation for you, @kbd{C-c C-d d} will open -a separate documentation buffer with help on the symbol at point. -This buffer will contain implementation-specific information about the -identifier (e.g., its docstring for Guile, or its contract, if any, -for Racket), and a handy button to open the corresponding manual entry -for the symbol, which will open an HTML page (for Racket and Chicken) -or the texinfo manual (for Guile). If you'd rather go directly to the -manual, try @kbd{C-c C-d i}, which invokes -@code{geiser-doc-look-up-manual} as the handy button does. - -@cindex module exports -@anchor{repl-mod} Geiser can also produce for you a list, classified by -kind, of the identifiers exported by a given module: all you need to do -is press @kbd{C-c C-d m}, and type or complete the desired module's -name. - -@imgc{repl-mod} - -The list of exported bindings is shown, again, in a buffer belonging to -Geiser's documentation browser, where you have at your disposal a bunch -of navigation commands listed in -@altr{Documentation browser,our cheat-sheet,Documentation browser,.} - -We'll have a bit more to say about the documentation browser in -@altr{doc-browser,a later section,Documentation helpers,.} - -@cindex jump, at the REPL -If that's still not enough, Geiser can jump, via @kbd{M-.}, to the -symbol's definition. A buffer with the corresponding file will pop up, -with its point resting upon the identifier's defining form. When you're -done inspecting, @kbd{M-,} will bring you back to where you were. As we -will see, these commands are also available in Scheme buffers. @kbd{M-.} -also works for modules: if your point is on an unambiguous module name, -the file where it's defined will be opened for you. - -@node Seeing is believing, Customization and tips, Autodoc and friends, The REPL -@section Seeing is believing - -@cindex image support -In schemes that support images as values (currently, that means -Racket), the REPL will display them inline if you're using them in a -graphics-aware Emacs. - -@imgc{repl-images} - -@cindex external image viewer -@cindex image viewer -For the terminal, images will appear as buttons: press return on them to -invoke an external viewer (configurable via @code{geiser-image-viewer}) -that will show you the image at hand. You can also ask for the same -behaviour on all emacsen by customising -@code{geiser-repl-inline-images-p} to @code{nil}. - -@cindex image cache -Geiser keeps a cache of the last displayed images in the directory -@code{geiser-image-cache-dir}, which defaults to the system's temp -directory, with up to @code{geiser-image-cache-keep-last} files. You -can invoke the external image viewer on any of them with @command{M-x -geiser-view-last-image}, which takes a prefix argument to indicate which -image number you want, 0 corresponding to the newest one. - -@node Customization and tips, , Seeing is believing, The REPL -@section Customization and tips - -@cindex REPL customization -The looks and ways of the REPL can be fine-tuned via a bunch of -customization variables. You can see and modify them all in the -corresponding customization group (by using the menu entry or the good -old @kbd{M-x customize-group geiser-repl}), or by setting them in your -Emacs initialisation files (as a rule, all knobs in Geiser are tunable -this way: you don't need to use customization buffers if you don't like -them). - -I'm documenting below a proper subset of those settings, together with -some related tips. - -@subsubheading Choosing a Scheme implementation -@cindex scheme implementation, choosing -@anchor{choosing-impl} -Instead of using the generic @command{geiser} command, you can directly -start your Scheme of choice using any of the following commands: -@itemize @bullet -@item @command{run-racket} -@item @command{run-guile} -@item @command{run-chicken} -@item @command{run-mit} -@item @command{run-chibi} -@item @command{run-chez} -@end itemize - @anchor{active-implementations} In addition, the -variable @code{geiser-active-implementations} contains a list of those -Schemes Geiser should be aware of. Thus, if you happen to be, say, a -racketeer not to be beguiled by other schemes, you can tell Geiser to -forget about the richness of the Scheme ecosystem with something like: - -@example -(setq geiser-active-implementations '(racket)) -@end example - -@noindent -in your initialisation files. - -@cindex scheme binary -@cindex scheme executable path -@anchor{impl-binary} When starting a new REPL, Geiser assumes, by -default, that the corresponding Scheme binary is in your path. If that's -not the case, the variables to tweak are (depending on which Scheme you choose): -@itemize @bullet -@item @code{geiser-guile-binary} -@item @code{geiser-racket-binary} -@item @code{geiser-chicken-binary} -@item @code{geiser-mit-binary} -@item @code{geiser-chibi-binary} -@item @code{geiser-chez-binary} -@end itemize -They should be set to a string with the full path to the requisite binary. - -@cindex Version checking -Before starting the REPL, Geiser will check whether the version of your -Scheme interpreter is good enough. This means that it will spend a -couple tenths of a second launching and quickly discarding a Scheme -process, but also that the error message you'll get if you're on the -wrong Scheme version will be much more informative. If you one to -avoid version checks, just check -@code{geiser-repl-skip-version-check-p} to @code{t} in your -configuration. - -@cindex scheme load path -@cindex scheme init file -@cindex GUILE_LOAD_PATH -@cindex GUILE_LOAD_COMPILED_PATH -@cindex geiser-add-to-load-path -@cindex geiser-repl-add-project-paths -@subsubheading Init files and load paths -The startup behaviour of the REPL can be also fine tuned with a couple -more initialisation parameters. - -Many Scheme implementations provide a configuration variable to specify -a Geiser-specific init file (e.g., @code{geiser-guile-init-file} for -Guile), and, sometimes a global list of paths to add to the -interpreter's load path (that'd be @code{geiser-guile-load-path} for -Guile). - -@cindex default directory -There is also a generic mechanism to specify how to add directories to -the initial load path when @code{geiser-repl-current-project-function} -is set: you can then customize @code{geiser-repl-add-project-paths} to a -list of subdirectories of the project's root to add to the load path. -When this option is set, the working directory of the REPL's buffer -(i.e., the value of the elisp variable @code{default-directory}) will be -set to the directory returned by -@code{geiser-repl-current-project-function}). - -These variables controlling your scheme's initialisation process are -good candidates for an entry in a project's @file{.dir-locals.el} file, -so that they are automatically set to a sensible value whenever you -start a REPL in the project's directory. - -@subsubheading Startup waiting time - -@cindex startup timeout -@cindex timeout -When starting a scheme implementation in old or very busy computers, -Geiser might have to wait a bit more than it expects (which is ten -seconds, or ten thousand milliseconds, by default). If you find that -Geiser is giving up too quickly and complaining that no prompt was -found, try to increase the value of @code{geiser-repl-startup-time} to, -say, twenty seconds: - -@example -(setq geiser-repl-startup-time 20000) -@end example - -@noindent -If you prefer, you can use the customize interface to, well, customise -the above variable's value. - -@subsubheading History - -By default, Geiser won't record duplicates in your input history. If you -prefer it did, just set @code{geiser-repl-history-no-dups-p} to -@code{nil}. History entries are persistent across REPL sessions: -they're saved in implementation-specific files whose location is -controlled by the variable @code{geiser-repl-history-filename}. For -example, my Geiser configuration includes the following line: - -@example -(setq geiser-repl-history-filename "~/.emacs.d/geiser-history") -@end example - -@noindent -which makes the files @file{geiser-history.guile} and -@file{geiser-history.racket} to live inside my home's @file{.emacs.d} -directory. - -@subsubheading Autodoc - -@cindex autodoc, disabling -@cindex peace and quiet -If you happen to love peace and quiet and prefer to keep your REPL's -echo area free from autodoc's noise, @code{geiser-repl-autodoc-p} is the -customization variable for you: set it to @code{nil} and autodoc will be -disabled by default in new REPLs. You can always bring the fairies -back, on a per-REPL basis, using @kbd{C-c C-d C-a}. - -@subsubheading Remote connections - -@cindex port, default -@cindex host, default -When using any of the connection commands (e.g. @code{geiser-connect}, -@code{connect-to-guile}, @code{connect-to-racket}, etc.) you'll be -prompted for a host and a port, defaulting to ``localhost'' and 37146. -You can change those defaults customizing -@code{geiser-repl-default-host} and @code{geiser-repl-default-port}, -respectively. - -@subsubheading Killing REPLs - -@cindex ask on kill, don't -If you don't want Emacs to ask for confirmation when you're about to -kill a live REPL buffer (as will happen, for instance, if you're exiting -Emacs before closing all your REPLs), you can set the flag -@code{geiser-repl-query-on-kill-p} to @code{nil}. On a related note, -the customizable variable @code{geiser-repl-query-on-exit-p} controls -whether Geiser should ask for confirmation when you exit the REPL -explicitly (via, say, @kbd{C-c C-q}, as opposed to killing the buffer), -and is set to @code{nil} by default. - -@c Local Variables: -@c mode: texinfo -@c TeX-master: "geiser" -@c End: diff --git a/elpa/geiser-0.30/doc/thanks.texi b/elpa/geiser-0.30/doc/thanks.texi @@ -1,92 +0,0 @@ -@node No hacker is an island, Index, Cheat sheet, Top -@chapter No hacker is an island -@cindex thanks - -Dan Leslie, with the help of his three-months old daughter Freija, -proved there's a smidgen of sense in this madness by adding support -for Chicken to version 0.7 of Geiser, several years after it was born. -And Peter Feigl reinforced that feeling soon afterwards with his work on -supporting GNU/MIT Scheme, Chib and Chez in one fell swoop. - -Andy Wingo, Geiser's first user, has been a continuous source of -encouragement and suggestions, and keeps improving Guile and heeding -my feature requests. - -The nice thing about collaborating with Andreas Rottmann over all -these years is that he will not only make your project better with -insightful comments and prodding: he'll send you patches galore too. - -Ludovic Courtès, #geiser's citizen no. 1, joined the fun after a -while, and has since then been a continuous source of encouragement, -ideas and bug reports. - -Michael Wilber convinced me that image support for Racket was not only -fun, but easy, with the best argument: actual code! - -Daniel Hackney and Grant Rettke created the first ELPA packages for -Geiser and taught me to fish. - -Diogo F. S. Ramos is Geiser's most indefatigable user and bug reporter, -and the mailing list has been a far less lonely place since he came. - -Aleix Conchillo has been my favourite spammer, beta tester and patch -sender during more years and for more projects than i can remember. - -Philip K. prepared the NonGNU ELPA packages for Geiser, making them -available by default starting in Emacs 28, very generously volunteering -all the work (i just had to update the docs!). - -Jonas Bernoulli, as it's his indefatigable wont, has improved Geiser's -compliance to current Emacs packaging standards, making it a respectful -member of the ELPA community. - -Eduardo Cavazos' contagious enthusiasm has helped in many ways to keep -Geiser alive, and he's become its best evangelist in R6RS circles. - -Alex Kost has contributed with many bug reports and improved Geiser -with several patches. - -Eli Barzilay took the time to play with an early alpha and made many -valuable suggestions, besides answering all my 'how do you in PLT' -questions. - -Matthew Flatt, Robby Findler and the rest of the PLT team did not only -answer my inquiries, but provided almost instant fixes to the few -issues i found. - -Thanks also to the PLT and Guile communities, for showing me that -Geiser was not only possible, but a pleasure to hack on. And to the -Slime hackers, who led the way. - - -@subsubheading Joining the fun - -@itemize @bullet -@item -@cindex mailing list -@cindex gmane -For questions, praise, critique and anything else Geiser, do not -hesitate to drop an email to our list, -@url{mailto:geiser-users@@nongnu.org, (@@ geiser-users (. nongnu -org))}: no subscription required. Check -@uref{http://lists.nongnu.org/@/mailman/@/listinfo/@/geiser-users, the list -page} for more information or browse -@uref{http://lists.nongnu.org/@/archive/@/html/@/geiser-users/, the archives}. -The list is also accessible via @uref{http://gmane.org, Gmane} as -@url{http://dir.gmane.org/@/gmane.lisp.scheme.geiser, -gmane.lisp.scheme.geiser}. -@item -@cindex bug tracker -You can submit bug reports either to the mailing list or to -@uref{https://gitlab.com/groups/emacs-geiser/-/issues, our bug tracker} over at -Gitlab. -@item -@cindex IRC channel -The Freenode IRC channel @i{#geiser} is the Geiserati's meeting point in -cyberspace. -@end itemize - -@c Local Variables: -@c mode: texinfo -@c TeX-master: "geiser" -@c End: diff --git a/elpa/geiser-0.30/doc/top.texi b/elpa/geiser-0.30/doc/top.texi @@ -1,23 +0,0 @@ -Geiser is a collection of Emacs major and minor modes that conspire with -one or more Scheme interpreters to keep the Lisp Machine Spirit alive. -It draws inspiration (and a bit more) from environments such as Common -Lisp's Slime, Factor's FUEL, Squeak or Emacs itself, and does its best -to make Scheme hacking inside Emacs (even more) fun. - -@cindex derailment -@cindex corpses -@cindex philosophy -Or, to be precise, what @uref{https://jao.io, i} consider -fun. Geiser is thus my humble contribution to the dynamic school of -expression, and a reaction against what i perceive as a derailment, in -modern times, of standard Scheme towards the static camp. Because i -prefer growing and healing to poking at corpses, the continuously -running Scheme interpreter takes the center of the stage in Geiser. A -bundle of Elisp shims orchestrates the dialog between the Scheme -interpreter, Emacs and, ultimately, the schemer, giving her access to -live metadata. Here's how. - -@c Local Variables: -@c mode: texinfo -@c TeX-master: geiser -@c End: diff --git a/elpa/geiser-0.30/geiser-autodoc.el b/elpa/geiser-0.30/geiser-autodoc.el @@ -1,256 +0,0 @@ -;;; geiser-autodoc.el -- autodoc mode -*- lexical-binding: t; -*- - -;; Copyright (C) 2009, 2010, 2011, 2012, 2015, 2016, 2021, 2022 Jose Antonio Ortega Ruiz - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the Modified BSD License. You should -;; have received a copy of the license along with this program. If -;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>. - -;; Start date: Sun Feb 08, 2009 19:44 - - -;;; Code: - -(require 'geiser-edit) -(require 'geiser-eval) -(require 'geiser-syntax) -(require 'geiser-custom) -(require 'geiser-base) - -(require 'eldoc) - - -;;; Customization: - -(defgroup geiser-autodoc nil - "Options for displaying autodoc strings in the echo area." - :group 'geiser) - -(geiser-custom--defface autodoc-current-arg - 'font-lock-variable-name-face - geiser-autodoc "highlighting current argument in autodoc messages") - -(geiser-custom--defface autodoc-identifier - 'font-lock-function-name-face - geiser-autodoc "highlighting procedure name in autodoc messages") - -(geiser-custom--defcustom geiser-autodoc-delay 0.3 - "Delay before autodoc messages are fetched and displayed, in seconds." - :type 'number) - -(geiser-custom--defcustom geiser-autodoc-display-module t - "Whether to display procedure module in autodoc strings." - :type 'boolean) - -(geiser-custom--defcustom geiser-autodoc-identifier-format "%s:%s" - "Format for displaying module and procedure or variable name, in that order, -when `geiser-autodoc-display-module' is on." - :type 'string) - -(geiser-custom--defcustom geiser-autodoc-use-docsig t - "Provide signature docstrings for systems like company or corfu. - -With this flag set, the signature of selected completions using -packages like company, corfu or completion-in-region functions -will be displayed in the echo area. For the case of a -completion-in-region function (e.g. consult's), which collects -all the docstrings at once, this might have a performance impact: -you can set this variable to nil to avoid them." - :type 'boolean) - - -;;; Procedure arguments: - -(defvar-local geiser-autodoc--cached-signatures nil) - -(defsubst geiser-autodoc--clean-cache () - (setq geiser-autodoc--cached-signatures nil)) - -(defun geiser-autodoc--update-signatures (ret callback) - (let ((res (geiser-eval--retort-result ret)) - (signs)) - (when res - (dolist (item res) - (push (cons (format "%s" (car item)) (cdr item)) signs)) - (when (functionp callback) - (let* ((path (geiser-syntax--scan-sexps)) - (str (geiser-autodoc--autodoc path nil signs))) - (funcall callback str))) - (setq geiser-autodoc--cached-signatures signs)))) - -(defun geiser-autodoc--get-signatures (funs callback) - (when funs - (let* ((m (format "'(%s)" (mapconcat 'identity funs " "))) - (str (geiser-eval--scheme-str `(:eval (:ge autodoc (:scm ,m)))))) - (if callback - (geiser-eval--send str - (lambda (r) - (geiser-autodoc--update-signatures r callback))) - (geiser-autodoc--update-signatures (geiser-eval--send/wait str) nil)))) - (and (or (assoc (car funs) geiser-autodoc--cached-signatures) - (assoc (cadr funs) geiser-autodoc--cached-signatures)) - geiser-autodoc--cached-signatures)) - -(defun geiser-autodoc--sanitize-args (args) - (cond ((null args) nil) - ((listp args) - (cons (car args) (geiser-autodoc--sanitize-args (cdr args)))) - (t '("...")))) - -(defun geiser-autodoc--format-arg (a) - (cond ((and (listp a) (geiser-syntax--keywordp (car a))) - (if (and (cdr a) (listp (cdr a))) - (format "(#%s %s)" (car a) (geiser-syntax--display (cadr a))) - (format "(#%s)" (car a)))) - (t (geiser-syntax--display a)))) - -(defvar geiser-autodoc--arg-face 'geiser-font-lock-autodoc-current-arg) - -(defun geiser-autodoc--insert-arg-group (args current &optional pos) - (when args (insert " ")) - (dolist (a (geiser-autodoc--sanitize-args args)) - (let ((p (point))) - (insert (geiser-autodoc--format-arg a)) - (when (or (and (numberp pos) - (numberp current) - (setq current (1+ current)) - (= (1+ pos) current)) - (and (geiser-syntax--keywordp current) - (listp a) - (geiser-syntax--symbol-eq current (car a)))) - (put-text-property p (point) 'face geiser-autodoc--arg-face) - (setq pos nil current nil))) - (insert " ")) - (when args (backward-char)) - current) - -(defun geiser-autodoc--insert-args (args pos prev) - (let ((cpos 1) - (reqs (cdr (assoc "required" args))) - (opts (mapcar (lambda (a) - (if (and (symbolp a) - (not (equal (symbol-name a) "..."))) - (list a) - a)) - (cdr (assoc "optional" args)))) - (keys (cdr (assoc "key" args)))) - (setq cpos - (geiser-autodoc--insert-arg-group reqs - cpos - (and (not (zerop pos)) pos))) - (setq cpos (geiser-autodoc--insert-arg-group opts cpos pos)) - (geiser-autodoc--insert-arg-group keys prev nil))) - -(defsubst geiser-autodoc--id-name (proc module) - (let ((str (if (and module geiser-autodoc-display-module) - (format geiser-autodoc-identifier-format module proc) - (format "%s" proc)))) - (propertize str 'face 'geiser-font-lock-autodoc-identifier))) - -(defun geiser-autodoc--str* (full-signature) - (let ((geiser-autodoc--arg-face 'default) - (sign (if (listp full-signature) full-signature (list full-signature)))) - (geiser-autodoc--str (list (car sign)) sign))) - -(defsubst geiser-autodoc--value-str (proc module value) - (let ((name (geiser-autodoc--id-name proc module))) - (if value (format "%s => %s" name value) name))) - -(defun geiser-autodoc--str (desc signature) - (let ((proc (car desc)) - (args (cdr (assoc "args" signature))) - (module (cdr (assoc "module" signature)))) - (if (not args) - (geiser-autodoc--value-str proc module (cdr (assoc "value" signature))) - (save-current-buffer - (set-buffer (geiser-syntax--font-lock-buffer)) - (erase-buffer) - (insert (format "(%s" (geiser-autodoc--id-name proc module))) - (let ((pos (or (cadr desc) 0)) - (prev (car (cddr desc)))) - (dolist (a args) - (when (not (member a (cdr (member a args)))) - (geiser-autodoc--insert-args a pos prev) - (insert " |")))) - (delete-char -2) - (insert ")") - (buffer-substring (point-min) (point)))))) - -(defun geiser-autodoc--autodoc (path callback &optional signs) - (let ((signs (or signs - (geiser-autodoc--get-signatures (mapcar 'car path) callback)))) - (or (and callback t) - (let ((p (car path)) - (s)) - (while (and p (not s)) - (setq s (or (cdr (assoc (car p) signs)) - (and (bound-and-true-p geiser-mode) - (cdr (geiser-edit--find-def (car p) t))))) - (unless s (setq p (car path) path (cdr path)))) - (cond ((stringp s) s) - (s (geiser-autodoc--str p s))))))) - - -;;; Autodoc functions: - -(defvar-local geiser-autodoc--inhibit-function nil) - -(defsubst geiser-autodoc--inhibit () - (and geiser-autodoc--inhibit-function - (funcall geiser-autodoc--inhibit-function))) - -(defsubst geiser-autodoc--inhibit-autodoc () - (setq geiser-autodoc--inhibit-function (lambda () t))) - -(defsubst geiser-autodoc--disinhibit-autodoc () - (setq geiser-autodoc--inhibit-function nil)) - -(defsubst geiser-autodoc--autodoc-at-point (callback) - (geiser-autodoc--autodoc (geiser-syntax--scan-sexps) callback)) - -(defun geiser-autodoc--eldoc-function (&optional callback) - (ignore-errors - (when (not (geiser-autodoc--inhibit)) - (geiser-autodoc--autodoc-at-point (or callback 'eldoc-message))))) - -(defun geiser-autodoc-show () - "Show the signature or value of the symbol at point in the echo area." - (interactive) - (message (geiser-autodoc--autodoc-at-point nil))) - - -;;; Autodoc mode: - -(defvar-local geiser-autodoc-mode-string " A" - "Modeline indicator for geiser-autodoc-mode") - -(define-minor-mode geiser-autodoc-mode - "Toggle Geiser's Autodoc mode. -With no argument, this command toggles the mode. -Non-null prefix argument turns on the mode. -Null prefix argument turns off the mode. - -When Autodoc mode is enabled, a synopsis of the word at point is -displayed in the minibuffer." - :init-value nil - :lighter geiser-autodoc-mode-string - :group 'geiser-autodoc - - (if (boundp 'eldoc-documentation-functions) - (if geiser-autodoc-mode - (add-hook 'eldoc-documentation-functions - #'geiser-autodoc--eldoc-function nil t) - (remove-hook 'eldoc-documentation-functions - #'geiser-autodoc--eldoc-function t)) - (set (make-local-variable 'eldoc-documentation-function) - (when geiser-autodoc-mode 'geiser-autodoc--eldoc-function))) - (set (make-local-variable 'eldoc-minor-mode-string) nil) - (set (make-local-variable 'eldoc-idle-delay) geiser-autodoc-delay) - (eldoc-mode (if geiser-autodoc-mode 1 -1)) - (when (called-interactively-p nil) - (message "Geiser Autodoc %s" - (if geiser-autodoc-mode "enabled" "disabled")))) - - -(provide 'geiser-autodoc) diff --git a/elpa/geiser-0.30/geiser-autoloads.el b/elpa/geiser-0.30/geiser-autoloads.el @@ -1,170 +0,0 @@ -;;; geiser-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 geiser.el - -(defconst geiser-elisp-dir (file-name-directory load-file-name) "\ -Directory containing Geiser's Elisp files.") -(autoload 'geiser-version "geiser-version" "\ -Echo Geiser's version." t) -(autoload 'geiser-unload "geiser-reload" "\ -Unload all Geiser code." t) -(autoload 'geiser-reload "geiser-reload" "\ -Reload Geiser code." t) -(autoload 'geiser "geiser-repl" "\ -Start a Geiser REPL." t) -(autoload 'run-geiser "geiser-repl" "\ -Start a Geiser REPL." t) -(autoload 'geiser-connect "geiser-repl" "\ -Start a Geiser REPL connected to a remote server." t) -(autoload 'geiser-connect-local "geiser-repl" "\ -Start a Geiser REPL connected to a remote server over a Unix-domain socket." t) -(autoload 'geiser-repl-switch "geiser-repl" "\ -Switch to a running one Geiser REPL." t) -(autoload 'geiser-mode "geiser-mode" "\ -Minor mode adding Geiser REPL interaction to Scheme buffers." t) -(autoload 'turn-on-geiser-mode "geiser-mode" "\ -Enable Geiser's mode (useful in Scheme buffers)." t) -(autoload 'turn-off-geiser-mode "geiser-mode" "\ -Disable Geiser's mode (useful in Scheme buffers)." t) -(mapc (lambda (group) (custom-add-load group (symbol-name group)) (custom-add-load 'geiser (symbol-name group))) '(geiser geiser-repl geiser-autodoc geiser-doc geiser-debug geiser-faces geiser-mode geiser-image geiser-implementation geiser-xref)) -(autoload 'geiser-mode--maybe-activate "geiser-mode") -(add-hook 'scheme-mode-hook #'geiser-mode--maybe-activate) - - -;;; Generated autoloads from geiser-autodoc.el - -(register-definition-prefixes "geiser-autodoc" '("geiser-autodoc-")) - - -;;; Generated autoloads from geiser-base.el - -(register-definition-prefixes "geiser-base" '("geiser--")) - - -;;; Generated autoloads from geiser-capf.el - -(register-definition-prefixes "geiser-capf" '("geiser-capf-")) - - -;;; Generated autoloads from geiser-compile.el - -(register-definition-prefixes "geiser-compile" '("geiser-")) - - -;;; Generated autoloads from geiser-completion.el - -(register-definition-prefixes "geiser-completion" '("geiser-")) - - -;;; Generated autoloads from geiser-connection.el - -(register-definition-prefixes "geiser-connection" '("geiser-con")) - - -;;; Generated autoloads from geiser-custom.el - -(register-definition-prefixes "geiser-custom" '("geiser-custom-")) - - -;;; Generated autoloads from geiser-debug.el - -(register-definition-prefixes "geiser-debug" '("geiser-debug-")) - - -;;; Generated autoloads from geiser-doc.el - -(register-definition-prefixes "geiser-doc" '("geiser-doc-")) - - -;;; Generated autoloads from geiser-edit.el - -(register-definition-prefixes "geiser-edit" '("geiser-")) - - -;;; Generated autoloads from geiser-eval.el - -(register-definition-prefixes "geiser-eval" '("geiser-eval-")) - - -;;; Generated autoloads from geiser-image.el - -(register-definition-prefixes "geiser-image" '("geiser-")) - - -;;; Generated autoloads from geiser-impl.el - - (defvar geiser-active-implementations nil) - (defvar geiser-implementations-alist nil) -(defun geiser-activate-implementation (impl) (add-to-list 'geiser-active-implementations impl)) -(defun geiser-impl--add-to-alist (kind what impl &optional append) (add-to-list 'geiser-implementations-alist (list (list kind what) impl) append)) -(defun geiser-implementation-extension (impl ext) "\ -Add to `geiser-implementations-alist' an entry for extension EXT." (geiser-impl--add-to-alist 'regexp (format "\\.%s\\'" ext) impl t)) -(register-definition-prefixes "geiser-impl" '("define-geiser-implementation" "geiser-" "with--geiser-implementation")) - - -;;; Generated autoloads from geiser-log.el - -(register-definition-prefixes "geiser-log" '("geiser-")) - - -;;; Generated autoloads from geiser-menu.el - -(register-definition-prefixes "geiser-menu" '("geiser-menu--")) - - -;;; Generated autoloads from geiser-mode.el - -(register-definition-prefixes "geiser-mode" '("geiser-" "turn-o")) - - -;;; Generated autoloads from geiser-popup.el - -(register-definition-prefixes "geiser-popup" '("geiser-popup-")) - - -;;; Generated autoloads from geiser-reload.el - -(register-definition-prefixes "geiser-reload" '("geiser-")) - - -;;; Generated autoloads from geiser-repl.el - -(register-definition-prefixes "geiser-repl" '("geiser")) - - -;;; Generated autoloads from geiser-syntax.el - -(register-definition-prefixes "geiser-syntax" '("geiser-syntax--")) - - -;;; Generated autoloads from geiser-table.el - -(register-definition-prefixes "geiser-table" '("geiser-table-")) - - -;;; Generated autoloads from geiser-xref.el - -(register-definition-prefixes "geiser-xref" '("geiser-xref-")) - -;;; End of scraped data - -(provide 'geiser-autoloads) - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; no-native-compile: t -;; coding: utf-8-emacs-unix -;; End: - -;;; geiser-autoloads.el ends here diff --git a/elpa/geiser-0.30/geiser-base.el b/elpa/geiser-0.30/geiser-base.el @@ -1,96 +0,0 @@ -;;; geiser-base.el --- shared bits -*- lexical-binding: t -*- - -;; Copyright (C) 2009, 2010, 2012, 2013, 2015, 2016, 2019 Jose Antonio Ortega Ruiz - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the Modified BSD License. You should -;; have received a copy of the license along with this program. If -;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>. - -;; Settings and vars shared by all geiser modules, including little -;; utilities and emacsen compatibility bits. - - -;;; Code: -;;; Emacs compatibility: - -(require 'ring) - -(eval-after-load "ring" - '(when (not (fboundp 'ring-member)) - (defun ring-member (ring item) - (catch 'found - (dotimes (ind (ring-length ring)) - (when (equal item (ring-ref ring ind)) - (throw 'found ind))))))) - -(when (not (fboundp 'looking-at-p)) - (defsubst looking-at-p (regexp) - (with-no-warnings - (let ((inhibit-changing-match-data t)) - (looking-at regexp))))) - -(defalias 'geiser--font-lock-ensure - (if (fboundp 'font-lock-ensure) - #'font-lock-ensure - (with-no-warnings - (lambda (&optional _beg _end) - (when font-lock-mode - (font-lock-fontify-buffer)))))) - -;;; Utilities: - -(defsubst geiser--chomp (str) - (if (string-match-p ".*\n$" str) (substring str 0 -1) str)) - -(defun geiser--shorten-str (str len &optional sep) - (let ((str-len (length str))) - (if (<= str-len len) - str - (let* ((sep (or sep " ... ")) - (sep-len (length sep)) - (prefix-len (/ (- str-len sep-len) 2)) - (prefix (substring str 0 prefix-len)) - (suffix (substring str (- str-len prefix-len)))) - (format "%s%s%s" prefix sep suffix))))) - -(defun geiser--region-to-string (begin &optional end) - (let ((end (or end (point)))) - (when (< begin end) - (let* ((str (buffer-substring-no-properties begin end)) - (pieces (split-string str nil t))) - (mapconcat 'identity pieces " "))))) - -(defun geiser--insert-with-face (str face) - (let ((p (point))) - (insert str) - (put-text-property p (point) 'face face))) - - -(defmacro geiser--save-msg (&rest body) - (let ((msg (make-symbol "msg"))) - `(let ((,msg (current-message))) - ,@body - (message ,msg)))) - -(put 'geiser--save-msg 'lisp-indent-function 0) - -(defun geiser--del-dups (lst) - (let (result) - (dolist (e lst (nreverse result)) - (unless (member e result) (push e result))))) - -(defsubst geiser--symbol-at-point () - (let ((thing (thing-at-point 'symbol))) - (and thing (make-symbol thing)))) - -(defun geiser--cut-version (v) - (when (string-match "\\([0-9]+\\(?:\\.[0-9]+\\)*\\).*" v) - (match-string 1 v))) - -(defun geiser--version< (v1 v2) - (let ((v1 (geiser--cut-version v1)) - (v2 (geiser--cut-version v2))) - (and v1 v2 (version< v1 v2)))) - -(provide 'geiser-base) diff --git a/elpa/geiser-0.30/geiser-capf.el b/elpa/geiser-0.30/geiser-capf.el @@ -1,95 +0,0 @@ -;;; geiser-capf.el -- Setup for Geiser's CAPFs -*- lexical-binding: t; -*- - -;; Copyright (c) 2022 Jose Antonio Ortega Ruiz - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the Modified BSD License. You should -;; have received a copy of the license along with this program. If -;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>. - -;; Start date: Sat Apr 23, 2022 18:39 - - - -(require 'geiser-autodoc) -(require 'geiser-impl) -(require 'geiser-eval) -(require 'geiser-doc) -(require 'geiser-completion) -(require 'geiser-edit) - -(defun geiser-capf--company-docsig (id) - (condition-case err - (when (and geiser-impl--implementation (not (geiser-autodoc--inhibit))) - (let* ((id (substring-no-properties id)) - (help (geiser-autodoc--autodoc `((,id 0)) nil))) - (and help (substring-no-properties help)))) - (error (geiser-log--warn "Error computing docsig: %s" err)))) - -(defun geiser-capf--company-doc-buffer (id) - (when geiser-impl--implementation - (let* ((module (geiser-eval--get-module)) - (symbol (make-symbol id)) - (ds (geiser-doc--get-docstring symbol module))) - (when (consp ds) - (with-current-buffer (get-buffer-create "*company-documentation*") - (geiser-doc--render-docstring ds symbol module) - (current-buffer)))))) - -(defun geiser-capf--company-location (id) - (condition-case _err - (when (and geiser-impl--implementation (not (geiser-autodoc--inhibit))) - (let ((id (make-symbol id))) - (condition-case nil - (geiser-edit-module id 'noselect) - (error (geiser-edit-symbol id 'noselect))))) - (error (message "Location not found for %s" id)))) - -(defun geiser-capf--thing-at-point (module &optional _predicate) - (with-syntax-table scheme-mode-syntax-table - (let* ((beg (geiser-completion--symbol-begin module)) - (end (or (geiser-completion--prefix-end beg module) beg)) - (prefix (and (> end beg) (buffer-substring-no-properties beg end))) - (prefix (and prefix - (if (string-match "\\([^-]+\\)-" prefix) - (match-string 1 prefix) - prefix))) - (cmps (and prefix (geiser-completion--complete prefix module)))) - (when cmps - (list beg end cmps - :company-docsig - (and geiser-autodoc-use-docsig #'geiser-capf--company-docsig) - :company-doc-buffer #'geiser-capf--company-doc-buffer - :company-location #'geiser-capf--company-location))))) - -(defun geiser-capf--for-symbol (&optional predicate) - (geiser-capf--thing-at-point nil predicate)) - -(defun geiser-capf--for-module (&optional predicate) - (geiser-capf--thing-at-point t predicate)) - -(defun geiser-capf--for-filename () - (when (geiser-syntax--in-string-p) - (let ((comint-completion-addsuffix "\"")) - (ignore-errors (comint-filename-completion))))) - -(defconst geiser-capf--capfs - '(geiser-capf--for-filename geiser-capf--for-module geiser-capf--for-symbol)) - -(defun geiser-capf-setup (enable) - (if enable - (dolist (f geiser-capf--capfs) - (add-hook 'completion-at-point-functions f nil t)) - (dolist (f geiser-capf--capfs) - (remove-hook 'completion-at-point-functions f t)))) - -(defun geiser-capf-complete-module () - "Complete module name at point." - (interactive) - (let ((completion-at-point-functions '(geiser-capf--for-module))) - (call-interactively 'completion-at-point))) - - - -(provide 'geiser-capf) -;;; geiser-capf.el ends here diff --git a/elpa/geiser-0.30/geiser-compile.el b/elpa/geiser-0.30/geiser-compile.el @@ -1,84 +0,0 @@ -;;; geiser-compile.el -- compile/load scheme files -*- lexical-binding: t; -*- - -;; Copyright (C) 2009-2013, 2016, 2018, 2021-2022 Jose Antonio Ortega Ruiz - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the Modified BSD License. You should -;; have received a copy of the license along with this program. If -;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>. - -;; Start date: Wed Feb 11, 2009 00:16 - - -;;; Code: - -(require 'geiser-debug) -(require 'geiser-autodoc) -(require 'geiser-eval) -(require 'geiser-base) -(require 'geiser-repl) - - -;;; Auxiliary functions: - -(defun geiser-compile--buffer/path (&optional path) - (let ((path (or path (read-file-name "Scheme file: " nil nil t)))) - (let ((buffer (find-file-noselect path))) - (when (and (buffer-modified-p buffer) - (y-or-n-p "Save buffer? ")) - (save-buffer buffer)) - (cons buffer path)))) - -(defun geiser-compile--display-result (title ret) - (if (not (geiser-eval--retort-error ret)) - (message "%s done" title) - (message "")) - (geiser-debug--display-retort title ret)) - -(defun geiser-compile--file-op (path compile-p msg) - (let* ((b/p (geiser-compile--buffer/path path)) - (path (cdr b/p)) - (msg (format "%s %s ..." msg path)) - (code `(,(if compile-p :comp-file :load-file) ,path)) - (cont (lambda (ret) (geiser-compile--display-result msg ret)))) - (message msg) - (geiser-autodoc--clean-cache) - (geiser-eval--send code cont))) - -(defun geiser-compile--ensure-repl (force) - (when (or force - (and (not (geiser-repl--ensure-repl-buffer)) - (yes-or-no-p "No REPL is running: start it?"))) - (geiser-repl-restart-repl))) - - -;;; User commands: - -(defun geiser-compile-file (path) - "Compile and load Scheme file." - (interactive "FScheme file: ") - (geiser-compile--file-op (file-local-name path) t "Compiling")) - -(defun geiser-compile-current-buffer (&optional restart) - "Compile and load current Scheme file. - -With prefix, restart REPL before compiling the file." - (interactive "P") - (geiser-compile--ensure-repl restart) - (geiser-compile-file (file-local-name (buffer-file-name (current-buffer))))) - -(defun geiser-load-file (path) - "Load Scheme file." - (interactive "FScheme file: ") - (geiser-compile--ensure-repl nil) - (geiser-compile--file-op (file-local-name (expand-file-name path)) nil "Loading")) - -(defun geiser-load-current-buffer (&optional restart) - "Load current Scheme file. - -With prefix, restart REPL before loading the file." - (interactive "P") - (geiser-compile--ensure-repl restart) - (geiser-load-file (file-local-name (buffer-file-name (current-buffer))))) - -(provide 'geiser-compile) diff --git a/elpa/geiser-0.30/geiser-completion.el b/elpa/geiser-0.30/geiser-completion.el @@ -1,159 +0,0 @@ -;;; geiser-completion.el -- tab completion -*- lexical-binding: t; -*- - -;; Copyright (C) 2009-2012, 2018, 2020-2022 Jose Antonio Ortega Ruiz - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the Modified BSD License. You should -;; have received a copy of the license along with this program. If -;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>. - -;; Start date: Mon Feb 09, 2009 22:21 - - -;;; Code: - -(require 'geiser-impl) -(require 'geiser-eval) -(require 'geiser-log) -(require 'geiser-syntax) -(require 'geiser-base) - -(require 'comint) -(require 'minibuffer) - - -;;; Minibuffer maps: - -(defvar geiser-completion--minibuffer-map - (let ((map (make-keymap))) - (set-keymap-parent map minibuffer-local-completion-map) - (define-key map "?" 'self-insert-command) - map)) - -(defvar geiser-completion--module-minibuffer-map - (let ((map (make-keymap))) - (set-keymap-parent map minibuffer-local-completion-map) - (define-key map " " 'self-insert-command) - (define-key map "?" 'self-insert-command) - map)) - - -;;; Completion functionality: - -(defvar geiser-completion--binding-forms nil) -(geiser-impl--register-local-variable - 'geiser-completion--binding-forms 'binding-forms nil - "A list of forms introducing local bindings, a la let or lambda.") - -(defvar geiser-completion--binding-forms* nil) -(geiser-impl--register-local-variable - 'geiser-completion--binding-forms* 'binding-forms* nil - "A list of forms introducing nested local bindings, a la let*.") - -(defsubst geiser-completion--locals () - (geiser-syntax--locals-around-point geiser-completion--binding-forms - geiser-completion--binding-forms*)) - -(defun geiser-completion--symbol-list (prefix) - (geiser--del-dups - (append (all-completions prefix (geiser-completion--locals)) - (geiser-eval--send/result `(:eval (:ge completions ,prefix)))))) - -(defsubst geiser-completion--module-list (prefix) - (geiser-eval--send/result `(:eval (:ge module-completions ,prefix)))) - -(defvar geiser-completion-module-list-func - (completion-table-dynamic 'geiser-completion--module-list t)) - -(defvar geiser-completion-symbol-list-func - (completion-table-dynamic 'geiser-completion--symbol-list t)) - -(defun geiser-completion--complete (prefix modules) - (if modules - (geiser-completion--module-list prefix) - (geiser-completion--symbol-list prefix))) - -(defvar geiser-completion--symbol-history nil) - -(defun geiser-completion--read-symbol (prompt &optional default history) - (let ((minibuffer-local-completion-map geiser-completion--minibuffer-map)) - (make-symbol (completing-read prompt - geiser-completion-symbol-list-func - nil nil nil - (or history - geiser-completion--symbol-history) - (or default - (symbol-name (geiser--symbol-at-point))))))) - -(defvar geiser-completion--module-history nil) - -(defun geiser-completion--read-module (&optional prompt default history) - (let ((minibuffer-local-completion-map geiser-completion--module-minibuffer-map)) - (completing-read (or prompt "Module name: ") - geiser-completion-module-list-func - nil nil nil - (or history geiser-completion--module-history) - default))) - -(defvar geiser-completion--symbol-begin-function nil) - -(defun geiser-completion--def-symbol-begin (_module) - (save-excursion (skip-syntax-backward "^-()>") (point))) - -(geiser-impl--register-local-method - 'geiser-completion--symbol-begin-function 'find-symbol-begin - 'geiser-completion--def-symbol-begin - "An optional function finding the position of the beginning of -the identifier around point. Takes a boolean, indicating whether -we're looking for a module name.") - -(defun geiser-completion--symbol-begin (module) - (funcall geiser-completion--symbol-begin-function module)) - -(defun geiser-completion--module-at-point () - (save-excursion - (goto-char (geiser-completion--symbol-begin t)) - (ignore-errors (thing-at-point 'sexp)))) - -(defsubst geiser-completion--prefix (module) - (buffer-substring-no-properties (geiser-completion--symbol-begin module) - (point))) - -(defsubst geiser-completion--prefix-end (beg mod) - (unless (or (eq beg (point-max)) - (member (char-syntax (char-after beg)) - (if mod '(?\" ?\)) '(?\" ?\( ?\))))) - (let ((pos (point))) - (condition-case nil - (save-excursion - (goto-char beg) - (forward-sexp 1) - (when (>= (point) pos) - (point))) - (scan-error pos))))) - - -;;; Smart tab mode: - -(defvar-local geiser-smart-tab-mode-string " SmartTab" - "Modeline indicator for geiser-smart-tab-mode") - -(define-minor-mode geiser-smart-tab-mode - "Toggle smart tab mode. -With no argument, this command toggles the mode. -Non-null prefix argument turns on the mode. -Null prefix argument turns off the mode. - -When this mode is enable, TAB will indent if at point is at -beginning of line or after a white space or closing parenthesis, -and will try completing symbol at point otherwise." - :init-value nil - :lighter geiser-smart-tab-mode-string - :group 'geiser-mode - (set (make-local-variable 'tab-always-indent) - (if geiser-smart-tab-mode - 'complete - (default-value 'tab-always-indent)))) - - -(provide 'geiser-completion) diff --git a/elpa/geiser-0.30/geiser-connection.el b/elpa/geiser-0.30/geiser-connection.el @@ -1,286 +0,0 @@ -;;; geiser-connection.el -- talking to a scheme process -*- lexical-binding: t; -*- - -;; Copyright (C) 2009-2011, 2013, 2021-2022 Jose Antonio Ortega Ruiz - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the Modified BSD License. You should -;; have received a copy of the license along with this program. If -;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>. - -;; Start date: Sat Feb 07, 2009 21:11 - -;;; Commentary: - -;; Connection datatype and functions for managing request queues -;; between emacs and inferior guile processes. - - -;;; Code: - -(require 'geiser-log) -(require 'geiser-syntax) -(require 'geiser-base) -(require 'geiser-impl) - -(require 'tq) -(eval-when-compile (require 'subr-x)) - - -;;; Buffer connections: - -(defvar-local geiser-con--connection nil) - -(defun geiser-con--get-connection (buffer/proc) - (if (processp buffer/proc) - (geiser-con--get-connection (process-buffer buffer/proc)) - (with-current-buffer buffer/proc geiser-con--connection))) - - -;;; Request datatype: - -(defun geiser-con--make-request (con str cont &optional sender-buffer) - (list (cons :id (geiser-con--connection-inc-count con)) - (cons :string str) - (cons :continuation cont) - (cons :buffer (or sender-buffer (current-buffer))) - (cons :connection con))) - -(defsubst geiser-con--request-id (req) - (cdr (assq :id req))) - -(defsubst geiser-con--request-string (req) - (cdr (assq :string req))) - -(defsubst geiser-con--request-continuation (req) - (cdr (assq :continuation req))) - -(defsubst geiser-con--request-buffer (req) - (cdr (assq :buffer req))) - -(defsubst geiser-con--request-connection (req) - (cdr (assq :connection req))) - -(defsubst geiser-con--request-deactivate (req) - (setcdr (assq :continuation req) nil)) - -(defsubst geiser-con--request-deactivated-p (req) - (null (cdr (assq :continuation req)))) - - -;;; Connection datatype: - -(defun geiser-con--tq-create (process) - (let ((tq (tq-create process))) - (set-process-filter process (lambda (_p s) (geiser-con--tq-filter tq s))) - tq)) - -(defun geiser-con--tq-filter (tq in) - (when (buffer-live-p (tq-buffer tq)) - (with-current-buffer (tq-buffer tq) - (if (tq-queue-empty tq) - (progn (geiser-log--error "Unexpected queue input:\n %s" in) - (delete-region (point-min) (point-max))) - (goto-char (point-max)) - (insert in) - (goto-char (point-min)) - (when (re-search-forward (tq-queue-head-regexp tq) nil t) - (unwind-protect - (funcall (tq-queue-head-fn tq) - (tq-queue-head-closure tq) - (buffer-substring (point-min) (point))) - (delete-region (point-min) (point-max)) - (tq-queue-pop tq))))))) - -(defun geiser-con--combined-prompt (prompt debug) - (if debug (format "\\(%s\\)\\|\\(%s\\)" prompt debug) prompt)) - -(defun geiser-con--connection-eot-re (prompt debug) - (geiser-con--combined-prompt (format "\n\\(%s\\)" prompt) - (and debug (format "\n\\(%s\\)" debug)))) - -(defun geiser-con--make-connection (proc prompt debug-prompt) - (list t - (cons :filter (process-filter proc)) - (cons :tq (geiser-con--tq-create proc)) - (cons :tq-filter (process-filter proc)) - (cons :eot (geiser-con--connection-eot-re prompt debug-prompt)) - (cons :prompt prompt) - (cons :debug-prompt debug-prompt) - (cons :is-debugging nil) - (cons :count 0) - (cons :completed (make-hash-table :weakness 'value)))) - -(defsubst geiser-con--connection-process (c) - (tq-process (cdr (assq :tq c)))) - -(defsubst geiser-con--connection-filter (c) - (cdr (assq :filter c))) - -(defsubst geiser-con--connection-tq-filter (c) - (cdr (assq :tq-filter c))) - -(defsubst geiser-con--connection-tq (c) - (cdr (assq :tq c))) - -(defsubst geiser-con--connection-eot (c) - (cdr (assq :eot c))) - -(defsubst geiser-con--connection-prompt (c) - (cdr (assq :prompt c))) - -(defsubst geiser-con--connection-debug-prompt (c) - (cdr (assq :debug-prompt c))) - -(defsubst geiser-con--connection-is-debugging (c) - (cdr (assq :is-debugging c))) - -(defsubst geiser-con--connection-set-debugging (c d) - (setcdr (assq :is-debugging c) d)) - -(defun geiser-con--connection-update-debugging (c txt) - (let* ((dp (geiser-con--connection-debug-prompt c)) - (is-d (and (stringp dp) (string-match dp txt)))) - (geiser-con--connection-set-debugging c is-d) - is-d)) - -(defsubst geiser-con--connection-completed (c r) - (geiser-con--request-deactivate r) - (puthash (geiser-con--request-id r) r (cdr (assoc :completed c)))) - -(defsubst geiser-con--connection-completed-p (c id) - (gethash id (cdr (assoc :completed c)))) - -(defun geiser-con--connection-inc-count (c) - (let* ((cnt (assoc :count c)) - (new (1+ (cdr cnt)))) - (setcdr cnt new) - new)) - -(defun geiser-con--has-entered-debugger (con answer) - (when-let ((p (car (last (split-string answer "\n" t))))) - (geiser-con--connection-update-debugging con p)) - (geiser-con--connection-is-debugging con)) - -(defun geiser-con--connection-eot-p (con txt) - (and txt - (string-match-p (geiser-con--connection-eot con) txt))) - -(defun geiser-con--connection-close (con) - (let ((tq (geiser-con--connection-tq con))) - (and tq (tq-close tq)))) - -(defvar geiser-con--startup-prompt nil) -(defun geiser-con--startup-prompt (_p s) - (setq geiser-con--startup-prompt - (concat geiser-con--startup-prompt s)) - nil) - -(defun geiser-con--connection-deactivate (c &optional no-wait) - (when (car c) - (let* ((tq (geiser-con--connection-tq c)) - (proc (geiser-con--connection-process c)) - (proc-filter (geiser-con--connection-filter c))) - (unless no-wait - (while (and (not (tq-queue-empty tq)) - (accept-process-output proc 0.1)))) - (set-process-filter proc proc-filter) - (setcar c nil)))) - -(defun geiser-con--connection-activate (c) - (when (not (car c)) - (let* ((proc (geiser-con--connection-process c)) - (tq-filter (geiser-con--connection-tq-filter c))) - (while (accept-process-output proc 0.01)) - (set-process-filter proc tq-filter) - (setcar c t)))) - - -;;; Requests handling: - -(defun geiser-con--req-form (req answer) - (let* ((con (geiser-con--request-connection req)) - (debugging (geiser-con--has-entered-debugger con answer))) - (condition-case err - (let ((start (string-match "((\\(?:result)?\\|error\\) " answer))) - (or (and start (car (read-from-string answer start))) - `((error (key . retort-syntax)) - (output . ,answer) - (debug . ,debugging)))) - (error `((error (key . geiser-con-error)) - (debug . debugging) - (output . ,(format "%s\n(%s)" - answer (error-message-string err)))))))) - -(defun geiser-con--process-completed-request (req answer) - (let ((cont (geiser-con--request-continuation req)) - (id (geiser-con--request-id req)) - (rstr (geiser-con--request-string req)) - (form (geiser-con--req-form req answer)) - (buffer (or (geiser-con--request-buffer req) (current-buffer))) - (con (geiser-con--request-connection req))) - (if (not cont) - (geiser-log--warn "<%s> Dropping result for request %S: %s" - id rstr form) - (condition-case cerr - (with-current-buffer buffer - (funcall cont form) - (geiser-log--info "<%s>: processed" id)) - (error (geiser-log--error - "<%s>: continuation failed %S \n\t%s" id rstr cerr)))) - (geiser-con--connection-completed con req))) - -(defun geiser-con--connection-add-request (c r) - (let ((rstr (geiser-con--request-string r))) - (geiser-log--info "REQUEST: <%s>: %s" - (geiser-con--request-id r) - rstr) - (geiser-con--connection-activate c) - (tq-enqueue (geiser-con--connection-tq c) - (concat rstr "\n") - (geiser-con--connection-eot c) - r - 'geiser-con--process-completed-request - t))) - - -;;; Message sending interface: - -(defun geiser-con--send-string (con str cont &optional sbuf) - (let ((req (geiser-con--make-request con str cont sbuf))) - (geiser-con--connection-add-request con req) - req)) - -(defvar geiser-connection-timeout 30000 - "Time limit, in msecs, blocking on synchronous evaluation requests") - -(defun geiser-con--interrupt (con) - "Interrupt any request being currently in process." - (when-let (proc (and con (geiser-con--connection-process con))) - (when (process-live-p proc) - (interrupt-process proc)))) - -(defun geiser-con--wait (req timeout) - "Wait up to TIMEOUT msecs for request REQ to finish, returning its result." - (let* ((con (or (geiser-con--request-connection req) - (error "Geiser connection not active"))) - (proc (geiser-con--connection-process con)) - (id (geiser-con--request-id req)) - (timeout (/ (or timeout geiser-connection-timeout) 1000.0)) - (step (/ timeout 10))) - (with-timeout (timeout (geiser-con--request-deactivate req)) - (condition-case nil - (while (and (geiser-con--connection-process con) - (not (geiser-con--connection-completed-p con id))) - (accept-process-output proc step)) - (error (geiser-con--request-deactivate req)))))) - -(defun geiser-con--send-string/wait (con str cont &optional timeout sbuf) - (when (and (stringp str) (not (string-blank-p str))) - (save-current-buffer - (let ((proc (and con (geiser-con--connection-process con)))) - (unless proc (error "Geiser connection not active")) - (let ((req (geiser-con--send-string con str cont sbuf))) - (geiser-con--wait req timeout)))))) - - -(provide 'geiser-connection) diff --git a/elpa/geiser-0.30/geiser-custom.el b/elpa/geiser-0.30/geiser-custom.el @@ -1,80 +0,0 @@ -;;; geiser-custom.el -- customization utilities -*- lexical-binding: t; -*- - -;; Copyright (C) 2009, 2010, 2012 Jose Antonio Ortega Ruiz - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the Modified BSD License. You should -;; have received a copy of the license along with this program. If -;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>. - -;; Start date: Sat Feb 14, 2009 21:49 - - -;;; Code: - -(require 'font-lock) -(require 'geiser-base) - - -;;; Customization group: - -(defgroup geiser nil - "Geiser framework for Scheme-Emacs interaction." - :group 'languages) - - -;;; Faces: - -(defgroup geiser-faces nil - "Faces used by Geiser." - :group 'geiser - :group 'faces) - -(defmacro geiser-custom--defface (face def group doc) - (declare (doc-string 4) (indent 1)) - (let ((face (intern (format "geiser-font-lock-%s" face)))) - `(defface ,face (face-default-spec ,def) - ,(format "Face for %s." doc) - :group ',group - :group 'geiser-faces))) - -;;; Reload support: - -(defvar geiser-custom--memoized-vars nil) - -(defun geiser-custom--memoize (name) - ;; FIXME: Why not build this list with mapatoms, filtering on a "\\`'geiser-" - ;; prefix and checking that it's a `defcustom', so we don't need - ;; `geiser-custom--defcustom'? - (add-to-list 'geiser-custom--memoized-vars name)) - -(defmacro geiser-custom--defcustom (name &rest body) - "Like `defcustom' but also put NAME on an internal list. -That list is used by `geiser-reload' to preserve the values -of the listed variables. It is not used for anything else." - ;; FIXME Remembering the value like this is not actually - ;; necessary. Evaluating `defcustom' always preserves the - ;; existing value, if any. - (declare (doc-string 3) (debug (name body)) (indent 2)) - `(progn - (geiser-custom--memoize ',name) - (defcustom ,name ,@body))) - -(defun geiser-custom--memoized-state () - (let ((result)) - (dolist (name geiser-custom--memoized-vars result) - (when (boundp name) - (push (cons name (symbol-value name)) result))))) - - -(defconst geiser-custom-font-lock-keywords - (eval-when-compile - `((,(concat "(\\(geiser-custom--\\(?:defcustom\\|defface\\)\\)\\_>" - "[ \t'\(]*" - "\\(\\(?:\\sw\\|\\s_\\)+\\)?") - (1 font-lock-keyword-face) - (2 font-lock-variable-name-face nil t))))) - -(font-lock-add-keywords 'emacs-lisp-mode geiser-custom-font-lock-keywords) - -(provide 'geiser-custom) diff --git a/elpa/geiser-0.30/geiser-debug.el b/elpa/geiser-0.30/geiser-debug.el @@ -1,313 +0,0 @@ -;;; geiser-debug.el -- displaying debug and eval info -*- lexical-binding: t; -*- - -;; Copyright (C) 2009-2016, 2020-2022 Jose Antonio Ortega Ruiz - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the Modified BSD License. You should -;; have received a copy of the license along with this program. If -;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>. - -;; Start date: Mon Feb 23, 2009 22:34 - - -;;; Code: - -(eval-when-compile (require 'cl-macs)) - -(require 'geiser-edit) -(require 'geiser-autodoc) -(require 'geiser-impl) -(require 'geiser-eval) -(require 'geiser-menu) -(require 'geiser-popup) -(require 'geiser-base) -(require 'geiser-image) - -(require 'ansi-color) -(require 'compile) - -(declare-function geiser-repl--switch-to-buffer "geiser-repl" (buffer)) - - -;;; Customization: - -(defgroup geiser-debug nil - "Debugging and error display options." - :group 'geiser) - -(define-obsolete-variable-alias 'geiser-debug-always-display-sexp-after-p - 'geiser-debug-always-display-sexp-after "0.26.2") - -(geiser-custom--defcustom geiser-debug-always-display-sexp-after nil - "Whether to always display the sexp whose evaluation caused an -error after the error message in the debug pop-up. - -If nil, expressions shorter than `geiser-debug-long-sexp-lines` -lines are shown before the error message." - :type 'boolean) - -(geiser-custom--defcustom geiser-debug-long-sexp-lines 6 - "Length of an expression in order to be relegated to the bottom -of the debug pop-up (after the error message). - -If `geiser-debug-always-display-sexp-after` is t, this variable -has no effect." - :type 'int) - -(define-obsolete-variable-alias 'geiser-debug-jump-to-debug-p - 'geiser-debug-jump-to-debug "0.26.2") - -(geiser-custom--defcustom geiser-debug-jump-to-debug t - "When set to t (the default), jump to the debug pop-up buffer -in case of evaluation errors. - -See also `geiser-debug-show-debug`. " - :type 'boolean) - -(define-obsolete-variable-alias 'geiser-debug-show-debug-p - 'geiser-debug-show-debug "0.26.2") - -(geiser-custom--defcustom geiser-debug-auto-next-error-p nil - "When set, automatically invoke `next-error' on of evaluation errors. - -This will make point jump to the location of an error if the output -of the evaluation contains any." - :type 'boolean) - -(geiser-custom--defcustom geiser-debug-show-debug t - "When set to t (the default), show the debug pop-up buffer in -case of evaluation errors. - -This option takes effect even if `geiser-debug-jump-to-debug` -is set." - :type 'boolean) - -(define-obsolete-variable-alias 'geiser-debug-auto-display-images-p - 'geiser-debug-auto-display-images "0.26.2") - -(geiser-custom--defcustom geiser-debug-auto-display-images t - "Whether to automatically invoke the external viewer to display -images when they're evaluated. - -See also `geiser-repl-auto-display-images-p'." - :type 'boolean) - -(geiser-custom--defcustom geiser-debug-treat-ansi-colors nil - "Colorize ANSI escape sequences produced by the scheme process. - -Some schemes are able to colorize their evaluation or error -results using ANSI color sequences (e.g. when using the the -colorized module in Guile). - -If set to `nil', no special treatment is applied to output. The -symbol colors indicates colorizing the display of the Geiser debug -buffer using any color escape, and the symbol remove to remove -all ANSI sequences." - :type '(choice (const :tag "No special treatment" nil) - (const :tag "Use font lock for colors" colors) - (const :tag "Remove all ANSI codes" remove))) - - -;;; Debug buffer mode: - -(defvar geiser-debug-mode-map - (let ((map (make-sparse-keymap))) - (suppress-keymap map) - map) - "Keymap for `geiser-debug-mode'.") - -(define-derived-mode geiser-debug-mode nil "Geiser Debug" - "A major mode for displaying Scheme compilation and evaluation results. -\\{geiser-debug-mode-map}" - (buffer-disable-undo) - (set-syntax-table scheme-mode-syntax-table) - (setq next-error-function 'geiser-edit--open-next) - (compilation-setup nil) - (setq buffer-read-only t)) - -(defvar-local geiser-debug--debugger-active nil) -(defvar-local geiser-debug--sender-buffer nil) - -(defun geiser-debug-active-p () - "Check whether debugger has been entered by a scheme buffer operation." - (and geiser-debug--debugger-active geiser-debug--sender-buffer)) - -(defun geiser-debug-switch-to-buffer () - "Return to the scheme buffer that pooped this debug window." - (interactive) - (when geiser-debug--sender-buffer - (geiser-repl--switch-to-buffer geiser-debug--sender-buffer))) - -(geiser-menu--defmenu debug geiser-debug-mode-map - ("Next error" ("n" [?\t]) compilation-next-error) - ("Previous error" ("p" "\e\t" [backtab]) compilation-previous-error) - ("Next error location" ((kbd "M-n")) next-error) - ("Previous error location" ((kbd "M-p")) previous-error) - ("Source buffer" ("z" (kbd "C-c C-z")) geiser-debug-switch-to-buffer) - -- - ("Quit" nil View-quit)) - - -;;; Implementation-dependent functionality -(geiser-impl--define-caller geiser-debug--clean-up-output clean-up-output (output) - "Clean up output from an evaluation for display.") - - -;;; Buffer for displaying evaluation results: - -(geiser-popup--define debug "*Geiser Debug*" geiser-debug-mode) - - -;;; Displaying retorts - -(geiser-impl--define-caller geiser-debug--display-error - display-error (module key message) - "This method takes 3 parameters (a module name, the error key, -and the accompanying error message) and should display -(in the current buffer) a formatted version of the error. If the -error was successfully displayed, the call should evaluate to a -non-null value.") - -(geiser-impl--define-caller geiser-debug--enter-debugger - enter-debugger () - "This method is called upon entering the debugger, in the REPL -buffer.") - -(defun geiser-debug--display-after (what) - (or geiser-debug-always-display-sexp-after - (>= (with-temp-buffer - (insert what) - (count-lines (point-min) (point-max))) - geiser-debug-long-sexp-lines))) - -(defun geiser-debug--insert-res (res) - (let ((begin (point))) - (insert res) - (let ((end (point))) - (goto-char begin) - (let ((no (geiser-image--replace-images t - geiser-debug-auto-display-images))) - (goto-char end) - (newline 2) - (and no (> no 0)))))) - -(defun geiser-debug--default-display-error (key msg) - (insert "\n" - (if key (format "Error: %s\n" key) "") - (format "%s" (or msg "")) "\n")) - -(defun geiser-debug--display-retort (what ret &optional res _auto-p) - (let* ((err (geiser-eval--retort-error ret)) - (key (geiser-eval--error-key err)) - (debug (alist-get 'debug ret)) - (impl geiser-impl--implementation) - (output (geiser-eval--retort-output ret)) - (output (and (stringp output) - (not (string= output "")) - (or (geiser-debug--clean-up-output impl output) output))) - (module (geiser-eval--get-module)) - (img nil) - (dir default-directory) - (buffer (current-buffer)) - (debug-entered (when debug (geiser-debug--enter-debugger impl))) - (after (geiser-debug--display-after what))) - (unless debug-entered - (geiser-debug--with-buffer - (when (and (not debug) geiser-debug--debugger-active) - (message "Debugger exited")) - (setq geiser-debug--debugger-active debug - geiser-debug--sender-buffer buffer - geiser-impl--implementation impl) - (erase-buffer) - (when dir (setq default-directory dir)) - (unless after (insert what "\n\n")) - (setq img (when (and res (not err) (not debug)) - (geiser-debug--insert-res res))) - (when (or err key output) - (when (fboundp 'next-error-select-buffer) - (next-error-select-buffer (current-buffer))) - (let ((msg (or (geiser-eval--error-msg err) output ""))) - (or (geiser-debug--display-error impl module key msg) - (geiser-debug--default-display-error key msg)) - (unless err (geiser-edit--buttonize-files)))) - (when after - (goto-char (point-max)) - (insert "\nExpression evaluated was:\n\n") - (insert what "\n")) - (cl-case geiser-debug-treat-ansi-colors - (colors (ansi-color-apply-on-region (point-min) (point-max))) - (remove (ansi-color-filter-region (point-min) (point-max)))) - (goto-char (point-min))) - (when (or img err output) - (cond (geiser-debug-jump-to-debug - (geiser-debug--pop-to-buffer)) - (geiser-debug-show-debug - (display-buffer (geiser-debug--buffer)))) - (when (and err geiser-debug-auto-next-error-p) - (ignore-errors (next-error)) - (message "=> %s" output)))))) - -(defsubst geiser-debug--wrap-region (str) - (format "(begin %s\n)" str)) - -(defun geiser-debug--unwrap (str) - (if (string-match "(begin[ \t\n\v\r]+\\(.+\\)*)" str) - (match-string 1 str) - str)) - -(defun geiser-debug--send-region (compile start end and-go wrap &optional nomsg) - "Evaluate (or COMPILE) the region delimited by START and END. -The result of the evaluation is reported asynchronously, so this -call is not blocking. If AND-GO is t, also jump to the repl -buffer. If WRAP is t, the region's content is wrapped in a begin -form. The flag NOMSG can be used to avoid reporting of the -result in the minibuffer." - (let* ((str (buffer-substring-no-properties start end)) - (wrapped (if wrap (geiser-debug--wrap-region str) str)) - (code `(,(if compile :comp :eval) (:scm ,wrapped))) - (cont (lambda (ret) - (let ((res (geiser-eval--retort-result-str ret nil)) - (scstr (geiser-syntax--scheme-str str))) - (when and-go (funcall and-go)) - (unless (geiser-eval--retort-error ret) - (save-excursion - (goto-char (/ (+ end start) 2)) - (geiser-autodoc--clean-cache)) - (unless nomsg - (save-match-data - (when (string-match "\\(?:[ \t\n\r]+\\)\\'" res) - (setq res (replace-match "" t t res)))) - (message "%s" res))) - (geiser-debug--display-retort scstr ret res))))) - (geiser-eval--send code cont (current-buffer)))) - -(defun geiser-debug--send-region/wait (compile start end timeout) - "Synchronous version of `geiser-debug--send-region', returning its result." - (let* ((str (buffer-substring-no-properties start end)) - (wrapped (geiser-debug--wrap-region str)) - (code `(,(if compile :comp :eval) (:scm ,wrapped)))) - (message "evaluating: %s" code) - (geiser-eval--send/wait code timeout))) - -(defun geiser-debug--expand-region (start end all wrap) - (let* ((str (buffer-substring-no-properties start end)) - (wrapped (if wrap (geiser-debug--wrap-region str) str)) - (code - `(:eval (:ge macroexpand (quote (:scm ,wrapped)) ,(if all :t :f)))) - (cont (lambda (ret) - (let ((err (geiser-eval--retort-error ret)) - (result (geiser-eval--retort-result ret))) - (if err - (geiser-debug--display-retort str ret) - (geiser-debug--with-buffer - (erase-buffer) - (insert (format "%s" - (if wrap - (geiser-debug--unwrap result) - result))) - (goto-char (point-min))) - (geiser-debug--pop-to-buffer)))))) - (geiser-eval--send code cont (current-buffer)))) - - -(provide 'geiser-debug) diff --git a/elpa/geiser-0.30/geiser-doc.el b/elpa/geiser-0.30/geiser-doc.el @@ -1,510 +0,0 @@ -;;; geiser-doc.el -- accessing scheme-provided documentation -*- lexical-binding: t; -*- - -;; Copyright (C) 2009-2016, 2021-2022 Jose Antonio Ortega Ruiz - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the Modified BSD License. You should -;; have received a copy of the license along with this program. If -;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>. - -;; Start date: Sat Feb 14, 2009 14:09 - - -;;; Code: - -(require 'geiser-edit) -(require 'geiser-impl) -(require 'geiser-completion) -(require 'geiser-autodoc) -(require 'geiser-eval) -(require 'geiser-syntax) -(require 'geiser-menu) -(require 'geiser-popup) -(require 'geiser-custom) -(require 'geiser-base) - -(require 'button) -(eval-when-compile (require 'subr-x)) - - -;;; Customization: - -(defgroup geiser-doc nil - "Options for documentation buffers." - :group 'geiser) - -(geiser-custom--defface doc-title - 'bold geiser-doc "article titles in documentation buffers") - -(geiser-custom--defface doc-link - 'link geiser-doc "links in documentation buffers") - -(geiser-custom--defface doc-button - 'button geiser-doc "buttons in documentation buffers") - - -;;; Implementation -(geiser-impl--define-caller geiser-doc--external-help external-help - (symbol module) - "By default, Geiser will display help about an identifier in a -help buffer, after collecting the associated signature and -docstring. You can provide an alternative function for displaying -help (e.g. browse an HTML page) implementing this method.") - -(geiser-impl--define-caller geiser-doc--display-docstring - display-docstring (ret) - "This method receives the result of calling the geiser scheme -procedure symbol-documentation and should display it in the -current buffer. By default, geiser looks for the value of the -key docstring in the result, assumed to be an alist, and inserts -it verbatim at point if it's a string. Providing an -implementation of this method may be useful if displaying the -info returned by the scheme side (display-docstring) needs more -elaboration on emacs' side. This method should return a truthy -value if the default action should be skipped.") - - -;;; Documentation browser history: - -(defvar geiser-doc-history-size 50) -(defvar geiser-doc--history nil) - -(defun geiser-doc--make-history () - (list nil ; current - (make-ring geiser-doc-history-size) ; previous - (make-ring geiser-doc-history-size))) ; next - -(setq geiser-doc--history (geiser-doc--make-history)) - -(defsubst geiser-doc--history-current () - (car geiser-doc--history)) - -(defsubst geiser-doc--history-previous-link () - (ring-ref (cadr geiser-doc--history) 0)) - -(defsubst geiser-doc--history-next-link () - (ring-ref (car (cddr geiser-doc--history)) 0)) - -(defun geiser-doc--history-push (link) - (unless (or (null link) (equal link (geiser-doc--history-current))) - (when (not (null (geiser-doc--history-current))) - (let ((next (geiser-doc--history-next))) - (unless (equal link next) - (when next (geiser-doc--history-previous)) - (ring-insert (nth 1 geiser-doc--history) - (car geiser-doc--history))))) - (setcar geiser-doc--history link)) - link) - -(defsubst geiser-doc--history-next-p () - (not (ring-empty-p (nth 2 geiser-doc--history)))) - -(defun geiser-doc--history-next (&optional forget-current) - (when (geiser-doc--history-next-p) - (when (and (car geiser-doc--history) (not forget-current)) - (ring-insert (nth 1 geiser-doc--history) (car geiser-doc--history))) - (setcar geiser-doc--history (ring-remove (nth 2 geiser-doc--history) 0)))) - -(defsubst geiser-doc--history-previous-p () - (not (ring-empty-p (nth 1 geiser-doc--history)))) - -(defun geiser-doc--history-previous (&optional forget-current) - (when (geiser-doc--history-previous-p) - (when (and (car geiser-doc--history) (not forget-current)) - (ring-insert (nth 2 geiser-doc--history) (car geiser-doc--history))) - (setcar geiser-doc--history (ring-remove (nth 1 geiser-doc--history) 0)))) - - -;;; Links - -(defsubst geiser-doc--make-link (target module impl) - (list target module impl)) - -(defsubst geiser-doc--link-target (link) - (nth 0 link)) - -(defsubst geiser-doc--link-module (link) - (nth 1 link)) - -(defsubst geiser-doc--link-impl (link) - (nth 2 link)) - -(defun geiser-doc--follow-link (link) - (let ((target (geiser-doc--link-target link)) - (module (geiser-doc--link-module link)) - (impl (geiser-doc--link-impl link))) - (when (and (or target module) impl) - (with--geiser-implementation impl - (if (null target) - (geiser-doc-module module impl) - (let ((geiser-eval--get-module-function (lambda (_) module))) - (geiser-doc-symbol target module impl))))))) - -(defvar-local geiser-doc--buffer-link nil) - -(defsubst geiser-doc--implementation () - (geiser-doc--link-impl geiser-doc--buffer-link)) - -(defun geiser-doc--button-action (button) - (let ((link (button-get button 'geiser-link))) - (when link (geiser-doc--follow-link link)))) - -(define-button-type 'geiser-doc--button - 'action 'geiser-doc--button-action - 'follow-link t) - -(defun geiser-doc--make-module-button (beg end module impl) - (let ((link (geiser-doc--make-link nil module impl)) - (help (format "Help for module %s" module))) - (make-text-button beg end :type 'geiser-doc--button - 'face 'geiser-font-lock-doc-link - 'geiser-link link - 'help-echo help))) - -(defun geiser-doc--insert-button (target module impl &optional sign) - (let* ((link (geiser-doc--make-link target module impl)) - (sign (when sign (if (listp sign) sign (list target)))) - (text (format "%s" (or (and sign (geiser-autodoc--str* sign)) - target - module))) - (help (format "%smodule %s" - (if target (format "%s in " target) "") - (or module "<unknown>")))) - (insert-text-button text - :type 'geiser-doc--button - 'face 'geiser-font-lock-doc-link - 'geiser-link link - 'help-echo help))) - -(defun geiser-doc-goto-source () - "Go to the definition of this item." - (interactive) - (when-let (link geiser-doc--buffer-link) - (with--geiser-implementation (geiser-doc--link-impl link) - (if-let (target (geiser-doc--link-target link)) - (geiser-edit-symbol target nil (point-marker)) - (geiser-edit-module (geiser-doc--link-module link)))))) - -(defun geiser-doc-goto-manual () - "Go to the manual for this item." - (interactive) - (when-let (link geiser-doc--buffer-link) - (let ((tm (geiser-doc--link-target link)) - (mod (geiser-doc--link-module link)) - (impl (geiser-doc--link-impl link))) - (geiser-doc--external-help impl (or tm mod) mod)))) - -(defun geiser-doc--xbutton-action (button) - (let ((k (button-get button 'x-kind))) - (cond ((eq 'source k) (geiser-doc-goto-source)) - ((eq 'manual k) (geiser-doc-goto-manual))))) - -(define-button-type 'geiser-doc--xbutton - 'action 'geiser-doc--xbutton-action - 'face 'geiser-font-lock-doc-button - 'follow-link t) - -(defun geiser-doc--insert-xbutton (&optional manual) - (let ((label (if manual "[manual]" "[source]")) - (help (if manual "Look up in Scheme manual" "Go to definition"))) - (insert-text-button label - :type 'geiser-doc--xbutton - 'help-echo help - 'x-kind (if manual 'manual 'source)))) - -(defun geiser-doc--insert-xbuttons (impl) - (when (geiser-impl--method 'external-help impl) - (geiser-doc--insert-xbutton t) - (insert " ")) - (geiser-doc--insert-xbutton)) - -(defun geiser-doc--insert-nav-button (next) - (let* ((lnk (if next (geiser-doc--history-next-link) - (geiser-doc--history-previous-link))) - (what (geiser-doc--link-target lnk)) - (what (or what (geiser-doc--link-module lnk))) - (action (if next '(lambda (b) (geiser-doc-next)) - '(lambda (b) (geiser-doc-previous))))) - (insert-text-button (if next "[forward]" "[back]") - 'action action - 'help-echo (format "Previous help item (%s)" what) - 'face 'geiser-font-lock-doc-button - 'follow-link t))) - - -;;; Auxiliary functions: - -(defun geiser-doc--manual-available-p () - (geiser-impl--method 'external-help geiser-impl--implementation)) - -(defun geiser-doc--module (&optional mod impl) - (let ((impl (or impl (geiser-doc--link-impl geiser-doc--buffer-link))) - (mod (or mod (geiser-doc--link-module geiser-doc--buffer-link)))) - (geiser-impl--call-method 'find-module impl mod))) - -(defun geiser-doc--insert-title (title) - (let ((p (point))) - (insert (format "%s" title)) - (fill-paragraph nil) - (let ((indent-line-function 'lisp-indent-line)) - (indent-region p (point))) - (put-text-property p (point) 'face 'geiser-font-lock-doc-title) - (newline))) - -(defun geiser-doc--insert-list (title lst module impl) - (when lst - (geiser-doc--insert-title title) - (newline) - (dolist (w lst) - (let ((name (car w)) - (signature (cdr (assoc "signature" w))) - (info (cdr (assoc "info" w)))) - (insert "\t- ") - (if module - (geiser-doc--insert-button name module impl signature) - (geiser-doc--insert-button nil name impl)) - (when info (insert (format " %s" info))) - (newline))) - (newline))) - -(defun geiser-doc--insert-footer (impl) - (newline 2) - (geiser-doc--insert-xbuttons impl) - (let* ((prev (and (geiser-doc--history-previous-p) 8)) - (nxt (and (geiser-doc--history-next-p) 10)) - (len (max 1 (- (window-width) - (- (point) (line-beginning-position)) - (or prev 0) - (or nxt 0))))) - (when (or prev nxt) - (insert (make-string len ?\ ))) - (when prev - (geiser-doc--insert-nav-button nil) - (insert " ")) - (when nxt - (geiser-doc--insert-nav-button t)))) - - -;;; Documentation browser and mode: - -(defun geiser-doc-edit-symbol-at-point () - "Open definition of symbol at point." - (interactive) - (let* ((impl (geiser-doc--implementation)) - (module (geiser-doc--module))) - (unless (and impl module) - (error "I don't know what module this buffer refers to.")) - (with--geiser-implementation impl - (geiser-edit-symbol-at-point)))) - -(defvar geiser-doc-mode-map - (let ((map (make-sparse-keymap))) - (suppress-keymap map) - (set-keymap-parent map button-buffer-map) - map) - "Keymap for `geiser-doc-mode'.") - -(declare-function geiser-repl--switch-to-repl "geiser-repl") - -(defun geiser-doc-switch-to-repl () - (interactive) - (geiser-repl--switch-to-repl)) - -(geiser-menu--defmenu doc geiser-doc-mode-map - ("Next link" ("n") forward-button) - ("Previous link" ("p") backward-button) - ("Next section" ("N") geiser-doc-next-section) - ("Previous section" ("P") geiser-doc-previous-section) - -- - ("Next page" ("f") geiser-doc-next "Next item" - :enable (geiser-doc--history-next-p)) - ("Previous page" ("b") geiser-doc-previous "Previous item" - :enable (geiser-doc--history-previous-p)) - -- - ("Go to REPL" ("z" "\C-cz" "\C-c\C-z") geiser-doc-switch-to-repl) - ("Refresh" ("g" "r") geiser-doc-refresh "Refresh current page") - -- - ("Edit symbol" ("." "\M-.") geiser-doc-edit-symbol-at-point - :enable (geiser--symbol-at-point)) - ("View source" ("s") geiser-doc-goto-source) - ("View manual" ("m" "h") geiser-doc-goto-manual) - -- - ("Kill item" "k" geiser-doc-kill-page "Kill this page") - ("Clear history" "c" geiser-doc-clean-history) - -- - (custom "Browser options" geiser-doc) - -- - ("Quit" nil View-quit)) - -(define-derived-mode geiser-doc-mode nil "Geiser Doc" - "Major mode for browsing scheme documentation. -\\{geiser-doc-mode-map}" - (buffer-disable-undo) - (setq truncate-lines t) - (set-syntax-table scheme-mode-syntax-table) - (setq geiser-eval--get-module-function 'geiser-doc--module) - (setq buffer-read-only t)) - -(geiser-popup--define doc "*Geiser Documentation*" geiser-doc-mode) - - -;;; Commands: - -(defun geiser-doc--get-docstring (symbol module) - (geiser-eval--send/result - `(:eval (:ge symbol-documentation ',symbol) ,module))) - -(defun geiser-doc--get-module-exports (module) - (geiser-eval--send/result - `(:eval (:ge module-exports '(:module ,module)) :f))) - -(defun geiser-doc--buttonize-modules (impl) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "in module \\([^.\n]+\\)[.\n ]" nil t) - (geiser-doc--make-module-button (match-beginning 1) - (match-end 1) - (geiser-doc--module (match-string 1) - impl) - impl)))) - -(defun geiser-doc--render-docstring (docstring symbol &optional module impl) - (erase-buffer) - (geiser-doc--insert-title - (geiser-autodoc--str* (cdr (assoc "signature" docstring)))) - (newline) - (or (geiser-doc--display-docstring impl docstring) - (insert (or (cdr (assoc "docstring" docstring)) ""))) - (geiser-doc--buttonize-modules impl) - (setq geiser-doc--buffer-link - (geiser-doc--history-push (geiser-doc--make-link symbol - module - impl))) - (geiser-doc--insert-footer impl) - (goto-char (point-min))) - -(defun geiser-doc-symbol (symbol &optional module impl) - (let* ((impl (or impl geiser-impl--implementation)) - (module (geiser-doc--module (or module (geiser-eval--get-module)) - impl))) - (let ((ds (geiser-doc--get-docstring symbol module))) - (if (or (not ds) (not (listp ds))) - (message "No documentation available for '%s'" symbol) - (geiser-doc--with-buffer - (geiser-doc--render-docstring ds symbol module impl)) - (geiser-doc--pop-to-buffer))))) - -(defun geiser-doc-symbol-at-point (&optional arg) - "Get docstring for symbol at point. -With prefix argument, ask for symbol (with completion)." - (interactive "P") - (let ((symbol (or (and (not arg) (geiser--symbol-at-point)) - (geiser-completion--read-symbol - "Symbol: " (geiser--symbol-at-point))))) - (when symbol (geiser-doc-symbol symbol)))) - -(defun geiser-doc-manual-for-symbol (symbol) - (geiser-doc--external-help geiser-impl--implementation - symbol - (geiser-eval--get-module))) - -(defun geiser-doc-look-up-manual (&optional arg) - "Look up manual for symbol at point. -With prefix argument, ask for the lookup symbol (with completion)." - (interactive "P") - (unless (geiser-doc--manual-available-p) - (error "No manual available")) - (let ((symbol (or (and (not arg) (geiser--symbol-at-point)) - (geiser-completion--read-symbol "Symbol: ")))) - (geiser-doc-manual-for-symbol symbol))) - -(defconst geiser-doc--sections '(("Procedures:" "procs") - ("Syntax:" "syntax") - ("Variables:" "vars") - ("Submodules:" "modules" t))) - -(defconst geiser-doc--sections-re - (format "^%s\n" (regexp-opt (mapcar 'car geiser-doc--sections)))) - -(defun geiser-doc-module (&optional module impl) - "Display information about a given module." - (interactive) - (let* ((impl (or impl geiser-impl--implementation)) - (module (geiser-doc--module (or module - (geiser-completion--read-module)) - impl)) - (msg (format "Retrieving documentation for %s ..." module)) - (exports (progn - (message "%s" msg) - (geiser-doc--get-module-exports module)))) - (if (not exports) - (message "No information available for %s" module) - (geiser-doc--with-buffer - (erase-buffer) - (geiser-doc--insert-title (format "%s" module)) - (newline) - (dolist (g geiser-doc--sections) - (geiser-doc--insert-list (car g) - (cdr (assoc (cadr g) exports)) - (and (not (cddr g)) module) - impl)) - (setq geiser-doc--buffer-link - (geiser-doc--history-push - (geiser-doc--make-link nil module impl))) - (geiser-doc--insert-footer impl) - (goto-char (point-min))) - (message "%s done" msg) - (geiser-doc--pop-to-buffer)))) - -(defun geiser-doc-next-section () - "Move to next section in this page." - (interactive) - (forward-line) - (re-search-forward geiser-doc--sections-re nil t) - (forward-line -1)) - -(defun geiser-doc-previous-section () - "Move to previous section in this page." - (interactive) - (re-search-backward geiser-doc--sections-re nil t)) - -(defun geiser-doc-next (&optional forget-current) - "Go to next page in documentation browser. -With prefix, the current page is deleted from history." - (interactive "P") - (let ((link (geiser-doc--history-next forget-current))) - (unless link (error "No next page")) - (geiser-doc--follow-link link))) - -(defun geiser-doc-previous (&optional forget-current) - "Go to previous page in documentation browser. -With prefix, the current page is deleted from history." - (interactive "P") - (let ((link (geiser-doc--history-previous forget-current))) - (unless link (error "No previous page")) - (geiser-doc--follow-link link))) - -(defun geiser-doc-kill-page () - "Kill current page if a previous or next one exists." - (interactive) - (condition-case nil - (geiser-doc-previous t) - (error (geiser-doc-next t)))) - -(defun geiser-doc-refresh () - "Refresh the contents of current page." - (interactive) - (when geiser-doc--buffer-link - (geiser-doc--follow-link geiser-doc--buffer-link))) - -(defun geiser-doc-clean-history () - "Clean up the document browser history." - (interactive) - (when (y-or-n-p "Clean browsing history? ") - (setq geiser-doc--history (geiser-doc--make-history)) - (geiser-doc-refresh)) - (message "")) - - - -(provide 'geiser-doc) diff --git a/elpa/geiser-0.30/geiser-edit.el b/elpa/geiser-0.30/geiser-edit.el @@ -1,341 +0,0 @@ -;;; geiser-edit.el -- scheme edit locations -*- lexical-binding: t; -*- - -;; Copyright (C) 2009, 2010, 2012, 2013, 2019-2023 Jose Antonio Ortega Ruiz - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the Modified BSD License. You should -;; have received a copy of the license along with this program. If -;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>. - -;; Start date: Wed Feb 11, 2009 21:07 - - -;;; Code: - -(require 'geiser-completion) -(require 'geiser-eval) -(require 'geiser-custom) -(require 'geiser-base) - -(require 'etags) -(eval-when-compile (require 'subr-x)) - - -;;; Customization: - -(defmacro geiser-edit--define-custom-visit (var group doc) - `(geiser-custom--defcustom ,var nil - ,doc - :group ',group - :type '(choice (const :tag "Other window" window) - (const :tag "Other frame" frame) - (const :tag "Current window" nil)))) - -(geiser-edit--define-custom-visit - geiser-edit-symbol-method geiser-mode - "How the new buffer is opened when invoking \\[geiser-edit-symbol-at-point] -or following links in error buffers.") - -(geiser-custom--defface error-link - 'link geiser-debug "links in error buffers") - - -;;; Auxiliary functions: - -(defun geiser-edit--visit-file (file method) - (cond ((eq method 'window) (pop-to-buffer (find-file-noselect file t))) - ((eq method 'frame) (find-file-other-frame file)) - ((eq method 'noselect) (find-file-noselect file t)) - (t (find-file file)))) - -(defsubst geiser-edit--location-name (loc) - (cdr (assoc "name" loc))) - -(defsubst geiser-edit--location-file (loc) - (when-let ((file-name (cdr (assoc "file" loc)))) - (concat (or (file-remote-p default-directory) "") - file-name))) - -(defsubst geiser-edit--to-number (x) - (cond ((numberp x) x) - ((stringp x) (string-to-number x)))) - -(defsubst geiser-edit--location-line (loc) - (geiser-edit--to-number (cdr (assoc "line" loc)))) - -(defsubst geiser-edit--location-column (loc) - (geiser-edit--to-number (cdr (assoc "column" loc)))) - -(defsubst geiser-edit--location-char (loc) - (geiser-edit--to-number (cdr (assoc "char" loc)))) - -(defsubst geiser-edit--make-location (name file line column) - (if (equal line "") - `(("name" . ,name) ("file" . ,file) ("char" . ,column)) - `(("name" . ,name) ("file" . ,file) ("line" . ,line) ("column" . ,column)))) - -(defconst geiser-edit--def-re - (regexp-opt '("define" - "defmacro" - "define-macro" - "define-syntax" - "define-syntax-rule" - "-define-syntax" - "-define" - "define*" - "define-method" - "define-class" - "define-struct"))) - -(defconst geiser-edit--def-re* - (regexp-opt '("define-syntaxes" "define-values"))) - -(defsubst geiser-edit--def-re (thing) - (let ((sx (regexp-quote (format "%s" thing)))) - (format (concat "(%s[[:space:]]+\\(" - "(%s\\_>[^)]*)\\|" - "\\(\\_<%s\\_>\\) *\\([^\n]*?\\)[)\n]" - "\\)") - geiser-edit--def-re sx sx))) - -(defsubst geiser-edit--def-re* (thing) - (format "(%s +([^)]*?\\_<%s\\_>" - geiser-edit--def-re* - (regexp-quote (format "%s" thing)))) - -(defun geiser-edit--find-def (symbol &optional args) - (save-excursion - (goto-char (point-min)) - (when (or (re-search-forward (geiser-edit--def-re symbol) nil t) - (re-search-forward (geiser-edit--def-re* symbol) nil t)) - (cons (match-beginning 0) - (and args - (if (match-string 2) - (let* ((v (or (match-string 3) "")) - (v (and (not (string-blank-p v)) v))) - (concat (match-string 2) - (and v " => ") - v - (and v (string-prefix-p "(" v) " ..."))) - (match-string 1))))))) - -(defsubst geiser-edit--symbol-re (thing) - (format "\\_<%s\\_>" (regexp-quote (format "%s" thing)))) - -(defun geiser-edit--goto-location (symbol line col pos) - (cond ((numberp line) - (goto-char (point-min)) - (forward-line (max 0 (1- line)))) - ((numberp pos) (goto-char pos))) - (if (not col) - (when-let (pos (car (geiser-edit--find-def symbol))) - (goto-char pos)) - (beginning-of-line) - (forward-char col) - (cons (current-buffer) (point)))) - -(defun geiser-edit--try-edit-location (symbol loc &optional method no-error) - (let ((symbol (or (geiser-edit--location-name loc) symbol)) - (file (geiser-edit--location-file loc)) - (line (geiser-edit--location-line loc)) - (col (geiser-edit--location-column loc)) - (pos (geiser-edit--location-char loc))) - (when file - (geiser-edit--visit-file file (or method geiser-edit-symbol-method))) - (or (geiser-edit--goto-location symbol line col pos) - file - (unless no-error - (error "Couldn't find location for '%s'" symbol))))) - -(defsubst geiser-edit--try-edit (symbol ret &optional method no-error) - (let ((res (geiser-eval--retort-result ret))) - (if (listp res) - (geiser-edit--try-edit-location symbol res method no-error) - (unless no-error (error "Couldn't find location for '%s'" symbol))))) - - -;;; Links - -(define-button-type 'geiser-edit--button - 'action 'geiser-edit--button-action - 'face 'geiser-font-lock-error-link - 'follow-link t) - -(defun geiser-edit--button-action (button) - (let ((loc (button-get button 'geiser-location)) - (method (button-get button 'geiser-method))) - (when loc (geiser-edit--try-edit-location nil loc method)))) - -(defun geiser-edit--make-link (beg end file line col &optional method) - (make-button beg end - :type 'geiser-edit--button - 'geiser-method method - 'geiser-location - (geiser-edit--make-location 'error file line col) - 'help-echo "Go to error location")) - -(defconst geiser-edit--default-file-rx - "^[ \t]*\\([^<>:\n\"]+\\):\\([0-9]+\\)\\(?::\\([0-9]+\\)\\)?") - -(defun geiser-edit--buttonize-files (&optional rx no-fill) - (let ((rx (or rx geiser-edit--default-file-rx)) - (fill-column (- (window-width) 2))) - (save-excursion - (while (re-search-forward rx nil t) - (geiser-edit--make-link (match-beginning 1) - (match-end 1) - (match-string 1) - (match-string 2) - (or (match-string 3) 0) - 'window) - (unless no-fill (fill-region (match-end 0) (line-end-position))))))) - -(defun geiser-edit--open-next (&optional n reset) - (interactive) - (let* ((n (or n 1)) - (nxt (if (< n 0) 'backward-button 'forward-button)) - (msg (if (< n 0) "previous" "next")) - (n (abs n)) - (p (point)) - (found nil)) - (when reset (goto-char (point-min))) - (while (> n 0) - (let ((b (ignore-errors (funcall nxt 1)))) - (unless b (setq n 0)) - (when (and b (eq (button-type b) 'geiser-edit--button)) - (setq n (- n 1)) - (when (<= n 0) - (setq found t) - (push-button (point)))))) - (unless found - (goto-char p) - (error "No %s error" msg)))) - - -;;; Visibility -(defun geiser-edit--cloak (form) - (intern (format "geiser-edit-cloak-%s" form))) - -(defun geiser-edit--hide (form) - (geiser-edit--show form) - (let ((cloak (geiser-edit--cloak form))) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward (format "(%s\\b" form) nil t) - (let* ((beg (match-beginning 0)) - (end (progn (ignore-errors (goto-char beg) (forward-sexp)) - (point)))) - (when (> end beg) - (overlay-put (make-overlay beg end) 'invisible cloak))))) - (add-to-invisibility-spec (cons cloak t)))) - -(defun geiser-edit--show (form) - (let ((cloak (geiser-edit--cloak form))) - (remove-overlays nil nil 'invisible cloak) - (remove-from-invisibility-spec (cons cloak t)))) - -(defun geiser-edit--show-all () - (remove-overlays) - (setq buffer-invisibility-spec '(t))) - -(defun geiser-edit--toggle-visibility (form) - (if (and (listp buffer-invisibility-spec) - (assoc (geiser-edit--cloak form) buffer-invisibility-spec)) - (geiser-edit--show form) - (geiser-edit--hide form))) - - -;;; Commands: - -(defvar geiser-edit--symbol-history nil) - -(defun geiser-edit-symbol (symbol &optional method marker) - "Asks for a symbol to edit, with completion." - (interactive - (list (geiser-completion--read-symbol "Edit symbol: " - nil - geiser-edit--symbol-history))) - (let ((cmd `(:eval (:ge symbol-location ',symbol)))) - (geiser-edit--try-edit symbol (geiser-eval--send/wait cmd) method) - (when marker (xref-push-marker-stack)))) - -(defun geiser-edit-symbol-at-point (&optional arg) - "Visit the definition of the symbol at point. -With prefix, asks for the symbol to locate." - (interactive "P") - (let* ((symbol (or (and (not arg) (geiser--symbol-at-point)) - (geiser-completion--read-symbol "Edit symbol: "))) - (cmd `(:eval (:ge symbol-location ',symbol))) - (marker (point-marker)) - (ret (ignore-errors (geiser-eval--send/wait cmd)))) - (if (geiser-edit--try-edit symbol ret nil t) - (when marker (xref-push-marker-stack marker)) - (unless (geiser-edit-module-at-point t) - (error "Couldn't find location for '%s'" symbol))) - t)) - -(defun geiser-pop-symbol-stack () - "Pop back to where \\[geiser-edit-symbol-at-point] was last invoked." - (interactive) - (if (fboundp 'xref-go-back) - (xref-go-back) - (with-no-warnings - (xref-pop-marker-stack)))) - -(defun geiser-edit-module (module &optional method no-error) - "Asks for a module and opens it in a new buffer." - (interactive (list (geiser-completion--read-module))) - (let ((cmd `(:eval (:ge module-location '(:module ,module))))) - (geiser-edit--try-edit module (geiser-eval--send/wait cmd) method no-error))) - -(defun geiser-edit-module-at-point (&optional no-error) - "Opens a new window visiting the module at point." - (interactive) - (let ((marker (point-marker))) - (when (geiser-edit-module (or (geiser-completion--module-at-point) - (geiser-completion--read-module)) - nil no-error) - (when marker (xref-push-marker-stack marker)) - t))) - -(defun geiser-insert-lambda (&optional full) - "Insert λ at point. With prefix, inserts (λ ())." - (interactive "P") - (if (not full) - (insert (make-char 'greek-iso8859-7 107)) - (insert "(" (make-char 'greek-iso8859-7 107) " ())") - (backward-char 2))) - -(defun geiser-squarify (n) - "Toggle between () and [] for current form. - -With numeric prefix, perform that many toggles, forward for -positive values and backward for negative." - (interactive "p") - (let ((pared (and (boundp 'paredit-mode) paredit-mode)) - (fwd (> n 0)) - (steps (abs n))) - (when (and pared (fboundp 'paredit-mode)) (paredit-mode -1)) - (unwind-protect - (save-excursion - (unless (looking-at-p "\\s(") (backward-up-list)) - (while (> steps 0) - (let ((p (point)) - (round (looking-at-p "("))) - (forward-sexp) - (delete-char -1) - (insert (if round "]" ")")) - (goto-char p) - (delete-char 1) - (insert (if round "[" "(")) - (setq steps (1- steps)) - (backward-char) - (condition-case nil - (progn (when fwd (forward-sexp 2)) - (backward-sexp)) - (error (setq steps 0)))))) - (when (and pared (fboundp 'paredit-mode)) (paredit-mode 1))))) - - - -(provide 'geiser-edit) diff --git a/elpa/geiser-0.30/geiser-eval.el b/elpa/geiser-0.30/geiser-eval.el @@ -1,225 +0,0 @@ -;;; geiser-eval.el -- sending scheme code for evaluation -*- lexical-binding: t; -*- - -;; Copyright (C) 2009, 2010, 2011, 2012, 2013, 2015, 2021, 2023 Jose Antonio Ortega Ruiz - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the Modified BSD License. You should -;; have received a copy of the license along with this program. If -;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>. - -;; Start date: Sat Feb 07, 2009 22:35 - -;; Functions, building on top of geiser-connection, to evaluate scheme -;; code. - - -;;; Code: - -(require 'geiser-impl) -(require 'geiser-connection) -(require 'geiser-syntax) -(require 'geiser-log) -(require 'geiser-base) - - -;;; Plug-able functions: - -(defvar-local geiser-eval--get-module-function nil) - -(defvar geiser-eval--get-impl-module nil) -(geiser-impl--register-local-method - 'geiser-eval--get-impl-module 'find-module '(lambda (&rest args) nil) - "Function used to obtain the module for current buffer. It takes -an optional argument, for cases where we want to force its -value.") - -(defun geiser-eval--get-module (&optional module) - (cond (geiser-eval--get-module-function - (funcall geiser-eval--get-module-function module)) - (geiser-eval--get-impl-module - (funcall geiser-eval--get-impl-module module)) - (t module))) - -(defvar geiser-eval--geiser-procedure-function nil) -(geiser-impl--register-local-method - 'geiser-eval--geiser-procedure-function 'marshall-procedure 'identity - "Function to translate a bare procedure symbol to one executable -in the Scheme context. Return NULL for unsupported ones; at the -very least, EVAL, COMPILE, LOAD-FILE and COMPILE-FILE should be -supported. Geiser will also invoke, if defined, the following -procedures, always wrapped in EVAL (with the current module as -its context): AUTODOC, SYMBOL-DOCUMENTATION, MODULE-EXPORTS, -SYMBOL-LOCATION, MODULE-LOCATION, COMPLETIONS, -MODULE-COMPLETIONS, MACRO-EXPAND ADD-TO-LOAD-PATH, METHOD, -CALLER, CALLEE and NO-VALUES.") - -(defvar geiser-eval--unsupported nil) -(geiser-impl--register-local-variable - 'geiser-eval--unsupported 'unsupported-procedures nil - "A list, or function returning a list, of the Geiser procedures -not implemented by this Scheme implementation. Possible values -include macroexpand, completions, module-completions, find-file, -symbol-location, module-location, symbol-documentation, -module-exports, autodoc, callers, callees and generic-methods.") - -(defun geiser-eval--supported-p (feat) - (or (not geiser-eval--unsupported) - (not (memq feat geiser-eval--unsupported)))) - -(defsubst geiser-eval--form (&rest args) - (when (not (geiser-eval--supported-p (car args))) - (error "Sorry, the %s scheme implementation does not support Geiser's %s" - geiser-impl--implementation (car args))) - (apply (or geiser-eval--geiser-procedure-function 'ignore) args)) - - -;;; Code formatting: - -(defsubst geiser-eval--load-file (file) - (geiser-eval--form 'load-file (geiser-eval--scheme-str file))) - -(defsubst geiser-eval--comp-file (file) - (geiser-eval--form 'compile-file (geiser-eval--scheme-str file))) - -(defsubst geiser-eval--module (code) - (geiser-eval--scheme-str - (cond ((or (null code) (eq code :t) (eq code :buffer)) - (geiser-eval--get-module)) - ((or (eq code :repl) (eq code :f)) :f) - (t (geiser-eval--get-module code))))) - -(defsubst geiser-eval--eval (code) - (geiser-eval--form 'eval - (geiser-eval--module (nth 1 code)) - (geiser-eval--scheme-str (nth 0 code)))) - -(defsubst geiser-eval--comp (code) - (geiser-eval--form 'compile - (geiser-eval--module (nth 1 code)) - (geiser-eval--scheme-str (nth 0 code)))) - -(defsubst geiser-eval--ge (proc args) - (apply 'geiser-eval--form (cons proc (mapcar 'geiser-eval--scheme-str args)))) - -(defsubst geiser-eval--debug (args) - (geiser-eval--ge 'debug args)) - -(defun geiser-eval--scheme-str (code) - (cond ((null code) "'()") - ((eq code :f) "#f") - ((eq code :t) "#t") - ((listp code) - (cond ((eq (car code) :debug) (geiser-eval--debug (cdr code))) - ((eq (car code) :eval) (geiser-eval--eval (cdr code))) - ((eq (car code) :comp) (geiser-eval--comp (cdr code))) - ((eq (car code) :load-file) - (geiser-eval--load-file (cadr code))) - ((eq (car code) :comp-file) - (geiser-eval--comp-file (cadr code))) - ((eq (car code) :module) (geiser-eval--module (cadr code))) - ((eq (car code) :ge) (geiser-eval--ge (cadr code) - (cddr code))) - ((eq (car code) :scm) (cadr code)) - (t (concat "(" - (mapconcat 'geiser-eval--scheme-str code " ") - ")")))) - ((symbolp code) (substring-no-properties (format "%s" code))) - (t (substring-no-properties (format "%S" code))))) - - -;;; Code sending: - -(defvar geiser-eval--default-connection-function nil) - -(defsubst geiser-eval--connection () - (and geiser-eval--default-connection-function - (funcall geiser-eval--default-connection-function))) - -(defun geiser-eval--log (s) - (geiser-log--info "RETORT: %S" s) - s) - -(defsubst geiser-eval--code-str (code) - (if (stringp code) code (geiser-eval--scheme-str code))) - -(defvar geiser-eval--async-retort nil) -(defsubst geiser-eval--send (code cont &optional buffer) - (setq geiser-eval--async-retort nil) - (geiser-con--send-string (geiser-eval--connection) - (geiser-eval--code-str code) - (lambda (s) - (setq geiser-eval--async-retort (geiser-eval--log s)) - (funcall cont s)) - buffer)) - -(defun geiser-eval--wait (req timeout) - (or (geiser-con--wait req timeout) geiser-eval--async-retort)) - -(defun geiser-eval--send/wait (code &optional timeout buffer) - (let ((sync-retort nil)) - (geiser-con--send-string/wait (geiser-eval--connection) - (geiser-eval--code-str code) - (lambda (s) - (setq sync-retort (geiser-eval--log s))) - timeout - buffer) - sync-retort)) - -(defun geiser-eval-interrupt () - "Interrupt on-going evaluation, if any." - (interactive) - (geiser-con--interrupt (geiser-eval--connection))) - - -;;; Retort parsing: - -(defsubst geiser-eval--retort-p (ret) - (and (listp ret) (or (assoc 'error ret) (assoc 'result ret)))) - -(defsubst geiser-eval--retort-result (ret) - (let ((values (cdr (assoc 'result ret)))) - (car (geiser-syntax--read-from-string (car values))))) - -(defsubst geiser-eval--send/result (code &optional timeout buffer) - (geiser-eval--retort-result (geiser-eval--send/wait code timeout buffer))) - -(defun geiser-eval--retort-result-str (ret prefix) - (let* ((prefix (or prefix "=> ")) - (nlprefix (concat "\n" prefix)) - (values (cdr (assoc 'result ret)))) - (if values - (concat prefix (mapconcat 'identity values nlprefix)) - (or prefix "(No value)")))) - -(defsubst geiser-eval--retort-output (ret) - (cdr (assq 'output ret))) - -(defsubst geiser-eval--retort-error (ret) - (cdr (assq 'error ret))) - -(defsubst geiser-eval--error-key (err) - (cdr (assq 'key err))) - -(defsubst geiser-eval--error-subr (err) - (cdr (assq 'subr err))) - -(defsubst geiser-eval--error-msg (err) - (cdr (assq 'msg err))) - -(defsubst geiser-eval--error-rest (err) - (cdr (assq 'rest err))) - -(defun geiser-eval--error-str (err) - (let* ((key (geiser-eval--error-key err)) - (key-str (if key (format ": %s" key) ":")) - (subr (geiser-eval--error-subr err)) - (subr-str (if subr (format " (%s):" subr) "")) - (msg (geiser-eval--error-msg err)) - (msg-str (if msg (format "\n %s" msg) "")) - (rest (geiser-eval--error-rest err)) - (rest-str (if rest (format "\n %s" rest) ""))) - (format "Error%s%s%s%s" subr-str key-str msg-str rest-str))) - - - -(provide 'geiser-eval) diff --git a/elpa/geiser-0.30/geiser-image.el b/elpa/geiser-0.30/geiser-image.el @@ -1,122 +0,0 @@ -;;; geiser-image.el -- support for image display -*- lexical-binding: t; -*- - -;; Copyright (c) 2012, 2015 Jose Antonio Ortega Ruiz - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the Modified BSD License. You should -;; have received a copy of the license along with this program. If -;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>. - -;; Authors: Michael Wilber, Jose Antonio Ortega Ruiz <jao@gnu.org> -;; Start date: Sun Sep 02, 2012 00:00 - - -;;; Code: - -(require 'geiser-custom) -(require 'geiser-base) -(require 'geiser-impl) - - -;;; Customization: - -(defgroup geiser-image nil - "Options for image displaying." - :group 'geiser) - -(geiser-custom--defcustom geiser-image-viewer "display" - "Which system image viewer program to invoke upon M-x -`geiser-view-last-image'." - :type 'string - :group 'geiser-image) - -(geiser-custom--defcustom geiser-image-cache-keep-last 10 - "How many images to keep in geiser's image cache." - :type 'integer - :group 'geiser-image) - -(geiser-custom--defcustom geiser-image-cache-dir nil - "Default directory where generated images are stored. - -If nil, then the system wide tmp dir will be used." - :type 'path - :group 'geiser-image) - -(geiser-custom--defface image-button - 'button geiser-image "image buttons in terminal buffers") - -(geiser-impl--define-caller geiser-image--cache-dir image-cache-dir () - "Directory where generated images are stored. -If this function returns nil, then no images are generated.") - - - -(defun geiser-image--list-cache () - "List all the images in the image cache." - (let ((cdir (geiser-image--cache-dir nil))) - (and cdir - (file-directory-p cdir) - (let ((files (directory-files-and-attributes cdir t - "geiser-img-[0-9]*.png"))) - (mapcar 'car (sort files (lambda (a b) - (< (float-time (nth 6 a)) - (float-time (nth 6 b)))))))))) - -(defun geiser-image--clean-cache () - "Clean all except for the last `geiser-image-cache-keep-last' -images in `geiser-image--cache-dir'." - (interactive) - (dolist (f (butlast (geiser-image--list-cache) geiser-image-cache-keep-last)) - (delete-file f))) - -(defun geiser-image--display (file) - (start-process "Geiser image view" nil geiser-image-viewer file)) - -(defun geiser-image--button-action (button) - (let ((file (button-get button 'geiser-image-file))) - (when (file-exists-p file) (geiser-image--display file)))) - -(define-button-type 'geiser-image--button - 'action 'geiser-image--button-action - 'follow-link t) - -(defun geiser-image--insert-button (file) - (insert-text-button "[image]" - :type 'geiser-image--button - 'face 'geiser-font-lock-image-button - 'geiser-image-file file - 'help-echo "Click to display image")) - -(defun geiser-image--replace-images (inline-images-p auto-p) - "Replace all image patterns with actual images" - (let ((seen 0)) - (with-silent-modifications - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "\"?#<Image: \\([-+.\\\\/_:0-9a-zA-Z]+\\)>\"?" - nil t) - (setq seen (+ 1 seen)) - (let* ((file (match-string 1)) - (begin (match-beginning 0)) - (end (match-end 0))) - (delete-region begin end) - (goto-char begin) - (if (and inline-images-p (display-images-p)) - (insert-image (create-image file) "[image]") - (geiser-image--insert-button file) - (when auto-p (geiser-image--display file))))))) - seen)) - -(defun geiser-view-last-image (n) - "Open the last displayed image in the system's image viewer. - -With prefix arg, open the N-th last shown image in the system's -image viewer." - (interactive "p") - (let ((images (reverse (geiser-image--list-cache)))) - (if (>= (length images) n) - (geiser-image--display (nth (- n 1) images)) - (error "There aren't %d recent images" n)))) - - -(provide 'geiser-image) diff --git a/elpa/geiser-0.30/geiser-impl.el b/elpa/geiser-0.30/geiser-impl.el @@ -1,354 +0,0 @@ -;;; geiser-impl.el -- generic support for scheme implementations -*- lexical-binding: t; -*- - -;; Copyright (C) 2009-2010, 2012-2013, 2015-2016, 2019, 2021-2022 Jose Antonio Ortega Ruiz - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the Modified BSD License. You should -;; have received a copy of the license along with this program. If -;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>. - -;; Start date: Sat Mar 07, 2009 23:32 - - -;;; Code: - -(require 'geiser-custom) -(require 'geiser-base) - -(require 'help-fns) - - -;;; Customization: - -(defgroup geiser-implementation nil - "Generic support for multiple Scheme implementations." - :group 'geiser) - -(geiser-custom--defcustom geiser-default-implementation nil - "Symbol naming the default Scheme implementation." - :type 'symbol) - -;;;###autoload (defvar geiser-active-implementations nil) -(geiser-custom--defcustom geiser-active-implementations () - "List of active installed Scheme implementations." - :type '(repeat symbol)) - -;;;###autoload (defvar geiser-implementations-alist nil) -(geiser-custom--defcustom geiser-implementations-alist nil - "A map from regular expressions or directories to implementations. -When opening a new file, its full path will be matched against -each one of the regular expressions or directories in this map -in order to determine its scheme flavour." - :type '(repeat (list (choice (group :tag "Regular expression" - (const regexp) regexp) - (group :tag "Directory" - (const dir) directory)) - symbol))) - - -;;; Implementation registry: - -(defvar geiser-impl--registry nil) -(defvar geiser-impl--load-files nil) -(defvar geiser-impl--method-docs nil) -(defvar geiser-impl--local-methods nil) -(defvar geiser-impl--local-variables nil) - -(geiser-custom--memoize 'geiser-impl--load-files) - -(defvar-local geiser-impl--implementation nil) - -(defsubst geiser-impl--impl-str (&optional impl) - (let ((impl (or impl geiser-impl--implementation))) - (and impl (capitalize (format "%s" impl))))) - -(defsubst geiser-impl--feature (impl) - (intern (format "geiser-%s" impl))) - -(defsubst geiser-impl--load-impl (impl) - (require (geiser-impl--feature impl) - (cdr (assq impl geiser-impl--load-files)) - t)) - -(defsubst geiser-impl--methods (impl) - (cdr (assq impl geiser-impl--registry))) - -(defun geiser-impl--method (method &optional impl) - (let ((impl (or impl - geiser-impl--implementation - geiser-default-implementation))) - (cadr (assq method (geiser-impl--methods impl))))) - -(defun geiser-impl--default-method (method) - (cadr (assoc method (mapcar #'cdr geiser-impl--local-methods)))) - -(defun geiser-impl--call-method (method impl &rest args) - (let ((fun (or (geiser-impl--method method impl) - (geiser-impl--default-method method)))) - (when (functionp fun) (apply fun args)))) - -(defun geiser-impl--method-doc (method doc user) - (let* ((user (if user (format " Used via `%s'." user) "")) - (extra-doc (format "%s%s" doc user))) - (add-to-list 'geiser-impl--method-docs (cons method extra-doc)) - (setq geiser-impl--method-docs - (sort geiser-impl--method-docs - (lambda (a b) (string< (symbol-name (car a)) - (symbol-name (car b)))))) - (put method 'function-documentation doc))) - -(defun geiser-implementation-help () - "Show a buffer with help on defining new supported Schemes." - (interactive) - (help-setup-xref (list #'geiser-implementation-help) t) - (save-excursion - (with-help-window (help-buffer) - (princ "Geiser: supporting new Scheme implementations.\n\n") - (princ "Use `define-geiser-implementation' to define ") - (princ "new implementations") - (princ "\n\n (define-geiser-implementation NAME &rest METHODS)\n\n") - (princ (documentation 'define-geiser-implementation)) - (princ "\n\nMethods used to define an implementation:\n\n") - (dolist (m geiser-impl--method-docs) - (let ((p (with-current-buffer (help-buffer) (point)))) - (princ (format "%s: " (car m))) - (princ (cdr m)) - (with-current-buffer (help-buffer) - (fill-region-as-paragraph p (point))) - (princ "\n\n"))) - (with-current-buffer standard-output (buffer-string))))) - -(defun geiser-impl--register-local-method (var-name method fallback doc) - (add-to-list 'geiser-impl--local-methods (list var-name method fallback)) - (geiser-impl--method-doc method doc var-name) - (put var-name 'function-documentation doc)) - -(defun geiser-impl--register-local-variable (var-name method fallback doc) - (add-to-list 'geiser-impl--local-variables (list var-name method fallback)) - (geiser-impl--method-doc method doc var-name) - (put var-name 'variable-documentation doc)) - -(defmacro geiser-impl--define-caller (fun-name method arglist doc) - (let ((impl (make-symbol "implementation-name"))) - `(progn - (defun ,fun-name ,(cons impl arglist) ,doc - (geiser-impl--call-method ',method ,impl ,@arglist)) - (geiser-impl--method-doc ',method ,doc ',fun-name)))) -(put 'geiser-impl--define-caller 'lisp-indent-function 3) - -(defun geiser-impl--register (file impl methods) - (let ((current (assq impl geiser-impl--registry))) - (if current (setcdr current methods) - (push (cons impl methods) geiser-impl--registry)) - (push (cons impl file) geiser-impl--load-files))) - -;;;###autoload -(progn ;Copy the whole def to the autoloads file. -(defun geiser-activate-implementation (impl) - (add-to-list 'geiser-active-implementations impl))) - -(defsubst geiser-deactivate-implementation (impl) - (setq geiser-active-implementations - (delq impl geiser-active-implementations))) - -(defsubst geiser-impl--active-p (impl) - (memq impl geiser-active-implementations)) - - -;;; Defining implementations: - -(defun geiser-impl--normalize-method (m) - (when (and (listp m) - (= 2 (length m)) - (symbolp (car m))) - (let ((v (cadr m))) - (if (functionp v) m `(,(car m) ,(lambda (&rest _) (eval v t))))))) - -(defun geiser-impl--define (file name parent methods) - (let* ((methods (mapcar #'geiser-impl--normalize-method methods)) - (methods (delq nil methods)) - (inherited-methods (and parent (geiser-impl--methods parent))) - (methods (append methods - (dolist (m methods inherited-methods) - (setq inherited-methods - (assq-delete-all m inherited-methods)))))) - (geiser-impl--register file name methods))) - -(defmacro define-geiser-implementation (name &rest methods) - "Define a new supported Scheme implementation. -NAME can be either an unquoted symbol naming the implementation, -or a two-element list (NAME PARENT), with PARENT naming another -registered implementation from which to borrow methods not -defined in METHODS. - -After NAME come the methods, each one a two element list of the -form (METHOD-NAME FUN-OR-VAR), where METHOD-NAME is one of the -needed methods (for a list, execute `geiser-implementation-help') -and a value, variable name or function name implementing it. -Omitted method names will return nil to their callers. - -Here's how a typical call to this macro looks like: - - (define-geiser-implementation guile - (binary geiser-guile--binary) - (arglist geiser-guile--parameters) - (repl-startup geiser-guile--startup) - (prompt-regexp geiser-guile--prompt-regexp) - (debugger-prompt-regexp geiser-guile--debugger-prompt-regexp) - (enter-debugger geiser-guile--enter-debugger) - (marshall-procedure geiser-guile--geiser-procedure) - (find-module geiser-guile--get-module) - (enter-command geiser-guile--enter-command) - (exit-command geiser-guile--exit-command) - (import-command geiser-guile--import-command) - (find-symbol-begin geiser-guile--symbol-begin) - (display-error geiser-guile--display-error) - (display-help) - (check-buffer geiser-guile--guess) - (keywords geiser-guile--keywords) - (case-sensitive geiser-guile-case-sensitive-p)) - -This macro also defines a runner function (geiser-NAME) and a -switcher (geiser-NAME-switch), and provides geiser-NAME." - (let ((name (if (listp name) (car name) name)) - (parent (and (listp name) (cadr name)))) - (unless (symbolp name) - (error "Malformed implementation name: %s" name)) - (let ((old-runner (intern (format "run-%s" name))) - (runner (intern (format "geiser-%s" name))) - (old-switcher (intern (format "switch-to-%s" name))) - (switcher (intern (format "geiser-%s-switch" name))) - (runner-doc (format "Start a new %s REPL." name)) - (switcher-doc (format "Switch to a running %s REPL, or start one." - name)) - (ask (gensym "ask"))) - `(progn - (geiser-impl--define load-file-name ',name ',parent ',methods) - (require 'geiser-repl) - (require 'geiser-menu) - (define-obsolete-function-alias ',old-runner ',runner "Geiser 0.26") - (defun ,runner () - ,runner-doc - (interactive) - (geiser ',name)) - (define-obsolete-function-alias ',old-switcher ',switcher "Geiser 0.26") - (defun ,switcher (&optional ,ask) - ,switcher-doc - (interactive "P") - (geiser-repl-switch ,ask ',name)) - (geiser-menu--add-impl ',name ',runner ',switcher))))) - -;;;###autoload -(progn - (defun geiser-impl--add-to-alist (kind what impl &optional append) - (add-to-list 'geiser-implementations-alist - (list (list kind what) impl) append)) - - (defun geiser-implementation-extension (impl ext) - "Add to `geiser-implementations-alist' an entry for extension EXT." - (geiser-impl--add-to-alist 'regexp (format "\\.%s\\'" ext) impl t))) - - -;;; Trying to guess the scheme implementation: - -(defvar-local geiser-scheme-implementation nil - "The Scheme implementation to be used by Geiser.") - -(put 'geiser-scheme-implementation 'safe-local-variable #'symbolp) - -(defun geiser-impl--match-impl (desc bn) - (let ((rx (if (eq (car desc) 'regexp) - (cadr desc) - (format "^%s" (regexp-quote (cadr desc)))))) - (and rx (string-match-p rx bn)))) - -(defvar geiser-impl--impl-prompt-history nil) - -(defun geiser-impl--read-impl (&optional prompt impls non-req) - (let* ((impls (or impls geiser-active-implementations)) - (impls (mapcar #'symbol-name impls)) - (prompt (or prompt "Scheme implementation: "))) - (intern (completing-read prompt impls nil (not non-req) nil - geiser-impl--impl-prompt-history - (and (car impls) (car impls)))))) - -(geiser-impl--define-caller geiser-impl--check-buffer check-buffer () - "Method called without arguments that should check whether the current -buffer contains Scheme code of the given implementation.") - -(defun geiser-impl--guess (&optional prompt) - (or geiser-impl--implementation - (progn (hack-local-variables) - (and (geiser-impl--active-p geiser-scheme-implementation) - geiser-scheme-implementation)) - (and (null (cdr geiser-active-implementations)) - (car geiser-active-implementations)) - (catch 'impl - (dolist (impl geiser-active-implementations) - (when (geiser-impl--check-buffer impl) - (throw 'impl impl))) - (let ((bn (buffer-file-name))) - (when bn - (dolist (x geiser-implementations-alist) - (when (and (geiser-impl--active-p (cadr x)) - (geiser-impl--match-impl (car x) bn)) - (throw 'impl (cadr x))))))) - geiser-default-implementation - (and prompt (geiser-impl--read-impl)))) - - -;;; Using implementations: - -(defsubst geiser-impl--registered-method (impl method fallback) - (let ((m (geiser-impl--method method impl))) - (if (fboundp m) m - (or fallback (error "%s not defined for %s implementation" - method impl))))) - -(defsubst geiser-impl--registered-value (impl method fallback) - (let ((m (geiser-impl--method method impl))) - (if (functionp m) (funcall m) fallback))) - -(defun geiser-impl--set-buffer-implementation (&optional impl prompt) - (let ((impl (or impl (geiser-impl--guess prompt)))) - (when impl - (unless (geiser-impl--load-impl impl) - (error "Cannot find %s implementation" impl)) - (setq geiser-impl--implementation impl) - (dolist (m geiser-impl--local-methods) - (set (make-local-variable (nth 0 m)) - (geiser-impl--registered-method impl (nth 1 m) (nth 2 m)))) - (dolist (m geiser-impl--local-variables) - (set (make-local-variable (nth 0 m)) - (geiser-impl--registered-value impl (nth 1 m) (nth 2 m))))))) - -(defmacro with--geiser-implementation (impl &rest body) - (declare (indent 1)) - (let* ((mbindings (mapcar (lambda (m) - `(,(nth 0 m) - (geiser-impl--registered-method ,impl - ',(nth 1 m) - ',(nth 2 m)))) - geiser-impl--local-methods)) - (vbindings (mapcar (lambda (m) - `(,(nth 0 m) - (geiser-impl--registered-value ,impl - ',(nth 1 m) - ',(nth 2 m)))) - geiser-impl--local-variables)) - (ibindings `((geiser-impl--implementation ,impl))) - (bindings (append ibindings mbindings vbindings))) - `(let* ,bindings ,@body))) - - -;;; Reload support: - -(defun geiser-impl-unload-function () - (dolist (imp (mapcar (lambda (i) - (geiser-impl--feature (car i))) - geiser-impl--registry)) - (when (featurep imp) (unload-feature imp t)))) - - -(provide 'geiser-impl) -;;; geiser-impl.el ends here diff --git a/elpa/geiser-0.30/geiser-log.el b/elpa/geiser-0.30/geiser-log.el @@ -1,145 +0,0 @@ -;;; geiser-log.el -- logging utilities -*- lexical-binding: t; -*- - -;; Copyright (C) 2009, 2010, 2012, 2019, 2021, 2022 Jose Antonio Ortega Ruiz - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the Modified BSD License. You should -;; have received a copy of the license along with this program. If -;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>. - -;; Start date: Sat Feb 07, 2009 12:07 - -;;; Commentary: - -;; Some utilities for maintaining a simple log buffer, mainly for -;; debugging purposes. - - -;;; Code: - -(require 'geiser-custom) -(require 'geiser-popup) -(require 'geiser-base) - -(require 'comint) - - -;;; Customization: - -(geiser-custom--defcustom geiser-log-autoscroll-buffer-p nil - "Set this so than the buffer *Geiser Messages* always shows the last message" - :group 'geiser - :type 'boolean) - -(defvar geiser-log--buffer-name "*Geiser Messages*" - "Name of the Geiser log buffer.") - -(defvar geiser-log--max-buffer-size 320000 - "Maximum size of the Geiser messages log.") - -(defvar geiser-log--max-message-size 20480 - "Maximum size of individual Geiser log messages.") - -(define-obsolete-variable-alias - 'geiser-log-verbose-p 'geiser-log-verbose "0.26.2") - -(defvar geiser-log-verbose nil - "Log purely informational messages.") - -(define-obsolete-variable-alias - 'geiser-log-verbose-debug-p 'geiser-log-verbose-debug "0.26.2") - -(defvar geiser-log-verbose-debug nil - "Log very verbose informational messages. Useful only for debugging.") - - -(defvar geiser-log--inhibit nil - "Set this to t to inhibit all log messages") - - -;;; Log buffer and mode: - -(defvar geiser-messages-mode-map - (let ((map (make-sparse-keymap))) - (define-key map "c" 'geiser-log-clear) - (define-key map "Q" 'geiser-log--deactivate) - map)) - -(define-derived-mode geiser-messages-mode fundamental-mode "Geiser Messages" - "Simple mode for Geiser log messages buffer." - (buffer-disable-undo) - (add-hook 'after-change-functions - (lambda (b _e _len) - (let ((inhibit-read-only t)) - (when (> b geiser-log--max-buffer-size) - (delete-region (point-min) b)))) - nil t) - ;; Maybe this feature would better be implemented as a revert-buffer function? - (add-hook 'after-change-functions - (lambda (_b _e _len) - (when geiser-log-autoscroll-buffer-p - (let ((my-window (get-buffer-window (geiser-log--buffer) t))) - (when (window-live-p my-window) - (set-window-point my-window (point)))))) - nil t) - (setq buffer-read-only t)) - -(geiser-popup--define log geiser-log--buffer-name geiser-messages-mode) - - -;;; Logging functions: - -(defun geiser-log--msg (type &rest args) - (unless geiser-log--inhibit - (geiser-log--with-buffer - (goto-char (point-max)) - (insert (geiser--shorten-str (format "\n%s: %s\n" type - (apply 'format args)) - geiser-log--max-message-size))))) - -(defsubst geiser-log--warn (&rest args) - (apply 'geiser-log--msg 'WARNING args)) - -(defsubst geiser-log--error (&rest args) - (apply 'geiser-log--msg 'ERROR args)) - -(defsubst geiser-log--info (&rest args) - (when geiser-log-verbose - (apply 'geiser-log--msg 'INFO args) "")) - -(defsubst geiser-log--debug (&rest args) - (when geiser-log-verbose-debug - (apply 'geiser-log--msg 'DEBUG args) "")) - - -;;; User commands: - -(defun geiser-show-logs (&optional arg) - "Show Geiser log messages. - -With prefix, activates all logging levels." - (interactive "P") - (setq geiser-log-verbose t) - (when arg - (setq geiser-log-verbose-debug t)) - (geiser-log--pop-to-buffer)) - -(defun geiser-log-clear () - "Clean all logs." - (interactive) - (geiser-log--with-buffer (delete-region (point-min) (point-max)))) - -(defun geiser-log-toggle-verbose () - "Toggle verbose logs" - (interactive) - (setq geiser-log-verbose (not geiser-log-verbose)) - (message "Geiser verbose logs %s" - (if geiser-log-verbose "enabled" "disabled"))) - -(defun geiser-log--deactivate () - (interactive) - (setq geiser-log-verbose nil) - (when (eq (current-buffer) (geiser-log--buffer)) (View-quit))) - - -(provide 'geiser-log) diff --git a/elpa/geiser-0.30/geiser-menu.el b/elpa/geiser-0.30/geiser-menu.el @@ -1,145 +0,0 @@ -;;; geiser-menu.el -- menu and keymaps definition -*- lexical-binding: t; -*- - -;; Copyright (c) 2010, 2012 Jose Antonio Ortega Ruiz - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the Modified BSD License. You should -;; have received a copy of the license along with this program. If -;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>. - -;; Start date: Sat Jun 12, 2010 03:01 - - -;;; Code: - -(require 'geiser-custom) -(require 'geiser-base) - - -;;; Customization: - -(geiser-custom--defcustom geiser-global-menu-always-on-p nil - "Whether the Geiser menu is always visible." - :type 'boolean - :group 'geiser) - - -;;; Top-level menu - -(defmacro geiser-menu--add-item (keymap map kd) - (cond ((or (eq '-- kd) (eq 'line kd)) `(geiser-menu--add-line ,map)) - ((stringp (car kd)) `(geiser-menu--add-basic-item ,keymap ,map ,kd)) - ((eq 'menu (car kd)) `(geiser-menu--add-submenu ,(cadr kd) - ,keymap ,map ,(cddr kd))) - ((eq 'custom (car kd)) `(geiser-menu--add-custom ,(nth 1 kd) - ,(nth 2 kd) - ,keymap - ,map)) - ((eq 'mode (car kd)) `(geiser-menu--mode-toggle ,(nth 1 kd) - ,(nth 2 kd) - ,(nth 3 kd) - ,keymap - ,map)) - (t (error "Bad item form: %s" kd)))) - -(defmacro geiser-menu--add-basic-item (keymap map kd) - (let* ((title (nth 0 kd)) - (binding (nth 1 kd)) - (cmd (nth 2 kd)) - (hlp (nth 3 kd)) - (item (make-symbol title)) - (hlp (and (stringp hlp) (list :help hlp))) - (rest (or (and hlp (nthcdr 4 kd)) - (nthcdr 3 kd))) - (binding (if (listp binding) - binding - (list binding)))) - `(progn (define-key ,map [,item] - '(menu-item ,title ,cmd ,@hlp ,@rest)) - ,@(and (car binding) - `((put ',cmd - :advertised-binding - ,(car binding)))) - ,@(mapcar (lambda (b) - `(define-key ,keymap ,b ',cmd)) - binding)))) - -(defmacro geiser-menu--add-items (keymap map keys) - `(progn ,@(mapcar (lambda (k) (list 'geiser-menu--add-item keymap map k)) - (reverse keys)))) - -(defmacro geiser-menu--add-submenu (name keymap map keys) - (let ((ev (make-symbol name)) - (map2 (make-symbol "map2"))) - `(progn - (let ((,map2 (make-sparse-keymap ,name))) - (define-key ,map [,ev] (cons ,name ,map2)) - (geiser-menu--add-items ,keymap ,map2 ,keys))))) - -(defvar geiser-menu--line-counter 0) - -(defun geiser-menu--add-line (&optional map) - (let ((line (make-symbol (format "line%s" - (setq geiser-menu--line-counter - (1+ geiser-menu--line-counter)))))) - (define-key (or map global-map) `[,line] - `(menu-item "--single-line")))) - -(defmacro geiser-menu--add-custom (title group keymap map) - `(geiser-menu--add-item ,keymap ,map - (,title nil (lambda () (interactive) (customize-group ',group))))) - -(defmacro geiser-menu--mode-toggle (title bindings mode keymap map) - `(geiser-menu--add-item ,keymap ,map - (,title ,bindings ,mode - :button (:toggle . (and (boundp ',mode) ,mode))))) - -(defmacro geiser-menu--defmenu (name keymap &rest keys) - (let ((mmap (make-symbol "mmap"))) - `(progn - (let ((,mmap (make-sparse-keymap "Geiser"))) - (define-key ,keymap [menu-bar ,name] (cons "Geiser" ,mmap)) - (define-key ,mmap [customize] - (cons "Customize" geiser-menu--custom-customize)) - (define-key ,mmap [switch] - (cons "Switch to" geiser-menu--custom-switch)) - (define-key ,mmap [Run] (cons "Run" geiser-menu--custom-run)) - (geiser-menu--add-line ,mmap) - (geiser-menu--add-items ,keymap ,mmap ,keys) - ,mmap)))) - -(put 'geiser-menu--defmenu 'lisp-indent-function 2) - - -;;; Shared entries - -(defvar geiser-menu--custom-map (make-sparse-keymap "Geiser")) -(defvar geiser-menu--custom-run (make-sparse-keymap "Run")) -(defvar geiser-menu--custom-switch (make-sparse-keymap "Switch")) -(defvar geiser-menu--custom-customize (make-sparse-keymap "Customize")) - -(define-key geiser-menu--custom-map [customize] - (cons "Customize" geiser-menu--custom-customize)) -(define-key geiser-menu--custom-map [switch] - (cons "Switch to" geiser-menu--custom-switch)) -(define-key geiser-menu--custom-map [run] - (cons "Run" geiser-menu--custom-run)) - -(defun geiser-menu--add-global-custom (title group) - (define-key geiser-menu--custom-customize `[,(make-symbol title)] - (cons title `(lambda () (interactive) (customize-group ',group))))) - -(defun geiser-menu--add-impl (name runner switcher) - (let ((title (capitalize (format "%s" name))) - (group (intern (format "geiser-%s" name)))) - (define-key geiser-menu--custom-run `[,name] - `(menu-item ,title ,runner :enable (geiser-impl--active-p ',name))) - (define-key geiser-menu--custom-switch `[,name] - `(menu-item ,title ,switcher :enable (geiser-repl--repl/impl ',name))) - (geiser-menu--add-global-custom title group))) - -(geiser-menu--add-global-custom "Geiser" 'geiser) - - - -(provide 'geiser-menu) diff --git a/elpa/geiser-0.30/geiser-mode.el b/elpa/geiser-0.30/geiser-mode.el @@ -1,444 +0,0 @@ -;;; geiser-mode.el -- minor mode for scheme buffers -*- lexical-binding: t; -*- - -;; Copyright (C) 2009-2017, 2020, 2022 Jose Antonio Ortega Ruiz - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the Modified BSD License. You should -;; have received a copy of the license along with this program. If -;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>. - -;; Start date: Sun Feb 08, 2009 15:13 - - -;;; Code: - -(require 'geiser-repl) -(require 'geiser-capf) -(require 'geiser-menu) -(require 'geiser-doc) -(require 'geiser-compile) -(require 'geiser-completion) -(require 'geiser-xref) -(require 'geiser-edit) -(require 'geiser-autodoc) -(require 'geiser-debug) -(require 'geiser-syntax) -(require 'geiser-impl) -(require 'geiser-eval) -(require 'geiser-popup) -(require 'geiser-custom) -(require 'geiser-base) - - -;;; Customization: - -(defgroup geiser-mode nil - "Mode enabling Geiser abilities in Scheme buffers &co.." - :group 'geiser) - -(geiser-custom--defcustom geiser-mode-auto-p t - "Whether `geiser-mode' should be active by default in all scheme buffers." - :group 'geiser-mode - :type 'boolean) - -(geiser-custom--defcustom geiser-mode-start-repl-p nil - "Whether a REPL should be automatically started if one is not -active when `geiser-mode' is activated in a buffer." - :group 'geiser-mode - :type 'boolean) - -(geiser-custom--defcustom geiser-mode-autodoc-p t - "Whether `geiser-autodoc-mode' gets enabled by default in Scheme buffers." - :group 'geiser-mode - :group 'geiser-autodoc - :type 'boolean) - -(geiser-custom--defcustom geiser-mode-smart-tab-p nil - "Whether `geiser-smart-tab-mode' gets enabled by default in Scheme buffers." - :group 'geiser-mode - :type 'boolean) - -(geiser-custom--defcustom geiser-mode-eval-last-sexp-to-buffer nil - "Whether `eval-last-sexp' prints results to buffer" - :group 'geiser-mode - :type 'boolean) - -(geiser-custom--defcustom geiser-mode-eval-to-buffer-prefix " " - "When `geiser-mode-eval-last-sexp-to-buffer', the prefix string -which will be prepended to results." - :group 'geiser-mode - :type 'string) - -(geiser-custom--defcustom geiser-mode-eval-to-buffer-transformer nil - "Transformer for results inserted in debug buffer. - -When `geiser-mode-eval-last-sexp-to-buffer', the result will be -transformed using this function default behavior is just prepend -with `geiser-mode-eval-to-buffer-prefix' takes two arguments: -`msg' and `is-error?' `msg' is the result string going to be -transformed, `is-error?' is a boolean indicating whether the -result is an error msg." - :group 'geiser-mode - :type 'function) - - - -;;; Evaluation commands: - -(defun geiser--go-to-repl () - (geiser-repl--switch-to-repl) - (push-mark) - (goto-char (point-max))) - -(defun geiser-wait-eval (req timeout) - "Use REQ, the result of computing an evaluation, to wait for its result. - -TIMEOUT is the number of seconds to wait for evaluation -completion. Functions returning a waitable REQ are -`geiser-eval-region' and its derivatives evaluating buffers or -individual sexps." - (geiser-eval--wait req (* 1000 timeout))) - -(defun geiser-eval-region (start end &optional and-go raw nomsg) - "Eval the current region in the Geiser REPL. - -With prefix, goes to the REPL buffer afterwards (as -`geiser-eval-region-and-go'). The evaluation is performed -asynchronously: this function's return value can be used to wait -for its completion using `geiser-eval-wait'. See also -`geiser-eval-region/wait' if you just need to eval a region -programmatically in a synchronous way." - (interactive "rP") - (save-restriction - (narrow-to-region start end) - (check-parens)) - (geiser-debug--send-region nil - start - end - (and and-go 'geiser--go-to-repl) - (not raw) - nomsg)) - -(defun geiser-eval-region/wait (start end &optional timeout) - "Like `geiser-eval-region', but waiting for the evaluation to finish. -Returns its raw result, rather than displaying it. TIMEOUT is the -number of seconds to wait for the evaluation to finish." - (geiser-debug--send-region/wait nil start end (* 1000 (or timeout 10)))) - -(defun geiser-eval-region-and-go (start end) - "Eval the current region in the Geiser REPL and visit it afterwads." - (interactive "r") - (geiser-eval-region start end t)) - -(geiser-impl--define-caller geiser-eval--bounds eval-bounds () - "A pair with the bounds of a buffer to be evaluated, defaulting - to (cons (point-min) . (point-max)).") - -(defun geiser-eval-buffer (&optional and-go raw nomsg) - "Eval the current buffer in the Geiser REPL. - -With prefix, goes to the REPL buffer afterwards (as -`geiser-eval-buffer-and-go')" - (interactive "P") - (let* ((bounds (geiser-eval--bounds geiser-impl--implementation)) - (from (or (car bounds) (point-min))) - (to (or (cdr bounds) (point-max)))) - (geiser-eval-region from to and-go raw nomsg))) - -(defun geiser-eval-buffer-and-go () - "Eval the current buffer in the Geiser REPL and visit it afterwads." - (interactive) - (geiser-eval-buffer t)) - -(defun geiser-eval-definition (&optional and-go) - "Eval the current definition in the Geiser REPL. - -With prefix, goes to the REPL buffer afterwards (as -`geiser-eval-definition-and-go')" - (interactive "P") - (save-excursion - (end-of-defun) - (let ((end (point))) - (beginning-of-defun) - (geiser-eval-region (point) end and-go t)))) - -(defun geiser-eval-definition-and-go () - "Eval the current definition in the Geiser REPL and visit it afterwads." - (interactive) - (geiser-eval-definition t)) - -(defun geiser-eval-last-sexp (print-to-buffer-p) - "Eval the previous sexp in the Geiser REPL. - -With a prefix, revert the effect of `geiser-mode-eval-last-sexp-to-buffer' " - (interactive "P") - (let* (bosexp - (eosexp (save-excursion (backward-sexp) - (setq bosexp (point)) - (forward-sexp) - (point))) - (ret-transformer (or geiser-mode-eval-to-buffer-transformer - (lambda (msg is-error?) - (format "%s%s%s" - geiser-mode-eval-to-buffer-prefix - (if is-error? "ERROR" "") - msg)))) - (ret (save-excursion - (geiser-eval-region bosexp ;beginning of sexp - eosexp ;end of sexp - nil - t - print-to-buffer-p))) - (ret (geiser-wait-eval ret 30)) - (err (geiser-eval--retort-error ret)) - (will-eval-to-buffer (if print-to-buffer-p - (not geiser-mode-eval-last-sexp-to-buffer) - geiser-mode-eval-last-sexp-to-buffer)) - (str (geiser-eval--retort-result-str ret - (when will-eval-to-buffer "")))) - (cond ((not will-eval-to-buffer) str) - (err (insert (funcall ret-transformer - (geiser-eval--error-str err) t))) - ((string= "" str)) - (t (push-mark) - (insert (funcall ret-transformer str nil)))))) - -(defun geiser-compile-definition (&optional and-go) - "Compile the current definition in the Geiser REPL. - -With prefix, goes to the REPL buffer afterwards (as -`geiser-eval-definition-and-go')" - (interactive "P") - (save-excursion - (end-of-defun) - (let ((end (point))) - (beginning-of-defun) - (geiser-debug--send-region t - (point) - end - (and and-go 'geiser--go-to-repl) - t)))) - -(defun geiser-compile-definition-and-go () - "Compile the current definition in the Geiser REPL and visit it afterwads." - (interactive) - (geiser-compile-definition t)) - -(defun geiser-expand-region (start end &optional all raw) - "Macro-expand the current region and display it in a buffer. -With prefix, recursively macro-expand the resulting expression." - (interactive "rP") - (geiser-debug--expand-region start end all (not raw))) - -(defun geiser-expand-definition (&optional all) - "Macro-expand the current definition. - -With prefix, recursively macro-expand the resulting expression." - (interactive "P") - (save-excursion - (end-of-defun) - (let ((end (point))) - (beginning-of-defun) - (geiser-expand-region (point) end all t)))) - -(defun geiser-expand-last-sexp (&optional all) - "Macro-expand the previous sexp. - -With prefix, recursively macro-expand the resulting expression." - (interactive "P") - (geiser-expand-region (save-excursion (backward-sexp) (point)) - (point) - all - t)) - -(defun geiser-set-scheme () - "Associates current buffer with a given Scheme implementation." - (interactive) - (save-excursion - (geiser-syntax--remove-kws) - (let ((impl (geiser-impl--read-impl))) - (geiser-impl--set-buffer-implementation impl) - (geiser-repl--set-up-repl impl) - (geiser-syntax--add-kws) - (geiser-syntax--fontify)))) - -(defun geiser-mode-switch-to-repl (arg) - "Switches to Geiser REPL. - -With prefix, try to enter the current buffer's module." - (interactive "P") - (geiser-repl--switch-to-repl arg)) - -(defun geiser-mode-switch-to-repl-and-enter () - "Switches to Geiser REPL and enters current buffer's module." - (interactive) - (geiser-mode-switch-to-repl t)) - -(defun geiser-restart-repl () - "Restarts the REPL associated with the current buffer." - (interactive) - (let ((b (current-buffer)) - (impl geiser-impl--implementation)) - (when (buffer-live-p geiser-repl--repl) - (geiser-mode-switch-to-repl nil) - (comint-kill-subjob) - (sit-for 0.1)) ;; ugly hack; but i don't care enough to fix it - (geiser impl) - (sit-for 0.2) - (goto-char (point-max)) - (pop-to-buffer b))) - -(defun geiser-exit-repl () - "Issues the command `geiser-repl-exit' in this buffer's associated REPL." - (interactive) - (geiser-repl--call-in-repl #'geiser-repl-exit)) - - -;;; Keys: - -(defvar geiser-mode-map - (let ((map (make-sparse-keymap))) - (define-key map [menu-bar scheme] 'undefined) - ;; (geiser-mode--triple-chord ?x ?m 'geiser-xref-generic-methods) - - (geiser-menu--defmenu geiserm map - ("Eval sexp before point" "\C-x\C-e" geiser-eval-last-sexp) - ("Eval definition" ("\M-\C-x" "\C-c\C-c") geiser-eval-definition) - ("Eval definition and go" ("\C-c\M-e" "\C-c\M-e") - geiser-eval-definition-and-go) - ("Eval region" "\C-c\C-r" geiser-eval-region :enable mark-active) - ("Eval region and go" "\C-c\M-r" geiser-eval-region-and-go - geiser-eval-region :enable mark-active) - ("Eval buffer" "\C-c\C-b" geiser-eval-buffer) - ("Eval buffer and go" "\C-c\M-b" geiser-eval-buffer-and-go) - ("Load scheme file..." "\C-c\C-l" geiser-load-file) - ("Abort evaluation" ("\C-c\C-i" "\C-c\C-e\C-i" "\C-c\C-ei") - geiser-eval-interrupt) - (menu "Macroexpand" - ("Sexp before point" ("\C-c\C-m\C-e" "\C-c\C-me") - geiser-expand-last-sexp) - ("Region" ("\C-c\C-m\C-r" "\C-c\C-mr") geiser-expand-region) - ("Definition" ("\C-c\C-m\C-x" "\C-c\C-mx") geiser-expand-definition)) - -- - ("Symbol documentation" ("\C-c\C-d\C-d" "\C-c\C-dd") - geiser-doc-symbol-at-point :enable (geiser--symbol-at-point)) - ("Short symbol documentation" ("\C-c\C-d\C-s" "\C-c\C-ds") - geiser-autodoc-show :enable (geiser--symbol-at-point)) - ("Module documentation" ("\C-c\C-d\C-m" "\C-c\C-dm") geiser-doc-module) - ("Symbol manual lookup" ("\C-c\C-d\C-i" "\C-c\C-di") - geiser-doc-look-up-manual :enable (geiser-doc--manual-available-p)) - (mode "Autodoc mode" ("\C-c\C-d\C-a" "\C-c\C-da") geiser-autodoc-mode) - (mode "Autoeval mode" ("\C-c\C-d\C-e" "\C-c\C-de") - geiser-repl-autoeval-mode) - (mode "Superparen mode" ("\C-c\C-d\C-s" "\C-c\C-ds") - geiser-repl-superparen-mode) - -- - ("Compile buffer" "\C-c\C-k" geiser-compile-current-buffer) - ("Switch to REPL" "\C-c\C-z" geiser-mode-switch-to-repl) - ("Switch to REPL and enter module" "\C-c\C-a" - geiser-mode-switch-to-repl-and-enter) - ("Set Scheme..." "\C-c\C-s" geiser-set-scheme) - ("Exit REPL or debugger" "\C-c\C-q" geiser-exit-repl) - -- - ("Edit symbol at point" "\M-." geiser-edit-symbol-at-point - :enable (geiser--symbol-at-point)) - ("Go to previous definition" "\M-," geiser-pop-symbol-stack) - ("Complete symbol" ((kbd "M-TAB")) completion-at-point - :enable (geiser--symbol-at-point)) - ("Complete module name" ((kbd "M-`") (kbd "C-.")) - geiser-capf-complete-module) - ("Edit module" ("\C-c\C-e\C-m" "\C-c\C-em") geiser-edit-module) - ("Add to load path..." ("\C-c\C-e\C-l" "\C-c\C-el") geiser-add-to-load-path) - ("Toggle ()/[]" ("\C-c\C-e\C-[" "\C-c\C-e[") geiser-squarify) - ("Insert λ" ("\C-c\\" "\C-c\C-\\") geiser-insert-lambda) - -- - ("Callers" ((kbd "C-c <")) geiser-xref-callers - :enable (and (geiser-eval--supported-p 'callers) - (geiser--symbol-at-point))) - ("Callees" ((kbd "C-c >")) geiser-xref-callees - :enable (and (geiser-eval--supported-p 'callees) - (geiser--symbol-at-point))) - -- - (mode "Smart TAB mode" nil geiser-smart-tab-mode) - -- - (custom "Customize Geiser mode" geiser-mode)) - map)) - - -;;; Geiser mode: - -(defvar-local geiser-mode-string nil - "Modeline indicator for geiser-mode") - -(defun geiser-mode--lighter () - (or geiser-mode-string - (format " %s" (or (geiser-impl--impl-str) "G")))) - -(define-minor-mode geiser-mode - "Toggle Geiser's mode. - -With no argument, this command toggles the mode. -Non-null prefix argument turns on the mode. -Null prefix argument turns off the mode. - -When Geiser mode is enabled, a host of nice utilities for -interacting with the Geiser REPL is at your disposal. -\\{geiser-mode-map}" - :init-value nil - :lighter (:eval (geiser-mode--lighter)) - :group 'geiser-mode - (when geiser-mode (geiser-impl--set-buffer-implementation nil t)) - (setq geiser-autodoc-mode-string "/A") - (setq geiser-smart-tab-mode-string "/T") - (geiser-capf-setup geiser-mode) - (when geiser-mode-autodoc-p - (geiser-autodoc-mode (if geiser-mode 1 -1))) - (when geiser-mode-smart-tab-p - (geiser-smart-tab-mode (if geiser-mode 1 -1))) - (geiser-syntax--add-kws) - (when (and geiser-mode - geiser-mode-start-repl-p - (not (geiser-syntax--font-lock-buffer-p)) - (not (geiser-repl--connection*))) - (save-window-excursion (geiser geiser-impl--implementation)))) - -(defun turn-on-geiser-mode () - "Enable `geiser-mode' (in a Scheme buffer)." - (interactive) - (geiser-mode 1)) - -(defun turn-off-geiser-mode () - "Disable `geiser-mode' (in a Scheme buffer)." - (interactive) - (geiser-mode -1)) - -(defun geiser-mode--maybe-activate () - (when (and geiser-mode-auto-p (eq major-mode 'scheme-mode)) - (turn-on-geiser-mode))) - - -;;; Reload support: - -(defun geiser-mode--buffers () - (let ((buffers)) - (dolist (buffer (buffer-list)) - (when (buffer-live-p buffer) - (set-buffer buffer) - (when geiser-mode - (push (cons buffer geiser-impl--implementation) buffers)))) - buffers)) - -(defun geiser-mode--restore (buffers) - (dolist (b buffers) - (when (buffer-live-p (car b)) - (set-buffer (car b)) - (when (cdr b) - (geiser-impl--set-buffer-implementation (cdr b))) - (geiser-mode 1)))) - -(defun geiser-mode-unload-function () - (dolist (b (geiser-mode--buffers)) - (with-current-buffer (car b) (geiser-mode nil)))) - - -(provide 'geiser-mode) diff --git a/elpa/geiser-0.30/geiser-pkg.el b/elpa/geiser-0.30/geiser-pkg.el @@ -1,2 +0,0 @@ -;; Generated package description from geiser.el -*- no-byte-compile: t -*- -(define-package "geiser" "0.30" "GNU Emacs and Scheme talk to each other" '((emacs "27.1") (project "0.8.1")) :commit "f343592a52da0f947989d07c208a51ad6c972a5e" :authors '(("Jose Antonio Ortega Ruiz" . "(jao@gnu.org)")) :maintainer '("Jose Antonio Ortega Ruiz" . "(jao@gnu.org)") :keywords '("languages" "scheme" "geiser") :url "https://gitlab.com/emacs-geiser/") diff --git a/elpa/geiser-0.30/geiser-popup.el b/elpa/geiser-0.30/geiser-popup.el @@ -1,74 +0,0 @@ -;;; geiser-popup.el -- popup windows -*- lexical-binding: t; -*- - -;; Copyright (C) 2009, 2010, 2012, 2013 Jose Antonio Ortega Ruiz - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the Modified BSD License. You should -;; have received a copy of the license along with this program. If -;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>. - -;; Start date: Sat Feb 07, 2009 14:05 - - -;;; Code: - -(require 'view) - - -;;; Support for defining popup buffers and accessors: - -(defvar geiser-popup--registry nil) - -(defvar geiser-popup--overriding-map - (let ((map (make-sparse-keymap))) - (define-key map "q" 'View-quit) - map)) - -(defun geiser-popup--setup-view-mode () - (view-mode t) - (set (make-local-variable 'view-no-disable-on-exit) t) - (set (make-local-variable 'minor-mode-overriding-map-alist) - (list (cons 'view-mode geiser-popup--overriding-map))) - (setq view-exit-action - (lambda (buffer) - (with-current-buffer buffer - (bury-buffer))))) - -(defmacro geiser-popup--define (base name mode) - (let ((get-buff (intern (format "geiser-%s--buffer" base))) - (pop-buff (intern (format "geiser-%s--pop-to-buffer" base))) - (with-macro (intern (format "geiser-%s--with-buffer" base))) - (method (make-symbol "method")) - (buffer (make-symbol "buffer"))) - `(progn - (add-to-list 'geiser-popup--registry ,name) - (defun ,get-buff () - (or (get-buffer ,name) - (with-current-buffer (get-buffer-create ,name) - (funcall ',mode) - (geiser-popup--setup-view-mode) - (current-buffer)))) - (defun ,pop-buff (&optional ,method) - (let ((,buffer (funcall ',get-buff))) - (unless (eq ,buffer (current-buffer)) - (cond ((eq ,method 'buffer) (view-buffer ,buffer)) - ((eq ,method 'frame) (view-buffer-other-frame ,buffer)) - (t (view-buffer-other-window ,buffer)))))) - (defmacro ,with-macro (&rest body) - (declare (debug (&rest form))) - (list 'with-current-buffer (list ',get-buff) - (cons 'let (cons '((inhibit-read-only t)) body)))) - (put ',with-macro 'lisp-indent-function 'defun)))) - -(put 'geiser-popup--define 'lisp-indent-function 1) - - -;;; Reload support: - -(defun geiser-popup-unload-function () - (dolist (name geiser-popup--registry) - (when (buffer-live-p (get-buffer name)) - (kill-buffer name)))) - - -(provide 'geiser-popup) diff --git a/elpa/geiser-0.30/geiser-reload.el b/elpa/geiser-0.30/geiser-reload.el @@ -1,85 +0,0 @@ -;;; geiser-reload.el -- unload/load geiser packages -*- lexical-binding: t; -*- - -;; Copyright (C) 2009, 2010, 2012, 2020, 2021, 2022 Jose Antonio Ortega Ruiz - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the Modified BSD License. You should -;; have received a copy of the license along with this program. If -;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>. - -;; Start date: Sat Aug 22, 2009 23:04 - - -;;; Code: - -(require 'geiser-repl) -(require 'geiser-mode) -(require 'geiser-custom) -(require 'geiser-base) -(require 'geiser) - - -;;; Reload: - -(defmacro geiser--features-list () - (quote '( - geiser-mode - geiser-repl - geiser-capf - geiser-doc - geiser-xref - geiser-compile - geiser-debug - geiser-completion - geiser-autodoc - geiser-edit - geiser-eval - geiser-connection - geiser-syntax - geiser-menu - geiser-inf - geiser-impl - geiser-image - geiser-custom - geiser-log - geiser-popup - geiser-base - geiser-version - geiser - ))) - -(defun geiser-unload () - "Unload all Geiser modules." - (interactive) - (let ((fs (geiser--features-list))) - (unload-feature 'geiser-reload t) - (dolist (f fs) - (when (featurep f) (unload-feature f t))) - (remove-hook 'scheme-mode-hook 'geiser-mode--maybe-activate))) - -(defun geiser-reload (&optional arg) - "Reload Geiser. -With prefix arg, prompts for the DIRECTORY from which Geiser should be -loaded again." - (interactive "P") - (let* ((old-dir geiser-elisp-dir) - (dir (or (and arg (read-directory-name "New Geiser elisp dir: " - old-dir old-dir t old-dir)) - old-dir))) - (unless (or (file-exists-p (expand-file-name "geiser-reload.el" dir)) - (file-exists-p (expand-file-name "geiser-reload.elc" dir))) - (error "%s does not contain Geiser!" dir)) - (let ((memo (geiser-custom--memoized-state)) - (repls (geiser-repl--repl-list)) - (buffers (geiser-mode--buffers))) - (geiser-unload) - (setq load-path (remove old-dir load-path)) - (add-to-list 'load-path dir) - (mapc (lambda (x) (set (car x) (cdr x))) memo) - (require 'geiser-reload) - (geiser-repl--restore repls) - (geiser-mode--restore buffers) - (message "Geiser reloaded!")))) - - -(provide 'geiser-reload) diff --git a/elpa/geiser-0.30/geiser-repl.el b/elpa/geiser-0.30/geiser-repl.el @@ -1,1295 +0,0 @@ -;;; geiser-repl.el --- Geiser's REPL -*- lexical-binding: t; -*- - -;; Copyright (C) 2009-2013, 2015-2016, 2018-2023 Jose Antonio Ortega Ruiz - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the Modified BSD License. You should -;; have received a copy of the license along with this program. If -;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>. - - -;;; Code: - -(require 'geiser-capf) -(require 'geiser-doc) -(require 'geiser-autodoc) -(require 'geiser-edit) -(require 'geiser-completion) -(require 'geiser-syntax) -(require 'geiser-impl) -(require 'geiser-eval) -(require 'geiser-connection) -(require 'geiser-menu) -(require 'geiser-image) -(require 'geiser-custom) -(require 'geiser-base) - -(require 'comint) -(require 'compile) -(require 'scheme) -(require 'font-lock) -(require 'project) -(require 'paren) - -(eval-when-compile (require 'subr-x)) - - -;;; Customization: - -(defgroup geiser-repl nil - "Interacting with the Geiser REPL." - :group 'geiser) - -(geiser-custom--defcustom geiser-repl-buffer-name-function - 'geiser-repl-buffer-name - "Function used to define the name of a REPL buffer. -The function is called with a single argument - an implementation -symbol (e.g., `guile', `chicken', etc.)." - :type '(choice (function-item geiser-repl-buffer-name) - (function :tag "Other function"))) - -(geiser-custom--defcustom geiser-repl-per-project-p nil - "Whether to spawn a separate REPL per project. -See also `geiser-repl-current-project-function' for the function -used to discover a buffer's project." - :type 'boolean) - -(defun geiser-repl-project-root () - "Use project.el, to determine a buffer's project root." - (when-let (p (project-current)) (project-root p))) - -(geiser-custom--defcustom geiser-repl-current-project-function - #'geiser-repl-project-root - "Function used to determine the current project. -The function is called from both source and REPL buffers, and -should return a value which uniquely identifies the project." - :type '(choice (function-item :tag "Ignore projects" ignore) - (function-item :tag "Use project.el" geiser-repl-project-root) - (function-item :tag "Use projectile" projectile-project-root) - (function :tag "Other function"))) - -(geiser-custom--defcustom geiser-repl-use-other-window t - "Whether to Use a window other than the current buffer's when -switching to the Geiser REPL buffer." - :type 'boolean) - -(geiser-custom--defcustom geiser-repl-window-allow-split t - "Whether to allow window splitting when switching to the Geiser REPL buffer." - :type 'boolean) - -(geiser-custom--defcustom geiser-repl-history-filename - (expand-file-name "~/.geiser_history") - "File where REPL input history is saved, so that it persists between sessions. - -This is actually the base name: the concrete Scheme -implementation name gets appended to it." - :type 'file) - -(geiser-custom--defcustom geiser-repl-history-size comint-input-ring-size - "Maximum size of the saved REPL input history." - :type 'integer) - -(geiser-custom--defcustom geiser-repl-history-no-dups-p t - "Whether to skip duplicates when recording history." - :type 'boolean) - -(geiser-custom--defcustom geiser-repl-save-debugging-history-p t - "Whether to save debugging input in REPL history. - -By default, REPL interactions while scheme is in the debugger are -not added to the REPL command history. Set this variable to t to -change that." - :type 'boolean) - -(geiser-custom--defcustom geiser-repl-autodoc-p t - "Whether to enable `geiser-autodoc-mode' in the REPL by default." - :type 'boolean) - -(geiser-custom--defcustom geiser-repl-read-only-prompt-p t - "Whether the REPL's prompt should be read-only." - :type 'boolean) - -(geiser-custom--defcustom geiser-repl-read-only-output-p t - "Whether the REPL's output should be read-only." - :type 'boolean) - -(geiser-custom--defcustom geiser-repl-highlight-output-p nil - "Whether to syntax highlight REPL output." - :type 'boolean) - -(geiser-custom--defcustom geiser-repl-auto-indent-p t - "Whether newlines for incomplete sexps are autoindented." - :type 'boolean) - -(geiser-custom--defcustom geiser-repl-send-on-return-p t - "Whether to Send input to REPL when ENTER is pressed in a balanced S-expression, -regardless of cursor positioning. - -When off, pressing ENTER inside a balance S-expression will -introduce a new line without sending input to the inferior -Scheme process. This option is useful when using minor modes -which might do parentheses balancing, or when entering additional -arguments inside an existing expression. - -When on (the default), pressing ENTER inside a balanced S-expression -will send the input to the inferior Scheme process regardless of the -cursor placement." - :type 'boolean) - -(geiser-custom--defcustom geiser-repl-forget-old-errors-p t - "Whether to forget old errors upon entering a new expression. - -When on (the default), every time a new expression is entered in -the REPL old error messages are flushed, and using \\[next-error] -afterwards will jump only to error locations produced by the new -expression, if any." - :type 'boolean) - -(geiser-custom--defcustom geiser-repl-skip-version-check-p nil - "Whether to skip version checks for the Scheme executable. - -When set, Geiser won't check the version of the Scheme -interpreter when starting a REPL, saving a few tenths of a -second." - :type 'boolean) - -(geiser-custom--defcustom geiser-repl-query-on-exit-p nil - "Whether to prompt for confirmation on \\[geiser-repl-exit]." - :type 'boolean) - -(geiser-custom--defcustom geiser-repl-delete-last-output-on-exit-p nil - "Whether to delete partial outputs when the REPL's process exits." - :type 'boolean) - -(geiser-custom--defcustom geiser-repl-query-on-kill-p t - "Whether to prompt for confirmation when killing a REPL buffer with -a life process." - :type 'boolean) - -(geiser-custom--defcustom geiser-repl-default-host "localhost" - "Default host when connecting to remote REPLs." - :type 'string) - -(geiser-custom--defcustom geiser-repl-default-port 37146 - "Default port for connecting to remote REPLs." - :type 'integer) - -(geiser-custom--defcustom geiser-repl-startup-time 10000 - "Time, in milliseconds, to wait for Racket to startup. -If you have a slow system, try to increase this time." - :type 'integer) - -(geiser-custom--defcustom geiser-repl-inline-images-p t - "Whether to display inline images in the REPL." - :type 'boolean) - -(geiser-custom--defcustom geiser-repl-auto-display-images-p t - "Whether to automatically invoke the external viewer to display -images popping up in the REPL. - -See also `geiser-debug-auto-display-images'." - :type 'boolean) - -(geiser-custom--defcustom geiser-repl-add-project-paths t - "Whether to automatically add current project's root to load path on startup. - -If set to `t' (the default), the directory returned by -`geiser-repl-current-project-function' is added to the load path. - -If set to a list of sudirectories (e.g. (\".\" \"src\" \"tests\")), -their full path (starting with the project's root, is added -instead. - -This variable is a good candidate for .dir-locals.el. - -This option has no effect if no project root is found." - :type '(choice boolean (list string))) - -(geiser-custom--defcustom geiser-repl-startup-hook nil - "Functions run right after a REPL has started and is fully set up. - -See also `geiser-repl-startup-forms'." - :type 'hook) - -(geiser-custom--defcustom geiser-repl-startup-forms nil - "List scheme forms, as strings, sent to a REPL on start-up. - -This variable is a good candidate for .dir-locals.el. - -See also `geiser-repl-startup-hook'." - :type '(repeat string)) - -(geiser-custom--defcustom geiser-repl-autoeval-mode-delay 0.125 - "Delay before autoeval is run after an S-expression is balanced, in seconds." - :type 'number) - -(geiser-custom--defcustom geiser-repl-autoeval-mode-p nil - "Whether `geiser-repl-autoeval-mode' gets enabled by default in REPL buffers." - :type 'boolean) - -(geiser-custom--defcustom geiser-repl-superparen-mode-p nil - "Whether `geiser-repl-superparen-mode' gets enabled by default in REPL buffers." - :type 'boolean) - -(geiser-custom--defcustom geiser-repl-superparen-character ?\] - "The character that represents a closing super parentheses." - :type 'character) - -(geiser-custom--defface repl-input - 'comint-highlight-input geiser-repl "evaluated input highlighting") - -(geiser-custom--defface repl-output - 'font-lock-string-face geiser-repl "REPL output") - -(geiser-custom--defface repl-prompt - 'comint-highlight-prompt geiser-repl "REPL prompt") - - - -;;; Implementation-dependent parameters - -(geiser-impl--define-caller geiser-repl--binary binary () - "A variable or function returning the path to the scheme binary -for this implementation.") - -(geiser-impl--define-caller geiser-repl--arglist arglist () - "A function taking no arguments and returning a list of -arguments to be used when invoking the scheme binary.") - -(geiser-impl--define-caller geiser-repl--prompt-regexp prompt-regexp () - "A variable (or thunk returning a value) giving the regular -expression for this implementation's geiser scheme prompt.") - -(geiser-impl--define-caller - geiser-repl--debugger-prompt-regexp debugger-prompt-regexp () - "A variable (or thunk returning a value) giving the regular -expression for this implementation's debugging prompt.") - -(geiser-impl--define-caller geiser-repl--startup repl-startup (remote) - "Function taking no parameters that is called after the REPL -has been initialised. All Geiser functionality is available to -you at that point.") - -(geiser-impl--define-caller geiser-repl--enter-cmd enter-command (module) - "Function taking a module designator and returning a REPL enter -module command as a string") - -(geiser-impl--define-caller geiser-repl--import-cmd import-command (module) - "Function taking a module designator and returning a REPL import -module command as a string") - -(geiser-impl--define-caller geiser-repl--exit-cmd exit-command () - "Function returning the REPL exit command as a string") - -(geiser-impl--define-caller geiser-repl--version version-command (binary) - "Function returning the version of the corresponding scheme process, - given its full path.") - -(geiser-impl--define-caller geiser-repl--min-version minimum-version () - "A variable providing the minimum required scheme version, as a string.") - -(geiser-impl--define-caller geiser-repl--connection-address connection-address () - "If this implementation supports a parallel connection, return its address. -The implementation is responsible of setting up the listening REPL on -startup. When this function returns a non-nil address, a connection -will be set up using `geiser-connect-local' when a REPL is started.") - - -;;; Geiser REPL buffers and processes: - -(defvar geiser-repl--repls nil) -(defvar geiser-repl--closed-repls nil) - -(defvar geiser-repl--last-output-start nil) -(defvar geiser-repl--last-output-end nil) - -(defvar-local geiser-repl--repl nil) - -(defvar-local geiser-repl--project nil) - -(defsubst geiser-repl--set-this-buffer-repl (r &optional this) - (with-current-buffer (or this (current-buffer)) (setq geiser-repl--repl r))) - -(defsubst geiser-repl--set-this-buffer-project (p) - (setq geiser-repl--project p)) - -(defsubst geiser-repl--current-project () - (or (when geiser-repl-per-project-p - (funcall geiser-repl-current-project-function)) - 'no-project)) - -(defun geiser-repl--live-p () - (and geiser-repl--repl - (get-buffer-process geiser-repl--repl))) - -(defun geiser-repl--repl/impl (impl &optional proj repls) - (let ((proj (or proj - geiser-repl--project - (geiser-repl--current-project))) - (repls (or repls - geiser-repl--repls))) - (catch 'repl - (dolist (repl repls) - (when (buffer-live-p repl) - (with-current-buffer repl - (when (and (eq geiser-impl--implementation impl) - (equal geiser-repl--project proj)) - (throw 'repl repl)))))))) - -(defun geiser-repl--set-up-repl (impl) - (or (and (not impl) geiser-repl--repl) - (geiser-repl--set-this-buffer-repl - (let ((impl (or impl - geiser-impl--implementation - (geiser-impl--guess)))) - (when impl (geiser-repl--repl/impl impl)))))) - -(defun geiser-repl--active-impls () - (let ((act)) - (dolist (repl geiser-repl--repls act) - (with-current-buffer repl - (unless (memq geiser-impl--implementation act) - (push geiser-impl--implementation act)))))) - -(defsubst geiser-repl--repl-name (impl) - (format "%s REPL" (geiser-impl--impl-str impl))) - -(defsubst geiser-repl--buffer-name (impl) - (funcall geiser-repl-buffer-name-function impl)) - -(defun geiser-repl-buffer-name (impl) - "Return default name of the REPL buffer for implementation IMPL." - (let ((repl-name (geiser-repl--repl-name impl)) - (current-project (funcall geiser-repl-current-project-function))) - (if (and geiser-repl-per-project-p current-project) - (let ((project-name (file-name-nondirectory - (directory-file-name current-project)))) - (format "*Geiser %s: %s*" repl-name project-name)) - (format "*Geiser %s*" repl-name)))) - -(defun geiser-repl--switch-to-buffer (buffer) - (unless (eq buffer (current-buffer)) - (let ((pop-up-windows geiser-repl-window-allow-split)) - (if geiser-repl-use-other-window - (switch-to-buffer-other-window buffer) - (switch-to-buffer buffer))))) - -(defun geiser-repl--to-repl-buffer (impl) - (unless (and (eq major-mode 'geiser-repl-mode) - (eq geiser-impl--implementation impl) - (not (get-buffer-process (current-buffer)))) - (let* ((proj (geiser-repl--current-project)) - (old (geiser-repl--repl/impl impl proj geiser-repl--closed-repls)) - (old (and (buffer-live-p old) - (not (get-buffer-process old)) - old)) - (origin (current-buffer))) - (geiser-repl--switch-to-buffer - (or old (generate-new-buffer (geiser-repl--buffer-name impl)))) - (geiser-repl--set-this-buffer-repl (current-buffer) origin) - (unless old - (geiser-repl-mode) - (geiser-impl--set-buffer-implementation impl) - (geiser-repl--set-this-buffer-project proj) - (geiser-syntax--add-kws t))))) - -(defun geiser-repl--read-impl (prompt &optional active) - (geiser-impl--read-impl prompt (and active (geiser-repl--active-impls)))) - -(defsubst geiser-repl--only-impl-p () - (and (null (cdr geiser-active-implementations)) - (car geiser-active-implementations))) - -(defun geiser-repl--get-impl (prompt) - (or (geiser-repl--only-impl-p) - (and (eq major-mode 'geiser-repl-mode) geiser-impl--implementation) - (geiser-repl--read-impl prompt))) - - -;;; Prompt &co. - -(defun geiser-repl--last-prompt-end () - (cond ((and (boundp 'comint-last-prompt) (markerp (cdr comint-last-prompt))) - (marker-position (cdr comint-last-prompt))) - ((and (boundp 'comint-last-prompt-overlay) comint-last-prompt-overlay) - (overlay-end comint-last-prompt-overlay)) - (t (save-excursion - (geiser-repl--bol) - (min (+ 1 (point)) (point-max)))))) - -(defun geiser-repl--last-prompt-start () - (cond ((and (boundp 'comint-last-prompt) (markerp (car comint-last-prompt))) - (marker-position (car comint-last-prompt))) - ((and (boundp 'comint-last-prompt-overlay) comint-last-prompt-overlay) - (overlay-start comint-last-prompt-overlay)) - (t (save-excursion (geiser-repl--bol) (point))))) - - -;;; REPL connections - -(defvar-local geiser-repl--address nil) - -(defvar-local geiser-repl--connection nil) - -(defun geiser-repl--local-p () - "Return non-nil, if current REPL is local (connected to socket)." - (stringp geiser-repl--address)) - -(defun geiser-repl--remote-p () - "Return non-nil, if current REPL is remote (connected to host:port)." - (consp geiser-repl--address)) - -(defsubst geiser-repl--host () (car geiser-repl--address)) -(defsubst geiser-repl--port () (cdr geiser-repl--address)) - -(defun geiser-repl--read-address (&optional host port) - (let ((defhost (or (geiser-repl--host) geiser-repl-default-host)) - (defport (or (geiser-repl--port) geiser-repl-default-port))) - (cons (or host - (read-string (format "Host (default %s): " defhost) - nil nil defhost)) - (or port (read-number "Port: " defport))))) - -(defun geiser-repl--autodoc-mode (n) - (when (or geiser-repl-autodoc-p (< n 0)) - (geiser--save-msg (geiser-autodoc-mode n)))) - -(defun geiser-repl--save-remote-data (address) - (setq geiser-repl--address address) - (cond ((consp address) - (setq header-line-format - (format "Host: %s Port: %s" - (geiser-repl--host) - (geiser-repl--port)))) - ((stringp address) - (setq header-line-format - (format "Socket: %s" address))))) - -(defun geiser-repl--fontify-output-region (beg end) - "Apply highlighting to a REPL output region." - (remove-text-properties beg end '(font-lock-face nil face nil)) - (if geiser-repl-highlight-output-p - (geiser-syntax--fontify-syntax-region beg end) - (geiser-repl--fontify-plaintext beg end))) - -(defun geiser-repl--fontify-plaintext (start end) - "Fontify REPL output plainly." - (add-text-properties - start end - '(font-lock-fontified t - fontified t - font-lock-multiline t - font-lock-face geiser-font-lock-repl-output))) - -(defun geiser-repl--narrow-to-prompt () - "Narrow to active prompt region and return t, otherwise returns nil." - (let* ((proc (get-buffer-process (current-buffer))) - (pmark (and proc (process-mark proc))) - (intxt (when (>= (point) (marker-position pmark)) - (save-excursion - (if comint-eol-on-send - (if comint-use-prompt-regexp - (end-of-line) - (goto-char (field-end)))) - (buffer-substring pmark (point))))) - (prompt-beg (marker-position pmark)) - (prompt-end (+ prompt-beg (length intxt)))) - (when (> (length intxt) 0) - (narrow-to-region prompt-beg prompt-end) - t))) - -(defun geiser-repl--wrap-fontify-region-function (_beg _end &optional _loudly) - (save-restriction - (when (geiser-repl--narrow-to-prompt) - (let ((font-lock-dont-widen t)) - (font-lock-default-fontify-region (point-min) (point-max) nil))))) - -(defun geiser-repl--wrap-unfontify-region-function (_beg _end &optional _loudly) - (save-restriction - (when (geiser-repl--narrow-to-prompt) - (let ((font-lock-dont-widen t)) - (font-lock-default-unfontify-region (point-min) (point-max)))))) - -(defun geiser-repl--find-output-region () - (save-excursion - (goto-char (point-max)) - (re-search-backward comint-prompt-regexp) - (move-to-column 0) - (set-marker geiser-repl--last-output-end (point)) - (save-excursion - (when (re-search-backward comint-prompt-regexp nil t) - (forward-line) - (when (> (point) geiser-repl--last-output-start) - (set-marker geiser-repl--last-output-start (point))))) - (> (- geiser-repl--last-output-end geiser-repl--last-output-start) 2))) - -(defun geiser-repl--treat-output-region () - (with-silent-modifications - (add-text-properties (max (point-min) (1- geiser-repl--last-output-start)) - (min geiser-repl--last-output-end (point-max)) - `(read-only ,geiser-repl-read-only-output-p)) - (geiser-repl--fontify-output-region geiser-repl--last-output-start - geiser-repl--last-output-end) - (geiser--font-lock-ensure geiser-repl--last-output-start - geiser-repl--last-output-end))) - -(defun geiser-repl--output-filter (txt) - (when (geiser-repl--find-output-region) (geiser-repl--treat-output-region)) - (geiser-con--connection-update-debugging geiser-repl--connection txt) - (geiser-image--replace-images geiser-repl-inline-images-p - geiser-repl-auto-display-images-p) - (when (string-match-p (geiser-con--connection-prompt geiser-repl--connection) - txt) - (geiser-autodoc--disinhibit-autodoc))) - -(defun geiser-repl--check-version (impl) - (when (not geiser-repl-skip-version-check-p) - (let ((v (geiser-repl--version impl (geiser-repl--binary impl))) - (r (geiser-repl--min-version impl))) - (when (and v r (geiser--version< v r)) - (error "Geiser requires %s version %s but detected %s" impl r v))))) - -(defvar geiser-repl--last-scm-buffer) - -(defun geiser-repl--set-default-directory () - (when-let (root (funcall geiser-repl-current-project-function)) - (setq-local default-directory root))) - -(defun geiser-repl--set-up-load-path () - (when geiser-repl-add-project-paths - (when-let (root (funcall geiser-repl-current-project-function)) - (dolist (p (cond ((eq t geiser-repl-add-project-paths) '(".")) - ((listp geiser-repl-add-project-paths) - geiser-repl-add-project-paths))) - (geiser-add-to-load-path (expand-file-name p root)))))) - -(defvar-local geiser-repl--repl-buffer nil) - -(defvar-local geiser-repl--binary nil) - -(defvar-local geiser-repl--arglist nil) - -(defun geiser-repl--start-repl (impl address) - (message "Starting Geiser REPL ...") - (when (not address) (geiser-repl--check-version impl)) - (let ((buffer (current-buffer)) - (binary (geiser-repl--binary impl)) - (arglist (geiser-repl--arglist impl))) - (geiser-repl--to-repl-buffer impl) - (setq geiser-repl--last-scm-buffer buffer - geiser-repl--binary binary - geiser-repl--arglist arglist)) - (sit-for 0) - (goto-char (point-max)) - (geiser-repl--autodoc-mode -1) - (let* ((prompt-rx (geiser-repl--prompt-regexp impl)) - (deb-prompt-rx (geiser-repl--debugger-prompt-regexp impl)) - (prompt (geiser-con--combined-prompt prompt-rx deb-prompt-rx))) - (unless prompt-rx - (error "Sorry, I don't know how to start a REPL for %s" impl)) - (geiser-repl--set-default-directory) - (geiser-repl--save-remote-data address) - (geiser-repl--start-scheme impl address prompt) - (geiser-repl--quit-setup) - (geiser-repl--history-setup) - (add-to-list 'geiser-repl--repls (current-buffer)) - (geiser-repl--set-this-buffer-repl (current-buffer)) - (setq geiser-repl--connection - (geiser-repl--connection-setup impl address prompt-rx deb-prompt-rx)) - (geiser-repl--startup impl address) - (geiser-repl--autodoc-mode 1) - (geiser-repl--set-up-load-path) - (add-hook 'comint-output-filter-functions - 'geiser-repl--output-filter - nil - t) - (set-process-query-on-exit-flag (get-buffer-process (current-buffer)) - geiser-repl-query-on-kill-p) - (dolist (f geiser-repl-startup-forms) - (geiser-log--info "Evaluating startup form %s..." f) - (geiser-eval--send/wait `(:eval (:scm ,f)))) - (run-hooks 'geiser-repl-startup-hook) - (message "%s up and running!" (geiser-repl--repl-name impl)))) - -(defvar-local geiser-repl--connection-buffer nil) - -(defun geiser-repl--connection-buffer (addr) - (when addr (get-buffer-create (format " %s <%s>" (buffer-name) addr)))) - -(defun geiser-repl--connection-setup (impl address prompt deb-prompt) - (let* ((addr (unless address (geiser-repl--connection-address impl))) - (buff (or (geiser-repl--connection-buffer addr) (current-buffer)))) - (when addr - (setq geiser-repl--connection-buffer buff) - (geiser-repl--comint-local-connect buff addr)) - (geiser-con--make-connection (get-buffer-process buff) prompt deb-prompt))) - -(defun geiser-repl--comint-local-connect (buff address) - "Connect over a Unix-domain socket." - (with-current-buffer buff - (let ((proc (make-network-process :name (buffer-name buff) - :buffer buff - :family 'local - :remote address - :service nil))) - ;; brittleness warning: this is stuff - ;; make-comint-in-buffer sets up, via comint-exec, when - ;; it creates its own process, something we're doing - ;; here by ourselves. - (set-process-filter proc 'comint-output-filter) - (goto-char (point-max)) - (set-marker (process-mark proc) (point))))) - -(defun geiser-repl--start-scheme (impl address prompt) - (setq comint-prompt-regexp prompt) - (let* ((name (geiser-repl--repl-name impl)) - (buff (current-buffer)) - (args (cond ((consp address) (list address)) - ((stringp address) '(())) - (t `(,(geiser-repl--get-binary impl) - nil - ,@(geiser-repl--get-arglist impl)))))) - (condition-case err - (if (and address (stringp address)) - (geiser-repl--comint-local-connect buff address) - (apply 'make-comint-in-buffer `(,name ,buff ,@args))) - (error (insert "Unable to start REPL:\n" (error-message-string err) "\n") - (error "Couldn't start Geiser: %s" err))) - (geiser-repl--wait-for-prompt geiser-repl-startup-time))) - -(defun geiser-repl--wait-for-prompt (timeout) - (let ((p (point)) (seen) (buffer (current-buffer))) - (while (and (not seen) - (> timeout 0) - (get-buffer-process buffer)) - (sleep-for 0.1) - (setq timeout (- timeout 100)) - (goto-char p) - (setq seen (re-search-forward comint-prompt-regexp nil t))) - (goto-char (point-max)) - (unless seen (error "%s" "No prompt found!")))) - -(defun geiser-repl--is-debugging () - (let ((dp (geiser-con--connection-debug-prompt geiser-repl--connection))) - (and dp - (save-excursion - (goto-char (geiser-repl--last-prompt-start)) - (re-search-forward dp (geiser-repl--last-prompt-end) t))))) - -(defun geiser-repl--connection* () - (let ((buffer (geiser-repl--set-up-repl geiser-impl--implementation))) - (and (buffer-live-p buffer) - (get-buffer-process buffer) - (with-current-buffer buffer geiser-repl--connection)))) - -(defun geiser-repl--connection () - (or (geiser-repl--connection*) - (error "No Geiser REPL for this buffer (try M-x geiser)"))) - -(setq geiser-eval--default-connection-function 'geiser-repl--connection) - -(defun geiser-repl--prepare-send () - (geiser-image--clean-cache) - (geiser-autodoc--inhibit-autodoc) - (geiser-con--connection-deactivate geiser-repl--connection)) - -(defun geiser-repl--send (cmd &optional save-history) - "Send CMD input string to the current REPL buffer. -If SAVE-HISTORY is non-nil, save CMD in the REPL history." - (when (and cmd (eq major-mode 'geiser-repl-mode)) - (geiser-repl--prepare-send) - (goto-char (point-max)) - (comint-kill-input) - (insert cmd) - (let ((comint-input-filter (if save-history - comint-input-filter - 'ignore))) - (comint-send-input nil t)))) - -(defun geiser-repl-interrupt () - (interactive) - (when (get-buffer-process (current-buffer)) - (interrupt-process nil comint-ptyp))) - - -;;; REPL history - -(defconst geiser-repl--history-separator "\n}{\n") - -(defsubst geiser-repl--history-file () - (format "%s.%s" geiser-repl-history-filename geiser-impl--implementation)) - -(defun geiser-repl--read-input-ring () - (let ((comint-input-ring-file-name (geiser-repl--history-file)) - (comint-input-ring-separator geiser-repl--history-separator) - (buffer-file-coding-system 'utf-8)) - (comint-read-input-ring t))) - -(defun geiser-repl--write-input-ring () - (let ((comint-input-ring-file-name (geiser-repl--history-file)) - (comint-input-ring-separator geiser-repl--history-separator) - (buffer-file-coding-system 'utf-8)) - (comint-write-input-ring))) - -(defun geiser-repl--history-setup () - (set (make-local-variable 'comint-input-ring-size) geiser-repl-history-size) - (set (make-local-variable 'comint-input-filter) 'geiser-repl--input-filter) - (geiser-repl--read-input-ring)) - - -;;; Cleaning up - -(defun geiser-repl--on-quit () - (geiser-repl--write-input-ring) - (let ((cb (current-buffer)) - (impl geiser-impl--implementation) - (comint-prompt-read-only nil)) - (geiser-con--connection-deactivate geiser-repl--connection t) - (geiser-con--connection-close geiser-repl--connection) - (setq geiser-repl--repls (remove cb geiser-repl--repls)) - (unless (eq cb geiser-repl--connection-buffer) - (when (buffer-live-p geiser-repl--connection-buffer) - (kill-buffer geiser-repl--connection-buffer) - (setq geiser-repl--connection-buffer nil) - (when-let (a (geiser-repl--connection-address - geiser-impl--implementation)) - (delete-file a)))) - (dolist (buffer (buffer-list)) - (when (buffer-live-p buffer) - (with-current-buffer buffer - (when (and (eq geiser-impl--implementation impl) - (equal cb geiser-repl--repl)) - (geiser-repl--set-up-repl geiser-impl--implementation))))))) - -(defun geiser-repl--sentinel (proc _event) - (let ((pb (process-buffer proc))) - (when (buffer-live-p pb) - (with-current-buffer pb - (let ((comint-prompt-read-only nil) - (comint-input-ring-file-name (geiser-repl--history-file)) - (comint-input-ring-separator geiser-repl--history-separator)) - (geiser-repl--on-quit) - (push pb geiser-repl--closed-repls) - (goto-char (point-max)) - (when geiser-repl-delete-last-output-on-exit-p - (comint-kill-region comint-last-input-start (point))) - (insert "\nIt's been nice interacting with you!\n") - (insert - (substitute-command-keys - "Press \\[geiser-repl-switch] to bring me back.\n"))))))) - -(defun geiser-repl--on-kill () - (geiser-repl--on-quit) - (setq geiser-repl--closed-repls - (remove (current-buffer) geiser-repl--closed-repls))) - -(defun geiser-repl--input-filter (str) - (not (or (and (not geiser-repl-save-debugging-history-p) - (geiser-repl--is-debugging)) - (string-match "^\\s *$" str) - (string-match "^,quit *$" str)))) - -(defun geiser-repl--old-input () - (save-excursion - (let ((end (point))) - (backward-sexp) - (buffer-substring (point) end)))) - -(defun geiser-repl--quit-setup () - (add-hook 'kill-buffer-hook 'geiser-repl--on-kill nil t) - (set-process-sentinel (get-buffer-process (current-buffer)) - 'geiser-repl--sentinel)) - - -;;; geiser-repl-autoeval-mode minor mode: - -(defun geiser-repl--autoeval-paren-function () - (let* ((data (show-paren--default)) - (here (nth 0 data)) - (there (nth 2 data)) - (mismatch (nth 4 data))) - (if (and here - (eq 0 (geiser-repl--nesting-level)) - (not mismatch) - (> here there)) - (geiser-repl--send-input)) - data)) - -(defvar-local geiser-repl-autoeval-mode-string " E" - "Modeline indicator for geiser-repl-autoeval-mode") - -(define-minor-mode geiser-repl-autoeval-mode - "Toggle the Geiser REPL's Autoeval mode. -With no argument, this command toggles the mode. -Non-null prefix argument turns on the mode. -Null prefix argument turns off the mode. - -When Autoeval mode is enabled, balanced S-expressions are automatically -evaluated without having to press ENTER. - -This mode may cause issues with structural editing modes such as paredit." - :init-value nil - :lighter geiser-repl-autoeval-mode-string - :group 'geiser-repl - - (if (boundp 'show-paren-data-function) - (if geiser-repl-autoeval-mode - (progn (show-paren-local-mode 1) - (setq-local show-paren-delay geiser-repl-autoeval-mode-delay) - (setq-local show-paren-data-function - 'geiser-repl--autoeval-paren-function)) - (setq-local show-paren-data-function 'show-paren--default))) - (when (called-interactively-p nil) - (message "Geiser Autoeval %s" - (if geiser-repl-autoeval-mode "enabled" "disabled")))) - - -;;; geiser-repl-superparen-mode minor mode: - -(defun geiser-repl--superparen-function () - (when (char-equal (char-before) geiser-repl-superparen-character) - (delete-char -1) - (insert-char ?\) (geiser-repl--nesting-level)))) - -(defvar-local geiser-repl-superparen-mode-string " S" - "Modeline indicator for geiser-repl-superparen-mode") - -(define-minor-mode geiser-repl-superparen-mode - "Toggle the Geiser REPL's Superparen mode. -With no argument, this command toggles the mode. -Non-null prefix argument turns on the mode. -Null prefix argument turns off the mode. - -When Superparen mode is enabled, entering the -`geiser-repl-superparen-char' character, which is ']' by default, -will close all parentheses of the expression currently being -typed. - -This mode may cause issues with structural editing modes such as -paredit." - :init-value nil - :lighter geiser-repl-superparen-mode-string - :group 'geiser-repl - - (if geiser-repl-superparen-mode - (add-hook 'post-self-insert-hook #'geiser-repl--superparen-function nil t) - (remove-hook 'post-self-insert-hook #'geiser-repl--superparen-function t)) - (when (called-interactively-p nil) - (if geiser-repl-superparen-mode - (message "Geiser Superparen enabled, using the %c character." - geiser-repl-superparen-character) - (message "Geiser Superparen disabled.")))) - - -;;; geiser-repl mode: - -(defun geiser-repl--bol () - (interactive) - (when (= (point) (comint-bol)) (beginning-of-line))) - -(defun geiser-repl--beginning-of-defun () - (save-restriction - (narrow-to-region (geiser-repl--last-prompt-end) (point)) - (let ((beginning-of-defun-function nil)) - (beginning-of-defun)))) - -(defun geiser-repl--module-function (&optional module) - (if (and module geiser-eval--get-impl-module) - (funcall geiser-eval--get-impl-module module) - :f)) - -(defun geiser-repl--doc-module () - (interactive) - (let ((geiser-eval--get-module-function - (geiser-impl--method 'find-module geiser-impl--implementation))) - (geiser-doc-module))) - -(defun geiser-repl--newline-and-indent () - (interactive) - (save-restriction - (narrow-to-region comint-last-input-start (point-max)) - (insert "\n") - (lisp-indent-line))) - -(defun geiser-repl--nesting-level () - (save-restriction - (narrow-to-region (geiser-repl--last-prompt-end) (point-max)) - (geiser-syntax--nesting-level))) - -(defun geiser-repl--is-input () - (not (eq (field-at-pos (point)) 'output))) - -(defun geiser-repl--grab-input () - (let ((pos (comint-bol))) - (goto-char (point-max)) - (insert (field-string-no-properties pos)))) - -(defun geiser-repl--send-input () - (set-marker geiser-repl--last-output-start (point-max)) - - (let* ((proc (get-buffer-process (current-buffer))) - (pmark (and proc (process-mark proc))) - (intxt (and pmark (buffer-substring pmark (point))))) - (when intxt - (when geiser-repl-forget-old-errors-p - (compilation-forget-errors)) - (geiser-repl--prepare-send) - (comint-send-input) - ;; match if `intxt' is lines of whitespace - (when (string-match "\\`\\(\\s-\\|\n\\)*\\'" intxt) - (comint-send-string proc (geiser-eval--scheme-str '(:ge no-values))) - (comint-send-string proc "\n"))))) - -(define-obsolete-function-alias 'geiser-repl--maybe-send - #'geiser-repl-maybe-send "0.26") - -(defun geiser-repl-maybe-send () - "Handle the current input at the REPL's prompt. - -If `geiser-repl-send-on-return-p' is t and the input is a -complete sexp, send the input to the REPL process; otherwise, -insert a new line and, if `geiser-repl-auto-indent-p' is t, -indentation." - (interactive) - (let ((p (point))) - (cond ((< p (geiser-repl--last-prompt-start)) - (if (geiser-repl--is-input) - (geiser-repl--grab-input) - (ignore-errors (compile-goto-error)))) - ((let ((inhibit-field-text-motion t)) - (when geiser-repl-send-on-return-p - (end-of-line)) - (<= (geiser-repl--nesting-level) 0)) - (geiser-repl--send-input)) - (t (goto-char p) - (if geiser-repl-auto-indent-p - (geiser-repl--newline-and-indent) - (insert "\n")))))) - -(defun geiser-repl-tab-dwim (n) - "If we're after the last prompt, complete symbol or indent (if -there's no symbol at point). Otherwise, go to next error in the REPL -buffer." - (interactive "p") - (if (>= (point) (geiser-repl--last-prompt-end)) - (or (completion-at-point) - (lisp-indent-line)) - (compilation-next-error n))) - -(defun geiser-repl--previous-error (n) - "Go to previous error in the REPL buffer." - (interactive "p") - (compilation-next-error (- n))) - -(defun geiser-repl-clear-buffer () - "Delete the output generated by the scheme process." - (interactive) - (let ((inhibit-read-only t)) - (delete-region (point-min) (geiser-repl--last-prompt-start)) - (when (< (point) (geiser-repl--last-prompt-end)) - (goto-char (geiser-repl--last-prompt-end))) - (recenter t))) - -(defvar geiser-repl-mode-map - (let ((map (make-sparse-keymap))) - (set-keymap-parent map comint-mode-map) - - (define-key map "\C-d" 'delete-char) - (define-key map "\C-m" 'geiser-repl-maybe-send) - (define-key map "\r" 'geiser-repl-maybe-send) - (define-key map "\C-j" 'geiser-repl--newline-and-indent) - (define-key map (kbd "TAB") 'geiser-repl-tab-dwim) - (define-key map [backtab] 'geiser-repl--previous-error) - - (define-key map "\C-a" 'geiser-repl--bol) - (define-key map (kbd "<home>") 'geiser-repl--bol) - - (geiser-menu--defmenu repl map - ("Complete symbol" ((kbd "M-TAB")) - completion-at-point :enable (geiser--symbol-at-point)) - ("Complete module name" ((kbd "C-.") (kbd "M-`")) - geiser-capf-complete-module :enable (geiser--symbol-at-point)) - ("Edit symbol" "\M-." geiser-edit-symbol-at-point - :enable (geiser--symbol-at-point)) - -- - ("Load scheme file..." "\C-c\C-l" geiser-load-file) - ("Switch to module..." "\C-c\C-m" geiser-repl-switch-to-module) - ("Import module..." "\C-c\C-i" geiser-repl-import-module) - ("Add to load path..." "\C-c\C-r" geiser-add-to-load-path) - -- - ("Previous matching input" "\M-p" comint-previous-matching-input-from-input - "Previous input matching current") - ("Next matching input" "\M-n" comint-next-matching-input-from-input - "Next input matching current") - ("Previous prompt" "\C-c\C-p" geiser-repl-previous-prompt) - ("Next prompt" "\C-c\C-n" geiser-repl-next-prompt) - ("Previous input" "\C-c\M-p" comint-previous-input) - ("Next input" "\C-c\M-n" comint-next-input) - -- - ("Interrupt evaluation" ("\C-c\C-k" "\C-c\C-c") - geiser-repl-interrupt) - -- - (mode "Autodoc mode" ("\C-c\C-da" "\C-c\C-d\C-a") geiser-autodoc-mode) - (mode "Autoeval mode" ("\C-c\C-de" "\C-c\C-d\C-e") - geiser-repl-autoeval-mode) - (mode "Superparen mode" ("\C-c\C-ds" "\C-c\C-d\C-s") - geiser-repl-superparen-mode) - ("Symbol documentation" ("\C-c\C-dd" "\C-c\C-d\C-d") - geiser-doc-symbol-at-point - "Documentation for symbol at point" :enable (geiser--symbol-at-point)) - ("Lookup symbol in manual" ("\C-c\C-di" "\C-c\C-d\C-i") - geiser-doc-look-up-manual - "Documentation for symbol at point" :enable (geiser--symbol-at-point)) - ("Module documentation" ("\C-c\C-dm" "\C-c\C-d\C-m") geiser-repl--doc-module - "Documentation for module at point" :enable (geiser--symbol-at-point)) - -- - ("Clear buffer" "\C-c\M-o" geiser-repl-clear-buffer - "Clean up REPL buffer, leaving just a lonely prompt") - ("Toggle ()/[]" ("\C-c\C-e\C-[" "\C-c\C-e[") geiser-squarify) - ("Insert λ" ("\C-c\\" "\C-c\C-\\") geiser-insert-lambda) - -- - ("Kill Scheme interpreter" "\C-c\C-q" geiser-repl-exit - :enable (geiser-repl--live-p)) - ("Restart" "\C-c\C-z" geiser-repl-switch - :enable (not (geiser-repl--live-p))) - - -- - (custom "REPL options" geiser-repl)) - - (define-key map [menu-bar completion] 'undefined) - map)) - -(define-derived-mode geiser-repl-mode comint-mode "REPL" - "Major mode for interacting with an inferior scheme repl process. -\\{geiser-repl-mode-map}" - (scheme-mode-variables) - (hack-dir-local-variables-non-file-buffer) - (set (make-local-variable 'geiser-repl--last-output-start) (point-marker)) - (set (make-local-variable 'geiser-repl--last-output-end) (point-marker)) - (set (make-local-variable 'face-remapping-alist) - '((comint-highlight-prompt geiser-font-lock-repl-prompt) - (comint-highlight-input geiser-font-lock-repl-input))) - (set (make-local-variable 'mode-line-process) nil) - (set (make-local-variable 'comint-use-prompt-regexp) nil) - (set (make-local-variable 'comint-prompt-read-only) - geiser-repl-read-only-prompt-p) - (setq comint-process-echoes nil) - (set (make-local-variable 'beginning-of-defun-function) - 'geiser-repl--beginning-of-defun) - (set (make-local-variable 'comint-input-ignoredups) - geiser-repl-history-no-dups-p) - (setq geiser-eval--get-module-function 'geiser-repl--module-function) - (geiser-capf-setup t) - (setq geiser-smart-tab-mode-string "") - (geiser-smart-tab-mode t) - - (setq-local font-lock-fontify-region-function - #'geiser-repl--wrap-fontify-region-function) - (setq-local font-lock-unfontify-region-function - #'geiser-repl--wrap-unfontify-region-function) - (setq geiser-autodoc-mode-string "/E") - (when geiser-repl-autoeval-mode-p - (geiser-repl-autoeval-mode 1)) - (when geiser-repl-superparen-mode-p - (geiser-repl-superparen-mode 1)) - - ;; enabling compilation-shell-minor-mode without the annoying highlighter - (compilation-setup t)) - - -;;; User commands - -(define-obsolete-function-alias 'run-geiser 'geiser "Geiser 0.26") - -(defun geiser (impl) - "Start a new Geiser REPL." - (interactive - (list (geiser-repl--get-impl "Start Geiser for scheme implementation: "))) - (geiser-repl--start-repl impl nil)) - -(defun geiser-connect (impl &optional host port) - "Start a new Geiser REPL connected to a remote Scheme process." - (interactive - (list (geiser-repl--get-impl "Connect to Scheme implementation: "))) - (geiser-repl--start-repl impl (geiser-repl--read-address host port))) - -(defun geiser-connect-local (impl socket) - "Start a new Geiser REPL connected to a remote Scheme process -over a Unix-domain socket." - (interactive - (list (geiser-repl--get-impl "Connect to Scheme implementation: ") - (expand-file-name (read-file-name "Socket file name: ")))) - (geiser-repl--start-repl impl socket)) - -(defvar-local geiser-repl--last-scm-buffer nil) - -(defun geiser-repl--maybe-remember-scm-buffer (buffer) - (when (and buffer - (eq 'scheme-mode (with-current-buffer buffer major-mode)) - (eq major-mode 'geiser-repl-mode)) - (setq geiser-repl--last-scm-buffer buffer))) - -(defun geiser-repl--get-binary (impl) - (or geiser-repl--binary (geiser-repl--binary impl))) - -(defun geiser-repl--get-arglist (impl) - (or geiser-repl--arglist (geiser-repl--arglist impl))) - -(defun geiser-repl--call-in-repl (cmd) - (when-let (b (geiser-repl--repl/impl geiser-impl--implementation)) - (save-window-excursion - (with-current-buffer b (funcall cmd))))) - -(define-obsolete-function-alias 'switch-to-geiser 'geiser-repl-switch "0.26") - -(defun geiser-repl-switch (&optional ask impl buffer) - "Switch to running Geiser REPL. - -If REPL is the current buffer, switch to the previously used -scheme buffer. - -With prefix argument, ask for which one if more than one is running. -If no REPL is running, execute `geiser' to start a fresh one." - (interactive "P") - (let* ((impl (or impl geiser-impl--implementation)) - (in-repl (eq major-mode 'geiser-repl-mode)) - (in-live-repl (and in-repl (get-buffer-process (current-buffer)))) - (repl (unless ask - (if impl - (geiser-repl--repl/impl impl) - (or geiser-repl--repl (car geiser-repl--repls)))))) - (cond (in-live-repl - (when (and (not (eq repl buffer)) - (buffer-live-p geiser-repl--last-scm-buffer)) - (geiser-repl--switch-to-buffer geiser-repl--last-scm-buffer))) - (repl (geiser-repl--set-this-buffer-repl repl) - (geiser-repl--switch-to-buffer repl)) - ((geiser-repl--remote-p) - (geiser-connect impl (geiser-repl--host) (geiser-repl--port))) - ((geiser-repl--local-p) - (geiser-connect-local impl geiser-repl--address)) - (impl (geiser impl)) - (t (call-interactively 'geiser))) - (geiser-repl--maybe-remember-scm-buffer buffer))) - -(define-obsolete-function-alias 'switch-to-geiser-module - 'geiser-repl-switch-to-module "0.26") - -(defun geiser-repl-switch-to-module (&optional module buffer) - "Switch to running Geiser REPL and try to enter a given module." - (interactive) - (let* ((module (or module - (geiser-completion--read-module - "Switch to module (default top-level): "))) - (cmd (and module - (geiser-repl--enter-cmd geiser-impl--implementation - module)))) - (unless (eq major-mode 'geiser-repl-mode) - (geiser-repl-switch nil nil (or buffer (current-buffer)))) - (geiser-repl--send cmd))) - -(defun geiser-repl--switch-to-repl (&optional and-module) - (if and-module - (geiser-repl-switch-to-module (geiser-eval--get-module) (current-buffer)) - (geiser-repl-switch nil nil (current-buffer)))) - -(defun geiser-repl--ensure-repl-buffer () - (unless (buffer-live-p geiser-repl--repl) - (setq geiser-repl--repl - (geiser-repl--repl/impl geiser-impl--implementation))) - (buffer-live-p geiser-repl--repl)) - -(defun geiser-repl-restart-repl () - "Restarts the REPL associated with the current buffer." - (interactive) - (let ((b (current-buffer)) - (impl geiser-impl--implementation)) - (when (buffer-live-p geiser-repl--repl) - (geiser-repl--switch-to-repl nil) - (comint-kill-subjob) - (sit-for 0.1)) ;; ugly hack; but i don't care enough to fix it - (geiser impl) - (sit-for 0.2) - (goto-char (point-max)) - (pop-to-buffer b))) - -(defun geiser-repl-import-module (&optional module) - "Import a given module in the current namespace of the REPL." - (interactive) - (let* ((module (or module - (geiser-completion--read-module "Import module: "))) - (cmd (and module - (geiser-repl--import-cmd geiser-impl--implementation - module)))) - (geiser-repl--switch-to-repl) - (geiser-repl--send cmd))) - -(defun geiser-repl-exit (&optional arg) - "Exit the current REPL. -With a prefix argument, force exit by killing the scheme process." - (interactive "P") - (when (or (not geiser-repl-query-on-exit-p) - (y-or-n-p "Really quit this REPL? ")) - (geiser-con--connection-deactivate geiser-repl--connection t) - (let ((cmd (and (not arg) - (geiser-repl--exit-cmd geiser-impl--implementation)))) - (if cmd - (when (stringp cmd) (geiser-repl--send cmd)) - (comint-kill-subjob))))) - -(defun geiser-repl-next-prompt (n) - (interactive "p") - (when (> n 0) - (end-of-line) - (re-search-forward comint-prompt-regexp nil 'go n))) - -(defun geiser-repl-previous-prompt (n) - (interactive "p") - (when (> n 0) - (end-of-line 0) - (when (re-search-backward comint-prompt-regexp nil 'go n) - (goto-char (match-end 0))))) - -(defun geiser-add-to-load-path (path) - "Add a new directory to running Scheme's load path. -When called interactively, this function will ask for the path to -add, defaulting to the current buffer's directory." - (interactive "DDirectory to add: ") - (let* ((c `(:eval (:ge add-to-load-path ,(file-local-name (expand-file-name path))))) - (r (geiser-eval--send/result c))) - (message "%s%s added to load path" path (if r "" " couldn't be")))) - - -;;; Unload: - -(defun geiser-repl--repl-list () - (let (lst) - (dolist (repl geiser-repl--repls lst) - (when (buffer-live-p repl) - (with-current-buffer repl - (push (cons geiser-impl--implementation - geiser-repl--address) - lst)))))) - -(defun geiser-repl--restore (impls) - (dolist (impl impls) - (when impl - (condition-case err - (geiser-repl--start-repl (car impl) (cdr impl)) - (error (message (error-message-string err))))))) - -(defun geiser-repl-unload-function () - (dolist (repl geiser-repl--repls) - (when (buffer-live-p repl) - (with-current-buffer repl - (let ((geiser-repl-query-on-exit-p nil)) (geiser-repl-exit)) - (sit-for 0.05) - (kill-buffer))))) - - -(provide 'geiser-repl) - - -;;; Initialization: -;; After providing 'geiser-repl, so that impls can use us. -(mapc 'geiser-impl--load-impl geiser-active-implementations) diff --git a/elpa/geiser-0.30/geiser-syntax.el b/elpa/geiser-0.30/geiser-syntax.el @@ -1,568 +0,0 @@ -;;; geiser-syntax.el -- utilities for parsing scheme syntax -*- lexical-binding: t; -*- - -;; Copyright (C) 2009-2016, 2019-2022 Jose Antonio Ortega Ruiz - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the Modified BSD License. You should -;; have received a copy of the license along with this program. If -;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>. - -;; Start date: Sun Feb 08, 2009 15:03 - - -;;; Code: - -(require 'geiser-impl) -(require 'geiser-popup) -(require 'geiser-base) - -(require 'scheme) - -(eval-when-compile - (require 'cl-lib) - (require 'subr-x)) - - -;;; Indentation: - -(defmacro geiser-syntax--scheme-indent (&rest pairs) - `(progn ,@(mapcar (lambda (p) - `(put ',(car p) 'scheme-indent-function ',(cadr p))) - pairs))) - -(geiser-syntax--scheme-indent - (and-let* 1) - (case-lambda 0) - (catch defun) - (class defun) - (dynamic-wind 0) - (guard 1) - (let*-values 1) - (let-values 1) - (let/ec 1) - (letrec* 1) - (match 1) - (match-lambda 0) - (match-lambda* 0) - (match-let scheme-let-indent) - (match-let* 1) - (match-letrec 1) - (opt-lambda 1) - (parameterize 1) - (parameterize* 1) - (receive 2) - (require-extension 0) - (syntax-case 2) - (test-approximate 1) - (test-assert 1) - (test-eq 1) - (test-equal 1) - (test-eqv 1) - (test-group 1) - (test-group-with-cleanup 1) - (test-runner-on-bad-count! 1) - (test-runner-on-bad-end-name! 1) - (test-runner-on-final! 1) - (test-runner-on-group-begin! 1) - (test-runner-on-group-end! 1) - (test-runner-on-test-begin! 1) - (test-runner-on-test-end! 1) - (test-with-runner 1) - (unless 1) - (when 1) - (while 1) - (with-exception-handler 1) - (with-syntax 1)) - - -;;; Extra syntax keywords - -(defconst geiser-syntax--builtin-keywords - '("and-let*" - "cut" - "cute" - "define-condition-type" - "define-immutable-record-type" - "define-record-type" - "define-values" - "letrec*" - "match" - "match-lambda" - "match-lambda*" - "match-let" - "match-let*" - "match-letrec" - "parameterize" - "receive" - "require-extension" - "set!" - "syntax-case" - "test-approximate" - "test-assert" - "test-begin" - "test-end" - "test-eq" - "test-equal" - "test-eqv" - "test-error" - "test-group" - "test-group-with-cleanup" - "test-with-runner" - "unless" - "when" - "with-exception-handler" - "with-input-from-file" - "with-output-to-file")) - -(defun geiser-syntax--simple-keywords (keywords) - "Return `font-lock-keywords' to highlight scheme KEYWORDS. -KEYWORDS should be a list of strings." - (when keywords - `((,(format "[[(]%s\\>" (regexp-opt keywords 1)) . 1)))) - -(defun geiser-syntax--keywords () - (append - (geiser-syntax--simple-keywords geiser-syntax--builtin-keywords) - `(("\\[\\(else\\)\\>" . 1) - (,(rx "(" (group "define-syntax-rule") eow (* space) - (? "(") (? (group (1+ word)))) - (1 font-lock-keyword-face) - (2 font-lock-function-name-face nil t))))) - -(font-lock-add-keywords 'scheme-mode (geiser-syntax--keywords)) - -(geiser-impl--define-caller geiser-syntax--impl-kws keywords () - "A variable (or thunk returning a value) giving additional, -implementation-specific entries for font-lock-keywords.") - -(geiser-impl--define-caller geiser-syntax--case-sensitive case-sensitive () - "A flag saying whether keywords are case sensitive.") - -(defun geiser-syntax--add-kws (&optional global-p) - (unless (bound-and-true-p quack-mode) - (let ((kw (geiser-syntax--impl-kws geiser-impl--implementation)) - (cs (geiser-syntax--case-sensitive geiser-impl--implementation))) - (when kw (font-lock-add-keywords nil kw)) - (when global-p (font-lock-add-keywords nil (geiser-syntax--keywords))) - (setq font-lock-keywords-case-fold-search (not cs))))) - -(defun geiser-syntax--remove-kws () - (unless (bound-and-true-p quack-mode) - (let ((kw (geiser-syntax--impl-kws geiser-impl--implementation))) - (when kw - (font-lock-remove-keywords nil kw))))) - - -;;; A simple scheme reader - -(defvar geiser-syntax--read/buffer-limit nil) - -(defsubst geiser-syntax--read/eos () - (or (eobp) - (and geiser-syntax--read/buffer-limit - (<= geiser-syntax--read/buffer-limit (point))))) - -(defsubst geiser-syntax--read/next-char () - (unless (geiser-syntax--read/eos) - (forward-char) - (char-after))) - -(defsubst geiser-syntax--read/token (token) - (geiser-syntax--read/next-char) - (if (listp token) token (list token))) - -(defsubst geiser-syntax--read/elisp () - (ignore-errors (read (current-buffer)))) - -(defun geiser-syntax--read/symbol () - (with-syntax-table scheme-mode-syntax-table - (when (re-search-forward "\\(\\sw\\|\\s_\\)+" nil t) - (make-symbol (match-string-no-properties 0))))) - -(defun geiser-syntax--read/matching (open close) - (let ((count 1) - (p (1+ (point)))) - (while (and (> count 0) - (geiser-syntax--read/next-char)) - (cond ((looking-at-p open) (setq count (1+ count))) - ((looking-at-p close) (setq count (1- count))))) - (buffer-substring-no-properties p (point)))) - -(defsubst geiser-syntax--read/unprintable () - (geiser-syntax--read/token - (cons 'unprintable (geiser-syntax--read/matching "<" ">")))) - -(defun geiser-syntax--read/ex-symbol () ;; #{foo bar}# style symbols - (let ((tk (geiser-syntax--read/matching "{" "}"))) - (when-let (c (geiser-syntax--read/next-char)) - (when (char-equal ?\# c) - (geiser-syntax--read/next-char) - (cons 'atom (make-symbol (format "#{%s}#" tk))))))) - -(defun geiser-syntax--read/skip-comment () - (while (and (geiser-syntax--read/next-char) - (nth 8 (syntax-ppss)))) - (geiser-syntax--read/next-token)) - -(defun geiser-syntax--read/next-token () - (skip-syntax-forward "->") - (if (geiser-syntax--read/eos) '(eob) - (cl-case (char-after) - (?\; (geiser-syntax--read/skip-comment)) - ((?\( ?\[) (geiser-syntax--read/token 'lparen)) - ((?\) ?\]) (geiser-syntax--read/token 'rparen)) - (?. (if (memq (car (syntax-after (1+ (point)))) '(0 11 12)) - (geiser-syntax--read/token 'dot) - (cons 'atom (geiser-syntax--read/elisp)))) - (?\# (cl-case (geiser-syntax--read/next-char) - ((nil quote) '(eob)) - (?| (geiser-syntax--read/skip-comment)) - (?: (if (geiser-syntax--read/next-char) - (cons 'kwd (geiser-syntax--read/symbol)) - '(eob))) - (?\\ (cons 'char (geiser-syntax--read/elisp))) - (?\( (geiser-syntax--read/token 'vectorb)) - (?\< (geiser-syntax--read/unprintable)) - ((?' ?` ?,) (geiser-syntax--read/next-token)) - (?\{ (geiser-syntax--read/ex-symbol)) - (t (let ((tok (geiser-syntax--read/symbol))) - (cond ((equal (symbol-name tok) "t") '(boolean . :t)) - ((equal (symbol-name tok) "f") '(boolean . :f)) - (tok (cons 'atom tok)) - (t (geiser-syntax--read/next-token))))))) - (?| (cl-case (geiser-syntax--read/next-char) ;; gambit style block comments - ((nil quote) '(eob)) - (?# (geiser-syntax--read/skip-comment)) - (t (let ((tok (geiser-syntax--read/symbol))) - (cond ((equal (symbol-name tok) "t") '(boolean . :t)) - ((equal (symbol-name tok) "f") '(boolean . :f)) - (tok (cons 'atom tok)) - (t (geiser-syntax--read/next-token))))))) - (?\' (geiser-syntax--read/token '(quote . quote))) - (?\` (geiser-syntax--read/token - `(backquote . ,backquote-backquote-symbol))) - (?, (if (eq (geiser-syntax--read/next-char) ?@) - (geiser-syntax--read/token - `(splice . ,backquote-splice-symbol)) - `(unquote . ,backquote-unquote-symbol))) - (?\" (cons 'string (geiser-syntax--read/elisp))) - (t (let ((x (geiser-syntax--read/elisp))) - (cons 'atom (if (atom x) x (geiser-syntax--read/symbol)))))))) - -(defsubst geiser-syntax--read/match (&rest tks) - (let ((token (geiser-syntax--read/next-token))) - (if (memq (car token) tks) token - (error "Unexpected token: %s" token)))) - -(defsubst geiser-syntax--read/skip-until (&rest tks) - (let (token) - (while (and (not (memq (car token) tks)) - (not (eq (car token) 'eob))) - (setq token (geiser-syntax--read/next-token))) - token)) - -(defsubst geiser-syntax--read/try (&rest tks) - (let ((p (point)) - (tk (ignore-errors (apply 'geiser-syntax--read/match tks)))) - (unless tk (goto-char p)) - tk)) - -(defun geiser-syntax--read/list () - (cond ((geiser-syntax--read/try 'dot) - (let ((tail (geiser-syntax--read))) - (geiser-syntax--read/skip-until 'eob 'rparen) - tail)) - ((geiser-syntax--read/try 'rparen 'eob) nil) - (t (cons (geiser-syntax--read) - (geiser-syntax--read/list))))) - -(defun geiser-syntax--read () - (let ((token (geiser-syntax--read/next-token)) - (max-lisp-eval-depth (max max-lisp-eval-depth 3000))) - (cl-case (car token) - (eob nil) - (lparen (geiser-syntax--read/list)) - (vectorb (apply 'vector (geiser-syntax--read/list))) - ((quote backquote unquote splice) (list (cdr token) - (geiser-syntax--read))) - (kwd (make-symbol (format ":%s" (cdr token)))) - (unprintable (format "#<%s>" (cdr token))) - ((char string atom) (cdr token)) - (boolean (cdr token)) - (t (error "Reading scheme syntax: unexpected token: %s" token))))) - -(defun geiser-syntax--read-from-string (string &optional start end) - (when (stringp string) - ;; In Emacs 29 this variable doesn't have an effect - ;; anymore and `max-lisp-eval-depth' achieves the same. - (with-suppressed-warnings ((obsolete max-specpdl-size)) - (let* ((start (or start 0)) - (end (or end (length string))) - (max-lisp-eval-depth (min 20000 - (max max-lisp-eval-depth (- end start)))) - (max-specpdl-size (* 2 max-lisp-eval-depth))) - (with-temp-buffer - (save-excursion (insert string)) - (cons (geiser-syntax--read) (point))))))) - -(defun geiser-syntax--form-from-string (s) - (car (geiser-syntax--read-from-string s))) - -(defsubst geiser-syntax--form-after-point (&optional boundary) - (let ((geiser-syntax--read/buffer-limit (and (numberp boundary) boundary))) - (save-excursion (list (geiser-syntax--read) (point))))) - -(defun geiser-syntax--mapconcat (fun lst sep) - (cond ((null lst) "") - ((not (listp lst)) (format ".%s%s" sep (funcall fun lst))) - ((null (cdr lst)) (format "%s" (funcall fun (car lst)))) - (t (format "%s%s%s" - (funcall fun (car lst)) - sep - (geiser-syntax--mapconcat fun (cdr lst) sep))))) - - -;;; Code parsing: - -(defsubst geiser-syntax--symbol-at-point () - (and (not (nth 8 (syntax-ppss))) - (car (geiser-syntax--read-from-string (thing-at-point 'symbol))))) - -(defsubst geiser-syntax--skip-comment/string () - (let ((pos (nth 8 (syntax-ppss)))) - (goto-char (or pos (point))) - pos)) - -(defsubst geiser-syntax--nesting-level () - (or (nth 0 (syntax-ppss)) 0)) - -(defun geiser-syntax--pop-to-top () - (ignore-errors - (while (> (geiser-syntax--nesting-level) 0) (backward-up-list)))) - -(defsubst geiser-syntax--in-string-p () - (nth 3 (syntax-ppss))) - -(defsubst geiser-syntax--pair-length (p) - (if (cdr (last p)) (1+ (safe-length p)) (length p))) - -(defun geiser-syntax--shallow-form (boundary) - (when (looking-at-p "\\s(") - (save-excursion - (forward-char) - (let ((elems)) - (ignore-errors - (while (< (point) boundary) - (skip-syntax-forward "-<>") - (when (<= (point) boundary) - (forward-sexp) - (let ((s (thing-at-point 'symbol))) - (unless (equal "." s) - (push (car (geiser-syntax--read-from-string s)) elems)))))) - (nreverse elems))))) - -(defsubst geiser-syntax--keywordp (s) - (and s (symbolp s) (string-match "^:.+" (symbol-name s)))) - -(defsubst geiser-syntax--symbol-eq (s0 s1) - (and (symbolp s0) (symbolp s1) (equal (symbol-name s0) (symbol-name s1)))) - -(defun geiser-syntax--scan-sexps () - (let* ((fst (geiser-syntax--symbol-at-point)) - (smth (or fst (not (looking-at-p "[\s \s)\s>\s<\n]")))) - (path (and fst `((,fst 0))))) - (save-excursion - (while (> (or (geiser-syntax--nesting-level) 0) 0) - (let ((boundary (point))) - (geiser-syntax--skip-comment/string) - (backward-up-list) - (let ((form (geiser-syntax--shallow-form boundary))) - (when (and (listp form) (car form) (symbolp (car form))) - (let* ((len (geiser-syntax--pair-length form)) - (pos (if smth (1- len) (progn (setq smth t) len))) - (prev (and (> pos 1) (nth (1- pos) form))) - (prev (and (geiser-syntax--keywordp prev) - (list prev)))) - (push `(,(car form) ,pos ,@prev) path))))))) - (mapcar (lambda (e) - (cons (substring-no-properties (format "%s" (car e))) (cdr e))) - (nreverse path)))) - -(defsubst geiser-syntax--binding-form-p (bfs sbfs f) - (and (symbolp f) - (let ((f (symbol-name f))) - (or (member f '("define" "define*" "define-syntax" - "syntax-rules" "lambda" "case-lambda" - "let" "let*" "let-values" "let*-values" - "letrec" "letrec*" "parameterize")) - (member f bfs) - (member f sbfs))))) - -(defsubst geiser-syntax--binding-form*-p (sbfs f) - (and (symbolp f) - (let ((f (symbol-name f))) - (or (member f '("let*" "let*-values" "letrec" "letrec*")) - (member f sbfs))))) - -(defsubst geiser-syntax--if-symbol (x) (and (symbolp x) x)) -(defsubst geiser-syntax--if-list (x) (and (listp x) x)) - -(defsubst geiser-syntax--normalize (vars) - (mapcar (lambda (i) - (let ((i (if (listp i) (car i) i))) - (and (symbolp i) (symbol-name i)))) - vars)) - -(defun geiser-syntax--linearize (form) - (cond ((not (listp form)) (list form)) - ((null form) nil) - (t (cons (car form) (geiser-syntax--linearize (cdr form)))))) - -(defun geiser-syntax--scan-locals (bfs sbfs form nesting locals) - (if (or (null form) (not (listp form))) - (geiser-syntax--normalize locals) - (if (not (geiser-syntax--binding-form-p bfs sbfs (car form))) - (geiser-syntax--scan-locals bfs sbfs - (car (last form)) - (1- nesting) locals) - (let* ((head (car form)) - (name (geiser-syntax--if-symbol (cadr form))) - (names (if name (geiser-syntax--if-list (caddr form)) - (geiser-syntax--if-list (cadr form)))) - (bns (and name - (geiser-syntax--binding-form-p bfs sbfs (car names)))) - (rest (if (and name (not bns)) (cdddr form) (cddr form))) - (use-names (and (or rest - (< nesting 1) - (geiser-syntax--binding-form*-p sbfs head)) - (not bns)))) - (when name (push name locals)) - (when (geiser-syntax--symbol-eq head 'case-lambda) - (dolist (n (and (> nesting 0) (caar (last form)))) - (when n (push n locals))) - (setq rest (and (> nesting 0) (cdr form))) - (setq use-names nil)) - (when (geiser-syntax--symbol-eq head 'syntax-rules) - (dolist (n (and (> nesting 0) (cdaar (last form)))) - (when n (push n locals))) - (setq rest (and (> nesting 0) (cdr form)))) - (when use-names - (dolist (n (geiser-syntax--linearize names)) - (let ((xs (if (and (listp n) (listp (car n))) (car n) (list n)))) - (dolist (x xs) (when x (push x locals)))))) - (dolist (f (butlast rest)) - (when (and (listp f) - (geiser-syntax--symbol-eq (car f) 'define) - (cadr f)) - (push (cadr f) locals))) - (geiser-syntax--scan-locals bfs sbfs - (car (last (or rest names))) - (1- nesting) - locals))))) - -(defun geiser-syntax--locals-around-point (bfs sbfs) - (when (eq major-mode 'scheme-mode) - (save-excursion - (let ((sym (unless (geiser-syntax--skip-comment/string) - (thing-at-point 'symbol)))) - (skip-syntax-forward "->") - (let ((boundary (point)) - (nesting (geiser-syntax--nesting-level))) - (geiser-syntax--pop-to-top) - (cl-destructuring-bind (form _end) - (geiser-syntax--form-after-point boundary) - (delete sym - (geiser-syntax--scan-locals bfs - sbfs - form - (1- nesting) - '())))))))) - - -;;; Display and fontify strings as Scheme code: - -(defun geiser-syntax--display (a) - (cond ((null a) "()") - ((eq a :t) "#t") - ((eq a :f) "#f") - ((geiser-syntax--keywordp a) (format "#%s" a)) - ((symbolp a) (format "%s" a)) - ((equal a "...") "...") - ((stringp a) (format "%S" a)) - ((and (listp a) (symbolp (car a)) - (equal (symbol-name (car a)) "quote")) - (format "'%s" (geiser-syntax--display (cadr a)))) - ((listp a) - (format "(%s)" - (geiser-syntax--mapconcat 'geiser-syntax--display a " "))) - (t (format "%s" a)))) - -(defconst geiser-syntax--font-lock-buffer-name " *Geiser font-lock*") - -(defun geiser-syntax--font-lock-buffer-p (&optional buffer) - (equal (buffer-name buffer) geiser-syntax--font-lock-buffer-name)) - -(defun geiser-syntax--font-lock-buffer () - (or (get-buffer geiser-syntax--font-lock-buffer-name) - (let ((buffer (get-buffer-create geiser-syntax--font-lock-buffer-name))) - (set-buffer buffer) - (let ((geiser-default-implementation - (or geiser-default-implementation - (car geiser-active-implementations)))) - (scheme-mode)) - buffer))) - -(defun geiser-syntax--fontify (&optional beg end) - (let ((font-lock-verbose nil) - (beg (or beg (point-min))) - (end (or end (point-max)))) - (if (fboundp 'font-lock-flush) - (font-lock-flush beg end) - (with-no-warnings (font-lock-fontify-region beg end))))) - -;; derived from org-src-font-lock-fontify-block (org-src.el) -(defun geiser-syntax--fontify-syntax-region (start end) - "Fontify region as Scheme." - (let ((string (buffer-substring-no-properties start end)) - (modified (buffer-modified-p)) - (buffer-undo-list t) - (geiser-buffer (current-buffer))) - (with-current-buffer - (get-buffer-create " *Geiser REPL fontification*") - (let ((inhibit-modification-hooks nil)) - (erase-buffer) - ;; Add string and a final space to ensure property change. - (insert string " ")) - ;; prevent geiser prompt - (let ((geiser-default-implementation - (or geiser-default-implementation - (car geiser-active-implementations)))) - (scheme-mode)) - (geiser--font-lock-ensure) - (let ((pos (point-min)) next) - (while (setq next (next-property-change pos)) - ;; Handle additional properties from font-lock, so as to - ;; preserve, e.g., composition. - (dolist (prop (cons 'face font-lock-extra-managed-props)) - (let ((new-prop (get-text-property pos prop)) - (start-point (+ start (1- pos))) - (end-point (1- (+ start next)))) - (put-text-property start-point end-point prop new-prop geiser-buffer))) - (setq pos next)))) - (add-text-properties - start end - '(font-lock-fontified t - fontified t - font-lock-multiline t)) - (set-buffer-modified-p modified))) - -(defun geiser-syntax--scheme-str (str) - (save-current-buffer - (set-buffer (geiser-syntax--font-lock-buffer)) - (erase-buffer) - (insert str) - (geiser-syntax--fontify) - (buffer-string))) - - -(provide 'geiser-syntax) diff --git a/elpa/geiser-0.30/geiser-table.el b/elpa/geiser-0.30/geiser-table.el @@ -1,137 +0,0 @@ -;;; geiser-table.el -- table creation -*- lexical-binding: t; -*- - -;; Copyright (C) 2009, 2010, 2012 Jose Antonio Ortega Ruiz - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the Modified BSD License. You should -;; have received a copy of the license along with this program. If -;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>. - -;; Start date: Tue Jan 06, 2009 13:44 - - -;;; Code: - -(defun geiser-table--col-widths (rows) - (let* ((col-no (length (car rows))) - (available (- (window-width) 2 (* 2 col-no))) - (widths) - (c 0)) - (while (< c col-no) - (let ((width 0) - (av-width (- available (* 5 (- col-no c))))) - (dolist (row rows) - (setq width - (min av-width - (max width (length (nth c row)))))) - (push width widths) - (setq available (- available width))) - (setq c (1+ c))) - (reverse widths))) - -(defun geiser-table--pad-str (str width) - (let ((len (length str))) - (cond ((= len width) str) - ((> len width) (concat (substring str 0 (- width 3)) "...")) - (t (concat str (make-string (- width (length str)) ?\ )))))) - -(defun geiser-table--str-lines (str width) - (if (<= (length str) width) - (list (geiser-table--pad-str str width)) - (with-temp-buffer - (let ((fill-column width)) - (insert str) - (fill-region (point-min) (point-max)) - (mapcar (lambda (s) (geiser-table--pad-str s width)) - (split-string (buffer-string) "\n")))))) - -(defun geiser-table--pad-row (row) - (let* ((max-ln (apply 'max (mapcar 'length row))) - (result)) - (dolist (lines row) - (let ((ln (length lines))) - (if (= ln max-ln) (push lines result) - (let ((lines (reverse lines)) - (l 0) - (blank (make-string (length (car lines)) ?\ ))) - (while (< l ln) - (push blank lines) - (setq l (1+ l))) - (push (reverse lines) result))))) - (reverse result))) - -(defun geiser-table--format-rows (rows widths) - (let ((col-no (length (car rows))) - (frows)) - (dolist (row rows) - (let ((c 0) (frow)) - (while (< c col-no) - (push (geiser-table--str-lines (nth c row) (nth c widths)) frow) - (setq c (1+ c))) - (push (geiser-table--pad-row (reverse frow)) frows))) - (reverse frows))) - -(defvar geiser-table-corner-lt "┌") -(defvar geiser-table-corner-lb "└") -(defvar geiser-table-corner-rt "┐") -(defvar geiser-table-corner-rb "┘") -(defvar geiser-table-line "─") -(defvar geiser-table-tee-t "┬") -(defvar geiser-table-tee-b "┴") -(defvar geiser-table-tee-l "├") -(defvar geiser-table-tee-r "┤") -(defvar geiser-table-crux "┼") -(defvar geiser-table-sep "│") - -(defun geiser-table--insert-line (widths first last sep) - (insert first geiser-table-line) - (dolist (w widths) - (while (> w 0) - (insert geiser-table-line) - (setq w (1- w))) - (insert geiser-table-line sep geiser-table-line)) - (delete-char -2) - (insert geiser-table-line last) - (newline)) - -(defun geiser-table--insert-first-line (widths) - (geiser-table--insert-line widths - geiser-table-corner-lt - geiser-table-corner-rt - geiser-table-tee-t)) - -(defun geiser-table--insert-middle-line (widths) - (geiser-table--insert-line widths - geiser-table-tee-l - geiser-table-tee-r - geiser-table-crux)) - -(defun geiser-table--insert-last-line (widths) - (geiser-table--insert-line widths - geiser-table-corner-lb - geiser-table-corner-rb - geiser-table-tee-b)) - -(defun geiser-table--insert-row (r) - (let ((ln (length (car r))) - (l 0)) - (while (< l ln) - (insert (concat geiser-table-sep " " - (mapconcat 'identity - (mapcar `(lambda (x) (nth ,l x)) r) - (concat " " geiser-table-sep " ")) - " " geiser-table-sep "\n")) - (setq l (1+ l))))) - -(defun geiser-table--insert (rows) - (let* ((widths (geiser-table--col-widths rows)) - (rows (geiser-table--format-rows rows widths))) - (geiser-table--insert-first-line widths) - (dolist (r rows) - (geiser-table--insert-row r) - (geiser-table--insert-middle-line widths)) - (kill-line -1) - (geiser-table--insert-last-line widths))) - - -(provide 'geiser-table) diff --git a/elpa/geiser-0.30/geiser-xref.el b/elpa/geiser-0.30/geiser-xref.el @@ -1,165 +0,0 @@ -;;; geiser-xref.el -- utilities for cross-referencing -*- lexical-binding: t; -*- - -;; Copyright (C) 2009, 2010, 2012, 2022 Jose Antonio Ortega Ruiz - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the Modified BSD License. You should -;; have received a copy of the license along with this program. If -;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>. - -;; Start date: Thu Mar 05, 2009 23:03 - - -;;; Code: - -(require' geiser-edit) -(require 'geiser-autodoc) -(require 'geiser-eval) -(require 'geiser-popup) -(require 'geiser-custom) -(require 'geiser-base) - -(require 'button) -(require 'lisp-mode) - - -;;; Customization: -(defgroup geiser-xref nil - "Options for cross-referencing commands." - :group 'geiser) - -(geiser-edit--define-custom-visit - geiser-xref-follow-link-method geiser-xref - "How to visit buffers when following xrefs.") - -(geiser-custom--defface xref-link - 'link geiser-xref "links in cross-reference buffers") - -(geiser-custom--defface xref-header - 'bold geiser-xref "headers in cross-reference buffers") - - -;;; Buffer and mode: - -(geiser-popup--define xref "*Geiser Xref*" geiser-xref-mode) - -(defvar geiser-xref-mode-map - (let ((map (make-sparse-keymap))) - (suppress-keymap map) - (set-keymap-parent map button-buffer-map) - map) - "Keymap for `geiser-xref-mode'.") - -(define-derived-mode geiser-xref-mode nil "Geiser Xref" - "Major mode for displaying cross-references. -\\{geiser-xref-mode-map}" - (buffer-disable-undo) - (set-syntax-table scheme-mode-syntax-table) - (setq buffer-read-only t)) - - -;;; Ref button: - -(define-button-type 'geiser-xref--button - 'action 'geiser-xref--button-action - 'face 'geiser-font-lock-xref-link - 'follow-link t) - -(defun geiser-xref--button-action (button) - (let ((location (button-get button 'location)) - (name (button-get button 'name))) - (when location - (geiser-edit--try-edit-location name - location - geiser-xref-follow-link-method)))) - -(defun geiser-xref--insert-button (xref) - (let* ((location (cdr (assoc "location" xref))) - (file (geiser-edit--location-file location)) - (signature (cdr (assoc "signature" xref))) - (signature-txt (and signature - (geiser-autodoc--str* signature))) - (p (point))) - (when signature - (insert " - ") - (if (stringp file) - (insert-text-button signature-txt - :type 'geiser-xref--button - 'location location - 'name (car signature) - 'help-echo (format "%s in %s" - (car signature) file)) - (insert (format "%s" signature-txt))) - (fill-region p (point)) - (save-excursion (goto-char p) (indent-sexp)) - (newline)))) - -(defun geiser-xref--module< (xr1 xr2) - (let ((m1 (format "%s" (cdr (assoc "module" xr1)))) - (m2 (format "%s" (cdr (assoc "module" xr2))))) - (cond ((equal m1 m2) - (string< (format "%s" (cdr (assoc "signature" xr1))) - (format "%s" (cdr (assoc "signature" xr2))))) - ((null m1) (not m2)) - ((null m2)) - (t (string< (format "%s" m1) (format "%s" m2)))))) - -(defun geiser-xref--display-xrefs (header xrefs) - (geiser-xref--with-buffer - (erase-buffer) - (geiser--insert-with-face header 'geiser-font-lock-xref-header) - (newline) - (let ((last-module)) - (dolist (xref (sort xrefs 'geiser-xref--module<)) - (let ((module (format "%s" (cdr (assoc "module" xref))))) - (when (not (equal module last-module)) - (insert "\n In module ") - (geiser--insert-with-face (format "%s" module) - 'geiser-font-lock-xref-header) - (newline 2) - (setq last-module module)) - (geiser-xref--insert-button xref))))) - (geiser-xref--pop-to-buffer) - (goto-char (point-min))) - -(defun geiser-xref--read-name (ask prompt) - (let ((name (or (and (not ask) (geiser--symbol-at-point)) - (read-string prompt nil nil (geiser--symbol-at-point))))) - (and name (format "%s" name)))) - -(defun geiser-xref--fetch-xrefs (ask kind rkind proc) - (let* ((name (geiser-xref--read-name ask (format "%s: " (capitalize kind)))) - (res (and name (geiser-eval--send/result - `(:eval (:ge ,proc (quote (:scm ,name)))))))) - (message "Retrieving %ss list for '%s'..." rkind name) - (if (or (not res) (not (listp res))) - (message "No %ss found for '%s'" rkind name) - (message "") - (geiser-xref--display-xrefs (format "%ss for '%s'" - (capitalize rkind) - name) - res)))) - - -;;; Commands: - -(defun geiser-xref-generic-methods (&optional arg) - "Display information about known methods of a given generic. -With prefix, ask for the name of the generic." - (interactive "P") - (geiser-xref--fetch-xrefs arg "generic" "method" 'generic-methods)) - -(defun geiser-xref-callers (&optional arg) - "Display list of callers for procedure at point. -With prefix, ask for the procedure." - (interactive "P") - (geiser-xref--fetch-xrefs arg "procedure" "caller" 'callers)) - -(defun geiser-xref-callees (&optional arg) - "Display list of callees for procedure at point. -With prefix, ask for the procedure." - (interactive "P") - (geiser-xref--fetch-xrefs arg "procedure" "callee" 'callees)) - - -(provide 'geiser-xref) diff --git a/elpa/geiser-0.30/geiser.el b/elpa/geiser-0.30/geiser.el @@ -1,134 +0,0 @@ -;;; geiser.el --- GNU Emacs and Scheme talk to each other -*- lexical-binding: t; -*- - -;; Copyright (C) 2009-2013, 2015, 2018, 2021-2023 Jose Antonio Ortega Ruiz - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the Modified BSD License. You should -;; have received a copy of the license along with this program. If -;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>. - -;; Author: Jose Antonio Ortega Ruiz (jao@gnu.org) -;; Maintainer: Jose Antonio Ortega Ruiz (jao@gnu.org) -;; Keywords: languages, scheme, geiser -;; Homepage: https://gitlab.com/emacs-geiser/ -;; Package-Requires: ((emacs "27.1") (project "0.8.1")) -;; SPDX-License-Identifier: BSD-3-Clause -;; Version: 0.30 - -;;; Commentary: - -;; Geiser is a generic Emacs/Scheme interaction mode, featuring an -;; enhanced REPL and a set of minor modes improving Emacs' basic scheme -;; major mode. - -;; Geiser supports Guile, Chicken, Gauche, Chibi, MIT-Scheme, Gambit, -;; Racket, Stklos, Kawa and Chez. Each one has a separate ELPA package -;; (geiser-guile, geiser-chicken, etc.) that you should install to use -;; your favourite scheme. - - -;; Main functionalities: -;; - Evaluation of forms in the namespace of the current module. -;; - Macro expansion. -;; - File/module loading. -;; - Namespace-aware identifier completion (including local bindings, -;; names visible in the current module, and module names). -;; - Autodoc: the echo area shows information about the signature of -;; the procedure/macro around point automatically. -;; - Jump to definition of identifier at point. -;; - Direct access to documentation, including docstrings (when the -;; implementation provides them) and user manuals. -;; - Listings of identifiers exported by a given module (Guile). -;; - Listings of callers/callees of procedures (Guile). -;; - Rudimentary support for debugging (list of -;; evaluation/compilation error in an Emacs' compilation-mode -;; buffer). -;; - Support for inline images in schemes, such as Racket, that treat -;; them as first order values. - -;; See http://www.nongnu.org/geiser/ for the full manual in HTML form, or -;; the the info manual installed by this package. - - -;;; Code: -;;; Locations: - -;;;###autoload -(defconst geiser-elisp-dir (file-name-directory load-file-name) - "Directory containing Geiser's Elisp files.") - - -;;; Autoloads: - -;;;###autoload -(autoload 'geiser-version "geiser-version" "Echo Geiser's version." t) - -;;;###autoload -(autoload 'geiser-unload "geiser-reload" "Unload all Geiser code." t) - -;;;###autoload -(autoload 'geiser-reload "geiser-reload" "Reload Geiser code." t) - -;;;###autoload -(autoload 'geiser "geiser-repl" "Start a Geiser REPL." t) - -;;;###autoload -(autoload 'run-geiser "geiser-repl" "Start a Geiser REPL." t) - -;;;###autoload -(autoload 'geiser-connect "geiser-repl" - "Start a Geiser REPL connected to a remote server." t) - -;;;###autoload -(autoload 'geiser-connect-local "geiser-repl" - "Start a Geiser REPL connected to a remote server over a Unix-domain socket." - t) - -;;;###autoload -(autoload 'geiser-repl-switch "geiser-repl" - "Switch to a running one Geiser REPL." t) - -;;;###autoload -(autoload 'geiser-mode "geiser-mode" - "Minor mode adding Geiser REPL interaction to Scheme buffers." t) - -;;;###autoload -(autoload 'turn-on-geiser-mode "geiser-mode" - "Enable Geiser's mode (useful in Scheme buffers)." t) - -;;;###autoload -(autoload 'turn-off-geiser-mode "geiser-mode" - "Disable Geiser's mode (useful in Scheme buffers)." t) - -(autoload 'geiser-activate-implementation "geiser-impl" - "Register the given implementation as active.") - -(autoload 'geiser-implementation-extension "geiser-impl" - "Register a file extension as handled by a given implementation.") - -;;;###autoload -(mapc (lambda (group) - (custom-add-load group (symbol-name group)) - (custom-add-load 'geiser (symbol-name group))) - '(geiser - geiser-repl - geiser-autodoc - geiser-doc - geiser-debug - geiser-faces - geiser-mode - geiser-image - geiser-implementation - geiser-xref)) - - -;;; Setup: - -;;;###autoload -(autoload 'geiser-mode--maybe-activate "geiser-mode") - -;;;###autoload -(add-hook 'scheme-mode-hook #'geiser-mode--maybe-activate) - -(provide 'geiser) -;;; geiser.el ends here diff --git a/elpa/geiser-0.30/geiser.info b/elpa/geiser-0.30/geiser.info @@ -1,1849 +0,0 @@ -This is docFESTkM.info, produced by makeinfo version 6.8 from -geiser.texi. - -This manual documents Geiser, an Emacs environment to hack in Scheme. - - Copyright (C) 2010, 2011, 2012, 2013, 2014, 2015, 2016, 2018, 2020, -2021 Jose Antonio Ortega Ruiz - - Permission is granted to copy, distribute and/or modify this - document under the terms of the GNU Free Documentation License, - Version 1.3 or any later version published by the Free Software - Foundation; with no Invariant Sections, no Front-Cover Texts, and - no Back-Cover Texts. A copy of the license is available from the - Free Software Foundation Web site at - <http://www.gnu.org/licenses/fdl.html>. - - The document was typeset with GNU Texinfo -(http://www.gnu.org/software/texinfo/index.html). -INFO-DIR-SECTION Emacs -START-INFO-DIR-ENTRY -* Geiser: (geiser). Emacs environment for Scheme hacking. -END-INFO-DIR-ENTRY - - -File: docFESTkM.info, Node: Top, Next: Introduction, Prev: (dir), Up: (dir) - -Geiser -****** - -* Menu: - -* Introduction:: -* Installation:: -* The REPL:: -* Between the parens:: -* Cheat sheet:: -* No hacker is an island:: -* Index:: - - -- The Detailed Node Listing -- - -Introduction - -* Modus operandi:: -* Showing off:: - -Installation - -* Must needs:: -* The quick and easy way:: -* From the source's mouth:: -* Friends:: - -The REPL - -* Starting the REPL:: -* First aids:: -* Switching context:: -* Completion and error handling:: -* Autodoc and friends:: -* Seeing is believing:: -* Customization and tips:: - -Between the parens - -* Activating Geiser:: -* The source and the REPL:: -* Documentation helpers:: -* To eval or not to eval:: -* To err perchance to debug:: -* Jumping around:: -* Geiser writes for you:: - -Cheat sheet - -* Scheme buffers:: -* REPL:: -* Documentation browser:: - - -Geiser is a collection of Emacs major and minor modes that conspire with -one or more Scheme interpreters to keep the Lisp Machine Spirit alive. -It draws inspiration (and a bit more) from environments such as Common -Lisp's Slime, Factor's FUEL, Squeak or Emacs itself, and does its best -to make Scheme hacking inside Emacs (even more) fun. - - Or, to be precise, what i (https://jao.io) consider fun. Geiser is -thus my humble contribution to the dynamic school of expression, and a -reaction against what i perceive as a derailment, in modern times, of -standard Scheme towards the static camp. Because i prefer growing and -healing to poking at corpses, the continuously running Scheme -interpreter takes the center of the stage in Geiser. A bundle of Elisp -shims orchestrates the dialog between the Scheme interpreter, Emacs and, -ultimately, the schemer, giving her access to live metadata. Here's -how. - - -File: docFESTkM.info, Node: Introduction, Next: Installation, Prev: Top, Up: Top - -1 Introduction -************** - -Geiser is an Emacs environment to hack and have fun in Scheme. If -that's enough for you, see *note Installation:: to get it running and -*note The REPL:: for the fun part. - -* Menu: - -* Modus operandi:: -* Showing off:: - - -File: docFESTkM.info, Node: Modus operandi, Next: Showing off, Prev: Introduction, Up: Introduction - -1.1 Modus operandi -================== - -As already mentioned, Geiser relies on a running Scheme process to -obtain the information it makes accessible to the programmer. There's -little effort, on the Elisp side, to understand, say, the module system -used by the Scheme implementation at hand; instead, a generic interface -between the two worlds is defined, and each supported Scheme includes a -library implementing that API, together with some wee shims in Elisp -allowing the reuse of the Emacs-side framework, which constitutes the -bulk of the code. - - While being as generic as possible, the Scheme-Elisp interface makes -some assumptions about the capabilities and interaction mode of the -corresponding REPL. In particular, Geiser expects the latter to support -namespaces in the form of a module system, and to provide a well-defined -way to establish the REPL's current namespace (or module), as well as -the current file's module (or namespace). Thus, all evaluations -performed by Geiser either in the REPL or in a source code buffer happen -in the context of the current namespace. Every time you switch to a -different file, you're switching namespaces automatically; at the REPL, -you must request the switch explicitly (usually just using means -provided by the Scheme implementation itself). - - If your favourite Scheme supports the above modus operandi, it has -all that's needed for a bare-bones Geiser mode. But Geiser can, and -will, use any metadata available: procedure arities and argument lists -to display interactive help, documentation strings, location information -to jump to definitions, export lists to provide completion, and so on -and so forth. Although this is not an all-or-none proposition (Geiser -can operate with just part of that functionality available), i initially -concentrated in supporting those Schemes with the richest (to my -knowledge) introspection capabilities, namely, Guile and Racket. Later -on, Dan Leslie added support for Chicken, and several other schemes -followed suit. - - -File: docFESTkM.info, Node: Showing off, Prev: Modus operandi, Up: Introduction - -1.2 Showing off -=============== - -When working with a fully conniving Scheme, Geiser can offer the -following functionality: - - * Form evaluation in the context of the current file's module. - * Macro expansion. - * File/module loading and/or compilation. - * Namespace-aware identifier completion (including local bindings, - names visible in the current module, and module names). - * Autodoc: the echo area shows information about the signature of the - procedure/macro around point automatically. - * Jump to definition of identifier at point. - * Access to documentation (including docstrings when the - implementation provides it). - * Listings of identifiers exported by a given module. - * Listings of callers/callees of procedures. - * Rudimentary support for debugging (when the REPL provides a - debugger) and error navigation. - * Support for multiple, simultaneous REPLs. - * Support for image display in those Schemes that treat them as first - class values. - - In the following pages, i'll try to explain what these features -actually are (i'm just swanking here), and how to use them for your -profit. But, before that, let's see how to install Geiser. - - -File: docFESTkM.info, Node: Installation, Next: The REPL, Prev: Introduction, Up: Top - -2 Installation -************** - -* Menu: - -* Must needs:: -* The quick and easy way:: -* From the source's mouth:: -* Friends:: - - -File: docFESTkM.info, Node: Must needs, Next: The quick and easy way, Prev: Installation, Up: Installation - -2.1 Must needs -============== - -If Geiser came with any guarantees, you'd break all of them by not using -GNU Emacs 24.4 (or better: i regularly use it with a recent Emacs -snapshot) and at least one of the supported Schemes, namely: - - * Chez (http://www.scheme.com) 9.4 or better, via geiser-chez - (https://gitlab.com/emacs-geiser/chez) - * Chibi (http://synthcode.com/scheme/chibi) 0.7.3 or better, via - geiser-chibi (https://gitlab.com/emacs-geiser/chibi) - * Chicken (http://call-cc.org) 4.8.0 or better, via geiser-chicken - (https://gitlab.com/emacs-geiser/chicken) - * Gambit (http://gambitscheme.org/wiki/index.php/Main_Page) 4.9.3 or - better, via geiser-gambit (https://gitlab.com/emacs-geiser/gambit) - * Gauche (http://practical-scheme.net/gauche/) 0.9.6 or better, via - geiser-gauche (https://gitlab.com/emacs-geiser/gauche) - * Guile (http://www.gnu.org/software/guile) 2.2 or better, via - geiser-guile (https://gitlab.com/emacs-geiser/guile) - * GNU Kawa (http://www.gnu.org/software/kawa/index.html) 3.1 or - better, via geiser-kawa (https://gitlab.com/emacs-geiser/kawa) - * MIT/GNU Scheme (https://www.gnu.org/software/mit-scheme) 9.0 or - better, via geiser-mit (https://gitlab.com/emacs-geiser/mit) - * Racket (http://www.racket-lang.org) 7.0 or better, via - geiser-racket (https://gitlab.com/emacs-geiser/racket) - * Stklos (https://stklos.net/) 1.50 or better, via geiser-stklos - (https://gitlab.com/emacs-geiser/stklos) - - Since Geiser supports multiple REPLs, having all of them will just -add to the fun. - - You'll also need Geiser itself. The quickest installation is via -your favourite implementation's ELPA packages (as of this writing, -they're all available in MELPA and (most of them) also in NonGNU ELPA, -which comes included with the batteries of Emacs 28 or better). - - -File: docFESTkM.info, Node: The quick and easy way, Next: From the source's mouth, Prev: Must needs, Up: Installation - -2.2 The quick and easy way -========================== - -Did i mention that the easiest way of installing Geiser is using its -ELPA (http://emacswiki.org/emacs/ELPA) package? If you're using Emacs -24, ELPA (http://emacswiki.org/emacs/ELPA) is already there; for earlier -versions, the page i just linked to twice will tell you where to find -the goodies. - - ELPA packages live in repositories accessible via HTTP. You can find -Geiser's package in either NonGNU ELPA -(https://elpa.nongnu.org/nongnu/geiser.html) or, if you like living on -the bleeding edge, MELPA (http://melpa.org/#/geiser) (directly from the -git repo). To tell Emacs that an ELPA repo exists, you add it to -'package-archives'(1): - - (require 'package) - - (add-to-list 'package-archives - '("nongnu" . "https://elpa.nongnu.org/nongnu/")) - - (package-initialize) - - And then installing your favourite Geiser is as easy as (if, say, -you're a MIT aficionado): - - M-x package-install RET geiser-mit RET - - Rinse and repeat for each of the scheme implementations that you -would like to use. Some of them (e.g. Gambit or Chicken) have a bit of -additional setup, specific to them, so make sure you also check their -respective package documentation. - - With that, you are pretty much all set up. See *note The REPL:: to -start using Geiser. - - ---------- Footnotes ---------- - - (1) If you're using Emacs 28 or better, 'package-archives' already -comes with the non-gnu archive preconfigured, so you're lucky in more -than one way. - - -File: docFESTkM.info, Node: From the source's mouth, Next: Friends, Prev: The quick and easy way, Up: Installation - -2.3 Installing from source -========================== - -All Geiser packages are ready to be used out of the box without much -more ado. For the sake of concreteness, let's assume you put its source -in the directory '~/lisp/geiser'. All you need to do is to add the -following line to your Emacs initialisation file (be it '~/.emacs', -'~/.emacs.d/init.el' or any of its moral equivalents): - - (add-to-list 'load-path "~/lisp/geiser/elisp") - - and, if your, say, 'geiser-gambit' checkout lives in -'~/lisp/geiser-mit' add to that: - - (add-to-list 'load-path "~/lisp/geiser-gambit") - - The autoloads defined in those packages should be enough to start -scheming. - - -File: docFESTkM.info, Node: Friends, Prev: From the source's mouth, Up: Installation - -2.4 Friends -=========== - -Although Geiser does not need them, it plays well with (and is enhanced -by) the following Emacs packages: - - * Paredit (http://www.emacswiki.org/emacs/ParEdit). Regardless of - whether you use Geiser or not, you shouldn't be coding in any Lisp - dialect without the aid of Taylor Campbell's structured editing - mode. - * Company (http://company-mode.github.io/). Nikolaj Schumacher's and - Dmitry Gutov's 'company-mode' provides a generic front-end for - completion engines (such as Geiser's), with pretty and automatic - completion lists. - * macrostep-geiser (https://github.com/nbfalcon/macrostep-geiser) - provides support for in-buffer macro expansion, using the macrostep - (https://github.com/joddie/macrostep) package. - * ac-geiser (https://github.com/xiaohanyu/ac-geiser/) If you prefer - 'auto-complete-mode' to 'company-mode', Xiao Hanyu's 'ac-geiser', - which provides a Geiser plugin for the popular Emacs Auto - Completion Mode (https://www.emacswiki.org/emacs/AutoComplete), is - the package for you. Like Geiser, 'ac-geiser' is available in - MELPA, and also as an 'el-get' package. - -You just need to install and setup them as usual, for every package's -definition of usual. Geiser will notice their presence and react -accordingly. - - -File: docFESTkM.info, Node: The REPL, Next: Between the parens, Prev: Installation, Up: Top - -3 The REPL -********** - -If you've followed the instructions in *note Installation::, your Emacs -is now ready to start playing. Otherwise, i'll wait for you: when -you're ready, just come back here and proceed to the following sections. - -* Menu: - -* Starting the REPL:: -* First aids:: -* Switching context:: -* Completion and error handling:: -* Autodoc and friends:: -* Seeing is believing:: -* Customization and tips:: - - -File: docFESTkM.info, Node: Starting the REPL, Next: First aids, Prev: The REPL, Up: The REPL - -3.1 Starting the REPL -===================== - -To start a Scheme REPL (meaning, a Scheme process offering you a -Read-Eval-Print Loop), Geiser provides the generic interactive command -'geiser'. If you invoke it (via, as is customary in Emacs, 'M-x -geiser'), you'll be saluted by a prompt asking which one of the -supported implementations you want to launch--yes, you can stop the -asking, see *note below: active-implementations. Tabbing for completion -will offer you, as of this writing, 'guile', 'racket', 'chicken', 'mit', -'chibi' and 'chez'. Just choose your poison, and a new REPL buffer will -pop up (by default, the REPL will appear in a new window: if that annoys -you, just set 'geiser-repl-use-other-window' to 'nil' and the current -window will be used). - - If all went according to plan, you'll be facing an -implementation-dependent banner, followed by an interactive prompt. -Going according to plan includes having the executable of the Scheme you -chose in your path. If that's not the case, you can tell Emacs where it -is, as described in *note a moment: impl-binary. Returning to our REPL, -the first thing to notice is that the funny prompt is telling you your -current module: its name is the part just after the @ sign (in Guile, -that means 'guile-user', while Racket's and Chicken's top namespaces -don't have a name; cf. discussion in *note Switching context::). Other -than that, this is pretty much equivalent to having a command-line -interpreter in a terminal, with a bunch of add-ons that we'll be -reviewing below. You can start typing sexps right there: Geiser will -only dispatch them for evaluation when they're complete, and will indent -new lines properly until then. It will also keep track of your input, -maintaining a history file that will be reloaded whenever you restart -the REPL. - - If you're not happy with the faces Geiser is using for the REPL's -prompt and evaluated input, you can customise -'geiser-font-lock-repl-prompt' and 'geiser-font-lock-repl-input' to -better-looking faces. - -Connecting to an external Scheme -................................ - -There's an alternative way of starting a Geiser REPL: you can connect to -an external Scheme process, provided it's running a REPL server at some -known port. How to make that happen depends on the Scheme -implementation. - - If you use Guile, you just need to start your Guile process (possibly -outside Emacs) passing to it the flag '--listen'. This flag accepts an -optional port as argument (as in '--listen=1969'), if you don't want to -use the default. - - In Racket, you have to use the REPL server that comes with Geiser. -To that end, put Geiser's Racket 'scheme' directory in Racket's -collection search path and invoke 'start-geiser' (a procedure in the -module 'geiser/server') somewhere in your program, passing it the -desired port and, if desired, network interface name. This procedure -will start the REPL server in a separate thread. For an example of how -to do that, see the script 'bin/geiser-racket.sh' in the source -distribution, or, if you've compiled Geiser, 'bin/geiser-racket-noinst' -in the build directory, or, if you've installed Geiser, 'geiser-racket' -in '<installation-prefix>/bin'. These scripts start a new interactive -Racket that is also running a REPL server (they also load the errortrace -library to provide better diagnostics, but that's not strictly needed). - - With your external Scheme process running and serving, come back to -Emacs and execute 'M-x geiser-connect', 'M-x connect-to-guile' or 'M-x -connect-to-racket'. You'll be asked for a host and a port, and, voila, -you'll have a Geiser REPL that is served by the remote Scheme process in -a dedicated thread, meaning that your external program can go on doing -whatever it was doing while you tinker with it from Emacs. Note, -however, that all Scheme threads share the heap, so that you'll be able -to interact with those other threads in the running Scheme from Emacs in -a variety of ways. For starters, all your (re)definitions will be -visible everywhere. That's dangerous, but will come in handy when you -need to debug your running web server. - - The connection between Emacs and the Scheme process goes over TCP, so -it can be as remote as you need, perhaps with the intervention of an SSH -tunnel. - - -File: docFESTkM.info, Node: First aids, Next: Switching context, Prev: Starting the REPL, Up: The REPL - -3.2 First aids -============== - -A quick way of seeing what else Geiser's REPL can do for you, is to -display the corresponding entry up there in your menu bar. No, i don't -normally use menus either; but they can come in handy until you've -memorized Geiser's commands, as a learning device. And yes, i usually -run Emacs inside a terminal, but one can always use La Carte -(http://www.emacswiki.org/emacs/LaCarte) to access the menus in a -convenient enough fashion. - - Or just press 'C-h m' and be done with that. - - Among the commands at your disposal, we find the familiar input -navigation keys, with a couple twists. By default, 'M-p' and 'M-n' are -bound to matching items in your input history. That is, they'll find -the previous or next sexp that starts with the current input prefix -(defined as the text between the end of the prompt and your current -position, a.k.a. "point", in the buffer). For going up and down the -list unconditionally, just use 'C-c M-p' and 'C-c M-n'. In addition, -navigation is sexp-based rather than line-based. - - There are also a few commands to twiddle with the Scheme process. -'C-c C-q' will gently ask it to quit, while 'C-u C-c C-q' will -mercilessly kill the process (but not before stowing your history in the -file system). Unless you're using a remote REPL, that is, in which case -both commands will just sever the connection and leave the remote -process alone. If worse comes to worst and the process is dead, 'C-c -C-z' will restart it. However, the same shortcut, issued when the REPL -is alive, will bring you back to the buffer you came from, as explained -in *note this section: switching-repl-buff. - - The remaining commands are meatier, and deserve sections of their -own. - - -File: docFESTkM.info, Node: Switching context, Next: Completion and error handling, Prev: First aids, Up: The REPL - -3.3 Switching context -===================== - -In tune with Geiser's modus operandi, evaluations in the REPL take place -in the namespace of the current module. As noted above, the REPL's -prompt tells you the name of the current module. To switch to a -different one, you can use the command 'geiser-repl-switch-to-module', -bound to 'C-c C-m'. You'll notice that Geiser simply uses a couple of -meta-commands provided by the Scheme REPL (the stock ',m' in Guile and -Chicken and the (geiser-defined) ',enter' in Racket), and that it -doesn't even try to hide that fact. That means that you can freely use -said native ways directly at the REPL, and Geiser will be happy to -oblige. In Racket, ',enter' works like Racket's standard 'enter!' form, -but you can also provide a path string as its argument (e.g., ',enter -"/tmp/foo.rkt"' is equivalent to ',enter (file "/tmp/foo.rkt")'). Like -'enter!', ',enter' accepts also module names (as in, say, ',enter -geiser/main'). As mentioned, in Guile and Chicken, ',m' is used as is. - - Once you enter a new module, only those bindings visible in its -namespace will be available to your evaluations. All Schemes supported -by Geiser provide a way to import new modules in the current namespace. -Again, there's a Geiser command, 'geiser-repl-import-module', to invoke -such functionality, bound this time to 'C-c C-i'. And, again, you'll -see Geiser just introducing the native incantation for you, and you're -free to use such incantations by hand whenever you want. - - One convenience provided by these two Geiser commands is that -completion is available when introducing the new module name, using the -'<TAB>' key. Pressing it at the command's prompt will offer you a -prefix-aware list of available module names. - - Which brings me to the next group of REPL commands. - - -File: docFESTkM.info, Node: Completion and error handling, Next: Autodoc and friends, Prev: Switching context, Up: The REPL - -3.4 Completion and error handling -================================= - -We've already seen Geiser completion of module names in action at the -minibuffer. You won't be surprised to know that it's also available at -the REPL buffer itself. There, you can use either 'C-.' or 'M-`' to -complete module names, and '<TAB>' or 'M-<TAB>' to complete identifiers. -Geiser will know what identifiers are bound in the current module and -show you a list of those starting with the prefix at point. Needless to -say, this is not a static list, and it will grow as you define or import -new bindings in the namespace at hand. If no completion is found, -'<TAB>' will try to complete the prefix after point as a module name. - - REPL buffers use Emacs' compilation mode to highlight errors reported -by the Scheme interpreter, and you can use the 'next-error' command -('M-g n') to jump to their location. By default, every time you enter a -new expression for evaluation old error messages are forgotten, so that -'M-g n' will always jump to errors related to the last evaluation -request, if any. If you prefer a not-so-forgetful REPL, set the -customization variable 'geiser-repl-forget-old-errors-p' to 'nil'. -Note, however, that even when that variable is left as 't', you can -always jump to an old error by moving to its line at the REPL and -pressing '<RET>'. When your cursor is away from the last prompt, -'<TAB>' will move to the next error in the buffer, and you can use -'<BACKTAB>' everywhere to go to the previous one. - -Caveat about completion & the REPL ----------------------------------- - -It is possible for Geiser to hang your Emacs process when trying to -complete symbols. This can happen in the REPL itself or even in a -Scheme buffer that is attached to the REPL process. If this happens, -you've probably entered a module that changes the REPL prompt from what -Geiser was expecting to see. - - Unfortunately, there's no general solution for this issue right now -(as it is a daunting task to try to make a regexp that can encompass all -possible REPL prompts). The best solution for now is to fix this issue -on a case-by-case basis by adjusting your prompt regexp variable so that -it matches the default prompt as well as your Scheme module's special -prompt. - - For example, XREPL is a Racket module that implements a better Racket -REPL. You might be interested in toying around with some of its -functions, but when you try to enter XREPL via, say, 'C-c C-m xrepl', -you'll notice that the REPL prompt has changed to something like this: - - <pkgs>/xrepl-lib/xrepl/main> - - If you start typing symbols, and then you try to auto-complete those -symbols, your Emacs process may hang. This is because Geiser expects -the REPL prompt to match this regexp (for Racket): - - "\\(mzscheme\\|racket\\)@[^ ]*> " - - Therefore, we can fix this issue by changing our default prompt -regexp like so: - - (setq geiser-racket--prompt-regexp "<pkgs>.*> \\|\\(mzscheme\\|racket\\)@[^ ]*> ") - - Note that you may have to run 'M-x geiser-reload' after setting this -variable so that your changes will take effect. - - Again, you'll have to change the regexp to fit every prompt that -causes this issue, but the only alternative (that we can think of right -now) is to create a regexp that will match every possible prompt. -Obviously, that is going to be more than a little tricky. However, if -you have a better solution than that, please share it with the Geiser -developers; we'll be more than happy to hear it. - - -File: docFESTkM.info, Node: Autodoc and friends, Next: Seeing is believing, Prev: Completion and error handling, Up: The REPL - -3.5 Autodoc and friends -======================= - -Oftentimes, there's more you'll want to know about an identifier besides -its name: What module does it belong to? Is it a procedure and, if so, -what arguments does it take? Geiser tries to help you answering those -questions too. - - Actually, if you've been playing with the REPL as you read, you might -have notice some frantic activity taking place in the echo area every -now and then. That was Geiser trying to be helpful (while, hopefully, -not being clippy), or, more concretely, what i call, for want of a -better name, its "autodoc" mode. Whenever it's active (did you notice -that A in the mode-line?), Geiser's gerbils will be scanning what you -type and showing (unless you silence them with 'C-c C-d C-a') -information about the identifier nearest to point. - - If that identifier corresponds to a variable visible in the current -namespace, you'll see the module it belongs to and its value. For -procedures and macros, autodoc will display, instead of their value, the -argument names (or an underscore if Geiser cannot determine the name -used in the definition). Optional arguments are surrounded by -parentheses. When the optional argument has a default value, it's -represented by a list made up of its name and that value. When the -argument is a keyword argument, its name has "#:" as a prefix. - - If that's not enough documentation for you, 'C-c C-d d' will open a -separate documentation buffer with help on the symbol at point. This -buffer will contain implementation-specific information about the -identifier (e.g., its docstring for Guile, or its contract, if any, for -Racket), and a handy button to open the corresponding manual entry for -the symbol, which will open an HTML page (for Racket and Chicken) or the -texinfo manual (for Guile). If you'd rather go directly to the manual, -try 'C-c C-d i', which invokes 'geiser-doc-look-up-manual' as the handy -button does. - - Geiser can also produce for you a list, classified by kind, of the -identifiers exported by a given module: all you need to do is press 'C-c -C-d m', and type or complete the desired module's name. - - The list of exported bindings is shown, again, in a buffer belonging -to Geiser's documentation browser, where you have at your disposal a -bunch of navigation commands listed in *note our cheat-sheet: -Documentation browser. - - We'll have a bit more to say about the documentation browser in *note -a later section: doc-browser. - - If that's still not enough, Geiser can jump, via 'M-.', to the -symbol's definition. A buffer with the corresponding file will pop up, -with its point resting upon the identifier's defining form. When you're -done inspecting, 'M-,' will bring you back to where you were. As we -will see, these commands are also available in Scheme buffers. 'M-.' -also works for modules: if your point is on an unambiguous module name, -the file where it's defined will be opened for you. - - -File: docFESTkM.info, Node: Seeing is believing, Next: Customization and tips, Prev: Autodoc and friends, Up: The REPL - -3.6 Seeing is believing -======================= - -In schemes that support images as values (currently, that means Racket), -the REPL will display them inline if you're using them in a -graphics-aware Emacs. - - For the terminal, images will appear as buttons: press return on them -to invoke an external viewer (configurable via 'geiser-image-viewer') -that will show you the image at hand. You can also ask for the same -behaviour on all emacsen by customising 'geiser-repl-inline-images-p' to -'nil'. - - Geiser keeps a cache of the last displayed images in the directory -'geiser-image-cache-dir', which defaults to the system's temp directory, -with up to 'geiser-image-cache-keep-last' files. You can invoke the -external image viewer on any of them with 'M-x geiser-view-last-image', -which takes a prefix argument to indicate which image number you want, 0 -corresponding to the newest one. - - -File: docFESTkM.info, Node: Customization and tips, Prev: Seeing is believing, Up: The REPL - -3.7 Customization and tips -========================== - -The looks and ways of the REPL can be fine-tuned via a bunch of -customization variables. You can see and modify them all in the -corresponding customization group (by using the menu entry or the good -old 'M-x customize-group geiser-repl'), or by setting them in your Emacs -initialisation files (as a rule, all knobs in Geiser are tunable this -way: you don't need to use customization buffers if you don't like -them). - - I'm documenting below a proper subset of those settings, together -with some related tips. - -Choosing a Scheme implementation -................................ - -Instead of using the generic 'geiser' command, you can directly start -your Scheme of choice using any of the following commands: - * 'run-racket' - * 'run-guile' - * 'run-chicken' - * 'run-mit' - * 'run-chibi' - * 'run-chez' - In addition, the variable 'geiser-active-implementations' contains a -list of those Schemes Geiser should be aware of. Thus, if you happen to -be, say, a racketeer not to be beguiled by other schemes, you can tell -Geiser to forget about the richness of the Scheme ecosystem with -something like: - - (setq geiser-active-implementations '(racket)) - -in your initialisation files. - - When starting a new REPL, Geiser assumes, by default, that the -corresponding Scheme binary is in your path. If that's not the case, -the variables to tweak are (depending on which Scheme you choose): - * 'geiser-guile-binary' - * 'geiser-racket-binary' - * 'geiser-chicken-binary' - * 'geiser-mit-binary' - * 'geiser-chibi-binary' - * 'geiser-chez-binary' - They should be set to a string with the full path to the requisite -binary. - - Before starting the REPL, Geiser will check whether the version of -your Scheme interpreter is good enough. This means that it will spend a -couple tenths of a second launching and quickly discarding a Scheme -process, but also that the error message you'll get if you're on the -wrong Scheme version will be much more informative. If you one to avoid -version checks, just check 'geiser-repl-skip-version-check-p' to 't' in -your configuration. - -Init files and load paths -......................... - -The startup behaviour of the REPL can be also fine tuned with a couple -more initialisation parameters. - - Many Scheme implementations provide a configuration variable to -specify a Geiser-specific init file (e.g., 'geiser-guile-init-file' for -Guile), and, sometimes a global list of paths to add to the -interpreter's load path (that'd be 'geiser-guile-load-path' for Guile). - - There is also a generic mechanism to specify how to add directories -to the initial load path when 'geiser-repl-current-project-function' is -set: you can then customize 'geiser-repl-add-project-paths' to a list of -subdirectories of the project's root to add to the load path. When this -option is set, the working directory of the REPL's buffer (i.e., the -value of the elisp variable 'default-directory') will be set to the -directory returned by 'geiser-repl-current-project-function'). - - These variables controlling your scheme's initialisation process are -good candidates for an entry in a project's '.dir-locals.el' file, so -that they are automatically set to a sensible value whenever you start a -REPL in the project's directory. - -Startup waiting time -.................... - -When starting a scheme implementation in old or very busy computers, -Geiser might have to wait a bit more than it expects (which is ten -seconds, or ten thousand milliseconds, by default). If you find that -Geiser is giving up too quickly and complaining that no prompt was -found, try to increase the value of 'geiser-repl-startup-time' to, say, -twenty seconds: - - (setq geiser-repl-startup-time 20000) - -If you prefer, you can use the customize interface to, well, customise -the above variable's value. - -History -....... - -By default, Geiser won't record duplicates in your input history. If -you prefer it did, just set 'geiser-repl-history-no-dups-p' to 'nil'. -History entries are persistent across REPL sessions: they're saved in -implementation-specific files whose location is controlled by the -variable 'geiser-repl-history-filename'. For example, my Geiser -configuration includes the following line: - - (setq geiser-repl-history-filename "~/.emacs.d/geiser-history") - -which makes the files 'geiser-history.guile' and 'geiser-history.racket' -to live inside my home's '.emacs.d' directory. - -Autodoc -....... - -If you happen to love peace and quiet and prefer to keep your REPL's -echo area free from autodoc's noise, 'geiser-repl-autodoc-p' is the -customization variable for you: set it to 'nil' and autodoc will be -disabled by default in new REPLs. You can always bring the fairies -back, on a per-REPL basis, using 'C-c C-d C-a'. - -Remote connections -.................. - -When using any of the connection commands (e.g. 'geiser-connect', -'connect-to-guile', 'connect-to-racket', etc.) you'll be prompted for a -host and a port, defaulting to "localhost" and 37146. You can change -those defaults customizing 'geiser-repl-default-host' and -'geiser-repl-default-port', respectively. - -Killing REPLs -............. - -If you don't want Emacs to ask for confirmation when you're about to -kill a live REPL buffer (as will happen, for instance, if you're exiting -Emacs before closing all your REPLs), you can set the flag -'geiser-repl-query-on-kill-p' to 'nil'. On a related note, the -customizable variable 'geiser-repl-query-on-exit-p' controls whether -Geiser should ask for confirmation when you exit the REPL explicitly -(via, say, 'C-c C-q', as opposed to killing the buffer), and is set to -'nil' by default. - - -File: docFESTkM.info, Node: Between the parens, Next: Cheat sheet, Prev: The REPL, Up: Top - -4 Between the parens -******************** - -A good REPL is a must, but just about half the story of a good Scheme -hacking environment. Well, perhaps a bit more than a half; but, at any -rate, one surely needs also a pleasant way of editing source code. -Don't pay attention to naysayers: Emacs comes with an excellent editor -included for about any language on Earth, and just the best one when -that language is sexpy (especially if you use Paredit). Geiser's -support for writing Scheme code adds to Emacs' 'scheme-mode', rather -than supplanting it; and it does so by means of a minor mode -(unimaginatively dubbed 'geiser-mode') that defines a bunch of new -commands to try and, with the help of the same Scheme process giving you -the REPL, make those Scheme buffers come to life. - -* Menu: - -* Activating Geiser:: -* The source and the REPL:: -* Documentation helpers:: -* To eval or not to eval:: -* To err perchance to debug:: -* Jumping around:: -* Geiser writes for you:: - - -File: docFESTkM.info, Node: Activating Geiser, Next: The source and the REPL, Prev: Between the parens, Up: Between the parens - -4.1 Activating Geiser -===================== - -With Geiser installed following any of the procedures described in *note -The quick and easy way:: or *note From the source's mouth::, Emacs will -automatically activate geiser-mode when opening a Scheme buffer. Geiser -also instructs Emacs to consider files with the extension 'rkt' part of -the family, so that, in principle, there's nothing you need to do to -ensure that Geiser's extensions will be available, out of the box, when -you start editing Scheme code. - - Indications that everything is working according to plan include the -'Geiser' minor mode indicator in your mode-line and the appearance of a -new entry for Geiser in the menu bar. If, moreover, the mode-line -indicator is the name of a Scheme implementation, you're indeed in a -perfect world; otherwise, don't despair and keep on reading: i'll tell -you how to fix that in a moment. - - The menu provides a good synopsis of everything Geiser brings to the -party, including those keyboard shortcuts we Emacsers love. If you're -seeing the name of your favourite Scheme implementation in the -mode-line, have a running REPL and are comfortable with Emacs, you can -stop reading now and, instead, discover Geiser's joys by yourself. I've -tried to make Geiser as self-documenting as any self-respecting Emacs -package should be. If you follow this route, make sure to take a look -at Geiser's customization buffers ('M-x customize-group <RET> geiser'): -there's lot of fine-tuning available there. You might also want to take -a glance at the tables in *note our cheat sheet: Cheat sheet. - - Since geiser-mode is a minor mode, you can toggle it with 'M-x -geiser-mode', and control its activation in hooks with the functions -'turn-on-geiser-mode' and 'turn-off-geiser-mode'. If, for some reason i -cannot fathom, you prefer geiser-mode not to be active by default, -customizing 'geiser-mode-auto-p' to 'nil' will do the trick. - - And if you happen to use a funky extension for your Scheme files that -is not recognised as such by Emacs, just tell her about it with: - - (add-to-list 'auto-mode-alist '("\\.funky-extension\\'" . scheme-mode)) - - Now, geiser-mode is just a useless wretch unless there's a running -Scheme process backing it up. Meaning that virtually all the commands -it provides require a REPL up and running, preferably corresponding to -the correct Scheme implementation. In the following section, we'll see -how to make sure that that's actually the case. - - -File: docFESTkM.info, Node: The source and the REPL, Next: Documentation helpers, Prev: Activating Geiser, Up: Between the parens - -4.2 The source and the REPL -=========================== - -As i've already mentioned a couple of times, geiser-mode needs a running -REPL to be operative. Thus, a common usage pattern will be for you to -first call 'geiser' (or one of its variants, e.g. 'run-guile'), and -then open some Scheme files; but there's nothing wrong in first opening -a couple Scheme buffers and then starting the REPL (you can even find it -more convenient, since pressing 'C-c C-z' in a Scheme buffer will start -the REPL for you). Since Geiser supports more than one Scheme -implementation, though, there's the problem of knowing which of them is -to be associated with each Scheme source file. Serviceable as it is, -geiser-mode will try to guess the correct implementation for you, -according to the algorithm described below. - -How Geiser associates a REPL to your Scheme buffer -.................................................. - -To determine what Scheme implementation corresponds to a given source -file, Geiser uses the following algorithm: - - 1. If the file-local variable 'geiser-scheme-implementation' is - defined, its value is used. A common way of setting buffer-local - variables is to put them in a comment near the beginning of the - file, surrounded by '-*-' marks, as in: - - ;; -*- geiser-scheme-implementation: guile -*- - - 2. If you've customized 'geiser-active-implementations' so that it's a - single-element list, that element is used as the chosen - implementation. - 3. The contents of the file is scanned for hints on its associated - implementation. For instance, files that contain a '#lang' - directive will be considered Racket source code, while those with a - 'define-module' form in them will be assigned to a Guile REPL. - 4. The current buffer's file name is checked against the rules given - in 'geiser-implementations-alist', and the first match is applied. - You can provide your own rules by customizing this variable, as - explained below. - 5. If we haven't been lucky this far and you have customized - 'geiser-default-implementation' to the name of a supported - implementation, we'll follow your lead. - 6. See? That's the problem of being a smart aleck: one's always - outsmarted by people around. At this point, geiser-mode will - humbly give up and ask you to explicitly choose the Scheme - implementation. - - As you can see in the list above, there are several ways to influence -Geiser's guessing by means of customizable variables. The most direct -(and most impoverishing) is probably limiting the active implementations -to a single one, while customizing 'geiser-implementations-alist' is the -most flexible (and, unsurprisingly, also the most complex). Here's the -default value for the latter variable: - - (((regexp "\\.scm$") guile) - ((regexp "\\.ss$") racket) - ((regexp "\\.rkt$") racket)) - -which describes the simple heuristic that files with '.scm' as extension -are by default associated to a Guile REPL while those ending in '.ss' or -'.rkt' correspond to Racket's implementation (with the caveat that these -rules are applied only if the previous heuristics have failed to detect -the correct implementation, and that they'll match only if the -corresponding implementation is active). You can add rules to -'geiser-implementations-alist' (or replace all of them) by customizing -it. Besides regular expressions, you can also use a directory name; for -instance, the following snippet: - - (eval-after-load "geiser-impl" - '(add-to-list 'geiser-implementations-alist - '((dir "/home/jao/prj/frob") guile))) - -will add a new rule that says that any file inside my -'/home/jao/prj/frob' directory (or, recursively, any of its children) is -to be assigned to Guile. Since rules are first matched, first served, -this new rule will take precedence over the default ones. - - A final tip: if you want Geiser to start automatically a REPL for you -if it notices that there's no one active when it enters geiser-mode, you -can customize 'geiser-mode-start-repl-p' to 't'. - -Managing multiple scheme projects -................................. - -By default, Geiser will re-use a single REPL for all buffers sharing the -same scheme implementation. This works well enough in many cases, but -may become problematic (or at least annoying) when working on multiple -projects with separate dependencies and include paths. - - Geiser provides optional support for using separate REPLs for each -project, which can be enabled by customizing -'geiser-repl-current-project-function' and selecting your Emacs -project-management library of choice (eg. 'project.el' or -'projectile'). With this configured, if you want new REPLs to -automatically associate themselves with the current project, so that all -Geiser commands will ignore REPLs that are not associated with the -project, customize the toggle 'geiser-repl-per-project-p' to 't' and -you're all set up. - - This can be very convenient when used with a '.dir-locals.el' in the -project root to set include paths, ensuring that Geiser REPLs will -always know where to find your project's modules or dependencies. -Geiser automatically handles the common case of the project root -belonging to the load path: unless you tell it otherwise (using the -customisable flag 'geiser-repl-add-project-path-p', which defaults to -'t'), it will add the result of calling -'geiser-repl-current-project-function' to the REPLs load path on -startup. - -Switching between source files and the REPL -........................................... - -Once you have a working geiser-mode, you can switch from Scheme source -buffers to the REPL or 'C-c C-z'. Those shortcuts map to the -interactive command 'geiser-repl-switch'. - - If you use a numeric prefix, as in 'C-u C-c C-z', besides being -teleported to the REPL, the latter will switch to the namespace of the -Scheme source file, as if you had used 'C-c C-m' in the REPL, with the -source file's module as argument; cf. discussion in *note Switching -context::. This command is also bound to 'C-c C-a'. - - Once you're in the REPL, the same 'C-c C-z' shortcut will bring you -back to the buffer you jumped from, provided you don't kill the Scheme -process in between. This is why the command is called -geiser-repl-switch instead of switch-to-repl, and what makes it really -handy, if you ask me. - - If for some reason you're not happy with the Scheme implementation -that Geiser has assigned to your file, you can change it with 'C-c C-s', -and you probably should take a look at the previous subsection to make -sure that Geiser doesn't get confused again. - -A note about context -.................... - -As explained before (*note Modus operandi::), all Geiser activities take -place in the context of the current namespace, which, for Scheme -buffers, corresponds to the module that the Scheme implementation -associates to the source file at hand (for instance, in Racket, there's -a one-to-one correspondence between paths and modules, while Guile -relies on explicit 'define-module' forms in the source file). - - Now that we have 'geiser-mode' happily alive in our Scheme buffers -and communicating with the right REPL instance, let us see what it can -do for us, besides jumping to and fro. - - -File: docFESTkM.info, Node: Documentation helpers, Next: To eval or not to eval, Prev: The source and the REPL, Up: Between the parens - -4.3 Documentation helpers -========================= - -Autodoc redux -............. - -The first thing you will notice by moving around Scheme source is that, -every now and then, the echo area lights up with the same autodoc -messages we know and love from our REPL forays. This happens every time -the Scheme process is able to recognise an identifier in the buffer, and -provide information either on its value (for variables) or on its arity -and the name of its formal arguments (for procedures and macros). That -information will only be available if the module the identifier belongs -to has been loaded in the running Scheme image. So it can be the case -that, at first, no autodoc is shown for identifiers defined in the file -you're editing. But as soon as you evaluate them (either individually -or collectively using any of the devices described in *note To eval or -not to eval::) their signatures will start appearing in the echo area. - - Autodoc activation is controlled by a minor mode, 'geiser-autodoc', -which you can toggle with 'M-x geiser-autodoc-mode', or its associated -keyboard shortcut, 'C-c C-d a'. That /A indicator in the mode-line is -telling you that autodoc is active. If you prefer that it be inactive -by default (e.g., because you're connecting to a really remote scheme -and want to minimize network exchanges), just set -'geiser-mode-autodoc-p' to 'nil' in your customization files. Even when -autodoc mode is off, you can use 'geiser-autodoc-show', bound by default -to 'C-c C-d s', to show the autodoc string for the symbol at point. - - The way autodoc displays information deserves some explanation. It -will first show the name of the module where the identifier at hand is -defined, followed by a colon and the identifier itself. If the latter -corresponds to a procedure or macro, it will be followed by a list of -argument names, starting with the ones that are required. Then there -comes a list of optional arguments, if any, enclosed in parentheses. -When an optional argument has a default value (or a form defining its -default value), autodoc will display it after the argument name. When -the optional arguments are keywords, their names are prefixed with "#:" -(i.e., their names are keywords). An ellipsis (...) serves as a marker -of an indeterminate number of parameters, as is the case with rest -arguments or when autodoc cannot fathom the exact number of arguments -(this is often the case with macros defined using 'syntax-case'). -Another way in which autodoc displays its ignorance is by using an -underscore to display parameters whose name is beyond its powers. - - It can also be the case that a function or macro has more than one -signature (e.g., functions defined using 'case-lambda', or some -'syntax-rules' macros, for which Geiser has often the black magic -necessary to retrieve their actual arities). In those cases, autodoc -shows all known signatures (using the above rules for each one) -separated by a vertical bar (|). - - As you have already noticed, the whole autodoc message is enclosed in -parentheses. After all, we're talking about Scheme here. - - Finally, life is much easier when your cursor is on a symbol -corresponding to a plain variable: you'll see in the echo area its name, -preceded by the module where it's defined, and followed by its value, -with an intervening arrow for greater effect. This time, there are no -enclosing parentheses (i hope you see the logic in my madness). - - You can change the way Geiser displays the module/identifier combo by -customizing 'geiser-autodoc-identifier-format'. For example, if you -wanted a tilde surrounded by spaces instead of a colon as a separator, -you would write something like: - - (setq geiser-autodoc-identifier-format "%s ~ %s") - -in your Emacs initialisation files. There's also a face -('geiser-font-lock-autodoc-identifier') that you can customize (for -instance, with 'M-x customize-face') to change the appearance of the -text. And another one ('geiser-font-lock-autodoc-current-arg') that -controls how the current argument position is highlighted. - -Other documentation commands -............................ - -Sometimes, autodoc won't provide enough information for you to -understand what a function does. In those cases, you can ask Geiser to -ask the running Scheme for further information on a given identifier or -module. - - For symbols, the incantation is 'M-x geiser-doc-symbol-at-point', or -'C-c C-d C-d' for short. If the associated Scheme supports docstrings -(as, for instance, Guile does), you'll be teleported to a new Emacs -buffer displaying Geiser's documentation browser, filled with -information about the identifier, including its docstring (if any; -unfortunately, that an implementation supports docstrings doesn't mean -that they're used everywhere). - - Pressing 'q' in the documentation buffer will bring you back, -enlightened, to where you were. There's also a handful of other -navigation commands available in that buffer, which you can discover by -means of its menu or via the good old 'C-h m' command. And feel free to -use the navigation buttons and hyperlinks that justify my calling this -buffer a documentation browser. - - For Racket, which does not support docstrings out of the box, this -command will provide less information, but the documentation browser -will display the corresponding contract when it's available, as well as -some other tidbits for re-exported identifiers. - - You can also ask Geiser to display information about a module, in the -form of a list of its exported identifiers, using 'C-c C-d C-m', exactly -as you would do in *note the REPL: repl-mod. - - In both cases, the documentation browser will show a couple of -buttons giving you access to further documentation. First, you'll see a -button named source: pressing it you'll jump to the symbol's definition. -The second button, dubbed manual, will open the Scheme implementation's -manual page for the symbol at hand. For Racket, that will open your web -browser displaying the corresponding reference's page (using the HTML -browser in Racket's configuration, which you can edit in DrRacket's -preferences dialog, or by setting 'plt:framework-pref:external-browser' -directly in '~/.racket/racket-prefs.rktd'), while in Guile a lookup will -be performed in the texinfo manual. - - For Guile, the manual lookup uses the info indexes in the standard -Guile info nodes, which are usually named "guile" or "guile-2.0". If -yours are named differently, just add your name to the customizable -variable 'geiser-guile-manual-lookup-nodes'. - - A list of all navigation commands in the documentation browser is -available in *note our cheat-sheet: Documentation browser. - - You can also skip the documentation browser and jump directly to the -manual page for the symbol at point with the command -'geiser-doc-look-up-manual', bound to 'C-c C-d i'. - - -File: docFESTkM.info, Node: To eval or not to eval, Next: To err perchance to debug, Prev: Documentation helpers, Up: Between the parens - -4.4 To eval or not to eval -========================== - -One of Geiser's main goals is to facilitate incremental development. -You might have noticed that i've made a big fuss of Geiser's ability to -recognize context, by dint of being aware of the namespace where its -operations happen. - - That awareness is especially important when evaluating code in your -scheme buffers, using the commands described below. They allow you to -send code to the running Scheme with a granularity ranging from whole -files to single s-expressions. That code will be evaluated in the -module associated with the file you're editing, allowing you to redefine -values and procedures to your heart's (and other modules') content. - - Macros are, of course, another kettle of fish: one needs to -re-evaluate uses of a macro after redefining it. That's not a -limitation imposed by Geiser, but a consequence of how macros work in -Scheme (and other Lisps). There's also the risk that you lose track of -what's actually defined and what's not during a given session. But, in -my opinion -(https://jaortega.wordpress.com/2009/03/29/from-my-cold-prying-hands), -those are limitations we lispers are aware of, and they don't force us -to throw the baby with the bathwater and ditch incremental evaluation. -Some people disagree; if you happen to find their arguments -(https://blog.racket-lang.org/2009/03/the-drscheme-repl-isnt-the-one-in-emacs.html) -convincing, you don't have to throw away Geiser together with the baby: -'M-x geiser-restart-repl' will let you restart the REPL as many times as -you see fit. Moreover, you can invoke 'geiser-compile-current-buffer' -and 'geiser-load-current-buffer' with a prefix argument (that'd be -something like 'C-u C-c C-k' for compilation, for instance), to tell -Geiser to restart the REPL associated with a buffer before compiling or -loading its current contents. - - For all of you auld bearded lispers still with me, here are some of -the commands performing incremental evaluation in Geiser. - - 'geiser-eval-last-sexp', bound to 'C-x C-e', will eval the -s-expression just before point. If you use a prefix, as in 'C-u C-x -C-e', besides evaluating it the expression is inserted in the the -buffer. - - 'geiser-eval-definition', bound to 'C-M-x', finds the topmost -definition containing point and sends it for evaluation. The variant -'geiser-eval-definition-and-go' ('C-c M-e') works in the same way, but -it also teleports you to REPL after the evaluation. - - 'geiser-eval-region', bound to 'C-c C-r', evals the current region. -Again, there's an and-go version available, 'geiser-eval-region-and-go', -bound to 'C-c M-r'. And, if you want to extend the evaluated region to -the whole buffer, there is 'geiser-eval-buffer', bound to 'C-c C-b' and -its companion 'geiser-eval-buffer-and-go', bound to 'C-c M-b'. - - For all the commands above, the result of the evaluation is displayed -in the minibuffer, unless it causes a (Scheme-side) error (*note To err -perchance to debug::), or, for schemes supporting them (such as Racket), -the evaluation yields an image, in which case you'll see it in popping -up in the Geiser debug buffer (if your Emacs runs under the auspices of -a graphical toolkit), or via an external viewer if you set -'geiser-image-viewer' to the path of an appropriate visualization -program (see also *note Seeing is believing:: for more on image -support). - - At the risk of repeating myself, i'll remind you that all these -evaluations will take place in the namespace of the module corresponding -to the Scheme file from which you're sending your code, which, in -general, will be different from the REPL's current module. And, if all -goes according to plan, (re)defined variables and procedures should be -immediately visible inside and, if exported, outside their module. - - Besides evaluating expressions, definitions and regions, you can also -macro-expand them. The corresponding key bindings start with the prefix -'C-c C-m' and end, respectively, with 'C-e', 'C-x' and 'C-r'. The -result of the macro expansion always appears in a pop up buffer. - - All the evaluations and expansions performed by the commands above -are asynchronous(1), so that you can move around while the answer is -being computed. The command 'geiser-eval-interrupt', bound to 'C-c C-i' -will interrupt any on-going evaluation and, when the scheme -implementation supports a debugger, bring you to a buffer where you can -perform buffer actions in the interrupted evaluation's context. - - Oh, didn't i mention we have support for debuggers? Let's talk about -that next. - - ---------- Footnotes ---------- - - (1) For local REPLs, where we can easily send an interrupt signal to -the scheme process; remote REPLs are another kettle of fish in this -regard, and generally interruptions are supported: you'll just have to -kill the connection if caught in a loop. - - -File: docFESTkM.info, Node: To err perchance to debug, Next: Jumping around, Prev: To eval or not to eval, Up: Between the parens - -4.5 To err: perchance to debug -============================== - -When an error occurs during evaluation, it will be reported according to -the capabilities of the underlying Scheme REPL. - - In most schemes, you'll be presented with a backtrace, in a new -buffer where file paths locating the origin of the error are click-able -(you can navigate them using the <TAB> key, and use <RET> or the mouse -to jump to the offending spot; or invoke Emacs' stock commands -'next-error' and 'previous-error', bound to 'M-g n' and 'M-g p' by -default). - - By default, Geiser will tele-transport your pointer to the debug -buffer: if you prefer to stay in the source buffer, set -'geiser-debug-jump-to-debug' to nil. - - For schemes with good debug support (Guile is one), the debug buffers -offer a debugging menu, accessible via the ',' (that's a comma) key. If -you press it, a transient menu will appear, offering you a variety of -actions, including showing local variable values or a more detailed -backtrace or frame display. This is the same interface you'll encounter -the in case of interrupted evaluations, either by your explicit 'C-c -C-i' command or because a breakpoint has been previously set. - - In addition, Geiser will sometimes report warnings for otherwise -successful evaluations. In those cases, it won't enter the debugger, -just report the warnings in a debug buffer. - - -File: docFESTkM.info, Node: Jumping around, Next: Geiser writes for you, Prev: To err perchance to debug, Up: Between the parens - -4.6 Jumping around -================== - -This one feature is as sweet as it is easy to explain: 'M-.' -('geiser-edit-symbol-at-point') will open the file where the identifier -around point is defined and land your point on its definition. To -return to where you were, press 'M-,' ('geiser-pop-symbol-stack'). This -command works also for module names: Geiser first tries to locate a -definition for the identifier at point and, if that fails, a module with -that name; if the latter succeeds, the file where the module is defined -will pop up. - - Sometimes, the underlying Scheme will tell Geiser only the file where -the symbol is defined, but Geiser will use some heuristics (read, -regular expressions) to locate the exact line and bring you there. -Thus, if you find Geiser systematically missing your definitions, send a -message to the mailing list <geiser-users@nongnu.org>, and we'll try to -make the algorithm smarter. - - You can control how the destination buffer pops up by setting -'geiser-edit-symbol-method' to either 'nil' (to open the file in the -current window), ''window' (other window in the same frame) or ''frame' -(in a new frame). - - -File: docFESTkM.info, Node: Geiser writes for you, Prev: Jumping around, Up: Between the parens - -4.7 Geiser writes for you -========================= - -No self-respecting programming mode would be complete without -completion. In geiser-mode, identifier completion is bound to -'M-<TAB>', and will offer all visible identifiers starting with the -prefix before point. Visible here means all symbols imported or defined -in the current namespace plus locally bound ones. E.g., if you're at -the end of the following partial expression: - - (let ((default 42)) - (frob def - -and press 'M-<TAB>', one of the possible completions will be 'default'. - - After obtaining the list of completions from the running Scheme, -Geiser uses the standard Emacs completion machinery to display them. -That means, among other things, that partial completion is available: -just try to complete 'd-s' or 'w-o-t-s' to see why this is a good thing. -Partial completion won't work if you have disabled it globally in your -Emacs configuration: if you don't know what i'm talking about, never -mind: Geiser's partial completion will work for you out of the box. - - If you find the 'M' modifier annoying, you always have the option to -activate 'geiser-smart-tab-mode', which will make the <TAB> key double -duty as the regular Emacs indentation command (when the cursor is not -near a symbol) and Geiser's completion function. If you want this -smarty pants mode always on in Scheme buffers, customize -'geiser-mode-smart-tab-p' to 't'. - - Geiser also knows how to complete module names: if no completion for -the prefix at point is found among the currently visible bindings, it -will try to find a module name that matches it. You can also request -explicitly completion only over module names using 'M-`' (that's a -backtick). - - Besides completion, there's also this little command, -'geiser-squarify', which will toggle the delimiters of the innermost -list around point between round and square brackets. It is bound to -'C-c C-e ['. With a numeric prefix (as in, say, 'M-2 C-c C-e ['), it -will perform that many toggles, forward for positive values and backward -for negative ones. - -Caveat about completion ------------------------ - -It is possible for Geiser to hang your Emacs process when trying to -complete symbols. This can happen in the REPL itself or even in a -Scheme buffer that is attached to the REPL process. For more details on -how to fix this problem, *note Caveat about completion & the REPL: -completion-caveat. - - -File: docFESTkM.info, Node: Cheat sheet, Next: No hacker is an island, Prev: Between the parens, Up: Top - -5 Cheat sheet -************* - -In the tables below, triple chords always accept a variant with the -third key not modified by <Control>; e.g., 'geiser-autodoc-show' is -bound both to 'C-c C-d C-s' and 'C-c C-d s'. - -* Menu: - -* Scheme buffers:: -* REPL:: -* Documentation browser:: - - -File: docFESTkM.info, Node: Scheme buffers, Next: REPL, Prev: Cheat sheet, Up: Cheat sheet - -5.1 Scheme buffers -================== - -Key Command Description ---------------------------------------------------------------------------- -C-c C-z 'geiser-mode-switch-to-repl' Switch to REPL -C-c C-a 'geiser-mode-switch-to-repl-and-enter'Switch to REPL and current - module (also 'C-u C-c C-z') -C-c C-s 'geiser-set-scheme' Specify Scheme - implementation for buffer -M-. 'geiser-edit-symbol-at-point' Go to definition of - identifier at point -M-, 'geiser-pop-symbol-stack' Go back to where M-. was - last invoked -C-c C-e C-m 'geiser-edit-module' Ask for a module and open - its file -C-c C-e C-l 'geiser-add-to-load-path' Ask for a directory and add - to Scheme load path -C-c C-e C-[ 'geiser-squarify' Toggle between () and [] - for current form -C-c C-\ 'geiser-insert-lambda' Insert greek lambda or, - with prefix, a lambda form -C-c C-i 'geiser-eval-interrupt' Interrupt ongoing - evaluation -C-M-x 'geiser-eval-definition' Eval definition around - point -C-c C-c 'geiser-eval-definition' Eval definition around - point -C-c M-e 'geiser-eval-definition-and-go'Eval definition around - point and switch to REPL -C-c M-c 'geiser-eval-definition-and-go'Eval definition around - point and switch to REPL -C-x C-e 'geiser-eval-last-sexp' Eval sexp before point -C-c C-r 'geiser-eval-region' Eval region -C-c M-r 'geiser-eval-region-and-go' Eval region and switch to - REPL -C-c C-b 'geiser-eval-buffer' Eval buffer -C-c M-b 'geiser-eval-buffer-and-go' Eval buffer and switch to - REPL -C-c C-m C-x 'geiser-expand-definition' Macro-expand definition - around point -C-c C-m C-e 'geiser-expand-last-sexp' Macro-expand sexp before - point -C-c C-m C-r 'geiser-expand-region' Macro-expand region -C-c C-k 'geiser-compile-current-buffer'Compile and load current - file; with prefix, restart - REPL before -C-c C-l 'geiser-load-file' Load scheme file -M-g n, C-x ' 'next-error' Jump to the location of - next error -M-g p 'previous-error' Jump to the location of - previous error -C-c C-d C-d 'geiser-doc-symbol-at-point' See documentation for - identifier at point -C-c C-d C-s 'geiser-autodoc-show' Show signature or value for - identifier at point in echo - area -C-c C-d C-m 'geiser-doc-module' See a list of a module's - exported identifiers -C-c C-d C-i 'geiser-doc-look-up-manual' Look up manual for symbol - at point -C-c C-d C-a 'geiser-autodoc-mode' Toggle autodoc mode -C-c < 'geiser-xref-callers' Show callers of procedure - at point -C-c > 'geiser-xref-callees' Show callees of procedure - at point -M-TAB 'completion-at-point' Complete identifier at - point -M-', C-. 'geiser-capf-complete-module' Complete module name at - point - - -File: docFESTkM.info, Node: REPL, Next: Documentation browser, Prev: Scheme buffers, Up: Cheat sheet - -5.2 REPL -======== - -Key Command Description ---------------------------------------------------------------------------- -C-c C-z 'geiser-repl-switch' Start Scheme REPL, or jump - to previous buffer -C-c M-o 'geiser-repl-clear-buffer' Clear REPL buffer -C-c C-k 'geiser-repl-interrupt' Interrupt REPL evaluation - (signalling inferior - scheme) -C-c C-q 'geiser-repl-exit' Kill Scheme process -M-. 'geiser-edit-symbol-at-point' Edit identifier at point -C-c C-l 'geiser-load-file' Load scheme file -TAB 'geiser-repl-tab-dwim' Complete, indent, or go to - next error -S-TAB 'geiser-repl--previous-error' Go to previous error in the -(backtab) REPL buffer -M-TAB 'completion-at-point' Complete identifier at - point -M-', C-. 'geiser-capf-complete-module' Complete module name at - point -C-c [, C-c 'geiser-squarify' Toggle between () and [] -C-[ for current form -C-c \, C-c 'geiser-insert-lambda' Insert greek lambda or, -C-\ with prefix, a lambda form -C-c C-r 'geiser-add-to-load-path' Ask for a directory and add - to Scheme load path -M-p, M-n (comint commands) Prompt history, matching - current prefix -C-c M-p, C-c (comint commands) Previous/next prompt inputs -M-n -C-c C-m 'geiser-repl-switch-to-module'Set current module -C-c C-i 'geiser-repl-import-module' Import module into current - namespace -C-c C-d C-d 'geiser-doc-symbol-at-point' See documentation for - symbol at point -C-c C-d C-i 'geiser-doc-look-up-manual' Look up manual for symbol - at point -C-c C-d C-m 'geiser-repl--doc-module' See documentation for - module -C-c C-d C-a 'geiser-autodoc-mode' Toggle autodoc mode - - -File: docFESTkM.info, Node: Documentation browser, Prev: REPL, Up: Cheat sheet - -5.3 Documentation browser -========================= - -Key Command Description ---------------------------------------------------------------------------- -TAB, n 'forward-button' Next link -S-TAB, p 'backward-button' Previous link -N 'geiser-doc-next-section' Next section -P 'geiser-doc-previous-section' Previous section -f 'geiser-doc-next' Next page -b 'geiser-doc-previous' Previous page -k 'geiser-doc-kill-page' Kill current page and go to - previous or next -g, r 'geiser-doc-refresh' Refresh page -c 'geiser-doc-clean-history' Clear browsing history -., M-. 'geiser-doc-edit-symbol-at-point'Edit identifier at point -z 'geiser-doc-switch-to-repl' Switch to REPL -q 'View-quit' Bury buffer - - -File: docFESTkM.info, Node: No hacker is an island, Next: Index, Prev: Cheat sheet, Up: Top - -6 No hacker is an island -************************ - -Dan Leslie, with the help of his three-months old daughter Freija, -proved there's a smidgen of sense in this madness by adding support for -Chicken to version 0.7 of Geiser, several years after it was born. And -Peter Feigl reinforced that feeling soon afterwards with his work on -supporting GNU/MIT Scheme, Chib and Chez in one fell swoop. - - Andy Wingo, Geiser's first user, has been a continuous source of -encouragement and suggestions, and keeps improving Guile and heeding my -feature requests. - - The nice thing about collaborating with Andreas Rottmann over all -these years is that he will not only make your project better with -insightful comments and prodding: he'll send you patches galore too. - - Ludovic Courtès, #geiser's citizen no. 1, joined the fun after a -while, and has since then been a continuous source of encouragement, -ideas and bug reports. - - Michael Wilber convinced me that image support for Racket was not -only fun, but easy, with the best argument: actual code! - - Daniel Hackney and Grant Rettke created the first ELPA packages for -Geiser and taught me to fish. - - Diogo F. S. Ramos is Geiser's most indefatigable user and bug -reporter, and the mailing list has been a far less lonely place since he -came. - - Aleix Conchillo has been my favourite spammer, beta tester and patch -sender during more years and for more projects than i can remember. - - Philip K. prepared the NonGNU ELPA packages for Geiser, making them -available by default starting in Emacs 28, very generously volunteering -all the work (i just had to update the docs!). - - Jonas Bernoulli, as it's his indefatigable wont, has improved -Geiser's compliance to current Emacs packaging standards, making it a -respectful member of the ELPA community. - - Eduardo Cavazos' contagious enthusiasm has helped in many ways to -keep Geiser alive, and he's become its best evangelist in R6RS circles. - - Alex Kost has contributed with many bug reports and improved Geiser -with several patches. - - Eli Barzilay took the time to play with an early alpha and made many -valuable suggestions, besides answering all my 'how do you in PLT' -questions. - - Matthew Flatt, Robby Findler and the rest of the PLT team did not -only answer my inquiries, but provided almost instant fixes to the few -issues i found. - - Thanks also to the PLT and Guile communities, for showing me that -Geiser was not only possible, but a pleasure to hack on. And to the -Slime hackers, who led the way. - -Joining the fun -............... - - * For questions, praise, critique and anything else Geiser, do not - hesitate to drop an email to our list, (@ geiser-users (. nongnu - org)) (mailto:geiser-users@nongnu.org): no subscription required. - Check the list page - (http://lists.nongnu.org/mailman/listinfo/geiser-users) for more - information or browse the archives - (http://lists.nongnu.org/archive/html/geiser-users/). The list is - also accessible via Gmane (http://gmane.org) as - gmane.lisp.scheme.geiser - (http://dir.gmane.org/gmane.lisp.scheme.geiser). - * You can submit bug reports either to the mailing list or to our bug - tracker (https://gitlab.com/groups/emacs-geiser/-/issues) over at - Gitlab. - * The Freenode IRC channel #geiser is the Geiserati's meeting point - in cyberspace. - - -File: docFESTkM.info, Node: Index, Prev: No hacker is an island, Up: Top - -Index -***** - - -* Menu: - -* ,enter vs. enter!: Switching context. (line 6) -* ac-geiser: Friends. (line 9) -* ask on kill, don't: Customization and tips. - (line 133) -* autocomplete: Friends. (line 9) -* autodoc customized: Documentation helpers. - (line 64) -* autodoc explained: Documentation helpers. - (line 32) -* autodoc for variables: Documentation helpers. - (line 58) -* autodoc, disabling: Customization and tips. - (line 115) -* autodoc, in scheme buffers: Documentation helpers. - (line 9) -* autodoc, in the REPL: Autodoc and friends. (line 11) -* autostart REPL: The source and the REPL. - (line 80) -* backtraces: To err perchance to debug. - (line 6) -* bug tracker: No hacker is an island. - (line 76) -* company: Friends. (line 9) -* completion for module names: Geiser writes for you. - (line 33) -* completion in scheme buffers: Geiser writes for you. - (line 6) -* completion, at the REPL: Completion and error handling. - (line 6) -* connect to server: Starting the REPL. (line 43) -* corpses: Top. (line 63) -* current module: Modus operandi. (line 15) -* current module, change: Switching context. (line 21) -* current module, in REPL: Switching context. (line 6) -* default directory: Customization and tips. - (line 69) -* derailment: Top. (line 63) -* dir-locals: The source and the REPL. - (line 87) -* disabling autodoc: Documentation helpers. - (line 22) -* docstrings, maybe: Documentation helpers. - (line 85) -* documentation for symbol: Documentation helpers. - (line 85) -* ELPA: The quick and easy way. - (line 6) -* error buffer: To err perchance to debug. - (line 9) -* evaluating images: To eval or not to eval. - (line 56) -* evaluation: To eval or not to eval. - (line 37) -* external image viewer: Seeing is believing. (line 10) -* faces, in the REPL: Starting the REPL. (line 35) -* geiser-add-to-load-path: Customization and tips. - (line 58) -* geiser-mode: Activating Geiser. (line 6) -* geiser-mode commands: Activating Geiser. (line 21) -* geiser-repl-add-project-path-p: The source and the REPL. - (line 102) -* geiser-repl-add-project-paths: Customization and tips. - (line 58) -* geiser-repl-per-project-p: The source and the REPL. - (line 92) -* gmane: No hacker is an island. - (line 66) -* Guile info nodes: Documentation helpers. - (line 120) -* Guile's REPL server: Starting the REPL. (line 48) -* GUILE_LOAD_COMPILED_PATH: Customization and tips. - (line 58) -* GUILE_LOAD_PATH: Customization and tips. - (line 58) -* help on identifier: Autodoc and friends. (line 29) -* host, default: Customization and tips. - (line 124) -* image cache: Seeing is believing. (line 16) -* image display: To eval or not to eval. - (line 56) -* image support: Seeing is believing. (line 6) -* image viewer: Seeing is believing. (line 10) -* incremental development: To eval or not to eval. - (line 6) -* incremental development, evil: To eval or not to eval. - (line 18) -* incremental development, not evil: To eval or not to eval. - (line 37) -* interrupt evaluation: To eval or not to eval. - (line 78) -* IRC channel: No hacker is an island. - (line 79) -* jump, at the REPL: Autodoc and friends. (line 51) -* jumping customized: Jumping around. (line 22) -* jumping in scheme buffers: Jumping around. (line 6) -* macrostep: Friends. (line 9) -* mailing list: No hacker is an island. - (line 66) -* manual autodoc: Documentation helpers. - (line 22) -* module exports: Autodoc and friends. (line 39) -* modus operandi: Modus operandi. (line 6) -* NonGNU ELPA: The quick and easy way. - (line 6) -* opening manual pages: Documentation helpers. - (line 128) -* paredit: Friends. (line 9) -* partial completion: Geiser writes for you. - (line 18) -* peace and quiet: Customization and tips. - (line 115) -* philosophy: Top. (line 63) -* philosophy <1>: To eval or not to eval. - (line 6) -* port, default: Customization and tips. - (line 124) -* project.el: The source and the REPL. - (line 87) -* projectile: The source and the REPL. - (line 87) -* projects: The source and the REPL. - (line 87) -* quick install: The quick and easy way. - (line 6) -* Racket's REPL server: Starting the REPL. (line 53) -* recursion: Index. (line 6) -* remote connections: Starting the REPL. (line 78) -* remote REPL: Starting the REPL. (line 43) -* REPL: Starting the REPL. (line 6) -* REPL commands: First aids. (line 6) -* REPL customization: Customization and tips. - (line 6) -* REPL, faces: Starting the REPL. (line 35) -* scheme binary: Customization and tips. - (line 38) -* scheme executable path: Customization and tips. - (line 38) -* scheme file extensions: Activating Geiser. (line 38) -* scheme implementation, choosing: Customization and tips. - (line 20) -* scheme implementation, choosing <1>: The source and the REPL. - (line 21) -* scheme init file: Customization and tips. - (line 58) -* scheme load path: Customization and tips. - (line 58) -* smart tabs: Geiser writes for you. - (line 26) -* start REPL, automatically: The source and the REPL. - (line 80) -* startup timeout: Customization and tips. - (line 85) -* supported versions: Must needs. (line 6) -* swanking: Showing off. (line 6) -* switching schemes: The source and the REPL. - (line 131) -* switching to module: The source and the REPL. - (line 119) -* switching to REPL: The source and the REPL. - (line 115) -* switching to source: The source and the REPL. - (line 115) -* thanks: No hacker is an island. - (line 6) -* timeout: Customization and tips. - (line 85) -* to err is schemey: To err perchance to debug. - (line 6) -* useless wretch: Activating Geiser. (line 43) -* Version checking: Customization and tips. - (line 50) -* versions supported: Must needs. (line 6) - - - -Tag Table: -Node: Top910 -Node: Introduction2674 -Node: Modus operandi3011 -Ref: current-module3669 -Node: Showing off5134 -Node: Installation6415 -Node: Must needs6631 -Node: The quick and easy way8592 -Ref: The quick and easy way-Footnote-110073 -Node: From the source's mouth10228 -Node: Friends11016 -Ref: paredit11293 -Node: The REPL12430 -Ref: quick-start12552 -Node: Starting the REPL12943 -Node: First aids17325 -Node: Switching context19161 -Node: Completion and error handling21094 -Ref: completion-caveat22805 -Node: Autodoc and friends24719 -Ref: repl-mod26792 -Node: Seeing is believing27798 -Node: Customization and tips28813 -Ref: choosing-impl29545 -Ref: active-implementations29776 -Ref: impl-binary30158 -Node: Between the parens34569 -Node: Activating Geiser35634 -Node: The source and the REPL38247 -Ref: repl-association39290 -Ref: repl-per-project42538 -Ref: switching-repl-buff43951 -Node: Documentation helpers45640 -Ref: doc-browser49911 -Node: To eval or not to eval52638 -Ref: To eval or not to eval-Footnote-157385 -Node: To err perchance to debug57638 -Node: Jumping around59145 -Node: Geiser writes for you60425 -Node: Cheat sheet62932 -Node: Scheme buffers63319 -Node: REPL67760 -Node: Documentation browser70350 -Node: No hacker is an island71421 -Node: Index74876 - -End Tag Table - - -Local Variables: -coding: utf-8 -End: diff --git a/elpa/geiser-0.30/license b/elpa/geiser-0.30/license @@ -1,29 +0,0 @@ -BSD 3-Clause License - -Copyright (c) 2009, 2010, 2011, 2012, 2013, 2015, Jose Antonio Ortega Ruiz -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - -* Redistributions of source code must retain the above copyright notice, this - list of conditions and the following disclaimer. - -* Redistributions in binary form must reproduce the above copyright notice, - this list of conditions and the following disclaimer in the documentation - and/or other materials provided with the distribution. - -* Neither the name of the copyright holder nor the names of its - contributors may be used to endorse or promote products derived from - this software without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" -AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE -DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE -FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR -SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER -CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, -OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/elpa/geiser-0.30/news.org b/elpa/geiser-0.30/news.org @@ -1,415 +0,0 @@ -* Version 0.30 (December 15, 2023) - - - New geiser-repl-superparen-mode - - Fix: better message for symbol not found error - - Fix: better detection of whitespace in REPL - - Compilation warnings and all libraries using lexical binding - -* Version 0.29.1 (August 6 2023) - - - Minimun Emacs version upped to 27.1 - -* Version 0.29 (July 14 2023) - - - Autoeval mode for REPL (thanks to Antero Mejr) - - Fixes for jumping and starting new REPLs - - Better tramp support (thanks to Brian Cully) - -* Version 0.28.1 (November 27 2022) - - - Bug fix: ensure geiser-activate-implementation is autoloaded. - - Bug fix: don't require transient, it's not used anymore by geiser core. - -* Version 0.28 (November 4 2022) - - - Last-result local jumps and autodoc (without using imenu). - - Simplifications to the debugging support. - - Clean-ups and more libs under lexical binding. - -* Version 0.27 (October 13 2022) - - - Fallback to imenu for jumping to symbol definition, as a last resort. - - Bug fixes: and-go commands, docsig for completions (now controlled - by the new geiser-autodoc-docsig flag). - -* Version 0.26.1 (September 6 2022) - - - Improve default names for per-project REPLs. - - Recover missing, obsoleted alias run-geiser - -* Version 0.26 (August 25 2022) - - - Ask interactively for REPL startup on C-c C-k as needed. - - New public command geiser-repl-maybe-send. - - ~switch-to-geiser~ and ~switch-to-geiser-module~ obsoleted in favour of - ~geiser-repl-switch~ and geiser-~repl-switch-to-module~. For implementations, - geiser-IMPL-switch is defined, obsoleting swith-to-IMPL. - - ~run-geiser~ obsoleted, just use =M-x geiser=. For implementations, - geiser-IMPL is defined, obsoleting run-IMPL. - -* Version 0.25.1 (August 21 2022) - - - Fixes for compilation errors. - -* Version 0.25 (August 21 2022) - - New customizable variables: geiser-repl-startup-hook and - geiser-repl-startup-forms. - - Fix: support for .dir-locals.el in REPL buffers. - - Fix: geiser-restart-repl: don't start a REPL to just restart it. - - Fix: respect user-defined completion-at-point-functions. - -* Version 0.24 (May 7 2022) - - - Support for #{...}# extended symbol syntax - - Removed explicit company backend: use CAPF instead. - -* Version 0.23.1 (March 23 2022) - - - Bug fix for debug buffer fontification - -* Version 0.23 (March 9 2022) - - - Set REPL's default directory to project's root. - - Depend on ELPA's project 0.8.1 to ensure compatibility - with emacs < 28. - - Harmonize buffer names (follow ~*Geiser ...*~ format) - -* Version 0.22.2 (February 3 2022) - - - Bug fixes (byte-compiler warnings, corfu compatibility). - -* Version 0.22.1 (January 23 2022) - - - Fix for C-u C-x C-e (in-buffer printing of evaluated expression) - - Fix for project functions other than project-current - -* Version 0.22 (December 29 2021) - - - New functions geiser-wait-eval and geiser-eval-region/wait for - synchronous clients like ob-scheme. - -* Version 0.21 (December 22 2021) - - - Asynchronous, interruptible evaluation and compilation - -* Version 0.20 (December 20 2021) - - - Improved support for debugging sessions (for implementations - supporting them, as usual). - - New option to add current project's root to load path or any of - its subdirectories, ~geiser-repl-add-project-paths~. - - Defaulting ~geiser-repl-current-project-function~ to ~project-current~ - in emacsen having it available, and using the new - ~geiser-repl-per-project-p~ to decide whether to use it. - -* Version 0.19 (December 4 2021) - - - Bug fixes - -* Version 0.18 (October 3 2021) - - - Documentation fix - -* Version 0.17 (August 8 2021) - - - Package available in NonGNU ELPA (doc update) - - Linting and minor fixes - -* Version 0.16 (April 21 2021) - - - Bug fix: display of evaluation outputs in schemes with no special - error display handler. - -* Versions 0.14 and 0.15 (April 16 2021) - - - Fixes for autoloads in some distributions - -* Version 0.13 (April 4 2021) - - - Split into per-scheme projects - -* Version 0.12 (July 14 2020) - - - New project.el and projectile support (Andrew Whatson) - - Improved Chez support (Jay Xu, Aaron Marks, Julian Herrera) - - Improved Chicken support (Ricardo G. Herdt, Noam Postavsky) - - Bug fixes (Philip K, spellcard199) - - Linting and clean ups (Jonas Bernoulli) - - Documentation updates - -* Version 0.11.2 (February 25 2020) - - - Bug fixes - -* Version 0.11.1 (February 23 2020) - - - Bug fixes - -* Version 0.11 (February 4 2020) - - - Bug fixes for all supported implementations - - New support for Gambit - -* Version 0.10 (March 14 2018) - - - Better support for Guile 2.2 - - Better support for Chicken (Dan Leslie, John Whitbeck) - - Better support for Chez (Chaos Eternal) - - Bug fixes (Peter Wang, Diog F. S. Ramos, Mario Rodas, Jordan Brown) - - Documentation fixes (Jonas Bernoulli, Andrew Sackville-West, Ziyi - Yan, James C. De Ricco, George D. Plymale II) - -* Version 0.9 (Oct 6 2016) - - - Chicken: improvements by Dan Leslie. - - Guile: support for Guile 2.2 (with help from Raffik Naccache and - David Thompson). - - Preliminary support for GNU/MIT, Chibi and Chez by Peter Feigl. - - Lots of bug fixes. - -* Version 0.8.1 (Oct 13 2015) - - Bug fix: font-lock-ensure is from the future. - -* Version 0.8 (Oct 12 2015) - - Improved features: - - - Lots of improvements to Chicken support, by Dan Leslie. - - Better interoperability with xscheme. - - Much better performance for long lists of completions or - evaluated values. - - Better highlighting and indentation rules, by Alex Kost and Dan - Leslie. - - Make completion work for quoted symbols. - - Bug fixes: - - - geiser-connect-local working again. - -* Version 0.7 "Freija" (Feb 21 2015) - - This release is dedicated to Dan's three-months-old daughter Freija, - who shared her dad's lap with his laptop while he was hacking on the - new Chicken scheme support for Geiser. - - New features: - - - Chicken support, by Dan Leslie. - - Improved features: - - - `company-mode' support completed with a method for `doc-buffer'. - - Support for multiple image display in Racket, including image - objects embedded in structured values (thanks to Greg Hendershott). - -* Version 0.6 (Aug 9 2014) - - New features: - - - New customizable variables `geiser-debug-jump-to-debug-p` and - `geiser-debug-show-debug-p`. - - Better fontification of some scheme keywords (thanks to Diogo - F. S. Ramos). - - Bug fixes: - - - Better support for Typed Racket: (re)definitions now work for - typed/racket modules (thanks to Sam Tobin-Hochstadt). - - Better behaviour for geiser-eval-buffer in racket - buffers that contain a #lang directive. But you'd better use C-c - C-k instead. - - Better behaviour of C-c C-c when interrupting looping functions - in the REPL. - - Fixes for Makefile target html-am (as in now it works). - -* Version 0.5 (Dec 9 2013) - - New features: - - - Geiser is now available from MELPA, with the help of Steve Purcell. - - Racket: new commands geiser-racket-{show, hide, toggle}-submodules, - for folding submodule forms in code buffers. - - Racket: interaction with submodules (entering them and evaluation - within their scope). - - New commands geiser-eval-buffer (C-c C-b) and - geiser-eval-buffer-and-go (C-c M-b), by Nick Parker. - - Pressing return on a previous expression in the REPL will resend - it, by Darren Hoo. - - Improvements to syntax highlighting (define/match in racket). - - Version checks for the underlying Scheme process, thanks to an - idea of B Batsov. - - Bug fixes: - - - Autodoc for Guile 2.0.9+'s subr fixed, thanks to Ludovic Courtès. - - Fixed problem when saving REPL history that contained non-ASCII - chars: all UTF-8 characters should be fair game now. - - Fixed problems with geiser-doc's history being handled by - session.el (by not letting the latter handle it). - - Paths in `geiser-load-path' are now also added to - `%load-compiled-path'. Ditto for paths added via - `geiser-add-to-load-path`. - - Compatibility fixes for Emacs snapshots. - -* Version 0.4 (May 2 2013) - - New features: - - - New command geiser-insert-lambda, bound to C-c \ in Scheme - buffers (thanks to Ray Racine). - - Configurable case-sensitivity when highlighting keywords (thanks - to Diogo F.S. Ramos), via geiser-guile-case-sensitive-p and - geiser-racket-case-sensitive-pp - - C-u C-x C-e to insert evaluation result in buffer (thanks to - Diogo). - - New flag geiser-repl-query-on-kill-p to control whether emacs - will ask for confirmation before killing a buffer with a live - REPL process. - - New flag geiser-mode-start-repl-p to tell Geiser to start a new - REPL if one isn't active when geiser-mode is activated. - - Bug fixes: - - - Filename completion should also work in emacs 23.2 now. - - Racket filenames with spaces no longer break Geiser when entering - them (thanks to Diogo). - - The REPL no longer hangs when company-mode is active (thanks to - Aleix Conchillo). - - Help manual lookup in Racket fixed for #lang racket/base modules. - -* Version 0.3 (Jan 19 2013) - - New features: - - - TAB in a string context in the REPL and Scheme buffers triggers - filename completion. - - User manual lookup command (C-c C-d i) available also in the - REPL. - - New REPL command, geiser-repl-clear-buffer (C-c M-o), to remove - all scheme output (thanks to Jonas Rodrigues). - - Indentation of scheme forms improved.. - - Bug fixes: - - - Racket: fixes for problems entering modules sans main.rkt. - - Racket: image support in Windows fixed. - -* Version 0.2.2 (Sep 30 2012) - - - ELPA support. We have now ELPA packages. Thanks to Grant Rettke - and Daniel Hackney. - -* Version 0.2.1 (Sep 15 2012) - - Bug fixes: - - - Racket: correctly reloading modules that contain submodules (this - one was breaking for instance code based on plai-typed). - - Racket: correctly jumping to symbols defined in files with .ss - extension. - - New features: - - - Racket: autodoc now displays argument names for constructors - defined by define-type (from either plai or plai-type). - - Racket: the included geiser-racket.sh script takes a new switch, - -n, to specify the network interface to listen to. - -* Version 0.2 (Sep 3 2012) - - New features: - - - Support for images in Racket, both in the REPL and during - evaluations. Thanks to Michael Wilber for code, discussion and - testing. - - Support for Racket 5.3. Older Rackets not actively supported. - - ,cd command in Racket's REPL. - - New customizable variable, geiser-guile-manual-lookup-nodes, to - specify the name of Guile's info nodes, if need be. - - Bug fixes: - - - We don't deactivate autodoc in the REPL unless requested. - - Indentation for syntax-id-rules and for/hash. - - Highlighting of [else forms in scheme buffers. - - Indentation for all 'for' forms in Racket. - - Correctly buttonizing paths with leading spaces in DBG buffers - - Autodoc was being deactivated in REPLs. - -* Version 0.1.4 (Nov 26 2011) - - New features: - - - Indentation for Racket's splicing-let and friends. - - Customizable prompt waiting time (geiser-repl-startup-time). - - New customizable faces: geiser-font-lock-repl-prompt and - geiser-font-lock-repl-input. - - Bug fixes: - - - C-c C-r and friends won't send unbalanced sexps to Scheme. - - C-c C-z works after run-geiser in a Scheme buffer. - - REPL: TAB indenting around whitespace. - - Racket: correct display of output to standard error (such as - rackunit's). - - Guile: ditto. - - Elisp: compatibility problems with filladapt fixed. - - Racket: autodoc in R5RS modules. - -* Version 0.1.3 (Jun 24 2011) - - Bug fixes: - - - The REPL doesn't break when one calls read (fixes bug #33090). - - In Guile buffers, C-c C-a (a.k.a C-u C-c C-z) recognizes the - current module even before the define-module form (fixes bug - #33497). - - Racket can now use the GUI libraries (see bug #32844). - - Texinfo formatting fixes. - -* Version 0.1.2 (Mar 9 2011) - - New features: - - - New C-c C-e C-l (or C-c C-r in REPL) to add a directory to - Scheme's load path. - - Guile 2.0 as lowest Guile version supported. - - New custom variable, geiser-guile-load-init-file-p, to allow - loading of ~/.guile. - - Bug fixes: - - - We no longer ignore geiser-repl-use-other-window. - - Company mode integration fixes (including #32231). - - M-x geiser-edit-module in REPL buffers fixed. - - We now respect user customizations of geiser-implementations-alist. - - Interaction with Guile's debugger fixed. - - "Clickable" paths in warnings buffer also for Guile 2.0. - - Fix for errors when entering r5rs modules in Racket. - -* Version 0.1.1 (Jan 24 2011) - - New features: - - - "Manual autodoc" command; C-c C-d s. - - Autodoc retrieval is now asynchronous, for better behaviour in - remote connections. - - New C-c C-a to switch to REPL and enter module (C-c C-Z was broken). - - Racket: ',enter "foo"' as a synonym of ',enter (file "foo")'. - - Documentation typos, and grammar and layout fixes. - - - Bug fixes: - - - Avoiding *spurious* buffers in case of communication errors. - - REPL: fixed problem with input history navigation in Racket. - - Autodoc no longer skips non-alphanumeric identifiers. - - Autodoc messages no longer interfere with active minibuffer. - - Fix for module name completion in Guile. - - Quack compatibility: avoiding problems with #f &c. - - -* Version 0.1 (Dec 20 2010) - - Initial release. diff --git a/elpa/geiser-0.30/readme.org b/elpa/geiser-0.30/readme.org @@ -1,224 +0,0 @@ -* Overview - - Geiser is a generic Emacs/Scheme interaction mode, featuring an - enhanced REPL and a set of minor modes improving Emacs' basic scheme - major mode. The main functionalities provided are: - - - Evaluation of forms in the namespace of the current module. - - Macro expansion. - - File/module loading. - - Namespace-aware identifier completion (including local bindings, - names visible in the current module, and module names). - - Autodoc: the echo area shows information about the signature of - the procedure/macro around point automatically. - - Jump to definition of identifier at point. - - Access to documentation (including docstrings when the - implementation provides it). - - Listings of identifiers exported by a given module. - - Listings of callers/callees of procedures. - - Rudimentary support for debugging (list of - evaluation/compilation error in an Emacs' compilation-mode - buffer). - - Support for inline images in schemes, such as Racket, that treat - them as first order values. - - If you're not in a hurry, [[http://www.nongnu.org/geiser/][Geiser's website]] contains a much nicer - manual. - -* Supported schemes - - Geiser needs Emacs 27.1 or better, and installing also at least one - of the supported scheme implementations. - - The following schemes are supported via an independent package, - installable from either NonGNU ELPA or MELPA: - - - Chez 9.4 or better, via [[https://gitlab.com/emacs-geiser/chez][geiser-chez]] - - Chibi 0.7.3 or better, via [[https://gitlab.com/emacs-geiser/chibi][geiser-chibi]] - - Chicken 4.8.0 or better, via [[https://gitlab.com/emacs-geiser/chicken][geiser-chicken]] - - Gambit 4.9.3 or better, via [[https://gitlab.com/emacs-geiser/gambit][geiser-gambit]] - - Gauche 0.9.6 or better, via [[https://gitlab.com/emacs-geiser/gauche][geiser-gauche]] - - Guile 2.2 or better, via [[https://gitlab.com/emacs-geiser/guile][geiser-guile]] - - Kawa 3.1, via [[https://gitlab.com/emacs-geiser/kawa][geiser-kawa]] - - MIT/GNU Scheme, via [[https://gitlab.com/emacs-geiser/mit][geiser-mit]] - - Racket 6.0 or better, via [[https://gitlab.com/emacs-geiser/racket][geiser-racket]] - - Stklos 1.50, via [[https://gitlab.com/emacs-geiser/stklos][geiser-stklos]] - -* Installation -*** Using ELPA - - Geiser is available in the ELPA repositories [[https://elpa.nongnu.org/nongnu/geiser.html][NonGNU ELPA]] - (pre-configured by default as a source starting in Emacs 28) and - MELPA. So the easiest way is to use the ELPA package, and just - type - - =M-x package-install RET geiser-<implementation>= - - inside emacs, or the corresponding =use-package= stanza, for, say - - #+begin_src emacs-lisp - (use-package geiser-mit :ensure t) - #+end_src - - All the concrete implementation packages depend on the base =geiser= - package, so it'll be installed for you. - -*** From a repository checkout - - If you are not using MELPA, just put this repository's ~elisp~ - directory and the target's scheme directory in your load path and - require the latter: - - #+begin_src emacs-lisp - (add-to-list 'load-path "<geiser checkout dir>/elisp") - (add-to-list 'load-path "<geiser-mit checkout dir>") - (require 'geiser-mit) - #+end_src - - Some scheme implementations need additional installation steps to - fully support all geiser operations, so please do check their - corresponding web pages. - -* Basic configuration - - When opening a scheme file, Geiser will try to guess its Scheme, - defaulting to the first in the list - =geiser-active-implementations=. If you've installed more than one - geiser package, you can also use =C-c C-s= to select the - implementation by hand (on a per file basis). - - Check the geiser customization group for some other options with: - - #+begin_example - M-x customize-group RET geiser RET - #+end_example - - In particular, customize =geiser-<impl>-binary=, which should point - to an executable in your path. - - To start a REPL, run =M-x geiser=. - -** Completion at point - - Geiser offers identifier and module name completion, bound to - =M-TAB= and =M-`= respectively. Only names visible in the current - module are offered. - - While that is cool and all, things are even better: if you have [[http://company-mode.github.io/][Company]] or - [[https://github.com/minad/corfu][Corfu]] installed, Geiser's completion will integrate with it. Just enable - global-company-mode/corfu-global-mode and, from then on, any new scheme - buffer or REPL will use it. Alternatively you can activate company-mode or - corfu-mode individually only in some buffers. - -** Macro expansion with macrostep-geiser - - Geiser offers basic macro expansion in a dedicated buffer. If you - prefer in-buffer, step by step expansion, please take a look at - Nikita Bloshchanevich's [[https://github.com/nbfalcon/macrostep-geiser][macrostep-geiser]]. - -* Quick key reference - - (See also [[http://geiser.nongnu.org/geiser_5.html#Cheat-sheet][the user's manual cheat sheet]]') - -** In Scheme buffers: - - | C-c C-s | Specify Scheme implementation for buffer | - | C-c C-z | Switch to REPL | - | C-c C-a | Switch to REPL and current module | - | M-. | Go to definition of identifier at point | - | M-, | Go back to where M-. was last invoked | - | C-c C-e m | Ask for a module and open its file | - | C-c C-e C-l | Add a given directory to Scheme's load path | - | C-c C-e [ | Toggle between () and [] for current form | - | c-c C-e \ | Insert λ | - | C-c C-i | Interrupt on-going evaluation | - | C-M-x | Eval definition around point | - | C-c C-c | Eval definition around point | - | C-c M-e | Eval definition around point and switch to REPL | - | C-x C-e | Eval sexp before point | - | C-c C-r | Eval region | - | C-c M-r | Eval region and switch to REPL | - | C-c C-b | Eval buffer | - | C-c M-b | Eval buffer and switch to REPL | - | C-c C-m x | Macro-expand definition around point | - | C-c C-m e | Macro-expand sexp before point | - | C-c C-m r | Macro-expand region | - | C-c C-k | Compile and load current buffer | - | C-c C-l | Load scheme file | - | C-u C-c C-k | Compile and load current buffer, restarting REPL | - | C-c C-d d | See documentation for identifier at point | - | C-c C-d s | See short documentation for identifier at point | - | C-c C-d i | Look up manual for identifier at point | - | C-c C-d m | See a list of a module's exported identifiers | - | C-c C-d a | Toggle autodoc mode | - | C-c < | Show callers of procedure at point | - | C-c > | Show callees of procedure at point | - | M-TAB | Complete identifier at point | - | M-`, C-. | Complete module name at point | - | TAB | Complete identifier at point or indent | - | | (If geiser-mode-smart-tab-p is t) | - -** In the REPL - - | C-c C-z | Start Scheme REPL, or jump to previous buffer | - | C-c M-o | Clear scheme output | - | C-c C-q | Kill Scheme process | - | C-c C-l | Load scheme file | - | C-c C-k | Nuke REPL: use it if the REPL becomes unresponsive | - | M-. | Edit identifier at point | - | TAB, M-TAB | Complete identifier at point | - | M-`, C-. | Complete module name at point | - | M-p, M-n | Prompt history, matching current prefix | - | C-c \ | Insert λ | - | C-c [ | Toggle between () and [] for current form | - | C-c C-m | Set current module | - | C-c C-i | Import module into current namespace | - | C-c C-r | Add a given directory to scheme's load path | - | C-c C-d C-d | See documentation for symbol at point | - | C-c C-d C-m | See documentation for module | - | C-c C-d C-a | Toggle autodoc mode | - -** In the documentation browser: - - | f | Next page | - | b | Previous page | - | TAB, n | Next link | - | S-TAB, p | Previous link | - | N | Next section | - | P | Previous section | - | k | Kill current page and go to previous or next | - | g, r | Refresh page | - | c | Clear browsing history | - | ., M-. | Edit identifier at point | - | z | Switch to REPL | - | q | Bury buffer | - -** In backtrace (evaluation/compile result) buffers: - - - =M-g n=, =M-g p=, =C-x `= for error location navigation. - - =n=, =p= for moving among errors in the buffer. - - =,= to pop-up the debugger actions menu. - - =q= to bury buffer. - -* How to support a new scheme implementation - Geiser works by running an instance of a REPL, or remotely - connecting to one, and evaluating the scheme code it sees - there. Then, every time it needs to perform some operation (like, - say, printing autodoc, jumping to a source location or expanding a - macro), it asks the running scheme instance for that information. - - So supporting a new scheme usually means writing a small scheme - library that provides that information on demand, and then some - standard elisp functions that invoke the procedures in that library. - - To see what elisp functions one needs to implement, just execute the - command `M-x geiser-implementation-help` inside emacs with a recent - version of geiser installed. And then take a look at, say, - [[https://gitlab.com/emacs-geiser/guile/-/blob/master/geiser-guile.el][geiser-guile.el]] for examples of how those functions are implemented - for concrete schemes. - - Not all schemes can provide introspective information to implement all - the functionality that geiser tries to offer. That is okay: you can - leave as many functions unimplemented as you see fit (there is even an - explicit list of unsupported features), and geiser will still know how - to use the ones that are implemented. diff --git a/elpa/geiser-guile-0.28.1.signed b/elpa/geiser-guile-0.28.1.signed @@ -1 +0,0 @@ -Good signature from 066DAFCB81E42C40 GNU ELPA Signing Agent (2019) <elpasign@elpa.gnu.org> (trust undefined) created at 2022-11-27T11:10:04+0100 using RSA -\ No newline at end of file diff --git a/elpa/geiser-guile-0.28.1/geiser-guile-autoloads.el b/elpa/geiser-guile-0.28.1/geiser-guile-autoloads.el @@ -1,38 +0,0 @@ -;;; geiser-guile-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 (file-name-directory load-file-name)) (car load-path))) - - - -;;; Generated autoloads from geiser-guile.el - -(autoload 'connect-to-guile "geiser-guile" "\ -Start a Guile REPL connected to a remote process. - -Start the external Guile process with the flag --listen to make -it spawn a server thread." t) -(geiser-activate-implementation 'guile) -(autoload 'run-guile "geiser-guile" "\ -Start a Geiser Guile REPL." t) -(autoload 'switch-to-guile "geiser-guile" "\ -Start a Geiser Guile REPL, or switch to a running one." t) -(register-definition-prefixes "geiser-guile" '("geiser-guile-" "guile")) - -;;; End of scraped data - -(provide 'geiser-guile-autoloads) - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; no-native-compile: t -;; coding: utf-8-emacs-unix -;; End: - -;;; geiser-guile-autoloads.el ends here diff --git a/elpa/geiser-guile-0.28.1/geiser-guile-pkg.el b/elpa/geiser-guile-0.28.1/geiser-guile-pkg.el @@ -1,2 +0,0 @@ -;; Generated package description from geiser-guile.el -*- no-byte-compile: t -*- -(define-package "geiser-guile" "0.28.1" "Guile and Geiser talk to each other" '((emacs "25.1") (transient "0.3") (geiser "0.28.1")) :commit "f57bfd5039ce158de95d2ef2933e64fb16def4f6" :authors '(("Jose Antonio Ortega Ruiz" . "jao@gnu.org")) :maintainer '("Jose Antonio Ortega Ruiz" . "jao@gnu.org") :keywords '("languages" "guile" "scheme" "geiser") :url "https://gitlab.com/emacs-geiser/guile") diff --git a/elpa/geiser-guile-0.28.1/geiser-guile.el b/elpa/geiser-guile-0.28.1/geiser-guile.el @@ -1,697 +0,0 @@ -;;; geiser-guile.el --- Guile and Geiser talk to each other -*- lexical-binding: t; -*- - -;; Copyright (C) 2009-2022 Jose Antonio Ortega Ruiz -;; Start date: Sun Mar 08, 2009 23:03 - -;; Author: Jose Antonio Ortega Ruiz (jao@gnu.org) -;; Maintainer: Jose Antonio Ortega Ruiz (jao@gnu.org) -;; Keywords: languages, guile, scheme, geiser -;; Homepage: https://gitlab.com/emacs-geiser/guile -;; Package-Requires: ((emacs "25.1") (transient "0.3") (geiser "0.28.1")) -;; SPDX-License-Identifier: BSD-3-Clause -;; Version: 0.28.1 - -;; This file is NOT part of GNU Emacs. - -;;; Commentary: - -;; This package extends the `geiser' core package to support GNU -;; Guile. - - -;;; Code: - -(require 'geiser-connection) -(require 'geiser-syntax) -(require 'geiser-custom) -(require 'geiser-repl) -(require 'geiser-debug) -(require 'geiser-impl) -(require 'geiser-base) -(require 'geiser-eval) -(require 'geiser-edit) -(require 'geiser-log) -(require 'geiser) - -(require 'transient) -(require 'compile) -(require 'info-look) - -(eval-when-compile - (require 'cl-lib) - (require 'tramp) - (require 'subr-x)) - - -;;; Customization - -(defgroup geiser-guile nil - "Customization for Geiser's Guile flavour." - :group 'geiser) - -(geiser-custom--defcustom geiser-guile-binary - (cond ((eq system-type 'windows-nt) "guile.exe") - ((eq system-type 'darwin) "guile") - (t "guile")) - "Name to use to call the Guile executable when starting a REPL." - :type '(choice string (repeat string))) - -(geiser-custom--defcustom geiser-guile-load-path nil - "A list of paths to be added to Guile's load path when it's started. -The paths are added to both %`load-path' and %load-compiled path, -and only if they are not already present. This variable is a -good candidate for an entry in your project's .dir-locals.el." - :type '(repeat file)) - -(geiser-custom--defcustom geiser-guile-init-file "~/.guile-geiser" - "Initialization file with user code for the Guile REPL. -If all you want is to load ~/.guile, set -`geiser-guile-load-init-file' instead." - :type 'string) - -(geiser-custom--defcustom geiser-guile-load-init-file nil - "Whether to load ~/.guile when starting Guile. -Note that, due to peculiarities in the way Guile loads its init -file, using `geiser-guile-init-file' is not equivalent to setting -this variable to t." - :type 'boolean) - -(define-obsolete-variable-alias - 'geiser-guile-load-init-file-p 'geiser-guile-load-init-file "0.26.2") - -(geiser-custom--defcustom geiser-guile-use-declarative-modules nil - "Whether Guile should use \"declarative\" modules limiting mutability. -When set to `t', Guile will enforce immutable bindings in -exported modules." - :type 'boolean - :link '(info-link "(guile) Declarative Modules")) - -(define-obsolete-variable-alias - 'geiser-guile-use-declarative-modules-p 'geiser-guile-use-declarative-modules - "0.26.2") - -(geiser-custom--defcustom geiser-guile-debug-backwards-backtrace t - "Whether to configure backtraces using the \\='backwards ordering." - :type 'boolean) - -(geiser-custom--defcustom geiser-guile-debug-terminal-width 999 - "Maximum number of columns shown in backtraces. -Normally, you'd want a big value here so that messages are not -truncated. Set to a negative value if you prefer that geiser -does not set it on startup." - :type 'integer) - -(geiser-custom--defcustom geiser-guile-debug-show-bt t - "Whether to automatically show a full backtrace when entering the debugger. -If nil, only the last frame is shown." - :type 'boolean) - -(define-obsolete-variable-alias - 'geiser-guile-debug-show-bt-p 'geiser-guile-debug-show-bt "0.26.2") - - -(geiser-custom--defcustom geiser-guile-debug-show-full-bt t - "Whether to show full backtraces in the debugger, including local variables." - :type 'boolean) - -(define-obsolete-variable-alias - 'geiser-guile-debug-show-full-bt-p 'geiser-guile-debug-show-full-bt "0.26.2") - - -(geiser-custom--defcustom geiser-guile-show-debug-help t - "Whether to show brief help in the echo area when entering the debugger." - :type 'boolean) - -(define-obsolete-variable-alias - 'geiser-guile-show-debug-help-p 'geiser-guile-show-debug-help "0.26.2") - -(geiser-custom--defcustom geiser-guile-warning-level 'medium - "Verbosity of the warnings reported by Guile. - -You can either choose one of the predefined warning sets, or -provide a list of symbols identifying the ones you want. Possible -choices are arity-mismatch, unbound-variable, unused-variable and -unused-toplevel. Unrecognised symbols are ignored. - -The predefined levels are: - - - Medium: arity-mismatch, unbound-variable, format - - High: arity-mismatch, unbound-variable, unused-variable, format - - None: no warnings - -Changes to the value of this variable will automatically take -effect on new REPLs. For existing ones, use the command -\\[geiser-guile-update-warning-level]." - :type '(choice (const :tag "Medium (arity and unbound vars)" medium) - (const :tag "High (also unused vars)" high) - (const :tag "No warnings" none) - (repeat :tag "Custom" symbol))) - -(geiser-custom--defcustom geiser-guile-extra-keywords nil - "Extra keywords highlighted in Guile scheme buffers." - :type '(repeat string)) - -(geiser-custom--defcustom geiser-guile-case-sensitive t - "Non-nil means keyword highlighting is case-sensitive." - :type 'boolean) - -(define-obsolete-variable-alias - 'geiser-guile-case-sensitive-p 'geiser-guile-case-sensitive "0.26.2") - -(geiser-custom--defcustom geiser-guile-manual-lookup-other-window nil - "Non-nil means pop up the Info buffer in another window." - :type 'boolean) - -(define-obsolete-variable-alias - 'geiser-guile-manual-lookup-other-window-p - 'geiser-guile-manual-lookup-other-window "0.26.2") - -(geiser-custom--defcustom geiser-guile-manual-lookup-nodes - '("Guile" "guile-2.0") - "List of info nodes that, when present, are used for manual lookups." - :type '(repeat string)) - - -;;; REPL support - -(defun geiser-guile--binary () - "Return the name of the Guile binary to execute." - (if (listp geiser-guile-binary) - (car geiser-guile-binary) - geiser-guile-binary)) - -(defvar geiser-guile-scheme-dir - (expand-file-name "src" (file-name-directory load-file-name)) - "Directory where the Guile scheme geiser modules are installed.") - -(defvar-local geiser-guile-scheme-local-dir - nil - "Location for scm files to communicate using REPL that are local to process. - -When using Tramp buffers, the guile modules are not local. They'll be stored in -this location for further cleanup.") - -(defun geiser-guile--remote-copy (source-path target-path) - "Copy source-path to target-path ensuring symlinks are resolved." - ;; when using `straight', guile scripts that need to be evaluated will be - ;; symlinks - ;; `copy-directory' will copy broken symlinks - ;; so we manually copy them to avoid broken symlinks in remote host - (cond ((file-symlink-p source-path) - (geiser-guile--remote-copy (file-truename source-path) target-path)) - ((file-directory-p source-path) - (unless (file-directory-p target-path) (make-directory target-path t)) - (let ((dest (file-name-as-directory target-path))) - (dolist (f (seq-difference (directory-files source-path) '("." ".."))) - (geiser-guile--remote-copy (expand-file-name f source-path) - (expand-file-name f dest))))) - (t (cl-assert (file-regular-p source-path)) - (copy-file source-path target-path)))) - -(defun geiser-guile-ensure-scheme-dir () - "Maybe setup and return dir for Guile scheme geiser modules. - -If using a remote Tramp buffer, this function will copy the modules to a -temporary location in the remote server and the return it. -Else, will just return `geiser-guile-scheme-dir'." - (cond ((not (and (fboundp 'tramp-tramp-file-p) - (tramp-tramp-file-p default-directory))) - geiser-guile-scheme-dir) - (geiser-guile-scheme-local-dir) ;; remote files are already there - (t - (let* ((temporary-file-directory (temporary-file-directory)) - (remote-temp-dir (make-temp-file "emacs-geiser-guile" t))) - (message "Setting up Tramp Guile REPL...") - (let ((inhibit-message t)) ;; prevent "Copying … to … " from dired - (geiser-guile--remote-copy - geiser-guile-scheme-dir - (concat (file-name-as-directory remote-temp-dir) - (file-name-nondirectory - (directory-file-name geiser-guile-scheme-dir))))) - ;; return the directory name as local to (remote) process - (setq geiser-guile-scheme-local-dir - (concat (file-name-as-directory - (file-local-name remote-temp-dir)) - (file-name-nondirectory geiser-guile-scheme-dir))))))) - -(defvar geiser-guile--conn-address nil) - -(defun geiser-guile--get-connection-address (&optional new) - "The path to the UNIX socket to talk to Guile in a connection. -Unused for now." - (when new - (setq geiser-guile--conn-address (make-temp-name "/tmp/geiser-guile-"))) - geiser-guile--conn-address) - -(defun geiser-guile--parameters () - "Return a list with all parameters needed to start Guile. -This function uses `geiser-guile-init-file' if it exists." - (let ((init-file (and (stringp geiser-guile-init-file) - (expand-file-name - (concat - (file-remote-p default-directory) - geiser-guile-init-file)))) - (c-flags (when geiser-guile--conn-address - `(,(format "--listen=%s" - (geiser-guile--get-connection-address t))))) - (q-flags (and (not geiser-guile-load-init-file) '("-q")))) - `(,@(and (listp geiser-guile-binary) (cdr geiser-guile-binary)) - ,@q-flags "-L" ,(geiser-guile-ensure-scheme-dir) ,@c-flags - ,@(apply 'append (mapcar (lambda (p) (list "-L" p)) - geiser-guile-load-path)) - ,@(and init-file (file-readable-p init-file) - (list "-l" (file-local-name init-file)))))) - -(defconst geiser-guile--prompt-regexp "^[^@(\n]+@([^)]*)> ") -(defconst geiser-guile--debugger-prompt-regexp - "^[^@(\n]+@([^)]*?) \\[\\([0-9]+\\)\\]> ") - -(defconst geiser-guile--clean-rx - (format "\\(%s\\)\\|\\(^\\$[0-9]+ = [^\n]+$\\)\\|%s" - (geiser-con--combined-prompt geiser-guile--prompt-regexp - geiser-guile--debugger-prompt-regexp) - "\\(\nEntering a new prompt. Type `,bt' for [^\n]+\\.$\\)")) - - -;;; Evaluation support -(defsubst geiser-guile--linearize-args (args) - "Concatenate the list ARGS." - (mapconcat 'identity args " ")) - -(defun geiser-guile--debug-cmd (args) - (let ((args (if (and geiser-guile-debug-show-full-bt - (string= (car args) "backtrace")) - '("backtrace" "#:full?" "#t") - args))) - (concat "," (geiser-guile--linearize-args args) "\n\"\""))) - -(defun geiser-guile--geiser-procedure (proc &rest args) - "Transform PROC in string for a scheme procedure using ARGS." - (cl-case proc - ((eval compile) (format ",geiser-eval %s %s%s" - (or (car args) "#f") - (geiser-guile--linearize-args (cdr args)) - (if (cddr args) "" " ()"))) - ((load-file compile-file) (format ",geiser-load-file %s" (car args))) - ((no-values) ",geiser-no-values") - ((debug) (geiser-guile--debug-cmd args)) - (t (format "ge:%s (%s)" proc (geiser-guile--linearize-args args))))) - -(defun geiser-guile--clean-up-output (str) - (let ((msg (when (string-match geiser-guile--debugger-prompt-regexp str) - (format "\n[Debugging level: %s]" (match-string 1 str))))) - (concat (replace-regexp-in-string geiser-guile--clean-rx "" str) msg))) - -(defconst geiser-guile--module-re - "(define-module +\\(([^)]+)\\)") - -(defconst geiser-guile--library-re - "(\\(?:define-\\)?library[[:blank:]\n]+\\(([^)]+)\\)") - -(defun geiser-guile--get-module (&optional module) - "Find current buffer's module using MODULE as a hint." - (cond ((null module) - (save-excursion - (geiser-syntax--pop-to-top) - (if (or (re-search-backward geiser-guile--module-re nil t) - (re-search-backward geiser-guile--library-re nil t) - (re-search-forward geiser-guile--module-re nil t) - (re-search-forward geiser-guile--library-re nil t)) - (geiser-guile--get-module (match-string-no-properties 1)) - :f))) - ((listp module) module) - ((stringp module) - (condition-case nil - (car (geiser-syntax--read-from-string module)) - (error :f))) - (t :f))) - -(defun geiser-guile--module-cmd (module fmt &optional def) - "Use FMT to format a change to MODULE, with default DEF." - (when module - (let* ((module (geiser-guile--get-module module)) - (module (cond ((or (null module) (eq module :f)) def) - (t (format "%s" module))))) - (and module (format fmt module))))) - -(defun geiser-guile--import-command (module) - "Format a REPL command to use MODULE." - (geiser-guile--module-cmd module ",use %s")) - -(defun geiser-guile--enter-command (module) - "Format a REPL command to enter MODULE." - (geiser-guile--module-cmd module ",m %s" "(guile-user)")) - - -(defun geiser-guile--exit-command () - "Format a REPL command to quit." - ",q") - -(defun geiser-guile--symbol-begin (module) - "Find beginning of symbol in the context of MODULE." - (if module - (max (save-excursion (beginning-of-line) (point)) - (save-excursion (skip-syntax-backward "^(>") (1- (point)))) - (save-excursion (skip-syntax-backward "^'-()>") (point)))) - - -;;; Compilation shell regexps - -(defconst geiser-guile--path-rx "^In \\([^:\n ]+\\):\n") - -(defconst geiser-guile--rel-path-rx "^In +\\([^/\n: ]+\\):\n") - -(defvar geiser-guile--file-cache (make-hash-table :test 'equal) - "Internal cache.") - -(defun geiser-guile--find-file (file) - (or (gethash file geiser-guile--file-cache) - (with-current-buffer (or geiser-debug--sender-buffer (current-buffer)) - (when-let (r geiser-repl--repl) - (with-current-buffer r - (geiser-eval--send/result `(:eval (:ge find-file ,file)))))))) - -(defun geiser-guile--resolve-file (file) - "Find the given FILE, if it's indeed a file." - (when (and (stringp file) - (not (member file - '("socket" "stdin" "unknown file" "current input")))) - (message "Resolving %s" file) - (cond ((file-name-absolute-p file) file) - (t (when-let (f (geiser-guile--find-file file)) - (puthash file f geiser-guile--file-cache)))))) - -(defun geiser-guile--resolve-file-x () - "Check if last match contain a resolvable file." - (let ((f (geiser-guile--resolve-file (match-string-no-properties 1)))) - (and (stringp f) (list f)))) - - -;;; Error display and debugger - -(defun geiser-guile--set-up-error-links () - (setq-local compilation-error-regexp-alist - `((,geiser-guile--path-rx geiser-guile--resolve-file-x) - ("^ +\\([0-9]+\\):\\([0-9]+\\)" nil 1 2) - ("^\\(/.*\\):\\([0-9]+\\):\\([0-9]+\\)" 1 2 3))) - (font-lock-add-keywords nil - `((,geiser-guile--path-rx 1 compilation-error-face)))) - -(defun geiser-guile-debug--send-dbg (thing) - (geiser-eval--send/wait (cons :debug (if (listp thing) thing (list thing))))) - -(defun geiser-guile-debug--debugger-display (thing ret) - (geiser-debug--display-retort (format ",%s" thing) - ret - (geiser-eval--retort-result-str ret nil))) - -(defun geiser-guile-debug--send-to-repl (thing) - (unless (geiser-debug-active-p) (error "Debugger not active")) - (save-window-excursion - (with-current-buffer geiser-debug--sender-buffer - (when-let (ret (geiser-guile-debug--send-dbg thing)) - (geiser-guile-debug--debugger-display thing ret))))) - -(defun geiser-guile-debug-quit () - "Quit the current debugging session level." - (interactive) - (geiser-guile-debug--send-to-repl 'quit)) - -(defun geiser-guile-debug-show-backtrace () - "Quit the current debugging session level." - (interactive) - (geiser-guile-debug--send-to-repl 'backtrace)) - -(defun geiser-guile-debug-show-locals () - "Show local variables." - (interactive) - (geiser-guile-debug--send-to-repl 'locals)) - -(defun geiser-guile-debug-show-registers () - "Show register values." - (interactive) - (geiser-guile-debug--send-to-repl 'registers)) - -(defun geiser-guile-debug-show-error () - "Show error message." - (interactive) - (geiser-guile-debug--send-to-repl 'error)) - -(transient-define-prefix geiser-guile--debug-transient () - "Debugging meta-commands." - ["Guile debugger" - [("n" "Next error" compilation-next-error) - ("p" "Previous error" compilation-next-error) - ("z" "Scheme buffer" geiser-debug-switch-to-buffer) - ("x" "Exit debug level" geiser-guile-debug-quit)] - [("b" "Show backtrace" geiser-guile-debug-show-backtrace) - ("e" "Show error" geiser-guile-debug-show-error) - ("l" "Show locals" geiser-guile-debug-show-locals) - ("r" "Show registers" geiser-guile-debug-show-registers)]]) - -(defun geiser-guile-debug-menu () - "Show available debugging commands, if any." - (interactive) - (when (and (eq 'guile geiser-impl--implementation) (geiser-debug-active-p)) - (call-interactively #'geiser-guile--debug-transient))) - -(define-key geiser-debug-mode-map "," #'geiser-guile-debug-menu) - -(defun geiser-guile--enter-debugger () - "Tell Geiser to interact with the debugger." - (when geiser-guile-show-debug-help - (message "Debugger active. Press , for commands.")) - nil) - -(defun geiser-guile--display-error (_module _key msg) - "Display error with given message MSG." - (when (stringp msg) - (geiser-guile--set-up-error-links) - (save-excursion (insert msg))) - (not (zerop (length msg)))) - - -;;; Trying to ascertain whether a buffer is Guile Scheme - -(defconst geiser-guile--guess-re - (format "\\(%s\\|#! *.+\\(/\\| \\)guile\\( *\\\\\\)?\\)" - geiser-guile--module-re)) - -(defun geiser-guile--guess () - "Ascertain whether we are in a Guile file." - (save-excursion - (goto-char (point-min)) - (re-search-forward geiser-guile--guess-re nil t))) - - -;;; Keywords and syntax - -(defconst geiser-guile--builtin-keywords - '("call-with-input-file" - "call-with-input-string" - "call-with-output-file" - "call-with-output-string" - "call-with-prompt" - "call-with-trace" - "define-accessor" - "define-class" - "define-enumeration" - "define-inlinable" - "define-syntax-parameter" - "eval-when" - "lambda*" - "syntax-parameterize" - "use-modules" - "with-error-to-file" - "with-error-to-port" - "with-error-to-string" - "with-fluid*" - "with-fluids" - "with-fluids*" - "with-input-from-port" - "with-input-from-string" - "with-output-to-port" - "with-output-to-string")) - -(defun geiser-guile--keywords () - "Return Guile-specific scheme keywords." - (append - (geiser-syntax--simple-keywords geiser-guile-extra-keywords) - (geiser-syntax--simple-keywords geiser-guile--builtin-keywords) - `((,(rx "(" (group "define-once") eow (* space) (? (group (+ word)))) - (1 font-lock-keyword-face) - (2 font-lock-variable-name-face nil t)) - ("(\\(define-module\\) +(\\([^)]+\\))" - (1 font-lock-keyword-face) - (2 font-lock-type-face nil t))))) - -(geiser-syntax--scheme-indent - (c-declare 0) - (c-lambda 2) - (call-with-input-string 1) - (call-with-output-string 0) - (call-with-prompt 1) - (call-with-trace 0) - (eval-when 1) - (lambda* 1) - (pmatch defun) - (sigaction 1) - (syntax-parameterize 1) - (with-error-to-file 1) - (with-error-to-port 1) - (with-error-to-string 0) - (with-fluid* 1) - (with-fluids 1) - (with-fluids* 1) - (with-input-from-string 1) - (with-method 1) - (with-mutex 1) - (with-output-to-string 0) - (with-throw-handler 1)) - - -;;; REPL startup - -(defconst geiser-guile-minimum-version "2.2") - -(defun geiser-guile--version (_binary) - "Find Guile's version running the configured Guile binary." - ;; maybe one day we'll have `process-lines' with tramp support - (let ((shell-command-switch "-c") - (shell-file-name "sh")) - (shell-command-to-string - (format "%s -c %s" - (geiser-guile--binary) - (shell-quote-argument "(display (version))"))))) - -(defun geiser-guile-update-warning-level () - "Update the warning level used by the REPL. -The new level is set using the value of `geiser-guile-warning-level'." - (interactive) - (let ((code `(:eval (:ge set-warnings ',geiser-guile-warning-level) - (geiser evaluation)))) - (geiser-eval--send/result code))) - -;;;###autoload -(defun connect-to-guile () - "Start a Guile REPL connected to a remote process. - -Start the external Guile process with the flag --listen to make -it spawn a server thread." - (interactive) - (geiser-connect 'guile)) - -(defun geiser-guile--set-geiser-load-path () - "Set up scheme load path for REPL." - (let* ((path (geiser-guile-ensure-scheme-dir)) - (witness "geiser/emacs.scm") - (code `(begin (if (not (%search-load-path ,witness)) - (set! %load-path (cons ,path %load-path))) - 'done))) - (geiser-eval--send/wait code))) - -(defun geiser-guile--set-up-declarative-modules () - "Set up Guile to (not) use declarative modules. -See `geiser-guile-use-declarative-modules'." - (unless geiser-guile-use-declarative-modules - (let ((code '(begin (eval-when (expand) (user-modules-declarative? :f)) 'ok))) - (geiser-eval--send/wait code)))) - -(defun geiser-guile--set-up-backtrace () - "Set up Guile's backtrace properties." - (when geiser-guile-debug-backwards-backtrace - (geiser-eval--send/wait '(debug-enable 'backwards))) - (when (> geiser-guile-debug-terminal-width 0) - (geiser-eval--send/wait `(begin ((@ (system repl debug) terminal-width) - ,geiser-guile-debug-terminal-width) - 'ok)))) - -(defun geiser-guile--startup (remote) - "Startup function, for a remote connection if REMOTE is t." - (geiser-guile--set-up-error-links) - (let ((geiser-log-verbose t) - (g-load-path (buffer-local-value 'geiser-guile-load-path - (or geiser-repl--last-scm-buffer - (current-buffer))))) - (when (or geiser-guile--conn-address remote) - (geiser-guile--set-geiser-load-path)) - (geiser-guile--set-up-declarative-modules) - (geiser-guile--set-up-backtrace) - (geiser-eval--send/wait ",use (geiser emacs)\n'done") - (dolist (dir g-load-path) - (let ((dir (expand-file-name dir))) - (geiser-eval--send/wait `(:eval (:ge add-to-load-path ,dir))))) - (geiser-guile-update-warning-level))) - - -;;; Manual lookup - -(defun geiser-guile--info-spec () - "Return info specification for given NODES." - (let* ((nrx "^[ ]+-+ [^:]+:[ ]*") - (drx "\\b") - (res (when (Info-find-file "r5rs" t) - `(("(r5rs)Index" nil ,nrx ,drx))))) - (dolist (node geiser-guile-manual-lookup-nodes res) - (when (Info-find-file node t) - (mapc (lambda (idx) - (add-to-list 'res - (list (format "(%s)%s" node idx) nil nrx drx))) - '("R5RS Index" "Concept Index" "Procedure Index" "Variable Index")))))) - -(info-lookup-add-help :topic 'symbol - :mode 'geiser-guile-mode - :ignore-case nil - :regexp "[^()`',\" \n]+" - :doc-spec (geiser-guile--info-spec)) - -(defun geiser-guile--info-lookup (id) - (cond ((null id) (info "guile")) - ((ignore-errors (info-lookup-symbol (format "%s" id) 'geiser-guile-mode) t)) - ((and (listp id) (geiser-guile--info-lookup (car (last id))))) - (t (geiser-guile--info-lookup (when (listp id) (butlast id)))))) - -(defun geiser-guile--manual-look-up (id _mod) - "Look for ID in the Guile manuals." - (let ((info-lookup-other-window-flag geiser-guile-manual-lookup-other-window)) - (geiser-guile--info-lookup id) - (when geiser-guile-manual-lookup-other-window - (switch-to-buffer-other-window "*info*")))) - - -;;; Implementation definition: - -(define-geiser-implementation guile - (binary geiser-guile--binary) - (arglist geiser-guile--parameters) - (version-command geiser-guile--version) - (minimum-version geiser-guile-minimum-version) - (repl-startup geiser-guile--startup) - (prompt-regexp geiser-guile--prompt-regexp) - (clean-up-output geiser-guile--clean-up-output) - (debugger-prompt-regexp geiser-guile--debugger-prompt-regexp) - (enter-debugger geiser-guile--enter-debugger) - (marshall-procedure geiser-guile--geiser-procedure) - (find-module geiser-guile--get-module) - (enter-command geiser-guile--enter-command) - (exit-command geiser-guile--exit-command) - (import-command geiser-guile--import-command) - (find-symbol-begin geiser-guile--symbol-begin) - (display-error geiser-guile--display-error) - (external-help geiser-guile--manual-look-up) - (check-buffer geiser-guile--guess) - (keywords geiser-guile--keywords) - (case-sensitive geiser-guile-case-sensitive)) - -;;;###autoload -(geiser-activate-implementation 'guile) - -;;;###autoload -(autoload 'run-guile "geiser-guile" "Start a Geiser Guile REPL." t) - -;;;###autoload -(autoload 'switch-to-guile "geiser-guile" - "Start a Geiser Guile REPL, or switch to a running one." t) - -(provide 'geiser-guile) -;;; geiser-guile.el ends here diff --git a/elpa/geiser-guile-0.28.1/geiser-guile.texi b/elpa/geiser-guile-0.28.1/geiser-guile.texi @@ -1,102 +0,0 @@ -\input texinfo @c -*- texinfo -*- -@c %**start of header -@setfilename geiser-guile.info -@settitle Geiser and Guile talk to each other -@documentencoding UTF-8 -@documentlanguage en -@c %**end of header - -@dircategory Emacs -@direntry -* Geiser Guile: (geiser-guile). Support for Guile in Geiser. -@end direntry - -@finalout -@titlepage -@title Geiser and Guile talk to each other -@author jao -@end titlepage - -@ifnottex -@node Top -@top Geiser and Guile talk to each other -@end ifnottex - -@menu -* Overview:: -* Start up:: -* Debugging support:: -* Tramp support:: -@end menu - -@node Overview -@unnumbered Overview - -This package provides support for using @uref{https://www.gnu.org/software/guile/, GNU Guile} in Emacs with -@uref{http://geiser.nongnu.org, Geiser}. - -Provided @uref{https://gitlab.com/emacs-geiser/geiser, geiser} is installed in your system, if this package's -directory is in your load path, just add @code{(require 'geiser-guile)} to -your initialisation files and then @code{M-x run-guile} to start a REPL@. -Scheme files with a Guile module declaration should be automatically -recognised as Guile-flavoured Geiser buffers. - -The easiest way of installing this package is using NonGNU Elpa or -MELPA@. If you're in Emacs 28 or higher, the former is already enabled -and all you need is the familiar - -@lisp -M-x install-package RET geiser-guile RET -@end lisp - -That will also install geiser, and its fine info manual. Please refer -to it (or its @uref{https://geiser.nongnu.org, online version}) for a general description of how geiser -schemes work. We provide below some additional details specific to -geiser-guile. - -@node Start up -@unnumbered Start up - -When launching the Guile REPL, geiser will invoke the binary -configured in @code{geiser-guile-binary} (simply "guile" by default) -which in turn will load @code{geiser-guile-init-file}, if any. - -Note, however, that specifying @code{geiser-guile-init-file} is @emph{not} -equivalent to changing Guile's initialization file (@samp{~/.guile}), -because the former is loaded using the @samp{-l} flag, together with @samp{-q} -to disable loading the second. But there are subtle differences -in the way Guile loads the initialization file versus how it loads -a file specified via the @samp{-l} flag. If what you want is just -loading @samp{~/.guile}, leave @code{geiser-guile-init-file} alone and set -@code{geiser-guile-load-init-file-p} to @code{t} instead. - -One can also provide a global list of paths to add to Guile's -@samp{%load-path} via @code{geiser-guile-load-path}. - -@node Debugging support -@unnumbered Debugging support - -Guile supports all the debugger commands supported by Geiser (it's -in fact used as the reference for the implementation and design of -that support). When the REPL would normally enter its debug mode, -with a prompt of the style: - -scheme@@(guile-user) [1]> - -showing a debugging level, Geiser will instead bring you to the -@samp{*Geiser Dbg*} buffer, where you can access a menu of debugging -commands via the @code{,} (comma) key. - -The geiser-guile customization group will show you, among many -other, a few flags fine-tuning interaction with the debugger, as -well as things like the detail level of error messages (e.g. via -@code{geiser-guile-warning-level}). - -@node Tramp support -@unnumbered Tramp support - -Geiser guile can be used remotely via tramp connections: the REPL -process will be run in the machine where the tramp-accessed file -lives. Implemented by Felipe Lema. - -@bye -\ No newline at end of file diff --git a/elpa/geiser-guile-0.28.1/license b/elpa/geiser-guile-0.28.1/license @@ -1,29 +0,0 @@ -BSD 3-Clause License - -Copyright (c) 2009, 2010, 2011, 2012, 2013, 2015, Jose Antonio Ortega Ruiz -All rights reserved. - -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions are met: - -* Redistributions of source code must retain the above copyright notice, this - list of conditions and the following disclaimer. - -* Redistributions in binary form must reproduce the above copyright notice, - this list of conditions and the following disclaimer in the documentation - and/or other materials provided with the distribution. - -* Neither the name of the copyright holder nor the names of its - contributors may be used to endorse or promote products derived from - this software without specific prior written permission. - -THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" -AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE -IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE -DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE -FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL -DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR -SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER -CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, -OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE -OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/elpa/geiser-guile-0.28.1/readme.org b/elpa/geiser-guile-0.28.1/readme.org @@ -1,71 +0,0 @@ -#+TITLE: Geiser and Guile talk to each other -#+OPTIONS: d:nil -#+EXPORT_FILE_NAME: geiser-guile.texi -#+TEXINFO_DIR_CATEGORY: Emacs -#+TEXINFO_DIR_TITLE: Geiser Guile: (geiser-guile). -#+TEXINFO_DIR_DESC: Support for Guile in Geiser - -* Overview - -This package provides support for using [[https://www.gnu.org/software/guile/][GNU Guile]] in Emacs with -[[http://geiser.nongnu.org][Geiser]]. - -Provided [[https://gitlab.com/emacs-geiser/geiser][geiser]] is installed in your system, if this package's -directory is in your load path, just add ~(require 'geiser-guile)~ to -your initialisation files and then ~M-x geiser-guile~ to start a REPL. -Scheme files with a Guile module declaration should be automatically -recognised as Guile-flavoured Geiser buffers. - -The easiest way of installing this package is using NonGNU Elpa or -MELPA. If you're in Emacs 28 or higher, the former is already enabled -and all you need is the familiar - -#+begin_src elisp - M-x install-package RET geiser-guile RET -#+end_src - -That will also install geiser, and its fine info manual. Please refer -to it (or its [[https://geiser.nongnu.org][online version]]) for a general description of how geiser -schemes work. We provide below some additional details specific to -geiser-guile. - -* Start up - - When launching the Guile REPL, geiser will invoke the binary - configured in ~geiser-guile-binary~ (simply "guile" by default) - which in turn will load ~geiser-guile-init-file~, if any. - - Note, however, that specifying ~geiser-guile-init-file~ is /not/ - equivalent to changing Guile's initialization file (=~/.guile=), - because the former is loaded using the =-l= flag, together with =-q= - to disable loading the second. But there are subtle differences - in the way Guile loads the initialization file versus how it loads - a file specified via the =-l= flag. If what you want is just - loading =~/.guile=, leave ~geiser-guile-init-file~ alone and set - ~geiser-guile-load-init-file~ to ~t~ instead. - - One can also provide a global list of paths to add to Guile's - =%load-path= via ~geiser-guile-load-path~. - -* Debugging support - - Guile supports all the debugger commands supported by Geiser (it's - in fact used as the reference for the implementation and design of - that support). When the REPL would normally enter its debug mode, - with a prompt of the style: - - scheme@(guile-user) [1]> - - showing a debugging level, Geiser will instead bring you to the - =*Geiser Dbg*= buffer, where you can access a menu of debugging - commands via the ~,~ (comma) key. - - The geiser-guile customization group will show you, among many - other, a few flags fine-tuning interaction with the debugger, as - well as things like the detail level of error messages (e.g. via - ~geiser-guile-warning-level~). - -* Tramp support - Geiser guile can be used remotely via tramp connections: the REPL - process will be run in the machine where the tramp-accessed file - lives. Implemented by Felipe Lema. diff --git a/elpa/geiser-guile-0.28.1/src/geiser/completion.scm b/elpa/geiser-guile-0.28.1/src/geiser/completion.scm @@ -1,27 +0,0 @@ -;;; completion.scm -- completing known symbols and module names - -;; Copyright (C) 2009, 2012 Jose Antonio Ortega Ruiz - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the Modified BSD License. You should -;; have received a copy of the license along with this program. If -;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>. - -;; Start date: Mon Mar 02, 2009 02:22 - -(define-module (geiser completion) - #:export (completions module-completions) - #:use-module (geiser utils) - #:use-module (geiser modules) - #:use-module (ice-9 session) - #:use-module (ice-9 regex)) - -(define (completions prefix) - (let ((prefix (string-append "^" (regexp-quote prefix)))) - (sort! (map symbol->string (apropos-internal prefix)) string<?))) - -(define (module-completions prefix) - (let* ((prefix (string-append "^" (regexp-quote prefix))) - (matcher (lambda (s) (string-match prefix s))) - (names (filter matcher (all-modules)))) - (sort! names string<?))) diff --git a/elpa/geiser-guile-0.28.1/src/geiser/doc.scm b/elpa/geiser-guile-0.28.1/src/geiser/doc.scm @@ -1,258 +0,0 @@ -;;; doc.scm -- procedures providing documentation on scheme objects - -;; Copyright (C) 2009, 2010, 2018 Jose Antonio Ortega Ruiz - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the Modified BSD License. You should -;; have received a copy of the license along with this program. If -;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>. - -;; Start date: Sun Feb 08, 2009 18:44 - -(define-module (geiser doc) - #:export (autodoc - symbol-documentation - module-exports - object-signature) - #:use-module (geiser utils) - #:use-module (geiser modules) - #:use-module (system vm program) - #:use-module (system vm debug) - #:use-module (ice-9 session) - #:use-module (ice-9 documentation) - #:use-module (ice-9 regex) - #:use-module (ice-9 format) - #:use-module (oop goops) - #:use-module (srfi srfi-1)) - -(define (autodoc ids) - (if (not (list? ids)) - '() - (map (lambda (id) (or (autodoc* id) (list id))) ids))) - -(define* (autodoc* id) - (let ((args (obj-args (symbol->object id)))) - (and args - `(,@(signature id args) - ("module" . ,(symbol-module id)))))) - -(define (object-signature name obj) - (let ((args (obj-args obj))) - (and args (signature name args)))) - -(define (value-str obj) - (format #f "~:@y" obj)) - -(define* (signature id args-list #:optional (detail #t)) - (define (arglst args kind) - (let ((args (assq-ref args kind))) - (cond ((or (not args) (null? args)) '()) - ((list? args) args) - (else (list args))))) - (define (mkargs as) - `(("required" ,@(arglst as 'required)) - ("optional" ,@(arglst as 'optional) - ,@(if (assq-ref as 'rest) (list "...") '())) - ("key" ,@(arglst as 'keyword)))) - (let* ((args-list (map mkargs (if (list? args-list) args-list '()))) - (value (and (and detail (null? args-list)) - (value-str (symbol->object id))))) - `(,id ("args" ,@args-list) ,@(if value `(("value" . ,value)) '())))) - -(define default-macro-args '(((required ...)))) - -(define geiser-args-key (gensym "geiser-args-key-")) - -(define (obj-args obj) - (cond ((not obj) #f) - ((or (procedure? obj) (program? obj)) - (cond ((procedure-property obj geiser-args-key)) - ((arguments obj) => - (lambda (args) - (set-procedure-property! obj geiser-args-key args) - args)) - (else #f))) - ((and (macro? obj) (macro-transformer obj)) => macro-args) - ((macro? obj) default-macro-args) - (else 'variable))) - -(define (program-arities prog) - (let ((addrs (program-address-range prog))) - (and (pair? addrs) (find-program-arities (car addrs))))) - -(define (arguments proc) - (define (p-args prog) - (let ((as (map arity-arguments-alist (or (program-arities prog) '())))) - (and (not (null? as)) as))) - (define (clist f) (lambda (x) (let ((y (f x))) (and y (list y))))) - (cond ((is-a? proc <generic>) (generic-args proc)) - ((doc->args proc) => list) - ((procedure-property proc 'arglist) => (clist arglist->args)) - ((procedure-source proc) => (clist source->args)) - ((and (program? proc) (p-args proc))) - ((procedure-property proc 'arity) => (clist arity->args)) - (else #f))) - -(define (source->args src) - (let ((formals (cadr src))) - (cond ((list? formals) `((required . ,formals))) - ((pair? formals) - `((required . ,(car formals)) (rest . ,(cdr formals)))) - (else #f)))) - -(define (macro-args tf) - (define* (collect args #:optional (req '())) - (cond ((null? args) (arglist->args `(,(reverse req) #f #f r #f))) - ((symbol? args) (arglist->args `(,(reverse req) #f #f r ,args))) - ((and (pair? args) (symbol? (car args))) - (collect (cdr args) (cons (car args) req))) - (else #f))) - (let* ((pats (procedure-property tf 'patterns)) - (args (and pats (filter-map collect pats)))) - (or (and args (not (null? args)) args) default-macro-args))) - -(define (arity->args art) - (define (gen-arg-names count) - (map (lambda (x) '_) (iota (max count 0)))) - (let ((req (car art)) - (opt (cadr art)) - (rest (caddr art))) - `(,@(if (> req 0) - (list (cons 'required (gen-arg-names req))) - '()) - ,@(if (> opt 0) - (list (cons 'optional (gen-arg-names opt))) - '()) - ,@(if rest (list (cons 'rest 'rest)) '())))) - -(define (arglist->args arglist) - `((required . ,(car arglist)) - (optional . ,(cadr arglist)) - (keyword . ,(caddr arglist)) - (rest . ,(car (cddddr arglist))))) - -(define (doc->args proc) - ;; Guile 2.0.9+ uses the (texinfo ...) modules to produce - ;; `guile-procedures.txt', and the output has a single hyphen, whereas - ;; `makeinfo' produces two hyphens. - (define proc-rx "--? Scheme Procedure: ([^[\n]+)\n") - (define proc-rx2 "--? Scheme Procedure: ([^[\n]+\\[[^\n]*(\n[^\n]+\\]+)?)") - (let ((doc (object-documentation proc))) - (and doc - (let ((match (or (string-match proc-rx doc) - (string-match proc-rx2 doc)))) - (and match - (parse-signature-string (match:substring match 1))))))) - -(define (parse-signature-string str) - (define opt-arg-rx "\\[([^] ]+)\\]?") - (define opt-arg-rx2 "([^ ])+\\]+") - (let ((tokens (string-tokenize str))) - (if (< (length tokens) 2) - '() - (let loop ((tokens (cdr tokens)) (req '()) (opt '()) (rest #f)) - (cond ((null? tokens) - `((required ,@(map string->symbol (reverse! req))) - (optional ,@(map string->symbol (reverse! opt))) - ,@(if rest - (list (cons 'rest (string->symbol rest))) - '()))) - ((string=? "." (car tokens)) - (if (not (null? (cdr tokens))) - (loop (cddr tokens) req opt (cadr tokens)) - (loop '() req opt "rest"))) - ((or (string-match opt-arg-rx (car tokens)) - (string-match opt-arg-rx2 (car tokens))) - => (lambda (m) - (loop (cdr tokens) - req - (cons (match:substring m 1) opt) - rest))) - (else (loop (cdr tokens) - (cons (car tokens) req) - opt - rest))))))) - -(define (generic-args gen) - (define (src> src1 src2) - (> (length (cadr src1)) (length (cadr src2)))) - (define (src m) - (catch #t - (lambda () (method-source m)) - (lambda (k . a) #f))) - (let* ((methods (generic-function-methods gen)) - (srcs (filter identity (map src methods)))) - (cond ((and (null? srcs) - (not (null? methods)) - (method-procedure (car methods))) => arguments) - ((not (null? srcs)) (list (source->args (car (sort! srcs src>))))) - (else '(((rest . rest))))))) - -(define (symbol-documentation sym) - (let ((obj (symbol->object sym))) - (if obj - `(("signature" . ,(or (obj-signature sym obj #f) sym)) - ("docstring" . ,(docstring sym obj)))))) - -(define (docstring sym obj) - (define (valuable?) - (not (or (macro? obj) (procedure? obj) (program? obj)))) - (with-output-to-string - (lambda () - (let* ((type (cond ((macro? obj) "A macro") - ((procedure? obj) "A procedure") - ((program? obj) "A compiled program") - (else "An object"))) - (modname (symbol-module sym)) - (doc (object-documentation obj))) - (display type) - (if modname - (begin - (display " in module ") - (display modname) - (display "."))) - (newline) - (if doc (begin (newline) (display doc))) - (if (valuable?) (begin (newline) - (display "Value:") - (newline) - (display " ") - (display (value-str obj)))))))) - -(define* (obj-signature sym obj #:optional (detail #t)) - (let ((args (obj-args obj))) - (and args (signature sym args detail)))) - -(define (module-exports mod-name) - (define elt-sort (make-symbol-sort car)) - (let* ((mod (catch #t - (lambda () (resolve-interface mod-name)) - (lambda args (resolve-module mod-name)))) - (elts (hash-fold classify-module-object - (list '() '() '()) - (module-obarray mod))) - (elts (map elt-sort elts)) - (subs (map (lambda (m) (list (module-name m))) - (submodules (resolve-module mod-name #f))))) - (list (cons "modules" subs) - (cons "procs" (car elts)) - (cons "syntax" (cadr elts)) - (cons "vars" (caddr elts))))) - -(define (classify-module-object name var elts) - (let ((obj (and (variable-bound? var) - (variable-ref var)))) - (cond ((or (not obj) (module? obj)) elts) - ((or (procedure? obj) (program? obj)) - (list (cons (list name `("signature" . ,(obj-signature name obj))) - (car elts)) - (cadr elts) - (caddr elts))) - ((macro? obj) - (list (car elts) - (cons (list name `("signature" . ,(obj-signature name obj))) - (cadr elts)) - (caddr elts))) - (else (list (car elts) - (cadr elts) - (cons (list name) (caddr elts))))))) diff --git a/elpa/geiser-guile-0.28.1/src/geiser/emacs.scm b/elpa/geiser-guile-0.28.1/src/geiser/emacs.scm @@ -1,60 +0,0 @@ -;;; emacs.scm -- procedures for emacs interaction: entry point - -;; Copyright (C) 2009, 2010, 2011 Jose Antonio Ortega Ruiz - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the Modified BSD License. You should -;; have received a copy of the license along with this program. If -;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>. - -;; Start date: Sun Feb 08, 2009 18:39 - -(define-module (geiser emacs) - #:use-module (ice-9 match) - #:use-module (system repl command) - #:use-module (system repl error-handling) - #:use-module (system repl server) - #:use-module (geiser evaluation) - #:use-module ((geiser modules) #:renamer (symbol-prefix-proc 'ge:)) - #:use-module ((geiser completion) #:renamer (symbol-prefix-proc 'ge:)) - #:use-module ((geiser xref) #:renamer (symbol-prefix-proc 'ge:)) - #:use-module ((geiser doc) #:renamer (symbol-prefix-proc 'ge:))) - -(define this-module (resolve-module '(geiser emacs))) - -(define-meta-command ((geiser-no-values geiser) repl) - "geiser-no-values -No-op command used internally by Geiser." - (values)) - -(define-meta-command ((geiser-newline geiser) repl) - "geiser-newline -Meta-command used by Geiser to emit a new line." - (newline)) - -(define-meta-command ((geiser-eval geiser) repl (mod form args) . rest) - "geiser-eval module form args () -Meta-command used by Geiser to evaluate and compile code." - (let ((args (syntax->datum args)) - (mod (syntax->datum mod))) - (if (null? args) - (call-with-error-handling - (lambda () (ge:compile form mod))) - (let ((proc (eval form this-module))) - (ge:eval `(,proc ,@args) mod))))) - -(define-meta-command ((geiser-load-file geiser) repl file) - "geiser-load-file file -Meta-command used by Geiser to load and compile files." - (call-with-error-handling - (lambda () (ge:compile-file file)))) - - -(define-meta-command ((geiser-start-server geiser) repl) - "geiser-start-server -Meta-command used by Geiser to start a REPL server." - (let* ((sock (make-tcp-server-socket #:port 0)) - (port (sockaddr:port (getsockname sock)))) - (spawn-server sock) - (write (list 'port port)) - (newline))) diff --git a/elpa/geiser-guile-0.28.1/src/geiser/evaluation.scm b/elpa/geiser-guile-0.28.1/src/geiser/evaluation.scm @@ -1,163 +0,0 @@ -;;; evaluation.scm -- evaluation, compilation and macro-expansion - -;; Copyright (C) 2009, 2010, 2011, 2013, 2015, 2022 Jose Antonio Ortega Ruiz - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the Modified BSD License. You should -;; have received a copy of the license along with this program. If -;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>. - -;; Start date: Mon Mar 02, 2009 02:46 - -(cond-expand - (guile-2.2 - (define-module (geiser evaluation) - #:export (ge:compile - ge:eval - ge:macroexpand - ge:compile-file - ge:load-file - ge:set-warnings - ge:add-to-load-path) - #:use-module (geiser modules) - #:use-module (srfi srfi-1) - #:use-module (language tree-il) - #:use-module (system base compile) - #:use-module (system base message) - #:use-module (system base pmatch) - #:use-module (system vm program) - #:use-module (ice-9 pretty-print) - #:use-module (ice-9 textual-ports) - #:use-module (system vm loader))) - (else - (define-module (geiser evaluation) - #:export (ge:compile - ge:eval - ge:macroexpand - ge:compile-file - ge:load-file - ge:set-warnings - ge:add-to-load-path) - #:use-module (geiser modules) - #:use-module (srfi srfi-1) - #:use-module (language tree-il) - #:use-module (system base compile) - #:use-module (system base message) - #:use-module (system base pmatch) - #:use-module (system vm program) - #:use-module (ice-9 pretty-print) - #:use-module (ice-9 textual-ports)))) - - -(define compile-opts '()) -(define compile-file-opts '()) - -(define default-warnings '(arity-mismatch unbound-variable format)) -(define verbose-warnings `(unused-variable ,@default-warnings)) - -(define (ge:set-warnings wl) - (let* ((warns (cond ((list? wl) wl) - ((symbol? wl) (case wl - ((none nil null) '()) - ((medium default) default-warnings) - ((high verbose) verbose-warnings) - (else '()))) - (else '()))) - (fwarns (if (memq 'unused-variable warns) - (cons 'unused-toplevel warns) - warns))) - (set! compile-opts (list #:warnings warns)) - (set! compile-file-opts (list #:warnings fwarns)))) - -(ge:set-warnings 'none) - -(define context-port #f) - -(define switcher-port - (make-soft-port (vector (lambda (c) (put-char c context-port)) - (lambda (s) (display s context-port)) - (lambda () (force-output context-port)) - (lambda () (close-port context-port)) - (lambda () 0)) - "w")) - -(define (call-with-switcher-output long-port thunk) - (let ((current (current-output-port))) - (parameterize ((current-output-port switcher-port)) - (dynamic-wind - (lambda () (set! context-port current)) - thunk - (lambda () (set! context-port long-port)))))) - -(define (call-with-result thunk) - (letrec* ((result #f) - (long-port (current-output-port)) - (run-thunk (lambda () (call-with-switcher-output long-port thunk))) - (output - (with-output-to-string - (lambda () - (with-fluids ((*current-warning-port* (current-output-port)) - (*current-warning-prefix* "")) - (with-error-to-port (current-output-port) - (lambda () - (set! result (map object->string (run-thunk)))))))))) - (write `((result ,@result) (output . ,output))) - (newline))) - -(define (ge:compile form module) - (compile* form module compile-opts)) - -(define (compile* form module-name opts) - (let* ((module (or (find-module module-name) (current-module))) - (ev (lambda () - (call-with-values - (lambda () - (let* ((to (cond-expand (guile-2.2 'bytecode) - (else 'objcode))) - (cf (cond-expand (guile-2.2 load-thunk-from-memory) - (else make-program))) - (o (compile form - #:to to - #:env module - #:opts opts)) - (thunk (cf o))) - (start-stack 'geiser-evaluation-stack - (eval `(,thunk) module)))) - (lambda vs vs))))) - (call-with-result ev))) - -(define (ge:eval form module-name) - (let* ((module (or (find-module module-name) (current-module))) - (ev (lambda () - (call-with-values - (lambda () (eval form module)) - (lambda vs vs))))) - (call-with-result ev))) - -(define (ge:compile-file path) - (call-with-result - (lambda () - (let ((cr (compile-file path - #:canonicalization 'absolute - #:opts compile-file-opts))) - (and cr - (list (object->string (save-module-excursion - (lambda () (load-compiled cr)))))))))) - -(define ge:load-file ge:compile-file) - -(define (ge:macroexpand form . all) - (let ((all (and (not (null? all)) (car all)))) - (with-output-to-string - (lambda () - (pretty-print (tree-il->scheme (macroexpand form))))))) - -(define (ge:add-to-load-path dir) - (and (file-is-directory? dir) - (let ((in-lp (member dir %load-path)) - (in-clp (member dir %load-compiled-path))) - (when (not in-lp) - (set! %load-path (cons dir %load-path))) - (when (not in-clp) - (set! %load-compiled-path (cons dir %load-compiled-path))) - (or in-lp in-clp)))) diff --git a/elpa/geiser-guile-0.28.1/src/geiser/modules.scm b/elpa/geiser-guile-0.28.1/src/geiser/modules.scm @@ -1,104 +0,0 @@ -;;; modules.scm -- module metadata - -;; Copyright (C) 2009, 2010, 2011, 2018 Jose Antonio Ortega Ruiz - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the Modified BSD License. You should -;; have received a copy of the license along with this program. If -;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>. - -;; Start date: Mon Mar 02, 2009 02:00 - -(define-module (geiser modules) - #:export (symbol-module - program-module - module-name? - module-path - find-module - all-modules - submodules - module-location) - #:use-module (geiser utils) - #:use-module (system vm program) - #:use-module (system vm debug) - #:use-module (ice-9 regex) - #:use-module (ice-9 session) - #:use-module (srfi srfi-1)) - -;; Return hash table mapping filename to list of modules defined in that -;; file. H/t andy wingo. -(define (fill-file->module-mapping! ret) - (define (record-module m) - (let ((f (module-filename m))) - (hash-set! ret f (cons m (hash-ref ret f '()))))) - (define (visit-module m) - (record-module m) - (hash-for-each (lambda (k v) (visit-module v)) - (module-submodules m))) - (visit-module (resolve-module '() #f)) - ret) - -(define file->modules (fill-file->module-mapping! (make-hash-table))) - -(define (program-file p) - (let ((src (program-source p 0))) - (and (pair? src) (cadr src)))) - -(define (program-module p) - (let* ((f (program-file p)) - (mods (or (hash-ref file->modules f) - (hash-ref (fill-file->module-mapping! file->modules) f)))) - (and (pair? mods) (not (null? mods)) (car mods)))) - -(define (module-name? module-name) - (and (list? module-name) - (not (null? module-name)) - (every symbol? module-name))) - -(define (symbol-module sym . all) - (and sym - (catch 'module-name - (lambda () - (apropos-fold (lambda (module name var init) - (if (eq? name sym) - (throw 'module-name (module-name module)) - init)) - #f - (regexp-quote (symbol->string sym)) - (if (or (null? all) (not (car all))) - (apropos-fold-accessible (current-module)) - apropos-fold-all))) - (lambda (key . args) - (and (eq? key 'module-name) (car args)))))) - -(define (module-location name) - (make-location (module-path name) #f)) - -(define (find-module mod-name) - (and (module-name? mod-name) - (resolve-module mod-name #f #:ensure #f))) - -(define (module-path module-name) - (and (module-name? module-name) - (or ((@@ (ice-9 session) module-filename) module-name) - (module-filename (resolve-module module-name #f))))) - -(define (submodules mod) - (hash-map->list (lambda (k v) v) (module-submodules mod))) - -(define (root-modules) - (submodules (resolve-module '() #f))) - -(define (all-modules) - (define (maybe-name m) - (and (module-kind m) (format #f "~A" (module-name m)))) - (let* ((guile (resolve-module '(guile))) - (roots (remove (lambda (m) (eq? m guile)) (root-modules))) - (children (append-map all-child-modules roots))) - (cons "(guile)" (filter-map maybe-name children)))) - -(define* (all-child-modules mod #:optional (seen '())) - (let ((cs (filter (lambda (m) (not (member m seen))) (submodules mod)))) - (fold (lambda (m all) (append (all-child-modules m all) all)) - (list mod) - cs))) diff --git a/elpa/geiser-guile-0.28.1/src/geiser/utils.scm b/elpa/geiser-guile-0.28.1/src/geiser/utils.scm @@ -1,52 +0,0 @@ -;;; utils.scm -- utility functions - -;; Copyright (C) 2009, 2010, 2011 Jose Antonio Ortega Ruiz - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the Modified BSD License. You should -;; have received a copy of the license along with this program. If -;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>. - -;; Start date: Mon Mar 02, 2009 01:48 - -(define-module (geiser utils) - #:export (make-location - symbol->object - pair->list - sort-symbols! - make-symbol-sort - gensym?) - #:use-module (ice-9 regex)) - -(define (symbol->object sym) - (and (symbol? sym) - (module-defined? (current-module) sym) - (module-ref (current-module) sym))) - -(define (pair->list pair) - (let loop ((d pair) (s '())) - (cond ((null? d) (reverse! s)) - ((symbol? d) (reverse! (cons d s))) - (else (loop (cdr d) (cons (car d) s)))))) - -(define (make-location file line) - (list (cons "file" (if (string? file) file '())) - (cons "line" (if (number? line) (+ 1 line) '())))) - -(define (sort-symbols! syms) - (let ((cmp (lambda (l r) - (string<? (symbol->string l) (symbol->string r))))) - (sort! syms cmp))) - -(define (make-symbol-sort sel) - (let ((cmp (lambda (a b) - (string<? (symbol->string (sel a)) - (symbol->string (sel b)))))) - (lambda (syms) - (sort! syms cmp)))) - -(define (gensym? sym) - (and (symbol? sym) (gensym-name? (format #f "~A" sym)))) - -(define (gensym-name? name) - (and (string-match "^#[{]" name) #t)) diff --git a/elpa/geiser-guile-0.28.1/src/geiser/xref.scm b/elpa/geiser-guile-0.28.1/src/geiser/xref.scm @@ -1,84 +0,0 @@ -;;; xref.scm -- cross-referencing utilities - -;; Copyright (C) 2009, 2010, 2020 Jose Antonio Ortega Ruiz - -;; This program is free software; you can redistribute it and/or -;; modify it under the terms of the Modified BSD License. You should -;; have received a copy of the license along with this program. If -;; not, see <http://www.xfree86.org/3.3.6/COPYRIGHT2.html#5>. - -;; Start date: Mon Mar 02, 2009 02:37 - -(define-module (geiser xref) - #:export (symbol-location - generic-methods - callers - callees - find-file) - #:use-module (geiser utils) - #:use-module (geiser modules) - #:use-module (geiser doc) - #:use-module (oop goops) - #:use-module (system xref) - #:use-module (system vm program)) - -(define (symbol-location sym) - (let ((obj (symbol->object sym))) - (cond ((program? obj) (program-location obj)) - ((symbol-module sym) => module-location) - (else '())))) - -(define (generic-methods sym) - (let* ((gen (symbol->object sym)) - (methods (if (is-a? gen <generic>) - (generic-function-methods gen) - '()))) - (filter (lambda (x) (not (null? x))) - (map (lambda (m) - (make-xref (method-procedure m) sym (symbol-module sym))) - methods)))) - -(define (make-xref proc name module) - (and proc - `(("location" . ,(or (program-location proc) (symbol-location name))) - ("signature" . ,(object-signature name proc)) - ("module" . ,(or module '()))))) - -(define (program-location p) - (cond ((not (program? p)) #f) - ((program-source p 0) => - (lambda (s) (make-location (program-path p) (source:line s)))) - ((program-path p) => (lambda (s) (make-location s #f))) - (else #f))) - -(define (program-path p) - (let* ((mod (program-module p)) - (name (and (module? mod) (module-name mod)))) - (and name (module-path name)))) - -(define (procedure-xref proc . mod-name) - (let* ((proc-name (or (procedure-name proc) '<anonymous>)) - (mod-name (if (null? mod-name) - (symbol-module proc-name) - (car mod-name)))) - (make-xref proc proc-name mod-name))) - -(define (callers sym) - (let ((mod (symbol-module sym #t))) - (and mod - (apply append (map (lambda (procs) - (map (lambda (proc) - (procedure-xref proc (car procs))) - (cdr procs))) - (procedure-callers (cons mod sym))))))) - -(define (callees sym) - (let ((obj (symbol->object sym))) - (and obj - (map procedure-xref (procedure-callees obj))))) - -(define (find-file path) - (let loop ((dirs %load-path)) - (if (null? dirs) #f - (let ((candidate (string-append (car dirs) "/" path))) - (if (file-exists? candidate) candidate (loop (cdr dirs))))))) diff --git a/elpa/request-0.3.3.signed b/elpa/request-0.3.3.signed @@ -1 +0,0 @@ -Good signature from 066DAFCB81E42C40 GNU ELPA Signing Agent (2019) <elpasign@elpa.gnu.org> (trust undefined) created at 2021-02-12T11:05:02+0100 using RSA -\ No newline at end of file diff --git a/elpa/request-0.3.3/.elpaignore b/elpa/request-0.3.3/.elpaignore @@ -1,3 +0,0 @@ -doc -tests -COPYING diff --git a/elpa/request-0.3.3/.github/workflows/test.yml b/elpa/request-0.3.3/.github/workflows/test.yml @@ -1,102 +0,0 @@ -name: CI - -on: - pull_request: - paths-ignore: - - '**.md' - - '**.markdown' - push: - paths-ignore: - - '**.md' - branches-ignore: - - 'master' - - 'main' - -jobs: - build: - runs-on: ${{ matrix.os }} - strategy: - matrix: - os: [ubuntu-latest, macos-latest] - emacs_version: [24.5, 25.3, 26.3, 27.1] - python_version: [2.7] - - steps: - - uses: actions/checkout@v1 - - - uses: actions/setup-python@v1 - with: - python-version: ${{ matrix.python_version }} - - - uses: purcell/setup-emacs@master - with: - version: ${{ matrix.emacs_version }} - - - uses: actions/cache@v1 - if: startsWith(runner.os, 'Linux') - with: - path: ~/.cache/pip - key: ${{ runner.os }}-pip-000 - - - uses: actions/cache@v1 - if: startsWith(runner.os, 'macOS') - with: - path: ~/Library/Caches/pip - key: ${{ runner.os }}-pip-000 - - - uses: actions/cache@v1 - with: - path: ~/local - key: ${{ runner.os }}-local-000 - - - uses: actions/cache@v1 - with: - path: ~/.emacs.d - key: emacs.d - - - uses: actions/cache@v1 - with: - path: ~/.cask - key: cask-000 - - - name: paths - run: | - echo "$HOME/local/bin" >> $GITHUB_PATH - echo "$HOME/local/cask/bin" >> $GITHUB_PATH - echo "$HOME/.local/bin" >> $GITHUB_PATH - echo "LD_LIBRARY_PATH=$HOME/.local/lib" >> $GITHUB_ENV - - - name: apt-get - if: startsWith(runner.os, 'Linux') - run: | - sudo apt-get -yq update - DEBIAN_FRONTEND=noninteractive sudo apt-get -yq install gnutls-bin sharutils gnupg2 dirmngr libreadline-dev libcurl4-openssl-dev virtualenv - - - name: gnupg - if: startsWith(runner.os, 'macOS') - run: brew list gnupg &>/dev/null || HOMEBREW_NO_AUTO_UPDATE=1 brew install gnupg - - - name: dependencies - run: | - pip install yq setuptools wheel - pip install Flask==1.0.2 tornado==5.1.1 - pip uninstall -y Werkzeug - pip install Werkzeug==0.14.1 - - - name: versions - run: | - curl --version - emacs --version - gpg --version - python --version - - - name: cask - run: | - sh tools/install-cask.sh - cask link list - - - name: test - run: | - make test-install - make test - continue-on-error: ${{ matrix.emacs_version == 'snapshot' }} diff --git a/elpa/request-0.3.3/Cask b/elpa/request-0.3.3/Cask @@ -1,8 +0,0 @@ -(source gnu) -(source melpa) - -(package-file "request.el") - -(development - (depends-on "ert") - (depends-on "deferred")) diff --git a/elpa/request-0.3.3/Makefile b/elpa/request-0.3.3/Makefile @@ -1,121 +0,0 @@ -export CASK ?= cask -export EMACS ?= $(shell which emacs) -export CASK_DIR := $(shell EMACS=$(EMACS) $(CASK) package-directory) - -PKBUILD=2.3 -TESTSSRC = $(shell ls tests/*.el) -ELCTESTS = $(TESTSSRC:.el=.elc) -.DEFAULT_GOAL := compile - -.PHONY: test -test: cask compile test-3 - -.PHONY: test-3 -test-3: test-3-tornado test-3-flask - -.PHONY: test-3-tornado -test-3-tornado: - EL_REQUEST_TEST_SERVER=tornado $(MAKE) test-2 - -.PHONY: test-3-flask -test-3-flask: - EL_REQUEST_TEST_SERVER=flask $(MAKE) test-2 - -.PHONY: test-2 -test-2: test-2-url-retrieve test-2-curl - -.PHONY: test-2-url-retrieve -test-2-url-retrieve: - EL_REQUEST_BACKEND=url-retrieve $(MAKE) test-1 - -.PHONY: test-2-curl -test-2-curl: - EL_REQUEST_BACKEND=curl $(MAKE) test-1 - -test-1: -# global-auto-revert-mode [github #132] - EL_REQUEST_NO_CAPTURE_MESSAGE=$(EL_REQUEST_NO_CAPTURE_MESSAGE) EL_REQUEST_MESSAGE_LEVEL=$(EL_REQUEST_MESSAGE_LEVEL) $(CASK) emacs -Q --batch -L . -L tests -l test-request.el --eval "(global-auto-revert-mode)" -f ert-run-tests-batch-and-exit - -.PHONY: cask -cask: $(CASK_DIR) -$(CASK_DIR): Cask - $(CASK) install - -.PHONY: compile -compile: cask - ! ($(CASK) eval \ - "(cl-letf (((symbol-function (quote cask-files)) (lambda (&rest _args) (mapcar (function symbol-name) (quote ($(TESTSSRC))))))) \ - (let ((byte-compile-error-on-warn t)) (cask-cli/build)))" 2>&1 | egrep -a "(Warning|Error):") ; (ret=$$? ; rm -f $(ELCTESTS) && exit $$ret) - ! ($(CASK) eval "(let ((byte-compile-error-on-warn t)) (cask-cli/build))" 2>&1 | egrep -a "(Warning|Error):") ; (ret=$$? ; $(CASK) clean-elc && exit $$ret) - -.PHONY: clean -clean: - $(CASK) clean-elc - make -C doc clean - - -.PHONY: dist-clean -dist-clean: - rm -rf dist - -.PHONY: dist -dist: dist-clean - $(CASK) package - -.PHONY: install -install: compile dist - $(EMACS) -Q --batch --eval "(package-initialize)" \ - --eval "(package-install-file \"dist/request-$(shell $(CASK) version).tar\")" - -define SET_GITHUB_REPOSITORY = -ifeq ($(GITHUB_REPOSITORY),) - GITHUB_REPOSITORY := $(shell git config user.name)/$(shell basename `git rev-parse --show-toplevel`) -endif -endef - -define SET_GITHUB_HEAD_REF = -ifeq ($(GITHUB_HEAD_REF),) -GITHUB_HEAD_REF := $(shell git rev-parse --abbrev-ref HEAD) -endif -endef - -define SET_GITHUB_SHA = -ifeq ($(GITHUB_SHA),) -GITHUB_SHA := $(shell if git show-ref --quiet --verify origin/$(GITHUB_HEAD_REF) ; then git rev-parse origin/$(GITHUB_HEAD_REF) ; fi) -endif -endef - -.PHONY: test-install-vars -test-install-vars: - $(eval $(call SET_GITHUB_REPOSITORY)) - $(eval $(call SET_GITHUB_HEAD_REF)) - $(eval $(call SET_GITHUB_SHA)) - @true - -.PHONY: test-install -test-install: test-install-vars - mkdir -p tests/test-install - if [ ! -s "tests/test-install/$(PKBUILD).tar.gz" ] ; then \ - cd tests/test-install ; curl -sLOk https://github.com/melpa/package-build/archive/$(PKBUILD).tar.gz ; fi - cd tests/test-install ; tar xfz $(PKBUILD).tar.gz - cd tests/test-install ; rm -f $(PKBUILD).tar.gz - cd tests/test-install/package-build-$(PKBUILD) ; make -s loaddefs - mkdir -p tests/test-install/recipes - cd tests/test-install/recipes ; curl -sfLOk https://raw.githubusercontent.com/melpa/melpa/master/recipes/request || cp -f ../../../tools/recipe ./request - ! ( $(EMACS) -Q --batch -L tests/test-install/package-build-$(PKBUILD) \ - --eval "(require 'package-build)" \ - --eval "(require 'subr-x)" \ - --eval "(package-initialize)" \ - --eval "(add-to-list 'package-archives '(\"melpa\" . \"http://melpa.org/packages/\"))" \ - --eval "(package-refresh-contents)" \ - --eval "(setq rcp (package-recipe-lookup \"request\"))" \ - --eval "(unless (file-exists-p package-build-archive-dir) \ - (make-directory package-build-archive-dir))" \ - --eval "(let* ((my-repo \"$(GITHUB_REPOSITORY)\") \ - (my-branch \"$(GITHUB_HEAD_REF)\") \ - (my-commit \"$(GITHUB_SHA)\")) \ - (oset rcp :repo my-repo) \ - (oset rcp :branch my-branch) \ - (oset rcp :commit my-commit))" \ - --eval "(package-build--package rcp (package-build--checkout rcp))" \ - --eval "(package-install-file (car (file-expand-wildcards (concat package-build-archive-dir \"request*.tar\"))))" 2>&1 | egrep -ia "error: |fatal" ) diff --git a/elpa/request-0.3.3/README.rst b/elpa/request-0.3.3/README.rst @@ -1,225 +0,0 @@ -|build-status| |melpa-badge| |melpa-stable-badge| - -==================================== - request.el -- an elisp HTTP library -==================================== - -Uses ``curl`` as its backend or emacs's native ``url.el`` library if ``curl`` is not found. - -The default encoding for requests is ``utf-8``. Please explicitly specify ``:encoding 'binary`` for binary data. - -Install -======= -As described in `Getting started`_, ensure melpa's whereabouts in ``init.el`` or ``.emacs``:: - - (add-to-list 'package-archives '("melpa" . "https://melpa.org/packages/")) - -Then - -:: - - M-x package-refresh-contents RET - M-x package-install RET request RET - -Alternatively, directly clone this repo and ``make install``. - -Examples -======== -GET: - -.. code:: emacs-lisp - - (request - "http://httpbin.org/get" - :params '(("key" . "value") ("key2" . "value2")) - :parser 'json-read - :success (cl-function - (lambda (&key data &allow-other-keys) - (message "I sent: %S" (assoc-default 'args data))))) - -POST: - -.. code:: emacs-lisp - - (request - "http://httpbin.org/post" - :type "POST" - :data '(("key" . "value") ("key2" . "value2")) - ;; :data "key=value&key2=value2" ; this is equivalent - :parser 'json-read - :success (cl-function - (lambda (&key data &allow-other-keys) - (message "I sent: %S" (assoc-default 'form data))))) - -Block until completion: - -.. code:: emacs-lisp - - (request - "http://httpbin.org/get" - :sync t - :complete (cl-function - (lambda (&key response &allow-other-keys) - (message "Done: %s" (request-response-status-code response))))) - -Curl authentication: - -.. code:: emacs-lisp - - (request - "http://httpbin.org/get" - :auth "digest" ;; or "basic", "anyauth", etc., which see curl(1) - :complete (cl-function - (lambda (&key response &allow-other-keys) - (message "Done: %s" (request-response-status-code response))))) - -Request binary data: - -.. code:: emacs-lisp - - (request - "http://httpbin.org/get" - :encoding 'binary - :complete (cl-function - (lambda (&key response &allow-other-keys) - (message "Done: %s" (request-response-status-code response))))) - -POST file (**WARNING**: it will send the contents of the current buffer!): - -.. code:: emacs-lisp - - (request - "http://httpbin.org/post" - :type "POST" - :files `(("current buffer" . ,(current-buffer)) - ("data" . ("data.csv" :data "1,2,3\n4,5,6\n"))) - :parser 'json-read - :success (cl-function - (lambda (&key data &allow-other-keys) - (message "I sent: %S" (assoc-default 'files data))))) - -Rich callback dispatch (like `jQuery.ajax`): - -.. code:: emacs-lisp - - (request - "http://httpbin.org/status/418" ; try other codes, for example: - ;; "http://httpbin.org/status/200" ; success callback will be called. - ;; "http://httpbin.org/status/400" ; you will see "Got 400." - :parser 'buffer-string - :success - (cl-function (lambda (&key data &allow-other-keys) - (when data - (with-current-buffer (get-buffer-create "*request demo*") - (erase-buffer) - (insert data) - (pop-to-buffer (current-buffer)))))) - :error - (cl-function (lambda (&rest args &key error-thrown &allow-other-keys) - (message "Got error: %S" error-thrown))) - :complete (lambda (&rest _) (message "Finished!")) - :status-code '((400 . (lambda (&rest _) (message "Got 400."))) - (418 . (lambda (&rest _) (message "Got 418."))))) - -Flexible PARSER option: - -.. code:: emacs-lisp - - (request - "https://github.com/tkf/emacs-request/commits/master.atom" - ;; Parse XML in response body: - :parser (lambda () (libxml-parse-xml-region (point) (point-max))) - :success (cl-function - (lambda (&key data &allow-other-keys) - ;; Just don't look at this function.... - (let ((get (lambda (node &rest names) - (if names - (apply get - (first (xml-get-children - node (car names))) - (cdr names)) - (first (xml-node-children node)))))) - (message "Latest commit: %s (by %s)" - (funcall get data 'entry 'title) - (funcall get data 'entry 'author 'name)))))) - -PUT JSON data: - -.. code:: emacs-lisp - - (request - "http://httpbin.org/put" - :type "PUT" - :data (json-encode '(("key" . "value") ("key2" . "value2"))) - :headers '(("Content-Type" . "application/json")) - :parser 'json-read - :success (cl-function - (lambda (&key data &allow-other-keys) - (message "I sent: %S" (assoc-default 'json data))))) - -PUT JSON data including non-ascii strings: - -.. code:: emacs-lisp - - (request - "http://httpbin.org/put" - :type "PUT" - :data (json-encode '(("key" . "値1") ("key2" . "値2"))) - :headers '(("Content-Type" . "application/json")) - :parser 'json-read - :encoding 'utf-8 - :success (cl-function - (lambda (&key data &allow-other-keys) - (message "I sent: %S" (assoc-default 'json data))))) - -Another PUT JSON example (nested JSON using alist structure, how to represent a boolean & how to selectively evaluate lisp): - -.. code:: emacs-lisp - - ;; (1) Prepend alist structure with a backtick (`) rather than single quote (') - ;; to allow elisp evaluation of selected elements prefixed with a comma (,) - ;; (2) This value is expected as a boolean so use the nil / t elisp alist denotation - ;; (3) The function will be evaluated as it has been prefixed with a comma (,) - (request - "http://httpbin.org/put" - :type "PUT" - :data (json-encode `(("jsonArray" . (("item1" . "value 1") ;; (1) - ("item2" . t) ;; (2) - ("item3" . ,(your-custom-elisp-function)))))) ;; (3) - :headers '(("Content-Type" . "application/json")) - :parser 'json-read - :success (cl-function - (lambda (&key data &allow-other-keys) - (message "I sent: %S" (assoc-default 'json data))))) - -GET with Unix domain socket data: - -.. code:: emacs-lisp - - (request - "http:/hello.txt" - :unix-socket "/tmp/app.sock" - :parser (lambda () (buffer-string)) - :success (cl-function - (lambda (&key data &allow-other-keys) - (message "Got: %s" data)))) - - -Legacy documentation -==================== -* `Github Pages <http://tkf.github.com/emacs-request/>` - -.. |build-status| - image:: https://secure.travis-ci.org/tkf/emacs-request.svg - ?branch=master - :target: http://travis-ci.org/tkf/emacs-request - :alt: Build Status -.. |melpa-badge| - image:: http://melpa.org/packages/request-badge.svg - :target: http://melpa.org/#/request - :alt: MELPA Badge -.. |melpa-stable-badge| - image:: http://stable.melpa.org/packages/request-badge.svg - :target: http://stable.melpa.org/#/request - :alt: MELPA Stable Badge -.. _Getting started: http://melpa.org/#/getting-started diff --git a/elpa/request-0.3.3/request-autoloads.el b/elpa/request-0.3.3/request-autoloads.el @@ -1,33 +0,0 @@ -;;; request-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 (file-name-directory load-file-name)) (car load-path))) - - - -;;; Generated autoloads from request.el - -(register-definition-prefixes "request" '("request-")) - - -;;; Generated autoloads from request-deferred.el - -(register-definition-prefixes "request-deferred" '("request-deferred")) - -;;; End of scraped data - -(provide 'request-autoloads) - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; no-native-compile: t -;; coding: utf-8-emacs-unix -;; End: - -;;; request-autoloads.el ends here diff --git a/elpa/request-0.3.3/request-deferred.el b/elpa/request-0.3.3/request-deferred.el @@ -1,71 +0,0 @@ -;;; request-deferred.el --- Wrap request.el by deferred -*- lexical-binding: t; -*- - -;; Copyright (C) 2012 Takafumi Arakaki - -;; Author: Takafumi Arakaki <aka.tkf at gmail.com> -;; URL: https://github.com/tkf/emacs-request -;; Package-Requires: ((deferred "0.3.1") (request "0.2.0")) -;; Version: 0.2.0 - -;; This file is NOT part of GNU Emacs. - -;; request-deferred.el is free software: you can 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. - -;; request-deferred.el is distributed in the hope that it will be useful, -;; but WITHOUT 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 request-deferred.el. -;; If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; - -;;; Code: - -(require 'request) -(require 'deferred) - -(defun request-deferred (url &rest args) - "Send a request and return deferred object associated with it. - -Following deferred callback takes a response object regardless of -the response result. To make sure no error occurs during the -request, check `request-response-error-thrown'. - -Arguments are the same as `request', but COMPLETE callback cannot -be used as it is used for starting deferred callback chain. - -Example:: - - (require 'request-deferred) - - (deferred:$ - (request-deferred \"http://httpbin.org/get\" :parser 'json-read) - (deferred:nextc it - (lambda (response) - (message \"Got: %S\" (request-response-data response))))) -" - - (let* ((d (deferred:new #'identity)) - (callback-post (apply-partially - (lambda (d &rest args) - (deferred:callback-post - d (plist-get args :response))) - d))) - ;; As `deferred:errorback-post' requires an error object to be - ;; posted, use `deferred:callback-post' for success and error - ;; cases. - (setq args (plist-put args :complete callback-post)) - (apply #'request url args) - d)) - -(provide 'request-deferred) - -;;; request-deferred.el ends here diff --git a/elpa/request-0.3.3/request-pkg.el b/elpa/request-0.3.3/request-pkg.el @@ -1,2 +0,0 @@ -;; Generated package description from request.el -*- no-byte-compile: t -*- -(define-package "request" "0.3.3" "Compatible layer for URL request in Emacs" '((emacs "24.4")) :authors '(("Takafumi Arakaki <aka.tkf at gmail.com>")) :maintainer '("Takafumi Arakaki <aka.tkf at gmail.com>") :url "https://github.com/tkf/emacs-request") diff --git a/elpa/request-0.3.3/request.el b/elpa/request-0.3.3/request.el @@ -1,1260 +0,0 @@ -;;; request.el --- Compatible layer for URL request in Emacs -*- lexical-binding: t; -*- - -;; Copyright (C) 2012 Takafumi Arakaki -;; Copyright (C) 1985-1986, 1992, 1994-1995, 1999-2012 -;; Free Software Foundation, Inc. - -;; Author: Takafumi Arakaki <aka.tkf at gmail.com> -;; URL: https://github.com/tkf/emacs-request -;; Package-Requires: ((emacs "24.4")) -;; Version: 0.3.3 - -;; This file is NOT part of GNU Emacs. - -;; request.el is free software: you can 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. - -;; request.el is distributed in the hope that it will be useful, -;; but WITHOUT 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 request.el. -;; If not, see <http://www.gnu.org/licenses/>. - -;;; Commentary: - -;; Request.el is a HTTP request library with multiple backends. It -;; supports url.el which is shipped with Emacs and curl command line -;; program. User can use curl when s/he has it, as curl is more reliable -;; than url.el. Library author can use request.el to avoid imposing -;; external dependencies such as curl to users while giving richer -;; experience for users who have curl. - -;; Following functions are adapted from GNU Emacs source code. -;; Free Software Foundation holds the copyright of them. -;; * `request--process-live-p' -;; * `request--url-default-expander' - -;;; Code: - -(eval-when-compile - (defvar url-http-method) - (defvar url-http-response-status)) - -(require 'cl-lib) -(require 'url) -(require 'mail-utils) -(require 'autorevert) -(require 'auth-source) - -(defgroup request nil - "Compatible layer for URL request in Emacs." - :group 'comm - :prefix "request-") - -(defconst request-version "0.3.3") - -(defcustom request-storage-directory - (concat (file-name-as-directory user-emacs-directory) "request") - "Directory to store data related to request.el." - :type 'directory) - -(defcustom request-curl "curl" - "Executable for curl command." - :type 'string) - -(defcustom request-curl-options nil - "curl command options. - -List of strings that will be passed to every curl invocation. You can pass -extra options here, like setting the proxy." - :type '(repeat string)) - -(defcustom request-backend (if (executable-find request-curl) - 'curl - 'url-retrieve) - "Backend to be used for HTTP request. -Automatically set to `curl' if curl command is found." - :type '(choice (const :tag "cURL backend" curl) - (const :tag "url-retrieve backend" url-retrieve))) - -(defcustom request-timeout nil - "Default request timeout in second. -`nil' means no timeout." - :type '(choice (integer :tag "Request timeout seconds") - (boolean :tag "No timeout" nil))) - -(make-obsolete-variable 'request-temp-prefix nil "0.3.3") - -(defcustom request-log-level -1 - "Logging level for request. -One of `error'/`warn'/`info'/`verbose'/`debug'/`trace'/`blather'. --1 means no logging." - :type '(choice (integer :tag "No logging" -1) - (const :tag "Level error" error) - (const :tag "Level warn" warn) - (const :tag "Level info" info) - (const :tag "Level Verbose" verbose) - (const :tag "Level DEBUG" debug) - (const :tag "Level TRACE" trace) - (const :tag "Level BLATHER" blather))) - -(defcustom request-message-level 'warn - "Logging level for request. -See `request-log-level'." - :type '(choice (integer :tag "No logging" -1) - (const :tag "Level error" error) - (const :tag "Level warn" warn) - (const :tag "Level info" info) - (const :tag "Level Verbose" verbose) - (const :tag "Level DEBUG" debug) - (const :tag "Level TRACE" trace) - (const :tag "Level BLATHER" blather))) - - -;;; Utilities - -(defun request--safe-apply (function &rest arguments) - "Apply FUNCTION with ARGUMENTS, suppressing any errors." - (condition-case nil - (apply #'apply function arguments) - ((debug error)))) - -(defun request--safe-call (function &rest arguments) - (request--safe-apply function arguments)) - -;; (defun request--url-no-cache (url) -;; "Imitate `cache=false' of `jQuery.ajax'. -;; See: http://api.jquery.com/jQuery.ajax/" -;; ;; FIXME: parse URL before adding ?_=TIME. -;; (concat url (format-time-string "?_=%s"))) - -(defmacro request--document-function (function docstring) - "Document FUNCTION with DOCSTRING. Use this for defstruct accessor etc." - (declare (indent defun) - (doc-string 2)) - `(put ',function 'function-documentation ,docstring)) - -(defun request--process-live-p (process) - "Copied from `process-live-p' for backward compatibility (Emacs < 24). -Adapted from lisp/subr.el. -FSF holds the copyright of this function: - Copyright (C) 1985-1986, 1992, 1994-1995, 1999-2012 - Free Software Foundation, Inc." - (memq (process-status process) '(run open listen connect stop))) - - -;;; Logging - -(defconst request--log-level-def - '(;; debugging - (blather . 60) (trace . 50) (debug . 40) - ;; information - (verbose . 30) (info . 20) - ;; errors - (warn . 10) (error . 0)) - "Named logging levels.") - -(defun request--log-level-as-int (level) - (if (integerp level) - level - (or (cdr (assq level request--log-level-def)) - 0))) - -(defvar request-log-buffer-name " *request-log*") - -(defun request--log-buffer () - (get-buffer-create request-log-buffer-name)) - -(defmacro request-log (level fmt &rest args) - (declare (indent 1)) - `(let ((level (request--log-level-as-int ,level)) - (log-level (request--log-level-as-int request-log-level)) - (msg-level (request--log-level-as-int request-message-level))) - (when (<= level (max log-level msg-level)) - (let ((msg (format "[%s] %s" ,level - (condition-case err - (format ,fmt ,@args) - (error (format " -!!! Logging error while executing: -%S -!!! Error: -%S" - ',args err)))))) - (when (<= level log-level) - (with-current-buffer (request--log-buffer) - (setq buffer-read-only t) - (let ((inhibit-read-only t)) - (goto-char (point-max)) - (insert msg "\n")))) - (when (<= level msg-level) - (message "%s" msg)))))) - - -;;; HTTP specific utilities - -(defconst request--url-unreserved-chars - '(?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z - ?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z - ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9 - ?- ?_ ?. ?~) - "`url-unreserved-chars' copied from Emacs 24.3 release candidate. -This is used for making `request--urlencode-alist' RFC 3986 compliant -for older Emacs versions.") - -(defun request--urlencode-alist (alist) - ;; FIXME: make monkey patching `url-unreserved-chars' optional - (let ((url-unreserved-chars request--url-unreserved-chars)) - (cl-loop for sep = "" then "&" - for (k . v) in alist - concat sep - concat (url-hexify-string (format "%s" k)) - concat "=" - concat (url-hexify-string (format "%s" v))))) - - -;;; Header parser - -(defun request--parse-response-at-point () - "Parse the first header line such as \"HTTP/1.1 200 OK\"." - (when (re-search-forward "\\=[ \t\n]*HTTP/\\([0-9\\.]+\\) +\\([0-9]+\\)" nil t) - (list :version (match-string 1) - :code (string-to-number (match-string 2))))) - -(defun request--goto-next-body (&optional noerror) - (re-search-forward "^\r\n" nil noerror)) - - -;;; Response object - -(cl-defstruct request-response - "A structure holding all relevant information of a request." - status-code history data error-thrown symbol-status url - done-p settings - ;; internal variables - -buffer -raw-header -timer -backend) - -(defmacro request--document-response (function docstring) - (declare (indent defun) - (doc-string 2)) - `(request--document-function ,function ,(concat docstring " - -.. This is an accessor for `request-response' object. - -\(fn RESPONSE)"))) - -(request--document-response request-response-status-code - "Integer HTTP response code (e.g., 200).") - -(request--document-response request-response-history - "Redirection history (a list of response object). -The first element is the oldest redirection. - -You can use restricted portion of functions for the response -objects in the history slot. It also depends on backend. Here -is the table showing what functions you can use for the response -objects in the history slot. - -==================================== ============== ============== -Slots Backends ------------------------------------- ----------------------------- -\\ curl url-retrieve -==================================== ============== ============== -request-response-url yes yes -request-response-header yes no -other functions no no -==================================== ============== ============== -") - -(request--document-response request-response-data - "Response parsed by the given parser.") - -(request--document-response request-response-error-thrown - "Error thrown during request. -It takes the form of ``(ERROR-SYMBOL . DATA)``, which can be -re-raised (`signal'ed) by ``(signal ERROR-SYMBOL DATA)``.") - -(request--document-response request-response-symbol-status - "A symbol representing the status of request (not HTTP response code). -One of success/error/timeout/abort/parse-error.") - -(request--document-response request-response-url - "Final URL location of response.") - -(request--document-response request-response-done-p - "Return t when the request is finished or aborted.") - -(request--document-response request-response-settings - "Keyword arguments passed to `request' function. -Some arguments such as HEADERS is changed to the one actually -passed to the backend. Also, it has additional keywords such -as URL which is the requested URL.") - -(defun request-response-header (response field-name) - "Fetch the values of RESPONSE header field named FIELD-NAME. - -It returns comma separated values when the header has multiple -field with the same name, as :RFC:`2616` specifies. - -Examples:: - - (request-response-header response - \"content-type\") ; => \"text/html; charset=utf-8\" - (request-response-header response - \"unknown-field\") ; => nil -" - (let ((raw-header (request-response--raw-header response))) - (when raw-header - (with-temp-buffer - (erase-buffer) - (insert raw-header) - ;; ALL=t to fetch all fields with the same name to get comma - ;; separated value [#rfc2616-sec4]_. - (mail-fetch-field field-name nil t))))) -;; .. [#rfc2616-sec4] RFC2616 says this is the right thing to do -;; (see http://tools.ietf.org/html/rfc2616.html#section-4.2). -;; Python's requests module does this too. - - -;;; Backend dispatcher - -(defconst request--backend-alist - '((url-retrieve - . ((request . request--url-retrieve) - (request-sync . request--url-retrieve-sync) - (terminate-process . delete-process) - (get-cookies . request--url-retrieve-get-cookies))) - (curl - . ((request . request--curl) - (request-sync . request--curl-sync) - (terminate-process . interrupt-process) - (get-cookies . request--curl-get-cookies)))) - "Map backend and method name to actual method (symbol). - -It's alist of alist, of the following form:: - - ((BACKEND . ((METHOD . FUNCTION) ...)) ...) - -It would be nicer if I can use EIEIO. But as CEDET is included -in Emacs by 23.2, using EIEIO means abandon older Emacs versions. -It is probably necessary if I need to support more backends. But -let's stick to manual dispatch for now.") -;; See: (view-emacs-news "23.2") - -(defun request--choose-backend (method) - "Return `fucall'able object for METHOD of current `request-backend'." - (assoc-default - method - (or (assoc-default request-backend request--backend-alist) - (error "%S is not valid `request-backend'." request-backend)))) - - -;;; Cookie - -(defun request-cookie-string (host &optional localpart secure) - "Return cookie string (like `document.cookie'). - -Example:: - - (request-cookie-string \"127.0.0.1\" \"/\") ; => \"key=value; key2=value2\" -" - (mapconcat (lambda (nv) (concat (car nv) "=" (cdr nv))) - (request-cookie-alist host localpart secure) - "; ")) - -(defun request-cookie-alist (host &optional localpart secure) - "Return cookies as an alist. - -Example:: - - (request-cookie-alist \"127.0.0.1\" \"/\") ; => ((\"key\" . \"value\") ...) -" - (funcall (request--choose-backend 'get-cookies) host localpart secure)) - - -;;; Main - -(cl-defun request-default-error-callback (url &key symbol-status - &allow-other-keys) - (request-log 'error - "request-default-error-callback: %s %s" url symbol-status)) - -(cl-defun request (url &rest settings - &key - (params nil) - (data nil) - (headers nil) - (encoding 'utf-8) - (error nil) - (sync nil) - (response (make-request-response)) - &allow-other-keys) - "Send request to URL. - -Request.el has a single entry point. It is `request'. - -==================== ======================================================== -Keyword argument Explanation -==================== ======================================================== -TYPE (string) type of request to make: POST/GET/PUT/DELETE -PARAMS (alist) set \"?key=val\" part in URL -DATA (string/alist) data to be sent to the server -FILES (alist) files to be sent to the server (see below) -PARSER (symbol) a function that reads current buffer and return data -HEADERS (alist) additional headers to send with the request -ENCODING (symbol) encoding for request body (utf-8 by default) -SUCCESS (function) called on success -ERROR (function) called on error -COMPLETE (function) called on both success and error -TIMEOUT (number) timeout in second -STATUS-CODE (alist) map status code (int) to callback -SYNC (bool) If `t', wait until request is done. Default is `nil'. -==================== ======================================================== - - -* Callback functions - -Callback functions STATUS, ERROR, COMPLETE and `cdr's in element of -the alist STATUS-CODE take same keyword arguments listed below. For -forward compatibility, these functions must ignore unused keyword -arguments (i.e., it's better to use `&allow-other-keys' [#]_).:: - - (CALLBACK ; SUCCESS/ERROR/COMPLETE/STATUS-CODE - :data data ; whatever PARSER function returns, or nil - :error-thrown error-thrown ; (ERROR-SYMBOL . DATA), or nil - :symbol-status symbol-status ; success/error/timeout/abort/parse-error - :response response ; request-response object - ...) - -.. [#] `&allow-other-keys' is a special \"markers\" available in macros - in the CL library for function definition such as `cl-defun' and - `cl-function'. Without this marker, you need to specify all arguments - to be passed. This becomes problem when request.el adds new arguments - when calling callback functions. If you use `&allow-other-keys' - (or manually ignore other arguments), your code is free from this - problem. See info node `(cl) Argument Lists' for more information. - -Arguments data, error-thrown, symbol-status can be accessed by -`request-response-data', `request-response-error-thrown', -`request-response-symbol-status' accessors, i.e.:: - - (request-response-data RESPONSE) ; same as data - -Response object holds other information which can be accessed by -the following accessors: -`request-response-status-code', -`request-response-url' and -`request-response-settings' - -* STATUS-CODE callback - -STATUS-CODE is an alist of the following format:: - - ((N-1 . CALLBACK-1) - (N-2 . CALLBACK-2) - ...) - -Here, N-1, N-2,... are integer status codes such as 200. - - -* FILES - -FILES is an alist of the following format:: - - ((NAME-1 . FILE-1) - (NAME-2 . FILE-2) - ...) - -where FILE-N is a list of the form:: - - (FILENAME &key PATH BUFFER STRING MIME-TYPE) - -FILE-N can also be a string (path to the file) or a buffer object. -In that case, FILENAME is set to the file name or buffer name. - -Example FILES argument:: - - `((\"passwd\" . \"/etc/passwd\") ; filename = passwd - (\"scratch\" . ,(get-buffer \"*scratch*\")) ; filename = *scratch* - (\"passwd2\" . (\"password.txt\" :file \"/etc/passwd\")) - (\"scratch2\" . (\"scratch.txt\" :buffer ,(get-buffer \"*scratch*\"))) - (\"data\" . (\"data.csv\" :data \"1,2,3\\n4,5,6\\n\"))) - -.. note:: FILES is implemented only for curl backend for now. - As furl.el_ supports multipart POST, it should be possible to - support FILES in pure elisp by making furl.el_ another backend. - Contributions are welcome. - - .. _furl.el: http://code.google.com/p/furl-el/ - - -* PARSER function - -PARSER function takes no argument and it is executed in the -buffer with HTTP response body. The current position in the HTTP -response buffer is at the beginning of the buffer. As the HTTP -header is stripped off, the cursor is actually at the beginning -of the response body. So, for example, you can pass `json-read' -to parse JSON object in the buffer. To fetch whole response as a -string, pass `buffer-string'. - -When using `json-read', it is useful to know that the returned -type can be modified by `json-object-type', `json-array-type', -`json-key-type', `json-false' and `json-null'. See docstring of -each function for what it does. For example, to convert JSON -objects to plist instead of alist, wrap `json-read' by `lambda' -like this.:: - - (request - \"http://...\" - :parser (lambda () - (let ((json-object-type 'plist)) - (json-read))) - ...) - -This is analogous to the `dataType' argument of jQuery.ajax_. -Only this function can access to the process buffer, which -is killed immediately after the execution of this function. - -* SYNC - -Synchronous request is functional, but *please* don't use it -other than testing or debugging. Emacs users have better things -to do rather than waiting for HTTP request. If you want a better -way to write callback chains, use `request-deferred'. - -If you can't avoid using it (e.g., you are inside of some hook -which must return some value), make sure to set TIMEOUT to -relatively small value. - -Due to limitation of `url-retrieve-synchronously', response slots -`request-response-error-thrown', `request-response-history' and -`request-response-url' are unknown (always `nil') when using -synchronous request with `url-retrieve' backend. - -* Note - -API of `request' is somewhat mixture of jQuery.ajax_ (Javascript) -and requests.request_ (Python). - -.. _jQuery.ajax: http://api.jquery.com/jQuery.ajax/ -.. _requests.request: http://docs.python-requests.org -" - (declare (indent defun)) - ;; FIXME: support CACHE argument (if possible) - ;; (unless cache - ;; (setq url (request--url-no-cache url))) - (unless error - (setq error (apply-partially #'request-default-error-callback url)) - (setq settings (plist-put settings :error error))) - (unless (or (stringp data) - (null data) - (assoc-string "Content-Type" headers t)) - (setq data (request--urlencode-alist data)) - (setq settings (plist-put settings :data data))) - (when params - (cl-assert (listp params) nil "PARAMS must be an alist. Given: %S" params) - (setq url (concat url (if (string-match-p "\\?" url) "&" "?") - (request--urlencode-alist params)))) - (setq settings (plist-put settings :url url)) - (setq settings (plist-put settings :response response)) - (setq settings (plist-put settings :encoding encoding)) - (setf (request-response-settings response) settings) - (setf (request-response-url response) url) - (setf (request-response--backend response) request-backend) - ;; Call `request--url-retrieve'(`-sync') or `request--curl'(`-sync'). - (apply (if sync - (request--choose-backend 'request-sync) - (request--choose-backend 'request)) - url settings) - response) - -(defun request--clean-header (response) - "Strip off carriage returns in the header of REQUEST." - (let* ((buffer (request-response--buffer response)) - (backend (request-response--backend response)) - ;; FIXME: a workaround when `url-http-clean-headers' fails... - (sep-regexp (if (eq backend 'url-retrieve) "^\r?$" "^\r$"))) - (when (buffer-live-p buffer) - (with-current-buffer buffer - (goto-char (point-min)) - (when (and (re-search-forward sep-regexp nil t) - (not (equal (match-string 0) ""))) - (request-log 'trace "request--clean-header: cleaning\n%s" - (buffer-substring (save-excursion - (forward-line -1) - (line-beginning-position)) - (save-excursion - (forward-line 1) - (line-end-position)))) - (while (re-search-backward "\r$" (point-min) t) - (replace-match ""))))))) - -(defun request--cut-header (response) - "Cut the first header part in the buffer of RESPONSE and move it to -raw-header slot." - (let ((buffer (request-response--buffer response))) - (when (buffer-live-p buffer) - (with-current-buffer buffer - (goto-char (point-min)) - (when (re-search-forward "^$" nil t) - (setf (request-response--raw-header response) - (buffer-substring (point-min) (point))) - (request-log 'trace "request--cut-header: cutting\n%s" - (buffer-substring (point-min) (min (1+ (point)) (point-max)))) - (delete-region (point-min) (min (1+ (point)) (point-max)))))))) - -(defun request-untrampify-filename (file) - "Return FILE as the local file name." - (or (file-remote-p file 'localname) file)) - -(defun request--parse-data (response encoding parser) - "For buffer held by RESPONSE, first decode via user's ENCODING elective, -then send to PARSER." - (let ((buffer (request-response--buffer response))) - (when (buffer-live-p buffer) - (with-current-buffer buffer - (request-log 'trace "request--parse-data: %s" (buffer-string)) - (unless (eq (request-response-status-code response) 204) - (recode-region (point-min) (point-max) encoding 'no-conversion) - (goto-char (point-min)) - (setf (request-response-data response) - (if parser (funcall parser) (buffer-string)))))))) - -(defsubst request-url-file-p (url) - "Return non-nil if URL looks like a file URL." - (let ((scheme (and (stringp url) (url-type (url-generic-parse-url url))))) - (and (stringp scheme) - (not (string-match-p "^http" scheme))))) - -(cl-defun request--callback (buffer - &key - parser success error complete - status-code response - encoding - &allow-other-keys) - (request-log 'debug "request--callback: UNPARSED\n%s" - (when (buffer-live-p buffer) - (with-current-buffer buffer (buffer-string)))) - - ;; Sometimes BUFFER given as the argument is different from the - ;; buffer already set in RESPONSE. That's why it is reset here. - ;; FIXME: Refactor how BUFFER is passed around. - (setf (request-response--buffer response) buffer) - (request-response--cancel-timer response) - (cl-symbol-macrolet - ((error-thrown (request-response-error-thrown response)) - (symbol-status (request-response-symbol-status response)) - (data (request-response-data response)) - (done-p (request-response-done-p response))) - (let* ((response-url (request-response-url response)) - (curl-file-p (and (eq (request-response--backend response) 'curl) - (request-url-file-p response-url)))) - (unless curl-file-p - (request--clean-header response) - (request--cut-header response))) - - ;; Parse response even if `error-thrown' is set, e.g., timeout - (condition-case err - (request--parse-data response encoding parser) - (error (unless error-thrown (setq error-thrown err)) - (unless symbol-status (setq symbol-status 'parse-error)))) - (kill-buffer buffer) - - ;; Ensuring `symbol-status' and `error-thrown' are consistent - ;; is why we should get rid of `symbol-status' - ;; (but downstream apps might ill-advisedly rely on it). - (if error-thrown - (progn - (request-log 'error "request--callback: %s" - (error-message-string error-thrown)) - (unless symbol-status (setq symbol-status 'error))) - (unless symbol-status (setq symbol-status 'success)) - (request-log 'debug "request--callback: PARSED\n%s" data)) - - (let ((args (list :data data - :symbol-status symbol-status - :error-thrown error-thrown - :response response))) - (let* ((success-p (eq symbol-status 'success)) - (cb (if success-p success error)) - (name (if success-p "success" "error"))) - (when cb - (request-log 'debug "request--callback: executing %s" name) - (request--safe-apply cb args))) - - (let ((cb (cdr (assq (request-response-status-code response) - status-code)))) - (when cb - (request-log 'debug "request--callback: executing status-code") - (request--safe-apply cb args))) - - (when complete - (request-log 'debug "request--callback: executing complete") - (request--safe-apply complete args))) - - (setq done-p t))) - -(cl-defun request-response--timeout-callback (response) - (setf (request-response-symbol-status response) 'timeout) - (setf (request-response-error-thrown response) '(error . ("Timeout"))) - (let* ((buffer (request-response--buffer response)) - (proc (and (buffer-live-p buffer) (get-buffer-process buffer)))) - (if proc - ;; This will call `request--callback': - (funcall (request--choose-backend 'terminate-process) proc) - (cl-symbol-macrolet ((done-p (request-response-done-p response))) - (unless done-p - (when (buffer-live-p buffer) - (cl-destructuring-bind (&key code &allow-other-keys) - (with-current-buffer buffer - (goto-char (point-min)) - (request--parse-response-at-point)) - (setf (request-response-status-code response) code))) - (apply #'request--callback - buffer - (request-response-settings response)) - (setq done-p t)))))) - -(defun request-response--cancel-timer (response) - (cl-symbol-macrolet ((timer (request-response--timer response))) - (when timer - (cancel-timer timer) - (setq timer nil)))) - - -(defun request-abort (response) - "Abort request for RESPONSE (the object returned by `request'). -Note that this function invoke ERROR and COMPLETE callbacks. -Callbacks may not be called immediately but called later when -associated process is exited." - (cl-symbol-macrolet ((buffer (request-response--buffer response)) - (symbol-status (request-response-symbol-status response)) - (done-p (request-response-done-p response))) - (let ((process (get-buffer-process buffer))) - (unless symbol-status ; should I use done-p here? - (setq symbol-status 'abort) - (setq done-p t) - (when (and - (processp process) ; process can be nil when buffer is killed - (request--process-live-p process)) - (funcall (request--choose-backend 'terminate-process) process)))))) - - -;;; Backend: `url-retrieve' - -(cl-defun request--url-retrieve-preprocess-settings - (&rest settings &key type data files headers &allow-other-keys) - (when files - (error "`url-retrieve' backend does not support FILES.")) - (when (and (equal type "POST") - data - (not (assoc-string "Content-Type" headers t))) - (push '("Content-Type" . "application/x-www-form-urlencoded") headers) - (setq settings (plist-put settings :headers headers))) - settings) - -(cl-defun request--url-retrieve (url &rest settings - &key type data timeout response - &allow-other-keys - &aux headers) - (setq settings (apply #'request--url-retrieve-preprocess-settings settings)) - (setq headers (plist-get settings :headers)) - (let* ((url-request-extra-headers headers) - (url-request-method type) - (url-request-data data) - (buffer (url-retrieve url #'request--url-retrieve-callback - (nconc (list :response response) settings) t)) - (proc (get-buffer-process buffer))) - (request--install-timeout timeout response) - (setf (request-response--buffer response) buffer) - (process-put proc :request-response response) - (set-process-query-on-exit-flag proc nil))) - -(cl-defun request--url-retrieve-callback (status &rest settings - &key response url - &allow-other-keys) - (when (featurep 'url-http) - (setf (request-response-status-code response) url-http-response-status)) - (let ((redirect (plist-get status :redirect))) - (when redirect - (setf (request-response-url response) redirect))) - ;; Construct history slot - (cl-loop for v in - (cl-loop with first = t - with l = nil - for (k v) on status by 'cddr - when (eq k :redirect) - if first - do (setq first nil) - else - do (push v l) - finally do (cons url l)) - do (let ((r (make-request-response :-backend 'url-retrieve))) - (setf (request-response-url r) v) - (push r (request-response-history response)))) - - (cl-symbol-macrolet ((error-thrown (request-response-error-thrown response)) - (status-error (plist-get status :error))) - (when status-error - (request-log 'warn "request--url-retrieve-callback: %s" status-error) - (unless error-thrown - (setq error-thrown status-error)))) - - (apply #'request--callback (current-buffer) settings)) - -(cl-defun request--url-retrieve-sync (url &rest settings - &key type data timeout response - &allow-other-keys - &aux headers) - (setq settings (apply #'request--url-retrieve-preprocess-settings settings)) - (setq headers (plist-get settings :headers)) - (let* ((url-request-extra-headers headers) - (url-request-method type) - (url-request-data data) - (buffer (if timeout - (with-timeout - (timeout - (setf (request-response-symbol-status response) - 'timeout) - (setf (request-response-done-p response) t) - nil) - (url-retrieve-synchronously url t)) - (url-retrieve-synchronously url t)))) - (setf (request-response--buffer response) buffer) - ;; It seems there is no way to get redirects and URL here... - (when buffer - ;; Fetch HTTP response code - (with-current-buffer buffer - (goto-char (point-min)) - (cl-destructuring-bind (&key code &allow-other-keys) - (request--parse-response-at-point) - (setf (request-response-status-code response) code))) - ;; Parse response body, etc. - (apply #'request--callback buffer settings))) - response) - -(defun request--url-retrieve-get-cookies (host localpart secure) - (mapcar - (lambda (c) (cons (url-cookie-name c) (url-cookie-value c))) - (url-cookie-retrieve host localpart secure))) - - -;;; Backend: curl - -(defvar request--curl-cookie-jar nil - "Override what the function `request--curl-cookie-jar' returns. -Currently it is used only for testing.") - -(defun request--curl-cookie-jar () - "Cookie storage for curl backend." - (or request--curl-cookie-jar - (expand-file-name "curl-cookie-jar" request-storage-directory))) - -(defvar request--curl-capabilities-cache - (make-hash-table :test 'eq :weakness 'key) - "Used to avoid invoking curl more than once for version info. By skeeto/elfeed.") - -(defun request--curl-capabilities () - "Return capabilities plist for curl. By skeeto/elfeed. -:version -- cURL's version string -:compression -- non-nil if --compressed is supported." - (let ((cache-value (gethash request-curl request--curl-capabilities-cache))) - (if cache-value - cache-value - (with-temp-buffer - (call-process request-curl nil t nil "--version") - (let ((version - (progn - (setf (point) (point-min)) - (when (re-search-forward "[.0-9]+" nil t) - (match-string 0)))) - (compression - (progn - (setf (point) (point-min)) - (not (null (re-search-forward "libz\\>" nil t)))))) - (setf (gethash request-curl request--curl-capabilities-cache) - `(:version ,version :compression ,compression))))))) - -(defconst request--curl-write-out-template - (if (eq system-type 'windows-nt) - "\\n(:num-redirects %{num_redirects} :url-effective %{url_effective})" - "\\n(:num-redirects %{num_redirects} :url-effective \"%{url_effective}\")")) - -(defun request--curl-mkdir-for-cookie-jar () - (ignore-errors - (make-directory (file-name-directory (request--curl-cookie-jar)) t))) - -(cl-defun request--curl-command - (url &key type data headers files unix-socket auth - &allow-other-keys - &aux (cookie-jar (convert-standard-filename - (expand-file-name (request--curl-cookie-jar))))) - "BUG: Simultaneous requests are a known cause of cookie-jar corruption." - (append - (list request-curl - "--silent" "--location" - "--cookie" cookie-jar "--cookie-jar" cookie-jar) - (when auth - (let* ((host (url-host (url-generic-parse-url url))) - (auth-source-creation-prompts `((user . ,(format "%s user: " host)) - (secret . "Password for %u: "))) - (cred (car (auth-source-search - :host host :require '(:user :secret) :create t :max 1)))) - (split-string (format "--%s --user %s:%s" - auth - (plist-get cred :user) - (let ((secret (plist-get cred :secret))) - (if (functionp secret) - (funcall secret) - secret)))))) - (unless (request-url-file-p url) - (list "--include" "--write-out" request--curl-write-out-template)) - request-curl-options - (when (plist-get (request--curl-capabilities) :compression) (list "--compressed")) - (when unix-socket (list "--unix-socket" unix-socket)) - (cl-loop with stdin-p = data - for (name . item) in files - collect "--form" - collect - (apply #'format "%s=@%s;filename=%s%s" - (cond ((stringp item) - (list name item (file-name-nondirectory item) "")) - ((bufferp item) - (if stdin-p - (error (concat "request--curl-command: " - "only one buffer or data entry permitted")) - (setq stdin-p t)) - (list name "-" (buffer-name item) "")) - ((listp item) - (unless (plist-get (cdr item) :file) - (if stdin-p - (error (concat "request--curl-command: " - "only one buffer or data entry permitted")) - (setq stdin-p t))) - (list name (or (plist-get (cdr item) :file) "-") (car item) - (if (plist-get item :mime-type) - (format ";type=%s" (plist-get item :mime-type)) - ""))) - (t (error (concat "request--curl-command: " - "%S not string, buffer, or list") - item))))) - (when data - (split-string "--data-binary @-")) - (when type (if (equal "head" (downcase type)) - (list "--head") - (list "--request" type))) - (cl-loop for (k . v) in headers - collect "--header" - collect (format "%s: %s" k v)) - (list url))) - -(defun request--install-timeout (timeout response) - "Out-of-band trigger after TIMEOUT seconds to prevent hangs." - (when (numberp timeout) - (setf (request-response--timer response) - (run-at-time timeout nil - #'request-response--timeout-callback response)))) - -(defun request--curl-occlude-secret (command) - "Simple regex filter on anything looking like a secret." - (let ((matched - (string-match (concat (regexp-quote "--user") "\\s-*\\(\\S-+\\)") command))) - (if matched - (replace-match "elided" nil nil command 1) - command))) - -(cl-defun request--curl (url &rest settings - &key data files timeout response encoding semaphore - &allow-other-keys) - "cURL-based request backend. - -Redirection handling strategy ------------------------------ - -curl follows redirection when --location is given. However, -all headers are printed when it is used with --include option. -Number of redirects is printed out sexp-based message using ---write-out option (see `request--curl-write-out-template'). -This number is used for removing extra headers and parse -location header from the last redirection header. - -Sexp at the end of buffer and extra headers for redirects are -removed from the buffer before it is shown to the parser function. -" - (request--curl-mkdir-for-cookie-jar) - (let* (process-connection-type ;; pipe, not pty, else curl hangs - (home-directory (or (file-remote-p default-directory) "~/")) - (default-directory (expand-file-name home-directory)) - (buffer (generate-new-buffer " *request curl*")) - (command (apply #'request--curl-command url settings)) - (proc (apply #'start-process "request curl" buffer command)) - (scommand (mapconcat 'identity command " ")) - (file-items (mapcar #'cdr files)) - (file-buffer (or (cl-some (lambda (item) - (when (bufferp item) item)) - file-items) - (cl-some (lambda (item) - (and (listp item) - (plist-get (cdr item) :buffer))) - file-items))) - (file-data (cl-some (lambda (item) - (and (listp item) - (plist-get (cdr item) :data))) - file-items))) - (request--install-timeout timeout response) - (request-log 'debug "request--curl: %s" - (request--curl-occlude-secret scommand)) - (setf (request-response--buffer response) buffer) - (process-put proc :request-response response) - (set-process-coding-system proc 'no-conversion 'no-conversion) - (set-process-query-on-exit-flag proc nil) - (when (or data file-buffer file-data) - ;; We dynamic-let the global `buffer-file-coding-system' to `no-conversion' - ;; in case the user-configured `encoding' doesn't fly. - ;; If we do not dynamic-let the global, `select-safe-coding-system' would - ;; plunge us into an undesirable interactive dialogue. - (let* ((buffer-file-coding-system-orig - (default-value 'buffer-file-coding-system)) - (select-safe-coding-system-accept-default-p - (lambda (&rest _) t))) - (unwind-protect - (progn - (setf (default-value 'buffer-file-coding-system) 'no-conversion) - (with-temp-buffer - (setq-local buffer-file-coding-system encoding) - (insert (or data - (when file-buffer - (with-current-buffer file-buffer - (buffer-substring-no-properties (point-min) (point-max)))) - file-data)) - (process-send-region proc (point-min) (point-max)) - (process-send-eof proc))) - (setf (default-value 'buffer-file-coding-system) - buffer-file-coding-system-orig)))) - (let ((callback-2 (apply-partially #'request--curl-callback url))) - (if semaphore - (set-process-sentinel proc (lambda (&rest args) - (apply callback-2 args) - (apply semaphore args))) - (set-process-sentinel proc callback-2))))) - -(defun request--curl-read-and-delete-tail-info () - "Read a sexp at the end of buffer and remove it and preceding character. -This function moves the point at the end of buffer by side effect. -See also `request--curl-write-out-template'." - (let (forward-sexp-function) - (goto-char (point-max)) - (forward-sexp -1) - (let ((beg (1- (point)))) - (prog1 - (read (current-buffer)) - (delete-region beg (point-max)))))) - -(defconst request--cookie-reserved-re - (mapconcat - (lambda (x) (concat "\\(^" x "\\'\\)")) - '("comment" "commenturl" "discard" "domain" "max-age" "path" "port" - "secure" "version" "expires") - "\\|") - "Uninterested keys in cookie. -See \"set-cookie-av\" in http://www.ietf.org/rfc/rfc2965.txt") - -(defun request--consume-100-continue () - "Remove \"HTTP/* 100 Continue\" header at the point." - (cl-destructuring-bind (&key code &allow-other-keys) - (save-excursion (request--parse-response-at-point)) - (when (equal code 100) - (request-log 'debug "request--consume-100-continue: consuming\n%s" - (buffer-substring (point) - (save-excursion - (request--goto-next-body t) - (point)))) - (delete-region (point) (progn (request--goto-next-body) (point))) - ;; FIXME: Does this make sense? Is it possible to have multiple 100? - (request--consume-100-continue)))) - -(defun request--consume-200-connection-established () - "Remove \"HTTP/* 200 Connection established\" header at the point." - (when (looking-at-p "HTTP/1\\.[0-1] 200 Connection established") - (delete-region (point) (progn (request--goto-next-body) (point))))) - -(defun request--curl-preprocess (&optional url) - "Pre-process current buffer before showing it to user." - (let (history) - (cl-destructuring-bind (&key num-redirects url-effective) - (if (request-url-file-p url) - `(:num-redirects 0 :url-effective ,url) - (request--curl-read-and-delete-tail-info)) - (goto-char (point-min)) - (request--consume-100-continue) - (request--consume-200-connection-established) - (when (> num-redirects 0) - (cl-loop with case-fold-search = t - repeat num-redirects - ;; Do not store code=100 headers: - do (request--consume-100-continue) - do (let ((response (make-request-response - :-buffer (current-buffer) - :-backend 'curl))) - (request--clean-header response) - (request--cut-header response) - (push response history)))) - - (goto-char (point-min)) - (nconc (list :num-redirects num-redirects :url-effective url-effective - :history (nreverse history)) - (request--parse-response-at-point))))) - -(defun request--curl-absolutify-redirects (start-url redirects) - "Convert relative paths in REDIRECTS to absolute URLs. -START-URL is the URL requested." - (cl-loop for prev-url = start-url then url - for url in redirects - unless (string-match url-nonrelative-link url) - do (setq url (url-expand-file-name url prev-url)) - collect url)) - -(defun request--curl-absolutify-location-history (start-url history) - "Convert relative paths in HISTORY to absolute URLs. -START-URL is the URL requested." - (when history - (setf (request-response-url (car history)) start-url)) - (cl-loop for url in (request--curl-absolutify-redirects - start-url - (mapcar (lambda (response) - (or (request-response-header response "location") - (request-response-url response))) - history)) - for response in (cdr history) - do (setf (request-response-url response) url))) - -(defun request--curl-callback (url proc event) - (let* ((buffer (process-buffer proc)) - (response (process-get proc :request-response)) - (settings (request-response-settings response))) - (request-log 'debug "request--curl-callback: event %s" event) - (request-log 'trace "request--curl-callback: raw-bytes=\n%s" - (when (buffer-live-p buffer) - (with-current-buffer buffer (buffer-string)))) - (cond - ((and (memq (process-status proc) '(exit signal)) - (/= (process-exit-status proc) 0)) - (setf (request-response-error-thrown response) (cons 'error event)) - (apply #'request--callback buffer settings)) - ((cl-search "finished" event) - (cl-destructuring-bind (&key code history error url-effective &allow-other-keys) - (condition-case err - (with-current-buffer buffer - (request--curl-preprocess url)) - ((debug error) - (list :error err))) - (request--curl-absolutify-location-history (plist-get settings :url) - history) - (setf (request-response-status-code response) code) - (setf (request-response-url response) url-effective) - (setf (request-response-history response) history) - (setf (request-response-error-thrown response) - (or error (and (numberp code) (>= code 400) `(error . (http ,code))))) - (apply #'request--callback buffer settings)))))) - -(defun request-auto-revert-notify-rm-watch () - "Backport of M. Engdegard's fix of `auto-revert-notify-rm-watch'." - (let ((desc auto-revert-notify-watch-descriptor) - (table (if (boundp 'auto-revert--buffers-by-watch-descriptor) - auto-revert--buffers-by-watch-descriptor - (when (boundp 'auto-revert-notify-watch-descriptor-hash-list) - auto-revert-notify-watch-descriptor-hash-list)))) - (when (and desc table) - (let ((buffers (delq (current-buffer) (gethash desc table)))) - (if buffers - (puthash desc buffers table) - (remhash desc table))) - (condition-case nil ;; ignore-errors doesn't work for me, sorry - (file-notify-rm-watch desc) - (error)) - (remove-hook 'kill-buffer-hook #'auto-revert-notify-rm-watch t))) - (setq auto-revert-notify-watch-descriptor nil - auto-revert-notify-modified-p nil)) - -(cl-defun request--curl-sync (url &rest settings &key response &allow-other-keys) - (let (finished) - (prog1 (apply #'request--curl url - :semaphore (lambda (&rest _) (setq finished t)) - settings) - (let* ((proc (get-buffer-process (request-response--buffer response))) - (interval 0.05) - (timeout 5) - (maxiter (truncate (/ timeout interval)))) - (auto-revert-set-timer) - (when auto-revert-use-notify - (dolist (buf (buffer-list)) - (with-current-buffer buf - (request-auto-revert-notify-rm-watch)))) - (with-local-quit - (cl-loop with iter = 0 - until (or (>= iter maxiter) finished) - do (accept-process-output nil interval) - unless (request--process-live-p proc) - do (cl-incf iter) - end - finally (when (>= iter maxiter) - (let ((m "request--curl-sync: semaphore never called")) - (princ (format "%s\n" m) #'external-debugging-output) - (request-log 'error m))))))))) - -(defun request--curl-get-cookies (host localpart secure) - (request--netscape-get-cookies (request--curl-cookie-jar) - host localpart secure)) - - -;;; Netscape cookie.txt parser - -(defun request--netscape-cookie-parse () - "Parse Netscape/Mozilla cookie format." - (goto-char (point-min)) - (let ((tsv-re (concat "^\\(#HttpOnly_\\)?" - (cl-loop repeat 6 concat "\\([^\t\n]+\\)\t") - "\\(.*\\)")) - cookies) - (while (not (eobp)) - ;; HttpOnly cookie starts with '#' but its line is not comment line(#60) - (cond ((and (looking-at-p "^#") (not (looking-at-p "^#HttpOnly_"))) t) - ((looking-at-p "^$") t) - ((looking-at tsv-re) - (let ((cookie (cl-loop for i from 1 to 8 collect (match-string i)))) - (push cookie cookies)))) - (forward-line 1)) - (setq cookies (nreverse cookies)) - (cl-loop for (http-only domain flag path secure expiration name value) in cookies - collect (list domain - (equal flag "TRUE") - path - (equal secure "TRUE") - (null (not http-only)) - (string-to-number expiration) - name - value)))) - -(defun request--netscape-filter-cookies (cookies host localpart secure) - (cl-loop for (domain _flag path secure-1 _http-only _expiration name value) in cookies - when (and (equal domain host) - (equal path localpart) - (or secure (not secure-1))) - collect (cons name value))) - -(defun request--netscape-get-cookies (filename host localpart secure) - (when (file-readable-p filename) - (with-temp-buffer - (erase-buffer) - (insert-file-contents filename) - (request--netscape-filter-cookies (request--netscape-cookie-parse) - host localpart secure)))) - -(provide 'request) - -;;; request.el ends here diff --git a/elpa/request-0.3.3/tools/install-cask.sh b/elpa/request-0.3.3/tools/install-cask.sh @@ -1,64 +0,0 @@ -#!/bin/bash - -# Install cask for Travis CI -# or if already installed, then check for updates -# Author: gonewest818 https://github.com/clojure-emacs/cider/pull/2139 - -set -x - -WORKDIR=${HOME}/local -CASKDIR=$WORKDIR/cask - -. tools/retry.sh - -update_elpa_keys() { - mkdir -p $HOME/.emacs.d/elpa/gnupg || true - chmod 700 $HOME/.emacs.d/elpa/gnupg - GPG=gpg - if which gpg2 ; then - GPG=gpg2 - fi - for i in 1 2 3 ; do - if ${GPG} -q --homedir $HOME/.emacs.d/elpa/gnupg -k | grep 81E42C40 ; then - return 0 - fi - if [ $i -gt 1 ] ; then - sleep 5 - fi - ${GPG} --keyserver hkp://ipv4.pool.sks-keyservers.net --homedir $HOME/.emacs.d/elpa/gnupg --recv-keys 066DAFCB81E42C40 - done - return 1 -} - -copy_keys() { - mkdir -p $(cask package-directory) || true - mkdir -p $HOME/.cask || true - rsync -azSHe ssh $HOME/.cask $(dirname $(dirname $(dirname $(cask package-directory)))) - rsync -azSHe ssh $HOME/.emacs.d/elpa/gnupg $(cask package-directory) -} - -cask_upgrade_cask_or_reset() { - cask upgrade-cask || { rm -rf $HOME/.emacs.d/.cask && false; } -} - -cask_install_or_reset() { - cask install </dev/null - find $(cask package-directory)/archives -print | xargs ls -l - find $(cask package-directory)/gnupg -print | xargs ls -l - - # travis cache - rsync -azSHe ssh $(dirname $(dirname $(cask package-directory))) $HOME/ -} - -# Bootstrap the cask tool and its dependencies -if [ ! -d $CASKDIR ] ; then - git clone https://github.com/cask/cask.git $CASKDIR -fi - -# Install dependencies for cider as described in ./Cask -# Effect is identical to "make elpa", but here we can retry -# in the event of network failures. -update_elpa_keys -copy_keys -travis_retry cask_upgrade_cask_or_reset -travis_retry cask_install_or_reset && touch elpa-emacs diff --git a/elpa/request-0.3.3/tools/install-evm.sh b/elpa/request-0.3.3/tools/install-evm.sh @@ -1,19 +0,0 @@ -#!/bin/bash - -# Install evm for Travis CI -# or if already installed, then check for updates -# Author: gonewest818 https://github.com/clojure-emacs/cider/pull/2139 -set -x - -WORKDIR=${HOME}/local -EVMDIR=$WORKDIR/evm - -. tools/retry.sh - -if [ -d $EVMDIR ] -then - cd $EVMDIR - git pull origin master -else - git clone https://github.com/rejeep/evm.git $EVMDIR -fi diff --git a/elpa/request-0.3.3/tools/recipe b/elpa/request-0.3.3/tools/recipe @@ -1 +0,0 @@ -(request :repo "tkf/emacs-request" :fetcher github :files ("request.el")) diff --git a/elpa/request-0.3.3/tools/retry.sh b/elpa/request-0.3.3/tools/retry.sh @@ -1,28 +0,0 @@ -# Copied retry logic from Travis CI [http://bit.ly/2jPDCtV] -# Author: gonewest818 https://github.com/clojure-emacs/cider/pull/2139 - -ANSI_RED="\033[31;1m" -ANSI_GREEN="\033[32;1m" -ANSI_RESET="\033[0m" -ANSI_CLEAR="\033[0K" - -travis_retry() { - local result=0 - local count=1 - while [ $count -le 3 ]; do - [ $result -ne 0 ] && { - echo -e "\n${ANSI_RED}The command \"$@\" failed. Retrying, $count of 3.${ANSI_RESET}\n" >&2 - } - "$@" - result=$? - [ $result -eq 0 ] && break - count=$(($count + 1)) - sleep 1 - done - - [ $count -gt 3 ] && { - echo -e "\n${ANSI_RED}The command \"$@\" failed 3 times.${ANSI_RESET}\n" >&2 - } - - return $result -} diff --git a/elpa/vterm-20230417.424/CMakeLists.txt b/elpa/vterm-20230417.424/CMakeLists.txt @@ -1,104 +0,0 @@ -cmake_minimum_required(VERSION 3.11) -include(ExternalProject) - -project(emacs-libvterm C) - -if(CMAKE_SYSTEM_NAME STREQUAL "FreeBSD" OR CMAKE_SYSTEM_NAME STREQUAL "OpenBSD" OR CMAKE_SYSTEM_NAME STREQUAL "NetBSD") - set(LIBVTERM_BUILD_COMMAND "gmake") -else() - set(LIBVTERM_BUILD_COMMAND "make") -endif() - -add_library(vterm-module MODULE vterm-module.c utf8.c elisp.c) -set_target_properties(vterm-module PROPERTIES - C_STANDARD 99 - C_VISIBILITY_PRESET "hidden" - POSITION_INDEPENDENT_CODE ON - PREFIX "" - LIBRARY_OUTPUT_DIRECTORY ${CMAKE_SOURCE_DIR} - ) - -# Set RelWithDebInfo as default build type -if (NOT CMAKE_BUILD_TYPE AND NOT CMAKE_CONFIGURATION_TYPES) - message(STATUS "No build type selected, defaulting to RelWithDebInfo") - set(CMAKE_BUILD_TYPE "RelWithDebInfo" CACHE STRING "Build type (default RelWithDebInfo)" FORCE) -endif() - -# Look for the header file. -option(USE_SYSTEM_LIBVTERM "Use system libvterm instead of the vendored version." ON) - -# Try to find the libvterm in system. -if (USE_SYSTEM_LIBVTERM) - # try to find the vterm.h header file. - find_path(LIBVTERM_INCLUDE_DIR - NAMES vterm.h - ) - - # vterm.h is found. - if (LIBVTERM_INCLUDE_DIR) - message(STATUS "System libvterm detected") - execute_process(COMMAND grep -c "VTermStringFragment" "${LIBVTERM_INCLUDE_DIR}/vterm.h" OUTPUT_VARIABLE VTermStringFragmentExists) - if (${VTermStringFragmentExists} EQUAL "0") -# add_compile_definitions(VTermStringFragmentNotExists) - add_definitions(-DVTermStringFragmentNotExists) - endif() - execute_process(COMMAND grep -c "VTermSelectionMask" "${LIBVTERM_INCLUDE_DIR}/vterm.h" OUTPUT_VARIABLE VTermSelectionMaskExists) - if (${VTermSelectionMaskExists} EQUAL "0") -# add_compile_definitions(VTermStringFragmentNotExists) - add_definitions(-DVTermSelectionMaskNotExists) - endif() - execute_process(COMMAND grep -c "sb_clear" "${LIBVTERM_INCLUDE_DIR}/vterm.h" OUTPUT_VARIABLE VTermSBClearExists) - if (${VTermSBClearExists} EQUAL "0") - add_definitions(-DVTermSBClearNotExists) - endif() - else() - message(STATUS "System libvterm not found: libvterm will be downloaded and compiled as part of the build process") - endif() -endif() - -if (LIBVTERM_INCLUDE_DIR) - find_library(LIBVTERM_LIBRARY NAMES - vterm - libvterm - ) - - if(NOT LIBVTERM_LIBRARY) - message(FATAL_ERROR "libvterm not found") - endif() -else() - find_program(LIBTOOL NAMES libtool glibtool) - if(NOT LIBTOOL) - message(FATAL_ERROR "libtool not found. Please install libtool") - endif() - - ExternalProject_add(libvterm - GIT_REPOSITORY https://github.com/Sbozzolo/libvterm-mirror.git - GIT_TAG 64f1775952dbe001e989f2ab679563b54f2fca55 - CONFIGURE_COMMAND "" - BUILD_COMMAND ${LIBVTERM_BUILD_COMMAND} "CFLAGS='-fPIC'" "LDFLAGS='-static'" - BUILD_IN_SOURCE ON - INSTALL_COMMAND "") - - ExternalProject_Get_property(libvterm SOURCE_DIR) - - set(LIBVTERM_INCLUDE_DIR ${SOURCE_DIR}/include) - set(LIBVTERM_LIBRARY ${SOURCE_DIR}/.libs/libvterm.a) - - add_dependencies(vterm-module libvterm) - - # Workaround for https://gitlab.kitware.com/cmake/cmake/issues/15052 - file(MAKE_DIRECTORY ${LIBVTERM_INCLUDE_DIR}) -endif() - -add_library(vterm STATIC IMPORTED) -set_target_properties(vterm PROPERTIES IMPORTED_LOCATION ${LIBVTERM_LIBRARY}) -target_include_directories(vterm INTERFACE ${LIBVTERM_INCLUDE_DIR}) - -# Link with libvterm -target_link_libraries(vterm-module PUBLIC vterm) - -# Custom run command for testing -add_custom_target(run - COMMAND emacs -Q -L ${CMAKE_SOURCE_DIR} -L ${CMAKE_BINARY_DIR} --eval "\\(require \\'vterm\\)" --eval "\\(vterm\\)" - DEPENDS vterm-module - ) diff --git a/elpa/vterm-20230417.424/elisp.c b/elpa/vterm-20230417.424/elisp.c @@ -1,209 +0,0 @@ -#include "elisp.h" -#include <stdio.h> - -// Emacs symbols -emacs_value Qt; -emacs_value Qnil; -emacs_value Qnormal; -emacs_value Qbold; -emacs_value Qitalic; -emacs_value Qforeground; -emacs_value Qbackground; -emacs_value Qweight; -emacs_value Qunderline; -emacs_value Qslant; -emacs_value Qreverse; -emacs_value Qstrike; -emacs_value Qextend; -emacs_value Qface; -emacs_value Qbox; -emacs_value Qbar; -emacs_value Qhbar; -emacs_value Qcursor_type; -emacs_value Qemacs_major_version; -emacs_value Qvterm_line_wrap; -emacs_value Qrear_nonsticky; -emacs_value Qvterm_prompt; - -// Emacs functions -emacs_value Fblink_cursor_mode; -emacs_value Fsymbol_value; -emacs_value Flength; -emacs_value Flist; -emacs_value Fnth; -emacs_value Ferase_buffer; -emacs_value Finsert; -emacs_value Fgoto_char; -emacs_value Fforward_char; -emacs_value Fforward_line; -emacs_value Fgoto_line; -emacs_value Fdelete_lines; -emacs_value Frecenter; -emacs_value Fset_window_point; -emacs_value Fwindow_body_height; -emacs_value Fpoint; - -emacs_value Fput_text_property; -emacs_value Fadd_text_properties; -emacs_value Fset; -emacs_value Fvterm_flush_output; -emacs_value Fget_buffer_window_list; -emacs_value Fselected_window; -emacs_value Fvterm_set_title; -emacs_value Fvterm_set_directory; -emacs_value Fvterm_invalidate; -emacs_value Feq; -emacs_value Fvterm_get_color; -emacs_value Fvterm_eval; -emacs_value Fvterm_set_selection; - -/* Set the function cell of the symbol named NAME to SFUN using - the 'fset' function. */ -void bind_function(emacs_env *env, const char *name, emacs_value Sfun) { - emacs_value Qfset = env->intern(env, "fset"); - emacs_value Qsym = env->intern(env, name); - - env->funcall(env, Qfset, 2, (emacs_value[]){Qsym, Sfun}); -} - -/* Provide FEATURE to Emacs. */ -void provide(emacs_env *env, const char *feature) { - emacs_value Qfeat = env->intern(env, feature); - emacs_value Qprovide = env->intern(env, "provide"); - - env->funcall(env, Qprovide, 1, (emacs_value[]){Qfeat}); -} - -emacs_value symbol_value(emacs_env *env, emacs_value symbol) { - return env->funcall(env, Fsymbol_value, 1, (emacs_value[]){symbol}); -} - -int string_bytes(emacs_env *env, emacs_value string) { - ptrdiff_t size = 0; - env->copy_string_contents(env, string, NULL, &size); - return size; -} - -emacs_value length(emacs_env *env, emacs_value string) { - return env->funcall(env, Flength, 1, (emacs_value[]){string}); -} - -emacs_value list(emacs_env *env, emacs_value elements[], ptrdiff_t len) { - return env->funcall(env, Flist, len, elements); -} -emacs_value nth(emacs_env *env, int idx, emacs_value list) { - emacs_value eidx = env->make_integer(env, idx); - return env->funcall(env, Fnth, 2, (emacs_value[]){eidx, list}); -} - -void put_text_property(emacs_env *env, emacs_value string, emacs_value property, - emacs_value value) { - emacs_value start = env->make_integer(env, 0); - emacs_value end = length(env, string); - - env->funcall(env, Fput_text_property, 5, - (emacs_value[]){start, end, property, value, string}); -} - -void add_text_properties(emacs_env *env, emacs_value string, - emacs_value property) { - emacs_value start = env->make_integer(env, 0); - emacs_value end = length(env, string); - - env->funcall(env, Fadd_text_properties, 4, - (emacs_value[]){start, end, property, string}); -} - -void erase_buffer(emacs_env *env) { env->funcall(env, Ferase_buffer, 0, NULL); } - -void insert(emacs_env *env, emacs_value string) { - env->funcall(env, Finsert, 1, (emacs_value[]){string}); -} - -void goto_char(emacs_env *env, int pos) { - emacs_value point = env->make_integer(env, pos); - env->funcall(env, Fgoto_char, 1, (emacs_value[]){point}); -} - -void forward_line(emacs_env *env, int n) { - emacs_value nline = env->make_integer(env, n); - env->funcall(env, Fforward_line, 1, (emacs_value[]){nline}); -} -void goto_line(emacs_env *env, int n) { - emacs_value nline = env->make_integer(env, n); - env->funcall(env, Fgoto_line, 1, (emacs_value[]){nline}); -} -void delete_lines(emacs_env *env, int linenum, int count, bool del_whole_line) { - emacs_value Qlinenum = env->make_integer(env, linenum); - emacs_value Qcount = env->make_integer(env, count); - if (del_whole_line) { - env->funcall(env, Fdelete_lines, 3, (emacs_value[]){Qlinenum, Qcount, Qt}); - } else { - env->funcall(env, Fdelete_lines, 3, - (emacs_value[]){Qlinenum, Qcount, Qnil}); - } -} -void recenter(emacs_env *env, emacs_value pos) { - env->funcall(env, Frecenter, 1, (emacs_value[]){pos}); -} -emacs_value point(emacs_env *env) { return env->funcall(env, Fpoint, 0, NULL); } - -void set_window_point(emacs_env *env, emacs_value win, emacs_value point) { - env->funcall(env, Fset_window_point, 2, (emacs_value[]){win, point}); -} -emacs_value window_body_height(emacs_env *env, emacs_value win) { - return env->funcall(env, Fwindow_body_height, 1, (emacs_value[]){win}); -} - -bool eq(emacs_env *env, emacs_value e1, emacs_value e2) { - emacs_value Qeq = env->funcall(env, Feq, 2, (emacs_value[]){e1, e2}); - return env->is_not_nil(env, Qeq); -} - -void forward_char(emacs_env *env, emacs_value n) { - env->funcall(env, Fforward_char, 1, (emacs_value[]){n}); -} - -emacs_value get_buffer_window_list(emacs_env *env) { - return env->funcall(env, Fget_buffer_window_list, 3, - (emacs_value[]){Qnil, Qnil, Qt}); -} - -emacs_value selected_window(emacs_env *env) { - return env->funcall(env, Fselected_window, 0, (emacs_value[]){}); -} - -void set_cursor_type(emacs_env *env, emacs_value cursor_type) { - env->funcall(env, Fset, 2, (emacs_value[]){Qcursor_type, cursor_type}); -} - -void set_cursor_blink(emacs_env *env, bool blink) { - env->funcall(env, Fblink_cursor_mode, 1, - (emacs_value[]){env->make_integer(env, blink)}); -} - -emacs_value vterm_get_color(emacs_env *env, int index) { - emacs_value idx = env->make_integer(env, index); - return env->funcall(env, Fvterm_get_color, 1, (emacs_value[]){idx}); -} - -void set_title(emacs_env *env, emacs_value string) { - env->funcall(env, Fvterm_set_title, 1, (emacs_value[]){string}); -} - -void set_directory(emacs_env *env, emacs_value string) { - env->funcall(env, Fvterm_set_directory, 1, (emacs_value[]){string}); -} - -void vterm_invalidate(emacs_env *env) { - env->funcall(env, Fvterm_invalidate, 0, NULL); -} -emacs_value vterm_eval(emacs_env *env, emacs_value string) { - return env->funcall(env, Fvterm_eval, 1, (emacs_value[]){string}); -} - -emacs_value vterm_set_selection(emacs_env *env, emacs_value selection_target, - emacs_value selection_data) { - return env->funcall(env, Fvterm_set_selection, 2, - (emacs_value[]){selection_target, selection_data}); -} diff --git a/elpa/vterm-20230417.424/elisp.h b/elpa/vterm-20230417.424/elisp.h @@ -1,99 +0,0 @@ -#ifndef ELISP_H -#define ELISP_H - -#include "emacs-module.h" -#include "vterm.h" - -// Emacs symbols -extern emacs_value Qt; -extern emacs_value Qnil; -extern emacs_value Qnormal; -extern emacs_value Qbold; -extern emacs_value Qitalic; -extern emacs_value Qforeground; -extern emacs_value Qbackground; -extern emacs_value Qweight; -extern emacs_value Qunderline; -extern emacs_value Qslant; -extern emacs_value Qreverse; -extern emacs_value Qstrike; -extern emacs_value Qextend; -extern emacs_value Qface; -extern emacs_value Qbox; -extern emacs_value Qbar; -extern emacs_value Qhbar; -extern emacs_value Qcursor_type; -extern emacs_value Qemacs_major_version; -extern emacs_value Qvterm_line_wrap; -extern emacs_value Qrear_nonsticky; -extern emacs_value Qvterm_prompt; - -// Emacs functions -extern emacs_value Fblink_cursor_mode; -extern emacs_value Fsymbol_value; -extern emacs_value Flength; -extern emacs_value Flist; -extern emacs_value Fnth; -extern emacs_value Ferase_buffer; -extern emacs_value Finsert; -extern emacs_value Fgoto_char; -extern emacs_value Fforward_char; -extern emacs_value Fforward_line; -extern emacs_value Fgoto_line; -extern emacs_value Fdelete_lines; -extern emacs_value Frecenter; -extern emacs_value Fset_window_point; -extern emacs_value Fwindow_body_height; -extern emacs_value Fpoint; - -extern emacs_value Fput_text_property; -extern emacs_value Fadd_text_properties; -extern emacs_value Fset; -extern emacs_value Fvterm_flush_output; -extern emacs_value Fget_buffer_window_list; -extern emacs_value Fselected_window; -extern emacs_value Fvterm_set_title; -extern emacs_value Fvterm_set_directory; -extern emacs_value Fvterm_invalidate; -extern emacs_value Feq; -extern emacs_value Fvterm_get_color; -extern emacs_value Fvterm_eval; -extern emacs_value Fvterm_set_selection; - -// Utils -void bind_function(emacs_env *env, const char *name, emacs_value Sfun); -void provide(emacs_env *env, const char *feature); -emacs_value symbol_value(emacs_env *env, emacs_value symbol); -int string_bytes(emacs_env *env, emacs_value string); -emacs_value length(emacs_env *env, emacs_value string); -emacs_value list(emacs_env *env, emacs_value elements[], ptrdiff_t len); -emacs_value nth(emacs_env *env, int idx, emacs_value list); -void put_text_property(emacs_env *env, emacs_value string, emacs_value property, - emacs_value value); -void add_text_properties(emacs_env *env, emacs_value string, - emacs_value property); -void erase_buffer(emacs_env *env); -void insert(emacs_env *env, emacs_value string); -void goto_char(emacs_env *env, int pos); -void forward_line(emacs_env *env, int n); -void goto_line(emacs_env *env, int n); -void set_cursor_type(emacs_env *env, emacs_value cursor_type); -void set_cursor_blink(emacs_env *env, bool blink); -void delete_lines(emacs_env *env, int linenum, int count, bool del_whole_line); -void recenter(emacs_env *env, emacs_value pos); -void set_window_point(emacs_env *env, emacs_value win, emacs_value point); -emacs_value window_body_height(emacs_env *env, emacs_value win); -emacs_value point(emacs_env *env); -bool eq(emacs_env *env, emacs_value e1, emacs_value e2); -void forward_char(emacs_env *env, emacs_value n); -emacs_value get_buffer_window_list(emacs_env *env); -emacs_value selected_window(emacs_env *env); -void set_title(emacs_env *env, emacs_value string); -void set_directory(emacs_env *env, emacs_value string); -void vterm_invalidate(emacs_env *env); -emacs_value vterm_get_color(emacs_env *env, int index); -emacs_value vterm_eval(emacs_env *env, emacs_value string); -emacs_value vterm_set_selection(emacs_env *env, emacs_value selection_target, - emacs_value selection_data); - -#endif /* ELISP_H */ diff --git a/elpa/vterm-20230417.424/emacs-module.h b/elpa/vterm-20230417.424/emacs-module.h @@ -1,334 +0,0 @@ -/* emacs-module.h - GNU Emacs module API. - -Copyright (C) 2015-2018 Free Software Foundation, Inc. - -This file is part of GNU Emacs. - -GNU Emacs is free software: you can redistribute it and/or modify -it under the terms of the GNU General Public License as published by -the Free Software Foundation, either version 3 of the License, or (at -your option) any later version. - -GNU Emacs is distributed in the hope that it will be useful, -but WITHOUT ANY WARRANTY; without even the implied warranty of -MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -GNU General Public License for more details. - -You should have received a copy of the GNU General Public License -along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. */ - -#ifndef EMACS_MODULE_H -#define EMACS_MODULE_H - -#include <stddef.h> -#include <stdint.h> - -#ifndef __cplusplus -#include <stdbool.h> -#endif - -#if defined __cplusplus && __cplusplus >= 201103L -#define EMACS_NOEXCEPT noexcept -#else -#define EMACS_NOEXCEPT -#endif - -#ifdef __has_attribute -#if __has_attribute(__nonnull__) -#define EMACS_ATTRIBUTE_NONNULL(...) __attribute__((__nonnull__(__VA_ARGS__))) -#endif -#endif -#ifndef EMACS_ATTRIBUTE_NONNULL -#define EMACS_ATTRIBUTE_NONNULL(...) -#endif - -#ifdef __cplusplus -extern "C" { -#endif - -/* Current environment. */ -typedef struct emacs_env_25 emacs_env; - -/* Opaque pointer representing an Emacs Lisp value. - BEWARE: Do not assume NULL is a valid value! */ -typedef struct emacs_value_tag *emacs_value; - -enum { emacs_variadic_function = -2 }; - -/* Struct passed to a module init function (emacs_module_init). */ -struct emacs_runtime { - /* Structure size (for version checking). */ - ptrdiff_t size; - - /* Private data; users should not touch this. */ - struct emacs_runtime_private *private_members; - - /* Return an environment pointer. */ - emacs_env *(*get_environment)(struct emacs_runtime *ert) - EMACS_ATTRIBUTE_NONNULL(1); -}; - -/* Possible Emacs function call outcomes. */ -enum emacs_funcall_exit { - /* Function has returned normally. */ - emacs_funcall_exit_return = 0, - - /* Function has signaled an error using `signal'. */ - emacs_funcall_exit_signal = 1, - - /* Function has exit using `throw'. */ - emacs_funcall_exit_throw = 2 -}; - -struct emacs_env_25 { - /* Structure size (for version checking). */ - ptrdiff_t size; - - /* Private data; users should not touch this. */ - struct emacs_env_private *private_members; - - /* Memory management. */ - - emacs_value (*make_global_ref)(emacs_env *env, emacs_value any_reference) - EMACS_ATTRIBUTE_NONNULL(1); - - void (*free_global_ref)(emacs_env *env, emacs_value global_reference) - EMACS_ATTRIBUTE_NONNULL(1); - - /* Non-local exit handling. */ - - enum emacs_funcall_exit (*non_local_exit_check)(emacs_env *env) - EMACS_ATTRIBUTE_NONNULL(1); - - void (*non_local_exit_clear)(emacs_env *env) EMACS_ATTRIBUTE_NONNULL(1); - - enum emacs_funcall_exit (*non_local_exit_get)( - emacs_env *env, emacs_value *non_local_exit_symbol_out, - emacs_value *non_local_exit_data_out) EMACS_ATTRIBUTE_NONNULL(1, 2, 3); - - void (*non_local_exit_signal)(emacs_env *env, - emacs_value non_local_exit_symbol, - emacs_value non_local_exit_data) - EMACS_ATTRIBUTE_NONNULL(1); - - void (*non_local_exit_throw)(emacs_env *env, emacs_value tag, - emacs_value value) EMACS_ATTRIBUTE_NONNULL(1); - - /* Function registration. */ - - emacs_value (*make_function)( - emacs_env *env, ptrdiff_t min_arity, ptrdiff_t max_arity, - emacs_value (*function)(emacs_env *env, ptrdiff_t nargs, - emacs_value args[], void *) - EMACS_NOEXCEPT EMACS_ATTRIBUTE_NONNULL(1), - const char *documentation, void *data) EMACS_ATTRIBUTE_NONNULL(1, 4); - - emacs_value (*funcall)(emacs_env *env, emacs_value function, ptrdiff_t nargs, - emacs_value args[]) EMACS_ATTRIBUTE_NONNULL(1); - - emacs_value (*intern)(emacs_env *env, const char *symbol_name) - EMACS_ATTRIBUTE_NONNULL(1, 2); - - /* Type conversion. */ - - emacs_value (*type_of)(emacs_env *env, emacs_value value) - EMACS_ATTRIBUTE_NONNULL(1); - - bool (*is_not_nil)(emacs_env *env, emacs_value value) - EMACS_ATTRIBUTE_NONNULL(1); - - bool (*eq)(emacs_env *env, emacs_value a, emacs_value b) - EMACS_ATTRIBUTE_NONNULL(1); - - intmax_t (*extract_integer)(emacs_env *env, emacs_value value) - EMACS_ATTRIBUTE_NONNULL(1); - - emacs_value (*make_integer)(emacs_env *env, intmax_t value) - EMACS_ATTRIBUTE_NONNULL(1); - - double (*extract_float)(emacs_env *env, emacs_value value) - EMACS_ATTRIBUTE_NONNULL(1); - - emacs_value (*make_float)(emacs_env *env, double value) - EMACS_ATTRIBUTE_NONNULL(1); - - /* Copy the content of the Lisp string VALUE to BUFFER as an utf8 - null-terminated string. - - SIZE must point to the total size of the buffer. If BUFFER is - NULL or if SIZE is not big enough, write the required buffer size - to SIZE and return true. - - Note that SIZE must include the last null byte (e.g. "abc" needs - a buffer of size 4). - - Return true if the string was successfully copied. */ - - bool (*copy_string_contents)(emacs_env *env, emacs_value value, char *buffer, - ptrdiff_t *size_inout) - EMACS_ATTRIBUTE_NONNULL(1, 4); - - /* Create a Lisp string from a utf8 encoded string. */ - emacs_value (*make_string)(emacs_env *env, const char *contents, - ptrdiff_t length) EMACS_ATTRIBUTE_NONNULL(1, 2); - - /* Embedded pointer type. */ - emacs_value (*make_user_ptr)(emacs_env *env, - void (*fin)(void *) EMACS_NOEXCEPT, void *ptr) - EMACS_ATTRIBUTE_NONNULL(1); - - void *(*get_user_ptr)(emacs_env *env, - emacs_value uptr)EMACS_ATTRIBUTE_NONNULL(1); - void (*set_user_ptr)(emacs_env *env, emacs_value uptr, void *ptr) - EMACS_ATTRIBUTE_NONNULL(1); - - void (*(*get_user_finalizer)(emacs_env *env, - emacs_value uptr))(void *) EMACS_NOEXCEPT - EMACS_ATTRIBUTE_NONNULL(1); - void (*set_user_finalizer)(emacs_env *env, emacs_value uptr, - void (*fin)(void *) EMACS_NOEXCEPT) - EMACS_ATTRIBUTE_NONNULL(1); - - /* Vector functions. */ - emacs_value (*vec_get)(emacs_env *env, emacs_value vec, ptrdiff_t i) - EMACS_ATTRIBUTE_NONNULL(1); - - void (*vec_set)(emacs_env *env, emacs_value vec, ptrdiff_t i, emacs_value val) - EMACS_ATTRIBUTE_NONNULL(1); - - ptrdiff_t (*vec_size)(emacs_env *env, emacs_value vec) - EMACS_ATTRIBUTE_NONNULL(1); -}; - -struct emacs_env_26 { - /* Structure size (for version checking). */ - ptrdiff_t size; - - /* Private data; users should not touch this. */ - struct emacs_env_private *private_members; - - /* Memory management. */ - - emacs_value (*make_global_ref)(emacs_env *env, emacs_value any_reference) - EMACS_ATTRIBUTE_NONNULL(1); - - void (*free_global_ref)(emacs_env *env, emacs_value global_reference) - EMACS_ATTRIBUTE_NONNULL(1); - - /* Non-local exit handling. */ - - enum emacs_funcall_exit (*non_local_exit_check)(emacs_env *env) - EMACS_ATTRIBUTE_NONNULL(1); - - void (*non_local_exit_clear)(emacs_env *env) EMACS_ATTRIBUTE_NONNULL(1); - - enum emacs_funcall_exit (*non_local_exit_get)( - emacs_env *env, emacs_value *non_local_exit_symbol_out, - emacs_value *non_local_exit_data_out) EMACS_ATTRIBUTE_NONNULL(1, 2, 3); - - void (*non_local_exit_signal)(emacs_env *env, - emacs_value non_local_exit_symbol, - emacs_value non_local_exit_data) - EMACS_ATTRIBUTE_NONNULL(1); - - void (*non_local_exit_throw)(emacs_env *env, emacs_value tag, - emacs_value value) EMACS_ATTRIBUTE_NONNULL(1); - - /* Function registration. */ - - emacs_value (*make_function)( - emacs_env *env, ptrdiff_t min_arity, ptrdiff_t max_arity, - emacs_value (*function)(emacs_env *env, ptrdiff_t nargs, - emacs_value args[], void *) - EMACS_NOEXCEPT EMACS_ATTRIBUTE_NONNULL(1), - const char *documentation, void *data) EMACS_ATTRIBUTE_NONNULL(1, 4); - - emacs_value (*funcall)(emacs_env *env, emacs_value function, ptrdiff_t nargs, - emacs_value args[]) EMACS_ATTRIBUTE_NONNULL(1); - - emacs_value (*intern)(emacs_env *env, const char *symbol_name) - EMACS_ATTRIBUTE_NONNULL(1, 2); - - /* Type conversion. */ - - emacs_value (*type_of)(emacs_env *env, emacs_value value) - EMACS_ATTRIBUTE_NONNULL(1); - - bool (*is_not_nil)(emacs_env *env, emacs_value value) - EMACS_ATTRIBUTE_NONNULL(1); - - bool (*eq)(emacs_env *env, emacs_value a, emacs_value b) - EMACS_ATTRIBUTE_NONNULL(1); - - intmax_t (*extract_integer)(emacs_env *env, emacs_value value) - EMACS_ATTRIBUTE_NONNULL(1); - - emacs_value (*make_integer)(emacs_env *env, intmax_t value) - EMACS_ATTRIBUTE_NONNULL(1); - - double (*extract_float)(emacs_env *env, emacs_value value) - EMACS_ATTRIBUTE_NONNULL(1); - - emacs_value (*make_float)(emacs_env *env, double value) - EMACS_ATTRIBUTE_NONNULL(1); - - /* Copy the content of the Lisp string VALUE to BUFFER as an utf8 - null-terminated string. - - SIZE must point to the total size of the buffer. If BUFFER is - NULL or if SIZE is not big enough, write the required buffer size - to SIZE and return true. - - Note that SIZE must include the last null byte (e.g. "abc" needs - a buffer of size 4). - - Return true if the string was successfully copied. */ - - bool (*copy_string_contents)(emacs_env *env, emacs_value value, char *buffer, - ptrdiff_t *size_inout) - EMACS_ATTRIBUTE_NONNULL(1, 4); - - /* Create a Lisp string from a utf8 encoded string. */ - emacs_value (*make_string)(emacs_env *env, const char *contents, - ptrdiff_t length) EMACS_ATTRIBUTE_NONNULL(1, 2); - - /* Embedded pointer type. */ - emacs_value (*make_user_ptr)(emacs_env *env, - void (*fin)(void *) EMACS_NOEXCEPT, void *ptr) - EMACS_ATTRIBUTE_NONNULL(1); - - void *(*get_user_ptr)(emacs_env *env, - emacs_value uptr)EMACS_ATTRIBUTE_NONNULL(1); - void (*set_user_ptr)(emacs_env *env, emacs_value uptr, void *ptr) - EMACS_ATTRIBUTE_NONNULL(1); - - void (*(*get_user_finalizer)(emacs_env *env, - emacs_value uptr))(void *) EMACS_NOEXCEPT - EMACS_ATTRIBUTE_NONNULL(1); - void (*set_user_finalizer)(emacs_env *env, emacs_value uptr, - void (*fin)(void *) EMACS_NOEXCEPT) - EMACS_ATTRIBUTE_NONNULL(1); - - /* Vector functions. */ - emacs_value (*vec_get)(emacs_env *env, emacs_value vec, ptrdiff_t i) - EMACS_ATTRIBUTE_NONNULL(1); - - void (*vec_set)(emacs_env *env, emacs_value vec, ptrdiff_t i, emacs_value val) - EMACS_ATTRIBUTE_NONNULL(1); - - ptrdiff_t (*vec_size)(emacs_env *env, emacs_value vec) - EMACS_ATTRIBUTE_NONNULL(1); - - /* Returns whether a quit is pending. */ - bool (*should_quit)(emacs_env *env) EMACS_ATTRIBUTE_NONNULL(1); -}; - -/* Every module should define a function as follows. */ -extern int emacs_module_init(struct emacs_runtime *ert) EMACS_NOEXCEPT - EMACS_ATTRIBUTE_NONNULL(1); - -#ifdef __cplusplus -} -#endif - -#endif /* EMACS_MODULE_H */ diff --git a/elpa/vterm-20230417.424/etc/emacs-vterm-bash.sh b/elpa/vterm-20230417.424/etc/emacs-vterm-bash.sh @@ -1,55 +0,0 @@ -# Some of the most useful features in emacs-libvterm require shell-side -# configurations. The main goal of these additional functions is to enable the -# shell to send information to `vterm` via properly escaped sequences. A -# function that helps in this task, `vterm_printf`, is defined below. - -function vterm_printf(){ - if [ -n "$TMUX" ] && ([ "${TERM%%-*}" = "tmux" ] || [ "${TERM%%-*}" = "screen" ] ); then - # Tell tmux to pass the escape sequences through - printf "\ePtmux;\e\e]%s\007\e\\" "$1" - elif [ "${TERM%%-*}" = "screen" ]; then - # GNU screen (screen, screen-256color, screen-256color-bce) - printf "\eP\e]%s\007\e\\" "$1" - else - printf "\e]%s\e\\" "$1" - fi -} - -# Completely clear the buffer. With this, everything that is not on screen -# is erased. -if [[ "$INSIDE_EMACS" = 'vterm' ]]; then - function clear(){ - vterm_printf "51;Evterm-clear-scrollback"; - tput clear; - } -fi - -# With vterm_cmd you can execute Emacs commands directly from the shell. -# For example, vterm_cmd message "HI" will print "HI". -# To enable new commands, you have to customize Emacs's variable -# vterm-eval-cmds. -vterm_cmd() { - local vterm_elisp - vterm_elisp="" - while [ $# -gt 0 ]; do - vterm_elisp="$vterm_elisp""$(printf '"%s" ' "$(printf "%s" "$1" | sed -e 's|\\|\\\\|g' -e 's|"|\\"|g')")" - shift - done - vterm_printf "51;E$vterm_elisp" -} - -# This is to change the title of the buffer based on information provided by the -# shell. See, http://tldp.org/HOWTO/Xterm-Title-4.html, for the meaning of the -# various symbols. -PROMPT_COMMAND="${PROMPT_COMMAND:+$PROMPT_COMMAND; }"'echo -ne "\033]0;${HOSTNAME}:${PWD}\007"' - -# Sync directory and host in the shell with Emacs's current directory. -# You may need to manually specify the hostname instead of $(hostname) in case -# $(hostname) does not return the correct string to connect to the server. -# -# The escape sequence "51;A" has also the role of identifying the end of the -# prompt -vterm_prompt_end(){ - vterm_printf "51;A$(whoami)@$(hostname):$(pwd)" -} -PS1=$PS1'\[$(vterm_prompt_end)\]' diff --git a/elpa/vterm-20230417.424/etc/emacs-vterm-zsh.sh b/elpa/vterm-20230417.424/etc/emacs-vterm-zsh.sh @@ -1,54 +0,0 @@ -# Some of the most useful features in emacs-libvterm require shell-side -# configurations. The main goal of these additional functions is to enable the -# shell to send information to `vterm` via properly escaped sequences. A -# function that helps in this task, `vterm_printf`, is defined below. - -function vterm_printf(){ - if [ -n "$TMUX" ] && ([ "${TERM%%-*}" = "tmux" ] || [ "${TERM%%-*}" = "screen" ] ); then - # Tell tmux to pass the escape sequences through - printf "\ePtmux;\e\e]%s\007\e\\" "$1" - elif [ "${TERM%%-*}" = "screen" ]; then - # GNU screen (screen, screen-256color, screen-256color-bce) - printf "\eP\e]%s\007\e\\" "$1" - else - printf "\e]%s\e\\" "$1" - fi -} - -# Completely clear the buffer. With this, everything that is not on screen -# is erased. -if [[ "$INSIDE_EMACS" = 'vterm' ]]; then - alias clear='vterm_printf "51;Evterm-clear-scrollback";tput clear' -fi - -# With vterm_cmd you can execute Emacs commands directly from the shell. -# For example, vterm_cmd message "HI" will print "HI". -# To enable new commands, you have to customize Emacs's variable -# vterm-eval-cmds. -vterm_cmd() { - local vterm_elisp - vterm_elisp="" - while [ $# -gt 0 ]; do - vterm_elisp="$vterm_elisp""$(printf '"%s" ' "$(printf "%s" "$1" | sed -e 's|\\|\\\\|g' -e 's|"|\\"|g')")" - shift - done - vterm_printf "51;E$vterm_elisp" -} - -# This is to change the title of the buffer based on information provided by the -# shell. See, http://tldp.org/HOWTO/Xterm-Title-4.html, for the meaning of the -# various symbols. -autoload -U add-zsh-hook -add-zsh-hook -Uz chpwd (){ print -Pn "\e]2;%m:%2~\a" } - -# Sync directory and host in the shell with Emacs's current directory. -# You may need to manually specify the hostname instead of $(hostname) in case -# $(hostname) does not return the correct string to connect to the server. -# -# The escape sequence "51;A" has also the role of identifying the end of the -# prompt -vterm_prompt_end() { - vterm_printf "51;A$(whoami)@$(hostname):$(pwd)" -} -setopt PROMPT_SUBST -PROMPT=$PROMPT'%{$(vterm_prompt_end)%}' diff --git a/elpa/vterm-20230417.424/etc/emacs-vterm.fish b/elpa/vterm-20230417.424/etc/emacs-vterm.fish @@ -1,67 +0,0 @@ -# Some of the most useful features in emacs-libvterm require shell-side -# configurations. The main goal of these additional functions is to enable the -# shell to send information to `vterm` via properly escaped sequences. A -# function that helps in this task, `vterm_printf`, is defined below. - -function vterm_printf; - if begin; [ -n "$TMUX" ] ; and string match -q -r "screen|tmux" "$TERM"; end - # tell tmux to pass the escape sequences through - printf "\ePtmux;\e\e]%s\007\e\\" "$argv" - else if string match -q -- "screen*" "$TERM" - # GNU screen (screen, screen-256color, screen-256color-bce) - printf "\eP\e]%s\007\e\\" "$argv" - else - printf "\e]%s\e\\" "$argv" - end -end - -# Completely clear the buffer. With this, everything that is not on screen -# is erased. -if [ "$INSIDE_EMACS" = 'vterm' ] - function clear - vterm_printf "51;Evterm-clear-scrollback"; - tput clear; - end -end - -# This is to change the title of the buffer based on information provided by the -# shell. See, http://tldp.org/HOWTO/Xterm-Title-4.html, for the meaning of the -# various symbols. -function fish_title - hostname - echo ":" - prompt_pwd -end - -# With vterm_cmd you can execute Emacs commands directly from the shell. -# For example, vterm_cmd message "HI" will print "HI". -# To enable new commands, you have to customize Emacs's variable -# vterm-eval-cmds. -function vterm_cmd --description 'Run an Emacs command among the ones defined in vterm-eval-cmds.' - set -l vterm_elisp () - for arg in $argv - set -a vterm_elisp (printf '"%s" ' (string replace -a -r '([\\\\"])' '\\\\\\\\$1' $arg)) - end - vterm_printf '51;E'(string join '' $vterm_elisp) -end - -# Sync directory and host in the shell with Emacs's current directory. -# You may need to manually specify the hostname instead of $(hostname) in case -# $(hostname) does not return the correct string to connect to the server. -# -# The escape sequence "51;A" has also the role of identifying the end of the -# prompt -function vterm_prompt_end; - vterm_printf '51;A'(whoami)'@'(hostname)':'(pwd) -end - -# We are going to add a portion to the prompt, so we copy the old one -functions --copy fish_prompt vterm_old_fish_prompt - -function fish_prompt --description 'Write out the prompt; do not replace this. Instead, put this at end of your file.' - # Remove the trailing newline from the original prompt. This is done - # using the string builtin from fish, but to make sure any escape codes - # are correctly interpreted, use %b for printf. - printf "%b" (string join "\n" (vterm_old_fish_prompt)) - vterm_prompt_end -end diff --git a/elpa/vterm-20230417.424/utf8.c b/elpa/vterm-20230417.424/utf8.c @@ -1,69 +0,0 @@ -#include "utf8.h" - -size_t codepoint_to_utf8(const uint32_t codepoint, unsigned char buffer[4]) { - if (codepoint <= 0x7F) { - buffer[0] = codepoint; - return 1; - } - if (codepoint >= 0x80 && codepoint <= 0x07FF) { - buffer[0] = 0xC0 | (codepoint >> 6); - buffer[1] = 0x80 | (codepoint & 0x3F); - return 2; - } - if (codepoint >= 0x0800 && codepoint <= 0xFFFF) { - buffer[0] = 0xE0 | (codepoint >> 12); - buffer[1] = 0x80 | ((codepoint >> 6) & 0x3F); - buffer[2] = 0x80 | (codepoint & 0x3F); - return 3; - } - - if (codepoint >= 0x10000 && codepoint <= 0x10FFFF) { - buffer[0] = 0xF0 | (codepoint >> 18); - buffer[1] = 0x80 | ((codepoint >> 12) & 0x3F); - buffer[2] = 0x80 | ((codepoint >> 6) & 0x3F); - buffer[3] = 0x80 | (codepoint & 0x3F); - return 4; - } - return 0; -} - -bool utf8_to_codepoint(const unsigned char buffer[4], const size_t len, - uint32_t *codepoint) { - *codepoint = 0; - if (len == 1 && buffer[0] <= 0x7F) { - *codepoint = buffer[0]; - return true; - } - if (len == 2 && (buffer[0] >= 0xC0 && buffer[0] <= 0xDF) && - (buffer[1] >= 0x80 && buffer[1] <= 0xBF)) { - *codepoint = buffer[0] & 0x1F; - *codepoint = *codepoint << 6; - *codepoint = *codepoint | (buffer[1] & 0x3F); - return true; - } - if (len == 3 && (buffer[0] >= 0xE0 && buffer[0] <= 0xEF) && - (buffer[1] >= 0x80 && buffer[1] <= 0xBF) && - (buffer[2] >= 0x80 && buffer[2] <= 0xBF)) { - *codepoint = buffer[0] & 0xF; - *codepoint = *codepoint << 6; - *codepoint = *codepoint | (buffer[1] & 0x3F); - *codepoint = *codepoint << 6; - *codepoint = *codepoint | (buffer[2] & 0x3F); - return true; - } - if (len == 4 && (buffer[0] >= 0xF0 && buffer[0] <= 0xF7) && - (buffer[1] >= 0x80 && buffer[1] <= 0xBF) && - (buffer[2] >= 0x80 && buffer[2] <= 0xBF) && - (buffer[3] >= 0x80 && buffer[3] <= 0xBF)) { - *codepoint = buffer[0] & 7; - *codepoint = *codepoint << 6; - *codepoint = *codepoint | (buffer[1] & 0x3F); - *codepoint = *codepoint << 6; - *codepoint = *codepoint | (buffer[2] & 0x3F); - *codepoint = *codepoint << 6; - *codepoint = *codepoint | (buffer[3] & 0x3F); - return true; - } - - return false; -} diff --git a/elpa/vterm-20230417.424/utf8.h b/elpa/vterm-20230417.424/utf8.h @@ -1,12 +0,0 @@ -#ifndef UTF8_H -#define UTF8_H - -#include <stdbool.h> -#include <stddef.h> -#include <stdint.h> - -size_t codepoint_to_utf8(const uint32_t codepoint, unsigned char buffer[4]); -bool utf8_to_codepoint(const unsigned char buffer[4], const size_t len, - uint32_t *codepoint); - -#endif /* UTF8_H */ diff --git a/elpa/vterm-20230417.424/vterm-autoloads.el b/elpa/vterm-20230417.424/vterm-autoloads.el @@ -1,81 +0,0 @@ -;;; vterm-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 (file-name-directory load-file-name)) (car load-path))) - - - -;;; Generated autoloads from vterm.el - -(autoload 'vterm-module-compile "vterm" "\ -Compile vterm-module." t) -(autoload 'vterm--bookmark-handler "vterm" "\ -Handler to restore a vterm bookmark BMK. - -If a vterm buffer of the same name does not exist, the function will create a -new vterm buffer of the name. It also checks the current directory and sets -it to the bookmarked directory if needed. - -(fn BMK)") -(autoload 'vterm-next-error-function "vterm" "\ -Advance to the next error message and visit the file where the error was. -This is the value of `next-error-function' in Compilation -buffers. Prefix arg N says how many error messages to move -forwards (or backwards, if negative). - -Optional argument RESET clears all the errors. - -(fn N &optional RESET)" t) -(autoload 'vterm "vterm" "\ -Create an interactive Vterm buffer. -Start a new Vterm session, or switch to an already active -session. Return the buffer selected (or created). - -With a nonnumeric prefix arg, create a new session. - -With a string prefix arg, create a new session with arg as buffer name. - -With a numeric prefix arg (as in `C-u 42 M-x vterm RET'), switch -to the session with that number, or create it if it doesn't -already exist. - -The buffer name used for Vterm sessions is determined by the -value of `vterm-buffer-name'. - -(fn &optional ARG)" t) -(autoload 'vterm-other-window "vterm" "\ -Create an interactive Vterm buffer in another window. -Start a new Vterm session, or switch to an already active -session. Return the buffer selected (or created). - -With a nonnumeric prefix arg, create a new session. - -With a string prefix arg, create a new session with arg as buffer name. - -With a numeric prefix arg (as in `C-u 42 M-x vterm RET'), switch -to the session with that number, or create it if it doesn't -already exist. - -The buffer name used for Vterm sessions is determined by the -value of `vterm-buffer-name'. - -(fn &optional ARG)" t) -(register-definition-prefixes "vterm" '("vterm-")) - -;;; End of scraped data - -(provide 'vterm-autoloads) - -;; Local Variables: -;; version-control: never -;; no-byte-compile: t -;; no-update-autoloads: t -;; no-native-compile: t -;; coding: utf-8-emacs-unix -;; End: - -;;; vterm-autoloads.el ends here diff --git a/elpa/vterm-20230417.424/vterm-module.c b/elpa/vterm-20230417.424/vterm-module.c @@ -1,1539 +0,0 @@ -#include "vterm-module.h" -#include "elisp.h" -#include "utf8.h" -#include <assert.h> -#include <fcntl.h> -#include <limits.h> -#include <stdio.h> -#include <string.h> -#include <termios.h> -#include <unistd.h> -#include <vterm.h> - -static LineInfo *alloc_lineinfo() { - LineInfo *info = malloc(sizeof(LineInfo)); - info->directory = NULL; - info->prompt_col = -1; - return info; -} -void free_lineinfo(LineInfo *line) { - if (line == NULL) { - return; - } - if (line->directory != NULL) { - free(line->directory); - line->directory = NULL; - } - free(line); -} -static int term_sb_push(int cols, const VTermScreenCell *cells, void *data) { - Term *term = (Term *)data; - - if (!term->sb_size) { - return 0; - } - - // copy vterm cells into sb_buffer - size_t c = (size_t)cols; - ScrollbackLine *sbrow = NULL; - if (term->sb_current == term->sb_size) { - if (term->sb_buffer[term->sb_current - 1]->cols == c) { - // Recycle old row if it's the right size - sbrow = term->sb_buffer[term->sb_current - 1]; - } else { - if (term->sb_buffer[term->sb_current - 1]->info != NULL) { - free_lineinfo(term->sb_buffer[term->sb_current - 1]->info); - term->sb_buffer[term->sb_current - 1]->info = NULL; - } - free(term->sb_buffer[term->sb_current - 1]); - } - - // Make room at the start by shifting to the right. - memmove(term->sb_buffer + 1, term->sb_buffer, - sizeof(term->sb_buffer[0]) * (term->sb_current - 1)); - - } else if (term->sb_current > 0) { - // Make room at the start by shifting to the right. - memmove(term->sb_buffer + 1, term->sb_buffer, - sizeof(term->sb_buffer[0]) * term->sb_current); - } - - if (!sbrow) { - sbrow = malloc(sizeof(ScrollbackLine) + c * sizeof(sbrow->cells[0])); - sbrow->cols = c; - sbrow->info = NULL; - } - if (sbrow->info != NULL) { - free_lineinfo(sbrow->info); - } - sbrow->info = term->lines[0]; - memmove(term->lines, term->lines + 1, - sizeof(term->lines[0]) * (term->lines_len - 1)); - if (term->resizing) { - /* pushed by window height decr */ - if (term->lines[term->lines_len - 1] != NULL) { - /* do not need free here ,it is reused ,we just need set null */ - term->lines[term->lines_len - 1] = NULL; - } - term->lines_len--; - } else { - LineInfo *lastline = term->lines[term->lines_len - 1]; - if (lastline != NULL) { - LineInfo *line = alloc_lineinfo(); - if (lastline->directory != NULL) { - line->directory = malloc(1 + strlen(lastline->directory)); - strcpy(line->directory, lastline->directory); - } - term->lines[term->lines_len - 1] = line; - } - } - - // New row is added at the start of the storage buffer. - term->sb_buffer[0] = sbrow; - if (term->sb_current < term->sb_size) { - term->sb_current++; - } - - if (term->sb_pending < term->sb_size) { - term->sb_pending++; - /* when window height decreased */ - if (term->height_resize < 0 && - term->sb_pending_by_height_decr < -term->height_resize) { - term->sb_pending_by_height_decr++; - } - } - - memcpy(sbrow->cells, cells, c * sizeof(cells[0])); - - return 1; -} -/// Scrollback pop handler (from pangoterm). -/// -/// @param cols -/// @param cells VTerm state to update. -/// @param data Term -static int term_sb_pop(int cols, VTermScreenCell *cells, void *data) { - Term *term = (Term *)data; - - if (!term->sb_current) { - return 0; - } - - if (term->sb_pending) { - term->sb_pending--; - } - - ScrollbackLine *sbrow = term->sb_buffer[0]; - term->sb_current--; - // Forget the "popped" row by shifting the rest onto it. - memmove(term->sb_buffer, term->sb_buffer + 1, - sizeof(term->sb_buffer[0]) * (term->sb_current)); - - size_t cols_to_copy = (size_t)cols; - if (cols_to_copy > sbrow->cols) { - cols_to_copy = sbrow->cols; - } - - // copy to vterm state - memcpy(cells, sbrow->cells, sizeof(cells[0]) * cols_to_copy); - size_t col; - for (col = cols_to_copy; col < (size_t)cols; col++) { - cells[col].chars[0] = 0; - cells[col].width = 1; - } - - LineInfo **lines = malloc(sizeof(LineInfo *) * (term->lines_len + 1)); - - memmove(lines + 1, term->lines, sizeof(term->lines[0]) * term->lines_len); - lines[0] = sbrow->info; - free(sbrow); - term->lines_len += 1; - free(term->lines); - term->lines = lines; - - return 1; -} - -static int term_sb_clear(void *data) { - Term *term = (Term *)data; - - if (term->sb_clear_pending) { - // Another scrollback clear is already pending, so skip this one. - return 0; - } - - for (int i = 0; i < term->sb_current; i++) { - if (term->sb_buffer[i]->info != NULL) { - free_lineinfo(term->sb_buffer[i]->info); - term->sb_buffer[i]->info = NULL; - } - free(term->sb_buffer[i]); - } - free(term->sb_buffer); - term->sb_buffer = malloc(sizeof(ScrollbackLine *) * term->sb_size); - term->sb_clear_pending = true; - term->sb_current = 0; - term->sb_pending = 0; - term->sb_pending_by_height_decr = 0; - invalidate_terminal(term, -1, -1); - - return 0; -} - -static int row_to_linenr(Term *term, int row) { - return row != INT_MAX ? row + (int)term->sb_current + 1 : INT_MAX; -} - -static int linenr_to_row(Term *term, int linenr) { - return linenr - (int)term->sb_current - 1; -} - -static void fetch_cell(Term *term, int row, int col, VTermScreenCell *cell) { - if (row < 0) { - ScrollbackLine *sbrow = term->sb_buffer[-row - 1]; - if ((size_t)col < sbrow->cols) { - *cell = sbrow->cells[col]; - } else { - // fill the pointer with an empty cell - VTermColor fg, bg; - VTermState *state = vterm_obtain_state(term->vt); - vterm_state_get_default_colors(state, &fg, &bg); - - *cell = (VTermScreenCell){.chars = {0}, .width = 1, .bg = bg}; - } - } else { - vterm_screen_get_cell(term->vts, (VTermPos){.row = row, .col = col}, cell); - } -} - -static char *get_row_directory(Term *term, int row) { - if (row < 0) { - ScrollbackLine *sbrow = term->sb_buffer[-row - 1]; - return sbrow->info->directory; - /* return term->dirs[0]; */ - } else { - LineInfo *line = term->lines[row]; - return line ? line->directory : NULL; - } -} -static LineInfo *get_lineinfo(Term *term, int row) { - if (row < 0) { - ScrollbackLine *sbrow = term->sb_buffer[-row - 1]; - return sbrow->info; - /* return term->dirs[0]; */ - } else { - return term->lines[row]; - } -} -static bool is_eol(Term *term, int end_col, int row, int col) { - /* This cell is EOL if this and every cell to the right is black */ - if (row >= 0) { - VTermPos pos = {.row = row, .col = col}; - return vterm_screen_is_eol(term->vts, pos); - } - - ScrollbackLine *sbrow = term->sb_buffer[-row - 1]; - int c; - for (c = col; c < end_col && c < sbrow->cols;) { - if (sbrow->cells[c].chars[0]) { - return 0; - } - c += sbrow->cells[c].width; - } - return 1; -} -static int is_end_of_prompt(Term *term, int end_col, int row, int col) { - LineInfo *info = get_lineinfo(term, row); - if (info == NULL) { - return 0; - } - if (info->prompt_col < 0) { - return 0; - } - if (info->prompt_col == col) { - return 1; - } - if (is_eol(term, end_col, row, col) && info->prompt_col >= col) { - return 1; - } - return 0; -} - -static void goto_col(Term *term, emacs_env *env, int row, int end_col) { - int col = 0; - size_t offset = 0; - size_t beyond_eol = 0; - - int height; - int width; - vterm_get_size(term->vt, &height, &width); - - while (col < end_col) { - VTermScreenCell cell; - fetch_cell(term, row, col, &cell); - if (cell.chars[0]) { - if (cell.width > 1) { - offset += cell.width - 1; - } - } else { - if (is_eol(term, term->width, row, col)) { - offset += cell.width; - beyond_eol += cell.width; - } - } - col += cell.width; - } - - forward_char(env, env->make_integer(env, end_col - offset)); - emacs_value space = env->make_string(env, " ", 1); - for (int i = 0; i < beyond_eol; i += 1) - insert(env, space); -} - -static void refresh_lines(Term *term, emacs_env *env, int start_row, - int end_row, int end_col) { - if (end_row < start_row) { - return; - } - int i, j; - -#define PUSH_BUFFER(c) \ - do { \ - if (length == capacity) { \ - capacity += end_col * 4; \ - buffer = realloc(buffer, capacity * sizeof(char)); \ - } \ - buffer[length] = (c); \ - length++; \ - } while (0) - - int capacity = ((end_row - start_row + 1) * end_col) * 4; - int length = 0; - char *buffer = malloc(capacity * sizeof(char)); - VTermScreenCell cell; - VTermScreenCell lastCell; - fetch_cell(term, start_row, 0, &lastCell); - - for (i = start_row; i < end_row; i++) { - - int newline = 0; - int isprompt = 0; - for (j = 0; j < end_col; j++) { - fetch_cell(term, i, j, &cell); - if (isprompt && length > 0) { - emacs_value text = render_text(env, term, buffer, length, &lastCell); - insert(env, render_prompt(env, text)); - length = 0; - } - - isprompt = is_end_of_prompt(term, end_col, i, j); - if (isprompt && length > 0) { - insert(env, render_text(env, term, buffer, length, &lastCell)); - length = 0; - } - - if (!compare_cells(&cell, &lastCell)) { - emacs_value text = render_text(env, term, buffer, length, &lastCell); - insert(env, text); - length = 0; - } - - lastCell = cell; - if (cell.chars[0] == 0) { - if (is_eol(term, end_col, i, j)) { - /* This cell is EOL if this and every cell to the right is black */ - PUSH_BUFFER('\n'); - newline = 1; - break; - } - PUSH_BUFFER(' '); - } else { - for (int k = 0; k < VTERM_MAX_CHARS_PER_CELL && cell.chars[k]; ++k) { - unsigned char bytes[4]; - size_t count = codepoint_to_utf8(cell.chars[k], bytes); - for (int l = 0; l < count; l++) { - PUSH_BUFFER(bytes[l]); - } - } - } - - if (cell.width > 1) { - int w = cell.width - 1; - j = j + w; - } - } - if (isprompt && length > 0) { - emacs_value text = render_text(env, term, buffer, length, &lastCell); - insert(env, render_prompt(env, text)); - length = 0; - isprompt = 0; - } - - if (!newline) { - emacs_value text = render_text(env, term, buffer, length, &lastCell); - insert(env, text); - length = 0; - text = render_fake_newline(env, term); - insert(env, text); - } - } - emacs_value text = render_text(env, term, buffer, length, &lastCell); - insert(env, text); - -#undef PUSH_BUFFER - free(buffer); - - return; -} -// Refresh the screen (visible part of the buffer when the terminal is -// focused) of a invalidated terminal -static void refresh_screen(Term *term, emacs_env *env) { - // Term height may have decreased before `invalid_end` reflects it. - term->invalid_end = MIN(term->invalid_end, term->height); - - if (term->invalid_end >= term->invalid_start) { - int startrow = -(term->height - term->invalid_start - term->linenum_added); - /* startrow is negative,so we backward -startrow lines from end of buffer - then delete lines there. - */ - goto_line(env, startrow); - delete_lines(env, startrow, term->invalid_end - term->invalid_start, true); - refresh_lines(term, env, term->invalid_start, term->invalid_end, - term->width); - - /* term->linenum_added is lines added by window height increased */ - term->linenum += term->linenum_added; - term->linenum_added = 0; - } - - term->invalid_start = INT_MAX; - term->invalid_end = -1; -} - -static int term_resize(int rows, int cols, void *user_data) { - /* can not use invalidate_terminal here */ - /* when the window height decreased, */ - /* the value of term->invalid_end can't bigger than window height */ - Term *term = (Term *)user_data; - term->invalid_start = 0; - term->invalid_end = rows; - - /* if rows=term->lines_len, that means term_sb_pop already resize term->lines - */ - /* if rows<term->lines_len, term_sb_push would resize term->lines there */ - /* we noly need to take care of rows>term->height */ - - if (rows > term->height) { - if (rows > term->lines_len) { - LineInfo **infos = term->lines; - term->lines = malloc(sizeof(LineInfo *) * rows); - memmove(term->lines, infos, sizeof(infos[0]) * term->lines_len); - - LineInfo *lastline = term->lines[term->lines_len - 1]; - for (int i = term->lines_len; i < rows; i++) { - if (lastline != NULL) { - LineInfo *line = alloc_lineinfo(); - if (lastline->directory != NULL) { - line->directory = - malloc(1 + strlen(term->lines[term->lines_len - 1]->directory)); - strcpy(line->directory, - term->lines[term->lines_len - 1]->directory); - } - term->lines[i] = line; - } else { - term->lines[i] = NULL; - } - } - term->lines_len = rows; - free(infos); - } - } - - term->width = cols; - term->height = rows; - - invalidate_terminal(term, -1, -1); - term->resizing = false; - - return 1; -} - -// Refresh the scrollback of an invalidated terminal. -static void refresh_scrollback(Term *term, emacs_env *env) { - int max_line_count = (int)term->sb_current + term->height; - int del_cnt = 0; - if (term->sb_clear_pending) { - del_cnt = term->linenum - term->height; - if (del_cnt > 0) { - delete_lines(env, 1, del_cnt, true); - term->linenum -= del_cnt; - } - term->sb_clear_pending = false; - } - if (term->sb_pending > 0) { - // This means that either the window height has decreased or the screen - // became full and libvterm had to push all rows up. Convert the first - // pending scrollback row into a string and append it just above the visible - // section of the buffer - - del_cnt = term->linenum - term->height - (int)term->sb_size + - term->sb_pending - term->sb_pending_by_height_decr; - if (del_cnt > 0) { - delete_lines(env, 1, del_cnt, true); - term->linenum -= del_cnt; - } - - term->linenum += term->sb_pending; - del_cnt = term->linenum - max_line_count; /* extra lines at the bottom */ - /* buf_index is negative,so we move to end of buffer,then backward - -buf_index lines. goto lines backward is effectively when - vterm-max-scrollback is a large number. - */ - int buf_index = -(term->height + del_cnt); - goto_line(env, buf_index); - refresh_lines(term, env, -term->sb_pending, 0, term->width); - - term->sb_pending = 0; - } - - // Remove extra lines at the bottom - del_cnt = term->linenum - max_line_count; - if (del_cnt > 0) { - term->linenum -= del_cnt; - /* -del_cnt is negative,so we delete_lines from end of buffer. - this line means: delete del_cnt count of lines at end of buffer. - */ - delete_lines(env, -del_cnt, del_cnt, true); - } - - term->sb_pending_by_height_decr = 0; - term->height_resize = 0; -} - -static void adjust_topline(Term *term, emacs_env *env) { - VTermState *state = vterm_obtain_state(term->vt); - VTermPos pos; - vterm_state_get_cursorpos(state, &pos); - - /* pos.row-term->height is negative,so we backward term->height-pos.row - * lines from end of buffer - */ - - goto_line(env, pos.row - term->height); - goto_col(term, env, pos.row, pos.col); - - emacs_value windows = get_buffer_window_list(env); - emacs_value swindow = selected_window(env); - int winnum = env->extract_integer(env, length(env, windows)); - for (int i = 0; i < winnum; i++) { - emacs_value window = nth(env, i, windows); - if (eq(env, window, swindow)) { - int win_body_height = - env->extract_integer(env, window_body_height(env, window)); - - /* recenter:If ARG is negative, it counts up from the bottom of the - * window. (ARG should be less than the height of the window ) */ - if (term->height - pos.row <= win_body_height) { - recenter(env, env->make_integer(env, pos.row - term->height)); - } else { - recenter(env, env->make_integer(env, pos.row)); - } - } else { - if (env->is_not_nil(env, window)) { - set_window_point(env, window, point(env)); - } - } - } -} - -static void invalidate_terminal(Term *term, int start_row, int end_row) { - if (start_row != -1 && end_row != -1) { - term->invalid_start = MIN(term->invalid_start, start_row); - term->invalid_end = MAX(term->invalid_end, end_row); - } - term->is_invalidated = true; -} - -static int term_damage(VTermRect rect, void *data) { - invalidate_terminal(data, rect.start_row, rect.end_row); - return 1; -} - -static int term_moverect(VTermRect dest, VTermRect src, void *data) { - invalidate_terminal(data, MIN(dest.start_row, src.start_row), - MAX(dest.end_row, src.end_row)); - return 1; -} - -static int term_movecursor(VTermPos new, VTermPos old, int visible, - void *data) { - Term *term = data; - term->cursor.row = new.row; - term->cursor.col = new.col; - invalidate_terminal(term, old.row, old.row + 1); - invalidate_terminal(term, new.row, new.row + 1); - - return 1; -} - -static void term_redraw_cursor(Term *term, emacs_env *env) { - if (term->cursor.cursor_blink_changed) { - term->cursor.cursor_blink_changed = false; - set_cursor_blink(env, term->cursor.cursor_blink); - } - - if (term->cursor.cursor_type_changed) { - term->cursor.cursor_type_changed = false; - - if (!term->cursor.cursor_visible) { - set_cursor_type(env, Qnil); - return; - } - - switch (term->cursor.cursor_type) { - case VTERM_PROP_CURSORSHAPE_BLOCK: - set_cursor_type(env, Qbox); - break; - case VTERM_PROP_CURSORSHAPE_UNDERLINE: - set_cursor_type(env, Qhbar); - break; - case VTERM_PROP_CURSORSHAPE_BAR_LEFT: - set_cursor_type(env, Qbar); - break; - default: - set_cursor_type(env, Qt); - break; - } - } -} - -static void term_redraw(Term *term, emacs_env *env) { - term_redraw_cursor(term, env); - - if (term->is_invalidated) { - int oldlinenum = term->linenum; - refresh_scrollback(term, env); - refresh_screen(term, env); - term->linenum_added = term->linenum - oldlinenum; - adjust_topline(term, env); - term->linenum_added = 0; - } - - if (term->title_changed) { - set_title(env, env->make_string(env, term->title, strlen(term->title))); - term->title_changed = false; - } - - if (term->directory_changed) { - set_directory( - env, env->make_string(env, term->directory, strlen(term->directory))); - term->directory_changed = false; - } - - while (term->elisp_code_first) { - ElispCodeListNode *node = term->elisp_code_first; - term->elisp_code_first = node->next; - emacs_value elisp_code = env->make_string(env, node->code, node->code_len); - vterm_eval(env, elisp_code); - - free(node->code); - free(node); - } - term->elisp_code_p_insert = &term->elisp_code_first; - - if (term->selection_data) { - emacs_value selection_mask = env->make_integer(env, term->selection_mask); - emacs_value selection_data = env->make_string(env, term->selection_data, - strlen(term->selection_data)); - vterm_set_selection(env, selection_mask, selection_data); - free(term->selection_data); - term->selection_data = NULL; - term->selection_mask = 0; - } - - term->is_invalidated = false; -} - -static VTermScreenCallbacks vterm_screen_callbacks = { - .damage = term_damage, - .moverect = term_moverect, - .movecursor = term_movecursor, - .settermprop = term_settermprop, - .resize = term_resize, - .sb_pushline = term_sb_push, - .sb_popline = term_sb_pop, -#if !defined(VTermSBClearNotExists) - .sb_clear = term_sb_clear, -#endif -}; - -static bool compare_cells(VTermScreenCell *a, VTermScreenCell *b) { - bool equal = true; - equal = equal && vterm_color_is_equal(&a->fg, &b->fg); - equal = equal && vterm_color_is_equal(&a->bg, &b->bg); - equal = equal && (a->attrs.bold == b->attrs.bold); - equal = equal && (a->attrs.underline == b->attrs.underline); - equal = equal && (a->attrs.italic == b->attrs.italic); - equal = equal && (a->attrs.reverse == b->attrs.reverse); - equal = equal && (a->attrs.strike == b->attrs.strike); - return equal; -} - -static bool is_key(unsigned char *key, size_t len, char *key_description) { - return (len == strlen(key_description) && - memcmp(key, key_description, len) == 0); -} - -/* str1=concat(str1,str2,str2_len,true); */ -/* str1 can be NULL */ -static char *concat(char *str1, const char *str2, size_t str2_len, - bool free_str1) { - if (str1 == NULL) { - str1 = malloc(str2_len + 1); - memcpy(str1, str2, str2_len); - str1[str2_len] = '\0'; - return str1; - } - size_t str1_len = strlen(str1); - char *buf = malloc(str1_len + str2_len + 1); - memcpy(buf, str1, str1_len); - memcpy(&buf[str1_len], str2, str2_len); - buf[str1_len + str2_len] = '\0'; - if (free_str1) { - free(str1); - } - return buf; -} -static void term_set_title(Term *term, const char *title, size_t len, - bool initial, bool final) { - if (term->title && initial) { - free(term->title); - term->title = NULL; - term->title_changed = false; - } - term->title = concat(term->title, title, len, true); - if (final) { - term->title_changed = true; - } - return; -} - -static int term_settermprop(VTermProp prop, VTermValue *val, void *user_data) { - Term *term = (Term *)user_data; - switch (prop) { - case VTERM_PROP_CURSORVISIBLE: - invalidate_terminal(term, term->cursor.row, term->cursor.row + 1); - term->cursor.cursor_visible = val->boolean; - term->cursor.cursor_type_changed = true; - break; - case VTERM_PROP_CURSORBLINK: - if (term->ignore_blink_cursor) - break; - invalidate_terminal(term, term->cursor.row, term->cursor.row + 1); - term->cursor.cursor_blink = val->boolean; - term->cursor.cursor_blink_changed = true; - break; - case VTERM_PROP_CURSORSHAPE: - invalidate_terminal(term, term->cursor.row, term->cursor.row + 1); - term->cursor.cursor_type = val->number; - term->cursor.cursor_type_changed = true; - break; - case VTERM_PROP_TITLE: -#ifdef VTermStringFragmentNotExists - term_set_title(term, val->string, strlen(val->string), true, true); -#else - term_set_title(term, val->string.str, val->string.len, val->string.initial, - val->string.final); -#endif - break; - case VTERM_PROP_ALTSCREEN: - invalidate_terminal(term, 0, term->height); - break; - default: - return 0; - } - - return 1; -} - -static emacs_value render_text(emacs_env *env, Term *term, char *buffer, - int len, VTermScreenCell *cell) { - emacs_value text; - if (len == 0) { - text = env->make_string(env, "", 0); - return text; - } else { - text = env->make_string(env, buffer, len); - } - - emacs_value fg = cell_rgb_color(env, term, cell, true); - emacs_value bg = cell_rgb_color(env, term, cell, false); - /* With vterm-disable-bold-font, vterm-disable-underline, - * vterm-disable-inverse-video, users can disable some text properties. - * Here, we check whether the text would require adding such properties. - * In case it does, and the user does not disable the attribute, we later - * append the property to the list props. If the text does not require - * such property, or the user disable it, we set the variable to nil. - * Properties that are marked as nil are not added to the text. */ - emacs_value bold = - cell->attrs.bold && !term->disable_bold_font ? Qbold : Qnil; - emacs_value underline = - cell->attrs.underline && !term->disable_underline ? Qt : Qnil; - emacs_value italic = cell->attrs.italic ? Qitalic : Qnil; - emacs_value reverse = - cell->attrs.reverse && !term->disable_inverse_video ? Qt : Qnil; - emacs_value strike = cell->attrs.strike ? Qt : Qnil; - - // TODO: Blink, font, dwl, dhl is missing - int emacs_major_version = - env->extract_integer(env, symbol_value(env, Qemacs_major_version)); - emacs_value properties; - emacs_value props[64]; - int props_len = 0; - if (env->is_not_nil(env, fg)) - props[props_len++] = Qforeground, props[props_len++] = fg; - if (env->is_not_nil(env, bg)) - props[props_len++] = Qbackground, props[props_len++] = bg; - if (bold != Qnil) - props[props_len++] = Qweight, props[props_len++] = bold; - if (underline != Qnil) - props[props_len++] = Qunderline, props[props_len++] = underline; - if (italic != Qnil) - props[props_len++] = Qslant, props[props_len++] = italic; - if (reverse != Qnil) - props[props_len++] = Qreverse, props[props_len++] = reverse; - if (strike != Qnil) - props[props_len++] = Qstrike, props[props_len++] = strike; - if (emacs_major_version >= 27) - props[props_len++] = Qextend, props[props_len++] = Qt; - - properties = list(env, props, props_len); - - if (props_len) - put_text_property(env, text, Qface, properties); - - return text; -} -static emacs_value render_prompt(emacs_env *env, emacs_value text) { - - emacs_value properties; - - properties = - list(env, (emacs_value[]){Qvterm_prompt, Qt, Qrear_nonsticky, Qt}, 4); - - add_text_properties(env, text, properties); - - return text; -} - -static emacs_value render_fake_newline(emacs_env *env, Term *term) { - - emacs_value text; - text = env->make_string(env, "\n", 1); - - emacs_value properties; - - properties = - list(env, (emacs_value[]){Qvterm_line_wrap, Qt, Qrear_nonsticky, Qt}, 4); - - add_text_properties(env, text, properties); - - return text; -} - -static emacs_value cell_rgb_color(emacs_env *env, Term *term, - VTermScreenCell *cell, bool is_foreground) { - VTermColor *color = is_foreground ? &cell->fg : &cell->bg; - - /** NOTE: -10 is used as index offset for special indexes, - * see C-h f vterm--get-color RET - */ - if (VTERM_COLOR_IS_DEFAULT_FG(color)) { - return vterm_get_color(env, -1 + (cell->attrs.underline ? -10 : 0)); - } - if (VTERM_COLOR_IS_DEFAULT_BG(color)) { - return vterm_get_color(env, -2 + (cell->attrs.reverse ? -10 : 0)); - } - if (VTERM_COLOR_IS_INDEXED(color)) { - if (color->indexed.idx < 16) { - return vterm_get_color(env, color->indexed.idx); - } else { - VTermState *state = vterm_obtain_state(term->vt); - vterm_state_get_palette_color(state, color->indexed.idx, color); - } - } else if (VTERM_COLOR_IS_RGB(color)) { - /* do nothing just use the argument color directly */ - } - - char buffer[8]; - snprintf(buffer, 8, "#%02X%02X%02X", color->rgb.red, color->rgb.green, - color->rgb.blue); - return env->make_string(env, buffer, 7); -} - -static void term_flush_output(Term *term, emacs_env *env) { - size_t len = vterm_output_get_buffer_current(term->vt); - if (len) { - char buffer[len]; - len = vterm_output_read(term->vt, buffer, len); - - emacs_value output = env->make_string(env, buffer, len); - env->funcall(env, Fvterm_flush_output, 1, (emacs_value[]){output}); - } -} - -static void term_clear_scrollback(Term *term, emacs_env *env) { - term_sb_clear(term); - vterm_screen_flush_damage(term->vts); - term_redraw(term, env); -} - -static void term_process_key(Term *term, emacs_env *env, unsigned char *key, - size_t len, VTermModifier modifier) { - if (is_key(key, len, "<clear_scrollback>")) { - term_clear_scrollback(term, env); - } else if (is_key(key, len, "<start>")) { - tcflow(term->pty_fd, TCOON); - } else if (is_key(key, len, "<stop>")) { - tcflow(term->pty_fd, TCOOFF); - } else if (is_key(key, len, "<start_paste>")) { - vterm_keyboard_start_paste(term->vt); - } else if (is_key(key, len, "<end_paste>")) { - vterm_keyboard_end_paste(term->vt); - } else if (is_key(key, len, "<tab>")) { - vterm_keyboard_key(term->vt, VTERM_KEY_TAB, modifier); - } else if (is_key(key, len, "<backtab>") || - is_key(key, len, "<iso-lefttab>")) { - vterm_keyboard_key(term->vt, VTERM_KEY_TAB, VTERM_MOD_SHIFT); - } else if (is_key(key, len, "<backspace>")) { - vterm_keyboard_key(term->vt, VTERM_KEY_BACKSPACE, modifier); - } else if (is_key(key, len, "<escape>")) { - vterm_keyboard_key(term->vt, VTERM_KEY_ESCAPE, modifier); - } else if (is_key(key, len, "<up>")) { - vterm_keyboard_key(term->vt, VTERM_KEY_UP, modifier); - } else if (is_key(key, len, "<down>")) { - vterm_keyboard_key(term->vt, VTERM_KEY_DOWN, modifier); - } else if (is_key(key, len, "<left>")) { - vterm_keyboard_key(term->vt, VTERM_KEY_LEFT, modifier); - } else if (is_key(key, len, "<right>")) { - vterm_keyboard_key(term->vt, VTERM_KEY_RIGHT, modifier); - } else if (is_key(key, len, "<insert>")) { - vterm_keyboard_key(term->vt, VTERM_KEY_INS, modifier); - } else if (is_key(key, len, "<delete>")) { - vterm_keyboard_key(term->vt, VTERM_KEY_DEL, modifier); - } else if (is_key(key, len, "<home>")) { - vterm_keyboard_key(term->vt, VTERM_KEY_HOME, modifier); - } else if (is_key(key, len, "<end>")) { - vterm_keyboard_key(term->vt, VTERM_KEY_END, modifier); - } else if (is_key(key, len, "<prior>")) { - vterm_keyboard_key(term->vt, VTERM_KEY_PAGEUP, modifier); - } else if (is_key(key, len, "<next>")) { - vterm_keyboard_key(term->vt, VTERM_KEY_PAGEDOWN, modifier); - } else if (is_key(key, len, "<f0>")) { - vterm_keyboard_key(term->vt, VTERM_KEY_FUNCTION(0), modifier); - } else if (is_key(key, len, "<f1>")) { - vterm_keyboard_key(term->vt, VTERM_KEY_FUNCTION(1), modifier); - } else if (is_key(key, len, "<f2>")) { - vterm_keyboard_key(term->vt, VTERM_KEY_FUNCTION(2), modifier); - } else if (is_key(key, len, "<f3>")) { - vterm_keyboard_key(term->vt, VTERM_KEY_FUNCTION(3), modifier); - } else if (is_key(key, len, "<f4>")) { - vterm_keyboard_key(term->vt, VTERM_KEY_FUNCTION(4), modifier); - } else if (is_key(key, len, "<f5>")) { - vterm_keyboard_key(term->vt, VTERM_KEY_FUNCTION(5), modifier); - } else if (is_key(key, len, "<f6>")) { - vterm_keyboard_key(term->vt, VTERM_KEY_FUNCTION(6), modifier); - } else if (is_key(key, len, "<f7>")) { - vterm_keyboard_key(term->vt, VTERM_KEY_FUNCTION(7), modifier); - } else if (is_key(key, len, "<f8>")) { - vterm_keyboard_key(term->vt, VTERM_KEY_FUNCTION(8), modifier); - } else if (is_key(key, len, "<f9>")) { - vterm_keyboard_key(term->vt, VTERM_KEY_FUNCTION(9), modifier); - } else if (is_key(key, len, "<f10>")) { - vterm_keyboard_key(term->vt, VTERM_KEY_FUNCTION(10), modifier); - } else if (is_key(key, len, "<f11>")) { - vterm_keyboard_key(term->vt, VTERM_KEY_FUNCTION(11), modifier); - } else if (is_key(key, len, "<f12>")) { - vterm_keyboard_key(term->vt, VTERM_KEY_FUNCTION(12), modifier); - } else if (is_key(key, len, "<kp-0>")) { - vterm_keyboard_key(term->vt, VTERM_KEY_KP_0, modifier); - } else if (is_key(key, len, "<kp-1>")) { - vterm_keyboard_key(term->vt, VTERM_KEY_KP_1, modifier); - } else if (is_key(key, len, "<kp-2>")) { - vterm_keyboard_key(term->vt, VTERM_KEY_KP_2, modifier); - } else if (is_key(key, len, "<kp-3>")) { - vterm_keyboard_key(term->vt, VTERM_KEY_KP_3, modifier); - } else if (is_key(key, len, "<kp-4>")) { - vterm_keyboard_key(term->vt, VTERM_KEY_KP_4, modifier); - } else if (is_key(key, len, "<kp-5>")) { - vterm_keyboard_key(term->vt, VTERM_KEY_KP_5, modifier); - } else if (is_key(key, len, "<kp-6>")) { - vterm_keyboard_key(term->vt, VTERM_KEY_KP_6, modifier); - } else if (is_key(key, len, "<kp-7>")) { - vterm_keyboard_key(term->vt, VTERM_KEY_KP_7, modifier); - } else if (is_key(key, len, "<kp-8>")) { - vterm_keyboard_key(term->vt, VTERM_KEY_KP_8, modifier); - } else if (is_key(key, len, "<kp-9>")) { - vterm_keyboard_key(term->vt, VTERM_KEY_KP_9, modifier); - } else if (is_key(key, len, "<kp-add>")) { - vterm_keyboard_key(term->vt, VTERM_KEY_KP_PLUS, modifier); - } else if (is_key(key, len, "<kp-subtract>")) { - vterm_keyboard_key(term->vt, VTERM_KEY_KP_MINUS, modifier); - } else if (is_key(key, len, "<kp-multiply>")) { - vterm_keyboard_key(term->vt, VTERM_KEY_KP_MULT, modifier); - } else if (is_key(key, len, "<kp-divide>")) { - vterm_keyboard_key(term->vt, VTERM_KEY_KP_DIVIDE, modifier); - } else if (is_key(key, len, "<kp-equal>")) { - vterm_keyboard_key(term->vt, VTERM_KEY_KP_EQUAL, modifier); - } else if (is_key(key, len, "<kp-decimal>")) { - vterm_keyboard_key(term->vt, VTERM_KEY_KP_PERIOD, modifier); - } else if (is_key(key, len, "<kp-separator>")) { - vterm_keyboard_key(term->vt, VTERM_KEY_KP_COMMA, modifier); - } else if (is_key(key, len, "<kp-enter>")) { - vterm_keyboard_key(term->vt, VTERM_KEY_KP_ENTER, modifier); - } else if (is_key(key, len, "j") && (modifier == VTERM_MOD_CTRL)) { - vterm_keyboard_unichar(term->vt, '\n', 0); - } else if (is_key(key, len, "SPC")) { - vterm_keyboard_unichar(term->vt, ' ', modifier); - } else if (len <= 4) { - uint32_t codepoint; - if (utf8_to_codepoint(key, len, &codepoint)) { - vterm_keyboard_unichar(term->vt, codepoint, modifier); - } - } -} - -void term_finalize(void *object) { - Term *term = (Term *)object; - for (int i = 0; i < term->sb_current; i++) { - if (term->sb_buffer[i]->info != NULL) { - free_lineinfo(term->sb_buffer[i]->info); - term->sb_buffer[i]->info = NULL; - } - free(term->sb_buffer[i]); - } - if (term->title) { - free(term->title); - term->title = NULL; - } - - if (term->directory) { - free(term->directory); - term->directory = NULL; - } - - while (term->elisp_code_first) { - ElispCodeListNode *node = term->elisp_code_first; - term->elisp_code_first = node->next; - free(node->code); - free(node); - } - term->elisp_code_p_insert = &term->elisp_code_first; - - if (term->cmd_buffer) { - free(term->cmd_buffer); - term->cmd_buffer = NULL; - } - if (term->selection_data) { - free(term->selection_data); - term->selection_data = NULL; - } - - for (int i = 0; i < term->lines_len; i++) { - if (term->lines[i] != NULL) { - free_lineinfo(term->lines[i]); - term->lines[i] = NULL; - } - } - - if (term->pty_fd > 0) { - close(term->pty_fd); - } - - free(term->sb_buffer); - free(term->lines); - vterm_free(term->vt); - free(term); -} - -static int handle_osc_cmd_51(Term *term, char subCmd, char *buffer) { - if (subCmd == 'A') { - /* "51;A" sets the current directory */ - /* "51;A" has also the role of identifying the end of the prompt */ - if (term->directory != NULL) { - free(term->directory); - term->directory = NULL; - } - term->directory = malloc(strlen(buffer) + 1); - strcpy(term->directory, buffer); - term->directory_changed = true; - - for (int i = term->cursor.row; i < term->lines_len; i++) { - if (term->lines[i] == NULL) { - term->lines[i] = alloc_lineinfo(); - } - - if (term->lines[i]->directory != NULL) { - free(term->lines[i]->directory); - } - term->lines[i]->directory = malloc(strlen(buffer) + 1); - strcpy(term->lines[i]->directory, buffer); - if (i == term->cursor.row) { - term->lines[i]->prompt_col = term->cursor.col; - } else { - term->lines[i]->prompt_col = -1; - } - } - return 1; - } else if (subCmd == 'E') { - /* "51;E" executes elisp code */ - /* The elisp code is executed in term_redraw */ - ElispCodeListNode *node = malloc(sizeof(ElispCodeListNode)); - node->code_len = strlen(buffer); - node->code = malloc(node->code_len + 1); - strcpy(node->code, buffer); - node->next = NULL; - - *(term->elisp_code_p_insert) = node; - term->elisp_code_p_insert = &(node->next); - return 1; - } - return 0; -} - -static int handle_osc_cmd(Term *term, int cmd, char *buffer) { - if (cmd == 51) { - char subCmd = '0'; - if (strlen(buffer) == 0) { - return 0; - } - subCmd = buffer[0]; - /* ++ skip the subcmd char */ - return handle_osc_cmd_51(term, subCmd, ++buffer); - } - return 0; -} -/* maybe we should drop support of libvterm < v0.2 */ -/* VTermStringFragmentNotExists was introduced when libvterm is not released */ -#ifdef VTermStringFragmentNotExists -static int osc_callback(const char *command, size_t cmdlen, void *user) { - Term *term = (Term *)user; - char buffer[cmdlen + 1]; - buffer[cmdlen] = '\0'; - memcpy(buffer, command, cmdlen); - - if (cmdlen > 4 && buffer[0] == '5' && buffer[1] == '1' && buffer[2] == ';' && - buffer[3] == 'A') { - return handle_osc_cmd_51(term, 'A', &buffer[4]); - } else if (cmdlen > 4 && buffer[0] == '5' && buffer[1] == '1' && - buffer[2] == ';' && buffer[3] == 'E') { - return handle_osc_cmd_51(term, 'E', &buffer[4]); - } - return 0; -} -static VTermParserCallbacks parser_callbacks = { - .text = NULL, - .control = NULL, - .escape = NULL, - .csi = NULL, - .osc = &osc_callback, - .dcs = NULL, -}; -#else - -static int osc_callback(int cmd, VTermStringFragment frag, void *user) { - /* osc_callback (OSC = Operating System Command) */ - - /* We interpret escape codes that start with "51;" */ - /* "51;A" sets the current directory */ - /* "51;A" has also the role of identifying the end of the prompt */ - /* "51;E" executes elisp code */ - /* The elisp code is executed in term_redraw */ - Term *term = (Term *)user; - - if (frag.initial) { - /* drop old fragment,because this is a initial fragment */ - if (term->cmd_buffer) { - free(term->cmd_buffer); - term->cmd_buffer = NULL; - } - } - - if (!frag.initial && !frag.final && frag.len == 0) { - return 0; - } - - term->cmd_buffer = concat(term->cmd_buffer, frag.str, frag.len, true); - if (frag.final) { - handle_osc_cmd(term, cmd, term->cmd_buffer); - free(term->cmd_buffer); - term->cmd_buffer = NULL; - } - return 0; -} -static VTermStateFallbacks parser_callbacks = { - .control = NULL, - .csi = NULL, - .osc = &osc_callback, - .dcs = NULL, -}; -#ifndef VTermSelectionMaskNotExists -static int set_selection(VTermSelectionMask mask, VTermStringFragment frag, - void *user) { - Term *term = (Term *)user; - - if (frag.initial) { - term->selection_mask = mask; - if (term->selection_data) { - free(term->selection_data); - } - term->selection_data = NULL; - } - - if (frag.len) { - term->selection_data = - concat(term->selection_data, frag.str, frag.len, true); - } - return 1; -} -/* OSC 52 ; Pc ; Pd BEL */ -/* Manipulate Selection Data */ -/* https://invisible-island.net/xterm/ctlseqs/ctlseqs.html */ -/* test by printf "\033]52;c;$(printf "%s" "blabla" | base64)\a" */ -/* c , p , q , s , 0 , 1 , 2 , 3 , 4 , 5 , 6 , and 7 */ -/* for clipboard, primary, secondary, select, or cut buffers 0 through 7 */ -/* respectively */ -static VTermSelectionCallbacks selection_callbacks = { - .set = &set_selection, - .query = NULL, -}; -#endif /* VTermSelectionMaskNotExists */ - -#endif - -emacs_value Fvterm_new(emacs_env *env, ptrdiff_t nargs, emacs_value args[], - void *data) { - Term *term = malloc(sizeof(Term)); - - int rows = env->extract_integer(env, args[0]); - int cols = env->extract_integer(env, args[1]); - int sb_size = env->extract_integer(env, args[2]); - int disable_bold_font = env->is_not_nil(env, args[3]); - int disable_underline = env->is_not_nil(env, args[4]); - int disable_inverse_video = env->is_not_nil(env, args[5]); - int ignore_blink_cursor = env->is_not_nil(env, args[6]); - int set_bold_hightbright = env->is_not_nil(env, args[7]); - - term->vt = vterm_new(rows, cols); - vterm_set_utf8(term->vt, 1); - - term->vts = vterm_obtain_screen(term->vt); - - VTermState *state = vterm_obtain_state(term->vt); - vterm_state_set_unrecognised_fallbacks(state, &parser_callbacks, term); - -#ifndef VTermSelectionMaskNotExists - vterm_state_set_selection_callbacks(state, &selection_callbacks, term, - term->selection_buf, SELECTION_BUF_LEN); -#endif - vterm_state_set_bold_highbright(state, set_bold_hightbright); - - vterm_screen_reset(term->vts, 1); - vterm_screen_set_callbacks(term->vts, &vterm_screen_callbacks, term); - vterm_screen_set_damage_merge(term->vts, VTERM_DAMAGE_SCROLL); - vterm_screen_enable_altscreen(term->vts, true); - term->sb_size = MIN(SB_MAX, sb_size); - term->sb_current = 0; - term->sb_pending = 0; - term->sb_clear_pending = false; - term->sb_pending_by_height_decr = 0; - term->sb_buffer = malloc(sizeof(ScrollbackLine *) * term->sb_size); - term->invalid_start = 0; - term->invalid_end = rows; - term->is_invalidated = false; - term->width = cols; - term->height = rows; - term->height_resize = 0; - term->disable_bold_font = disable_bold_font; - term->disable_underline = disable_underline; - term->disable_inverse_video = disable_inverse_video; - term->ignore_blink_cursor = ignore_blink_cursor; - emacs_value newline = env->make_string(env, "\n", 1); - for (int i = 0; i < term->height; i++) { - insert(env, newline); - } - term->linenum = term->height; - term->linenum_added = 0; - term->resizing = false; - - term->pty_fd = -1; - - term->title = NULL; - term->title_changed = false; - - term->cursor.row = 0; - term->cursor.col = 0; - term->cursor.cursor_type = -1; - term->cursor.cursor_visible = true; - term->cursor.cursor_type_changed = false; - term->cursor.cursor_blink = false; - term->cursor.cursor_blink_changed = false; - term->directory = NULL; - term->directory_changed = false; - term->elisp_code_first = NULL; - term->elisp_code_p_insert = &term->elisp_code_first; - term->selection_data = NULL; - term->selection_mask = 0; - - term->cmd_buffer = NULL; - - term->lines = malloc(sizeof(LineInfo *) * rows); - term->lines_len = rows; - for (int i = 0; i < rows; i++) { - term->lines[i] = NULL; - } - - return env->make_user_ptr(env, term_finalize, term); -} - -emacs_value Fvterm_update(emacs_env *env, ptrdiff_t nargs, emacs_value args[], - void *data) { - Term *term = env->get_user_ptr(env, args[0]); - - // Process keys - if (nargs > 1) { - ptrdiff_t len = string_bytes(env, args[1]); - unsigned char key[len]; - env->copy_string_contents(env, args[1], (char *)key, &len); - VTermModifier modifier = VTERM_MOD_NONE; - if (nargs > 2 && env->is_not_nil(env, args[2])) - modifier = modifier | VTERM_MOD_SHIFT; - if (nargs > 3 && env->is_not_nil(env, args[3])) - modifier = modifier | VTERM_MOD_ALT; - if (nargs > 4 && env->is_not_nil(env, args[4])) - modifier = modifier | VTERM_MOD_CTRL; - - // Ignore the final zero byte - term_process_key(term, env, key, len - 1, modifier); - } - - // Flush output - term_flush_output(term, env); - if (term->is_invalidated) { - vterm_invalidate(env); - } - - return env->make_integer(env, 0); -} - -emacs_value Fvterm_redraw(emacs_env *env, ptrdiff_t nargs, emacs_value args[], - void *data) { - Term *term = env->get_user_ptr(env, args[0]); - term_redraw(term, env); - return env->make_integer(env, 0); -} - -emacs_value Fvterm_write_input(emacs_env *env, ptrdiff_t nargs, - emacs_value args[], void *data) { - Term *term = env->get_user_ptr(env, args[0]); - ptrdiff_t len = string_bytes(env, args[1]); - char bytes[len]; - - env->copy_string_contents(env, args[1], bytes, &len); - - vterm_input_write(term->vt, bytes, len); - vterm_screen_flush_damage(term->vts); - - return env->make_integer(env, 0); -} - -emacs_value Fvterm_set_size(emacs_env *env, ptrdiff_t nargs, emacs_value args[], - void *data) { - Term *term = env->get_user_ptr(env, args[0]); - int rows = env->extract_integer(env, args[1]); - int cols = env->extract_integer(env, args[2]); - - if (cols != term->width || rows != term->height) { - term->height_resize = rows - term->height; - if (rows > term->height) { - if (rows - term->height > term->sb_current) { - term->linenum_added = rows - term->height - term->sb_current; - } - } - term->resizing = true; - vterm_set_size(term->vt, rows, cols); - vterm_screen_flush_damage(term->vts); - - term_redraw(term, env); - } - - return Qnil; -} - -emacs_value Fvterm_set_pty_name(emacs_env *env, ptrdiff_t nargs, - emacs_value args[], void *data) { - Term *term = env->get_user_ptr(env, args[0]); - - if (nargs > 1) { - ptrdiff_t len = string_bytes(env, args[1]); - char filename[len]; - - env->copy_string_contents(env, args[1], filename, &len); - - term->pty_fd = open(filename, O_RDONLY); - } - return Qnil; -} -emacs_value Fvterm_get_pwd(emacs_env *env, ptrdiff_t nargs, emacs_value args[], - void *data) { - Term *term = env->get_user_ptr(env, args[0]); - int linenum = env->extract_integer(env, args[1]); - int row = linenr_to_row(term, linenum); - char *dir = get_row_directory(term, row); - - return dir ? env->make_string(env, dir, strlen(dir)) : Qnil; -} - -emacs_value Fvterm_get_icrnl(emacs_env *env, ptrdiff_t nargs, - emacs_value args[], void *data) { - Term *term = env->get_user_ptr(env, args[0]); - - if (term->pty_fd > 0) { - struct termios keys; - tcgetattr(term->pty_fd, &keys); - - if (keys.c_iflag & ICRNL) - return Qt; - else - return Qnil; - } - return Qnil; -} - -emacs_value Fvterm_reset_cursor_point(emacs_env *env, ptrdiff_t nargs, - emacs_value args[], void *data) { - Term *term = env->get_user_ptr(env, args[0]); - int line = row_to_linenr(term, term->cursor.row); - goto_line(env, line); - goto_col(term, env, term->cursor.row, term->cursor.col); - return point(env); -} - -int emacs_module_init(struct emacs_runtime *ert) { - emacs_env *env = ert->get_environment(ert); - - // Symbols; - Qt = env->make_global_ref(env, env->intern(env, "t")); - Qnil = env->make_global_ref(env, env->intern(env, "nil")); - Qnormal = env->make_global_ref(env, env->intern(env, "normal")); - Qbold = env->make_global_ref(env, env->intern(env, "bold")); - Qitalic = env->make_global_ref(env, env->intern(env, "italic")); - Qforeground = env->make_global_ref(env, env->intern(env, ":foreground")); - Qbackground = env->make_global_ref(env, env->intern(env, ":background")); - Qweight = env->make_global_ref(env, env->intern(env, ":weight")); - Qunderline = env->make_global_ref(env, env->intern(env, ":underline")); - Qslant = env->make_global_ref(env, env->intern(env, ":slant")); - Qreverse = env->make_global_ref(env, env->intern(env, ":inverse-video")); - Qstrike = env->make_global_ref(env, env->intern(env, ":strike-through")); - Qextend = env->make_global_ref(env, env->intern(env, ":extend")); - Qemacs_major_version = - env->make_global_ref(env, env->intern(env, "emacs-major-version")); - Qvterm_line_wrap = - env->make_global_ref(env, env->intern(env, "vterm-line-wrap")); - Qrear_nonsticky = - env->make_global_ref(env, env->intern(env, "rear-nonsticky")); - Qvterm_prompt = env->make_global_ref(env, env->intern(env, "vterm-prompt")); - - Qface = env->make_global_ref(env, env->intern(env, "font-lock-face")); - Qbox = env->make_global_ref(env, env->intern(env, "box")); - Qbar = env->make_global_ref(env, env->intern(env, "bar")); - Qhbar = env->make_global_ref(env, env->intern(env, "hbar")); - Qcursor_type = env->make_global_ref(env, env->intern(env, "cursor-type")); - - // Functions - Fblink_cursor_mode = - env->make_global_ref(env, env->intern(env, "blink-cursor-mode")); - Fsymbol_value = env->make_global_ref(env, env->intern(env, "symbol-value")); - Flength = env->make_global_ref(env, env->intern(env, "length")); - Flist = env->make_global_ref(env, env->intern(env, "list")); - Fnth = env->make_global_ref(env, env->intern(env, "nth")); - Ferase_buffer = env->make_global_ref(env, env->intern(env, "erase-buffer")); - Finsert = env->make_global_ref(env, env->intern(env, "vterm--insert")); - Fgoto_char = env->make_global_ref(env, env->intern(env, "goto-char")); - Fput_text_property = - env->make_global_ref(env, env->intern(env, "put-text-property")); - Fadd_text_properties = - env->make_global_ref(env, env->intern(env, "add-text-properties")); - Fset = env->make_global_ref(env, env->intern(env, "set")); - Fvterm_flush_output = - env->make_global_ref(env, env->intern(env, "vterm--flush-output")); - Fforward_line = env->make_global_ref(env, env->intern(env, "forward-line")); - Fgoto_line = env->make_global_ref(env, env->intern(env, "vterm--goto-line")); - Fdelete_lines = - env->make_global_ref(env, env->intern(env, "vterm--delete-lines")); - Frecenter = env->make_global_ref(env, env->intern(env, "recenter")); - Fset_window_point = - env->make_global_ref(env, env->intern(env, "set-window-point")); - Fwindow_body_height = - env->make_global_ref(env, env->intern(env, "window-body-height")); - - Fpoint = env->make_global_ref(env, env->intern(env, "point")); - Fforward_char = env->make_global_ref(env, env->intern(env, "forward-char")); - Fget_buffer_window_list = - env->make_global_ref(env, env->intern(env, "get-buffer-window-list")); - Fselected_window = - env->make_global_ref(env, env->intern(env, "selected-window")); - - Fvterm_set_title = - env->make_global_ref(env, env->intern(env, "vterm--set-title")); - Fvterm_set_directory = - env->make_global_ref(env, env->intern(env, "vterm--set-directory")); - Fvterm_invalidate = - env->make_global_ref(env, env->intern(env, "vterm--invalidate")); - Feq = env->make_global_ref(env, env->intern(env, "eq")); - Fvterm_get_color = - env->make_global_ref(env, env->intern(env, "vterm--get-color")); - Fvterm_eval = env->make_global_ref(env, env->intern(env, "vterm--eval")); - Fvterm_set_selection = - env->make_global_ref(env, env->intern(env, "vterm--set-selection")); - - // Exported functions - emacs_value fun; - fun = - env->make_function(env, 4, 8, Fvterm_new, "Allocate a new vterm.", NULL); - bind_function(env, "vterm--new", fun); - - fun = env->make_function(env, 1, 5, Fvterm_update, - "Process io and update the screen.", NULL); - bind_function(env, "vterm--update", fun); - - fun = - env->make_function(env, 1, 1, Fvterm_redraw, "Redraw the screen.", NULL); - bind_function(env, "vterm--redraw", fun); - - fun = env->make_function(env, 2, 2, Fvterm_write_input, - "Write input to vterm.", NULL); - bind_function(env, "vterm--write-input", fun); - - fun = env->make_function(env, 3, 3, Fvterm_set_size, - "Set the size of the terminal.", NULL); - bind_function(env, "vterm--set-size", fun); - - fun = env->make_function(env, 2, 2, Fvterm_set_pty_name, - "Set the name of the pty.", NULL); - bind_function(env, "vterm--set-pty-name", fun); - fun = env->make_function(env, 2, 2, Fvterm_get_pwd, - "Get the working directory of at line n.", NULL); - bind_function(env, "vterm--get-pwd-raw", fun); - fun = env->make_function(env, 1, 1, Fvterm_reset_cursor_point, - "Reset cursor postion.", NULL); - bind_function(env, "vterm--reset-point", fun); - - fun = env->make_function(env, 1, 1, Fvterm_get_icrnl, - "Get the icrnl state of the pty", NULL); - bind_function(env, "vterm--get-icrnl", fun); - - provide(env, "vterm-module"); - - return 0; -} diff --git a/elpa/vterm-20230417.424/vterm-module.h b/elpa/vterm-20230417.424/vterm-module.h @@ -1,169 +0,0 @@ -#ifndef VTERM_MODULE_H -#define VTERM_MODULE_H - -#include "emacs-module.h" -#include <inttypes.h> -#include <stdbool.h> -#include <vterm.h> - -// https://gcc.gnu.org/wiki/Visibility -#if defined _WIN32 || defined __CYGWIN__ -#ifdef __GNUC__ -#define VTERM_EXPORT __attribute__((dllexport)) -#else -#define VTERM_EXPORT __declspec(dllexport) -#endif -#else -#if __GNUC__ >= 4 -#define VTERM_EXPORT __attribute__((visibility("default"))) -#else -#define VTERM_EXPORT -#endif -#endif - -VTERM_EXPORT int plugin_is_GPL_compatible; - -#define SB_MAX 100000 // Maximum 'scrollback' value. - -#ifndef MIN -#define MIN(X, Y) ((X) < (Y) ? (X) : (Y)) -#endif -#ifndef MAX -#define MAX(X, Y) ((X) > (Y) ? (X) : (Y)) -#endif - -typedef struct LineInfo { - char *directory; /* working directory */ - - int prompt_col; /* end column of the prompt, if the current line contains the - * prompt */ -} LineInfo; - -typedef struct ScrollbackLine { - size_t cols; - LineInfo *info; - VTermScreenCell cells[]; -} ScrollbackLine; - -typedef struct ElispCodeListNode { - char *code; - size_t code_len; - struct ElispCodeListNode *next; -} ElispCodeListNode; - -/* c , p , q , s , 0 , 1 , 2 , 3 , 4 , 5 , 6 , and 7 */ -/* clipboard, primary, secondary, select, or cut buffers 0 through 7 */ -#define SELECTION_BUF_LEN 4096 - -typedef struct Cursor { - int row, col; - int cursor_type; - bool cursor_visible; - bool cursor_blink; - bool cursor_type_changed; - bool cursor_blink_changed; -} Cursor; - -typedef struct Term { - VTerm *vt; - VTermScreen *vts; - // buffer used to: - // - convert VTermScreen cell arrays into utf8 strings - // - receive data from libvterm as a result of key presses. - ScrollbackLine **sb_buffer; // Scrollback buffer storage for libvterm - size_t sb_current; // number of rows pushed to sb_buffer - size_t sb_size; // sb_buffer size - // "virtual index" that points to the first sb_buffer row that we need to - // push to the terminal buffer when refreshing the scrollback. When negative, - // it actually points to entries that are no longer in sb_buffer (because the - // window height has increased) and must be deleted from the terminal buffer - int sb_pending; - int sb_pending_by_height_decr; - bool sb_clear_pending; - long linenum; - long linenum_added; - - int invalid_start, invalid_end; // invalid rows in libvterm screen - bool is_invalidated; - - Cursor cursor; - char *title; - bool title_changed; - - char *directory; - bool directory_changed; - - // Single-linked list of elisp_code. - // Newer commands are added at the tail. - ElispCodeListNode *elisp_code_first; - ElispCodeListNode **elisp_code_p_insert; // pointer to the position where new - // node should be inserted - - /* c , p , q , s , 0 , 1 , 2 , 3 , 4 , 5 , 6 , and 7 */ - /* clipboard, primary, secondary, select, or cut buffers 0 through 7 */ - int selection_mask; /* see VTermSelectionMask in vterm.h */ - char *selection_data; - char selection_buf[SELECTION_BUF_LEN]; - - /* the size of dirs almost = window height, value = directory of that line */ - LineInfo **lines; - int lines_len; - - int width, height; - int height_resize; - bool resizing; - bool disable_bold_font; - bool disable_underline; - bool disable_inverse_video; - bool ignore_blink_cursor; - - char *cmd_buffer; - - int pty_fd; -} Term; - -static bool compare_cells(VTermScreenCell *a, VTermScreenCell *b); -static bool is_key(unsigned char *key, size_t len, char *key_description); -static emacs_value render_text(emacs_env *env, Term *term, char *string, - int len, VTermScreenCell *cell); -static emacs_value render_fake_newline(emacs_env *env, Term *term); -static emacs_value render_prompt(emacs_env *env, emacs_value text); -static emacs_value cell_rgb_color(emacs_env *env, Term *term, - VTermScreenCell *cell, bool is_foreground); - -static int term_settermprop(VTermProp prop, VTermValue *val, void *user_data); - -static void term_redraw(Term *term, emacs_env *env); -static void term_flush_output(Term *term, emacs_env *env); -static void term_process_key(Term *term, emacs_env *env, unsigned char *key, - size_t len, VTermModifier modifier); -static void invalidate_terminal(Term *term, int start_row, int end_row); - -void term_finalize(void *object); - -emacs_value Fvterm_new(emacs_env *env, ptrdiff_t nargs, emacs_value args[], - void *data); -emacs_value Fvterm_update(emacs_env *env, ptrdiff_t nargs, emacs_value args[], - void *data); -emacs_value Fvterm_redraw(emacs_env *env, ptrdiff_t nargs, emacs_value args[], - void *data); -emacs_value Fvterm_write_input(emacs_env *env, ptrdiff_t nargs, - emacs_value args[], void *data); -emacs_value Fvterm_set_size(emacs_env *env, ptrdiff_t nargs, emacs_value args[], - void *data); -emacs_value Fvterm_set_pty_name(emacs_env *env, ptrdiff_t nargs, - emacs_value args[], void *data); -emacs_value Fvterm_get_icrnl(emacs_env *env, ptrdiff_t nargs, - emacs_value args[], void *data); - -emacs_value Fvterm_get_pwd(emacs_env *env, ptrdiff_t nargs, emacs_value args[], - void *data); - -emacs_value Fvterm_get_prompt_point(emacs_env *env, ptrdiff_t nargs, - emacs_value args[], void *data); -emacs_value Fvterm_reset_cursor_point(emacs_env *env, ptrdiff_t nargs, - emacs_value args[], void *data); - -VTERM_EXPORT int emacs_module_init(struct emacs_runtime *ert); - -#endif /* VTERM_MODULE_H */ diff --git a/elpa/vterm-20230417.424/vterm-pkg.el b/elpa/vterm-20230417.424/vterm-pkg.el @@ -1,14 +0,0 @@ -(define-package "vterm" "20230417.424" "Fully-featured terminal emulator" - '((emacs "25.1")) - :commit "94e2b0b2b4a750e7907dacd5b4c0584900846dd1" :authors - '(("Lukas Fürmetz" . "fuermetz@mailbox.org")) - :maintainers - '(("Lukas Fürmetz" . "fuermetz@mailbox.org")) - :maintainer - '("Lukas Fürmetz" . "fuermetz@mailbox.org") - :keywords - '("terminals") - :url "https://github.com/akermu/emacs-libvterm") -;; Local Variables: -;; no-byte-compile: t -;; End: diff --git a/elpa/vterm-20230417.424/vterm.el b/elpa/vterm-20230417.424/vterm.el @@ -1,1841 +0,0 @@ -;;; vterm.el --- Fully-featured terminal emulator -*- lexical-binding: t; -*- - -;; Copyright (C) 2017-2020 by Lukas Fürmetz & Contributors -;; -;; Author: Lukas Fürmetz <fuermetz@mailbox.org> -;; Version: 0.0.2 -;; URL: https://github.com/akermu/emacs-libvterm -;; Keywords: terminals -;; Package-Requires: ((emacs "25.1")) - - -;; This file is not part of GNU Emacs. - -;; This file is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation; either version 2, or (at your option) -;; any later version. - -;; This file is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>. - - -;;; Commentary: -;; -;; Emacs-libvterm (vterm) is fully-fledged terminal emulator based on an -;; external library (libvterm) loaded as a dynamic module. As a result of using -;; compiled code (instead of elisp), emacs-libvterm is fully capable, fast, and -;; it can seamlessly handle large outputs. - -;;; Installation - -;; Emacs-libvterm requires support for loading modules. You can check if your -;; Emacs supports modules by inspecting the variable module-file-suffix. If it -;; nil, than, you need to recompile Emacs or obtain a copy of Emacs with this -;; option enabled. - -;; Emacs-libvterm requires CMake and libvterm. If libvterm is not available, -;; emacs-libvterm will downloaded and compiled. In this case, libtool is -;; needed. - -;; The reccomended way to install emacs-libvterm is from MELPA. - -;;; Usage - -;; To open a terminal, simply use the command M-x vterm. - -;;; Tips and tricks - -;; Adding some shell-side configuration enables a large set of additional -;; features, including, directory tracking, prompt recognition, message passing. - -;;; Code: - -(require 'term/xterm) - -(unless module-file-suffix - (error "VTerm needs module support. Please compile Emacs with - the --with-modules option!")) - -(defvar vterm-copy-mode) - -;;; Compilation of the module - -(defcustom vterm-module-cmake-args "" - "Arguments given to CMake to compile vterm-module. - -Currently, vterm defines the following flags (in addition to the -ones already available in CMake): - -`USE_SYSTEM_LIBVTERM'. Set it to `Off' to use the vendored version of -libvterm instead of the one installed on your system. - -This string is given verbatim to CMake, so it has to have the -correct syntax. An example of meaningful value for this variable -is `-DUSE_SYSTEM_LIBVTERM=Off'." - :type 'string - :group 'vterm) - -(defcustom vterm-always-compile-module nil - "If not nil, if `vterm-module' is not found, compile it without asking. - -When `vterm-always-compile-module' is nil, vterm will ask for -confirmation before compiling." - :type 'boolean - :group 'vterm) - -(defvar vterm-install-buffer-name " *Install vterm* " - "Name of the buffer used for compiling vterm-module.") - -(defun vterm-module--cmake-is-available () - "Return t if cmake is available. -CMake is needed to build vterm, here we check that we can find -the executable." - - (unless (executable-find "cmake") - (error "Vterm needs CMake to be compiled. Please, install CMake")) - t) - -;;;###autoload -(defun vterm-module-compile () - "Compile vterm-module." - (interactive) - (when (vterm-module--cmake-is-available) - (let* ((vterm-directory - (shell-quote-argument - ;; NOTE: This is a workaround to fix an issue with how the Emacs - ;; feature/native-comp branch changes the result of - ;; `(locate-library "vterm")'. See emacs-devel thread - ;; https://lists.gnu.org/archive/html/emacs-devel/2020-07/msg00306.html - ;; for a discussion. - (file-name-directory (locate-library "vterm.el" t)))) - (make-commands - (concat - "cd " vterm-directory "; \ - mkdir -p build; \ - cd build; \ - cmake -G 'Unix Makefiles' " - vterm-module-cmake-args - " ..; \ - make; \ - cd -")) - (buffer (get-buffer-create vterm-install-buffer-name))) - (pop-to-buffer buffer) - (compilation-mode) - (if (zerop (let ((inhibit-read-only t)) - (call-process "sh" nil buffer t "-c" make-commands))) - (message "Compilation of `emacs-libvterm' module succeeded") - (error "Compilation of `emacs-libvterm' module failed!"))))) - -;; If the vterm-module is not compiled yet, compile it -(unless (require 'vterm-module nil t) - (if (or vterm-always-compile-module - (y-or-n-p "Vterm needs `vterm-module' to work. Compile it now? ")) - (progn - (vterm-module-compile) - (require 'vterm-module)) - (error "Vterm will not work until `vterm-module' is compiled!"))) - -;;; Dependencies - -;; Generate this list with: -;; awk -F\" '/bind_function*/ {print "(declare-function", $2, "\"vterm-module\")"}' vterm-module.c -(declare-function vterm--new "vterm-module") -(declare-function vterm--update "vterm-module") -(declare-function vterm--redraw "vterm-module") -(declare-function vterm--write-input "vterm-module") -(declare-function vterm--set-size "vterm-module") -(declare-function vterm--set-pty-name "vterm-module") -(declare-function vterm--get-pwd-raw "vterm-module") -(declare-function vterm--reset-point "vterm-module") -(declare-function vterm--get-icrnl "vterm-module") - -(require 'subr-x) -(require 'find-func) -(require 'cl-lib) -(require 'term) -(require 'color) -(require 'compile) -(require 'face-remap) -(require 'tramp) -(require 'bookmark) - -;;; Options - -(defcustom vterm-shell shell-file-name - "The shell that gets run in the vterm." - :type 'string - :group 'vterm) - -(defcustom vterm-tramp-shells '(("docker" "/bin/sh")) - "The shell that gets run in the vterm for tramp. - -`vterm-tramp-shells' has to be a list of pairs of the format: -\(TRAMP-METHOD SHELL)" - :type '(alist :key-type string :value-type string) - :group 'vterm) - -(defcustom vterm-buffer-name "*vterm*" - "The basename used for vterm buffers. -This is the default name used when running `vterm' or -`vterm-other-window'. - -With a numeric prefix argument to `vterm', the buffer name will -be the value of this variable followed by the number. For -example, with the numeric prefix argument 2, the buffer would be -named \"*vterm*<2>\"." - :type 'string - :group 'vterm) - -(defcustom vterm-max-scrollback 1000 - "Maximum \\='scrollback\\=' value. - -The maximum allowed is 100000. This value can modified by -changing the SB_MAX variable in vterm-module.h and recompiling -the module." - :type 'number - :group 'vterm) - -(defcustom vterm-min-window-width 80 - "Minimum window width." - :type 'number - :group 'vterm) - -(defcustom vterm-kill-buffer-on-exit t - "If not nil vterm buffers are killed when the attached process is terminated. - -If `vterm-kill-buffer-on-exit' is set to t, when the process -associated to a vterm buffer quits, the buffer is killed. When -nil, the buffer will still be available as if it were in -`fundamental-mode'." - :type 'boolean - :group 'vterm) - -(define-obsolete-variable-alias 'vterm-clear-scrollback - 'vterm-clear-scrollback-when-clearing "0.0.1") - -(define-obsolete-variable-alias 'vterm-use-vterm-prompt - 'vterm-use-vterm-prompt-detection-method "0.0.1") - -(defcustom vterm-clear-scrollback-when-clearing nil - "If not nil `vterm-clear' clears both screen and scrollback. - -The scrollback is everything that is not current visible on -screen in vterm buffers. - -If `vterm-clear-scrollback-when-clearing' is nil, `vterm-clear' -clears only the screen, so the scrollback is accessible moving -the point up." - :type 'boolean - :group 'vterm) - -(defcustom vterm-keymap-exceptions - '("C-c" "C-x" "C-u" "C-g" "C-h" "C-l" "M-x" "M-o" "C-y" "M-y") - "Exceptions for `vterm-keymap'. - -If you use a keybinding with a prefix-key, add that prefix-key to -this list. Note that after doing so that prefix-key cannot be sent -to the terminal anymore. - -The mapping is done by the macro `vterm-define-key', and the -function `vterm--exclude-keys' removes the keybindings defined in -`vterm-keymap-exceptions'." - :type '(repeat string) - :set (lambda (sym val) - (set sym val) - (when (and (fboundp 'vterm--exclude-keys) - (boundp 'vterm-mode-map)) - (vterm--exclude-keys vterm-mode-map val))) - :group 'vterm) - -(defcustom vterm-exit-functions nil - "List of functions called when a vterm process exits. - -Each function is called with two arguments: the vterm buffer of -the process if any, and a string describing the event passed from -the sentinel. - -This hook applies only to new vterms, created after setting this -value with `add-hook'. - -Note that this hook will not work if another package like -`shell-pop' sets its own sentinel to the `vterm' process." - :type 'hook - :group 'vterm) - -(make-obsolete-variable 'vterm-set-title-functions - "This variable was substituted by `vterm-buffer-name-string'." - "0.0.1") - -(defcustom vterm-buffer-name-string nil - "Format string for the title of vterm buffers. - -If `vterm-buffer-name-string' is nil, vterm will not set the -title of its buffers. If not nil, `vterm-buffer-name-string' has -to be a format control string (see `format') containing one -instance of %s which will be substituted with the string TITLE. -The argument TITLE is provided by the shell. This requires shell -side configuration. - -For example, if `vterm-buffer-name-string' is set to \"vterm %s\", -and the shell properly configured to set TITLE=$(pwd), than vterm -buffers will be named \"vterm\" followed by the current path. - -See URL http://tldp.org/HOWTO/Xterm-Title-4.html for additional -information on the how to configure the shell." - :type 'string - :group 'vterm) - -(defcustom vterm-term-environment-variable "xterm-256color" - "TERM value for terminal." - :type 'string - :group 'vterm) - -(defcustom vterm-environment nil - "List of extra environment variables to the vterm shell processes only. - -demo: \\='(\"env1=v1\" \"env2=v2\")" - :type '(repeat string) - :group 'vterm) - - -(defcustom vterm-enable-manipulate-selection-data-by-osc52 nil - "Support OSC 52 MANIPULATE SELECTION DATA(libvterm 0.2 is needed). - -Support copy text to Emacs kill ring and system clipboard by using OSC 52. -For example: send base64 encoded \\='foo\\=' to kill ring: echo -en \\='\\e]52;c;Zm9v\\a\\=', -tmux can share its copy buffer to terminals by supporting osc52(like iterm2 - xterm) you can enable this feature for tmux by : -set -g set-clipboard on #osc 52 copy paste share with iterm -set -ga terminal-overrides \\=',xterm*:XT:Ms=\\E]52;%p1%s;%p2%s\\007\\=' -set -ga terminal-overrides \\=',screen*:XT:Ms=\\E]52;%p1%s;%p2%s\\007\\=' - -The clipboard querying/clearing functionality offered by OSC 52 is not -implemented here,And for security reason, this feature is disabled -by default." - :type 'boolean - :group 'vterm) - -;; TODO: Improve doc string, it should not point to the readme but it should -;; be self-contained. -(defcustom vterm-eval-cmds '(("find-file" find-file) - ("message" message) - ("vterm-clear-scrollback" vterm-clear-scrollback)) - "Whitelisted Emacs functions that can be executed from vterm. - -You can execute Emacs functions directly from vterm buffers. To do this, -you have to escape the name of the function and its arguments with \e]51;E. - -See Message passing in README. - -The function you want to execute has to be in `vterm-eval-cmds'. - -`vterm-eval-cmds' has to be a list of pairs of the format: -\(NAME-OF-COMMAND-IN-SHELL EMACS-FUNCTION) - -The need for an explicit map is to avoid arbitrary code execution." - :type '(alist :key-type string) - :group 'vterm) - -(defcustom vterm-disable-underline nil - "When not-nil, underline text properties are ignored. - -This means that vterm will render underlined text as if it was not -underlined." - :type 'boolean - :group 'vterm) - -(defcustom vterm-disable-inverse-video nil - "When not-nil, inverse video text properties are ignored. - -This means that vterm will render reversed video text as if it was not -such." - :type 'boolean - :group 'vterm) - -(define-obsolete-variable-alias 'vterm-disable-bold-font - 'vterm-disable-bold "0.0.1") - -(defcustom vterm-disable-bold-font nil - "When not-nil, bold text properties are ignored. - -This means that vterm will render bold with the default face weight." - :type 'boolean - :group 'vterm) - -(defcustom vterm-set-bold-hightbright nil - "When not-nil, using hightbright colors for bolded text, see #549." - :type 'boolean - :group 'vterm) - -(defcustom vterm-ignore-blink-cursor t - "When t, vterm will ignore request from application to turn on/off cursor blink. - -If nil, cursor in any window may begin to blink or not blink because -`blink-cursor-mode`is a global minor mode in Emacs, -you can use `M-x blink-cursor-mode` to toggle." - :type 'boolean - :group 'vterm) - -(defcustom vterm-copy-exclude-prompt t - "When not-nil, the prompt is not included by `vterm-copy-mode-done'." - :type 'boolean - :group 'vterm) - -(defcustom vterm-use-vterm-prompt-detection-method t - "When not-nil, the prompt is detected through the shell. - -Vterm needs to know where the shell prompt is to enable all the -available features. There are two supported ways to do this. -First, the shell can inform vterm on the location of the prompt. -This requires shell-side configuration: the escape code 51;A is -used to set the current directory and prompt location. This -detection method is the most-reliable. To use it, you have -to change your shell prompt to print 51;A. - -The second method is using a regular expression. This method does -not require any shell-side configuration. See -`term-prompt-regexp', for more information." - :type 'boolean - :group 'vterm) - -(defcustom vterm-bookmark-check-dir t - "When set to non-nil, also restore directory when restoring a vterm bookmark." - :type 'boolean - :group 'vterm) - -(defcustom vterm-copy-mode-remove-fake-newlines nil - "When not-nil fake newlines are removed on entering copy mode. - -vterm inserts \\='fake\\=' newlines purely for rendering. When using -vterm-copy-mode these are in conflict with many emacs functions -like isearch-forward. if this varialbe is not-nil the -fake-newlines are removed on entering copy-mode and re-inserted -on leaving copy mode. Also truncate-lines is set to t on entering -copy-mode and set to nil on leaving." - :type 'boolean - :group 'vterm) - -;;; Faces - -(defface vterm-color-black - `((t :inherit term-color-black)) - "Face used to render black color code. -The foreground color is used as ANSI color 0 and the background -color is used as ANSI color 8." - :group 'vterm) - -(defface vterm-color-red - `((t :inherit term-color-red)) - "Face used to render red color code. -The foreground color is used as ANSI color 1 and the background -color is used as ANSI color 9." - :group 'vterm) - -(defface vterm-color-green - `((t :inherit term-color-green)) - "Face used to render green color code. -The foreground color is used as ANSI color 2 and the background -color is used as ANSI color 10." - :group 'vterm) - -(defface vterm-color-yellow - `((t :inherit term-color-yellow)) - "Face used to render yellow color code. -The foreground color is used as ANSI color 3 and the background -color is used as ANSI color 11." - :group 'vterm) - -(defface vterm-color-blue - `((t :inherit term-color-blue)) - "Face used to render blue color code. -The foreground color is used as ANSI color 4 and the background -color is used as ANSI color 12." - :group 'vterm) - -(defface vterm-color-magenta - `((t :inherit term-color-magenta)) - "Face used to render magenta color code. -The foreground color is used as ansi color 5 and the background -color is used as ansi color 13." - :group 'vterm) - -(defface vterm-color-cyan - `((t :inherit term-color-cyan)) - "Face used to render cyan color code. -The foreground color is used as ansi color 6 and the background -color is used as ansi color 14." - :group 'vterm) - -(defface vterm-color-white - `((t :inherit term-color-white)) - "Face used to render white color code. -The foreground color is used as ansi color 7 and the background -color is used as ansi color 15." - :group 'vterm) - -(defface vterm-color-underline - `((t :inherit default)) - "Face used to render cells with underline attribute. -Only foreground is used." - :group 'vterm) - -(defface vterm-color-inverse-video - `((t :inherit default)) - "Face used to render cells with inverse video attribute. -Only background is used." - :group 'vterm) - -;;; Variables - -(defvar vterm-color-palette - [vterm-color-black - vterm-color-red - vterm-color-green - vterm-color-yellow - vterm-color-blue - vterm-color-magenta - vterm-color-cyan - vterm-color-white] - "Color palette for the foreground and background.") - -(defvar-local vterm--term nil - "Pointer to Term.") - -(defvar-local vterm--process nil - "Shell process of current term.") - -(defvar-local vterm--redraw-timer nil) -(defvar-local vterm--redraw-immididately nil) -(defvar-local vterm--linenum-remapping nil) -(defvar-local vterm--prompt-tracking-enabled-p nil) -(defvar-local vterm--insert-function (symbol-function #'insert)) -(defvar-local vterm--delete-char-function (symbol-function #'delete-char)) -(defvar-local vterm--delete-region-function (symbol-function #'delete-region)) -(defvar-local vterm--undecoded-bytes nil) -(defvar-local vterm--copy-mode-fake-newlines nil) - - -(defvar vterm-timer-delay 0.1 - "Delay for refreshing the buffer after receiving updates from libvterm. - -A larger delary improves performance when receiving large bursts -of data. If nil, never delay. The units are seconds.") - -;;; Keybindings - -;; We have many functions defined by vterm-define-key. Later, we will bind some -;; of the functions. If the following is not evaluated during compilation, the compiler -;; will complain that some functions are not defined (eg, vterm-send-C-c) -(eval-and-compile - (defmacro vterm-define-key (key) - "Define a command that sends KEY with modifiers C and M to vterm." - (declare (indent defun) - (doc-string 3)) - `(progn (defun ,(intern (format "vterm-send-%s" key))() - ,(format "Sends %s to the libvterm." key) - (interactive) - (vterm-send-key ,(char-to-string (get-byte (1- (length key)) key)) - ,(let ((case-fold-search nil)) - (or (string-match-p "[A-Z]$" key) - (string-match-p "S-" key))) - ,(string-match-p "M-" key) - ,(string-match-p "C-" key))) - (make-obsolete ',(intern (format "vterm-send-%s" key)) - "use `vterm--self-insert' or `vterm-send' or `vterm-send-key'." - "v0.1"))) - (make-obsolete 'vterm-define-key "" "v0.1") - (mapc (lambda (key) - (eval `(vterm-define-key ,key))) - (cl-loop for prefix in '("M-") - append (cl-loop for char from ?A to ?Z - for key = (format "%s%c" prefix char) - collect key))) - (mapc (lambda (key) - (eval `(vterm-define-key ,key))) - (cl-loop for prefix in '("C-" "M-" "C-S-") - append (cl-loop for char from ?a to ?z - for key = (format "%s%c" prefix char) - collect key)))) - -;; Function keys and most of C- and M- bindings -(defun vterm--exclude-keys (map exceptions) - "Remove EXCEPTIONS from the keys bound by `vterm-define-keys'. - -Exceptions are defined by `vterm-keymap-exceptions'." - (mapc (lambda (key) - (define-key map (kbd key) nil)) - exceptions) - (mapc (lambda (key) - (define-key map (kbd key) #'vterm--self-insert)) - (cl-loop for number from 1 to 12 - for key = (format "<f%i>" number) - unless (member key exceptions) - collect key)) - (let ((esc-map (lookup-key map "\e")) - (i 0) - key) - (unless esc-map (setq esc-map (make-keymap))) - (while (< i 128) - (setq key (make-string 1 i)) - (unless (member (key-description key) exceptions) - (define-key map key 'vterm--self-insert)) - ;; Avoid O and [. They are used in escape sequences for various keys. - (unless (or (eq i ?O) (eq i 91)) - (unless (member (key-description key "\e") exceptions) - (define-key esc-map key 'vterm--self-insert-meta))) - (setq i (1+ i))) - (define-key map "\e" esc-map))) - -(defun vterm-xterm-paste (event) - "Handle xterm paste EVENT in vterm." - (interactive "e") - (with-temp-buffer - (xterm-paste event) - (kill-new (buffer-string))) - (vterm-yank)) - -(defvar vterm-mode-map - (let ((map (make-sparse-keymap))) - (vterm--exclude-keys map vterm-keymap-exceptions) - (define-key map (kbd "C-]") #'vterm--self-insert) - (define-key map (kbd "M-<") #'vterm--self-insert) - (define-key map (kbd "M->") #'vterm--self-insert) - (define-key map [tab] #'vterm-send-tab) - (define-key map (kbd "TAB") #'vterm-send-tab) - (define-key map [backtab] #'vterm--self-insert) - (define-key map [backspace] #'vterm-send-backspace) - (define-key map (kbd "DEL") #'vterm-send-backspace) - (define-key map [delete] #'vterm-send-delete) - (define-key map [M-backspace] #'vterm-send-meta-backspace) - (define-key map (kbd "M-DEL") #'vterm-send-meta-backspace) - (define-key map [C-backspace] #'vterm-send-meta-backspace) - (define-key map [return] #'vterm-send-return) - (define-key map (kbd "RET") #'vterm-send-return) - (define-key map [C-left] #'vterm--self-insert) - (define-key map [M-left] #'vterm--self-insert) - (define-key map [C-right] #'vterm--self-insert) - (define-key map [M-right] #'vterm--self-insert) - (define-key map [C-up] #'vterm--self-insert) - (define-key map [C-down] #'vterm--self-insert) - (define-key map [M-up] #'vterm--self-insert) - (define-key map [M-down] #'vterm--self-insert) - (define-key map [left] #'vterm--self-insert) - (define-key map [right] #'vterm--self-insert) - (define-key map [up] #'vterm--self-insert) - (define-key map [down] #'vterm--self-insert) - (define-key map [prior] #'vterm--self-insert) - (define-key map [S-prior] #'scroll-down-command) - (define-key map [next] #'vterm--self-insert) - (define-key map [S-next] #'scroll-up-command) - (define-key map [home] #'vterm--self-insert) - (define-key map [end] #'vterm--self-insert) - (define-key map [C-home] #'vterm--self-insert) - (define-key map [C-end] #'vterm--self-insert) - (define-key map [escape] #'vterm--self-insert) - (define-key map [remap yank] #'vterm-yank) - (define-key map [remap xterm-paste] #'vterm-xterm-paste) - (define-key map [remap yank-pop] #'vterm-yank-pop) - (define-key map [remap mouse-yank-primary] #'vterm-yank-primary) - (define-key map [mouse-1] #'vterm-mouse-set-point) - (define-key map (kbd "C-SPC") #'vterm--self-insert) - (define-key map (kbd "S-SPC") #'vterm-send-space) - (define-key map (kbd "C-_") #'vterm--self-insert) - (define-key map [remap undo] #'vterm-undo) - (define-key map (kbd "M-.") #'vterm--self-insert) - (define-key map (kbd "M-,") #'vterm--self-insert) - (define-key map (kbd "C-c C-y") #'vterm--self-insert) - (define-key map (kbd "C-c C-c") #'vterm--self-insert) - (define-key map (kbd "C-c C-l") #'vterm-clear-scrollback) - (define-key map (kbd "C-l") #'vterm-clear) - (define-key map (kbd "C-\\") #'vterm--self-insert) - (define-key map (kbd "C-c C-g") #'vterm--self-insert) - (define-key map (kbd "C-c C-u") #'vterm--self-insert) - (define-key map [remap self-insert-command] #'vterm--self-insert) - (define-key map (kbd "C-c C-r") #'vterm-reset-cursor-point) - (define-key map (kbd "C-c C-n") #'vterm-next-prompt) - (define-key map (kbd "C-c C-p") #'vterm-previous-prompt) - (define-key map (kbd "C-c C-t") #'vterm-copy-mode) - map)) - -(defvar vterm-copy-mode-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "C-c C-t") #'vterm-copy-mode) - (define-key map [return] #'vterm-copy-mode-done) - (define-key map (kbd "RET") #'vterm-copy-mode-done) - (define-key map (kbd "C-c C-r") #'vterm-reset-cursor-point) - (define-key map (kbd "C-a") #'vterm-beginning-of-line) - (define-key map (kbd "C-e") #'vterm-end-of-line) - (define-key map (kbd "C-c C-n") #'vterm-next-prompt) - (define-key map (kbd "C-c C-p") #'vterm-previous-prompt) - map)) - - -;;; Mode - -(define-derived-mode vterm-mode fundamental-mode "VTerm" - "Major mode for vterm buffer." - (buffer-disable-undo) - (and (boundp 'display-line-numbers) - (let ((font-height (expt text-scale-mode-step text-scale-mode-amount))) - (setq vterm--linenum-remapping - (face-remap-add-relative 'line-number :height font-height)))) - (hack-dir-local-variables) - (let ((vterm-env (assq 'vterm-environment dir-local-variables-alist))) - (when vterm-env - (make-local-variable 'vterm-environment) - (setq vterm-environment (cdr vterm-env)))) - (let ((process-environment (append vterm-environment - `(,(concat "TERM=" - vterm-term-environment-variable) - ,(concat "EMACS_VTERM_PATH=" - (file-name-directory (find-library-name "vterm"))) - "INSIDE_EMACS=vterm" - "LINES" - "COLUMNS") - process-environment)) - ;; TODO: Figure out why inhibit is needed for curses to render correctly. - (inhibit-eol-conversion nil) - (coding-system-for-read 'binary) - (process-adaptive-read-buffering nil) - (width (max (- (window-body-width) (vterm--get-margin-width)) - vterm-min-window-width))) - (setq vterm--term (vterm--new (window-body-height) - width vterm-max-scrollback - vterm-disable-bold-font - vterm-disable-underline - vterm-disable-inverse-video - vterm-ignore-blink-cursor - vterm-set-bold-hightbright)) - (setq buffer-read-only t) - (setq-local scroll-conservatively 101) - (setq-local scroll-margin 0) - (setq-local hscroll-margin 0) - (setq-local hscroll-step 1) - (setq-local truncate-lines t) - - - ;; Disable all automatic fontification - (setq-local font-lock-defaults '(nil t)) - - (add-function :filter-return - (local 'filter-buffer-substring-function) - #'vterm--filter-buffer-substring) - (setq vterm--process - (make-process - :name "vterm" - :buffer (current-buffer) - :command - `("/bin/sh" "-c" - ,(format - "stty -nl sane %s erase ^? rows %d columns %d >/dev/null && exec %s" - ;; Some stty implementations (i.e. that of *BSD) do not - ;; support the iutf8 option. to handle that, we run some - ;; heuristics to work out if the system supports that - ;; option and set the arg string accordingly. This is a - ;; gross hack but FreeBSD doesn't seem to want to fix it. - ;; - ;; See: https://bugs.freebsd.org/bugzilla/show_bug.cgi?id=220009 - (if (eq system-type 'berkeley-unix) "" "iutf8") - (window-body-height) - width (vterm--get-shell))) - ;; :coding 'no-conversion - :connection-type 'pty - :file-handler t - :filter #'vterm--filter - ;; The sentinel is needed if there are exit functions or if - ;; vterm-kill-buffer-on-exit is set to t. In this latter case, - ;; vterm--sentinel will kill the buffer - :sentinel (when (or vterm-exit-functions - vterm-kill-buffer-on-exit) - #'vterm--sentinel)))) - - ;; Change major-mode is not allowed - ;; Vterm interfaces with an underlying process. Changing the major - ;; mode can break this, leading to segmentation faults. - (add-hook 'change-major-mode-hook - (lambda () (interactive) - (user-error "You cannot change major mode in vterm buffers")) nil t) - - (vterm--set-pty-name vterm--term (process-tty-name vterm--process)) - (process-put vterm--process 'adjust-window-size-function - #'vterm--window-adjust-process-window-size) - ;; Support to compilation-shell-minor-mode - ;; Is this necessary? See vterm--compilation-setup - (setq next-error-function 'vterm-next-error-function) - (setq-local bookmark-make-record-function 'vterm--bookmark-make-record)) - -(defun vterm--get-shell () - "Get the shell that gets run in the vterm." - (if (ignore-errors (file-remote-p default-directory)) - (with-parsed-tramp-file-name default-directory nil - (or (cadr (assoc method vterm-tramp-shells)) - (with-connection-local-variables shell-file-name) - vterm-shell)) - vterm-shell)) - -(defun vterm--bookmark-make-record () - "Create a vterm bookmark. - -Notes down the current directory and buffer name." - `(nil - (handler . vterm--bookmark-handler) - (thisdir . ,default-directory) - (buf-name . ,(buffer-name)) - (defaults . nil))) - - -;;;###autoload -(defun vterm--bookmark-handler (bmk) - "Handler to restore a vterm bookmark BMK. - -If a vterm buffer of the same name does not exist, the function will create a -new vterm buffer of the name. It also checks the current directory and sets -it to the bookmarked directory if needed." - (let* ((thisdir (bookmark-prop-get bmk 'thisdir)) - (buf-name (bookmark-prop-get bmk 'buf-name)) - (buf (get-buffer buf-name)) - (thismode (and buf (with-current-buffer buf major-mode)))) - ;; create if no such vterm buffer exists - (when (or (not buf) (not (eq thismode 'vterm-mode))) - (setq buf (generate-new-buffer buf-name)) - (with-current-buffer buf - (when vterm-bookmark-check-dir - (setq default-directory thisdir)) - (vterm-mode))) - ;; check the current directory - (with-current-buffer buf - (when (and vterm-bookmark-check-dir - (not (string-equal default-directory thisdir))) - (when vterm-copy-mode - (vterm-copy-mode-done nil)) - (vterm-insert (concat "cd " thisdir)) - (vterm-send-return))) - ;; set to this vterm buf - (set-buffer buf))) - -(defun vterm--compilation-setup () - "Function to enable the option `compilation-shell-minor-mode' for vterm. -`'compilation-shell-minor-mode' would change the value of local -variable `next-error-function', so we should call this function in -`compilation-shell-minor-mode-hook'." - (when (eq major-mode 'vterm-mode) - (setq next-error-function 'vterm-next-error-function))) - -(add-hook 'compilation-shell-minor-mode-hook #'vterm--compilation-setup) - -;;;###autoload -(defun vterm-next-error-function (n &optional reset) - "Advance to the next error message and visit the file where the error was. -This is the value of `next-error-function' in Compilation -buffers. Prefix arg N says how many error messages to move -forwards (or backwards, if negative). - -Optional argument RESET clears all the errors." - (interactive "p") - (let* ((pt (point)) - (default-directory default-directory) - (pwd (vterm--get-pwd))) - (when pwd - (setq default-directory pwd)) - (goto-char pt) - (compilation-next-error-function n reset))) - -;;; Copy Mode - -(defun vterm--enter-copy-mode () - (use-local-map nil) - (vterm-send-stop) - (when vterm-copy-mode-remove-fake-newlines - (save-excursion - (setq truncate-lines nil) - (vterm--remove-fake-newlines t)))) - - -(defun vterm--exit-copy-mode () - (when vterm-copy-mode-remove-fake-newlines - (save-excursion - (setq truncate-lines t) - (vterm--reinsert-fake-newlines))) - (vterm-reset-cursor-point) - (use-local-map vterm-mode-map) - (vterm-send-start)) - -(define-minor-mode vterm-copy-mode - "Toggle `vterm-copy-mode'. - -When `vterm-copy-mode' is enabled, the terminal will not display -additional output received from the underlying process and will -behave similarly to buffer in `fundamental-mode'. This mode is -typically used to copy text from vterm buffers. - -A conventient way to exit `vterm-copy-mode' is with -`vterm-copy-mode-done', which copies the selected text and exit -`vterm-copy-mode'." - :group 'vterm - :lighter " VTermCopy" - :keymap vterm-copy-mode-map - (if (equal major-mode 'vterm-mode) - (if vterm-copy-mode - (vterm--enter-copy-mode) - (vterm--exit-copy-mode)) - (user-error "You cannot enable vterm-copy-mode outside vterm buffers"))) - -(defun vterm-copy-mode-done (arg) - "Save the active region or line to the kill ring and exit `vterm-copy-mode'. - -If a region is defined then that region is killed, with no region then -current line is killed from start to end. - -The option `vterm-copy-exclude-prompt' controls if the prompt -should be included in a line copy. Using the universal prefix ARG -will invert `vterm-copy-exclude-prompt' for that call." - (interactive "P") - (unless vterm-copy-mode - (user-error "This command is effective only in vterm-copy-mode")) - (unless (use-region-p) - (goto-char (vterm--get-beginning-of-line)) - ;; Are we excluding the prompt? - (if (or (and vterm-copy-exclude-prompt (not arg)) - (and (not vterm-copy-exclude-prompt) arg)) - (goto-char (max (or (vterm--get-prompt-point) 0) - (vterm--get-beginning-of-line)))) - (set-mark (point)) - (goto-char (vterm--get-end-of-line))) - (kill-ring-save (region-beginning) (region-end)) - (vterm-copy-mode -1)) - -;;; Commands - -(defun vterm--self-insert-meta () - (interactive) - (when vterm--term - (dolist (key (vterm--translate-event-to-args - last-command-event :meta)) - (apply #'vterm-send-key key)))) - -(defun vterm--self-insert () - "Send invoking key to libvterm." - (interactive) - (when vterm--term - (dolist (key (vterm--translate-event-to-args - last-command-event)) - (apply #'vterm-send-key key)))) - -(defun vterm-send-key (key &optional shift meta ctrl accept-proc-output) - "Send KEY to libvterm with optional modifiers SHIFT, META and CTRL." - (deactivate-mark) - (when vterm--term - (let ((inhibit-redisplay t) - (inhibit-read-only t)) - (vterm--update vterm--term key shift meta ctrl) - (setq vterm--redraw-immididately t) - (when accept-proc-output - (accept-process-output vterm--process vterm-timer-delay nil t))))) - -(defun vterm-send (key) - "Send KEY to libvterm. KEY can be anything `kbd' understands." - (dolist (key (vterm--translate-event-to-args - (listify-key-sequence (kbd key)))) - (apply #'vterm-send-key key))) - -(defun vterm-send-next-key () - "Read next input event and send it to the libvterm. - -With this you can directly send modified keys to applications -running in the terminal (like Emacs or Nano)." - (interactive) - (dolist (key (vterm--translate-event-to-args - (read-event))) - (apply #'vterm-send-key key))) - -(defun vterm-send-start () - "Output from the system is started when the system receives START." - (interactive) - (vterm-send-key "<start>")) - -(defun vterm-send-stop () - "Output from the system is stopped when the system receives STOP." - (interactive) - (vterm-send-key "<stop>")) - -(defun vterm-send-return () - "Send `C-m' to the libvterm." - (interactive) - (deactivate-mark) - (when vterm--term - (if (vterm--get-icrnl vterm--term) - (process-send-string vterm--process "\C-j") - (process-send-string vterm--process "\C-m")))) - -(defun vterm-send-tab () - "Send `<tab>' to the libvterm." - (interactive) - (vterm-send-key "<tab>")) - -(defun vterm-send-space () - "Send `<space>' to the libvterm." - (interactive) - (vterm-send-key " ")) - -(defun vterm-send-backspace () - "Send `<backspace>' to the libvterm." - (interactive) - (vterm-send-key "<backspace>")) - -(defun vterm-send-delete () - "Send `<delete>' to the libvterm." - (interactive) - (vterm-send-key "<delete>")) - -(defun vterm-send-meta-backspace () - "Send `M-<backspace>' to the libvterm." - (interactive) - (vterm-send-key "<backspace>" nil t)) - -(defun vterm-send-up () - "Send `<up>' to the libvterm." - (interactive) - (vterm-send-key "<up>")) -(make-obsolete 'vterm-send-up 'vterm--self-insert "v0.1") - -(defun vterm-send-down () - "Send `<down>' to the libvterm." - (interactive) - (vterm-send-key "<down>")) -(make-obsolete 'vterm-send-down 'vterm--self-insert "v0.1") - -(defun vterm-send-left () - "Send `<left>' to the libvterm." - (interactive) - (vterm-send-key "<left>")) -(make-obsolete 'vterm-send-left 'vterm--self-insert "v0.1") - -(defun vterm-send-right () - "Send `<right>' to the libvterm." - (interactive) - (vterm-send-key "<right>")) -(make-obsolete 'vterm-send-right 'vterm--self-insert "v0.1") - -(defun vterm-send-prior () - "Send `<prior>' to the libvterm." - (interactive) - (vterm-send-key "<prior>")) -(make-obsolete 'vterm-send-prior 'vterm--self-insert "v0.1") - -(defun vterm-send-next () - "Send `<next>' to the libvterm." - (interactive) - (vterm-send-key "<next>")) -(make-obsolete 'vterm-send-next 'vterm--self-insert "v0.1") - -(defun vterm-send-meta-dot () - "Send `M-.' to the libvterm." - (interactive) - (vterm-send-key "." nil t)) -(make-obsolete 'vterm-send-meta-dot 'vterm--self-insert "v0.1") - -(defun vterm-send-meta-comma () - "Send `M-,' to the libvterm." - (interactive) - (vterm-send-key "," nil t)) -(make-obsolete 'vterm-send-meta-comma 'vterm--self-insert "v0.1") - -(defun vterm-send-ctrl-slash () - "Send `C-\' to the libvterm." - (interactive) - (vterm-send-key "\\" nil nil t)) -(make-obsolete 'vterm-send-ctrl-slash 'vterm--self-insert "v0.1") - -(defun vterm-send-escape () - "Send `<escape>' to the libvterm." - (interactive) - (vterm-send-key "<escape>")) - -(defun vterm-clear-scrollback () - "Send `<clear-scrollback>' to the libvterm." - (interactive) - (vterm-send-key "<clear_scrollback>")) - -(defun vterm-clear (&optional arg) - "Send `<clear>' to the libvterm. - -`vterm-clear-scrollback' determines whether -`vterm-clear' should also clear the scrollback or not. - -This behavior can be altered by calling `vterm-clear' with a -prefix argument ARG or with \\[universal-argument]." - (interactive "P") - (if (or - (and vterm-clear-scrollback-when-clearing (not arg)) - (and arg (not vterm-clear-scrollback-when-clearing))) - (vterm-clear-scrollback)) - (vterm-send-key "l" nil nil :ctrl)) - -(defun vterm-undo () - "Send `C-_' to the libvterm." - (interactive) - (vterm-send-key "_" nil nil t)) - -(defun vterm-yank (&optional arg) - "Yank (paste) text in vterm. - -Argument ARG is passed to `yank'." - (interactive "P") - (deactivate-mark) - (vterm-goto-char (point)) - (let ((inhibit-read-only t)) - (cl-letf (((symbol-function 'insert-for-yank) #'vterm-insert)) - (yank arg)))) - -(defun vterm-yank-primary () - "Yank text from the primary selection in vterm." - (interactive) - (vterm-goto-char (point)) - (let ((inhibit-read-only t) - (primary (gui-get-primary-selection))) - (cl-letf (((symbol-function 'insert-for-yank) #'vterm-insert)) - (insert-for-yank primary)))) - -(defun vterm-yank-pop (&optional arg) - "Replaced text just yanked with the next entry in the kill ring. - -Argument ARG is passed to `yank'" - (interactive "p") - (vterm-goto-char (point)) - (let ((inhibit-read-only t) - (yank-undo-function #'(lambda (_start _end) (vterm-undo)))) - (cl-letf (((symbol-function 'insert-for-yank) #'vterm-insert)) - (yank-pop arg)))) - -(defun vterm-mouse-set-point (event &optional promote-to-region) - "Move point to the position clicked on with the mouse. -But when clicking to the unused area below the last prompt, -move the cursor to the prompt area." - (interactive "e\np") - (let ((pt (mouse-set-point event promote-to-region))) - (if (= (count-words pt (point-max)) 0) - (vterm-reset-cursor-point) - pt)) - ;; Otherwise it selects text for every other click - (keyboard-quit)) - -(defun vterm-send-string (string &optional paste-p) - "Send the string STRING to vterm. -Optional argument PASTE-P paste-p." - (when vterm--term - (when paste-p - (vterm--update vterm--term "<start_paste>" )) - (dolist (char (string-to-list string)) - (vterm--update vterm--term (char-to-string char))) - (when paste-p - (vterm--update vterm--term "<end_paste>"))) - (setq vterm--redraw-immididately t) - (accept-process-output vterm--process vterm-timer-delay nil t)) - -(defun vterm-insert (&rest contents) - "Insert the arguments, either strings or characters, at point. - -Provide similar behavior as `insert' for vterm." - (when vterm--term - (vterm--update vterm--term "<start_paste>") - (dolist (c contents) - (if (characterp c) - (vterm--update vterm--term (char-to-string c)) - (dolist (char (string-to-list c)) - (vterm--update vterm--term (char-to-string char))))) - (vterm--update vterm--term "<end_paste>") - (setq vterm--redraw-immididately t) - (accept-process-output vterm--process vterm-timer-delay nil t))) - -(defun vterm-delete-region (start end) - "Delete the text between START and END for vterm. " - (when vterm--term - (save-excursion - (when (get-text-property start 'vterm-line-wrap) - ;; skip over the fake newline when start there. - (setq start (1+ start)))) - ;; count of chars after fake newline removed - (let ((count (length (filter-buffer-substring start end)))) - (if (vterm-goto-char start) - (cl-loop repeat count do - (vterm-send-key "<delete>" nil nil nil t)) - (let ((inhibit-read-only nil)) - (vterm--delete-region start end)))))) - -(defun vterm-goto-char (pos) - "Set point to POSITION for vterm. - -The return value is `t' when point moved successfully." - (when (and vterm--term - (vterm-cursor-in-command-buffer-p) - (vterm-cursor-in-command-buffer-p pos)) - (vterm-reset-cursor-point) - (let ((diff (- pos (point)))) - (cond - ((zerop diff) t) ;do not need move - ((< diff 0) ;backward - (while (and - (vterm--backward-char) - (> (point) pos))) - (<= (point) pos)) - (t - (while (and (vterm--forward-char) - (< (point) pos))) - (>= (point) pos)))))) - -;;; Internal - -(defun vterm--forward-char () - "Move point 1 character forward (). - -the return value is `t' when cursor moved." - (vterm-reset-cursor-point) - (let ((pt (point))) - (vterm-send-key "<right>" nil nil nil t) - (cond - ((= (point) (1+ pt)) t) - ((and (> (point) pt) - ;; move over the fake newline - (get-text-property (1- (point)) 'vterm-line-wrap)) - t) - ((and (= (point) (+ 4 pt)) - (looking-back (regexp-quote "^[[C") nil)) ;escape code for <right> - (dotimes (_ 3) (vterm-send-key "<backspace>" nil nil nil t)) ;;delete "^[[C" - nil) - ((> (point) (1+ pt)) ;auto suggest - (vterm-send-key "_" nil nil t t) ;undo C-_ - nil) - (t nil)))) - - - -(defun vterm--backward-char () - "Move point N characters backward. - -Return count of moved characeters." - (vterm-reset-cursor-point) - (let ((pt (point))) - (vterm-send-key "<left>" nil nil nil t) - (cond - ((= (point) (1- pt)) t) - ((and (= (point) (- pt 2)) - ;; backward cross fake newline - (string-equal (buffer-substring-no-properties - (1+ (point)) (+ 2 (point))) - "\n")) - t) - ((and (= (point) (+ 4 pt)) - (looking-back (regexp-quote "^[[D") nil)) ;escape code for <left> - (dotimes (_ 3) (vterm-send-key "<backspace>" nil nil nil t)) ;;delete "^[[D" - nil) - (t nil)))) - -(defun vterm--delete-region(start end) - "A wrapper for `delete-region'." - (funcall vterm--delete-region-function start end)) - -(defun vterm--insert(&rest content) - "A wrapper for `insert'." - (apply vterm--insert-function content)) - -(defun vterm--delete-char(n &optional killflag) - "A wrapper for `delete-char'." - (funcall vterm--delete-char-function n killflag)) - -(defun vterm--translate-event-to-args (event &optional meta) - "Translate EVENT as list of args for `vterm-send-key'. - -When some input method is enabled, one key may generate -several characters, so the result of this function is a list, -looks like: ((\"m\" :shift ))" - (let* ((modifiers (event-modifiers event)) - (shift (memq 'shift modifiers)) - (meta (or meta (memq 'meta modifiers))) - (ctrl (memq 'control modifiers)) - (raw-key (event-basic-type event)) - (ev-keys) keys) - (if input-method-function - (let ((inhibit-read-only t)) - (setq ev-keys (funcall input-method-function raw-key)) - (when (listp ev-keys) - (dolist (k ev-keys) - (when-let ((key (key-description (vector k)))) - (when (and (not (symbolp event)) shift (not meta) (not ctrl)) - (setq key (upcase key))) - (setq keys (append keys (list (list key shift meta ctrl)))))))) - (when-let ((key (key-description (vector raw-key)))) - (when (and (not (symbolp event)) shift (not meta) (not ctrl)) - (setq key (upcase key))) - (setq keys (list (list key shift meta ctrl))))) - keys)) - -(defun vterm--invalidate () - "The terminal buffer is invalidated, the buffer needs redrawing." - (if (and (not vterm--redraw-immididately) - vterm-timer-delay) - (unless vterm--redraw-timer - (setq vterm--redraw-timer - (run-with-timer vterm-timer-delay nil - #'vterm--delayed-redraw (current-buffer)))) - (vterm--delayed-redraw (current-buffer)) - (setq vterm--redraw-immididately nil))) - -(defun vterm-check-proc (&optional buffer) - "Check if there is a running process associated to the vterm buffer BUFFER. - -BUFFER can be either a buffer or the name of one." - (let* ((buffer (get-buffer (or buffer (current-buffer)))) - (proc (get-buffer-process buffer))) - (and proc - (memq (process-status proc) '(run stop open listen connect)) - (buffer-local-value 'vterm--term buffer)))) - -(defun vterm--delayed-redraw (buffer) - "Redraw the terminal buffer. -Argument BUFFER the terminal buffer." - (when (buffer-live-p buffer) - (with-current-buffer buffer - (let ((inhibit-redisplay t) - (inhibit-read-only t) - (windows (get-buffer-window-list))) - (setq vterm--redraw-timer nil) - (when vterm--term - (vterm--redraw vterm--term) - (unless (zerop (window-hscroll)) - (when (cl-member (selected-window) windows :test #'eq) - (set-window-hscroll (selected-window) 0)))))))) - -;; see VTermSelectionMask in vterm.el -;; VTERM_SELECTION_CLIPBOARD = (1<<0), -;; VTERM_SELECTION_PRIMARY = (1<<1), -(defconst vterm--selection-clipboard 1) ;(1<<0) -(defconst vterm--selection-primary 2) ;(1<<1) -(defun vterm--set-selection (mask data) - "OSC 52 Manipulate Selection Data. -Search Manipulate Selection Data in - https://invisible-island.net/xterm/ctlseqs/ctlseqs.html ." - (when vterm-enable-manipulate-selection-data-by-osc52 - (let ((select-enable-clipboard select-enable-clipboard) - (select-enable-primary select-enable-primary)) - (setq select-enable-clipboard - (logand mask vterm--selection-clipboard)) - (setq select-enable-primary - (logand mask vterm--selection-primary)) - (kill-new data) - (message "kill-ring is updated by vterm OSC 52(Manipulate Selection Data)")) - )) - -;;; Entry Points - -;;;###autoload -(defun vterm (&optional arg) - "Create an interactive Vterm buffer. -Start a new Vterm session, or switch to an already active -session. Return the buffer selected (or created). - -With a nonnumeric prefix arg, create a new session. - -With a string prefix arg, create a new session with arg as buffer name. - -With a numeric prefix arg (as in `C-u 42 M-x vterm RET'), switch -to the session with that number, or create it if it doesn't -already exist. - -The buffer name used for Vterm sessions is determined by the -value of `vterm-buffer-name'." - (interactive "P") - (vterm--internal #'pop-to-buffer-same-window arg)) - -;;;###autoload -(defun vterm-other-window (&optional arg) - "Create an interactive Vterm buffer in another window. -Start a new Vterm session, or switch to an already active -session. Return the buffer selected (or created). - -With a nonnumeric prefix arg, create a new session. - -With a string prefix arg, create a new session with arg as buffer name. - -With a numeric prefix arg (as in `C-u 42 M-x vterm RET'), switch -to the session with that number, or create it if it doesn't -already exist. - -The buffer name used for Vterm sessions is determined by the -value of `vterm-buffer-name'." - (interactive "P") - (vterm--internal #'pop-to-buffer arg)) - -(defun vterm--internal (pop-to-buf-fun &optional arg) - (cl-assert vterm-buffer-name) - (let ((buf (cond ((numberp arg) - (get-buffer-create (format "%s<%d>" - vterm-buffer-name - arg))) - ((stringp arg) (generate-new-buffer arg)) - (arg (generate-new-buffer vterm-buffer-name)) - (t - (get-buffer-create vterm-buffer-name))))) - (cl-assert (and buf (buffer-live-p buf))) - (funcall pop-to-buf-fun buf) - (with-current-buffer buf - (unless (derived-mode-p 'vterm-mode) - (vterm-mode))) - buf)) - -;;; Internal - -(defun vterm--flush-output (output) - "Send the virtual terminal's OUTPUT to the shell." - (process-send-string vterm--process output)) -;; Terminal emulation -;; This is the standard process filter for term buffers. -;; It emulates (most of the features of) a VT100/ANSI-style terminal. - -;; References: -;; [ctlseqs]: http://invisible-island.net/xterm/ctlseqs/ctlseqs.html -;; [ECMA-48]: https://www.ecma-international.org/publications/standards/Ecma-048.htm -;; [vt100]: https://vt100.net/docs/vt100-ug/chapter3.html - -(defconst vterm-control-seq-regexp - (concat - ;; A control character, - "\\(?:[\r\n\000\007\t\b\016\017]\\|" - ;; a C1 escape coded character (see [ECMA-48] section 5.3 "Elements - ;; of the C1 set"), - "\e\\(?:[DM78c=]\\|" - ;; another Emacs specific control sequence for term.el, - "AnSiT[^\n]+\n\\|" - ;; another Emacs specific control sequence for vterm.el - ;; printf "\e]%s\e\\" - "\\][^\e]+\e\\\\\\|" - ;; or an escape sequence (section 5.4 "Control Sequences"), - "\\[\\([\x30-\x3F]*\\)[\x20-\x2F]*[\x40-\x7E]\\)\\)") - "Regexp matching control sequences handled by term.el.") - -(defconst vterm-control-seq-prefix-regexp - "[\032\e]") - -(defun vterm--filter (process input) - "I/O Event. Feeds PROCESS's INPUT to the virtual terminal. - -Then triggers a redraw from the module." - (let ((inhibit-redisplay t) - (inhibit-eol-conversion t) - (inhibit-read-only t) - (buf (process-buffer process)) - (i 0) - (str-length (length input)) - decoded-substring - funny) - (when (buffer-live-p buf) - (with-current-buffer buf - ;; borrowed from term.el - ;; Handle non-control data. Decode the string before - ;; counting characters, to avoid garbling of certain - ;; multibyte characters (https://github.com/akermu/emacs-libvterm/issues/394). - ;; same bug of term.el https://debbugs.gnu.org/cgi/bugreport.cgi?bug=1006 - (when vterm--undecoded-bytes - (setq input (concat vterm--undecoded-bytes input)) - (setq vterm--undecoded-bytes nil) - (setq str-length (length input))) - (while (< i str-length) - (setq funny (string-match vterm-control-seq-regexp input i)) - (let ((ctl-end (if funny (match-end 0) - (setq funny (string-match vterm-control-seq-prefix-regexp input i)) - (if funny - (setq vterm--undecoded-bytes - (substring input funny)) - (setq funny str-length)) - ;; The control sequence ends somewhere - ;; past the end of this string. - (1+ str-length)))) - (when (> funny i) - ;; Handle non-control data. Decode the string before - ;; counting characters, to avoid garbling of certain - ;; multibyte characters (emacs bug#1006). - (setq decoded-substring - (decode-coding-string - (substring input i funny) - locale-coding-system t)) - ;; Check for multibyte characters that ends - ;; before end of string, and save it for - ;; next time. - (when (= funny str-length) - (let ((partial 0) - (count (length decoded-substring))) - (while (and (< partial count) - (eq (char-charset (aref decoded-substring - (- count 1 partial))) - 'eight-bit)) - (cl-incf partial)) - (when (> count partial 0) - (setq vterm--undecoded-bytes - (substring decoded-substring (- partial))) - (setq decoded-substring - (substring decoded-substring 0 (- partial))) - (cl-decf str-length partial) - (cl-decf funny partial)))) - (ignore-errors (vterm--write-input vterm--term decoded-substring)) - (setq i funny)) - (when (<= ctl-end str-length) - (ignore-errors (vterm--write-input vterm--term (substring input i ctl-end)))) - (setq i ctl-end))) - (vterm--update vterm--term))))) - -(defun vterm--sentinel (process event) - "Sentinel of vterm PROCESS. -Argument EVENT process event." - (let ((buf (process-buffer process))) - (run-hook-with-args 'vterm-exit-functions - (if (buffer-live-p buf) buf nil) - event) - (if (and vterm-kill-buffer-on-exit (buffer-live-p buf)) - (kill-buffer buf)))) - -(defun vterm--text-scale-mode (&optional _argv) - "Fix `line-number' height for scaled text." - (and text-scale-mode - (equal major-mode 'vterm-mode) - (boundp 'display-line-numbers) - (let ((height (expt text-scale-mode-step - text-scale-mode-amount))) - (when vterm--linenum-remapping - (face-remap-remove-relative vterm--linenum-remapping)) - (setq vterm--linenum-remapping - (face-remap-add-relative 'line-number :height height)))) - (window--adjust-process-windows)) - -(advice-add #'text-scale-mode :after #'vterm--text-scale-mode) - -(defun vterm--window-adjust-process-window-size (process windows) - "Adjust width of window WINDOWS associated to process PROCESS. - -`vterm-min-window-width' determines the minimum width allowed." - ;; We want `vterm-copy-mode' to resemble a fundamental buffer as much as - ;; possible. Hence, we must not call this function when the minor mode is - ;; enabled, otherwise the buffer would be redrawn, messing around with the - ;; position of the point. - (unless vterm-copy-mode - (let* ((size (funcall window-adjust-process-window-size-function - process windows)) - (width (car size)) - (height (cdr size)) - (inhibit-read-only t)) - (setq width (- width (vterm--get-margin-width))) - (setq width (max width vterm-min-window-width)) - (when (and (processp process) - (process-live-p process) - (> width 0) - (> height 0)) - (vterm--set-size vterm--term height width) - (cons width height))))) - -(defun vterm--get-margin-width () - "Get margin width of vterm buffer when `display-line-numbers-mode' is enabled." - (let ((width 0) - (max-line-num (+ (frame-height) vterm-max-scrollback))) - (when (bound-and-true-p display-line-numbers) - (setq width (+ width 4 - (string-width (number-to-string max-line-num))))) - width)) - -(defun vterm--delete-lines (line-num count &optional delete-whole-line) - "Delete COUNT lines from LINE-NUM. -If LINE-NUM is negative backward-line from end of buffer. -If option DELETE-WHOLE-LINE is non-nil, then this command kills -the whole line including its terminating newline" - (save-excursion - (when (vterm--goto-line line-num) - (vterm--delete-region (point) (line-end-position count)) - (when (and delete-whole-line - (looking-at "\n")) - (vterm--delete-char 1))))) - -(defun vterm--goto-line (n) - "Go to line N and return true on success. -If N is negative backward-line from end of buffer." - (cond - ((> n 0) - (goto-char (point-min)) - (eq 0 (forward-line (1- n)))) - (t - (goto-char (point-max)) - (eq 0 (forward-line n))))) - -(defun vterm--set-title (title) - "Use TITLE to set the buffer name according to `vterm-buffer-name-string'." - (when vterm-buffer-name-string - (rename-buffer (format vterm-buffer-name-string title) t))) - -(defun vterm--set-directory (path) - "Set `default-directory' to PATH." - (let ((dir (vterm--get-directory path))) - (when dir (setq default-directory dir)))) - -(defun vterm--get-directory (path) - "Get normalized directory to PATH." - (when path - (let (directory) - (if (string-match "^\\(.*?\\)@\\(.*?\\):\\(.*?\\)$" path) - (progn - (let ((user (match-string 1 path)) - (host (match-string 2 path)) - (dir (match-string 3 path))) - (if (and (string-equal user user-login-name) - (string-equal host (system-name))) - (progn - (when (file-directory-p dir) - (setq directory (file-name-as-directory dir)))) - (setq directory (file-name-as-directory (concat "/-:" path)))))) - (when (file-directory-p path) - (setq directory (file-name-as-directory path)))) - directory))) - -(defun vterm--get-pwd (&optional linenum) - "Get working directory at LINENUM." - (when vterm--term - (let ((raw-pwd (vterm--get-pwd-raw - vterm--term - (or linenum (line-number-at-pos))))) - (when raw-pwd - (vterm--get-directory raw-pwd))))) - -(defun vterm--get-color (index) - "Get color by index from `vterm-color-palette'. -Argument INDEX index of the terminal color. -Special values for INDEX are: --11 foreground for cells with underline attribute, foreground of -the `vterm-color-underline' face is used in this case. --12 background for cells with inverse video attribute, background -of the `vterm-color-inverse-video' face is used in this case." - (cond - ((and (>= index 0) (< index 8)) - (face-foreground - (elt vterm-color-palette index) - nil 'default)) - ((and (>= index 8) (< index 16)) - (face-background - (elt vterm-color-palette (% index 8)) - nil 'default)) - ((= index -11) - (face-foreground 'vterm-color-underline nil 'default)) - ((= index -12) - (face-background 'vterm-color-inverse-video nil 'default)) - (t - nil))) - -(defun vterm--eval (str) - "Check if string STR is `vterm-eval-cmds' and execute command. - -All passed in arguments are strings and forwarded as string to -the called functions." - (let* ((parts (split-string-and-unquote str)) - (command (car parts)) - (args (cdr parts)) - (f (assoc command vterm-eval-cmds))) - (if f - (apply (cadr f) args) - (message "Failed to find command: %s. To execute a command, - add it to the `vterm-eval-cmd' list" command)))) - -;; TODO: Improve doc string, it should not point to the readme but it should -;; be self-contained. -(defun vterm--prompt-tracking-enabled-p () - "Return t if tracking the prompt is enabled. - -Prompt tracking need shell side configurations. - -For zsh user, this is done by PROMPT=$PROMPT'%{$(vterm_prompt_end)%}'. - -The shell send semantic information about where the prompt ends via properly -escaped sequences to Emacs. - -More information see `Shell-side configuration' and `Directory tracking' -in README." - (or vterm--prompt-tracking-enabled-p - (save-excursion - (setq vterm--prompt-tracking-enabled-p - (next-single-property-change (point-min) 'vterm-prompt))))) - -(defun vterm-next-prompt (n) - "Move to end of Nth next prompt in the buffer." - (interactive "p") - (if (and vterm-use-vterm-prompt-detection-method - (vterm--prompt-tracking-enabled-p)) - (let ((pt (point)) - (promp-pt (vterm--get-prompt-point))) - (when promp-pt (goto-char promp-pt)) - (cl-loop repeat (or n 1) do - (setq pt (next-single-property-change (line-beginning-position 2) 'vterm-prompt)) - (when pt (goto-char pt)))) - (term-next-prompt n))) - -(defun vterm-previous-prompt (n) - "Move to end of Nth previous prompt in the buffer." - (interactive "p") - (if (and vterm-use-vterm-prompt-detection-method - (vterm--prompt-tracking-enabled-p)) - (let ((pt (point)) - (prompt-pt (vterm--get-prompt-point))) - (when prompt-pt - (goto-char prompt-pt) - (when (> pt (point)) - (setq n (1- (or n 1)))) - (cl-loop repeat n do - (setq pt (previous-single-property-change (1- (point)) 'vterm-prompt)) - (when pt (goto-char (1- pt)))))) - (term-previous-prompt n))) - -(defun vterm--get-beginning-of-line (&optional pt) - "Find the start of the line, bypassing line wraps. -If PT is specified, find it's beginning of the line instead of the beginning -of the line at cursor." - (save-excursion - (when pt (goto-char pt)) - (beginning-of-line) - (while (and (not (bobp)) - (get-text-property (1- (point)) 'vterm-line-wrap)) - (forward-char -1) - (beginning-of-line)) - (point))) - -(defun vterm--get-end-of-line (&optional pt) - "Find the start of the line, bypassing line wraps. -If PT is specified, find it's end of the line instead of the end -of the line at cursor." - (save-excursion - (when pt (goto-char pt)) - (end-of-line) - (while (get-text-property (point) 'vterm-line-wrap) - (forward-char) - (end-of-line)) - (point))) - -;; TODO: Improve doc string, it should not point to the readme but it should -;; be self-contained. -(defun vterm--get-prompt-point () - "Get the position of the end of current prompt. -More information see `vterm--prompt-tracking-enabled-p' and -`Directory tracking and Prompt tracking'in README." - (let ((end-point (vterm--get-end-of-line)) - prompt-point) - (save-excursion - (if (and vterm-use-vterm-prompt-detection-method - (vterm--prompt-tracking-enabled-p)) - (if (get-text-property end-point 'vterm-prompt) - end-point - (setq prompt-point (previous-single-property-change end-point 'vterm-prompt)) - (when prompt-point (setq prompt-point (1- prompt-point)))) - (goto-char end-point) - (if (search-backward-regexp term-prompt-regexp nil t) - (goto-char (match-end 0)) - (vterm--get-beginning-of-line)))))) - -(defun vterm--at-prompt-p () - "Return t if the cursor position is at shell prompt." - (= (point) (or (vterm--get-prompt-point) 0))) - -(defun vterm-cursor-in-command-buffer-p (&optional pt) - "Check whether cursor in command buffer area." - (save-excursion - (vterm-reset-cursor-point) - (let ((promp-pt (vterm--get-prompt-point))) - (when promp-pt - (<= promp-pt (or pt (vterm--get-cursor-point))))))) - -(defun vterm-beginning-of-line () - "Move point to the beginning of the line. - -Move the point to the first character after the shell prompt on this line. -If the point is already there, move to the beginning of the line. -Effectively toggle between the two positions." - (interactive "^") - (if (vterm--at-prompt-p) - (goto-char (vterm--get-beginning-of-line)) - (goto-char (max (or (vterm--get-prompt-point) 0) - (vterm--get-beginning-of-line))))) - -(defun vterm-end-of-line () - "Move point to the end of the line, bypassing line wraps." - (interactive "^") - (goto-char (vterm--get-end-of-line))) - -(defun vterm-reset-cursor-point () - "Make sure the cursor at the right position." - (interactive) - (when vterm--term - (let ((inhibit-read-only t)) - (vterm--reset-point vterm--term)))) - -(defun vterm--get-cursor-point () - "Get term cursor position." - (when vterm--term - (save-excursion - (vterm-reset-cursor-point)))) - -(defun vterm--reinsert-fake-newlines () - "Reinsert fake newline from `vterm--copy-mode-fake-newlines'." - (let ((inhibit-read-only t) - (inhibit-redisplay t) - (fake-newline-text "\n") - fake-newline-pos) - (add-text-properties 0 1 '(vterm-line-wrap t rear-nonsticky t) - fake-newline-text) - (while vterm--copy-mode-fake-newlines - (setq fake-newline-pos (car vterm--copy-mode-fake-newlines)) - (setq vterm--copy-mode-fake-newlines (cdr vterm--copy-mode-fake-newlines)) - (goto-char fake-newline-pos) - (insert fake-newline-text)))) - -(defun vterm--remove-fake-newlines (&optional remembering-pos-p) - "Filter out injected newlines were injected when rendering the terminal. - -These newlines were tagged with \\='vterm-line-wrap property so we -can find them and remove them. -If REMEMBERING-POS-P is not nil remembering their positions in a buffer-local -`vterm--copy-mode-fake-newlines'." - (let (fake-newline - (inhibit-read-only t) - (inhibit-redisplay t)) - (when remembering-pos-p - (setq vterm--copy-mode-fake-newlines nil)) - - (goto-char (point-max)) - (when (and (bolp) - (not (bobp)) - (get-text-property (1- (point)) 'vterm-line-wrap)) - (forward-char -1) - (when remembering-pos-p - (setq vterm--copy-mode-fake-newlines - (cons (point) vterm--copy-mode-fake-newlines))) - (vterm--delete-char 1)) - - (while (and (not (bobp)) - (setq fake-newline (previous-single-property-change - (point) 'vterm-line-wrap))) - (goto-char (1- fake-newline)) - (cl-assert (eq ?\n (char-after))) - (when remembering-pos-p - (setq vterm--copy-mode-fake-newlines - (cons (point) vterm--copy-mode-fake-newlines))) - (vterm--delete-char 1)))) - -(defun vterm--filter-buffer-substring (content) - "Filter string CONTENT of fake/injected newlines." - (with-temp-buffer - (vterm--insert content) - (vterm--remove-fake-newlines nil) - (buffer-string))) - - -(provide 'vterm) -;; Local Variables: -;; indent-tabs-mode: nil -;; End: -;;; vterm.el ends here diff --git a/init.el b/init.el @@ -395,7 +395,7 @@ ("melpa" . "https://melpa.org/packages/"))) '(package-pinned-packages '((sly . "melpa"))) '(package-selected-packages - '(highlight-function-calls prism modus-themes imenu-list diff-hl embark-consult embark all-the-icons-completion all-the-icons-ibuffer all-the-icons-dired sly-named-readtables sly-macrostep denote-refs denote-menu denote ox-epub ob-powershell powershell web-mode lexic editorconfig elfeed-tube-mpv elfeed-tube cider restclient-jq graphviz-dot-mode consult-eglot jq-mode ob-restclient restclient vterm deadgrep helpful pdf-tools paredit-menu paredit corfu sly eglot aggressive-indent project nov nhexl-mode elfeed magit yaml-mode json-mode lua-mode go-mode geiser-guile geiser org-contrib org ace-window expand-region consult marginalia uuidgen request diminish which-key)) + '(highlight-function-calls prism modus-themes imenu-list diff-hl embark-consult embark all-the-icons-completion all-the-icons-ibuffer all-the-icons-dired sly-named-readtables sly-macrostep denote-refs denote-menu denote ox-epub ob-powershell powershell web-mode lexic editorconfig elfeed-tube-mpv elfeed-tube restclient-jq graphviz-dot-mode consult-eglot jq-mode ob-restclient restclient deadgrep helpful pdf-tools paredit-menu paredit corfu sly eglot aggressive-indent project nov nhexl-mode elfeed magit yaml-mode json-mode lua-mode go-mode org-contrib org ace-window expand-region consult marginalia uuidgen diminish which-key)) '(pcomplete-ignore-case t t) '(pixel-scroll-precision-mode t) '(prism-parens t)
