diff --git a/.github/ISSUE_TEMPLATE.md b/.github/ISSUE_TEMPLATE.md deleted file mode 100644 index e3e5cda..0000000 --- a/.github/ISSUE_TEMPLATE.md +++ /dev/null @@ -1,33 +0,0 @@ -*Use the template below when reporting bugs. Please, make sure that -you're running the latest stable clojure-mode and that the problem you're reporting -hasn't been reported (and potentially fixed) already.* - -**Please, remove all of the placeholder text (the one in italics) 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 - -### clojure-ts-mode version - -*Include here the version string displayed by `M-x -clojure-ts-mode-display-version`. Here's an example:* - -``` -clojure-ts-mode (version 5.2.0) -``` - -### Emacs version - -*E.g. 29.1* (use C-h C-a to see it) - -### Operating system - -*E.g. Windows 10* diff --git a/.github/ISSUE_TEMPLATE/bug_report.md b/.github/ISSUE_TEMPLATE/bug_report.md new file mode 100644 index 0000000..329a945 --- /dev/null +++ b/.github/ISSUE_TEMPLATE/bug_report.md @@ -0,0 +1,54 @@ +--- +name: Bug Report +about: Report an issue you've discovered. +labels: [bug] +--- + +*Use the template below when reporting bugs. Please, make sure that +you're running the latest stable clojure-ts-mode and that the problem you're reporting +hasn't been reported (and potentially fixed) already.* + +**Please, remove all of the placeholder text (the one in italics) 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 + +### clojure-ts-mode version + +*Include here the version string displayed by `M-x +clojure-ts-mode-display-version`. Here's an example:* + +``` +clojure-ts-mode (version 0.1.5) +``` + +### tree-sitter-clojure grammar version + +*E.g. v0.0.12* + +*Please make sure you are using compatible tree-sitter grammars. +See the variable clojure-ts-grammar-recipes for the current recommend versions. +They should be installed automatically if not found. +However, some linux distributions package these same grammars and Emacs will use them if found.* + +**If you are not sure what version you are using, try running +M-x treesit-install-language-grammar clojure y, and use the values +https://github.com/sogaiu/tree-sitter-clojure.git for the URL, +v0.0.12 for the TAG and default values for the remaining options. +Then see if the problem still persists.** + +### Emacs version + +*E.g. 29.1* (use C-h C-a to see it) + +### Operating system + +*E.g. Windows 10* diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml new file mode 100644 index 0000000..53af842 --- /dev/null +++ b/.github/workflows/ci.yml @@ -0,0 +1,77 @@ +name: CI + +on: + push: + paths: ['**.el'] + pull_request: + paths: ['**.el'] + +jobs: + compile: + runs-on: ubuntu-latest + # continue-on-error: ${{matrix.emacs_version == 'snapshot'}} + + strategy: + matrix: + emacs_version: ['30.1', 'snapshot'] + + steps: + - name: Set up Emacs + uses: purcell/setup-emacs@master + with: + version: ${{matrix.emacs_version}} + + - name: Install Eldev + run: curl -fsSL https://raw.github.com/doublep/eldev/master/webinstall/github-eldev | sh + + - name: Check out the source code + uses: actions/checkout@v4 + + - name: Compile the project + run: make compile + + lint: + runs-on: ubuntu-latest + # continue-on-error: ${{matrix.emacs_version == 'snapshot'}} + + strategy: + matrix: + emacs_version: ['30.1'] + + steps: + - name: Set up Emacs + uses: purcell/setup-emacs@master + with: + version: ${{matrix.emacs_version}} + + - name: Install Eldev + run: curl -fsSL https://raw.github.com/doublep/eldev/master/webinstall/github-eldev | sh + + - name: Check out the source code + uses: actions/checkout@v4 + + - name: Lint the project + run: make lint + + test: + runs-on: ubuntu-latest + # continue-on-error: ${{matrix.emacs_version == 'snapshot'}} + + strategy: + matrix: + emacs_version: ['30.1', 'snapshot'] + + steps: + - name: Set up Emacs + uses: purcell/setup-emacs@master + with: + version: ${{matrix.emacs_version}} + + - name: Install Eldev + run: curl -fsSL https://raw.github.com/doublep/eldev/master/webinstall/github-eldev | sh + + - name: Check out the source code + uses: actions/checkout@v4 + + - name: Run tests + run: make test diff --git a/.github/workflows/github_release.yml b/.github/workflows/github_release.yml new file mode 100644 index 0000000..390eacc --- /dev/null +++ b/.github/workflows/github_release.yml @@ -0,0 +1,27 @@ +name: Create GitHub Release + +on: + push: + tags: + - "v*" # Trigger when a version tag is pushed (e.g., v1.0.0) + +jobs: + create-release: + runs-on: ubuntu-latest + + permissions: + contents: write + + steps: + - name: Checkout Code + uses: actions/checkout@v4 + + - name: Create GitHub Release with Auto-Generated Notes + uses: ncipollo/release-action@v1 + with: + tag: ${{ github.ref_name }} + name: clojure-ts-mode ${{ github.ref_name }} + prerelease: ${{ contains(github.ref, '-rc') || contains(github.ref, '-alpha') || contains(github.ref, '-beta') }} + generateReleaseNotes: true # Auto-generate release notes based on PRs and commits + # TODO: Use bodyFile to get the contents from changelog + token: ${{ secrets.GITHUB_TOKEN }} diff --git a/.github/workflows/lint-emacs.yml b/.github/workflows/lint-emacs.yml deleted file mode 100644 index 872a125..0000000 --- a/.github/workflows/lint-emacs.yml +++ /dev/null @@ -1,31 +0,0 @@ -name: Lint Emacs - -on: - push: - paths: ['**.el'] - pull_request: - paths: ['**.el'] - -jobs: - test: - runs-on: ubuntu-latest - # continue-on-error: ${{matrix.emacs_version == 'snapshot'}} - - strategy: - matrix: - emacs_version: ['snapshot'] - - steps: - - name: Set up Emacs - uses: purcell/setup-emacs@master - with: - version: ${{matrix.emacs_version}} - - - name: Install Eldev - run: curl -fsSL https://raw.github.com/doublep/eldev/master/webinstall/github-eldev | sh - - - name: Check out the source code - uses: actions/checkout@v2 - - - name: Lint the project - run: eldev -dtT -C compile --warnings-as-errors diff --git a/.gitignore b/.gitignore index 7807b63..c3df805 100644 --- a/.gitignore +++ b/.gitignore @@ -9,3 +9,6 @@ elpa* /clojure-ts-mode-autoloads.el /clojure-ts-mode-pkg.el + +/.eldev +/Eldev-local diff --git a/CHANGELOG.md b/CHANGELOG.md index 59fedbd..96251e7 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -2,15 +2,133 @@ ## main (unreleased) -- Re-enable treesit-transpose-sexps on Emacs 30 after fixes released by @casouri. +- Add a dedicated mode for editing Joker code. (`clojure-ts-joker-mode`). +- [#113](https://github.com/clojure-emacs/clojure-ts-mode/pull/113): Fix non-working refactoring commands for Emacs-30. +- [#114](https://github.com/clojure-emacs/clojure-ts-mode/pull/114): Extend built-in completion to complete keywords and local bindings in + `for` and `doseq` forms. + +## 0.5.1 (2025-06-17) + +- [#109](https://github.com/clojure-emacs/clojure-ts-mode/issues/109): Improve performance by pre-compiling Tree-sitter queries. +- [#111](https://github.com/clojure-emacs/clojure-ts-mode/pull/111): Set `clojure-ts-completion-at-point-function` only for `clojure-ts-mode` buffers. + +## 0.5.0 (2025-06-04) + +- [#96](https://github.com/clojure-emacs/clojure-ts-mode/pull/96): Highlight function name properly in `extend-protocol` form. +- [#96](https://github.com/clojure-emacs/clojure-ts-mode/pull/96): Add support for extend-protocol forms to `clojure-ts-add-arity` refactoring + command. +- [#99](https://github.com/clojure-emacs/clojure-ts-mode/pull/99): Improve navigation by s-expression by switching to an experimental + Clojure grammar. +- [#99](https://github.com/clojure-emacs/clojure-ts-mode/pull/99): More consistent docstrings highlighting and `fill-paragraph` behavior. +- [#99](https://github.com/clojure-emacs/clojure-ts-mode/pull/99): Fix bug in `clojure-ts-align` when nested form has extra spaces. +- [#99](https://github.com/clojure-emacs/clojure-ts-mode/pull/99): Fix bug in `clojure-ts-unwind` when there is only one expression after + threading symbol. +- [#103](https://github.com/clojure-emacs/clojure-ts-mode/issues/103): Introduce `clojure-ts-jank-use-cpp-parser` customization which allows + highlighting C++ syntax in Jank `native/raw` forms. +- [#103](https://github.com/clojure-emacs/clojure-ts-mode/issues/103): Introduce `clojure-ts-clojurescript-use-js-parser` customization which + allows highlighting JS syntax in ClojureScript `js*` forms. +- [#104](https://github.com/clojure-emacs/clojure-ts-mode/pull/104): Introduce the `clojure-ts-extra-def-forms` customization option to specify + additional `defn`-like forms that should be fontified. +- [#108](https://github.com/clojure-emacs/clojure-ts-mode/pull/108): Introduce completion feature and `clojure-ts-completion-enabled` + customization. + +## 0.4.0 (2025-05-15) + +- [#16](https://github.com/clojure-emacs/clojure-ts-mode/issues/16): Introduce `clojure-ts-align`. +- [#11](https://github.com/clojure-emacs/clojure-ts-mode/issues/11): Enable regex syntax highlighting. +- [#16](https://github.com/clojure-emacs/clojure-ts-mode/issues/16): Add support for automatic aligning forms. +- [#82](https://github.com/clojure-emacs/clojure-ts-mode/issues/82): Introduce `clojure-ts-outline-variant`. +- [#86](https://github.com/clojure-emacs/clojure-ts-mode/pull/86): Better handling of function literals: + - Syntax highlighting of built-in keywords. + - Consistent indentation with regular forms. + - Support for automatic aligning forms. +- [#88](https://github.com/clojure-emacs/clojure-ts-mode/pull/88): Introduce `clojure-ts-unwind` and `clojure-ts-unwind-all`. +- [#89](https://github.com/clojure-emacs/clojure-ts-mode/pull/89): Introduce `clojure-ts-thread`, `clojure-ts-thread-first-all` and + `clojure-ts-thread-last-all`. +- [#90](https://github.com/clojure-emacs/clojure-ts-mode/pull/90): Introduce `clojure-ts-cycle-privacy`. +- [#91](https://github.com/clojure-emacs/clojure-ts-mode/pull/91): Introduce `clojure-ts-cycle-keyword-string`. +- [#92](https://github.com/clojure-emacs/clojure-ts-mode/pull/92): Add commands to convert between collections types. +- [#93](https://github.com/clojure-emacs/clojure-ts-mode/pull/93): Introduce `clojure-ts-add-arity`. +- [#94](https://github.com/clojure-emacs/clojure-ts-mode/pull/94): Add indentation rules and `clojure-ts-align` support for namespaced maps. +- [#95](https://github.com/clojure-emacs/clojure-ts-mode/pull/95): Introduce `clojure-ts-cycle-conditional` and `clojure-ts-cycle-not`. + +## 0.3.0 (2025-04-15) + +- [#62](https://github.com/clojure-emacs/clojure-ts-mode/issues/62): Define `list` "thing" to improve navigation in Emacs 31. +- [#64](https://github.com/clojure-emacs/clojure-ts-mode/pull/64): Add defcustom `clojure-ts-auto-remap` to control remapping of `clojure-mode` buffers. +- [#66](https://github.com/clojure-emacs/clojure-ts-mode/pull/66): Improve syntax highlighting: + - Highlight metadata with single keyword with `clojure-ts-keyword-face`. + - Only highlight built-ins from `clojure.core` namespace. + - Highlight named lambda functions properly. + - Fix syntax highlighting for functions and vars with metadata on the previous + line. +- [#67](https://github.com/clojure-emacs/clojure-ts-mode/pull/67): Improve semantic indentation rules to be more consistent with cljfmt. +- [#67](https://github.com/clojure-emacs/clojure-ts-mode/pull/67): Introduce `clojure-ts-semantic-indent-rules` customization option. +- [#61](https://github.com/clojure-emacs/clojure-ts-mode/issues/61): Fix issue with indentation of collection items with metadata. +- [#68](https://github.com/clojure-emacs/clojure-ts-mode/pull/68): Proper syntax highlighting for expressions with metadata. +- [#69](https://github.com/clojure-emacs/clojure-ts-mode/pull/69): Add basic support for dynamic indentation via `clojure-ts-get-indent-function`. +- [#70](https://github.com/clojure-emacs/clojure-ts-mode/pull/70): Add support for nested indentation rules. +- [#71](https://github.com/clojure-emacs/clojure-ts-mode/pull/71): Properly highlight function name in `letfn` form. +- [#72](https://github.com/clojure-emacs/clojure-ts-mode/pull/72): Pass fully qualified symbol to `clojure-ts-get-indent-function`. +- [#76](https://github.com/clojure-emacs/clojure-ts-mode/pull/76): Improve performance of semantic indentation by caching rules. +- [#74](https://github.com/clojure-emacs/clojure-ts-mode/issues/74): Add imenu support for keywords definitions. +- [#77](https://github.com/clojure-emacs/clojure-ts-mode/issues/77): Update grammars to the latest versions. +- [#79](https://github.com/clojure-emacs/clojure-ts-mode/pull/79): Improve markdown highlighting in the docstrings. +- [#60](https://github.com/clojure-emacs/clojure-ts-mode/issues/60): Fix issue with incorrect fontification, when `markdown-inline` is enabled. + +## 0.2.3 (2025-03-04) + +- [#38]: Add support for `in-ns` forms in `clojure-ts-find-ns`. +- [#46]: Fix missing `comment-add` variable in `clojure-ts-mode-variables` mentioned in [#26] +- Add imenu support for `deftest` definitions. +- [#53]: Let `clojure-ts-mode` derive from `clojure-mode` for Emacs 30+. +- [#42]: Fix imenu support for definitions with metadata. +- [#42]: Fix font locking of definitions with metadata. +- [#42]: Fix indentation of definitions with metadata. +- [#49]: Fix semantic indentation of quoted functions. +- [#58]: Add custom `fill-paragraph-function` which respects docstrings similar to + `clojure-mode`. +- [#59]: Add customization option to disable markdown syntax highlighting in the + docstrings. + +## 0.2.2 (2024-02-16) + +- [#37]: Fix derived modes broken with [#36]. + +## 0.2.1 (2024-02-14) + +- [#36]: Rename all derived mode vars to match the package prefix. + - `clojurescript-ts-mode` -> `clojure-ts-clojurescript-mode` + - `clojurec-ts-mode` -> `clojure-ts-clojurec-mode` + - `clojure-dart-ts-mode` -> `clojure-ts-clojuredart-mode` + - `clojure-jank-ts-mode` -> `clojure-ts-jank-mode` +- [#30]: Add custom option `clojure-ts-toplevel-inside-comment-form` as an equivalent to `clojure-toplevel-inside-comment-form` in `clojure-mode`. +- [#32]: Change behavior of `beginning-of-defun` and `end-of-defun` to consider all Clojure sexps as defuns. + +## 0.2.0 + - Pin grammar revision in treesit-language-source-alist -- Make font lock feature list more conforming with recommendations - - (See treesit-font-lock-level documentation for more information.) -- Highlight docstrings in interface, protocol, and variable definitions -- Add support for semantic indentation (now the default) + - [bd61a7fb281b7b0b1d2e20d19ab5d46cbcdc6c1e](https://github.com/clojure-emacs/clojure-ts-mode/commit/bd61a7fb281b7b0b1d2e20d19ab5d46cbcdc6c1e) +Make font lock feature list more conforming with recommendations + - (See treesit-font-lock-level documentation for more information.) + - [2225190ee57ef667d69f2cd740e0137810bc38e7](https://github.com/clojure-emacs/clojure-ts-mode/commit/2225190ee57ef667d69f2cd740e0137810bc38e7) +Highlight docstrings in interface, protocol, and variable definitions + - [9af0a6b35c708309acdfeb4c0c79061b0fd4eb44](https://github.com/clojure-emacs/clojure-ts-mode/commit/9af0a6b35c708309acdfeb4c0c79061b0fd4eb44) +Add support for semantic indentation (now the default) + - [ae2e2486010554cfeb12f06a1485b4d81609d964](https://github.com/clojure-emacs/clojure-ts-mode/commit/ae2e2486010554cfeb12f06a1485b4d81609d964) + - [ca3914aa7aa9645ab244658f8db781cc6f95111e](https://github.com/clojure-emacs/clojure-ts-mode/commit/ca3914aa7aa9645ab244658f8db781cc6f95111e) + - [85871fdbc831b3129dae5762e9c247d453c35e15](https://github.com/clojure-emacs/clojure-ts-mode/commit/85871fdbc831b3129dae5762e9c247d453c35e15) + - [ff5d7e13dc53cc5da0e8139b04e02d90f61d9065](https://github.com/clojure-emacs/clojure-ts-mode/commit/ff5d7e13dc53cc5da0e8139b04e02d90f61d9065) - Highlight "\`quoted-symbols\` in docs strings like this." - - This feature uses a nested markdown parser. + - This feature uses a nested markdown parser. If the parser is not available this feature should be silently disabled. + - [9af0a6b35c708309acdfeb4c0c79061b0fd4eb44](https://github.com/clojure-emacs/clojure-ts-mode/commit/9af0a6b35c708309acdfeb4c0c79061b0fd4eb44) +- Highlight methods for `deftype`, `defrecord`, `defprotocol`, `reify` and `definterface` + forms ([#20](https://github.com/clojure-emacs/clojure-ts-mode/issues/20)). + - [5231c348e509cff91edd1ec59d7a59645395da15](https://github.com/clojure-emacs/clojure-ts-mode/commit/5231c348e509cff91edd1ec59d7a59645395da15) + - Thank you rrudakov for this contribution. +- Add derived `clojure-jank-ts-mode` for the [Jank](https://github.com/jank-lang/jank) dialect of clojure + - [a7b9654488693cdc9057a91410f74de42a397d1b](https://github.com/clojure-emacs/clojure-ts-mode/commit/a7b9654488693cdc9057a91410f74de42a397d1b) ## 0.1.5 @@ -24,18 +142,18 @@ ## 0.1.3 - Add custom option for highlighting comment macro body forms as comments. [ae3790adc0fc40ad905b8c30b152122991592a4e](https://github.com/clojure-emacs/clojure-ts-mode/commit/ae3790adc0fc40ad905b8c30b152122991592a4e) - - Defaults to OFF, highlighting comment body forms like any other expressions. - - Additionally, does a better job of better detecting comment macros by reducing false positives from forms like (not.clojure.core/comment) + - Defaults to OFF, highlighting comment body forms like any other expressions. + - Additionally, does a better job of better detecting comment macros by reducing false positives from forms like (not.clojure.core/comment) ## 0.1.2 -- Add a syntax table from clojure-mode. [712dc772fd38111c1e35fe60e4dbe7ac83032bd6](https://github.com/clojure-emacs/clojure-ts-mode/commit/712dc772fd38111c1e35fe60e4dbe7ac83032bd6). - - Better support for `thing-at-point` driven functionality. - - Thank you @jasonjckn for this contribution. +- Add a syntax table from clojure-mode. [712dc772fd38111c1e35fe60e4dbe7ac83032bd6](https://github.com/clojure-emacs/clojure-ts-mode/commit/712dc772fd38111c1e35fe60e4dbe7ac83032bd6). + - Better support for `thing-at-point` driven functionality. + - Thank you @jasonjckn for this contribution. - Add 3 derived major modes [4dc853df16ba09d10dc3a648865e681679c17606](https://github.com/clojure-emacs/clojure-ts-mode/commit/4dc853df16ba09d10dc3a648865e681679c17606) - - clojurescript-ts-mode - - clojurec-ts-mode - - clojure-dart-ts-mode + - clojurescript-ts-mode + - clojurec-ts-mode + - clojure-dart-ts-mode ## 0.1.1 diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md index b72898e..9a6a3fe 100644 --- a/CONTRIBUTING.md +++ b/CONTRIBUTING.md @@ -35,21 +35,9 @@ clojure-ts-mode (version 2.1.1) * Open a [pull request][4] that relates to *only* one subject with a clear title and description in grammatically correct, complete sentences. -## I don't have a github account - -or maybe you would rather use email. That is okay. - -If you prefer you can also send a message to the [mailing list][7]. -This mailing list is not the [primary issue tracker][1]. -All the same etiquette rules above apply to the mailing list as well. -Submitted patches will be turned into pull requests. -Any issues reported on the mailing list will be copied to the issue tracker -where the primary work will take place. - [1]: https://github.com/clojure-emacs/clojure-ts-mode/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/clojure-ts-mode/blob/master/CHANGELOG.md -[7]: https://lists.sr.ht/~dannyfreeman/clojure-ts-mode diff --git a/Eldev b/Eldev new file mode 100644 index 0000000..b704571 --- /dev/null +++ b/Eldev @@ -0,0 +1,36 @@ +; -*- mode: emacs-lisp; lexical-binding: t -*- + +(eldev-require-version "1.8.2") + +(eldev-use-package-archive 'gnu-elpa) +(eldev-use-package-archive 'nongnu-elpa) + +(eldev-use-package-archive 'melpa-stable) +(eldev-use-package-archive 'melpa-unstable) + +(eldev-use-plugin 'autoloads) + +(eldev-add-extra-dependencies 'test 'buttercup) + +(setq byte-compile-docstring-max-column 240) +(setq checkdoc-force-docstrings-flag nil) +(setq checkdoc-permit-comma-termination-flag t) +(setq checkdoc--interactive-docstring-flag nil) + +(setq eldev-lint-default-excluded '(package)) + +(with-eval-after-load 'elisp-lint + ;; We will byte-compile with Eldev. + (setf elisp-lint-ignored-validators '("fill-column" "check-declare") + enable-local-variables :safe)) + +(setq eldev-project-main-file "clojure-ts-mode.el") + +;; Exclude tests merged from clojure-mode from running, linting and byte compiling +(setf eldev-test-fileset + `(:and ,eldev-test-fileset + (:not "./clojure-mode-tests/*"))) +(setf eldev-standard-excludes + `(:or ,eldev-standard-excludes "./clojure-mode-tests/*")) +(setf eldev-lint-ignored-fileset + `(:or ,eldev-lint-ignored-fileset "./clojure-mode-tests/*")) diff --git a/Makefile b/Makefile new file mode 100644 index 0000000..3e61353 --- /dev/null +++ b/Makefile @@ -0,0 +1,17 @@ +.PHONY: clean compile lint test all +.DEFAULT_GOAL := all + +clean: + eldev clean + +lint: clean + eldev lint -c + +# Checks for byte-compilation warnings. +compile: clean + eldev -dtT compile --warnings-as-errors + +test: clean + eldev -dtT -p test + +all: clean compile lint test diff --git a/README.md b/README.md index 9dc5438..767ca69 100644 --- a/README.md +++ b/README.md @@ -2,42 +2,15 @@ [![MELPA Stable][melpa-stable-badge]][melpa-stable-package] [![MELPA][melpa-badge]][melpa-package] [![License GPL 3][badge-license]][copying] -[![Lint Status](https://github.com/clojure-emacs/clojure-ts-mode/actions/workflows/lint-emacs.yml/badge.svg)](https://github.com/clojure-emacs/clojure-ts-mode/actions/workflows/lint-emacs.yml) +[![CI Status](https://github.com/clojure-emacs/clojure-ts-mode/actions/workflows/ci.yml/badge.svg)](https://github.com/clojure-emacs/clojure-ts-mode/actions/workflows/ci.yml) -# Clojure Tree-Sitter Mode +# Clojure Tree-sitter Mode `clojure-ts-mode` is an Emacs major mode that provides font-lock (syntax highlighting), indentation, and navigation support for the [Clojure(Script) programming language](http://clojure.org), powered by the [tree-sitter-clojure](https://github.com/sogaiu/tree-sitter-clojure) -[tree-sitter](https://tree-sitter.github.io/tree-sitter/) grammar. - -## Configuration - -To see a list of available configuration options do `M-x customize-group clojure-ts`. - -Most configuration changes will require reverting any active clojure-ts-mode buffers. - -### Indentation - -clojure-ts-mode currently supports 2 different indentation strategies -- `semantic`, the default, which tries to match the indentation of clojure-mode and cljfmt -- `fixed`, [a simple indentation strategy outlined by Tonsky in a blog post](https://tonsky.me/blog/clojurefmt/) - -Set the var `clojure-ts-indent-style` to change it. -``` emacs-lisp -(setq clojure-ts-indent-style 'fixed) -``` - -### Font Locking - -Too highlight entire rich `comment` expression with the comment font face, set -``` emacs-lisp -(setq clojure-ts-comment-macro-font-lock-body t) -``` - -By default this is `nil`, so that anything within a `comment` expression is -highlighted like regular clojure code. +[Tree-sitter](https://tree-sitter.github.io/tree-sitter/) grammar. ## Rationale @@ -45,8 +18,17 @@ highlighted like regular clojure code. for a very long time, but it suffers from a few [long-standing problems](https://github.com/clojure-emacs/clojure-mode#caveats), related to Emacs limitations baked into its design. The introduction of built-in support -for Tree-sitter in Emacs 29 provides a natural opportunity to address many of -them. Enter `clojure-ts-mode`. +for Tree-sitter in Emacs 29 presents a natural opportunity to address many of +them. Enter `clojure-ts-mode`, which makes use of Tree-sitter to provide: + +- fast, accurate and more granular font-locking +- fast indentation +- common Emacs functionality like structured navigation, `imenu` (an outline of + a source buffer), current form inference (used internally by various Emacs + modes and utilities), etc + +Working with Tree-sitter is significantly easier than the legacy Emacs APIs for font-locking and +indentation, which makes it easier to contribute to `clojure-ts-mode`, and to improve it in general. Keep in mind that the transition to `clojure-ts-mode` won't happen overnight for several reasons: @@ -54,29 +36,57 @@ Keep in mind that the transition to `clojure-ts-mode` won't happen overnight for - tools that depend on `clojure-mode` will need to be updated to work with `clojure-ts-mode` - we still need to support users of older Emacs versions that don't support Tree-sitter -That's why `clojure-ts-mode` is being developed independently of `clojure-mode` and will one day replace it when the time is right. (e.g. 3 major Emacs version down the road, so circa Emacs 32) +That's why `clojure-ts-mode` is being developed independently of `clojure-mode` +and will one day replace it when the time is right. (e.g. 3 major Emacs version +down the road, so circa Emacs 32) You can read more about the vision for `clojure-ts-mode` [here](https://metaredux.com/posts/2023/03/12/clojure-mode-meets-tree-sitter.html). ## Current Status -**This library is still under development. Breaking changes should be expected.** +> [!WARNING] +> +> This library is still under active development. Breaking changes should be expected. + +The currently provided functionality should cover the needs of most Clojure programmers, but you +can expect to encounter some bugs and missing functionality here and there. + +Those will be addressed over the time, as more and more people use `clojure-ts-mode`. ## Installation -### Emacs 29 +### Requirements -This package requires Emacs 29 built with tree-sitter support from the [emacs-29 branch](https://git.savannah.gnu.org/cgit/emacs.git/log/?h=emacs-29). +For `clojure-ts-mode` to work, you need Emacs 30+ built with Tree-sitter support. +To check if your Emacs supports Tree-sitter run the following (e.g. by using `M-:`): -If you decide to build Emacs from source there's some useful information on this in the Emacs repository: -- [Emacs tree-sitter starter-guide](https://git.savannah.gnu.org/cgit/emacs.git/tree/admin/notes/tree-sitter/starter-guide?h=emacs-29) -- [Emacs install instructions](https://git.savannah.gnu.org/cgit/emacs.git/tree/INSTALL.REPO). +``` emacs-lisp +(treesit-available-p) +``` + +Additionally, you'll need to have Git and some C compiler (`cc`) installed and available +in your `$PATH` (or Emacs's `exec-path`), for `clojure-ts-mode` to be able to install the required +Tree-sitter grammars automatically. + +> [!TIP] +> +> As the Tree-sitter support in Emacs is still fairly new and under active development itself, for optimal +> results you should use the latest stable Emacs release or even the development version of Emacs. +> See the "Caveats" section for more on the subject. ### Install clojure-ts-mode +> [!NOTE] +> +> That's the recommended way to install `clojure-ts-mode`. + +If you have `git` and a C compiler (`cc`) available on your system's `PATH`, +`clojure-ts-mode` will install the +grammars + clojure-ts-mode is available on [MElPA](https://melpa.org/#/clojure-ts-mode) and [NonGNU ELPA](https://elpa.nongnu.org/nongnu/clojure-ts-mode.html). -It can be installed with +It can be installed with: ``` emacs-lisp (package-install 'clojure-ts-mode) @@ -84,7 +94,7 @@ It can be installed with #### package-vc -Emacs 29 also includes `package-vc-install`, so you can run +Emacs also includes `package-vc-install`, so you can run: ``` emacs-lisp (package-vc-install "https://github.com/clojure-emacs/clojure-ts-mode") @@ -104,72 +114,552 @@ git clone https://github.com/clojure-emacs/clojure-ts-mode.git (add-to-list 'load-path "~/path/to/clojure-ts-mode/") ``` -Once installed, evaluate clojure-ts-mode.el and you should be ready to go. +Once installed, evaluate `clojure-ts-mode.el` and you should be ready to go. -### Install tree-sitter grammars +### Install Tree-sitter grammars -The compile tree-sitter clojure shared library must be available to Emacs. -Additionally, the tree-sitter [markdown_inline](https://github.com/MDeiml/tree-sitter-markdown) shared library will also be used for docstrings if available. +> [!NOTE] +> +> `clojure-ts-mode` install the required grammars automatically, so for most +> people no manual actions will be required. -If you have `git` and a C compiler (`cc`) available on your system's `PATH`, **then these steps should not be necessary**. -clojure-ts-mode will install the grammars when you first open a Clojure file and -`clojure-ts-ensure-grammars` is set to `t` (the default). +`clojure-ts-mode` makes use of the following Tree-sitter grammars: -If clojure-ts-mode fails to automatically install the grammar, you have the option to install it manually. +- The [experimental](https://github.com/sogaiu/tree-sitter-clojure/tree/unstable-20250526) version Clojure grammar. This version includes a few + improvements, which potentially will be promoted to a stable release (See [the + discussion](https://github.com/sogaiu/tree-sitter-clojure/issues/65)). This grammar is required for proper work of `clojure-ts-mode`. +- [markdown-inline](https://github.com/MDeiml/tree-sitter-markdown), which will be used for docstrings if available and if + `clojure-ts-use-markdown-inline` is enabled. +- [tree-sitter-regex](https://github.com/tree-sitter/tree-sitter-regex/releases/tag/v0.24.3), which will be used for regex literals if available and if + `clojure-ts-use-regex-parser` is not `nil`. -#### From your OS +`clojure-ts-clojurescript-mode` can optionally use `tree-sitter-javascript` grammar +to highlight JS syntax in `js*` forms. This is enabled by default and can be +turned off by setting `clojure-ts-clojurescript-use-js-parser` to `nil`. -Some distributions may package the tree-sitter-clojure grammar in their package repositories. -If yours does you may be able to install tree-sitter-clojure with your system package manager. +`clojure-ts-jank-mode` can optionally use `tree-sitter-cpp` grammar to highlight C++ +syntax in `native/raw` forms. This is enabled by default and can be turned off by +setting `clojure-ts-jank-use-cpp-parser` to `nil`. -If the version packaged by your OS is out of date, you may see errors in the `*Messages*` buffer or your clojure buffers will not have any syntax highlighting. +If you have `git` and a C compiler (`cc`) available on your system's `PATH`, +`clojure-ts-mode` will install the +grammars when you first open a Clojure file and `clojure-ts-ensure-grammars` is +set to `t` (the default). macOS users can install the required tools like this: -If this happens you should install the grammar manually with `M-x treesit-install-language-grammar clojure` and follow the prompts. -Recommended values for these prompts can be seen in `clojure-ts-grammar-recipes`. +```shell +xcode-select --install +``` -#### Compile From Source +Similarly, Debian/Ubuntu users can do something like: -If all else fails, you can attempt to download and compile manually. -All you need is `git` and a C compiler (GCC works well). +```shell +sudo apt install build-essential +``` -To start, clone [tree-sitter-clojure](https://github.com/sogaiu/tree-sitter-clojure). +This installs GCC, G++, `make`, and other essential development tools. -Then run the following code (depending on your OS) from the tree-sitter-clojure repository on your machine. +If `clojure-ts-mode` fails to automatically install the grammar, you have the +option to install it manually. Please, refer to the installation instructions of +each required grammar and make sure you're install the versions expected (see +`clojure-ts-grammar-recipes` for details). -#### Linux +If `clojure-ts-ensure-grammars` is enabled, `clojure-ts-mode` will try to upgrade +the Clojure grammar if it's outdated. This might happen, when you activate +`clojure-ts-mode` for the first time after package update. If grammar was +previously installed, you might need to restart Emacs, because it has to reload +the grammar binary. -```bash -mkdir -p dist -cc -c -I./src src/parser.c -o "parser.o" -cc -fPIC -shared src/parser.o -o "dist/libtree-sitter-clojure.so" +### Upgrading Tree-sitter grammars + +To reinstall or upgrade Tree-sitter grammars, you can execute: + +```emacs-lisp +M-x clojure-ts-reinstall-grammars ``` -#### macOS +This will install the latest compatible grammars, even if they are already +installed. -```bash -mkdir -p dist -cc -c -I./src src/parser.c -o "parser.o" -cc -fPIC -shared src/parser.o -o "dist/libtree-sitter-clojure.dylib" +## Configuration + +To see a list of available configuration options do `M-x customize-group clojure-ts`. + +Most configuration changes will require reverting any active `clojure-ts-mode` buffers. + +### Remapping of `clojure-mode` buffers + +By default, `clojure-ts-mode` assumes command over all buffers and file +extensions previously associated with `clojure-mode` (and derived major modes +like `clojurescript-mode`). To disable this remapping, set + +``` emacs-lisp +(setopt clojure-ts-auto-remap nil) ``` -#### Windows +You can also use the commands `clojure-ts-activate` / `clojure-ts-deactivate` to +interactively change this behavior. -I don't know how to do this on Windows. Patches welcome! +### Indentation -#### Finally, in emacs +`clojure-ts-mode` currently supports 2 different indentation strategies: -Then tell Emacs where to find the shared library by adding something like this to your init file +- `semantic`, the default, which tries to match the indentation of `clojure-mode` and `cljfmt` +- `fixed`, [a simple indentation strategy outlined by Tonsky in a blog post](https://tonsky.me/blog/clojurefmt/) + +Set the var `clojure-ts-indent-style` to change it. + +``` emacs-lisp +(setopt clojure-ts-indent-style 'fixed) +``` + +> [!TIP] +> +> You can find [this article](https://metaredux.com/posts/2020/12/06/semantic-clojure-formatting.html) comparing semantic and fixed indentation useful. + +#### Customizing semantic indentation + +The indentation of special forms and macros with bodies is controlled via +`clojure-ts-semantic-indent-rules`. Nearly all special forms and built-in macros +with bodies have special indentation settings in clojure-ts-mode, which are +aligned with cljfmt indent rules. You can add/alter the indentation settings in +your personal config. Let's assume you want to indent `->>` and `->` like this: + +```clojure +(->> something + ala + bala + portokala) +``` + +You can do so by putting the following in your config: + +```emacs-lisp +(setopt clojure-ts-semantic-indent-rules '(("->" . ((:block 1))) + ("->>" . ((:block 1))))) +``` + +This means that the body of the `->`/`->>` is after the first argument. + +The default set of rules is defined as +`clojure-ts--semantic-indent-rules-defaults`, any rule can be overridden using +customization option. + +Two types of rules are supported: `:block` and `:inner`, mirroring those in +cljfmt. When a rule is defined as `:block n`, `n` represents the number of +arguments preceding the body. When a rule is defined as `:inner n`, each form +within the expression's body, nested `n` levels deep, is indented by two +spaces. These rule definitions fully reflect the [cljfmt rules](https://github.com/weavejester/cljfmt/blob/0.13.0/docs/INDENTS.md). + +For example: + +- `do` has a rule `((:block 0))`. +- `when` has a rule `((:block 1))`. +- `defn` and `fn` have a rule `((:inner 0))`. +- `letfn` has a rule `((:block 1) (:inner 2 0))`. + +Note that `clojure-ts-semantic-indent-rules` should be set using the +customization interface or `setopt`; otherwise, it will not be applied +correctly. + +#### Project-specific indentation + +Custom indentation rules can be set for individual projects. To achieve this, +you need to create a `.dir-locals.el` file in the project root. The content +should look like: ```emacs-lisp -(setq treesit-extra-load-path '( "~/path/to/tree-sitter-clojure/dist")) +((clojure-ts-mode . ((clojure-ts-semantic-indent-rules . (("with-transaction" . ((:block 1))) + ("with-retry" . ((:block 1)))))))) +``` + +In order to apply directory-local variables to existing buffers, they must be +"reverted" (reloaded). + +### Vertical alignment + +You can vertically align sexps with `C-c SPC`. For instance, typing this combo +on the following form: + +```clojure +(def my-map + {:a-key 1 + :other-key 2}) +``` + +Leads to the following: + +```clojure +(def my-map + {:a-key 1 + :other-key 2}) +``` + +This can also be done automatically (as part of indentation) by turning on +`clojure-ts-align-forms-automatically`. This way it will happen whenever you +select some code and hit `TAB`. + +Forms that can be aligned vertically are configured via the following variables: + +- `clojure-ts-align-reader-conditionals` - align reader conditionals as if they + were maps. +- `clojure-ts-align-binding-forms` - a customizable list of forms with let-like + bindings that can be aligned vertically. +- `clojure-ts-align-cond-forms` - a customizable list of forms whose body + elements can be aligned vertically. These forms respect the block semantic + indentation rule (if configured) and align only the body forms, skipping N + special arguments. +- `clojure-ts-align-separator` - determines whether blank lines prevent vertical + alignment. + +### Font Locking + +To highlight entire rich `comment` expression with the comment font face, set + +``` emacs-lisp +(setopt clojure-ts-comment-macro-font-lock-body t) +``` + +By default this is `nil`, so that anything within a `comment` expression is +highlighted like regular Clojure code. + +> [!TIP] +> +> You can customize the exact level of font-locking via the variables +> `treesit-font-lock-level` (the default value is 3) and +> `treesit-font-lock-features-list`. Check [this +> section](https://www.gnu.org/software/emacs/manual/html_node/emacs/Parser_002dbased-Font-Lock.html) +> of the Emacs manual for more details. + +#### Extending font-lock rules + +In `clojure-ts-mode` it is possible to specify additional defn-like forms that +should be fontified. For example to highlight the following form from Hiccup +library as a function definition: + +```clojure +(defelem file-upload + "Creates a file upload input." + [name] + (input-field "file" name nil)) +``` + +You can add `defelem` to `clojure-ts-extra-def-forms` list like this: + +```emacs-lisp +(add-to-list 'clojure-ts-extra-def-forms "defelem") +``` + +or set this variable using `setopt`: + +```emacs-lisp +(setopt clojure-ts-extra-def-forms '("defelem")) +``` + +This setting will highlight `defelem` symbol, function name and the docstring. + +> [!IMPORTANT] +> +> Setting `clojure-ts-extra-def-forms` won't change the indentation rule for +> these forms. For indentation rules you should use +> `clojure-ts-semantic-indent-rules` variable (see [semantic +> indentation](#customizing-semantic-indentation) section). + +### Highlight markdown syntax in docstrings + +By default Markdown syntax is highlighted in the docstrings using +`markdown-inline` grammar. To disable this feature use: + +``` emacs-lisp +(setopt clojure-ts-use-markdown-inline nil) +``` + +Example of Markdown syntax highlighting: + + + +### Highlight regular expression syntax + +By default syntax inside regex literals is highlighted using +[regex](https://github.com/tree-sitter/tree-sitter-regex) grammar. To disable +this feature use: + +```emacs-lisp +(setopt clojure-ts-use-regex-parser nil) +``` + +Example of regex syntax highlighting: + + + +### Navigation and Evaluation + +To make forms inside of `(comment ...)` forms appear as top-level forms for evaluation and navigation, set + +``` emacs-lisp +(setopt clojure-ts-toplevel-inside-comment-form t) +``` + +### Fill paragraph + +To change the maximal line length used by `M-x prog-fill-reindent-defun` (also +bound to `M-q` by default) to reformat docstrings and comments it's possible to +customize `clojure-ts-fill-paragraph` variable (by default set to the value of +Emacs' `fill-paragraph` value). + +Every new line in the docstrings is indented by +`clojure-ts-docstring-fill-prefix-width` number of spaces (set to 2 by default +which matches the `clojure-mode` settings). + +### imenu + +`clojure-ts-mode` supports various types of definition that can be navigated +using `imenu`, such as: + +- namespace +- function +- macro +- var +- interface (forms such as `defprotocol`, `definterface` and `defmulti`) +- class (forms such as `deftype`, `defrecord` and `defstruct`) +- keyword (for example, spec definitions) + +### Integration with `outline-minor-mode` + +`clojure-ts-mode` supports two integration variants with +`outline-minor-mode`. The default variant uses special top-level comments (level +1 heading starts with three semicolons, level 2 heading starts with four, +etc.). The other variant treats def-like forms (the same forms produced by the +`imenu` command) as outline headings. To use the second option, use the +following customization: + +```emacs-lisp +(setopt clojure-ts-outline-variant 'imenu) +``` + +## Refactoring support + +### Threading macros related features + +There are a bunch of commands for threading and unwinding threaded Clojure forms: + +- `clojure-ts-thread`: Thread another form into the surrounding thread. Both +`->>`/`some->>` and `->`/`some->` variants are supported. +- `clojure-ts-unwind`: Unwind a threaded expression. Supports both `->>`/`some->>` +and `->`/`some->`. +- `clojure-ts-thread-first-all`: Introduce the thread first macro (`->`) and +rewrite the entire form. With a prefix argument do not thread the last form. +- `clojure-ts-thread-last-all`: Introduce the thread last macro and rewrite the +entire form. With a prefix argument do not thread the last form. +- `clojure-ts-unwind-all`: Fully unwind a threaded expression removing the +threading macro. + +#### Customize threading refactoring behavior + +By default `clojure-ts-thread-first-all` and `clojure-ts-thread-last-all` will +thread all nested expressions. For example this expression: + +```clojure +(->map (assoc {} :key "value") :lock) +``` + +After executing `clojure-ts-thread-last-all` will be converted to: + +```clojure +(-> {} + (assoc :key "value") + (->map :lock)) +``` + +This behavior can be changed by setting: + +```emacs-lisp +(setopt clojure-ts-thread-all-but-last t) +``` + +Then the last expression will not be threaded and the result will be: + +```clojure +(-> (assoc {} :key "value") + (->map :lock)) +``` + +### Cycling things + +- `clojure-ts-cycle-keyword-string`: Convert the string at point to a keyword and +vice versa. +- `clojure-ts-cycle-privacy`: Cycle privacy of `def`s or `defn`s. Use metadata +explicitly with setting `clojure-ts-use-metadata-for-defn-privacy` to `t` for +`defn`s too. +- `clojure-ts-cycle-conditional`: Change a surrounding conditional form to its + negated counterpart, or vice versa (supports `if`/`if-not` and + `when`/`when-not`). For `if`/`if-not` also transposes the else and then + branches, keeping the semantics the same as before. +- `clojure-ts-cycle-not`: Add or remove a `not` form around the current form. + +### Convert collection + +Convert any given collection at point to list, quoted list, map, vector or +set. The following commands are available: + +- `clojure-ts-convert-collection-to-list` +- `clojure-ts-convert-collection-to-quoted-list` +- `clojure-ts-convert-collection-to-map` +- `clojure-ts-convert-collection-to-vector` +- `clojure-ts-convert-collection-to-set` + +### Add arity to a function or macro + +`clojure-ts-add-arity`: Add a new arity to an existing single-arity or +multi-arity function or macro. Function can be defined using `defn`, `fn` or +`defmethod` form. This command also supports functions defined inside forms like +`letfn`, `defprotol`, `reify`, `extend-protocol` or `proxy`. + +### Default keybindings + +| Keybinding | Command | +|:----------------------------|:-----------------------------------------------| +| `C-:` | `clojure-ts-cycle-keyword-string` | +| `C-c SPC` | `clojure-ts-align` | +| `C-c C-r t` / `C-c C-r C-t` | `clojure-ts-thread` | +| `C-c C-r u` / `C-c C-r C-u` | `clojure-ts-unwind` | +| `C-c C-r f` / `C-c C-r C-f` | `clojure-ts-thread-first-all` | +| `C-c C-r l` / `C-c C-r C-l` | `clojure-ts-thread-last-all` | +| `C-c C-r p` / `C-c C-r C-p` | `clojure-ts-cycle-privacy` | +| `C-c C-r (` / `C-c C-r C-(` | `clojure-ts-convert-collection-to-list` | +| `C-c C-r '` / `C-c C-r C-'` | `clojure-ts-convert-collection-to-quoted-list` | +| `C-c C-r {` / `C-c C-r C-{` | `clojure-ts-convert-collection-to-map` | +| `C-c C-r [` / `C-c C-r C-[` | `clojure-ts-convert-collection-to-vector` | +| `C-c C-r #` / `C-c C-r C-#` | `clojure-ts-convert-collection-to-set` | +| `C-c C-r c` / `C-c C-r C-c` | `clojure-ts-cycle-conditional` | +| `C-c C-r o` / `C-c C-r C-o` | `clojure-ts-cycle-not` | +| `C-c C-r a` / `C-c C-r C-a` | `clojure-ts-add-arity` | + +### Customize refactoring commands prefix + +By default prefix for all refactoring commands is `C-c C-r`. It can be changed +by customizing `clojure-ts-refactor-map-prefix` variable. + +## Code completion + +`clojure-ts-mode` provides basic code completion functionality. Completion only +works for the current source buffer and includes completion of top-level +definitions and local bindings. This feature can be turned off by setting: + +```emacs-lisp +(setopt clojure-ts-completion-enabled nil) +``` + +Here's the short video illustrating the feature with Emacs's built-in completion UI (it +should also work well with more advanced packages like `company` and `corfu`): + +https://github.com/user-attachments/assets/7c37179f-5a5d-424f-9bd6-9c8525f6b2f7 + +## Migrating to clojure-ts-mode + +If you are migrating to `clojure-ts-mode` note that `clojure-mode` is still +required for CIDER and `clj-refactor` packages to work properly. + +After installing the package do the following: + +- Check the value of `clojure-mode-hook` and copy all relevant hooks to `clojure-ts-mode-hook`. + +``` emacs-lisp +(add-hook 'clojure-ts-mode-hook #'cider-mode) +(add-hook 'clojure-ts-mode-hook #'enable-paredit-mode) +(add-hook 'clojure-ts-mode-hook #'rainbow-delimiters-mode) +(add-hook 'clojure-ts-mode-hook #'clj-refactor-mode) +``` + +- Update `.dir-locals.el` in all of your Clojure projects to activate directory + local variables in `clojure-ts-mode`. + +``` emacs-lisp +((clojure-mode + (cider-clojure-cli-aliases . ":test:repl")) + (clojure-ts-mode + (cider-clojure-cli-aliases . ":test:repl"))) +``` + +## Caveats + +As the Tree-sitter Emacs APIs are new and keep evolving there are some +differences in the behavior of `clojure-ts-mode` on different Emacs versions. +Here are some notable examples: + +- On Emacs 29 the parent mode is `prog-mode`, but on Emacs 30+ it's both `prog-mode` +and `clojure-mode` (this is very helpful when dealing with `derived-mode-p` checks) +- Navigation by sexp/lists might work differently on Emacs versions lower + than 31. Starting with version 31, Emacs uses Tree-sitter 'things' settings, if + available, to rebind some commands. +- If you set `clojure-ts-extra-def-forms`, `clojure-ts-mode` will highlight the + specified forms, including their docstrings, in a manner similar to Clojure's + `defn`. However, Markdown syntax will not be highlighted within these custom + docstrings. + +## Frequently Asked Questions + +### What `clojure-mode` features are currently missing? + +As of version 0.5.x, `clojure-ts-mode` provides almost all `clojure-mode` features. +Currently only a few refactoring commands are missing. + +### Does `clojure-ts-mode` work with CIDER? + +Yes! Preliminary support for `clojure-ts-mode` was released in [CIDER +1.14](https://github.com/clojure-emacs/cider/releases/tag/v1.14.0). Note that +`clojure-mode` is still needed for some APIs that haven't yet been ported to +`clojure-ts-mode`. + +For now, when you take care of the keybindings for the CIDER commands you use +and ensure `cider-mode` is enabled for `clojure-ts-mode` buffers in your config, +most functionality should already work: + +```emacs-lisp +(add-hook 'clojure-ts-mode-hook #'cider-mode) +``` + +Check out [this article](https://metaredux.com/posts/2024/02/19/cider-preliminary-support-for-clojure-ts-mode.html) for more details. + +> [!NOTE] +> +> The dynamic indentation feature in CIDER requires clojure-ts-mode 0.3+. + +### Does `clojure-ts-mode` work with `inf-clojure`? + +Yes, it does. `inf-clojure` 3.3+ supports `clojure-ts-mode`. + +### Why does `clojure-ts-mode` require Emacs 30? + +You might be wondering why does `clojure-ts-mode` require Emacs 30 instead of +Emacs 29, which introduced the built-in Tree-sitter support. The answer is +simple - the initial Tree-sitter support in Emacs 29 had quite a few issues and +we felt it's better to nudge most people interested in using it to Emacs 30, +which fixed a lot of the problems. + +## Contributing + +We welcome contributions of any kind! + +If you're not familiar with Tree-sitter, a good place to start is our +[design documentation](doc/design.md), which explains how Tree-sitter +works in Emacs in broad strokes and covers some of the design +decisions we've made a long the way. + +We're using [Eldev](https://github.com/emacs-eldev/eldev) as our build tool, so you'll +have to install it. We also provide a simple [Makefile](Makefile) with targets invoking Eldev. You +only need to know a couple of them: + +```shell +make lint + +make test ``` -OR you can move the `libtree-sitter-clojure.so`/`libtree-sitter-clojure.dylib` to a directory named `tree-sitter` -under your `user-emacs-directory` (typically `~/.emacs.d` on Unix systems). +The process of releasing a new version of `clojure-ts-mode` is documented [here](doc/release-process). ## License -Copyright © 2022-2023 Danny Freeman and [contributors][]. +Copyright © 2022-2025 Danny Freeman, Bozhidar Batsov and [contributors][]. Distributed under the GNU General Public License; type C-h C-c to view it. diff --git a/clojure-mode-tests/clojure-mode-convert-collection-test.el b/clojure-mode-tests/clojure-mode-convert-collection-test.el new file mode 100644 index 0000000..14e5291 --- /dev/null +++ b/clojure-mode-tests/clojure-mode-convert-collection-test.el @@ -0,0 +1,82 @@ +;;; clojure-mode-convert-collection-test.el --- Clojure Mode: convert collection type -*- lexical-binding: t; -*- + +;; Copyright (C) 2016-2021 Benedek Fazekas + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; The convert collection code originally was implemented +;; as cycling collection type in clj-refactor.el and is the work +;; of the clj-reafctor.el team. + +;;; Code: + +(require 'clojure-mode) +(require 'buttercup) +(require 'test-helper "test/utils/test-helper") + +(describe "clojure-convert-collection-to-map" + (when-refactoring-it "should convert a list to a map" + "(:a 1 :b 2)" + "{:a 1 :b 2}" + (backward-sexp) + (down-list) + (clojure-convert-collection-to-map))) + +(describe "clojure-convert-collection-to-vector" + (when-refactoring-it "should convert a map to a vector" + "{:a 1 :b 2}" + "[:a 1 :b 2]" + (backward-sexp) + (down-list) + (clojure-convert-collection-to-vector))) + +(describe "clojure-convert-collection-to-set" + (when-refactoring-it "should convert a vector to a set" + "[1 2 3]" + "#{1 2 3}" + (backward-sexp) + (down-list) + (clojure-convert-collection-to-set))) + +(describe "clojure-convert-collection-to-list" + (when-refactoring-it "should convert a set to a list" + "#{1 2 3}" + "(1 2 3)" + (backward-sexp) + (down-list) + (clojure-convert-collection-to-list))) + +(describe "clojure-convert-collection-to-quoted-list" + (when-refactoring-it "should convert a set to a quoted list" + "#{1 2 3}" + "'(1 2 3)" + (backward-sexp) + (down-list) + (clojure-convert-collection-to-quoted-list))) + +(describe "clojure-convert-collection-to-set" + (when-refactoring-it "should convert a quoted list to a set" + "'(1 2 3)" + "#{1 2 3}" + (backward-sexp) + (down-list) + (clojure-convert-collection-to-set))) + +(provide 'clojure-mode-convert-collection-test) + +;;; clojure-mode-convert-collection-test.el ends here diff --git a/clojure-mode-tests/clojure-mode-cycling-test.el b/clojure-mode-tests/clojure-mode-cycling-test.el new file mode 100644 index 0000000..e1dcc46 --- /dev/null +++ b/clojure-mode-tests/clojure-mode-cycling-test.el @@ -0,0 +1,194 @@ +;;; clojure-mode-cycling-test.el --- Clojure Mode: cycling things tests -*- lexical-binding: t; -*- + +;; Copyright (C) 2016-2021 Benedek Fazekas + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; The cycling privacy and if/if-not code is ported from +;; clj-refactor.el and the work of the clj-reafctor.el team. + +;;; Code: + +(require 'clojure-mode) +(require 'buttercup) + +(describe "clojure-cycle-privacy" + + (when-refactoring-it "should turn a public defn into a private defn" + "(defn add [a b] + (+ a b))" + + "(defn- add [a b] + (+ a b))" + + (clojure-cycle-privacy)) + + (when-refactoring-it "should also work from the beginning of a sexp" + "(defn- add [a b] + (+ a b))" + + "(defn add [a b] + (+ a b))" + + (backward-sexp) + (clojure-cycle-privacy)) + + (when-refactoring-it "should use metadata when clojure-use-metadata-for-privacy is set to true" + "(defn add [a b] + (+ a b))" + + "(defn ^:private add [a b] + (+ a b))" + + (let ((clojure-use-metadata-for-privacy t)) + (clojure-cycle-privacy))) + + (when-refactoring-it "should turn a private defn into a public defn" + "(defn- add [a b] + (+ a b))" + + "(defn add [a b] + (+ a b))" + + (clojure-cycle-privacy)) + + (when-refactoring-it "should turn a private defn with metadata into a public defn" + "(defn ^:private add [a b] + (+ a b))" + + "(defn add [a b] + (+ a b))" + + (let ((clojure-use-metadata-for-privacy t)) + (clojure-cycle-privacy))) + + (when-refactoring-it "should also work with pre-existing metadata" + "(def ^:dynamic config + \"docs\" + {:env \"staging\"})" + + "(def ^:private ^:dynamic config + \"docs\" + {:env \"staging\"})" + + (clojure-cycle-privacy)) + + (when-refactoring-it "should turn a private def with metadata into a public def" + "(def ^:private config + \"docs\" + {:env \"staging\"})" + + "(def config + \"docs\" + {:env \"staging\"})" + + (clojure-cycle-privacy))) + +(describe "clojure-cycle-if" + + (when-refactoring-it "should cycle inner if" + "(if this + (if that + (then AAA) + (else BBB)) + (otherwise CCC))" + + "(if this + (if-not that + (else BBB) + (then AAA)) + (otherwise CCC))" + + (beginning-of-buffer) + (search-forward "BBB)") + (clojure-cycle-if)) + + (when-refactoring-it "should cycle outer if" + "(if-not this + (if that + (then AAA) + (else BBB)) + (otherwise CCC))" + + "(if this + (otherwise CCC) + (if that + (then AAA) + (else BBB)))" + + (beginning-of-buffer) + (search-forward "BBB))") + (clojure-cycle-if))) + +(describe "clojure-cycle-when" + + (when-refactoring-it "should cycle inner when" + "(when this + (when that + (aaa) + (bbb)) + (ccc))" + + "(when this + (when-not that + (aaa) + (bbb)) + (ccc))" + + (beginning-of-buffer) + (search-forward "bbb)") + (clojure-cycle-when)) + + (when-refactoring-it "should cycle outer when" + "(when-not this + (when that + (aaa) + (bbb)) + (ccc))" + + "(when this + (when that + (aaa) + (bbb)) + (ccc))" + + (beginning-of-buffer) + (search-forward "bbb))") + (clojure-cycle-when))) + +(describe "clojure-cycle-not" + + (when-refactoring-it "should add a not when missing" + "(ala bala portokala)" + "(not (ala bala portokala))" + + (beginning-of-buffer) + (search-forward "bala") + (clojure-cycle-not)) + + (when-refactoring-it "should remove a not when present" + "(not (ala bala portokala))" + "(ala bala portokala)" + + (beginning-of-buffer) + (search-forward "bala") + (clojure-cycle-not))) + +(provide 'clojure-mode-cycling-test) + +;;; clojure-mode-cycling-test.el ends here diff --git a/clojure-mode-tests/clojure-mode-external-interaction-test.el b/clojure-mode-tests/clojure-mode-external-interaction-test.el new file mode 100644 index 0000000..e394f9d --- /dev/null +++ b/clojure-mode-tests/clojure-mode-external-interaction-test.el @@ -0,0 +1,135 @@ +;;; clojure-mode-external-interaction-test.el --- Clojure Mode interactions with external packages test suite -*- lexical-binding: t; -*- + +;; Copyright (C) 2014-2021 Bozhidar Batsov + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Code: + +(require 'clojure-mode) +(require 'buttercup) +(require 'paredit) +(require 'test-helper "test/utils/test-helper") + +(describe "Interactions with Paredit:" + ;; reuse existing when-refactoring-it macro + (describe "it should insert a space" + (when-refactoring-it "before lists" + "foo" + "foo ()" + (paredit-mode) + (paredit-open-round)) + (when-refactoring-it "before vectors" + "foo" + "foo []" + (paredit-mode) + (paredit-open-square)) + (when-refactoring-it "before maps" + "foo" + "foo {}" + (paredit-mode) + (paredit-open-curly)) + (when-refactoring-it "before strings" + "foo" + "foo \"\"" + (paredit-mode) + (paredit-doublequote)) + (when-refactoring-it "after gensym" + "foo#" + "foo# ()" + (paredit-mode) + (paredit-open-round)) + (when-refactoring-it "after symbols ending with '" + "foo'" + "foo' ()" + (paredit-mode) + (paredit-open-round))) + (describe "it should not insert a space" + (when-refactoring-it "for anonymous fn syntax" + "foo #" + "foo #()" + (paredit-mode) + (paredit-open-round)) + (when-refactoring-it "for hash sets" + "foo #" + "foo #{}" + (paredit-mode) + (paredit-open-curly)) + (when-refactoring-it "for regexes" + "foo #" + "foo #\"\"" + (paredit-mode) + (paredit-doublequote)) + (when-refactoring-it "for quoted collections" + "foo '" + "foo '()" + (paredit-mode) + (paredit-open-round)) + (when-refactoring-it "for reader conditionals" + "foo #?" + "foo #?()" + (paredit-mode) + (paredit-open-round))) + (describe "reader tags" + (when-refactoring-it "should insert a space before strings" + "#uuid" + "#uuid \"\"" + (paredit-mode) + (paredit-doublequote)) + (when-refactoring-it "should not insert a space before namespaced maps" + "#::my-ns" + "#::my-ns{}" + (paredit-mode) + (paredit-open-curly)) + (when-refactoring-it "should not insert a space before namespaced maps 2" + "#::" + "#::{}" + (paredit-mode) + (paredit-open-curly)) + (when-refactoring-it "should not insert a space before namespaced maps 3" + "#:fully.qualified.ns123.-$#.%*+!" + "#:fully.qualified.ns123.-$#.%*+!{}" + (paredit-mode) + (paredit-open-curly)) + (when-refactoring-it "should not insert a space before tagged vectors" + "#tag123.-$#.%*+!" + "#tag123.-$#.%*+![]" + (paredit-mode) + (paredit-open-square)))) + + +(describe "Interactions with delete-trailing-whitespace" + (when-refactoring-it "should not delete trailing commas" + "(def foo + \\\"foo\\\": 1, + \\\"bar\\\": 2} + +(-> m + (assoc ,,, + :foo 123))" + "(def foo + \\\"foo\\\": 1, + \\\"bar\\\": 2} + +(-> m + (assoc ,,, + :foo 123))" + (delete-trailing-whitespace))) + +(provide 'clojure-mode-external-interaction-test) + + +;;; clojure-mode-external-interaction-test.el ends here diff --git a/clojure-mode-tests/clojure-mode-font-lock-test.el b/clojure-mode-tests/clojure-mode-font-lock-test.el new file mode 100644 index 0000000..3477190 --- /dev/null +++ b/clojure-mode-tests/clojure-mode-font-lock-test.el @@ -0,0 +1,1048 @@ +;;; clojure-mode-font-lock-test.el --- Clojure Mode: Font lock test suite -*- lexical-binding: t; -*- + +;; Copyright (C) 2014-2021 Bozhidar Batsov + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; The unit test suite of Clojure Mode + +;;; Code: + +(require 'clojure-mode) +(require 'cl-lib) +(require 'buttercup) +(require 'test-helper "test/utils/test-helper") + + +;;;; Utilities + +(defmacro with-fontified-clojure-buffer (content &rest body) + "Evaluate BODY in a temporary buffer with CONTENT." + (declare (debug t) + (indent 1)) + `(with-clojure-buffer ,content + (font-lock-ensure) + (goto-char (point-min)) + ,@body)) + +(defun clojure-get-face-at (start end content) + "Get the face between START and END in CONTENT." + (with-fontified-clojure-buffer content + (let ((start-face (get-text-property start 'face)) + (all-faces (cl-loop for i from start to end collect (get-text-property + i 'face)))) + (if (cl-every (lambda (face) (eq face start-face)) all-faces) + start-face + 'various-faces)))) + +(defun expect-face-at (content start end face) + "Expect face in CONTENT between START and END to be equal to FACE." + (expect (clojure-get-face-at start end content) :to-equal face)) + +(defun expect-faces-at (content &rest faces) + "Expect FACES in CONTENT. + +FACES is a list of the form (content (start end expected-face)*)" + (dolist (face faces) + (apply (apply-partially #'expect-face-at content) face))) + +(defconst clojure-test-syntax-classes + [whitespace punctuation word symbol open-paren close-paren expression-prefix + string-quote paired-delim escape character-quote comment-start + comment-end inherit generic-comment generic-string] + "Readable symbols for syntax classes. + +Each symbol in this vector corresponding to the syntax code of +its index.") + +(defmacro when-fontifying-it (description &rest tests) + "Return a buttercup spec. + +TESTS are lists of the form (content (start end expected-face)*). For each test +check that each `expected-face` is found in `content` between `start` and `end`. + +DESCRIPTION is the description of the spec." + (declare (indent 1)) + `(it ,description + (dolist (test (quote ,tests)) + (apply #'expect-faces-at test)))) + +;;;; Font locking + +(describe "clojure-mode-syntax-table" + + (when-fontifying-it "should handle stuff in backticks" + ("\"`#'s/trim`\"" + (1 2 font-lock-string-face) + (3 10 (font-lock-constant-face font-lock-string-face)) + (11 12 font-lock-string-face)) + + (";`#'s/trim`" + (1 1 font-lock-comment-delimiter-face) + (2 2 font-lock-comment-face) + (3 10 (font-lock-constant-face font-lock-comment-face)) + (11 11 font-lock-comment-face))) + + (when-fontifying-it "should handle stuff in strings" + ("\"a\\bc\\n\"" + (1 2 font-lock-string-face) + (3 4 (bold font-lock-string-face)) + (5 5 font-lock-string-face) + (6 7 (bold font-lock-string-face))) + + ("#\"a\\bc\\n\"" + (4 5 (bold font-lock-string-face)))) + + (when-fontifying-it "should handle stuff in double brackets" + ("\"[[#'s/trim]]\"" + (1 3 font-lock-string-face) + (4 11 (font-lock-constant-face font-lock-string-face)) + (12 14 font-lock-string-face)) + + (";[[#'s/trim]]" + (1 1 font-lock-comment-delimiter-face) + (2 3 font-lock-comment-face) + (4 11 (font-lock-constant-face font-lock-comment-face)) + (12 13 font-lock-comment-face))) + + (when-fontifying-it "should fontify let, when, and while type forms" + ("(when-alist [x 1]\n ())" + (2 11 font-lock-keyword-face)) + + ("(while-alist [x 1]\n ())" + (2 12 font-lock-keyword-face)) + + ("(let-alist [x 1]\n ())" + (2 10 font-lock-keyword-face))) + + (when-fontifying-it "should handle comment macros" + ("#_" + (1 2 nil)) + + ("#_#_" + (1 2 nil)) + + ("#_#_" + (3 2 font-lock-comment-face)) + + ("#_ #_" + (1 3 nil)) + + ("#_ #_" + (4 2 font-lock-comment-face)) + + ("#_ \n;; some crap\n (lala 0101\n lao\n\n 0 0i)" + (1 2 nil)) + + ("#_ \n;; some crap\n (lala 0101\n lao\n\n 0 0i)" + (5 41 font-lock-comment-face)) + + ("#_#_ \n;; some crap\n (lala 0101\n lao\n\n 0 0i)\n;; more crap\n (foobar tnseriao)" + (1 4 nil)) + + ("#_ #_ \n;; some crap\n (lala 0101\n lao\n\n 0 0i)\n;; more crap\n (foobar tnseriao)" + (1 5 nil)) + + ("#_#_ \n;; some crap\n (lala 0101\n lao\n\n 0 0i)\n;; more crap\n (foobar tnseriao)" + (7 75 font-lock-comment-face)) + + ("#_ #_ \n;; some crap\n (lala 0101\n lao\n\n 0 0i)\n;; more crap\n (foobar tnseriao)" + (8 75 font-lock-comment-face))) + + (when-fontifying-it "should handle namespace declarations" + ("(ns .validns)" + (5 12 font-lock-type-face)) + + ("(ns =validns)" + (5 12 font-lock-type-face)) + + ("(ns .ValidNs=<>?+|?*.)" + (5 21 font-lock-type-face)) + + ("(ns ValidNs<>?+|?*.b*ar.ba*z)" + (5 28 font-lock-type-face)) + + ("(ns other.valid.ns)" + (5 18 font-lock-type-face)) + + ("(ns oneword)" + (5 11 font-lock-type-face)) + + ("(ns foo.bar)" + (5 11 font-lock-type-face)) + + ("(ns Foo.bar)" + (5 11 font-lock-type-face) + (5 11 font-lock-type-face) + (5 11 font-lock-type-face)) + + ("(ns Foo-bar)" + (5 11 font-lock-type-face) + (5 11 font-lock-type-face)) + + ("(ns foo-Bar)" + (5 11 font-lock-type-face)) + + ("(ns one.X)" + (5 9 font-lock-type-face)) + + ("(ns ^:md ns-name)" + (10 16 font-lock-type-face)) + + ("(ns ^:md \n ns-name)" + (13 19 font-lock-type-face)) + + ("(ns ^:md1 ^:md2 ns-name)" + (17 23 font-lock-type-face)) + + ("(ns ^:md1 ^{:md2 true} ns-name)" + (24 30 font-lock-type-face)) + + ("(ns ^{:md2 true} ^:md1 ns-name)" + (24 30 font-lock-type-face)) + + ("(ns ^:md1 ^{:md2 true} \n ns-name)" + (27 33 font-lock-type-face)) + + ("(ns ^{:md2 true} ^:md1 \n ns-name)" + (27 33 font-lock-type-face))) + + (when-fontifying-it "should handle one word" + (" oneword" + (2 8 nil)) + + ("@oneword" + (2 8 nil)) + + ("#oneword" + (2 8 nil)) + + (".oneword" + (2 8 nil)) + + ("#^oneword" + (3 9 font-lock-type-face)) ;; type-hint + + ("(oneword)" + (2 8 nil)) + + ("(oneword/oneword)" + (2 8 font-lock-type-face) + (9 10 nil) + (11 16 nil)) + + ("(oneword/seg.mnt)" + (2 8 font-lock-type-face) + (9 10 nil) + (11 16 nil)) + + ("(oneword/mxdCase)" + (2 8 font-lock-type-face) + (9 10 nil) + (11 16 nil)) + + ("(oneword/CmlCase)" + (2 8 font-lock-type-face) + (9 10 nil) + (11 16 nil)) + + ("(colons:are:okay)" + (2 16 nil)) + + ("(some-ns/colons:are:okay)" + (2 8 font-lock-type-face) + (9 24 nil)) + + ("(oneword/ve/yCom|pLex.stu-ff)" + (2 8 font-lock-type-face) + (9 10 nil) + (11 28 nil)) + + ("(oneword/.ve/yCom|pLex.stu-ff)" + (2 8 font-lock-type-face) + (9 10 nil) + (12 29 nil))) + + (when-fontifying-it "should handle a segment" + (" seg.mnt" + (2 8 nil)) + + ("@seg.mnt" + (2 8 nil)) + + ("#seg.mnt" + (2 8 nil)) + + (".seg.mnt" + (2 8 nil)) + + ("#^seg.mnt" + (3 9 font-lock-type-face)) ;; type-hint + + ("(seg.mnt)" + (2 8 nil)) + + ("(seg.mnt/oneword)" + (2 8 font-lock-type-face) + (9 10 nil) + (11 16 nil)) + + ("(seg.mnt/seg.mnt)" + (2 8 font-lock-type-face) + (9 10 nil) + (11 16 nil)) + + ("(seg.mnt/mxdCase)" + (2 8 font-lock-type-face) + (9 10 nil) + (11 16 nil)) + + ("(seg.mnt/CmlCase)" + (2 8 font-lock-type-face) + (9 10 nil) + (11 16 nil)) + + ("(seg.mnt/ve/yCom|pLex.stu-ff)" + (2 8 font-lock-type-face) + (9 10 nil) + (11 28 nil)) + + ("(seg.mnt/.ve/yCom|pLex.stu-ff)" + (2 8 font-lock-type-face) + (9 10 nil) + (12 29 nil))) + + (when-fontifying-it "should handle camelcase" + (" CmlCase" + (2 8 nil)) + + ("@CmlCase" + (2 8 nil)) + + ("#CmlCase" + (2 8 nil)) + + (".CmlCase" + (2 8 nil)) + + ("#^CmlCase" + (3 9 font-lock-type-face)) ;; type-hint + + ("(CmlCase)" + (2 8 nil)) + + ("(CmlCase/oneword)" + (2 8 font-lock-type-face) + (9 10 nil) + (11 16 nil)) + + ("(CmlCase/seg.mnt)" + (2 8 font-lock-type-face) + (9 10 nil) + (11 16 nil)) + + ("(CmlCase/mxdCase)" + (2 8 font-lock-type-face) + (9 10 nil) + (11 16 nil)) + + ("(CmlCase/CmlCase)" + (2 8 font-lock-type-face) + (9 10 nil) + (11 16 nil)) + + ("(CmlCase/ve/yCom|pLex.stu-ff)" + (2 8 font-lock-type-face) + (9 10 nil) + (11 28 nil)) + + ("(CmlCase/.ve/yCom|pLex.stu-ff)" + (2 8 font-lock-type-face) + (9 10 nil) + (12 29 nil))) + + (when-fontifying-it "should handle mixed case" + (" mxdCase" + (2 8 nil)) + + ("@mxdCase" + (2 8 nil)) + + ("#mxdCase" + (2 8 nil)) + + (".mxdCase" + (2 8 nil)) + + ("#^mxdCase" + (3 9 font-lock-type-face)) ;; type-hint + + ("(mxdCase)" + (2 8 nil)) + + ("(mxdCase/oneword)" + (2 8 font-lock-type-face) + (9 10 nil) + (11 16 nil)) + + ("(mxdCase/seg.mnt)" + (2 8 font-lock-type-face) + (9 10 nil) + (11 16 nil)) + + ("(mxdCase/mxdCase)" + (2 8 font-lock-type-face) + (9 10 nil) + (11 16 nil)) + + ("(mxdCase/CmlCase)" + (2 8 font-lock-type-face) + (9 10 nil) + (11 16 nil)) + + ("(mxdCase/ve/yCom|pLex.stu-ff)" + (2 8 font-lock-type-face) + (9 10 nil) + (11 28 nil)) + + ("(mxdCase/.ve/yCom|pLex.stu-ff)" + (2 8 font-lock-type-face) + (9 10 nil) + (12 29 nil))) + + (when-fontifying-it "should handle quotes in tail of symbols and keywords" + ("'quot'ed'/sy'm'bol''" + (2 9 font-lock-type-face) + (10 20 nil)) + + (":qu'ote'd''/key'word'" + (2 11 font-lock-type-face) + (12 12 default) + (13 21 clojure-keyword-face))) + + (when-fontifying-it "should handle very complex stuff" + (" ve/yCom|pLex.stu-ff" + (3 4 font-lock-type-face) + (5 21 nil)) + + (" @ve/yCom|pLex.stu-ff" + (2 2 nil) + (3 4 font-lock-type-face) + (5 21 nil)) + + (" #ve/yCom|pLex.stu-ff" + (2 4 font-lock-type-face) + (5 21 nil)) + + (" .ve/yCom|pLex.stu-ff" + (2 4 font-lock-type-face) + (5 21 nil)) + + ;; type-hint + ("#^ve/yCom|pLex.stu-ff" + (1 2 default) + (3 4 font-lock-type-face) + (5 21 default)) + + ("^ve/yCom|pLex.stu-ff" + (2 3 font-lock-type-face) + (5 20 default)) + + (" (ve/yCom|pLex.stu-ff)" + (3 4 font-lock-type-face) + (5 21 nil)) + + (" (ve/yCom|pLex.stu-ff/oneword)" + (3 4 font-lock-type-face) + (5 29 nil)) + + (" (ve/yCom|pLex.stu-ff/seg.mnt)" + (3 4 font-lock-type-face) + (5 29 nil)) + + (" (ve/yCom|pLex.stu-ff/mxdCase)" + (3 4 font-lock-type-face) + (5 29 nil)) + + (" (ve/yCom|pLex.stu-ff/CmlCase)" + (3 4 font-lock-type-face) + (5 29 nil)) + + (" (ve/yCom|pLex.stu-ff/ve/yCom|pLex.stu-ff)" + (3 4 font-lock-type-face) + (5 41 nil)) + + (" (ve/yCom|pLex.stu-ff/.ve/yCom|pLex.stu-ff)" + (3 4 font-lock-type-face) + (5 42 nil))) + + (when-fontifying-it "should handle oneword keywords" + (" :oneword" + (3 9 clojure-keyword-face)) + + (" :1oneword" + (3 10 clojure-keyword-face)) + + ("{:oneword 0}" + (3 9 clojure-keyword-face)) + + ("{:1oneword 0}" + (3 10 clojure-keyword-face)) + + ("{:#oneword 0}" + (3 10 clojure-keyword-face)) + + ("{:.oneword 0}" + (3 10 clojure-keyword-face)) + + ("{:oneword/oneword 0}" + (3 9 font-lock-type-face) + (10 10 default) + (11 17 clojure-keyword-face)) + + ("{:oneword/seg.mnt 0}" + (3 9 font-lock-type-face) + (10 10 default) + (11 17 clojure-keyword-face)) + + ("{:oneword/CmlCase 0}" + (3 9 font-lock-type-face) + (10 10 default) + (11 17 clojure-keyword-face)) + + ("{:oneword/mxdCase 0}" + (3 9 font-lock-type-face) + (10 10 default) + (11 17 clojure-keyword-face)) + + ("{:oneword/ve/yCom|pLex.stu-ff 0}" + (3 9 font-lock-type-face) + (10 10 default) + (11 29 clojure-keyword-face)) + + ("{:oneword/.ve/yCom|pLex.stu-ff 0}" + (3 9 font-lock-type-face) + (10 10 default) + (11 30 clojure-keyword-face))) + + (when-fontifying-it "should handle namespaced keywords" + ("::foo" + (1 5 clojure-keyword-face)) + + (":_::_:foo" + (1 9 clojure-keyword-face)) + + (":_:_:foo" + (1 8 clojure-keyword-face)) + + (":foo/:bar" + (1 9 clojure-keyword-face)) + + ("::_:foo" + (1 7 clojure-keyword-face)) + + ("::_:_:foo" + (1 9 clojure-keyword-face)) + + (":_:_:foo/_" + (1 1 clojure-keyword-face) + (2 8 font-lock-type-face) + (9 9 default) + (10 10 clojure-keyword-face)) + + (":_:_:foo/bar" + (10 12 clojure-keyword-face)) + + (":_:_:foo/bar/eee" + (10 16 clojure-keyword-face)) + + (":_:_:foo/bar_:foo" + (10 17 clojure-keyword-face)) + + (":_:_:foo/bar_:_:foo" + (10 19 clojure-keyword-face)) + + (":1foo/bar" + (2 5 font-lock-type-face) + (6 6 default) + (7 9 clojure-keyword-face)) + + (":foo/1bar" + (2 4 font-lock-type-face) + (5 5 default) + (6 9 clojure-keyword-face)) + + (":1foo/1bar" + (2 5 font-lock-type-face) + (6 6 default) + (7 10 clojure-keyword-face))) + + (when-fontifying-it "should handle segment keywords" + (" :seg.mnt" + (3 9 clojure-keyword-face)) + + ("{:seg.mnt 0}" + (3 9 clojure-keyword-face)) + + ("{:#seg.mnt 0}" + (3 10 clojure-keyword-face)) + + ("{:.seg.mnt 0}" + (3 10 clojure-keyword-face)) + + ("{:seg.mnt/oneword 0}" + (3 9 font-lock-type-face) + (10 10 default) + (11 17 clojure-keyword-face)) + + ("{:seg.mnt/seg.mnt 0}" + (3 9 font-lock-type-face ) + (10 10 default) + (11 17 clojure-keyword-face)) + + ("{:seg.mnt/CmlCase 0}" + (3 9 font-lock-type-face) + (10 10 default) + (11 17 clojure-keyword-face)) + + ("{:seg.mnt/mxdCase 0}" + (3 9 font-lock-type-face) + (10 10 default) + (11 17 clojure-keyword-face)) + + ("{:seg.mnt/ve/yCom|pLex.stu-ff 0}" + (3 9 font-lock-type-face) + (10 10 default) + (11 29 clojure-keyword-face)) + + ("{:seg.mnt/.ve/yCom|pLex.stu-ff 0}" + (3 9 font-lock-type-face) + (10 10 default) + (11 30 clojure-keyword-face))) + + (when-fontifying-it "should handle camel case keywords" + (" :CmlCase" + (3 9 clojure-keyword-face)) + + ("{:CmlCase 0}" + (3 9 clojure-keyword-face)) + + ("{:#CmlCase 0}" + (3 10 clojure-keyword-face)) + + ("{:.CmlCase 0}" + (3 10 clojure-keyword-face)) + + ("{:CmlCase/oneword 0}" + (3 9 font-lock-type-face) + (10 10 default) + (11 17 clojure-keyword-face)) + + ("{:CmlCase/seg.mnt 0}" + (3 9 font-lock-type-face) + (10 10 default) + (11 17 clojure-keyword-face)) + + ("{:CmlCase/CmlCase 0}" + (3 9 font-lock-type-face) + (10 10 default) + (11 17 clojure-keyword-face)) + + ("{:CmlCase/mxdCase 0}" + (3 9 font-lock-type-face) + (10 10 default) + (11 17 clojure-keyword-face)) + + ("{:CmlCase/ve/yCom|pLex.stu-ff 0}" + (3 9 font-lock-type-face) + (10 10 default) + (11 29 clojure-keyword-face)) + + ("{:CmlCase/.ve/yCom|pLex.stu-ff 0}" + (3 9 font-lock-type-face) + (10 10 default) + (11 30 clojure-keyword-face))) + + (when-fontifying-it "should handle mixed case keywords" + (" :mxdCase" + (3 9 clojure-keyword-face)) + + ("{:mxdCase 0}" + (3 9 clojure-keyword-face)) + + ("{:#mxdCase 0}" + (3 10 clojure-keyword-face)) + + ("{:.mxdCase 0}" + (3 10 clojure-keyword-face)) + + ("{:mxdCase/oneword 0}" + (3 9 font-lock-type-face) + (10 10 default) + (11 17 clojure-keyword-face)) + + ("{:mxdCase/seg.mnt 0}" + (3 9 font-lock-type-face) + (10 10 default) + (11 17 clojure-keyword-face)) + + ("{:mxdCase/CmlCase 0}" + (3 9 font-lock-type-face) + (10 10 default) + (11 17 clojure-keyword-face)) + + ("{:mxdCase/mxdCase 0}" + (3 9 font-lock-type-face) + (10 10 default) + (11 17 clojure-keyword-face)) + + ("{:mxdCase/ve/yCom|pLex.stu-ff 0}" + (3 9 font-lock-type-face) + (10 10 default) + (11 29 clojure-keyword-face)) + + ("{:mxdCase/.ve/yCom|pLex.stu-ff 0}" + (3 9 font-lock-type-face) + (10 10 default) + (11 30 clojure-keyword-face))) + + (when-fontifying-it "should handle keywords with colons" + (":a:a" + (1 4 clojure-keyword-face)) + + (":a:a/:a" + (1 7 clojure-keyword-face)) + + ("::a:a" + (1 5 clojure-keyword-face)) + + ("::a.a:a" + (1 7 clojure-keyword-face))) + + (when-fontifying-it "should handle very complex keywords" + (" :ve/yCom|pLex.stu-ff" + (3 4 font-lock-type-face) + (5 5 default) + (6 21 clojure-keyword-face)) + + ("{:ve/yCom|pLex.stu-ff 0}" + (2 2 clojure-keyword-face) + (3 4 font-lock-type-face) + (5 5 default) + (6 21 clojure-keyword-face)) + + ("{:#ve/yCom|pLex.stu-ff 0}" + (2 2 clojure-keyword-face) + (3 5 font-lock-type-face) + (6 6 default) + (7 22 clojure-keyword-face)) + + ("{:.ve/yCom|pLex.stu-ff 0}" + (2 2 clojure-keyword-face) + (3 5 font-lock-type-face) + (6 6 default) + (7 22 clojure-keyword-face)) + + ("{:ve/yCom|pLex.stu-ff/oneword 0}" + (2 2 clojure-keyword-face) + (3 4 font-lock-type-face) + (5 5 default) + (6 29 clojure-keyword-face)) + + ("{:ve/yCom|pLex.stu-ff/seg.mnt 0}" + (2 2 clojure-keyword-face) + (3 4 font-lock-type-face) + (5 5 default) + (6 29 clojure-keyword-face)) + + ("{:ve/yCom|pLex.stu-ff/ClmCase 0}" + (2 2 clojure-keyword-face) + (3 4 font-lock-type-face) + (5 5 default) + (6 29 clojure-keyword-face)) + + ("{:ve/yCom|pLex.stu-ff/mxdCase 0}" + (2 2 clojure-keyword-face) + (3 4 font-lock-type-face) + (5 5 default) + (6 29 clojure-keyword-face)) + + ("{:ve/yCom|pLex.stu-ff/ve/yCom|pLex.stu-ff 0}" + (2 2 clojure-keyword-face) + (3 4 font-lock-type-face) + (5 5 default) + (6 41 clojure-keyword-face)) + + ("{:ve/yCom|pLex.stu-ff/.ve/yCom|pLex.stu-ff 0}" + (2 2 clojure-keyword-face) + (3 4 font-lock-type-face) + (5 5 default) + (6 42 clojure-keyword-face))) + + (when-fontifying-it "should handle namespaced defs" + ("(clojure.core/defn bar [] nil)" + (2 13 font-lock-type-face) + (14 14 nil) + (15 18 font-lock-keyword-face) + (20 22 font-lock-function-name-face)) + + ("(clojure.core/defrecord foo nil)" + (2 13 font-lock-type-face) + (14 14 nil) + (15 23 font-lock-keyword-face) + (25 27 font-lock-type-face)) + + ("(s/def ::keyword)" + (2 2 font-lock-type-face) + (3 3 nil) + (4 6 font-lock-keyword-face) + (8 16 clojure-keyword-face))) + + (when-fontifying-it "should handle any known def form" + ("(def a 1)" (2 4 font-lock-keyword-face)) + ("(defonce a 1)" (2 8 font-lock-keyword-face)) + ("(defn a [b])" (2 5 font-lock-keyword-face)) + ("(defmacro a [b])" (2 9 font-lock-keyword-face)) + ("(definline a [b])" (2 10 font-lock-keyword-face)) + ("(defmulti a identity)" (2 9 font-lock-keyword-face)) + ("(defmethod a :foo [b] (println \"bar\"))" (2 10 font-lock-keyword-face)) + ("(defprotocol a (b [this] \"that\"))" (2 12 font-lock-keyword-face)) + ("(definterface a (b [c]))" (2 13 font-lock-keyword-face)) + ("(defrecord a [b c])" (2 10 font-lock-keyword-face)) + ("(deftype a [b c])" (2 8 font-lock-keyword-face)) + ("(defstruct a :b :c)" (2 10 font-lock-keyword-face)) + ("(deftest a (is (= 1 1)))" (2 8 font-lock-keyword-face)) + ("(defne [x y])" (2 6 font-lock-keyword-face)) + ("(defnm a b)" (2 6 font-lock-keyword-face)) + ("(defnu)" (2 6 font-lock-keyword-face)) + ("(defnc [a])" (2 6 font-lock-keyword-face)) + ("(defna)" (2 6 font-lock-keyword-face)) + ("(deftask a)" (2 8 font-lock-keyword-face)) + ("(defstate a :start \"b\" :stop \"c\")" (2 9 font-lock-keyword-face))) + + (when-fontifying-it "should ignore unknown def forms" + ("(defbugproducer me)" (2 15 nil)) + ("(default-user-settings {:a 1})" (2 24 nil)) + ("(s/deftartar :foo)" (4 10 nil))) + + (when-fontifying-it "should handle variables defined with def" + ("(def foo 10)" + (2 4 font-lock-keyword-face) + (6 8 font-lock-variable-name-face)) + ("(def foo:bar 10)" + (2 4 font-lock-keyword-face) + (6 12 font-lock-variable-name-face))) + + (when-fontifying-it "should handle variables definitions of type string" + ("(def foo \"hello\")" + (10 16 font-lock-string-face)) + + ("(def foo \"hello\" )" + (10 16 font-lock-string-face)) + + ("(def foo \n \"hello\")" + (13 19 font-lock-string-face)) + + ("(def foo \n \"hello\"\n)" + (13 19 font-lock-string-face))) + + (when-fontifying-it "variable-def-string-with-docstring" + ("(def foo \"usage\" \"hello\")" + (10 16 font-lock-doc-face) + (18 24 font-lock-string-face)) + + ("(def foo \"usage\" \"hello\" )" + (18 24 font-lock-string-face)) + + ("(def foo \"usage\" \n \"hello\")" + (21 27 font-lock-string-face)) + + ("(def foo \n \"usage\" \"hello\")" + (13 19 font-lock-doc-face)) + + ("(def foo \n \"usage\" \n \"hello\")" + (13 19 font-lock-doc-face) + (24 30 font-lock-string-face)) + + ("(def test-string\n \"this\\n\n is\n my\n string\")" + (20 24 font-lock-string-face) + (25 26 (bold font-lock-string-face)) + (27 46 font-lock-string-face))) + + (when-fontifying-it "should handle deftype" + ("(deftype Foo)" + (2 8 font-lock-keyword-face) + (10 12 font-lock-type-face))) + + (when-fontifying-it "should handle defn" + ("(defn foo [x] x)" + (2 5 font-lock-keyword-face) + (7 9 font-lock-function-name-face))) + + (when-fontifying-it "should handle fn" + ;; try to byte-recompile the clojure-mode.el when the face of 'fn' is 't' + ("(fn foo [x] x)" + (2 3 font-lock-keyword-face) + ( 5 7 font-lock-function-name-face))) + + (when-fontifying-it "should handle lambda-params %, %1, %n..." + ("#(+ % %2 %3 %&)" + (5 5 font-lock-variable-name-face) + (7 8 font-lock-variable-name-face) + (10 11 font-lock-variable-name-face) + (13 14 font-lock-variable-name-face))) + + (when-fontifying-it "should handle multi-digit lambda-params" + ;; % args with >1 digit are rare and unidiomatic but legal up to + ;; `MAX_POSITIONAL_ARITY` in Clojure's compiler, which as of today is 20 + ("#(* %10 %15 %19 %20)" + ;; it would be better if this were just `font-lock-variable-name-face` but + ;; it seems to work as-is + (5 7 various-faces) + (9 11 font-lock-variable-name-face) + (13 15 font-lock-variable-name-face) + (17 19 various-faces))) + + (when-fontifying-it "should handle nils" + ("(= nil x)" + (4 6 font-lock-constant-face)) + + ("(fnil x)" + (3 5 nil))) + + (when-fontifying-it "should handle true" + ("(= true x)" + (4 7 font-lock-constant-face))) + + (when-fontifying-it "should handle false" + ("(= false x)" + (4 8 font-lock-constant-face))) + + (when-fontifying-it "should handle keyword-meta" + ("^:meta-data" + (1 1 nil) + (2 11 clojure-keyword-face))) + + (when-fontifying-it "should handle a keyword with allowed characters" + (":aaa#bbb" + (1 8 clojure-keyword-face))) + + (when-fontifying-it "should handle a keyword with disallowed characters" + (":aaa@bbb" + (1 5 various-faces)) + + (":aaa@bbb" + (1 4 clojure-keyword-face)) + + (":aaa~bbb" + (1 5 various-faces)) + + (":aaa~bbb" + (1 4 clojure-keyword-face)) + + (":aaa@bbb" + (1 5 various-faces)) + + (":aaa@bbb" + (1 4 clojure-keyword-face))) + + (when-fontifying-it "should handle characters" + ("\\a" + (1 2 clojure-character-face)) + + ("\\A" + (1 2 clojure-character-face)) + + ("\\newline" + (1 8 clojure-character-face)) + + ("\\abc" + (1 4 nil)) + + ("\\newlin" + (1 7 nil)) + + ("\\newlinex" + (1 9 nil)) + + ("\\1" + (1 2 clojure-character-face)) + + ("\\u0032" + (1 6 clojure-character-face)) + + ("\\o127" + (1 4 clojure-character-face)) + + ("\\+" + (1 2 clojure-character-face)) + + ("\\." + (1 2 clojure-character-face)) + + ("\\," + (1 2 clojure-character-face)) + + ("\\;" + (1 2 clojure-character-face)) + + ("\\Ω" + (1 2 clojure-character-face)) + + ("\\ク" + (1 2 clojure-character-face))) + + (when-fontifying-it "should handle characters not by themselves" + ("[\\,,]" + (1 1 nil) + (2 3 clojure-character-face) + (4 5 nil)) + + ("[\\[]" + (1 1 nil) + (2 3 clojure-character-face) + (4 4 nil))) + + (when-fontifying-it "should handle % character literal" + ("#(str \\% %)" + (7 8 clojure-character-face) + (10 10 font-lock-variable-name-face))) + + (when-fontifying-it "should handle referred vars" + ("foo/var" + (1 3 font-lock-type-face)) + + ("@foo/var" + (2 4 font-lock-type-face))) + + (when-fontifying-it "should handle dynamic vars" + ("*some-var*" + (1 10 font-lock-variable-name-face)) + + ("@*some-var*" + (2 11 font-lock-variable-name-face)) + + ("some.ns/*var*" + (9 13 font-lock-variable-name-face)) + + ("*some-var?*" + (1 11 font-lock-variable-name-face)))) + +(provide 'clojure-mode-font-lock-test) + +;;; clojure-mode-font-lock-test.el ends here diff --git a/clojure-mode-tests/clojure-mode-indentation-test.el b/clojure-mode-tests/clojure-mode-indentation-test.el new file mode 100644 index 0000000..1a03656 --- /dev/null +++ b/clojure-mode-tests/clojure-mode-indentation-test.el @@ -0,0 +1,839 @@ +;;; clojure-mode-indentation-test.el --- Clojure Mode: indentation tests -*- lexical-binding: t; -*- + +;; Copyright (C) 2015-2021 Bozhidar Batsov + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; The unit test suite of Clojure Mode + +;;; Code: + +(require 'clojure-mode) +(require 'cl-lib) +(require 'buttercup) +(require 's nil t) ;Don't burp if it's missing during compilation. +(require 'test-helper "test/utils/test-helper") + +(defmacro when-indenting-with-point-it (description before after) + "Return a buttercup spec. + +Check whether the swift indentation command will correctly change the buffer. +Will also check whether point is moved to the expected position. + +BEFORE is the buffer string before indenting, where a pipe (|) represents +point. + +AFTER is the expected buffer string after indenting, where a pipe (|) +represents the expected position of point. + +DESCRIPTION is a string with the description of the spec." + (declare (indent 1)) + `(it ,description + (let* ((after ,after) + (clojure-indent-style 'always-align) + (expected-cursor-pos (1+ (s-index-of "|" after))) + (expected-state (delete ?| after))) + (with-clojure-buffer ,before + (goto-char (point-min)) + (search-forward "|") + (delete-char -1) + (font-lock-ensure) + (indent-according-to-mode) + (expect (buffer-string) :to-equal expected-state) + (expect (point) :to-equal expected-cursor-pos))))) + +;; Backtracking indent +(defmacro when-indenting-it (description &optional style &rest forms) + "Return a buttercup spec. + +Check that all FORMS correspond to properly indented sexps. + +STYLE allows overriding the default clojure-indent-style 'always-align. + +DESCRIPTION is a string with the description of the spec." + (declare (indent 1)) + (when (stringp style) + (setq forms (cons style forms)) + (setq style '(quote always-align))) + `(it ,description + (progn + ,@(mapcar (lambda (form) + `(with-temp-buffer + (clojure-mode) + (insert "\n" ,form);,(replace-regexp-in-string "\n +" "\n " form)) + (let ((clojure-indent-style ,style)) + (indent-region (point-min) (point-max))) + (expect (buffer-string) :to-equal ,(concat "\n" form)))) + forms)))) + +(defmacro when-aligning-it (description &rest forms) + "Return a buttercup spec. + +Check that all FORMS correspond to properly indented sexps. + +DESCRIPTION is a string with the description of the spec." + (declare (indent defun)) + `(it ,description + (let ((clojure-align-forms-automatically t) + (clojure-align-reader-conditionals t)) + ,@(mapcar (lambda (form) + `(with-temp-buffer + (clojure-mode) + (insert "\n" ,(replace-regexp-in-string " +" " " form)) + (indent-region (point-min) (point-max)) + (should (equal (buffer-substring-no-properties (point-min) (point-max)) + ,(concat "\n" form))))) + forms)) + (let ((clojure-align-forms-automatically nil)) + ,@(mapcar (lambda (form) + `(with-temp-buffer + (clojure-mode) + (insert "\n" ,(replace-regexp-in-string " +" " " form)) + ;; This is to check that we did NOT align anything. Run + ;; `indent-region' and then check that no extra spaces + ;; where inserted besides the start of the line. + (indent-region (point-min) (point-max)) + (goto-char (point-min)) + (should-not (search-forward-regexp "\\([^\s\n]\\) +" nil 'noerror)))) + forms)))) + +;; Provide font locking for easier test editing. + +(font-lock-add-keywords + 'emacs-lisp-mode + `((,(rx "(" (group "when-indenting-with-point-it") eow) + (1 font-lock-keyword-face)) + (,(rx "(" + (group "when-indenting-with-point-it") (+ space) + (group bow (+ (not space)) eow) + ) + (1 font-lock-keyword-face) + (2 font-lock-function-name-face)))) + +(describe "indentation" + (it "should not hang on end of buffer" + (with-clojure-buffer "(let [a b]" + (goto-char (point-max)) + (expect + (with-timeout (2) + (newline-and-indent) + t)))) + + (when-indenting-with-point-it "should have no indentation at top level" + "|x" + + "|x") + + (when-indenting-with-point-it "should indent cond" + " + (cond + |x)" + + " + (cond + |x)") + + (when-indenting-with-point-it "should indent cond-> with a namespaced map" + " +(cond-> #:a{:b 1} +|x 1)" + + " +(cond-> #:a{:b 1} + |x 1)") + + (when-indenting-with-point-it "should indent cond-> with a namespaced map 2" + " +(cond-> #::a{:b 1} +|x 1)" + + " +(cond-> #::a{:b 1} + |x 1)") + + (when-indenting-with-point-it "should indent threading macro with expression on first line" + " + (->> expr + |ala)" + + " + (->> expr + |ala)") + + (when-indenting-with-point-it "should indent threading macro with expression on second line" + " + (->> + |expr)" + + " + (->> + |expr)") + + (when-indenting-with-point-it "should not indent for def string" + "(def foo \"hello|\")" + "(def foo \"hello|\")") + + (when-indenting-with-point-it "should indent doc strings" + " + (defn some-fn + |\"some doc string\")" + " + (defn some-fn + |\"some doc string\")") + + (when-indenting-with-point-it "should not indent doc strings when correct indent already specified" + " + (defn some-fn + |\"some doc string\")" + " + (defn some-fn + |\"some doc string\")") + + (when-indenting-with-point-it "should handle doc strings with additional indent specified" + " + (defn some-fn + |\"some doc string + - some note\")" + " + (defn some-fn + |\"some doc string + - some note\")") + + (describe "specify different indentation for symbol with some ns prefix" + (put-clojure-indent 'bala 0) + (put-clojure-indent 'ala/bala 1) + + (when-indenting-with-point-it "should handle a symbol without ns" + " + (bala + |one)" + " + (bala + |one)") + + (when-indenting-with-point-it "should handle a symbol with ns" + " + (ala/bala top + |one)" + " + (ala/bala top + |one)")) + + (describe "specify an indentation for symbol" + (put-clojure-indent 'cala 1) + + (when-indenting-with-point-it "should handle a symbol with ns" + " + (cala top + |one)" + " + (cala top + |one)") + (when-indenting-with-point-it "should handle special arguments" + " + (cala + |top + one)" + " + (cala + |top + one)")) + (describe "should respect special argument indentation" + :var (clojure-special-arg-indent-factor) + (before-each + (setq clojure-special-arg-indent-factor 1)) + (after-each + (setq clojure-special-arg-indent-factor 2)) + + (put-clojure-indent 'cala 1) + + (when-indenting-with-point-it "should handle a symbol with ns" + " + (cala top + |one)" + " + (cala top + |one)") + (when-indenting-with-point-it "should handle special arguments" + " + (cala + |top + one)" + " + (cala + |top + one)")) + + (describe "we can pass a lambda to explicitly set the column" + (put-clojure-indent 'arsymbol (lambda (_indent-point _state) 0)) + + (when-indenting-with-point-it "should handle a symbol with lambda" + " +(arsymbol +|one)" + " +(arsymbol +|one)")) + + (when-indenting-with-point-it "should indent a form with metadata" + " + (ns ^:doc app.core + |(:gen-class))" + " + (ns ^:doc app.core + |(:gen-class))") + + (when-indenting-with-point-it "should handle multiline sexps" + " + [[ + 2] a + |x]" + " + [[ + 2] a + |x]") + + (when-indenting-with-point-it "should indent reader conditionals" + " + #?(:clj :foo + |:cljs :bar)" + " + #?(:clj :foo + |:cljs :bar)") + + (when-indenting-with-point-it "should handle backtracking with aliases" + " + (clojure.core/letfn [(twice [x] + |(* x 2))] + :a)" + " + (clojure.core/letfn [(twice [x] + |(* x 2))] + :a)") + + (when-indenting-with-point-it "should handle fixed-normal-indent" + " + (cond + (or 1 + 2) 3 + |:else 4)" + + " + (cond + (or 1 + 2) 3 + |:else 4)") + + (when-indenting-with-point-it "should handle fixed-normal-indent-2" + " +(fact {:spec-type + :charnock-column-id} #{\"charnock\"} +|{:spec-type + :charnock-column-id} #{\"current_charnock\"})" + + " +(fact {:spec-type + :charnock-column-id} #{\"charnock\"} + |{:spec-type + :charnock-column-id} #{\"current_charnock\"})") + + (when-indenting-it "closing-paren" + " +(ns ca + (:gen-class) + )") + + (when-indenting-it "default-is-not-a-define" + " +(default a + b + b)" + " +(some.namespace/default a + b + b)") + + + (when-indenting-it "should handle extend-type with multiarity" + " +(extend-type Banana + Fruit + (subtotal + ([item] + (* 158 (:qty item))) + ([item a] + (* a (:qty item)))))" + + " +(extend-protocol Banana + Fruit + (subtotal + ([item] + (* 158 (:qty item))) + ([item a] + (* a (:qty item)))))") + + + (when-indenting-it "should handle deftype with multiarity" + " +(deftype Banana [] + Fruit + (subtotal + ([item] + (* 158 (:qty item))) + ([item a] + (* a (:qty item)))))") + + (when-indenting-it "should handle defprotocol" + " +(defprotocol IFoo + (foo [this] + \"Why is this over here?\") + (foo-2 + [this] + \"Why is this over here?\"))") + + + (when-indenting-it "should handle definterface" + " +(definterface IFoo + (foo [this] + \"Why is this over here?\") + (foo-2 + [this] + \"Why is this over here?\"))") + + (when-indenting-it "should handle specify" + " +(specify obj + ISwap + (-swap! + ([this f] (reset! this (f @this))) + ([this f a] (reset! this (f @this a))) + ([this f a b] (reset! this (f @this a b))) + ([this f a b xs] (reset! this (apply f @this a b xs)))))") + + (when-indenting-it "should handle specify!" + " +(specify! obj + ISwap + (-swap! + ([this f] (reset! this (f @this))) + ([this f a] (reset! this (f @this a))) + ([this f a b] (reset! this (f @this a b))) + ([this f a b xs] (reset! this (apply f @this a b xs)))))") + + (when-indenting-it "should handle non-symbol at start" + " +{\"1\" 2 + *3 4}") + + (when-indenting-it "should handle non-symbol at start 2" + " +(\"1\" 2 + *3 4)") + + (when-indenting-it "should handle defrecord" + " +(defrecord TheNameOfTheRecord + [a pretty long argument list] + SomeType + (assoc [_ x] + (.assoc pretty x 10)))") + + (when-indenting-it "should handle defrecord 2" + " +(defrecord TheNameOfTheRecord [a pretty long argument list] + SomeType (assoc [_ x] + (.assoc pretty x 10)))") + + (when-indenting-it "should handle defrecord with multiarity" + " +(defrecord Banana [] + Fruit + (subtotal + ([item] + (* 158 (:qty item))) + ([item a] + (* a (:qty item)))))") + + (when-indenting-it "should handle letfn" + " +(letfn [(f [x] + (* x 2)) + (f [x] + (* x 2))] + (a b + c) (d) + e)") + + (when-indenting-it "should handle reify" + " +(reify Object + (x [_] + 1))" + + " +(reify + om/IRender + (render [this] + (let [indent-test :fail] + ...)) + om/IRender + (render [this] + (let [indent-test :fail] + ...)))") + + (when-indenting-it "proxy" + " +(proxy [Writer] [] + (close [] (.flush ^Writer this)) + (write + ([x] + (with-out-binding [out messages] + (.write out x))) + ([x ^Integer off ^Integer len] + (with-out-binding [out messages] + (.write out x off len)))) + (flush [] + (with-out-binding [out messages] + (.flush out))))") + + (when-indenting-it "should handle reader conditionals" + "#?@ (:clj [] + :cljs [])") + + (when-indenting-it "should handle an empty close paren" + " +(let [x] + )" + + " +(ns ok + )" + + " +(ns ^{:zen :dikar} + ok + )") + + (when-indenting-it "should handle unfinished sexps" + " +(letfn [(tw [x] + dd") + + (when-indenting-it "should handle symbols ending in crap" + " +(msg? ExceptionInfo + 10)" + + " +(thrown-with-msg? ExceptionInfo + #\"Storage must be initialized before use\" + (f))" + + " +(msg' 1 + 10)") + + (when-indenting-it "should handle let, when and while forms" + "(let-alist [x 1]\n ())" + "(while-alist [x 1]\n ())" + "(when-alist [x 1]\n ())" + "(if-alist [x 1]\n ())" + "(indents-like-fn-when-let-while-if-are-not-the-start [x 1]\n ())") + +(defun indent-cond (indent-point state) + (goto-char (elt state 1)) + (let ((pos -1) + (base-col (current-column))) + (forward-char 1) + ;; `forward-sexp' will error if indent-point is after + ;; the last sexp in the current sexp. + (condition-case nil + (while (and (<= (point) indent-point) + (not (eobp))) + (clojure-forward-logical-sexp 1) + (cl-incf pos)) + ;; If indent-point is _after_ the last sexp in the + ;; current sexp, we detect that by catching the + ;; `scan-error'. In that case, we should return the + ;; indentation as if there were an extra sexp at point. + (scan-error (cl-incf pos))) + (+ base-col (if (cl-evenp pos) 0 2)))) +(put-clojure-indent 'test-cond #'indent-cond) + +(defun indent-cond-0 (_indent-point _state) 0) +(put-clojure-indent 'test-cond-0 #'indent-cond-0) + + + (when-indenting-it "should handle function spec" + " +(when me + (test-cond + x + 1 + 2 + 3))" + + " +(when me + (test-cond-0 +x +1 +2 +3))") + + (when-indenting-it "should respect indent style 'align-arguments" + 'align-arguments + + " +(some-function + 10 + 1 + 2)" + + " +(some-function 10 + 1 + 2)") + + (when-indenting-it "should respect indent style 'always-indent" + 'always-indent + + " +(some-function + 10 + 1 + 2)" + + " +(some-function 10 + 1 + 2)") + + (when-aligning-it "should basic forms" + " +{:this-is-a-form b + c d}" + + " +{:this-is b + c d}" + + " +{:this b + c d}" + + " +{:a b + c d}" + + " +(let [this-is-a-form b + c d])" + + " +(let [this-is b + c d])" + + " +(let [this b + c d])" + + " +(let [a b + c d])") + + (when-aligning-it "should handle a blank line" + " +(let [this-is-a-form b + c d + + another form + k g])" + + " +{:this-is-a-form b + c d + + :another form + k g}") + + (when-aligning-it "should handle basic forms (reversed)" + " +{c d + :this-is-a-form b}" + " +{c d + :this-is b}" + " +{c d + :this b}" + " +{c d + :a b}" + + " +(let [c d + this-is-a-form b])" + + " +(let [c d + this-is b])" + + " +(let [c d + this b])" + + " +(let [c d + a b])") + + (when-aligning-it "should handle incomplete sexps" + " +(cond aa b + casodkas )" + + " +(cond aa b + casodkas)" + + " +(cond aa b + casodkas " + + " +(cond aa b + casodkas" + + " +(cond aa b + casodkas a)" + + " +(cond casodkas a + aa b)" + + " +(cond casodkas + aa b)") + + + (when-aligning-it "should handle multiple words" + " +(cond this is just + a test of + how well + multiple words will work)") + + (when-aligning-it "should handle nested maps" + " +{:a {:a :a + :bbbb :b} + :bbbb :b}") + + (when-aligning-it "should regard end as a marker" + " +{:a {:a :a + :aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa :a} + :b {:a :a + :aa :a}}") + + (when-aligning-it "should handle trailing commas" + " +{:a {:a :a, + :aa :a}, + :b {:a :a, + :aa :a}}") + + (when-aligning-it "should handle standard reader conditionals" + " +#?(:clj 2 + :cljs 2)") + + (when-aligning-it "should handle splicing reader conditional" + " +#?@(:clj [2] + :cljs [2])") + + (when-aligning-it "should handle sexps broken up by line comments" + " +(let [x 1 + ;; comment + xx 1] + xx)" + + " +{:x 1 + ;; comment + :xxx 2}" + + " +(case x + :aa 1 + ;; comment + :a 2)") + + (when-aligning-it "should work correctly when margin comments appear after nested, multi-line, non-terminal sexps" + " +(let [x {:a 1 + :b 2} ; comment + xx 3] + x)" + + " +{:aa {:b 1 + :cc 2} ;; comment + :a 1}}" + + " +(case x + :a (let [a 1 + aa (+ a 1)] + aa); comment + :aa 2)") + + (it "should handle improperly indented content" + (let ((content "(let [a-long-name 10\nb 20])") + (aligned-content "(let [a-long-name 10\n b 20])")) + (with-clojure-buffer content + (call-interactively #'clojure-align) + (expect (buffer-string) :to-equal aligned-content)))) + + (it "should not align reader conditionals by default" + (let ((content "#?(:clj 2\n :cljs 2)")) + (with-clojure-buffer content + (call-interactively #'clojure-align) + (expect (buffer-string) :to-equal content)))) + + (it "should align reader conditionals when clojure-align-reader-conditionals is true" + (let ((content "#?(:clj 2\n :cljs 2)")) + (with-clojure-buffer content + (setq-local clojure-align-reader-conditionals t) + (call-interactively #'clojure-align) + (expect (buffer-string) :not :to-equal content)))) + + (it "should remove extra commas" + (with-clojure-buffer "{:a 2, ,:c 4}" + (call-interactively #'clojure-align) + (expect (string= (buffer-string) "{:a 2, :c 4}"))))) + +(provide 'clojure-mode-indentation-test) + +;;; clojure-mode-indentation-test.el ends here diff --git a/clojure-mode-tests/clojure-mode-promote-fn-literal-test.el b/clojure-mode-tests/clojure-mode-promote-fn-literal-test.el new file mode 100644 index 0000000..13aa006 --- /dev/null +++ b/clojure-mode-tests/clojure-mode-promote-fn-literal-test.el @@ -0,0 +1,73 @@ +;;; clojure-mode-promote-fn-literal-test.el --- Clojure Mode: convert fn syntax -*- lexical-binding: t; -*- + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; Tests for clojure-promote-fn-literal + +;;; Code: + +(require 'clojure-mode) +(require 'buttercup) +(require 'test-helper "test/utils/test-helper") + +(describe "clojure-promote-fn-literal" + :var (names) + + (before-each + (spy-on 'read-string + :and-call-fake (lambda (_) (or (pop names) (error ""))))) + + (when-refactoring-it "should convert 0-arg fns" + "#(rand)" + "(fn [] (rand))" + (clojure-promote-fn-literal)) + + (when-refactoring-it "should convert 1-arg fns" + "#(= % 1)" + "(fn [x] (= x 1))" + (setq names '("x")) + (clojure-promote-fn-literal)) + + (when-refactoring-it "should convert 2-arg fns" + "#(conj (pop %) (assoc (peek %1) %2 (* %2 %2)))" + "(fn [acc x] (conj (pop acc) (assoc (peek acc) x (* x x))))" + (setq names '("acc" "x")) + (clojure-promote-fn-literal)) + + (when-refactoring-it "should convert variadic fns" + ;; from https://hypirion.com/musings/swearjure + "#(* (`[~@%&] (+)) + ((% (+)) % (- (`[~@%&] (+)) (*))))" + "(fn [v & vs] (* (`[~@vs] (+)) + ((v (+)) v (- (`[~@vs] (+)) (*)))))" + (setq names '("v" "vs")) + (clojure-promote-fn-literal)) + + (when-refactoring-it "should ignore strings and comments" + "#(format \"%2\" ;; FIXME: %2 is an illegal specifier + %7) " + "(fn [_ _ _ _ _ _ id] (format \"%2\" ;; FIXME: %2 is an illegal specifier + id)) " + (setq names '("_" "_" "_" "_" "_" "_" "id")) + (clojure-promote-fn-literal))) + + +(provide 'clojure-mode-convert-fn-test) + + +;;; clojure-mode-promote-fn-literal-test.el ends here diff --git a/clojure-mode-tests/clojure-mode-refactor-add-arity-test.el b/clojure-mode-tests/clojure-mode-refactor-add-arity-test.el new file mode 100644 index 0000000..5f1c5fb --- /dev/null +++ b/clojure-mode-tests/clojure-mode-refactor-add-arity-test.el @@ -0,0 +1,328 @@ +;;; clojure-mode-refactor-add-arity.el --- Clojure Mode: refactor add arity -*- lexical-binding: t; -*- + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + + +;;; Commentary: + +;; Tests for clojure-add-arity + +;;; Code: + +(require 'clojure-mode) +(require 'buttercup) +(require 'test-helper "test/utils/test-helper") + +(describe "clojure-add-arity" + + (when-refactoring-with-point-it "should add an arity to a single-arity defn with args on same line" + "(defn foo [arg] + body|)" + + "(defn foo + ([|]) + ([arg] + body))" + + (clojure-add-arity)) + + (when-refactoring-with-point-it "should add an arity to a single-arity defn with args on next line" + "(defn foo + [arg] + bo|dy)" + + "(defn foo + ([|]) + ([arg] + body))" + + (clojure-add-arity)) + + (when-refactoring-with-point-it "should handle a single-arity defn with a docstring" + "(defn foo + \"some docst|ring\" + [arg] + body)" + + "(defn foo + \"some docstring\" + ([|]) + ([arg] + body))" + + (clojure-add-arity)) + + (when-refactoring-with-point-it "should handle a single-arity defn with metadata" + "(defn fo|o + ^{:bla \"meta\"} + [arg] + body)" + + "(defn foo + ^{:bla \"meta\"} + ([|]) + ([arg] + body))" + + (clojure-add-arity)) + + (when-refactoring-with-point-it "should add an arity to a multi-arity defn" + "(defn foo + ([arg1]) + ([ar|g1 arg2] + body))" + + "(defn foo + ([|]) + ([arg1]) + ([arg1 arg2] + body))" + + (clojure-add-arity)) + + (when-refactoring-with-point-it "should handle a multi-arity defn with a docstring" + "(defn foo + \"some docstring\" + ([]) + ([arg|] + body))" + + "(defn foo + \"some docstring\" + ([|]) + ([]) + ([arg] + body))" + + (clojure-add-arity)) + + (when-refactoring-with-point-it "should handle a multi-arity defn with metadata" + "(defn foo + \"some docstring\" + ^{:bla \"meta\"} + ([]) + |([arg] + body))" + + "(defn foo + \"some docstring\" + ^{:bla \"meta\"} + ([|]) + ([]) + ([arg] + body))" + + (clojure-add-arity)) + + (when-refactoring-with-point-it "should handle a single-arity fn" + "(fn foo [arg] + body|)" + + "(fn foo + ([|]) + ([arg] + body))" + + (clojure-add-arity)) + + (when-refactoring-with-point-it "should handle a multi-arity fn" + "(fn foo + ([x y] + body) + ([a|rg] + body))" + + "(fn foo + ([|]) + ([x y] + body) + ([arg] + body))" + + (clojure-add-arity)) + + (when-refactoring-with-point-it "should handle a single-arity defmacro" + "(defmacro foo [arg] + body|)" + + "(defmacro foo + ([|]) + ([arg] + body))" + + (clojure-add-arity)) + + (when-refactoring-with-point-it "should handle a multi-arity defmacro" + "(defmacro foo + ([x y] + body) + ([a|rg] + body))" + + "(defmacro foo + ([|]) + ([x y] + body) + ([arg] + body))" + + (clojure-add-arity)) + + (when-refactoring-with-point-it "should handle a single-arity defmethod" + "(defmethod foo :bar [arg] + body|)" + + "(defmethod foo :bar + ([|]) + ([arg] + body))" + + (clojure-add-arity)) + + (when-refactoring-with-point-it "should handle a multi-arity defmethod" + "(defmethod foo :bar + ([x y] + body) + ([a|rg] + body))" + + "(defmethod foo :bar + ([|]) + ([x y] + body) + ([arg] + body))" + + (clojure-add-arity)) + + (when-refactoring-with-point-it "should handle a defn inside a reader conditional" + "#?(:clj + (defn foo + \"some docstring\" + ^{:bla \"meta\"} + |([arg] + body)))" + + "#?(:clj + (defn foo + \"some docstring\" + ^{:bla \"meta\"} + ([|]) + ([arg] + body)))" + + (clojure-add-arity)) + + (when-refactoring-with-point-it "should handle a defn inside a reader conditional with 2 platform tags" + "#?(:clj + (defn foo + \"some docstring\" + ^{:bla \"meta\"} + |([arg] + body)) + :cljs + (defn foo + \"some docstring\" + ^{:bla \"meta\"} + ([arg] + body)))" + + "#?(:clj + (defn foo + \"some docstring\" + ^{:bla \"meta\"} + ([|]) + ([arg] + body)) + :cljs + (defn foo + \"some docstring\" + ^{:bla \"meta\"} + ([arg] + body)))" + + (clojure-add-arity)) + + (when-refactoring-with-point-it "should handle a single-arity fn inside a letfn" + "(letfn [(foo [x] + bo|dy)] + (foo 3))" + + "(letfn [(foo + ([|]) + ([x] + body))] + (foo 3))" + + (clojure-add-arity)) + + (when-refactoring-with-point-it "should handle a multi-arity fn inside a letfn" + "(letfn [(foo + ([x] + body) + |([x y] + body))] + (foo 3))" + + "(letfn [(foo + ([|]) + ([x] + body) + ([x y] + body))] + (foo 3))" + + (clojure-add-arity)) + + (when-refactoring-with-point-it "should handle a proxy" + "(proxy [Foo] [] + (bar [arg] + body|))" + + "(proxy [Foo] [] + (bar + ([|]) + ([arg] + body)))" + + (clojure-add-arity)) + + (when-refactoring-with-point-it "should handle a defprotocol" + "(defprotocol Foo + \"some docstring\" + (bar [arg] [x |y] \"some docstring\"))" + + "(defprotocol Foo + \"some docstring\" + (bar [|] [arg] [x y] \"some docstring\"))" + + (clojure-add-arity)) + + (when-refactoring-with-point-it "should handle a reify" + "(reify Foo + (bar [arg] body) + (blahs [arg]| body))" + + "(reify Foo + (bar [arg] body) + (blahs [|]) + (blahs [arg] body))" + + (clojure-add-arity))) + +(provide 'clojure-mode-refactor-add-arity-test) + +;;; clojure-mode-refactor-add-arity-test.el ends here diff --git a/clojure-mode-tests/clojure-mode-refactor-let-test.el b/clojure-mode-tests/clojure-mode-refactor-let-test.el new file mode 100644 index 0000000..a197012 --- /dev/null +++ b/clojure-mode-tests/clojure-mode-refactor-let-test.el @@ -0,0 +1,259 @@ +;;; clojure-mode-refactor-let-test.el --- Clojure Mode: refactor let -*- lexical-binding: t; -*- + +;; Copyright (C) 2016-2021 Benedek Fazekas + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; The refactor-let code originally was implemented in clj-refactor.el +;; and is the work of the clj-reafctor.el team. + +;;; Code: + +(require 'clojure-mode) +(require 'buttercup) + +(describe "clojure--introduce-let-internal" + (when-refactoring-it "should introduce a let form" + "{:status 200 + :body (find-body abc)}" + + "{:status 200 + :body (let [body (find-body abc)] + body)}" + + (search-backward "(find-body") + (clojure--introduce-let-internal "body")) + + (when-refactoring-it "should introduce an expanded let form" + "(defn handle-request [] + {:status 200 + :length (count (find-body abc)) + :body (find-body abc)})" + + "(defn handle-request [] + (let [body (find-body abc)] + {:status 200 + :length (count body) + :body body}))" + + (search-backward "(find-body") + (clojure--introduce-let-internal "body" 1)) + + (when-refactoring-it "should replace bindings whitespace" + "(defn handle-request [] + {:status 200 + :length (count + (find-body + abc)) + :body (find-body abc)})" + + "(defn handle-request [] + (let [body (find-body abc)] + {:status 200 + :length (count + body) + :body body}))" + (search-backward "(find-body") + (clojure--introduce-let-internal "body" 1))) + +(describe "clojure-let-forward-slurp-sexp" + (when-refactoring-it "should slurp the next 2 sexps after the let into the let form" + "(defn handle-request [] + (let [body (find-body abc)] + {:status 200 + :length (count body) + :body body}) + (println (find-body abc)) + (println \"foobar\"))" + + "(defn handle-request [] + (let [body (find-body abc)] + {:status 200 + :length (count body) + :body body} + (println body) + (println \"foobar\")))" + + (search-backward "(count body") + (clojure-let-forward-slurp-sexp 2))) + +(describe "clojure-let-backward-slurp-sexp" + (when-refactoring-it "should slurp the previous 2 sexps before the let into the let form" + "(defn handle-request [] + (println (find-body abc)) + (println \"foobar\") + (let [body (find-body abc)] + {:status 200 + :length (count body) + :body body}))" + + "(defn handle-request [] + (let [body (find-body abc)] + (println body) + (println \"foobar\") + {:status 200 + :length (count body) + :body body}))" + + (search-backward "(count body") + (clojure-let-backward-slurp-sexp 2))) + +(describe "clojure--move-to-let-internal" + (when-refactoring-it "should move sexp to let" + "(defn handle-request + (let [body (find-body abc)] + {:status (or status 500) + :body body}))" + + "(defn handle-request + (let [body (find-body abc) + status (or status 500)] + {:status status + :body body}))" + + (search-backward "(or ") + (clojure--move-to-let-internal "status")) + + (when-refactoring-it "should move constant to when let" + "(defn handle-request + (when-let [body (find-body abc)] + {:status 42 + :body body}))" + + "(defn handle-request + (when-let [body (find-body abc) + status 42] + {:status status + :body body}))" + + (search-backward "42") + (clojure--move-to-let-internal "status")) + + (when-refactoring-it "should move sexp to empty let" + "(defn handle-request + (if-let [] + {:status (or status 500) + :body body}))" + + "(defn handle-request + (if-let [status (or status 500)] + {:status status + :body body}))" + + (search-backward "(or ") + (clojure--move-to-let-internal "status")) + + (when-refactoring-it "should introduce let if missing" + "(defn handle-request + {:status (or status 500) + :body body})" + + "(defn handle-request + {:status (let [status (or status 500)] + status) + :body body})" + + (search-backward "(or ") + (clojure--move-to-let-internal "status")) + + (when-refactoring-it "should move multiple occurrences of a sexp" + "(defn handle-request + (let [] + (println \"body: \" body \", params: \" \", status: \" (or status 500)) + {:status (or status 500) + :body body}))" + + "(defn handle-request + (let [status (or status 500)] + (println \"body: \" body \", params: \" \", status: \" status) + {:status status + :body body}))" + + (search-backward "(or ") + (clojure--move-to-let-internal "status")) + + (when-refactoring-it "should handle a name that is longer than the expression" + "(defn handle-request + (let [] + (println \"body: \" body \", params: \" \", status: \" 5) + {:body body + :status 5}))" + + "(defn handle-request + (let [status 5] + (println \"body: \" body \", params: \" \", status: \" status) + {:body body + :status status}))" + + (search-backward "5") + (search-backward "5") + (clojure--move-to-let-internal "status")) + + ;; clojure-emacs/clj-refactor.el#41 + (when-refactoring-it "should not move to nested let" + "(defn foo [] + (let [x (range 10)] + (doseq [x (range 10)] + (let [x2 (* x x)])) + (+ 1 1)))" + + "(defn foo [] + (let [x (range 10) + something (+ 1 1)] + (doseq [x x] + (let [x2 (* x x)])) + something))" + + (search-backward "(+ 1 1") + (clojure--move-to-let-internal "something")) + + ;; clojure-emacs/clj-refactor.el#30 + (when-refactoring-it "should move before current form when already inside let binding-1" + "(deftest retrieve-order-body-test + (let [item (get-in (retrieve-order-body order-item-response-str))]))" + + "(deftest retrieve-order-body-test + (let [something (retrieve-order-body order-item-response-str) + item (get-in something)]))" + + (search-backward "(retrieve") + (clojure--move-to-let-internal "something")) + + ;; clojure-emacs/clj-refactor.el#30 + (when-refactoring-it "should move before current form when already inside let binding-2" + "(let [parent (.getParent (io/file root adrf)) + builder (string-builder) + normalize-path (comp (partial path/relative-to root) + path/->normalized + foobar)] + (do-something-spectacular parent builder))" + + "(let [parent (.getParent (io/file root adrf)) + builder (string-builder) + something (partial path/relative-to root) + normalize-path (comp something + path/->normalized + foobar)] + (do-something-spectacular parent builder))" + + (search-backward "(partial") + (clojure--move-to-let-internal "something"))) + +(provide 'clojure-mode-refactor-let-test) + +;;; clojure-mode-refactor-let-test.el ends here diff --git a/clojure-mode-tests/clojure-mode-refactor-rename-ns-alias-test.el b/clojure-mode-tests/clojure-mode-refactor-rename-ns-alias-test.el new file mode 100644 index 0000000..919a3cd --- /dev/null +++ b/clojure-mode-tests/clojure-mode-refactor-rename-ns-alias-test.el @@ -0,0 +1,175 @@ +;;; clojure-mode-refactor-rename-ns-alias-test.el --- Clojure Mode: refactor rename ns alias -*- lexical-binding: t; -*- + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + + +;;; Commentary: + +;; Tests for clojure-rename-ns-alias + +;;; Code: + +(require 'clojure-mode) +(require 'ert) + +(describe "clojure--rename-ns-alias-internal" + + (when-refactoring-it "should rename an alias" + "(ns cljr.core + (:require [my.lib :as lib])) + + (def m #::lib{:kw 1, :n/kw 2, :_/bare 3, 0 4}) + + (+ (lib/a 1) (b 2))" + + "(ns cljr.core + (:require [my.lib :as foo])) + + (def m #::foo{:kw 1, :n/kw 2, :_/bare 3, 0 4}) + + (+ (foo/a 1) (b 2))" + + (clojure--rename-ns-alias-internal "lib" "foo")) + (when-refactoring-it "should handle multiple aliases with common prefixes" + + "(ns foo + (:require [clojure.string :as string] + [clojure.spec.alpha :as s] + [clojure.java.shell :as shell])) + +(s/def ::abc string/blank?) +" + "(ns foo + (:require [clojure.string :as string] + [clojure.spec.alpha :as spec] + [clojure.java.shell :as shell])) + +(spec/def ::abc string/blank?) +" + (clojure--rename-ns-alias-internal "s" "spec")) + + (when-refactoring-it "should handle ns declarations with missing as" + "(ns cljr.core + (:require [my.lib :as lib])) + + (def m #::lib{:kw 1, :n/kw 2, :_/bare 3, 0 4}) + + (+ (lib/a 1) (b 2))" + + "(ns cljr.core + (:require [my.lib :as lib])) + + (def m #::lib{:kw 1, :n/kw 2, :_/bare 3, 0 4}) + + (+ (lib/a 1) (b 2))" + + (clojure--rename-ns-alias-internal "foo" "bar")) + + (when-refactoring-it "should skip strings" + "(ns cljr.core + (:require [my.lib :as lib])) + + (def dirname \"/usr/local/lib/python3.6/site-packages\") + + (+ (lib/a 1) (b 2))" + + "(ns cljr.core + (:require [my.lib :as foo])) + + (def dirname \"/usr/local/lib/python3.6/site-packages\") + + (+ (foo/a 1) (b 2))" + + (clojure--rename-ns-alias-internal "lib" "foo")) + + (when-refactoring-it "should not skip comments" + "(ns cljr.core + (:require [my.lib :as lib])) + + (def dirname \"/usr/local/lib/python3.6/site-packages\") + + ;; TODO refactor using lib/foo + (+ (lib/a 1) (b 2))" + + "(ns cljr.core + (:require [my.lib :as new-lib])) + + (def dirname \"/usr/local/lib/python3.6/site-packages\") + + ;; TODO refactor using new-lib/foo + (+ (new-lib/a 1) (b 2))" + + (clojure--rename-ns-alias-internal "lib" "new-lib")) + + (when-refactoring-it "should escape regex characters" + "(ns test.ns + (:require [my.math.subtraction :as math.-] + [my.math.multiplication :as math.*])) + +(math.*/operator 1 (math.-/subtract 2 3))" + "(ns test.ns + (:require [my.math.subtraction :as math.-] + [my.math.multiplication :as m*])) + +(m*/operator 1 (math.-/subtract 2 3))" + (clojure--rename-ns-alias-internal "math.*" "m*")) + + (when-refactoring-it "should replace aliases in region" + "(str/join []) + +(s/with-gen #(string/includes? % \"gen/nope\") + #(gen/fmap (fn [[s1 s2]] (str s1 \"hello\" s2)) + (gen/tuple (gen/string-alphanumeric) (gen/string-alphanumeric)))) + +(gen/different-library)" + "(string/join []) + +(s/with-gen #(string/includes? % \"gen/nope\") + #(s.gen/fmap (fn [[s1 s2]] (str s1 \"hello\" s2)) + (s.gen/tuple (s.gen/string-alphanumeric) (s.gen/string-alphanumeric)))) + +(gen/different-library)" + + (clojure--rename-ns-alias-usages "str" "string" (point-min) 13) + (clojure--rename-ns-alias-usages "gen" "s.gen" (point-min) (- (point-max) 23))) + + (it "should offer completions for ns forms" + (expect + (with-clojure-buffer + "(ns test.ns + (:require [my.math.subtraction :as math.-] + [my.math.multiplication :as math.*] + [clojure.spec.alpha :as s] + ;; [clojure.spec.alpha2 :as s2] + [symbols :as abc123.-$#.%*+!@])) + +(math.*/operator 1 (math.-/subtract 2 3))" + (clojure--collect-ns-aliases (point-min) (point-max) 'ns-form)) + :to-equal '("math.-" "math.*" "s" "abc123.-$#.%*+!@"))) + + (it "should offer completions for usages in region" + (expect + (with-clojure-buffer + "(s/with-gen #(string/includes? % \"hello\") + #(gen/fmap (fn [[s1 s2]] (str s1 \"hello\" s2)) + (gen/tuple (gen/string-alphanumeric) (gen/string-alphanumeric))))" + (clojure--collect-ns-aliases (point-min) (point-max) nil)) + :to-equal '("s" "string" "gen")))) + + +(provide 'clojure-mode-refactor-rename-ns-alias-test) + +;;; clojure-mode-refactor-rename-ns-alias-test.el ends here diff --git a/clojure-mode-tests/clojure-mode-refactor-threading-test.el b/clojure-mode-tests/clojure-mode-refactor-threading-test.el new file mode 100644 index 0000000..efd7eb1 --- /dev/null +++ b/clojure-mode-tests/clojure-mode-refactor-threading-test.el @@ -0,0 +1,465 @@ +;;; clojure-mode-refactor-threading-test.el --- Clojure Mode: refactor threading tests -*- lexical-binding: t; -*- + +;; Copyright (C) 2016-2021 Benedek Fazekas + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; The threading refactoring code is ported from clj-refactor.el +;; and mainly the work of Magnar Sveen, Alex Baranosky and +;; the rest of the clj-reafctor.el team. + +;;; Code: + +(require 'clojure-mode) +(require 'buttercup) + +(describe "clojure-thread" + + (when-refactoring-it "should work with -> when performed once" + "(-> (dissoc (assoc {} :key \"value\") :lock))" + + "(-> (assoc {} :key \"value\") + (dissoc :lock))" + + (clojure-thread)) + + (when-refactoring-it "should work with -> when performed twice" + "(-> (dissoc (assoc {} :key \"value\") :lock))" + + "(-> {} + (assoc :key \"value\") + (dissoc :lock))" + + (clojure-thread) + (clojure-thread)) + + (when-refactoring-it "should not thread maps" + "(-> (dissoc (assoc {} :key \"value\") :lock))" + + "(-> {} + (assoc :key \"value\") + (dissoc :lock))" + + (clojure-thread) + (clojure-thread) + (clojure-thread)) + + (when-refactoring-it "should not thread last sexp" + "(-> (dissoc (assoc (get-a-map) :key \"value\") :lock))" + + "(-> (get-a-map) + (assoc :key \"value\") + (dissoc :lock))" + + (clojure-thread) + (clojure-thread) + (clojure-thread)) + + (when-refactoring-it "should thread-first-easy-on-whitespace" + "(-> + (dissoc (assoc {} :key \"value\") :lock))" + + "(-> + (assoc {} :key \"value\") + (dissoc :lock))" + + (clojure-thread)) + + (when-refactoring-it "should remove superfluous parens" + "(-> (square (sum [1 2 3 4 5])))" + + "(-> [1 2 3 4 5] + sum + square)" + + (clojure-thread) + (clojure-thread)) + + (when-refactoring-it "should work with cursor before ->" + "(-> (not (s-acc/mobile? session)))" + + "(-> (s-acc/mobile? session) + not)" + + (beginning-of-buffer) + (clojure-thread)) + + (when-refactoring-it "should work with one step with ->>" + "(->> (map square (filter even? [1 2 3 4 5])))" + + "(->> (filter even? [1 2 3 4 5]) + (map square))" + + (clojure-thread)) + + (when-refactoring-it "should work with two steps with ->>" + "(->> (map square (filter even? [1 2 3 4 5])))" + + "(->> [1 2 3 4 5] + (filter even?) + (map square))" + + (clojure-thread) + (clojure-thread)) + + (when-refactoring-it "should not thread vectors with ->>" + "(->> (map square (filter even? [1 2 3 4 5])))" + + "(->> [1 2 3 4 5] + (filter even?) + (map square))" + + (clojure-thread) + (clojure-thread) + (clojure-thread)) + + (when-refactoring-it "should not thread last sexp with ->>" + "(->> (map square (filter even? (get-a-list))))" + + "(->> (get-a-list) + (filter even?) + (map square))" + + (clojure-thread) + (clojure-thread) + (clojure-thread)) + + (when-refactoring-it "should work with some->" + "(some-> (+ (val (find {:a 1} :b)) 5))" + + "(some-> {:a 1} + (find :b) + val + (+ 5))" + + (clojure-thread) + (clojure-thread) + (clojure-thread)) + + (when-refactoring-it "should work with some->>" + "(some->> (+ 5 (val (find {:a 1} :b))))" + + "(some->> :b + (find {:a 1}) + val + (+ 5))" + + (clojure-thread) + (clojure-thread) + (clojure-thread))) + +(describe "clojure-unwind" + + (when-refactoring-it "should unwind -> one step" + "(-> {} + (assoc :key \"value\") + (dissoc :lock))" + + "(-> (assoc {} :key \"value\") + (dissoc :lock))" + + (clojure-unwind)) + + (when-refactoring-it "should unwind -> two steps" + "(-> {} + (assoc :key \"value\") + (dissoc :lock))" + + "(-> (dissoc (assoc {} :key \"value\") :lock))" + + (clojure-unwind) + (clojure-unwind)) + + (when-refactoring-it "should unwind -> completely" + "(-> {} + (assoc :key \"value\") + (dissoc :lock))" + + "(dissoc (assoc {} :key \"value\") :lock)" + + (clojure-unwind) + (clojure-unwind) + (clojure-unwind)) + + (when-refactoring-it "should unwind ->> one step" + "(->> [1 2 3 4 5] + (filter even?) + (map square))" + + "(->> (filter even? [1 2 3 4 5]) + (map square))" + + (clojure-unwind)) + + (when-refactoring-it "should unwind ->> two steps" + "(->> [1 2 3 4 5] + (filter even?) + (map square))" + + "(->> (map square (filter even? [1 2 3 4 5])))" + + (clojure-unwind) + (clojure-unwind)) + + (when-refactoring-it "should unwind ->> completely" + "(->> [1 2 3 4 5] + (filter even?) + (map square))" + + "(map square (filter even? [1 2 3 4 5]))" + + (clojure-unwind) + (clojure-unwind) + (clojure-unwind)) + + (when-refactoring-it "should unwind N steps with numeric prefix arg" + "(->> [1 2 3 4 5] + (filter even?) + (map square) + sum)" + + "(->> (sum (map square (filter even? [1 2 3 4 5]))))" + + (clojure-unwind 3)) + + (when-refactoring-it "should unwind completely with universal prefix arg" + "(->> [1 2 3 4 5] + (filter even?) + (map square) + sum)" + + "(sum (map square (filter even? [1 2 3 4 5])))" + + (clojure-unwind '(4))) + + (when-refactoring-it "should unwind correctly when multiple ->> are present on same line" + "(->> 1 inc) (->> [1 2 3 4 5] + (filter even?) + (map square))" + + "(->> 1 inc) (->> (map square (filter even? [1 2 3 4 5])))" + + (clojure-unwind) + (clojure-unwind)) + + (when-refactoring-it "should unwind with function name" + "(->> [1 2 3 4 5] + sum + square)" + + "(->> (sum [1 2 3 4 5]) + square)" + + (clojure-unwind)) + + (when-refactoring-it "should unwind with function name twice" + "(-> [1 2 3 4 5] + sum + square)" + + "(-> (square (sum [1 2 3 4 5])))" + + (clojure-unwind) + (clojure-unwind)) + + (when-refactoring-it "should thread-issue-6-1" + "(defn plus [a b] + (-> a (+ b)))" + + "(defn plus [a b] + (-> (+ a b)))" + + (clojure-unwind)) + + (when-refactoring-it "should thread-issue-6-2" + "(defn plus [a b] + (->> a (+ b)))" + + "(defn plus [a b] + (->> (+ b a)))" + + (clojure-unwind)) + + (when-refactoring-it "should unwind some->" + "(some-> {:a 1} + (find :b) + val + (+ 5))" + + "(some-> (+ (val (find {:a 1} :b)) 5))" + + (clojure-unwind) + (clojure-unwind) + (clojure-unwind)) + + (when-refactoring-it "should unwind some->>" + "(some->> :b + (find {:a 1}) val + (+ 5))" + + "(some->> (+ 5 (val (find {:a 1} :b))))" + + (clojure-unwind) + (clojure-unwind) + (clojure-unwind))) + +(describe "clojure-thread-first-all" + + (when-refactoring-it "should thread first all sexps" + "(->map (assoc {} :key \"value\") :lock)" + + "(-> {} + (assoc :key \"value\") + (->map :lock))" + + (beginning-of-buffer) + (clojure-thread-first-all nil)) + + (when-refactoring-it "should thread a form except the last expression" + "(->map (assoc {} :key \"value\") :lock)" + + "(-> (assoc {} :key \"value\") + (->map :lock))" + + (beginning-of-buffer) + (clojure-thread-first-all t))) + +(describe "clojure-thread-last-all" + + (when-refactoring-it "should fully thread a form" + "(map square (filter even? (make-things)))" + + "(->> (make-things) + (filter even?) + (map square))" + + (beginning-of-buffer) + (clojure-thread-last-all nil)) + + (when-refactoring-it "should thread a form except the last expression" + "(map square (filter even? (make-things)))" + + "(->> (filter even? (make-things)) + (map square))" + + (beginning-of-buffer) + (clojure-thread-last-all t)) + + (when-refactoring-it "should handle dangling parens 1" + "(map inc + (range))" + + "(->> (range) + (map inc))" + + (beginning-of-buffer) + (clojure-thread-last-all nil)) + + (when-refactoring-it "should handle dangling parens 2" + "(deftask dev [] + (comp (serve) + (cljs)))" + + "(->> (cljs) + (comp (serve)) + (deftask dev []))" + + (beginning-of-buffer) + (clojure-thread-last-all nil))) + +(describe "clojure-unwind-all" + + (when-refactoring-it "should unwind all in ->" + "(-> {} + (assoc :key \"value\") + (dissoc :lock))" + + "(dissoc (assoc {} :key \"value\") :lock)" + + (beginning-of-buffer) + (clojure-unwind-all)) + + (when-refactoring-it "should unwind all in ->>" + "(->> (make-things) + (filter even?) + (map square))" + + "(map square (filter even? (make-things)))" + + (beginning-of-buffer) + (clojure-unwind-all)) + + ;; fix for clojure-emacs/clj-refactor.el#259 + (when-refactoring-it "should leave multiline sexp alone" + "(->> [a b] + (some (fn [x] + (when x + 10))))" + + "(some (fn [x] + (when x + 10)) + [a b])" + + (clojure-unwind-all)) + + (when-refactoring-it "should thread-last-maybe-unjoin-lines" + "(deftask dev [] + (comp (serve) + (cljs (lala) + 10)))" + + "(deftask dev [] + (comp (serve) + (cljs (lala) + 10)))" + + (goto-char (point-min)) + (clojure-thread-last-all nil) + (clojure-unwind-all))) + +(describe "clojure-thread-first-all" + + (when-refactoring-it "should thread with an empty first line" + "(map + inc + [1 2])" + + "(-> inc + (map + [1 2]))" + + (goto-char (point-min)) + (clojure-thread-first-all nil)) + + (when-refactoring-it "should thread-first-maybe-unjoin-lines" + "(map + inc + [1 2])" + + "(map + inc + [1 2])" + + (goto-char (point-min)) + (clojure-thread-first-all nil) + (clojure-unwind-all))) + +(provide 'clojure-mode-refactor-threading-test) + +;;; clojure-mode-refactor-threading-test.el ends here diff --git a/clojure-mode-tests/clojure-mode-safe-eval-test.el b/clojure-mode-tests/clojure-mode-safe-eval-test.el new file mode 100644 index 0000000..fe1e2a6 --- /dev/null +++ b/clojure-mode-tests/clojure-mode-safe-eval-test.el @@ -0,0 +1,74 @@ +;;; clojure-mode-safe-eval-test.el --- Clojure Mode: safe eval test suite -*- lexical-binding: t; -*- + +;; Copyright (C) 2014-2021 Bozhidar Batsov +;; Copyright (C) 2021 Rob Browning + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; The safe eval test suite of Clojure Mode + +;;; Code: +(require 'clojure-mode) +(require 'buttercup) + +(describe "put-clojure-indent safe-local-eval-function property" + (it "should be set to clojure--valid-put-clojure-indent-call-p" + (expect (get 'put-clojure-indent 'safe-local-eval-function) + :to-be 'clojure--valid-put-clojure-indent-call-p))) + +(describe "clojure--valid-put-clojure-indent-call-p" + (it "should approve valid forms" + (expect (clojure--valid-put-clojure-indent-call-p + '(put-clojure-indent 'foo 1))) + (expect (clojure--valid-put-clojure-indent-call-p + '(put-clojure-indent 'foo :defn))) + (expect (clojure--valid-put-clojure-indent-call-p + '(put-clojure-indent 'foo :form))) + (expect (clojure--valid-put-clojure-indent-call-p + '(put-clojure-indent 'foo '(1)))) + (expect (clojure--valid-put-clojure-indent-call-p + '(put-clojure-indent 'foo '(:defn)))) + (expect (clojure--valid-put-clojure-indent-call-p + '(put-clojure-indent 'foo '(:form)))) + (expect (clojure--valid-put-clojure-indent-call-p + '(put-clojure-indent 'foo '(1 1)))) + (expect (clojure--valid-put-clojure-indent-call-p + '(put-clojure-indent 'foo '(2 :form :form (1)))))) + (it "should reject invalid forms" + (expect (clojure--valid-put-clojure-indent-call-p + '(put-clojure-indent 1 1)) + :to-throw 'error) + (expect (clojure--valid-put-clojure-indent-call-p + '(put-clojure-indent 'foo :foo)) + :to-throw 'error) + (expect (clojure--valid-put-clojure-indent-call-p + '(put-clojure-indent 'foo (:defn))) + :to-throw 'error) + (expect (clojure--valid-put-clojure-indent-call-p + '(put-clojure-indent 'foo '(:foo))) + :to-throw 'error) + (expect (clojure--valid-put-clojure-indent-call-p + '(put-clojure-indent 'foo '(1 :foo))) + :to-throw 'error) + (expect (clojure--valid-put-clojure-indent-call-p + '(put-clojure-indent 'foo '(1 "foo"))) + :to-throw 'error))) + +(provide 'clojure-mode-safe-eval-test) + +;;; clojure-mode-safe-eval-test.el ends here diff --git a/clojure-mode-tests/clojure-mode-sexp-test.el b/clojure-mode-tests/clojure-mode-sexp-test.el new file mode 100644 index 0000000..11bf519 --- /dev/null +++ b/clojure-mode-tests/clojure-mode-sexp-test.el @@ -0,0 +1,233 @@ +;;; clojure-mode-sexp-test.el --- Clojure Mode: sexp tests -*- lexical-binding: t; -*- + +;; Copyright (C) 2015-2021 Artur Malabarba + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Code: + +(require 'clojure-mode) +(require 'buttercup) + +(describe "clojure-top-level-form-p" + (it "should return true when passed the correct form" + (with-clojure-buffer-point + "(comment + (wrong) + (rig|ht) + (wrong))" + ;; make this use the native beginning of defun since this is used to + ;; determine whether to use the comment aware version or not. + (expect (let ((beginning-of-defun-function nil)) + (clojure-top-level-form-p "comment"))))) + (it "should return true when multiple forms are present" + (with-clojure-buffer-point + "(+ 1 2) (comment + (wrong) + (rig|ht) + (wrong))" + (expect (let ((beginning-of-defun-function nil)) + (clojure-top-level-form-p "comment")))))) +(describe "clojure--looking-at-top-level-form" + (it "should return nil when point is inside a top level form" + (with-clojure-buffer-point + "(comment + |(ns foo))" + (expect (clojure--looking-at-top-level-form) :to-equal nil)) + (with-clojure-buffer-point + "\"|(ns foo)\"" + (expect (clojure--looking-at-top-level-form) :to-equal nil)) + (with-clojure-buffer-point + "^{:fake-ns |(ns foo)}" + (expect (clojure--looking-at-top-level-form) :to-equal nil))) + (it "should return true when point is looking at a top level form" + (with-clojure-buffer-point + "(comment + |(ns foo))" + (expect (clojure--looking-at-top-level-form (point-min)) :to-equal t)) + (with-clojure-buffer-point + "|(ns foo)" + (expect (clojure--looking-at-top-level-form) :to-equal t)))) +(describe "clojure-beginning-of-defun-function" + (it "should go to top level form" + (with-clojure-buffer-point + " (comment + (wrong) + (wrong) + (rig|ht) + (wrong))" + (clojure-beginning-of-defun-function) + (expect (looking-at-p "(comment")))) + + (it "should eval top level forms inside comment forms when clojure-toplevel-inside-comment-form set to true" + (with-clojure-buffer-point + "(+ inc 1) (comment + (wrong) + (wrong) (rig|ht) + (wrong))" + (let ((clojure-toplevel-inside-comment-form t)) + (clojure-beginning-of-defun-function)) + (expect (looking-at-p "(right)")))) + + (it "should go to beginning of previous top level form" + (with-clojure-buffer-point + " +(formA) +| +(formB)" + (let ((clojure-toplevel-inside-comment-form t)) + (beginning-of-defun) + (expect (looking-at-p "(formA)"))))) + + (it "should move forward to next top level form" + (with-clojure-buffer-point + " +(first form) +| +(second form) + +(third form)" + + (end-of-defun) + (backward-char) + (expect (looking-back "(second form)"))))) + +(describe "clojure-forward-logical-sexp" + (it "should work with commas" + (with-clojure-buffer "[], {}, :a, 2" + (goto-char (point-min)) + (clojure-forward-logical-sexp 1) + (expect (looking-at-p " {}, :a, 2")) + (clojure-forward-logical-sexp 1) + (expect (looking-at-p " :a, 2"))))) + +(describe "clojure-backward-logical-sexp" + (it "should work when used in conjunction with clojure-forward-logical-sexp" + (with-clojure-buffer "^String #macro ^dynamic reverse" + (clojure-backward-logical-sexp 1) + (expect (looking-at-p "\\^String \\#macro \\^dynamic reverse")) + (clojure-forward-logical-sexp 1) + (expect (looking-back "\\^String \\#macro \\^dynamic reverse")) + (insert " ^String biverse inverse") + (clojure-backward-logical-sexp 1) + (expect (looking-at-p "inverse")) + (clojure-backward-logical-sexp 2) + (expect (looking-at-p "\\^String \\#macro \\^dynamic reverse")) + (clojure-forward-logical-sexp 2) + (expect (looking-back "\\^String biverse")) + (clojure-backward-logical-sexp 1) + (expect (looking-at-p "\\^String biverse")))) + + (it "should handle a namespaced map" + (with-clojure-buffer "first #:name/space{:k v}" + (clojure-backward-logical-sexp 1) + (expect (looking-at-p "#:name/space{:k v}")) + (insert " #::ns {:k v}") + (clojure-backward-logical-sexp 1) + (expect (looking-at-p "#::ns {:k v}"))))) + +(describe "clojure-backward-logical-sexp" + (it "should work with buffer corners" + (with-clojure-buffer "^String reverse" + ;; Return nil and don't error + (expect (clojure-backward-logical-sexp 100) :to-be nil) + (expect (looking-at-p "\\^String reverse")) + (expect (clojure-forward-logical-sexp 100) :to-be nil) + (expect (looking-at-p "$"))) + (with-clojure-buffer "(+ 10" + (expect (clojure-backward-logical-sexp 100) :to-throw 'error) + (goto-char (point-min)) + (expect (clojure-forward-logical-sexp 100) :to-throw 'error) + ;; Just don't hang. + (goto-char (point-max)) + (expect (clojure-forward-logical-sexp 1) :to-be nil) + (erase-buffer) + (insert "(+ 10") + (newline) + (erase-buffer) + (insert "(+ 10") + (newline-and-indent)))) + +(describe "clojure-find-ns" + (it "should return the namespace from various locations in the buffer" + ;; we should not cache the results of `clojure-find-ns' here + (let ((clojure-cache-ns nil)) + (with-clojure-buffer "(ns ^{:doc \"Some docs\"}\nfoo-bar)" + (newline) + (newline) + (insert "(in-ns 'baz-quux)") + + ;; From inside docstring of first ns + (goto-char 18) + (expect (clojure-find-ns) :to-equal "foo-bar") + + ;; From inside first ns's name, on its own line + (goto-char 29) + (expect (clojure-find-ns) :to-equal "foo-bar") + + ;; From inside second ns's name + (goto-char 42) + (expect (equal "baz-quux" (clojure-find-ns)))) + (let ((data + '(("\"\n(ns foo-bar)\"\n" "(in-ns 'baz-quux)" "baz-quux") + (";(ns foo-bar)\n" "(in-ns 'baz-quux2)" "baz-quux2") + ("(ns foo-bar)\n" "\"\n(in-ns 'baz-quux)\"" "foo-bar") + ("(ns foo-bar2)\n" ";(in-ns 'baz-quux)" "foo-bar2")))) + (pcase-dolist (`(,form1 ,form2 ,expected) data) + (with-clojure-buffer form1 + (save-excursion (insert form2)) + ;; Between the two namespaces + (expect (clojure-find-ns) :to-equal expected) + ;; After both namespaces + (goto-char (point-max)) + (expect (clojure-find-ns) :to-equal expected)))))) + + (describe "`suppress-errors' argument" + (let ((clojure-cache-ns nil)) + (describe "given a faulty ns form" + (let ((ns-form "(ns )")) + (describe "when the argument is `t'" + (it "causes `clojure-find-ns' to return nil" + (with-clojure-buffer ns-form + (expect (equal nil (clojure-find-ns t)))))) + + (describe "when the argument is `nil'" + (it "causes `clojure-find-ns' to return raise an error" + (with-clojure-buffer ns-form + (expect (clojure-find-ns nil) + :to-throw 'error))))))))) + +(describe "clojure-sexp-starts-until-position" + (it "should return starting points for forms after POINT until POSITION" + (with-clojure-buffer "(run 1) (def b 2) (slurp \"file\")\n" + (goto-char (point-min)) + (expect (not (cl-set-difference '(19 9 1) + (clojure-sexp-starts-until-position (point-max))))))) + + (it "should return starting point for a single form in buffer after POINT" + (with-clojure-buffer "comment\n" + (goto-char (point-min)) + (expect (not (cl-set-difference '(1) + (clojure-sexp-starts-until-position (point-max))))))) + + (it "should return nil if POSITION is behind POINT" + (with-clojure-buffer "(run 1) (def b 2)\n" + (goto-char (point-max)) + (expect (not (clojure-sexp-starts-until-position (- (point-max) 1))))))) + +(provide 'clojure-mode-sexp-test) + +;;; clojure-mode-sexp-test.el ends here diff --git a/clojure-mode-tests/clojure-mode-syntax-test.el b/clojure-mode-tests/clojure-mode-syntax-test.el new file mode 100644 index 0000000..dfe2505 --- /dev/null +++ b/clojure-mode-tests/clojure-mode-syntax-test.el @@ -0,0 +1,193 @@ +;;; clojure-mode-syntax-test.el --- Clojure Mode: syntax related tests -*- lexical-binding: t; -*- + +;; Copyright (C) 2015-2021 Bozhidar Batsov + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; The unit test suite of Clojure Mode + +;;; Code: + +(require 'clojure-mode) +(require 'buttercup) +(require 'test-helper "test/utils/test-helper") + +(defun non-func (form-a form-b) + (with-clojure-buffer form-a + (save-excursion (insert form-b)) + (clojure--not-function-form-p))) + +(describe "clojure--not-function-form-p" + (it "should handle forms that are not funcions" + (dolist (form '(("#?@ " "(c d)") + ("#?@" "(c d)") + ("#? " "(c d)") + ("#?" "(c d)") + ("" "[asda]") + ("" "{a b}") + ("#" "{a b}") + ("" "(~)"))) + (expect (apply #'non-func form)))) + + (it "should handle forms that are funcions" + (dolist (form '("(c d)" + "(.c d)" + "(:c d)" + "(c/a d)" + "(.c/a d)" + "(:c/a d)" + "(c/a)" + "(:c/a)" + "(.c/a)")) + (expect (non-func "" form) :to-be nil) + (expect (non-func "^hint" form) :to-be nil) + (expect (non-func "#macro" form) :to-be nil) + (expect (non-func "^hint " form) :to-be nil) + (expect (non-func "#macro " form) :to-be nil)))) + +(describe "clojure-match-next-def" + (let ((some-sexp "\n(list [1 2 3])")) + (it "handles vars with metadata" + (dolist (form '("(def ^Integer a 1)" + "(def ^:a a 1)" + "(def ^::a a 1)" + "(def ^::a/b a 1)" + "(def ^{:macro true} a 1)")) + (with-clojure-buffer (concat form some-sexp) + (end-of-buffer) + (clojure-match-next-def) + (expect (looking-at "(def"))))) + + (it "handles vars without metadata" + (with-clojure-buffer (concat "(def a 1)" some-sexp) + (end-of-buffer) + (clojure-match-next-def) + (expect (looking-at "(def")))) + + (it "handles invalid def forms" + (dolist (form '("(def ^Integer)" + "(def)" + "(def ^{:macro})" + "(def ^{:macro true})" + "(def ^{:macro true} foo)" + "(def ^{:macro} foo)")) + (with-clojure-buffer (concat form some-sexp) + (end-of-buffer) + (clojure-match-next-def) + (expect (looking-at "(def")))))) + + (it "captures var name" + (dolist (form '("(def some-name 1)" + "(def some-name)" + "(def ^:private some-name 2)" + "(def ^{:private true} some-name 3)")) + (with-clojure-buffer form + (end-of-buffer) + (clojure-match-next-def) + (cl-destructuring-bind (name-beg name-end) (match-data) + (expect (string= "some-name" (buffer-substring name-beg name-end))))))) + + (it "captures var name with dispatch value for defmethod" + (dolist (form '("(defmethod some-name :key [a])" + "(defmethod ^:meta some-name :key [a])" + "(defmethod ^{:meta true} some-name :key [a])" + "(defmethod some-name :key)")) + (with-clojure-buffer form + (end-of-buffer) + (clojure-match-next-def) + (cl-destructuring-bind (name-beg name-end) (match-data) + (expect (string= "some-name :key" (buffer-substring name-beg name-end)))))))) + +(describe "clojure syntax" + (it "handles prefixed symbols" + (dolist (form '(("#?@aaa" . "aaa") + ("#?aaa" . "?aaa") + ("#aaa" . "aaa") + ("'aaa" . "aaa"))) + (with-clojure-buffer (car form) + ;; FIXME: Shouldn't there be an `expect' here? + (equal (symbol-name (symbol-at-point)) (cdr form))))) + + (it "skips prefixes" + (dolist (form '("#?@aaa" "#?aaa" "#aaa" "'aaa")) + (with-clojure-buffer form + (backward-word) + (backward-prefix-chars) + (expect (bobp)))))) + +(describe "fill-paragraph" + + (it "should work within comments" + (with-clojure-buffer " +;; Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt +;; ut labore et dolore magna aliqua." + (goto-char (point-min)) + (let ((fill-column 80)) + (fill-paragraph)) + (expect (buffer-string) :to-equal " +;; Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod +;; tempor incididunt ut labore et dolore magna aliqua."))) + + (it "should work within inner comments" + (with-clojure-buffer " +(let [a 1] + ;; Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt + ;; ut labore et dolore + ;; magna aliqua. + )" + (goto-char (point-min)) + (forward-line 2) + (let ((fill-column 80)) + (fill-paragraph)) + (expect (buffer-string) :to-equal " +(let [a 1] + ;; Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod + ;; tempor incididunt ut labore et dolore magna aliqua. + )"))) + +(when (fboundp 'font-lock-ensure) + (it "should not alter surrounding code" + (with-clojure-buffer "(def my-example-variable + \"It has a very long docstring. So long, in fact, that it wraps onto multiple lines! This is to demonstrate what happens when the docstring wraps over three lines.\" + nil)" + (font-lock-ensure) + (goto-char 40) + (let ((clojure-docstring-fill-column 80) + (fill-column 80)) + (fill-paragraph)) + (expect (buffer-string) :to-equal "(def my-example-variable + \"It has a very long docstring. So long, in fact, that it wraps onto multiple + lines! This is to demonstrate what happens when the docstring wraps over three + lines.\" + nil)"))))) + +(when (fboundp 'font-lock-ensure) + (describe "clojure-in-docstring-p" + (it "should handle def with docstring" + (with-clojure-buffer "(def my-example-variable + \"Doc here and `doc-here`\" + nil)" + (font-lock-ensure) + (goto-char 32) + (expect (clojure-in-docstring-p)) + (goto-char 46) + (expect (clojure-in-docstring-p)))))) + +(provide 'clojure-mode-syntax-test) + +;;; clojure-mode-syntax-test.el ends here diff --git a/clojure-mode-tests/clojure-mode-util-test.el b/clojure-mode-tests/clojure-mode-util-test.el new file mode 100644 index 0000000..78a2ac1 --- /dev/null +++ b/clojure-mode-tests/clojure-mode-util-test.el @@ -0,0 +1,336 @@ +;;; clojure-mode-util-test.el --- Clojure Mode: util test suite -*- lexical-binding: t; -*- + +;; Copyright (C) 2014-2021 Bozhidar Batsov + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; The unit test suite of Clojure Mode + +;;; Code: +(require 'clojure-mode) +(require 'cl-lib) +(require 'buttercup) +(require 'test-helper "test/utils/test-helper") + +(describe "clojure-mode-version" + (it "should not be nil" + (expect clojure-mode-version))) + +(defvar clojure-cache-project) + +(let ((project-dir "/home/user/projects/my-project/") + (clj-file-path "/home/user/projects/my-project/src/clj/my_project/my_ns/my_file.clj") + (project-relative-clj-file-path "src/clj/my_project/my_ns/my_file.clj") + (clj-file-ns "my-project.my-ns.my-file") + (clojure-cache-project nil)) + + (describe "clojure-project-root-path" + (it "nbb subdir" + (with-temp-dir temp-dir + (let* ((bb-edn (expand-file-name "nbb.edn" temp-dir)) + (bb-edn-src (expand-file-name "src" temp-dir))) + (write-region "{}" nil bb-edn) + (make-directory bb-edn-src) + (expect (expand-file-name (clojure-project-dir bb-edn-src)) + :to-equal (file-name-as-directory temp-dir)))))) + + (describe "clojure-project-relative-path" + (cl-letf (((symbol-function 'clojure-project-dir) (lambda () project-dir))) + (expect (string= (clojure-project-relative-path clj-file-path) + project-relative-clj-file-path)))) + + (describe "clojure-expected-ns" + (it "should return the namespace matching a path" + (cl-letf (((symbol-function 'clojure-project-relative-path) + (lambda (&optional _current-buffer-file-name) + project-relative-clj-file-path))) + (expect (string= (clojure-expected-ns clj-file-path) clj-file-ns)))) + + (it "should return the namespace even without a path" + (cl-letf (((symbol-function 'clojure-project-relative-path) + (lambda (&optional _current-buffer-file-name) + project-relative-clj-file-path))) + (expect (string= (let ((buffer-file-name clj-file-path)) + (clojure-expected-ns)) + clj-file-ns)))))) + +(describe "clojure-find-ns" + (it "should find common namespace declarations" + (with-clojure-buffer "(ns foo)" + (expect (clojure-find-ns) :to-equal "foo")) + (with-clojure-buffer "(ns + foo)" + (expect (clojure-find-ns) :to-equal "foo")) + (with-clojure-buffer "(ns foo.baz)" + (expect (clojure-find-ns) :to-equal "foo.baz")) + (with-clojure-buffer "(ns ^:bar foo)" + (expect (clojure-find-ns) :to-equal "foo")) + (with-clojure-buffer "(ns ^:bar ^:baz foo)" + (expect (clojure-find-ns) :to-equal "foo"))) + (it "should find namespaces with spaces before ns form" + (with-clojure-buffer " (ns foo)" + (expect (clojure-find-ns) :to-equal "foo"))) + (it "should skip namespaces within any comment forms" + (with-clojure-buffer "(comment + (ns foo))" + (expect (clojure-find-ns) :to-equal nil)) + (with-clojure-buffer " (ns foo) + (comment + (ns bar))" + (expect (clojure-find-ns) :to-equal "foo")) + (with-clojure-buffer " (comment + (ns foo)) + (ns bar) + (comment + (ns baz))" + (expect (clojure-find-ns) :to-equal "bar"))) + (it "should find namespace declarations with nested metadata and docstrings" + (with-clojure-buffer "(ns ^{:bar true} foo)" + (expect (clojure-find-ns) :to-equal "foo")) + (with-clojure-buffer "(ns #^{:bar true} foo)" + (expect (clojure-find-ns) :to-equal "foo")) + (with-clojure-buffer "(ns #^{:fail {}} foo)" + (expect (clojure-find-ns) :to-equal "foo")) + (with-clojure-buffer "(ns ^{:fail2 {}} foo.baz)" + (expect (clojure-find-ns) :to-equal "foo.baz")) + (with-clojure-buffer "(ns ^{} foo)" + (expect (clojure-find-ns) :to-equal "foo")) + (with-clojure-buffer "(ns ^{:skip-wiki true} + aleph.netty" + (expect (clojure-find-ns) :to-equal "aleph.netty")) + (with-clojure-buffer "(ns ^{:foo {:bar :baz} :fake (ns in.meta)} foo + \"docstring +(ns misleading)\")" + (expect (clojure-find-ns) :to-equal "foo"))) + (it "should support non-alphanumeric characters" + (with-clojure-buffer "(ns foo+)" + (expect (clojure-find-ns) :to-equal "foo+")) + (with-clojure-buffer "(ns bar**baz$-_quux)" + (expect (clojure-find-ns) :to-equal "bar**baz$-_quux")) + (with-clojure-buffer "(ns aoc-2019.puzzles.day14)" + (expect (clojure-find-ns) :to-equal "aoc-2019.puzzles.day14"))) + (it "should support in-ns forms" + (with-clojure-buffer "(in-ns 'bar.baz)" + (expect (clojure-find-ns) :to-equal "bar.baz"))) + (it "should take the closest ns before point" + (with-clojure-buffer " (ns foo1) + +(ns foo2)" + (expect (clojure-find-ns) :to-equal "foo2")) + (with-clojure-buffer " (in-ns foo1) +(ns 'foo2) +(in-ns 'foo3) +| +(ns foo4)" + (re-search-backward "|") + (expect (clojure-find-ns) :to-equal "foo3")) + (with-clojure-buffer "(ns foo) +(ns-unmap *ns* 'map) +(ns.misleading 1 2 3)" + (expect (clojure-find-ns) :to-equal "foo"))) + (it "should skip leading garbage" + (with-clojure-buffer " (ns foo)" + (expect (clojure-find-ns) :to-equal "foo")) + (with-clojure-buffer "1(ns foo)" + (expect (clojure-find-ns) :to-equal "foo")) + (with-clojure-buffer "1 (ns foo)" + (expect (clojure-find-ns) :to-equal "foo")) + (with-clojure-buffer "1 +(ns foo)" + (expect (clojure-find-ns) :to-equal "foo")) + (with-clojure-buffer "[1] +(ns foo)" + (expect (clojure-find-ns) :to-equal "foo")) + (with-clojure-buffer "[1] (ns foo)" + (expect (clojure-find-ns) :to-equal "foo")) + (with-clojure-buffer "[1](ns foo)" + (expect (clojure-find-ns) :to-equal "foo")) + (with-clojure-buffer "(ns)(ns foo)" + (expect (clojure-find-ns) :to-equal "foo")) + (with-clojure-buffer "(ns )(ns foo)" + (expect (clojure-find-ns) :to-equal "foo"))) + (it "should ignore carriage returns" + (with-clojure-buffer "(ns \r\n foo)" + (expect (clojure-find-ns) :to-equal "foo")) + (with-clojure-buffer "(ns\r\n ^{:doc \"meta\r\n\"}\r\n foo\r\n)" + (expect (clojure-find-ns) :to-equal "foo")))) + +(describe "clojure-sort-ns" + (it "should sort requires in a basic ns" + (with-clojure-buffer "(ns my-app.core + (:require [rum.core :as rum] ;comment + [my-app.views [user-page :as user-page]]))" + (clojure-sort-ns) + (expect (buffer-string) :to-equal + "(ns my-app.core + (:require [my-app.views [user-page :as user-page]] + [rum.core :as rum] ;comment +))"))) + + (it "should sort requires in a basic ns with comments in the end" + (with-clojure-buffer "(ns my-app.core + (:require [rum.core :as rum] ;comment + [my-app.views [user-page :as user-page]] + ;;[comment2] +))" + (clojure-sort-ns) + (expect (buffer-string) :to-equal + "(ns my-app.core + (:require [my-app.views [user-page :as user-page]] + [rum.core :as rum] ;comment + + ;;[comment2] +))"))) + (it "should sort requires in ns with copyright disclamer and comments" + (with-clojure-buffer ";; Copyright (c) John Doe. All rights reserved. +;; The use and distribution terms for this software are covered by the +;; Eclipse Public License 1.0 (https://opensource.org/license/epl-1-0/) +(ns clojure.core + (:require + ;; The first comment + [foo] ;; foo comment + ;; Middle comment + [bar] ;; bar comment + ;; A last comment + ))" + (clojure-sort-ns) + (expect (buffer-string) :to-equal + ";; Copyright (c) John Doe. All rights reserved. +;; The use and distribution terms for this software are covered by the +;; Eclipse Public License 1.0 (https://opensource.org/license/epl-1-0/) +(ns clojure.core + (:require + ;; Middle comment + [bar] ;; bar comment + ;; The first comment + [foo] ;; foo comment + + ;; A last comment + ))"))) + + (it "should also sort imports in a ns" + (with-clojure-buffer "\n(ns my-app.core + (:require [my-app.views [front-page :as front-page]] + [my-app.state :refer [state]] ; Comments too. + ;; Some comments. + [rum.core :as rum] + [my-app.views [user-page :as user-page]] + my-app.util.api) + (:import java.io.Writer + [clojure.lang AFunction Atom MultiFn Namespace]))" + (clojure-mode) + (clojure-sort-ns) + (expect (buffer-string) :to-equal + "\n(ns my-app.core + (:require [my-app.state :refer [state]] ; Comments too. + my-app.util.api + [my-app.views [front-page :as front-page]] + [my-app.views [user-page :as user-page]] + ;; Some comments. + [rum.core :as rum]) + (:import [clojure.lang AFunction Atom MultiFn Namespace] + java.io.Writer))")))) + +(describe "clojure-toggle-ignore" + (when-refactoring-with-point-it "should add #_ to literals" + "[1 |2 3]" "[1 #_|2 3]" + (clojure-toggle-ignore)) + (when-refactoring-with-point-it "should work with point in middle of symbol" + "[foo b|ar baz]" "[foo #_b|ar baz]" + (clojure-toggle-ignore)) + (when-refactoring-with-point-it "should remove #_ after cursor" + "[1 |#_2 3]" "[1 |2 3]" + (clojure-toggle-ignore)) + (when-refactoring-with-point-it "should remove #_ before cursor" + "[#_:fo|o :bar :baz]" "[:fo|o :bar :baz]" + (clojure-toggle-ignore)) + (when-refactoring-with-point-it "should insert multiple #_" + "{:foo| 1 :bar 2 :baz 3}" + "{#_#_#_#_:foo| 1 :bar 2 :baz 3}" + (clojure-toggle-ignore 4)) + (when-refactoring-with-point-it "should remove multiple #_" + "{#_#_#_#_:foo| 1 :bar 2 :baz 3}" + "{#_#_:foo| 1 :bar 2 :baz 3}" + (clojure-toggle-ignore 2)) + (when-refactoring-with-point-it "should handle spaces and newlines" + "[foo #_ \n #_ \r\n b|ar baz]" "[foo b|ar baz]" + (clojure-toggle-ignore 2)) + (when-refactoring-with-point-it "should toggle entire string" + "[:div \"lorem ips|um text\"]" + "[:div #_\"lorem ips|um text\"]" + (clojure-toggle-ignore)) + (when-refactoring-with-point-it "should toggle regexps" + "[|#\".*\"]" + "[#_|#\".*\"]" + (clojure-toggle-ignore)) + (when-refactoring-with-point-it "should toggle collections" + "[foo |[bar baz]]" + "[foo #_|[bar baz]]" + (clojure-toggle-ignore)) + (when-refactoring-with-point-it "should toggle hash sets" + "[foo #|{bar baz}]" + "[foo #_#|{bar baz}]" + (clojure-toggle-ignore)) + (when-refactoring-with-point-it "should work on last-sexp" + "[foo '(bar baz)| quux]" + "[foo #_'(bar baz)| quux]" + (clojure-toggle-ignore)) + (when-refactoring-with-point-it "should insert newline before top-level form" + "|[foo bar baz]" + "#_ +|[foo bar baz]" + (clojure-toggle-ignore))) + +(describe "clojure-toggle-ignore-surrounding-form" + (when-refactoring-with-point-it "should toggle lists" + "(li|st [vector {map #{set}}])" + "#_\n(li|st [vector {map #{set}}])" + (clojure-toggle-ignore-surrounding-form)) + (when-refactoring-with-point-it "should toggle vectors" + "(list #_[vector| {map #{set}}])" + "(list [vector| {map #{set}}])" + (clojure-toggle-ignore-surrounding-form)) + (when-refactoring-with-point-it "should toggle maps" + "(list [vector #_ \n {map #{set}|}])" + "(list [vector {map #{set}|}])" + (clojure-toggle-ignore-surrounding-form)) + (when-refactoring-with-point-it "should toggle sets" + "(list [vector {map #{set|}}])" + "(list [vector {map #_#{set|}}])" + (clojure-toggle-ignore-surrounding-form)) + (when-refactoring-with-point-it "should work with numeric arg" + "(four (three (two (on|e)))" + "(four (three #_(two (on|e)))" + (clojure-toggle-ignore-surrounding-form 2)) + (when-refactoring-with-point-it "should remove #_ with numeric arg" + "(four #_(three (two (on|e)))" + "(four (three (two (on|e)))" + (clojure-toggle-ignore-surrounding-form 3))) + +(describe "clojure-toggle-ignore-defun" + (when-refactoring-with-point-it "should ignore defun with newline" + "(defn foo [x] + {:nested (in|c x)})" + "#_ +(defn foo [x] + {:nested (in|c x)})" + (clojure-toggle-ignore-defun))) + +(provide 'clojure-mode-util-test) + +;;; clojure-mode-util-test.el ends here diff --git a/clojure-ts-mode.el b/clojure-ts-mode.el index 10efd3e..4802d9e 100644 --- a/clojure-ts-mode.el +++ b/clojure-ts-mode.el @@ -1,13 +1,14 @@ ;;; clojure-ts-mode.el --- Major mode for Clojure code -*- lexical-binding: t; -*- -;; Copyright © 2022-2023 Danny Freeman +;; Copyright © 2022-2025 Danny Freeman, Bozhidar Batsov and contributors ;; ;; Authors: Danny Freeman -;; Maintainer: Danny Freeman +;; Bozhidar Batsov +;; Maintainer: Bozhidar Batsov ;; URL: http://github.com/clojure-emacs/clojure-ts-mode ;; Keywords: languages clojure clojurescript lisp -;; Version: 0.1.5 -;; Package-Requires: ((emacs "29")) +;; Version: 0.6.0-snapshot +;; Package-Requires: ((emacs "30.1")) ;; This file is not part of GNU Emacs. @@ -16,7 +17,7 @@ ;; Provides font-lock, indentation, and navigation for the ;; Clojure programming language (http://clojure.org). -;; For the tree-sitter grammar this mode is based on, +;; For the Tree-sitter grammar this mode is based on, ;; see https://github.com/sogaiu/tree-sitter-clojure. ;; Using clojure-ts-mode with paredit or smartparens is highly recommended. @@ -53,25 +54,27 @@ ;; Boston, MA 02110-1301, USA. ;;; Code: + (require 'treesit) -(require 'lisp-mnt) +(require 'align) +(require 'subr-x) (declare-function treesit-parser-create "treesit.c") +(declare-function treesit-node-eq "treesit.c") (declare-function treesit-node-type "treesit.c") +(declare-function treesit-node-parent "treesit.c") (declare-function treesit-node-child "treesit.c") (declare-function treesit-node-child-by-field-name "treesit.c") -(declare-function treesit-node-prev-sibling "treesit.c") (defgroup clojure-ts nil - "Major mode for editing Clojure code with tree-sitter." + "Major mode for editing Clojure code with Tree-sitter." :prefix "clojure-ts-" :group 'languages :link '(url-link :tag "GitHub" "https://github.com/clojure-emacs/clojure-ts-mode") :link '(emacs-commentary-link :tag "Commentary" "clojure-mode")) (defconst clojure-ts-mode-version - (eval-when-compile - (lm-version (or load-file-name buffer-file-name))) + "0.6.0-snapshot" "The current version of `clojure-ts-mode'.") (defcustom clojure-ts-comment-macro-font-lock-body nil @@ -87,11 +90,194 @@ itself." :package-version '(clojure-ts-mode . "0.1.3")) (defcustom clojure-ts-ensure-grammars t - "When non-nil, ensure required tree-sitter grammars are installed." + "When non-nil, ensure required Tree-sitter grammars are installed." :safe #'booleanp :type 'boolean :package-version '(clojure-ts-mode . "0.2.0")) +(defcustom clojure-ts-toplevel-inside-comment-form nil + "Eval top level forms inside comment forms instead of the comment form itself." + :type 'boolean + :safe #'booleanp + :package-version '(clojure-ts-mode . "0.2.1")) + +(defcustom clojure-ts-docstring-fill-column fill-column + "Value of `fill-column' to use when filling a docstring." + :type 'integer + :safe #'integerp + :package-version '(clojure-ts-mode . "0.2.3")) + +(defcustom clojure-ts-docstring-fill-prefix-width 2 + "Width of `fill-prefix' when filling a docstring. +The default value conforms with the de facto convention for +Clojure docstrings, aligning the second line with the opening +double quotes on the third column." + :type 'integer + :safe #'integerp + :package-version '(clojure-ts-mode . "0.2.3")) + +(defcustom clojure-ts-use-markdown-inline t + "When non-nil, use Markdown inline grammar for docstrings." + :type 'boolean + :safe #'booleanp + :package-version '(clojure-ts-mode . "0.2.3")) + +(defcustom clojure-ts-use-regex-parser t + "When non-nil, use separate grammar to highlight regex syntax." + :type 'boolean + :safe #'booleanp + :package-version '(clojure-ts-mode . "0.4")) + +(defcustom clojure-ts-clojurescript-use-js-parser t + "When non-nil, use JS grammar to highlight syntax in js* forms." + :type 'boolean + :safe #'booleanp + :package-version '(clojure-ts-mode . "0.5")) + +(defcustom clojure-ts-jank-use-cpp-parser t + "When non-nil, use C++ grammar to highlight syntax in native/raw forms." + :type 'boolean + :safe #'booleanp + :package-version '(clojure-ts-mode . "0.5")) + +(defcustom clojure-ts-auto-remap t + "When non-nil, redirect all `clojure-mode' buffers to `clojure-ts-mode'." + :safe #'booleanp + :type 'boolean + :package-version '(clojure-ts-mode . "0.3")) + +(defcustom clojure-ts-outline-variant 'comments + "Determines how `clojure-ts-mode' integrates with `outline-minor-mode'. + +If set to the symbol `comments', then top-level comments starting with +three or more semicolons will be treated as outline headings. If set to +`imenu', then def-like forms are treated as outline headings." + :safe #'symbolp + :type '(choice (const :tag "Use special comments" comments) + (const :tag "Use imenu" imenu)) + :package-version '(clojure-ts-mode . "0.4")) + +(defcustom clojure-ts-refactor-map-prefix "C-c C-r" + "Clojure refactor keymap prefix." + :type 'string + :package-version '(clojure-ts-mode . "0.4")) + +(defcustom clojure-ts-thread-all-but-last nil + "Non-nil means do not thread the last expression. + +This means that `clojure-ts-thread-first-all' and +`clojure-ts-thread-last-all' not thread the deepest sexp inside the +current sexp." + :package-version '(clojure-ts-mode . "0.4") + :safe #'booleanp + :type 'boolean) + +(defcustom clojure-ts-use-metadata-for-defn-privacy nil + "If nil, `clojure-ts-cycle-privacy' will use (defn- f []). + +If t, it will use (defn ^:private f [])." + :package-version '(clojure-ts-mode . "0.4") + :safe #'booleanp + :type 'boolean) + +(defcustom clojure-ts-align-reader-conditionals nil + "Whether to align reader conditionals, as if they were maps." + :package-version '(clojure-ts-mode . "0.4") + :safe #'booleanp + :type 'boolean) + +(defcustom clojure-ts-align-binding-forms + '("let" + "when-let" + "when-some" + "if-let" + "if-some" + "binding" + "loop" + "doseq" + "for" + "with-open" + "with-local-vars" + "with-redefs" + "clojure.core/let" + "clojure.core/when-let" + "clojure.core/when-some" + "clojure.core/if-let" + "clojure.core/if-some" + "clojure.core/binding" + "clojure.core/loop" + "clojure.core/doseq" + "clojure.core/for" + "clojure.core/with-open" + "clojure.core/with-local-vars" + "clojure.core/with-redefs") + "List of strings matching forms that have binding forms." + :package-version '(clojure-ts-mode . "0.4") + :safe #'listp + :type '(repeat string)) + +(defconst clojure-ts--align-separator-newline-regexp "^ *$") + +(defcustom clojure-ts-align-separator clojure-ts--align-separator-newline-regexp + "Separator passed to `align-region' when performing vertical alignment." + :package-version '(clojure-ts-mode . "0.4") + :type `(choice (const :tag "Make blank lines prevent vertical alignment from happening." + ,clojure-ts--align-separator-newline-regexp) + (other :tag "Allow blank lines to happen within a vertically-aligned expression." + entire))) + +(defcustom clojure-ts-align-cond-forms + '("condp" + "cond" + "cond->" + "cond->>" + "case" + "are" + "clojure.core/condp" + "clojure.core/cond" + "clojure.core/cond->" + "clojure.core/cond->>" + "clojure.core/case" + "clojure.core/are") + "List of strings identifying cond-like forms." + :package-version '(clojure-ts-mode . "0.4") + :safe #'listp + :type '(repeat string)) + +(defcustom clojure-ts-align-forms-automatically nil + "If non-nil, vertically align some forms automatically. + +Automatically means it is done as part of indenting code. This applies +to binding forms (`clojure-ts-align-binding-forms'), to cond +forms (`clojure-ts-align-cond-forms') and to map literals. For +instance, selecting a map a hitting +\\`\\[indent-for-tab-command]' will align the +values like this: + +{:some-key 10 + :key2 20}" + :package-version '(clojure-ts-mode . "0.4") + :safe #'booleanp + :type 'boolean) + +(defcustom clojure-ts-completion-enabled t + "Enable built-in completion feature." + :package-version '(clojure-ts-mode . "0.5") + :safe #'booleanp + :type 'boolean) + +(defvar clojure-ts-mode-remappings + '((clojure-mode . clojure-ts-mode) + (clojurescript-mode . clojure-ts-clojurescript-mode) + (clojurec-mode . clojure-ts-clojurec-mode) + (clojuredart-mode . clojure-ts-clojuredart-mode) + (jank-mode . clojure-ts-jank-mode) + (joker-mode . clojure-ts-joker-mode)) + "Alist of entries to `major-mode-remap-defaults'. + +See also `clojure-ts-activate-mode-remappings' and +`clojure-ts-definition-docstring-symbols'.") + (defvar clojure-ts--debug nil "Enables debugging messages, shows current node in mode-line. Only intended for use at development time.") @@ -138,11 +324,10 @@ Only intended for use at development time.") (modify-syntax-entry ?\\ "\\" table) ; escape table) - "Syntax table for clojure-ts-mode.") - + "Syntax table for `clojure-ts-mode'.") (defconst clojure-ts--builtin-dynamic-var-regexp - (eval-and-compile + (eval-when-compile (concat "^" (regexp-opt '("*1" "*2" "*3" "*agent*" @@ -159,7 +344,7 @@ Only intended for use at development time.") "$"))) (defconst clojure-ts--builtin-symbol-regexp - (eval-and-compile + (eval-when-compile (concat "^" (regexp-opt '("do" "if" "let*" "var" @@ -177,7 +362,7 @@ Only intended for use at development time.") "defmulti" "defn" "defn-" "defonce" "defprotocol" "defrecord" "defstruct" "deftype" "delay" "doall" "dorun" "doseq" "dosync" "dotimes" "doto" - "extend-protocol" "extend-type" + "extend-protocol" "extend-type" "extend" "for" "future" "gen-class" "gen-interface" "if-let" "if-not" "if-some" "import" "in-ns""io!" @@ -190,7 +375,9 @@ Only intended for use at development time.") "when" "when-first" "when-let" "when-not" "when-some" "while" "with-bindings" "with-in-str" "with-loading-context" "with-local-vars" "with-open" "with-out-str" "with-precision" - "with-redefs" "with-redefs-fn")) + "with-redefs" "with-redefs-fn" + ;; Commonly used clojure.test functions + "deftest" "deftest-" "is" "are" "testing")) "$"))) (defface clojure-ts-keyword-face @@ -201,244 +388,515 @@ Only intended for use at development time.") '((t (:inherit font-lock-string-face))) "Face used to font-lock Clojure character literals.") -(defconst clojure-ts--definition-symbol-regexp - (rx - line-start - (or (group (or "ns" "fn")) - (group "def" - (+ (or alnum - ;; What are valid characters for symbols? - ;; is a negative match better? - "-" "_" "!" "@" "#" "$" "%" "^" "&" - "*" "|" "?" "<" ">" "+" "=" ":")))) - line-end)) +(defun clojure-ts-symbol-regexp (symbols) + "Return a regular expression that matches one of SYMBOLS exactly." + (concat "^" (regexp-opt symbols) "$")) + +(defconst clojure-ts-function-docstring-symbols + (rx line-start + (or "definline" + "defmulti" + "defmacro" + "defn" + "defn-" + "defprotocol" + "ns") + line-end) + "Symbols that accept an optional docstring as their second argument.") + +(defconst clojure-ts-definition-docstring-symbols + (rx line-start "def" line-end) + "Symbols that accept an optional docstring as their second argument. +Any symbols added here should only treat their second argument as a docstring +if a third argument (the value) is provided. +\"def\" is the only builtin Clojure symbol that behaves like this.") (defconst clojure-ts--variable-definition-symbol-regexp - (eval-and-compile - (rx line-start (or "def" "defonce") line-end)) + (rx line-start (or "def" "defonce") line-end) "A regular expression matching a symbol used to define a variable.") (defconst clojure-ts--typedef-symbol-regexp - (eval-and-compile - (rx line-start + (rx line-start (or "defprotocol" "defmulti" "deftype" "defrecord" "definterface" "defmethod" "defstruct") - line-end)) - "A regular expression matching a symbol used to define a type") - -(defconst clojure-ts-type-symbol-regexp - (eval-and-compile - (rx line-start - (or "deftype" "defrecord" - ;; While not reifying, helps with doc strings - "defprotocol" "definterface" - "reify" "proxy" "extend-type" "extend-protocol") - line-end)) + line-end) + "A regular expression matching a symbol used to define a type.") + +(defconst clojure-ts--type-symbol-regexp + (rx line-start + (or "deftype" "defrecord" + ;; While not reifying, helps with doc strings + "defprotocol" "definterface" + "reify" "proxy" "extend-type" "extend-protocol") + line-end) "A regular expression matching a symbol used to define or instantiate a type.") (defconst clojure-ts--interface-def-symbol-regexp - (eval-and-compile - (rx line-start (or "defprotocol" "definterface") line-end)) + (rx line-start (or "defprotocol" "definterface") line-end) "A regular expression matching a symbol used to define an interface.") -(defun clojure-ts--docstring-query (capture-symbol) - "Return a query that captures docstrings with CAPTURE-SYMBOL." - `(;; Captures docstrings in def, defonce - ((list_lit :anchor (sym_lit) @def_symbol - :anchor (sym_lit) ; variable name - :anchor (str_lit) ,capture-symbol - :anchor (_)) ; the variable's value - (:match ,clojure-ts--variable-definition-symbol-regexp @def_symbol)) - ;; Captures docstrings in metadata of definitions - ((list_lit :anchor (sym_lit) @def_symbol - :anchor (sym_lit - (meta_lit - value: (map_lit - (kwd_lit) @doc-keyword - :anchor - (str_lit) ,capture-symbol)))) - ;; We're only supporting this on a fixed set of defining symbols - ;; Existing regexes don't encompass def and defn - ;; Naming another regex is very cumbersome. - (:match ,(regexp-opt '("def" "defonce" "defn" "defn-" "defmacro" "ns" - "defmulti" "definterface" "defprotocol" - "deftype" "defrecord" "defstruct")) - @def_symbol) - (:equal @doc-keyword ":doc")) - ;; Captures docstrings defn, defmacro, ns, and things like that - ((list_lit :anchor (sym_lit) @def_symbol - :anchor (sym_lit) ; function_name - :anchor (str_lit) ,capture-symbol) - (:match ,clojure-ts--definition-symbol-regexp @def_symbol)) - ;; Captures docstrings in defprotcol, definterface - ((list_lit :anchor (sym_lit) @def_symbol - (list_lit - :anchor (sym_lit) (vec_lit) :* - (str_lit) ,capture-symbol :anchor) - :*) - (:match ,clojure-ts--interface-def-symbol-regexp @def_symbol)))) - -(defvar clojure-ts--treesit-range-settings - (treesit-range-rules - :embed 'markdown_inline - :host 'clojure - (clojure-ts--docstring-query '@capture))) - -(defun clojure-ts--font-lock-settings (markdown-available) +(defun clojure-ts--docstring-query (capture-symbol &optional capture-quotes) + "Return a query that captures docstrings with CAPTURE-SYMBOL. + +By default produced query captures only strings content, if optional +CAPTURE-QUOTES argument is non-nil, then the entire string literals are +captured including quotes." + (let ((quotes-symbol (if capture-quotes + capture-symbol + '@_ignore))) + `(;; Captures docstrings in def + ((list_lit :anchor [(comment) (meta_lit) (old_meta_lit)] :* + :anchor (sym_lit) @_def_symbol + :anchor [(comment) (meta_lit) (old_meta_lit)] :* + ;; Variable name + :anchor (sym_lit) + :anchor [(comment) (meta_lit) (old_meta_lit)] :* + :anchor (str_lit (str_content) ,capture-symbol) ,quotes-symbol + ;; The variable's value + :anchor (_)) + (:match ,clojure-ts-definition-docstring-symbols + @_def_symbol)) + ;; Captures docstrings in metadata of definitions + ((list_lit :anchor [(comment) (meta_lit) (old_meta_lit)] :* + :anchor (sym_lit) @_def_symbol + :anchor (comment) :* + :anchor (meta_lit + value: (map_lit + (kwd_lit) @_doc-keyword + :anchor (str_lit (str_content) ,capture-symbol) ,quotes-symbol))) + ;; We're only supporting this on a fixed set of defining symbols + ;; Existing regexes don't encompass def and defn + ;; Naming another regex is very cumbersome. + (:match ,(clojure-ts-symbol-regexp + '("def" "defonce" "defn" "defn-" "defmacro" "ns" + "defmulti" "definterface" "defprotocol" + "deftest" "deftest-" + "deftype" "defrecord" "defstruct")) + @_def_symbol) + (:equal @_doc-keyword ":doc")) + ;; Captures docstrings defn, defmacro, ns, and things like that + ((list_lit :anchor [(comment) (meta_lit) (old_meta_lit)] :* + :anchor (sym_lit) @_def_symbol + :anchor [(comment) (meta_lit) (old_meta_lit)] :* + ;; Function_name + :anchor (sym_lit) + :anchor [(comment) (meta_lit) (old_meta_lit)] :* + :anchor (str_lit (str_content) ,capture-symbol) ,quotes-symbol) + (:match ,clojure-ts-function-docstring-symbols + @_def_symbol)) + ;; Captures docstrings in defprotcol, definterface + ((list_lit :anchor [(comment) (meta_lit) (old_meta_lit)] :* + :anchor (sym_lit) @_def_symbol + (list_lit :anchor (sym_lit) (vec_lit) :* + (str_lit (str_content) ,capture-symbol) ,quotes-symbol) + :*) + (:match ,clojure-ts--interface-def-symbol-regexp @_def_symbol))))) + +(defconst clojure-ts--match-docstring-query + (treesit-query-compile 'clojure (clojure-ts--docstring-query '@font-lock-doc-face t)) + "Precompiled query that matches a Clojure docstring.") + +(defun clojure-ts--treesit-range-settings (use-markdown-inline use-regex) + "Return value for `treesit-range-settings' for `clojure-ts-mode'. + +When USE-MARKDOWN-INLINE is non-nil, include range settings for +markdown-inline parser. + +When USE-REGEX is non-nil, include range settings for regex parser." + (append + (when use-markdown-inline + (treesit-range-rules + :embed 'markdown-inline + :host 'clojure + :local t + (clojure-ts--docstring-query '@capture))) + (when use-regex + (treesit-range-rules + :embed 'regex + :host 'clojure + :local t + '((regex_content) @capture))))) + +(defun clojure-ts--fontify-string (node override _start _end &optional _rest) + "Fontify string content NODE with `font-lock-string-face'. + +In order to support embedded syntax highlighting for JS in ClojureScript +and C++ in Jank we need to avoid fontifying string content in some +special forms, such as native/raw in Jank and js* in ClojureScript, +otherwise string face will interfere with embedded parser's faces. + +This function respects OVERRIDE argument by passing it to +`treesit-fontify-with-override'. + +START and END arguments that are passed to this function are not start +and end of the NODE, so we ignore them." + (let* ((prev (treesit-node-prev-sibling (treesit-node-parent node))) + ;; TODO: Seems jank has removed this syntax, so we might drop this + ;; after jank 1.0 gets released + ;; See https://github.com/jank-lang/jank/issues/24#issuecomment-2924460595 + (jank-native-p (and (derived-mode-p 'clojure-ts-jank-mode) + clojure-ts-jank-use-cpp-parser + (clojure-ts--symbol-node-p prev) + (string= (treesit-node-text prev) "native/raw"))) + (js-interop-p (and (derived-mode-p 'clojure-ts-clojurescript-mode) + clojure-ts-clojurescript-use-js-parser + (clojure-ts--symbol-node-p prev) + (string= (treesit-node-text prev) "js*")))) + (when (not (or jank-native-p js-interop-p)) + (treesit-fontify-with-override (treesit-node-start node) + (treesit-node-end node) + 'font-lock-string-face + override)))) + +(defconst clojure-ts--clojure-font-lock-queries + (treesit-font-lock-rules + :feature 'string + :language 'clojure + '((str_lit open: _ @font-lock-string-face + (str_content) @clojure-ts--fontify-string + close: _ @font-lock-string-face) + (regex_lit) @font-lock-regexp-face) + + :feature 'regex + :language 'clojure + :override t + '((regex_lit marker: _ @font-lock-property-face)) + + :feature 'number + :language 'clojure + '((num_lit) @font-lock-number-face) + + :feature 'constant + :language 'clojure + '([(bool_lit) (nil_lit)] @font-lock-constant-face) + + :feature 'char + :language 'clojure + '((char_lit) @clojure-ts-character-face) + + :feature 'keyword + :language 'clojure + '((kwd_ns) @font-lock-type-face + (kwd_name) @clojure-ts-keyword-face + (kwd_lit + marker: _ @clojure-ts-keyword-face + delimiter: _ :? @default)) + + ;; Highlight as built-in only if there is no namespace or namespace is + ;; `clojure.core'. + :feature 'builtin + :language 'clojure + `(((list_lit :anchor [(comment) (meta_lit) (old_meta_lit)] :* + :anchor (sym_lit !namespace name: (sym_name) @font-lock-keyword-face)) + (:match ,clojure-ts--builtin-symbol-regexp @font-lock-keyword-face)) + ((list_lit :anchor [(comment) (meta_lit) (old_meta_lit)] :* + :anchor (sym_lit namespace: ((sym_ns) @ns + (:equal "clojure.core" @ns)) + name: (sym_name) @font-lock-keyword-face)) + (:match ,clojure-ts--builtin-symbol-regexp @font-lock-keyword-face)) + ((anon_fn_lit :anchor [(comment) (meta_lit) (old_meta_lit)] :* + :anchor (sym_lit !namespace name: (sym_name) @font-lock-keyword-face)) + (:match ,clojure-ts--builtin-symbol-regexp @font-lock-keyword-face)) + ((anon_fn_lit :anchor [(comment) (meta_lit) (old_meta_lit)] :* + :anchor (sym_lit namespace: ((sym_ns) @ns + (:equal "clojure.core" @ns)) + name: (sym_name) @font-lock-keyword-face)) + (:match ,clojure-ts--builtin-symbol-regexp @font-lock-keyword-face)) + ((sym_name) @font-lock-builtin-face + (:match ,clojure-ts--builtin-dynamic-var-regexp @font-lock-builtin-face))) + + ;; Any function calls, not built-ins. + ;; This can give false positives (macros, quoted lists, namespace imports) + ;; but is a level 4 feature and never enabled by default. + :feature 'function + :language 'clojure + '((list_lit :anchor (sym_lit (sym_name) @font-lock-function-call-face))) + + :feature 'symbol + :language 'clojure + '((sym_ns) @font-lock-type-face) + + ;; How does this work for defns nested in other forms, not at the top level? + ;; Should I match against the source node to only hit the top level? Can that be expressed? + ;; What about valid usages like `(let [closed 1] (defn +closed [n] (+ n closed)))'?? + ;; No wonder the tree-sitter-clojure grammar only touches syntax, and not semantics + :feature 'definition ;; defn and defn like macros + :language 'clojure + `(((list_lit :anchor [(comment) (meta_lit) (old_meta_lit)] :* + :anchor (sym_lit (sym_name) @font-lock-keyword-face) + :anchor [(comment) (meta_lit) (old_meta_lit)] :* + :anchor (sym_lit (sym_name) @font-lock-function-name-face)) + (:match ,(rx-to-string + `(seq bol + (or + "fn" + "defn" + "defn-" + "defmulti" + "defmethod" + "deftest" + "deftest-" + "defmacro" + "definline" + "defonce") + eol)) + @font-lock-keyword-face)) + ((anon_fn_lit + marker: "#" @font-lock-property-face)) + ;; Methods implementation + ((list_lit + :anchor [(comment) (meta_lit) (old_meta_lit)] :* + :anchor ((sym_lit name: (sym_name) @def) + ((:match ,(rx-to-string + `(seq bol + (or + "defrecord" + "definterface" + "deftype" + "defprotocol") + eol)) + @def))) + :anchor [(comment) (meta_lit) (old_meta_lit)] :* + :anchor (sym_lit (sym_name) @font-lock-type-face) + (list_lit + (sym_lit name: (sym_name) @font-lock-function-name-face)))) + ((list_lit + ((sym_lit name: (sym_name) @def) + ((:match ,(rx-to-string + `(seq bol + (or "reify" + "extend-protocol" + "extend-type") + eol)) + @def))) + (list_lit + (sym_lit name: (sym_name) @font-lock-function-name-face)))) + ;; letfn + ((list_lit + ((sym_lit name: (sym_name) @symbol) + ((:equal "letfn" @symbol))) + (vec_lit + (list_lit + (sym_lit name: (sym_name) @font-lock-function-name-face)))))) + + :feature 'variable ;; def, defonce + :language 'clojure + `(((list_lit :anchor [(comment) (meta_lit) (old_meta_lit)] :* + :anchor (sym_lit (sym_name) @font-lock-keyword-face) + :anchor [(comment) (meta_lit) (old_meta_lit)] :* + :anchor (sym_lit (sym_name) @font-lock-variable-name-face)) + (:match ,clojure-ts--variable-definition-symbol-regexp @font-lock-keyword-face))) + + ;; Can we support declarations in the namespace form? + :feature 'type + :language 'clojure + `(;; Type Declarations + ((list_lit :anchor (sym_lit (sym_name) @def) + :anchor (sym_lit (sym_name) @font-lock-type-face)) + (:match ,clojure-ts--typedef-symbol-regexp @def)) + ;; Type Hints + (meta_lit + marker: "^" @font-lock-operator-face + value: (sym_lit (sym_name) @font-lock-type-face)) + (old_meta_lit + marker: "#^" @font-lock-operator-face + value: (sym_lit (sym_name) @font-lock-type-face)) + ;; Highlight namespace + ((list_lit :anchor (sym_lit (sym_name) @def) + :anchor (sym_lit (sym_name) @font-lock-type-face)) + (:equal "ns" @def))) + + :feature 'metadata + :language 'clojure + :override t + `((meta_lit + marker: "^" @font-lock-operator-face + value: (kwd_lit (kwd_name) @clojure-ts-keyword-face)) + (old_meta_lit + marker: "#^" @font-lock-operator-face + value: (kwd_lit (kwd_name) @clojure-ts-keyword-face))) + + :feature 'tagged-literals + :language 'clojure + :override t + '((tagged_or_ctor_lit marker: "#" @font-lock-preprocessor-face + tag: (sym_lit) @font-lock-preprocessor-face)) + + :feature 'doc + :language 'clojure + :override t + (clojure-ts--docstring-query '@font-lock-doc-face t) + + :feature 'quote + :language 'clojure + '((quoting_lit + marker: _ @font-lock-delimiter-face) + (var_quoting_lit + marker: _ @font-lock-delimiter-face) + (syn_quoting_lit + marker: _ @font-lock-delimiter-face) + (unquoting_lit + marker: _ @font-lock-delimiter-face) + (unquote_splicing_lit + marker: _ @font-lock-delimiter-face) + (var_quoting_lit + marker: _ @font-lock-delimiter-face)) + + :feature 'bracket + :language 'clojure + '((["(" ")" "[" "]" "{" "}"]) @font-lock-bracket-face + (set_lit :anchor "#" @font-lock-bracket-face)) + + :feature 'comment + :language 'clojure + :override t + `((comment) @font-lock-comment-face + (dis_expr + marker: "#_" @font-lock-comment-delimiter-face + meta: (meta_lit) :* @font-lock-comment-face + value: _ @font-lock-comment-face) + (,(append + '(list_lit :anchor (sym_lit) @font-lock-comment-delimiter-face) + (when clojure-ts-comment-macro-font-lock-body + '(_ :* @font-lock-comment-face))) + (:match "^\\(\\(clojure.core/\\)?comment\\)$" @font-lock-comment-delimiter-face))) + + :feature 'deref ;; not part of clojure-mode, but a cool idea? + :language 'clojure + '((derefing_lit + marker: "@" @font-lock-warning-face)))) + +(defvar clojure-ts--clojure-extra-queries nil + "Pre-compiled Tree-sitter queries produced from `clojure-ts-extra-def-forms'.") + +(defun clojure-ts--compute-extra-def-queries (syms) + "Comute font lock rules for extra def forms. + +If SYMS are not provided, return nil. If SYMS are provided, this +function returns compiled font lock rules that should be assigned to +`clojure-ts--clojure-extra-queries' variable. + +This function is called when the `clojure-ts-extra-def-forms' variable +is customized using setopt or the Emacs customization interface. It is +also called when file-local variables are updated. This ensures that +updated indentation rules are always precalculated." + (when syms + (treesit-font-lock-rules + :feature 'definition + :language 'clojure + `(((list_lit :anchor [(comment) (meta_lit) (old_meta_lit)] :* + :anchor (sym_lit (sym_name) @font-lock-keyword-face) + :anchor [(comment) (meta_lit) (old_meta_lit)] :* + :anchor (sym_lit (sym_name) @font-lock-function-name-face)) + (:match ,(clojure-ts-symbol-regexp syms) + @font-lock-keyword-face))) + + ;; NOTE: Here we also define queries to fontify docstrings in custom extra + ;; defn forms, but Markdown syntax won't work here, because it's not a part + ;; of range settings. + :feature 'doc + :language 'clojure + :override t + `(((list_lit :anchor [(comment) (meta_lit) (old_meta_lit)] :* + :anchor (sym_lit) @_def_symbol + :anchor [(comment) (meta_lit) (old_meta_lit)] :* + ;; Function_name + :anchor (sym_lit) + :anchor [(comment) (meta_lit) (old_meta_lit)] :* + :anchor (str_lit) @font-lock-doc-face) + (:match ,(clojure-ts-symbol-regexp syms) + @_def_symbol)))))) + +(defun clojure-ts--set-extra-def-queries (symbol value) + "Setter function for `clojure-ts-extra-def-forms' variable. + +Sets SYMBOL's top-level default value to VALUE and updates the +`clojure-ts--clojure-extra-queries' in all `clojure-ts-mode' +buffers, if any exist. + +NOTE: This function is not meant to be called directly." + (set-default-toplevel-value symbol value) + ;; Update value in every `clojure-ts-mode' buffer. + (let ((new-value (clojure-ts--compute-extra-def-queries value))) + (dolist (buf (buffer-list)) + (when (buffer-local-boundp 'clojure-ts--clojure-extra-queries buf) + (setq clojure-ts--clojure-extra-queries new-value))))) + +(defcustom clojure-ts-extra-def-forms nil + "List of forms that should be fontified the same way as defn." + :package-version '(clojure-ts-mode . "0.5") + :safe #'listp + :type '(repeat string) + :set #'clojure-ts--set-extra-def-queries) + +(defconst clojure-ts--markdown-font-lock-queries + (treesit-font-lock-rules + :feature 'doc + :language 'markdown-inline + :override 'prepend + `([((image_description) @link) + ((link_destination) @font-lock-constant-face) + ((code_span) @font-lock-constant-face) + ((emphasis) @underline) + ((strong_emphasis) @bold) + (inline_link (link_text) @link) + (inline_link (link_destination) @font-lock-constant-face) + (shortcut_link (link_text) @link)]))) + +(defconst clojure-ts--regex-font-lock-queries + ;; Queries are adapted from + ;; https://github.com/tree-sitter/tree-sitter-regex/blob/v0.24.3/queries/highlights.scm. + (treesit-font-lock-rules + :feature 'regex + :language 'regex + :override t + '((["(" + ")" + "(?" + "(?:" + "(?<" + "(?P<" + "(?P=" + ">" + "[" + "]" + "{" + "}" + "[:" + ":]"] + @font-lock-regexp-grouping-construct) + (["*" + "+" + "?" + "|" + "=" + "!"] + @font-lock-property-name-face) + ((group_name) @font-lock-variable-name-face) + ((count_quantifier + [(decimal_digits) @font-lock-number-face + "," @font-lock-delimiter-face])) + ((flags) @font-lock-constant-face) + ((character_class + ["^" @font-lock-escape-face + (class_range "-" @font-lock-escape-face)])) + ((identity_escape) @font-lock-builtin-face) + ([(start_assertion) (end_assertion)] @font-lock-constant-face)))) + +(defun clojure-ts--font-lock-settings (markdown-available regex-available) "Return font lock settings suitable for use in `treesit-font-lock-settings'. + When MARKDOWN-AVAILABLE is non-nil, includes rules for highlighting docstrings -with the markdown_inline grammar." - (append - (treesit-font-lock-rules - :feature 'string - :language 'clojure - '((str_lit) @font-lock-string-face - (regex_lit) @font-lock-regexp-face) - - :feature 'regex - :language 'clojure - :override t - '((regex_lit marker: _ @font-lock-property-face)) - - :feature 'number - :language 'clojure - '((num_lit) @font-lock-number-face) - - :feature 'constant - :language 'clojure - '([(bool_lit) (nil_lit)] @font-lock-constant-face) - - :feature 'char - :language 'clojure - '((char_lit) @clojure-ts-character-face) - - :feature 'keyword - :language 'clojure - '((kwd_ns) @font-lock-type-face - (kwd_name) @clojure-ts-keyword-face - (kwd_lit - marker: _ @clojure-ts-keyword-face - delimiter: _ :? @default)) - - :feature 'builtin - :language 'clojure - `(((list_lit :anchor (sym_lit (sym_name) @font-lock-keyword-face)) - (:match ,clojure-ts--builtin-symbol-regexp @font-lock-keyword-face)) - ((sym_name) @font-lock-builtin-face - (:match ,clojure-ts--builtin-dynamic-var-regexp @font-lock-builtin-face))) - - ;; Any function calls, not built-ins. - ;; This can give false positives (macros, quoted lists, namespace imports) - ;; but is a level 4 feature and never enabled by default. - :feature 'function - :language 'clojure - '((list_lit :anchor (sym_lit (sym_name) @font-lock-function-call-face))) - - :feature 'symbol - :language 'clojure - '((sym_ns) @font-lock-type-face) - - ;; How does this work for defns nested in other forms, not at the top level? - ;; Should I match against the source node to only hit the top level? Can that be expressed? - ;; What about valid usages like `(let [closed 1] (defn +closed [n] (+ n closed)))'?? - ;; No wonder the tree-sitter-clojure grammar only touches syntax, and not semantics - :feature 'definition ;; defn and defn like macros - :language 'clojure - `(((list_lit :anchor (sym_lit (sym_name) @def) - :anchor (sym_lit (sym_name) @font-lock-function-name-face)) - (:match ,clojure-ts--definition-symbol-regexp @def)) - ((anon_fn_lit - marker: "#" @font-lock-property-face))) - - :feature 'variable ;; def, defonce - :language 'clojure - `(((list_lit :anchor (sym_lit (sym_name) @def) - :anchor (sym_lit (sym_name) @font-lock-variable-name-face)) - (:match ,clojure-ts--variable-definition-symbol-regexp @def))) - - ;; Can we support declarations in the namespace form? - :feature 'type - :language 'clojure - `(;; Type Declarations - ((list_lit :anchor (sym_lit (sym_name) @def) - :anchor (sym_lit (sym_name) @font-lock-type-face)) - (:match ,clojure-ts--typedef-symbol-regexp @def)) - ;; Type Hints - (meta_lit - marker: "^" @font-lock-operator-face - value: (sym_lit (sym_name) @font-lock-type-face)) - (old_meta_lit - marker: "#^" @font-lock-operator-face - value: (sym_lit (sym_name) @font-lock-type-face))) - - :feature 'metadata - :language 'clojure - :override t - `((meta_lit - marker: "^" @font-lock-operator-face - value: (kwd_lit (kwd_name) @font-lock-property-name-face)) - (old_meta_lit - marker: "#^" @font-lock-operator-face - value: (kwd_lit (kwd_name) @font-lock-property-name-face))) - - :feature 'tagged-literals - :language 'clojure - :override t - '((tagged_or_ctor_lit marker: "#" @font-lock-preprocessor-face - tag: (sym_lit) @font-lock-preprocessor-face)) - - :feature 'doc - :language 'clojure - :override t - (clojure-ts--docstring-query '@font-lock-doc-face)) - - (when markdown-available - (treesit-font-lock-rules - :feature 'doc - :language 'markdown_inline - :override t - `((inline - (code_span (code_span_delimiter) :* @font-lock-delimiter-face) - @font-lock-constant-face)))) - - (treesit-font-lock-rules - :feature 'quote - :language 'clojure - '((quoting_lit - marker: _ @font-lock-delimiter-face) - (var_quoting_lit - marker: _ @font-lock-delimiter-face) - (syn_quoting_lit - marker: _ @font-lock-delimiter-face) - (unquoting_lit - marker: _ @font-lock-delimiter-face) - (unquote_splicing_lit - marker: _ @font-lock-delimiter-face) - (var_quoting_lit - marker: _ @font-lock-delimiter-face)) - - :feature 'bracket - :language 'clojure - '((["(" ")" "[" "]" "{" "}"]) @font-lock-bracket-face - (set_lit :anchor "#" @font-lock-bracket-face)) - - :feature 'comment - :language 'clojure - :override t - `((comment) @font-lock-comment-face - (dis_expr - marker: "#_" @font-lock-comment-delimiter-face - value: _ @font-lock-comment-face) - (,(append - '(list_lit :anchor (sym_lit) @font-lock-comment-delimiter-face) - (when clojure-ts-comment-macro-font-lock-body - '(_ :* @font-lock-comment-face))) - (:match "^\\(\\(clojure.core/\\)?comment\\)$" @font-lock-comment-delimiter-face))) - - :feature 'deref ;; not part of clojure-mode, but a cool idea? - :language 'clojure - '((derefing_lit - marker: "@" @font-lock-warning-face))))) +with the markdown-inline grammar. + +When REGEX-AVAILABLE is non-nil, includes rules for highlighting regex +literals with regex grammar." + (append clojure-ts--clojure-font-lock-queries + clojure-ts--clojure-extra-queries + (when markdown-available + clojure-ts--markdown-font-lock-queries) + (when regex-available + clojure-ts--regex-font-lock-queries))) ;; Node predicates @@ -446,6 +904,18 @@ with the markdown_inline grammar." "Return non-nil if NODE is a Clojure list." (string-equal "list_lit" (treesit-node-type node))) +(defun clojure-ts--vec-node-p (node) + "Return non-nil if NODE is a Clojure vector." + (string-equal "vec_lit" (treesit-node-type node))) + +(defun clojure-ts--anon-fn-node-p (node) + "Return non-nil if NODE is a Clojure function literal." + (string-equal "anon_fn_lit" (treesit-node-type node))) + +(defun clojure-ts--opening-paren-node-p (node) + "Return non-nil if NODE is an opening paren." + (string-equal "(" (treesit-node-text node))) + (defun clojure-ts--symbol-node-p (node) "Return non-nil if NODE is a Clojure symbol." (string-equal "sym_lit" (treesit-node-type node))) @@ -458,16 +928,53 @@ with the markdown_inline grammar." "Return non-nil if NODE is a Clojure keyword." (string-equal "kwd_lit" (treesit-node-type node))) +(defun clojure-ts--metadata-node-p (node) + "Return non-nil if NODE is a Clojure metadata node." + (or (string-equal "meta_lit" (treesit-node-type node)) + (string-equal "old_meta_lit" (treesit-node-type node)))) + +(defun clojure-ts--var-node-p (node) + "Return non-nil if NODE is a var (eg. #\\'foo)." + (string-equal "var_quoting_lit" (treesit-node-type node))) + (defun clojure-ts--named-node-text (node) "Gets the name of a symbol or keyword NODE. This does not include the NODE's namespace." (treesit-node-text (treesit-node-child-by-field-name node "name"))) +(defun clojure-ts--node-namespace-text (node) + "Gets the namespace of a symbol or keyword NODE. + +If there is no namespace, returns nil." + (treesit-node-text (treesit-node-child-by-field-name node "namespace"))) + (defun clojure-ts--symbol-named-p (expected-symbol-name node) "Return non-nil if NODE is a symbol with text matching EXPECTED-SYMBOL-NAME." (and (clojure-ts--symbol-node-p node) (string-equal expected-symbol-name (clojure-ts--named-node-text node)))) +(defun clojure-ts--node-child-skip-metadata (node n) + "Return the Nth child of NODE like `treesit-node-child', sans metadata. +Skip the optional metadata node at pos 0 if present." + (let ((first-child (treesit-node-child node 0 t))) + (treesit-node-child + node + (if (clojure-ts--metadata-node-p first-child) + (1+ n) + n) + t))) + +(defun clojure-ts--first-value-child (node) + "Return the first value child of the given NODE. + +In the syntax tree, there are a few types of possible child nodes: +unnamed standalone nodes (e.g., comments), anonymous nodes (e.g., +opening or closing parentheses), and named nodes. Named nodes are +standalone nodes that are labeled by a specific name. The most common +names are meta and value. This function skips any unnamed, anonymous, +and metadata nodes and returns the first value node." + (treesit-node-child-by-field-name node "value")) + (defun clojure-ts--symbol-matches-p (symbol-regexp node) "Return non-nil if NODE is a symbol that matches SYMBOL-REGEXP." (and (clojure-ts--symbol-node-p node) @@ -488,23 +995,39 @@ like \"defn\". See `clojure-ts--definition-node-p' when an exact match is possible." (and (clojure-ts--list-node-p node) - (let* ((child (treesit-node-child node 0 t)) - (child-txt (clojure-ts--named-node-text child))) + (let* ((child (clojure-ts--node-child-skip-metadata node 0)) + (child-txt (clojure-ts--named-node-text child)) + (name-sym (clojure-ts--node-child-skip-metadata node 1))) (and (clojure-ts--symbol-node-p child) + (clojure-ts--symbol-node-p name-sym) (string-match-p definition-type-regexp child-txt))))) +(defun clojure-ts--kwd-definition-node-match-p (node) + "Return non-nil if the NODE is a keyword definition." + (and (clojure-ts--list-node-p node) + (let* ((child (clojure-ts--node-child-skip-metadata node 0)) + (child-txt (clojure-ts--named-node-text child)) + (child-ns (clojure-ts--node-namespace-text child)) + (name-kwd (clojure-ts--node-child-skip-metadata node 1))) + (and child-ns + (clojure-ts--symbol-node-p child) + (clojure-ts--keyword-node-p name-kwd) + (string-equal child-txt "def"))))) + (defun clojure-ts--standard-definition-node-name (node) "Return the definition name for the given NODE. -Returns nil if NODE is not a list with symbols as the first two children. -For example the node representing the expression (def foo 1) would return foo. -The node representing (ns user) would return user. -Does not does any matching on the first symbol (def, defn, etc), so identifying -that a node is a definition is intended to be done elsewhere. + +Return nil if NODE is not a list with symbols as the first two +children. For example the node representing the expression (def foo 1) +would return foo. The node representing (ns user) would return user. +Does not do any matching on the first symbol (def, defn, etc), so +identifying that a node is a definition is intended to be done +elsewhere. Can be called directly, but intended for use as `treesit-defun-name-function'." (when (and (clojure-ts--list-node-p node) - (clojure-ts--symbol-node-p (treesit-node-child node 0 t))) - (let ((sym (treesit-node-child node 1 t))) + (clojure-ts--symbol-node-p (clojure-ts--node-child-skip-metadata node 0))) + (let ((sym (clojure-ts--node-child-skip-metadata node 1))) (when (clojure-ts--symbol-node-p sym) ;; Extracts ns and name, and recreates the full var name. ;; We can't just get the node-text of the full symbol because @@ -515,8 +1038,23 @@ Can be called directly, but intended for use as `treesit-defun-name-function'." (concat (treesit-node-text ns) "/" (treesit-node-text name)) (treesit-node-text name))))))) +(defun clojure-ts--kwd-definition-node-name (node) + "Return the keyword name for the given NODE. + +Return nil if NODE is not a list where the first element is a symbol +and the second is a keyword. For example, a node representing the +expression (s/def ::foo int?) would return foo. + +Can be called directly, but intended for use as +`treesit-defun-name-function'." + (when (and (clojure-ts--list-node-p node) + (clojure-ts--symbol-node-p (clojure-ts--node-child-skip-metadata node 0))) + (let ((kwd (clojure-ts--node-child-skip-metadata node 1))) + (when (clojure-ts--keyword-node-p kwd) + (treesit-node-text (treesit-node-child-by-field-name kwd "name")))))) + (defvar clojure-ts--function-type-regexp - (rx string-start (or "defn" "defmethod") string-end) + (rx string-start (or (seq "defn" (opt "-")) "defmethod" "deftest") string-end) "Regular expression for matching definition nodes that resemble functions.") (defun clojure-ts--function-node-p (node) @@ -541,13 +1079,13 @@ Includes a dispatch value when applicable (defmethods)." "Return non-nil if NODE is a ns form." (clojure-ts--definition-node-p "ns" node)) -(defvar clojure-ts--variable-type-regexp +(defvar clojure-ts--variable-definition-type-regexp (rx string-start (or "def" "defonce") string-end) "Regular expression for matching definition nodes that resemble variables.") -(defun clojure-ts--variable-node-p (node) +(defun clojure-ts--variable-definition-node-p (node) "Return non-nil if NODE is a def or defonce form." - (clojure-ts--definition-node-match-p clojure-ts--variable-type-regexp node)) + (clojure-ts--definition-node-match-p clojure-ts--variable-definition-type-regexp node)) (defvar clojure-ts--class-type-regexp (rx string-start (or "deftype" "defrecord" "defstruct") string-end) @@ -565,20 +1103,37 @@ Includes a dispatch value when applicable (defmethods)." "Return non-nil if NODE represents a protocol or interface definition." (clojure-ts--definition-node-match-p clojure-ts--interface-type-regexp node)) - (defvar clojure-ts--imenu-settings `(("Namespace" "list_lit" clojure-ts--ns-node-p) ("Function" "list_lit" clojure-ts--function-node-p ;; Used instead of treesit-defun-name-function. clojure-ts--function-node-name) ("Macro" "list_lit" clojure-ts--defmacro-node-p) - ("Variable" "list_lit" clojure-ts--variable-node-p) + ("Variable" "list_lit" clojure-ts--variable-definition-node-p) ("Interface" "list_lit" clojure-ts--interface-node-p) - ("Class" "list_lit" clojure-ts--class-node-p)) + ("Class" "list_lit" clojure-ts--class-node-p) + ("Keyword" + "list_lit" + clojure-ts--kwd-definition-node-match-p + clojure-ts--kwd-definition-node-name)) "The value for `treesit-simple-imenu-settings'. By default `treesit-defun-name-function' is used to extract definition names. See `clojure-ts--standard-definition-node-name' for the implementation used.") +;;; Outline settings + +(defun clojure-ts--outline-predicate (node) + "Return TRUE if NODE is an outline heading comment." + (and (string= (treesit-node-type node) "comment") + (string-match-p "^\\(?:;;;;* \\).*" (treesit-node-text node)))) + +(defun clojure-ts--outline-level () + "Return the current level of the outline heading at point." + (when-let* ((node (treesit-thing-at (point) #'clojure-ts--outline-predicate)) + (node-text (treesit-node-text node))) + (string-match ";;\\(;+\\) " node-text) + (- (match-end 1) (match-beginning 1)))) + (defcustom clojure-ts-indent-style 'semantic "Automatic indentation style to use when mode `clojure-ts-mode' is run. @@ -622,75 +1177,302 @@ The possible values for this variable are ((parent-is "list_lit") parent 1) ((parent-is "set_lit") parent 2)))) -(defvar clojure-ts--symbols-with-body-expressions-regexp - (eval-and-compile - (rx (or - ;; Match def* symbols, - ;; we also explicitly do not match symbols beginning with - ;; "default" "deflate" and "defer", like cljfmt - (and line-start "def") - ;; Match with-* symbols - (and line-start "with-") - ;; Exact matches - (and line-start - (or "alt!" "alt!!" "are" "as->" - "binding" "bound-fn" - "case" "catch" "comment" "cond" "condp" "cond->" "cond->>" - "delay" "do" "doseq" "dotimes" "doto" - "extend" "extend-protocol" "extend-type" - "fdef" "finally" "fn" "for" "future" - "go" "go-loop" - "if" "if-let" "if-not" "if-some" - "let" "letfn" "locking" "loop" - "match" "ns" "proxy" "reify" "struct-map" - "testing" "thread" "try" - "use-fixtures" - "when" "when-first" "when-let" "when-not" "when-some" "while") - line-end)))) - "A regex to match symbols that are functions/macros with a body argument. -Taken from cljfmt: -https://github.com/weavejester/cljfmt/blob/fb26b22f569724b05c93eb2502592dfc2de898c3/cljfmt/resources/cljfmt/indents/clojure.clj") +(defvar clojure-ts--semantic-indent-rules-defaults + '(("alt!" . ((:block 0))) + ("alt!!" . ((:block 0))) + ("comment" . ((:block 0))) + ("cond" . ((:block 0))) + ("delay" . ((:block 0))) + ("do" . ((:block 0))) + ("finally" . ((:block 0))) + ("future" . ((:block 0))) + ("go" . ((:block 0))) + ("thread" . ((:block 0))) + ("try" . ((:block 0))) + ("with-out-str" . ((:block 0))) + ("defprotocol" . ((:block 1) (:inner 1))) + ("definterface" . ((:block 1) (:inner 1))) + ("binding" . ((:block 1))) + ("case" . ((:block 1))) + ("cond->" . ((:block 1))) + ("cond->>" . ((:block 1))) + ("doseq" . ((:block 1))) + ("dotimes" . ((:block 1))) + ("doto" . ((:block 1))) + ("extend" . ((:block 1))) + ("extend-protocol" . ((:block 1) (:inner 1))) + ("extend-type" . ((:block 1) (:inner 1))) + ("for" . ((:block 1))) + ("go-loop" . ((:block 1))) + ("if" . ((:block 1))) + ("if-let" . ((:block 1))) + ("if-not" . ((:block 1))) + ("if-some" . ((:block 1))) + ("let" . ((:block 1))) + ("letfn" . ((:block 1) (:inner 2 0))) + ("locking" . ((:block 1))) + ("loop" . ((:block 1))) + ("match" . ((:block 1))) + ("ns" . ((:block 1))) + ("struct-map" . ((:block 1))) + ("testing" . ((:block 1))) + ("when" . ((:block 1))) + ("when-first" . ((:block 1))) + ("when-let" . ((:block 1))) + ("when-not" . ((:block 1))) + ("when-some" . ((:block 1))) + ("while" . ((:block 1))) + ("with-local-vars" . ((:block 1))) + ("with-open" . ((:block 1))) + ("with-precision" . ((:block 1))) + ("with-redefs" . ((:block 1))) + ("defrecord" . ((:block 2) (:inner 1))) + ("deftype" . ((:block 2) (:inner 1))) + ("are" . ((:block 2))) + ("as->" . ((:block 2))) + ("catch" . ((:block 2))) + ("condp" . ((:block 2))) + ("bound-fn" . ((:inner 0))) + ("def" . ((:inner 0))) + ("defmacro" . ((:inner 0))) + ("defmethod" . ((:inner 0))) + ("defmulti" . ((:inner 0))) + ("defn" . ((:inner 0))) + ("defn-" . ((:inner 0))) + ("defonce" . ((:inner 0))) + ("deftest" . ((:inner 0))) + ("fdef" . ((:inner 0))) + ("fn" . ((:inner 0))) + ("reify" . ((:inner 0) (:inner 1))) + ("proxy" . ((:block 2) (:inner 1))) + ("use-fixtures" . ((:inner 0)))) + "Default semantic indentation rules. + +The format reflects cljfmt indentation rules. All the default rules are +aligned with +https://github.com/weavejester/cljfmt/blob/0.13.0/cljfmt/resources/cljfmt/indents/clojure.clj") + +(defvar-local clojure-ts--semantic-indent-rules-cache nil) + +(defun clojure-ts--compute-semantic-indentation-rules-cache (rules) + "Compute the combined semantic indentation rules cache. + +If RULES are not provided, this function computes the union of +`clojure-ts-semantic-indent-rules' and +`clojure-ts--semantic-indent-rules-defaults', prioritizing user-defined +rules. If RULES are provided, this function uses them instead of +`clojure-ts-semantic-indent-rules'. + +This function is called when the `clojure-ts-semantic-indent-rules' +variable is customized using setopt or the Emacs customization +interface. It is also called when file-local variables are updated. +This ensures that updated indentation rules are always precalculated." + (seq-union rules + clojure-ts--semantic-indent-rules-defaults + (lambda (e1 e2) (equal (car e1) (car e2))))) + +(defun clojure-ts--set-semantic-indent-rules (symbol value) + "Setter function for `clojure-ts-semantic-indent-rules' variable. + +Sets SYMBOL's top-level default value to VALUE and updates the +`clojure-ts--semantic-indent-rules-cache' in all `clojure-ts-mode' +buffers, if any exist. + +NOTE: This function is not meant to be called directly." + (set-default-toplevel-value symbol value) + ;; Update cache in every `clojure-ts-mode' buffer. + (let ((new-cache (clojure-ts--compute-semantic-indentation-rules-cache value))) + (dolist (buf (buffer-list)) + (when (buffer-local-boundp 'clojure-ts--semantic-indent-rules-cache buf) + (setq clojure-ts--semantic-indent-rules-cache new-cache))))) + +(defcustom clojure-ts-semantic-indent-rules nil + "Custom rules to extend default indentation rules for `semantic' style. + +Each rule is an alist entry which looks like `(\"symbol-name\" +. (rule-type rule-value))', where rule-type is one either `:block' or +`:inner' and rule-value is an integer. The semantic is similar to +cljfmt indentation rules. + +Default set of rules is defined in +`clojure-ts--semantic-indent-rules-defaults'." + :safe #'listp + :type '(alist :key-type string + :value-type (repeat (choice (list (choice (const :tag "Block indentation rule" :block) + (const :tag "Inner indentation rule" :inner)) + integer) + (list (const :tag "Inner indentation rule" :inner) + integer + integer)))) + :package-version '(clojure-ts-mode . "0.3") + :set #'clojure-ts--set-semantic-indent-rules) + +(defun clojure-ts--match-block-0-body (bol first-child) + "Match if expression body is not at the same line as FIRST-CHILD. + +If there is no body, check that BOL is not at the same line." + (let* ((body-pos (if-let* ((body (treesit-node-next-sibling first-child))) + (treesit-node-start body) + bol))) + (< (line-number-at-pos (treesit-node-start first-child)) + (line-number-at-pos body-pos)))) + +(defun clojure-ts--node-pos-match-block (node parent bol block) + "Return TRUE if NODE index in the PARENT matches requested BLOCK. + +NODE might be nil (when we insert an empty line for example), in this +case we look for next available child node in the PARENT after BOL +position. + +The first node in the expression is usually an opening paren, the last +node is usually a closing paren (unless some automatic parens mode is +not enabled). If requested BLOCK is 1, the NODE index should be at +least 3 (first node is opening paren, second node is matched symbol, +third node is first argument, and the rest is body which should be +indented.)" + (if node + (> (treesit-node-index node) (1+ block)) + (when-let* ((node-after-bol (treesit-node-first-child-for-pos parent bol))) + (> (treesit-node-index node-after-bol) (1+ block))))) + +(defvar clojure-ts-get-indent-function nil + "Function to get the indent spec of a symbol. + +This function should take one argument, the name of the symbol as a +string. This name will be exactly as it appears in the buffer, so it +might start with a namespace alias. + +The returned value is expected to be the same as +`clojure-get-indent-function' from `clojure-mode' for compatibility +reasons.") + +(defun clojure-ts--unwrap-dynamic-spec (spec current-depth) + "Recursively unwrap SPEC, incrementally increasing the CURRENT-DEPTH. + +This function accepts a list SPEC, like ((:defn)) and produce a proper +indent rule. For example, ((:defn)) is converted to (:inner 2), +and (:defn) is converted to (:inner 1)." + (if (consp spec) + (clojure-ts--unwrap-dynamic-spec (car spec) (1+ current-depth)) + (cond + ((equal spec :defn) (list :inner current-depth)) + (t nil)))) + +(defun clojure-ts--dynamic-indent-for-symbol (sym &optional ns) + "Return the dynamic indentation specification for SYM, if found. + +If the function `clojure-ts-get-indent-function' is defined, call it and +produce a valid indentation specification from its return value. + +The `clojure-ts-get-indent-function' should return an indentation +specification compatible with `clojure-mode', which will then be +converted to a suitable `clojure-ts-mode' specification. + +For example, (1 ((:defn)) nil) is converted to ((:block 1) (:inner 2)). + +If NS is defined, then the fully qualified symbol is passed to +`clojure-ts-get-indent-function'." + (when (and sym (functionp clojure-ts-get-indent-function)) + (let* ((full-symbol (if ns + (concat ns "/" sym) + sym)) + (spec (funcall clojure-ts-get-indent-function full-symbol))) + (if (integerp spec) + (list (list :block spec)) + (when (sequencep spec) + (thread-last spec + (seq-map (lambda (el) + (cond + ((integerp el) (list :block el)) + ((equal el :defn) (list :inner 0)) + ((consp el) (clojure-ts--unwrap-dynamic-spec el 0)) + (t nil)))) + (seq-remove #'null) + ;; Always put `:block' to the beginning. + (seq-sort (lambda (spec1 _spec2) + (equal (car spec1) :block))))))))) + +(defun clojure-ts--find-semantic-rules-for-node (node) + "Return a list of semantic rules for NODE." + (let* ((first-child (clojure-ts--node-child-skip-metadata node 0)) + (symbol-name (clojure-ts--named-node-text first-child)) + (symbol-namespace (clojure-ts--node-namespace-text first-child))) + (or (clojure-ts--dynamic-indent-for-symbol symbol-name symbol-namespace) + (alist-get symbol-name + clojure-ts--semantic-indent-rules-cache + nil + nil + #'equal)))) + +(defun clojure-ts--find-semantic-rule (node parent current-depth) + "Return a suitable indentation rule for NODE, considering the CURRENT-DEPTH. + +Attempts to find an indentation rule by examining the symbol name of the +PARENT's first child. If a rule is not found, it navigates up the +syntax tree and recursively attempts to find a rule, incrementally +increasing the CURRENT-DEPTH. If a rule is not found upon reaching the +root of the syntax tree, it returns nil. A rule is considered a match +only if the CURRENT-DEPTH matches the rule's required depth." + (let* ((idx (- (treesit-node-index node) 2))) + (if-let* ((rule-set (clojure-ts--find-semantic-rules-for-node parent))) + (if (zerop current-depth) + (let ((rule (car rule-set))) + (if (equal (car rule) :block) + rule + (pcase-let ((`(,_ ,rule-depth ,rule-idx) rule)) + (when (and (equal rule-depth current-depth) + (or (null rule-idx) + (equal rule-idx idx))) + rule)))) + (thread-last rule-set + (seq-filter (lambda (rule) + (pcase-let ((`(,rule-type ,rule-depth ,rule-idx) rule)) + (and (equal rule-type :inner) + (equal rule-depth current-depth) + (or (null rule-idx) + (equal rule-idx idx)))))) + (seq-first))) + ;; Let's go no more than 3 levels up to avoid performance degradation. + (when-let* (((< current-depth 3)) + (new-parent (treesit-node-parent parent))) + (clojure-ts--find-semantic-rule parent + new-parent + (1+ current-depth)))))) + +(defun clojure-ts--match-form-body (node parent bol) + "Match if NODE has to be indented as a for body. + +PARENT not should be a list. If first symbol in the expression has an +indentation rule in `clojure-ts--semantic-indent-rules-defaults' or +`clojure-ts-semantic-indent-rules' check if NODE should be indented +according to the rule. If NODE is nil, use next node after BOL." + (and (or (clojure-ts--list-node-p parent) + (clojure-ts--anon-fn-node-p parent)) + (let* ((first-child (clojure-ts--first-value-child parent))) + (when-let* ((rule (clojure-ts--find-semantic-rule node parent 0))) + (let ((rule-type (car rule)) + (rule-value (cadr rule))) + (if (equal rule-type :block) + (if (zerop rule-value) + ;; Special treatment for block 0 rule. + (clojure-ts--match-block-0-body bol first-child) + (clojure-ts--node-pos-match-block node parent bol rule-value)) + ;; Return true for any inner rule. + t)))))) (defun clojure-ts--match-function-call-arg (node parent _bol) "Match NODE if PARENT is a list expressing a function or macro call." - (and (clojure-ts--list-node-p parent) - ;; Can the following two clauses be replaced by checking indexes? - ;; Does the second child exist, and is it not equal to the current node? - (treesit-node-child parent 1 t) - (not (treesit-node-eq (treesit-node-child parent 1 t) node)) - (let ((first-child (treesit-node-child parent 0 t))) - (or (clojure-ts--symbol-node-p first-child) - (clojure-ts--keyword-node-p first-child))))) - -(defun clojure-ts--match-expression-in-body (_node parent _bol) - "Match NODE if it is an expression used in a body argument. -PARENT is expected to be a list literal. -See `treesit-simple-indent-rules'." - (and - (clojure-ts--list-node-p parent) - (let ((first-child (treesit-node-child parent 0 t))) - (and - (not - (clojure-ts--symbol-matches-p - ;; Symbols starting with this are false positives - (rx line-start (or "default" "deflate" "defer")) - first-child)) - (clojure-ts--symbol-matches-p - clojure-ts--symbols-with-body-expressions-regexp - first-child))))) - -(defun clojure-ts--match-method-body (_node parent _bol) - "Matches a `NODE' in the body of a `PARENT' method implementation. -A method implementation referes to concrete implemntations being defined in -forms like deftype, defrecord, reify, proxy, etc." - (and - (clojure-ts--list-node-p parent) - (let* ((grandparent (treesit-node-parent parent)) - ;; auncle: gender neutral sibling of parent, aka child of grandparent - (first-auncle (treesit-node-child grandparent 0 t))) - (and (clojure-ts--list-node-p grandparent) - (clojure-ts--symbol-matches-p clojure-ts-type-symbol-regexp - first-auncle))))) + (and (or (clojure-ts--list-node-p parent) + (clojure-ts--anon-fn-node-p parent)) + (let ((first-child (clojure-ts--first-value-child parent)) + (second-child (clojure-ts--node-child-skip-metadata parent 1))) + (and first-child + ;; Does the second child exist, and is it not equal to the current node? + second-child + (not (treesit-node-eq second-child node)) + (or (clojure-ts--symbol-node-p first-child) + (clojure-ts--keyword-node-p first-child) + (clojure-ts--var-node-p first-child)))))) (defvar clojure-ts--threading-macro (eval-and-compile @@ -701,68 +1483,78 @@ forms like deftype, defrecord, reify, proxy, etc." "Match NODE if it is an argument to a PARENT threading macro." ;; We want threading macros to indent 2 only if the ->> is on it's own line. ;; If not, then align function arg. - (and (clojure-ts--list-node-p parent) - (let ((first-child (treesit-node-child parent 0 t))) + (and (or (clojure-ts--list-node-p parent) + (clojure-ts--anon-fn-node-p parent)) + (let ((first-child (clojure-ts--first-value-child parent))) (clojure-ts--symbol-matches-p clojure-ts--threading-macro first-child)))) -(defun clojure-ts--match-fn-docstring (node) - "Match NODE when it is a docstring for PARENT function definition node." - ;; A string that is the third node in a function defn block - (let ((parent (treesit-node-parent node))) - (and (treesit-node-eq node (treesit-node-child parent 2 t)) - (let ((first-auncle (treesit-node-child parent 0 t))) - (clojure-ts--symbol-matches-p - clojure-ts--definition-symbol-regexp - first-auncle))))) - -(defun clojure-ts--match-def-docstring (node) - "Match NODE when it is a docstring for PARENT variable definition node." - ;; A string that is the fourth node in a variable definition block. - (let ((parent (treesit-node-parent node))) - (and (treesit-node-eq node (treesit-node-child parent 2 t)) - ;; There needs to be a value after the string. - ;; If there is no 4th child, then this string is the value. - (treesit-node-child parent 3 t) - (let ((first-auncle (treesit-node-child parent 0 t))) - (clojure-ts--symbol-matches-p - clojure-ts--variable-definition-symbol-regexp - first-auncle))))) - -(defun clojure-ts--match-method-docstring (node) - "Match NODE when it is a docstring in a method definition." - (let* ((grandparent (treesit-node-parent ;; the protocol/interface - (treesit-node-parent node))) ;; the method definition - (first-grandauncle (treesit-node-child grandparent 0 t))) - (clojure-ts--symbol-matches-p - clojure-ts--interface-def-symbol-regexp - first-grandauncle))) - (defun clojure-ts--match-docstring (_node parent _bol) "Match PARENT when it is a docstring node." - (and (clojure-ts--string-node-p parent) ;; We are IN a string - (or (clojure-ts--match-def-docstring parent) - (clojure-ts--match-fn-docstring parent) - (clojure-ts--match-method-docstring parent)))) + (when-let* ((top-level-node (treesit-parent-until parent 'defun t)) + (result (treesit-query-capture top-level-node + clojure-ts--match-docstring-query))) + (seq-find (lambda (elt) + (and (eq (car elt) 'font-lock-doc-face) + (treesit-node-eq (cdr elt) parent))) + result))) + +(defun clojure-ts--match-with-metadata (node &optional _parent _bol) + "Match NODE when it has metadata." + (when-let* ((prev-sibling (treesit-node-prev-sibling node))) + (clojure-ts--metadata-node-p prev-sibling))) + +(defun clojure-ts--anchor-parent-opening-paren (_node parent _bol) + "Return position of PARENT start for NODE. + +If PARENT has optional metadata we skip it and return starting position +of the first child's opening paren. + +NOTE: This serves as an anchor function to resolve an indentation issue +for forms with type hints." + (thread-first parent + (treesit-search-subtree #'clojure-ts--opening-paren-node-p nil t 1) + (treesit-node-start))) + +(defun clojure-ts--anchor-nth-sibling (n) + "Return the start of the Nth child of PARENT skipping metadata." + (lambda (_n parent &rest _) + (treesit-node-start (treesit-node-child parent n t)))) (defun clojure-ts--semantic-indent-rules () - "Return a list of indentation rules for `treesit-simple-indent-rules'." + "Return a list of indentation rules for `treesit-simple-indent-rules'. + +NOTE: All built-in matchers (such as `parent-is' etc) expect a node type +regex. Therefore, if the string map_lit is used, it will incorrectly +match both map_lit and ns_map_lit. To prevent this, more precise +regexes with anchors matching the beginning and end of the line are +used." `((clojure - ((parent-is "source") parent-bol 0) - (clojure-ts--match-docstring parent 0) + ((parent-is "^source$") parent-bol 0) + ;; Literal Sequences + ((parent-is "^vec_lit$") parent 1) ;; https://guide.clojure.style/#bindings-alignment + ((parent-is "^map_lit$") parent 1) ;; https://guide.clojure.style/#map-keys-alignment + ((parent-is "^set_lit$") parent 2) + ((parent-is "^splicing_read_cond_lit$") parent 4) + ((parent-is "^read_cond_lit$") parent 3) + ((parent-is "^tagged_or_ctor_lit$") parent 0) + ((parent-is "^ns_map_lit$") (nth-sibling 2) 1) ;; https://guide.clojure.style/#body-indentation - (clojure-ts--match-method-body parent 2) - (clojure-ts--match-expression-in-body parent 2) + (clojure-ts--match-form-body clojure-ts--anchor-parent-opening-paren 2) ;; https://guide.clojure.style/#threading-macros-alignment (clojure-ts--match-threading-macro-arg prev-sibling 0) ;; https://guide.clojure.style/#vertically-align-fn-args - (clojure-ts--match-function-call-arg (nth-sibling 2 nil) 0) - ;; Literal Sequences - ((parent-is "list_lit") parent 1) ;; https://guide.clojure.style/#one-space-indent - ((parent-is "vec_lit") parent 1) ;; https://guide.clojure.style/#bindings-alignment - ((parent-is "map_lit") parent 1) ;; https://guide.clojure.style/#map-keys-alignment - ((parent-is "set_lit") parent 2)))) + (clojure-ts--match-function-call-arg ,(clojure-ts--anchor-nth-sibling 1) 0) + ;; https://guide.clojure.style/#one-space-indent + ((parent-is "^list_lit$") parent 1) + ((parent-is "^anon_fn_lit$") parent 2) + (clojure-ts--match-with-metadata parent 0) + ;; This is slow and only matches when point is inside of a docstring and + ;; only when Markdown grammar is disabled. `indent-region' tries to match + ;; all the rules from top to bottom, so order matters here (the slowest + ;; rules should be at the bottom). + (clojure-ts--match-docstring parent 0)))) (defun clojure-ts--configured-indent-rules () "Gets the configured choice of indent rules." @@ -775,6 +1567,48 @@ forms like deftype, defrecord, reify, proxy, etc." '(semantic fixed) clojure-ts-indent-style))))) +(defun clojure-ts--docstring-fill-prefix () + "The prefix string used by `clojure-ts--fill-paragraph'. +It is simply `clojure-ts-docstring-fill-prefix-width' number of spaces." + (make-string clojure-ts-docstring-fill-prefix-width ? )) + +(defun clojure-ts--fill-paragraph (&optional justify) + "Like `fill-paragraph', but can handler Clojure docstrings. +If JUSTIFY is non-nil, justify as well as fill the paragraph." + (let ((current-node (treesit-node-at (point) 'clojure t))) + (if (clojure-ts--match-docstring nil current-node nil) + (let ((fill-column (or clojure-ts-docstring-fill-column fill-column)) + (fill-prefix (clojure-ts--docstring-fill-prefix)) + (beg-doc (treesit-node-start current-node)) + (end-doc (treesit-node-end current-node))) + (save-restriction + (narrow-to-region beg-doc end-doc) + (fill-paragraph justify))) + (or (fill-comment-paragraph justify) + (fill-paragraph justify))) + t)) + +(defun clojure-ts--list-node-sym-text (node &optional include-anon-fn-lit) + "Return text of the first child of the NODE if NODE is a list. + +Return nil if the NODE is not a list or if the first child is not a +symbol. Optionally if INCLUDE-ANON-FN-LIT is non-nil, return the text +of the first symbol of a functional literal NODE." + (when (or (clojure-ts--list-node-p node) + (and include-anon-fn-lit + (clojure-ts--anon-fn-node-p node))) + (when-let* ((first-child (clojure-ts--first-value-child node)) + ((clojure-ts--symbol-node-p first-child))) + (clojure-ts--named-node-text first-child)))) + +(defun clojure-ts--list-node-sym-match-p (node regex &optional include-anon-fn-lit) + "Return TRUE if NODE is a list and its first symbol matches the REGEX. + +Optionally if INCLUDE-ANON-FN-LIT is TRUE, perform the same check for a +function literal." + (when-let* ((sym-text (clojure-ts--list-node-sym-text node include-anon-fn-lit))) + (string-match-p regex sym-text))) + (defconst clojure-ts--sexp-nodes '("#_" ;; transpose-sexp near a discard macro moves it around. "num_lit" "sym_lit" "kwd_lit" "nil_lit" "bool_lit" @@ -784,30 +1618,1117 @@ forms like deftype, defrecord, reify, proxy, etc." "var_quoting_lit" "sym_val_lit" "evaling_lit" "tagged_or_ctor_lit" "splicing_read_cond_lit" "derefing_lit" "quoting_lit" "syn_quoting_lit" - "unquote_splicing_lit" "unquoting_lit") + "unquote_splicing_lit" "unquoting_lit" + "dis_expr") "A regular expression that matches nodes that can be treated as s-expressions.") +(defconst clojure-ts--list-nodes + '("list_lit" "anon_fn_lit" "read_cond_lit" "splicing_read_cond_lit" + "map_lit" "ns_map_lit" "vec_lit" "set_lit") + "A regular expression that matches nodes that can be treated as lists.") + +(defconst clojure-ts--defun-symbols-regex + (rx bol + (or "def" + "defn" + "defn-" + "definline" + "defrecord" + "defmacro" + "defmulti" + "defonce" + "defprotocol" + "deftest" + "deftest-" + "ns" + "definterface" + "deftype" + "defstruct") + eol)) + +(defun clojure-ts--defun-node-p (node) + "Return TRUE if NODE is a function or a var definition." + (clojure-ts--list-node-sym-match-p node clojure-ts--defun-symbols-regex)) + +(defconst clojure-ts--markdown-inline-sexp-nodes + '("inline_link" "full_reference_link" "collapsed_reference_link" + "uri_autolink" "email_autolink" "shortcut_link" "image" + "code_span") + "Nodes representing s-expressions in the `markdown-inline' parser.") + +(defun clojure-ts--default-sexp-node-p (node) + "Return TRUE if point is after the # marker of set or function literal NODE." + (and (eq (char-before) ?\#) + (string-match-p (rx bol (or "anon_fn_lit" "set_lit") eol) + (treesit-node-type (treesit-node-parent node))))) + (defconst clojure-ts--thing-settings `((clojure - ((sexp ,(regexp-opt clojure-ts--sexp-nodes)) - (text ,(regexp-opt '("comment"))))))) + (sexp ,(regexp-opt clojure-ts--sexp-nodes)) + (list ,(regexp-opt clojure-ts--list-nodes)) + ;; `sexp-default' thing allows to fallback to the default implementation of + ;; `forward-sexp' function where `treesit-forward-sexp' produces undesired + ;; results. + (sexp-default + ;; For `C-M-f' in "#|(a)" or "#|{1 2 3}" + (,(rx (or "(" "{")) . ,#'clojure-ts--default-sexp-node-p)) + (text ,(regexp-opt '("comment"))) + (defun ,#'clojure-ts--defun-node-p)) + (when clojure-ts-use-markdown-inline + (markdown-inline + (sexp ,(regexp-opt clojure-ts--markdown-inline-sexp-nodes)))))) + +;;; Vertical alignment + +(defun clojure-ts--beginning-of-defun-pos () + "Return the point that represents the beginning of the current defun." + (treesit-node-start (treesit-defun-at-point))) + +(defun clojure-ts--end-of-defun-pos () + "Return the point that represends the end of the current defun." + (treesit-node-end (treesit-defun-at-point))) + +(defun clojure-ts--search-whitespace-after-next-sexp (root-node bound) + "Move the point after all whitespace following the next s-expression. + +Set match data group 1 to this region of whitespace and return the +point. + +To move over the next s-expression, fetch the next node after the +current cursor position that is a direct child of ROOT-NODE and navigate +to its end. The most complex aspect here is handling nodes with +metadata. Some forms are represented in the syntax tree as a single +s-expression (for example, ^long my-var or ^String (str \"Hello\" +\"world\")), while other forms are two separate s-expressions (for +example, ^long 123 or ^String \"Hello\"). Expressions with two nodes +share some common features: + +- The top-level node type is usually sym_lit + +- They do not have value children, or they have an empty name. + +Regular expression and syntax analysis code is borrowed from +`clojure-mode.' + +BOUND bounds the whitespace search." + (unwind-protect + (let ((regex "\\([,\s\t]*\\)\\(;+.*\\)?")) + ;; If we're on an empty line, we should return match, otherwise + ;; `clojure-ts-align-separator' setting won't work. + (if (and (bolp) (looking-at-p "[[:blank:]]*$")) + (progn + (search-forward-regexp regex bound) + (point)) + (when-let* ((cur-sexp (treesit-node-first-child-for-pos root-node (point) t))) + (goto-char (treesit-node-start cur-sexp)) + (if (clojure-ts--metadata-node-p cur-sexp) + (progn + (treesit-end-of-thing 'sexp 1 'restricted) + (just-one-space) + (treesit-end-of-thing 'sexp 1 'restricted)) + (treesit-end-of-thing 'sexp 1 'restricted)) + (when (looking-at-p ",") + (forward-char)) + ;; Move past any whitespace or comment. + (search-forward-regexp regex bound) + (pcase (syntax-after (point)) + ;; End-of-line, try again on next line. + (`(12) (progn + (forward-char 1) + (clojure-ts--search-whitespace-after-next-sexp root-node bound))) + ;; Closing paren, stop here. + (`(5 . ,_) nil) + ;; Anything else is something to align. + (_ (point)))))) + (when (and bound (> (point) bound)) + (goto-char bound)))) + +(defun clojure-ts--region-node (beg end) + "Return the smallest node that covers buffer positions BEG to END." + (let* ((root-node (treesit-buffer-root-node 'clojure))) + (treesit-node-descendant-for-range root-node beg end t))) + +(defun clojure-ts--node-from-sexp-data (beg end sexp) + "Return updated node using SEXP data in the region between BEG and END." + (let* ((new-region-node (clojure-ts--region-node beg end)) + (sexp-beg (marker-position (plist-get sexp :beg-marker))) + (sexp-end (marker-position (plist-get sexp :end-marker)))) + (treesit-node-descendant-for-range new-region-node + sexp-beg + sexp-end + t))) + +(defvar clojure-ts--align-query + (treesit-query-compile 'clojure + `(((map_lit) @map) + ((ns_map_lit) @ns-map) + ((list_lit + ((sym_lit) @sym + (:match ,(clojure-ts-symbol-regexp clojure-ts-align-binding-forms) @sym)) + (vec_lit) @bindings-vec)) + ((list_lit + :anchor + ((sym_lit) @sym + (:match ,(rx bol (or "for" "doseq") eol) @sym)) + (vec_lit + ((kwd_lit) @kwd + (:equal ":let" @kwd)) + :anchor + (vec_lit) @bindings-vec))) + ((list_lit + ((sym_lit) @sym + (:match ,(clojure-ts-symbol-regexp clojure-ts-align-cond-forms) @sym))) + @cond) + ((anon_fn_lit + ((sym_lit) @sym + (:match ,(clojure-ts-symbol-regexp clojure-ts-align-binding-forms) @sym)) + (vec_lit) @bindings-vec)) + ((anon_fn_lit + ((sym_lit) @sym + (:match ,(clojure-ts-symbol-regexp clojure-ts-align-cond-forms) @sym))) + @cond)))) + +(defvar clojure-ts--align-reader-conditionals-query + (treesit-query-compile 'clojure + '(((read_cond_lit) @read-cond) + ((splicing_read_cond_lit) @read-cond)))) + +(defun clojure-ts--get-nodes-to-align (beg end) + "Return a plist of nodes data for alignment. + +The search is limited by BEG, END. + +Possible node types are: map, bindings-vec, cond or read-cond. + +The returned value is a list of property lists. Each property list +includes `:sexp-type', `:node', `:beg-marker', and `:end-marker'. +Markers are necessary to fetch the same nodes after their boundaries +have changed." + ;; By default `treesit-query-capture' captures all nodes that cross the range. + ;; We need to restrict it to only nodes inside of the range. + (let* ((region-node (clojure-ts--region-node beg end)) + (nodes (append (treesit-query-capture region-node clojure-ts--align-query beg end) + (when clojure-ts-align-reader-conditionals + (treesit-query-capture region-node clojure-ts--align-reader-conditionals-query beg end))))) + (thread-last nodes + (seq-remove (lambda (elt) (eq (car elt) 'sym))) + ;; Reverse the result to align the most deeply nested nodes + ;; first. This way we can prevent breaking alignment of outer + ;; nodes. + (seq-reverse) + ;; When first node is reindented, all other nodes become + ;; outdated. Executing the entire query everytime is very + ;; expensive, instead we use markers for every captured node to + ;; retrieve only a single node later. + (seq-map (lambda (elt) + (let* ((sexp-type (car elt)) + (node (cdr elt)) + (beg-marker (copy-marker (treesit-node-start node) t)) + (end-marker (copy-marker (treesit-node-end node)))) + (list :sexp-type sexp-type + :node node + :beg-marker beg-marker + :end-marker end-marker))))))) + +(defun clojure-ts--point-to-align-position (sexp-type node) + "Move point to the appropriate position to align NODE. + +For NODE with SEXP-TYPE map or bindings-vec, the appropriate +position is after the first opening brace. + +For NODE with SEXP-TYPE cond, we need to skip the first symbol and the +subsequent special arguments based on block indentation rules." + (goto-char (treesit-node-start node)) + (when-let* ((cur-sexp (treesit-node-first-child-for-pos node (point) t))) + (goto-char (treesit-node-start cur-sexp)) + ;; For namespaced maps we need to skip the namespace, which is the first + ;; nested sexp. + (when (equal sexp-type 'ns-map) + (treesit-beginning-of-thing 'sexp -1 'nested)) + ;; For cond forms we need to skip first n + 1 nodes according to block + ;; indentation rules. First node to skip is the symbol itself. + (when (equal sexp-type 'cond) + (if-let* ((rule-set (clojure-ts--find-semantic-rules-for-node node)) + (rule (car rule-set)) + ((equal (car rule) :block))) + (treesit-beginning-of-thing 'sexp (1- (- (cadr rule))) 'restrict) + (treesit-beginning-of-thing 'sexp -1))))) + +(defun clojure-ts-align (beg end) + "Vertically align the contents of the sexp around point. + +If region is active, align it. Otherwise, align everything in the +current \"top-level\" sexp. When called from lisp code align everything +between BEG and END." + (interactive (if (use-region-p) + (list (region-beginning) (region-end)) + (save-excursion + (if (not (treesit-defun-at-point)) + (user-error "No defun at point") + (let ((start (clojure-ts--beginning-of-defun-pos)) + (end (clojure-ts--end-of-defun-pos))) + (list start end)))))) + (setq end (copy-marker end)) + (let* ((sexps-to-align (clojure-ts--get-nodes-to-align beg (marker-position end))) + ;; We have to disable it here to avoid endless recursion. + (clojure-ts-align-forms-automatically nil)) + (save-excursion + (indent-region beg (marker-position end)) + (dolist (sexp sexps-to-align) + ;; After reindenting a node, all other nodes in the `sexps-to-align' + ;; list become outdated, so we need to fetch updated nodes for every + ;; iteration. + (let* ((node (clojure-ts--node-from-sexp-data beg (marker-position end) sexp)) + (sexp-type (plist-get sexp :sexp-type)) + (node-end (treesit-node-end node))) + (clojure-ts--point-to-align-position sexp-type node) + (align-region (point) node-end nil + `((clojure-align (regexp . ,(lambda (&optional bound _noerror) + (let ((updated-node (clojure-ts--node-from-sexp-data beg (marker-position end) sexp))) + (clojure-ts--search-whitespace-after-next-sexp updated-node bound)))) + (group . 1) + (separate . ,clojure-ts-align-separator) + (repeat . t))) + nil) + ;; After every iteration we have to re-indent the s-expression, + ;; otherwise some can be indented inconsistently. + (indent-region (marker-position (plist-get sexp :beg-marker)) + (marker-position (plist-get sexp :end-marker))))) + ;; If `clojure-ts-align-separator' is used, `align-region' leaves trailing + ;; whitespaces on empty lines. + (delete-trailing-whitespace beg (marker-position end))))) + +(defun clojure-ts-indent-region (beg end) + "Like `indent-region', but also maybe align forms. + +Forms between BEG and END are aligned according to +`clojure-ts-align-forms-automatically'." + (prog1 (let ((indent-region-function #'treesit-indent-region)) + (indent-region beg end)) + (when clojure-ts-align-forms-automatically + (clojure-ts-align beg end)))) + +;;; Refactoring + +(defun clojure-ts--parent-until (pred) + "Return the closest parent of node at point that satisfies PRED." + (when-let* ((node-at-point (treesit-node-at (point) 'clojure t))) + (treesit-parent-until node-at-point pred t))) + +(defun clojure-ts--search-list-form-at-point (sym-regex &optional include-anon-fn-lit) + "Return the list node at point which first symbol matches SYM-REGEX. + +If INCLUDE-ANON-FN-LIT is non-nil, this function may also return a +functional literal node." + (clojure-ts--parent-until + (lambda (node) + (clojure-ts--list-node-sym-match-p node sym-regex include-anon-fn-lit)))) + +(defun clojure-ts--threading-sexp-node () + "Return list node at point which is a threading expression." + (clojure-ts--search-list-form-at-point (rx bol (* "some") "->" (* ">") eol) t)) + +(defun clojure-ts--delete-and-extract-sexp () + "Delete the surrounding sexp and return it." + (let* ((sexp-node (treesit-thing-at-point 'sexp 'nested)) + (result (treesit-node-text sexp-node))) + (delete-region (treesit-node-start sexp-node) + (treesit-node-end sexp-node)) + result)) + +(defun clojure-ts--ensure-parens-around-function-name () + "Insert parens around function name if necessary." + (unless (string= (treesit-node-text (treesit-node-at (point))) "(") + (insert-parentheses 1) + (backward-up-list))) + +(defun clojure-ts--multiline-sexp-p () + "Return TRUE if s-expression at point is multiline." + (let ((sexp (treesit-thing-at-point 'sexp 'nested))) + (not (= (line-number-at-pos (treesit-node-start sexp)) + (line-number-at-pos (treesit-node-end sexp)))))) + +(defun clojure-ts--unwind-thread-first () + "Unwind a thread first macro once." + (let* ((threading-sexp (clojure-ts--threading-sexp-node)) + (first-child-start (thread-first threading-sexp + (treesit-node-child 0 t) + (treesit-node-start) + (copy-marker)))) + (save-excursion + (goto-char first-child-start) + (treesit-beginning-of-thing 'sexp -1) + (let ((contents (clojure-ts--delete-and-extract-sexp))) + (when (looking-at-p " *\n") + (join-line 'following)) + (just-one-space) + (goto-char first-child-start) + (treesit-beginning-of-thing 'sexp -1) + (let ((multiline-p (clojure-ts--multiline-sexp-p))) + (clojure-ts--ensure-parens-around-function-name) + (down-list) + (forward-sexp) + (cond + ((and multiline-p (looking-at-p " *\n")) + (insert "\n" contents)) + (multiline-p (insert " " contents "\n")) + (t (insert " " contents)))))))) + +(defun clojure-ts--unwind-thread-last () + "Unwind a thread last macro once." + (let* ((threading-sexp (clojure-ts--threading-sexp-node)) + (first-child-start (thread-first threading-sexp + (treesit-node-child 0 t) + (treesit-node-start) + (copy-marker)))) + (save-excursion + (goto-char first-child-start) + (treesit-beginning-of-thing 'sexp -1) + (let ((contents (clojure-ts--delete-and-extract-sexp))) + (when (looking-at-p " *\n") + (join-line 'following)) + (just-one-space) + (goto-char first-child-start) + (treesit-beginning-of-thing 'sexp -1) + (let ((multiline-p (clojure-ts--multiline-sexp-p))) + (clojure-ts--ensure-parens-around-function-name) + (forward-list) + (down-list -1) + (when multiline-p + (insert "\n")) + (insert " " contents)))))) + +(defun clojure-ts--node-threading-p (node) + "Return non-nil if NODE is a threading macro s-expression." + (and (or (clojure-ts--list-node-p node) + (clojure-ts--anon-fn-node-p node)) + (let ((first-child (treesit-node-child node 0 t))) + (clojure-ts--symbol-matches-p clojure-ts--threading-macro first-child)))) + +(defun clojure-ts--skip-first-child (parent) + "Move point to the beginning of the first child of the PARENT node." + (thread-first parent + (treesit-node-child 1 t) + (treesit-node-start) + (goto-char))) + +(defun clojure-ts--nothing-more-to-unwind () + "Return TRUE if threading expression at point has only one argument." + (let ((threading-sexp (clojure-ts--threading-sexp-node))) + (save-excursion + (clojure-ts--skip-first-child threading-sexp) + (not (treesit-end-of-thing 'sexp 2 'restricted))))) + +(defun clojure-ts--raise-sexp () + "Raise current sexp one level higher up the tree. + +The built-in `raise-sexp' function doesn't work well with a few Clojure +nodes (function literals, expressions with metadata etc.), it loses some +parenthesis." + (when-let* ((sexp-node (treesit-thing-at (point) 'sexp)) + (beg (thread-first sexp-node + (clojure-ts--node-start-skip-metadata) + (copy-marker))) + (end (thread-first sexp-node + (treesit-node-end) + (copy-marker)))) + (when-let* ((parent (treesit-node-parent sexp-node)) + ((not (string= (treesit-node-type parent) "source"))) + (parent-beg (thread-first parent + (clojure-ts--node-start-skip-metadata) + (copy-marker))) + (parent-end (thread-first parent + (treesit-node-end) + (copy-marker)))) + (save-excursion + (delete-region parent-beg beg) + (delete-region end parent-end))))) + +(defun clojure-ts--pop-out-of-threading () + "Raise a sexp up a level to unwind a threading form." + (let* ((threading-sexp (clojure-ts--threading-sexp-node)) + (beg (thread-first threading-sexp + (treesit-node-child 0 t) + (treesit-node-start)))) + (save-excursion + (clojure-ts--skip-first-child threading-sexp) + (delete-region beg (point)) + ;; `raise-sexp' doesn't work properly for function literals (it loses one + ;; of the parenthesis). Seems like an Emacs' bug. + (backward-up-list) + (delete-pair)))) + +(defun clojure-ts--fix-sexp-whitespace () + "Fix whitespace after unwinding a threading form." + (save-excursion + (let ((beg (point))) + (treesit-end-of-thing 'sexp) + (indent-region beg (point)) + (delete-trailing-whitespace beg (point))))) + +(defun clojure-ts--unwind-sexps-counter () + "Return total number of s-expressions of a threading form at point." + (if-let* ((threading-sexp (clojure-ts--threading-sexp-node))) + (save-excursion + (clojure-ts--skip-first-child threading-sexp) + (let ((n 0)) + (while (treesit-end-of-thing 'sexp 1 'restricted) + (setq n (1+ n))) + n)) + (user-error "No threading form to unwind at point"))) + +(defun clojure-ts-unwind (&optional n) + "Unwind thread at point or above point by N levels. + +With universal argument \\[universal-argument], fully unwinds thread." + (interactive "P") + (setq n (cond + ((equal n '(4)) (clojure-ts--unwind-sexps-counter)) + (n) + (1))) + (if-let* ((threading-sexp (clojure-ts--threading-sexp-node)) + (sym (clojure-ts--list-node-sym-text threading-sexp t))) + (save-excursion + (let ((beg (thread-first threading-sexp + (treesit-node-start) + (copy-marker))) + (end (thread-first threading-sexp + (treesit-node-end) + (copy-marker)))) + ;; If it's the last expression, just raise it out of the threading + ;; macro. + (if (clojure-ts--nothing-more-to-unwind) + (progn + (clojure-ts--pop-out-of-threading) + (clojure-ts--fix-sexp-whitespace)) + (while (> n 0) + (cond + ((string-match-p (rx bol (* "some") "->" eol) sym) + (clojure-ts--unwind-thread-first)) + ((string-match-p (rx bol (* "some") "->>" eol) sym) + (clojure-ts--unwind-thread-last))) + (setq n (1- n)) + ;; After unwinding we check if it is the last expression and maybe + ;; splice it. + (when (clojure-ts--nothing-more-to-unwind) + (clojure-ts--pop-out-of-threading) + (clojure-ts--fix-sexp-whitespace) + (setq n 0)))) + (indent-region (marker-position beg) (marker-position end)) + (delete-trailing-whitespace beg end))) + (user-error "No threading form to unwind at point"))) + +(defun clojure-ts-unwind-all () + "Fully unwind thread at point or above point." + (interactive) + (clojure-ts-unwind '(4))) + +(defun clojure-ts--remove-superfluous-parens () + "Remove extra parens from a form." + (when-let* ((node (treesit-thing-at-point 'sexp 'nested)) + ((clojure-ts--list-node-p node)) + ((= 1 (treesit-node-child-count node t)))) + (let ((delete-pair-blink-delay 0)) + (delete-pair)))) + +(defun clojure-ts--thread-first () + "Thread a sexp using ->." + (save-excursion + (clojure-ts--skip-first-child (clojure-ts--threading-sexp-node)) + (down-list) + (treesit-beginning-of-thing 'sexp -1) + (let ((contents (clojure-ts--delete-and-extract-sexp))) + (delete-char -1) + (when (looking-at-p " *\n") + (join-line 'following)) + (backward-up-list) + (insert contents "\n") + (clojure-ts--remove-superfluous-parens)))) + +(defun clojure-ts--thread-last () + "Thread a sexp using ->>." + (save-excursion + (clojure-ts--skip-first-child (clojure-ts--threading-sexp-node)) + (treesit-end-of-thing 'sexp) + (down-list -1) + (treesit-beginning-of-thing 'sexp) + (let ((contents (clojure-ts--delete-and-extract-sexp))) + (delete-char -1) + (treesit-end-of-thing 'sexp -1 'restricted) + (when (looking-at-p " *\n") + (join-line 'following)) + (backward-up-list) + (insert contents "\n") + (clojure-ts--remove-superfluous-parens)))) + +(defun clojure-ts--threadable-p (node) + "Return non-nil if expression NODE can be threaded. + +First argument after threading symbol itself should be a list and it +should have more than one named child." + (let ((second-child (treesit-node-child node 1 t))) + (and (clojure-ts--list-node-p second-child) + (> (treesit-node-child-count second-child t) 1)))) + +(defun clojure-ts-thread (&optional called-by-user-p) + "Thread by one more level an existing threading macro. + +If CALLED-BY-USER-P is non-nil (which is always TRUE when called +interactively), the function signals a `user-error' if threading form +cannot be found." + (interactive "p") + (if-let* ((threading-sexp (clojure-ts--threading-sexp-node)) + ((clojure-ts--threadable-p threading-sexp)) + (sym (clojure-ts--list-node-sym-text threading-sexp t))) + (let ((beg (thread-first threading-sexp + (treesit-node-start) + (copy-marker))) + (end (thread-first threading-sexp + (treesit-node-end) + (copy-marker)))) + (cond + ((string-match-p (rx bol (* "some") "->" eol) sym) + (clojure-ts--thread-first)) + ((string-match-p (rx bol (* "some") "->>" eol) sym) + (clojure-ts--thread-last))) + (indent-region (marker-position beg) (marker-position end)) + (delete-trailing-whitespace beg end) + t) + (when called-by-user-p + (user-error "No threading form at point")))) + +(defun clojure-ts--thread-all (first-or-last-thread but-last) + "Fully thread the form at point. + +FIRST-OR-LAST-THREAD is either \"->\" or \"->>\". + +When BUT-LAST is non-nil, the last expression is not threaded. Default +value is `clojure-ts-thread-all-but-last.'" + (if-let* ((list-at-point (treesit-thing-at-point 'list 'nested))) + (save-excursion + (goto-char (treesit-node-start list-at-point)) + (insert-parentheses 1) + (insert first-or-last-thread) + (while (clojure-ts-thread)) + (when (or but-last clojure-ts-thread-all-but-last) + (clojure-ts-unwind))) + (user-error "No list to thread at point"))) + +(defun clojure-ts-thread-first-all (but-last) + "Fully thread the form at point using ->. + +When BUT-LAST is non-nil, the last expression is not threaded. Default +value is `clojure-ts-thread-all-but-last'." + (interactive "P") + (clojure-ts--thread-all "-> " but-last)) + +(defun clojure-ts-thread-last-all (but-last) + "Fully thread the form at point using ->>. + +When BUT-LAST is non-nil, the last expression is not threaded. Default +value is `clojure-ts-thread-all-but-last'." + (interactive "P") + (clojure-ts--thread-all "->> " but-last)) + +(defun clojure-ts-cycle-privacy () + "Make a definition at point public or private." + (interactive) + (if-let* ((node-at-point (treesit-node-at (point) 'clojure t)) + (defun-node (treesit-parent-until node-at-point 'defun t))) + (save-excursion + (goto-char (treesit-node-start defun-node)) + (search-forward-regexp (rx "def" (* letter) (? (group (or "-" " ^:private"))))) + (if (match-string 1) + (replace-match "" nil nil nil 1) + (goto-char (match-end 0)) + (insert (if (or clojure-ts-use-metadata-for-defn-privacy + (not (string= (match-string 0) "defn"))) + " ^:private" + "-")))) + (user-error "No defun at point"))) + +(defun clojure-ts--node-child (node predicate) + "Return the first child of the NODE that matches the PREDICATE. + +PREDICATE can be a symbol representing a thing in +`treesit-thing-settings', or a predicate, like regexp matching node +type, etc. See `treesit-thing-settings' for more details." + (thread-last (treesit-node-children node t) + (seq-find (lambda (child) + (treesit-node-match-p child predicate t))))) + +(defun clojure-ts--node-start-skip-metadata (node) + "Return NODE start position optionally skipping metadata." + (if (clojure-ts--metadata-node-p (treesit-node-child node 0 t)) + (treesit-node-start (treesit-node-child node 1)) + (treesit-node-start node))) + +(defun clojure-ts--add-arity-internal (fn-node) + "Add an arity to a function defined by FN-NODE." + (let* ((first-coll (clojure-ts--node-child fn-node (rx bol (or "vec_lit" "list_lit") eol))) + (coll-start (treesit-node-start first-coll)) + (line-parent (thread-first fn-node + (clojure-ts--first-value-child) + (treesit-node-start) + (line-number-at-pos))) + (line-args (line-number-at-pos coll-start)) + (same-line-p (= line-parent line-args)) + (single-arity-p (clojure-ts--vec-node-p first-coll))) + (goto-char coll-start) + (when same-line-p + (newline-and-indent)) + (when single-arity-p + (insert-pair 2 ?\( ?\)) + (backward-up-list)) + (insert "([])\n") + ;; Put the point between square brackets. + (down-list -2))) + +(defun clojure-ts--add-arity-defprotocol-internal (fn-node) + "Add an arity to a defprotocol function defined by FN-NODE." + (let* ((args-vec (clojure-ts--node-child fn-node (rx bol "vec_lit" eol))) + (args-vec-start (treesit-node-start args-vec)) + (line-parent (thread-first fn-node + (clojure-ts--node-child-skip-metadata 0) + (treesit-node-start) + (line-number-at-pos))) + (line-args-vec (line-number-at-pos args-vec-start)) + (same-line-p (= line-parent line-args-vec))) + (goto-char args-vec-start) + (insert "[]") + (if same-line-p + (insert " ") + ;; If args vector is not at the same line, respect this and place each new + ;; vector on a new line. + (newline-and-indent)) + ;; Put the point between square brackets. + (down-list -1))) + +(defun clojure-ts--add-arity-reify-internal (fn-node) + "Add an arity to a reify function defined by FN-NODE." + (let* ((fn-name (clojure-ts--list-node-sym-text fn-node))) + (goto-char (treesit-node-start fn-node)) + (insert "(" fn-name " [])") + (newline-and-indent) + ;; Put the point between sqare brackets. + (down-list -2))) + +(defun clojure-ts--letfn-defn-p (node) + "Return non-nil if NODE is a function definition in a letfn form." + (when-let* ((parent (treesit-node-parent node))) + (and (clojure-ts--list-node-p node) + (clojure-ts--vec-node-p parent) + (let ((grandparent (treesit-node-parent parent))) + (string= (clojure-ts--list-node-sym-text grandparent) + "letfn"))))) + +(defun clojure-ts--proxy-defn-p (node) + "Return non-nil if NODE is a function definition in a proxy form." + (when-let* ((parent (treesit-node-parent node))) + (and (clojure-ts--list-node-p node) + (string= (clojure-ts--list-node-sym-text parent) "proxy")))) + +(defun clojure-ts--defprotocol-defn-p (node) + "Return non-nil if NODE is a function definition in a defprotocol form." + (when-let* ((parent (treesit-node-parent node))) + (and (clojure-ts--list-node-p node) + (string= (clojure-ts--list-node-sym-text parent) "defprotocol")))) + +(defun clojure-ts--reify-defn-p (node) + "Return non-nil if NODE is a function definition in a reify form." + (when-let* ((parent (treesit-node-parent node))) + (and (clojure-ts--list-node-p node) + (string= (clojure-ts--list-node-sym-text parent) "reify")))) + +(defun clojure-ts--extend-protocol-defn-p (node) + "Return non-nil if NODE is a function definition in an extend-protocol form." + (when-let* ((parent (treesit-node-parent node))) + (and (clojure-ts--list-node-p node) + (string= (clojure-ts--list-node-sym-text parent) "extend-protocol")))) + +(defun clojure-ts-add-arity () + "Add an arity to a function or macro." + (interactive) + (if-let* ((sym-regex (rx bol + (or "defn" + "letfn" + "fn" + "defmacro" + "defmethod" + "defprotocol" + "extend-protocol" + "reify" + "proxy") + eol)) + (parent-def-node (clojure-ts--search-list-form-at-point sym-regex)) + (parent-def-sym (clojure-ts--list-node-sym-text parent-def-node)) + (fn-node (cond + ((string= parent-def-sym "letfn") + (clojure-ts--parent-until #'clojure-ts--letfn-defn-p)) + ((string= parent-def-sym "proxy") + (clojure-ts--parent-until #'clojure-ts--proxy-defn-p)) + ((string= parent-def-sym "defprotocol") + (clojure-ts--parent-until #'clojure-ts--defprotocol-defn-p)) + ((string= parent-def-sym "reify") + (clojure-ts--parent-until #'clojure-ts--reify-defn-p)) + ((string= parent-def-sym "extend-protocol") + (clojure-ts--parent-until #'clojure-ts--extend-protocol-defn-p)) + (t parent-def-node)))) + (let ((beg-marker (copy-marker (treesit-node-start parent-def-node))) + (end-marker (copy-marker (treesit-node-end parent-def-node)))) + (cond + ((string= parent-def-sym "defprotocol") + (clojure-ts--add-arity-defprotocol-internal fn-node)) + ((or (string= parent-def-sym "reify") + (string= parent-def-sym "extend-protocol")) + (clojure-ts--add-arity-reify-internal fn-node)) + (t (clojure-ts--add-arity-internal fn-node))) + (indent-region (marker-position beg-marker) (marker-position end-marker))) + (user-error "No suitable form to add an arity at point"))) + +(defun clojure-ts-cycle-keyword-string () + "Convert the string at point to a keyword, or vice versa." + (interactive) + (let ((node (treesit-thing-at-point 'sexp 'nested)) + (pos (point))) + (cond + ((clojure-ts--string-node-p node) + (if (string-match-p " " (treesit-node-text node t)) + (user-error "Cannot convert a string containing spaces to keyword") + (insert ?: (substring (clojure-ts--delete-and-extract-sexp) 1 -1)))) + ((clojure-ts--keyword-node-p node) + (insert ?\" (substring (clojure-ts--delete-and-extract-sexp) 1) ?\")) + (t + (user-error "No string or keyword at point"))) + (goto-char pos))) + +(defun clojure-ts--collection-node-at-point () + "Return node at point that represent a collection." + (when-let* ((node (thread-first (point) + (treesit-node-at 'clojure) + (treesit-parent-until (rx bol + (or "map_lit" + "vec_lit" + "set_lit" + "list_lit" + "quoting_lit") + eol))))) + (cond + ;; If node is a list, check if it's quoted. + ((string= (treesit-node-type node) "list_lit") + (if-let* ((parent (treesit-node-parent node)) + ((string= (treesit-node-type parent) "quoting_lit"))) + parent + node)) + ;; If the point is at the quote character, check if the child node is a + ;; list. + ((string= (treesit-node-type node) "quoting_lit") + (when-let* ((first-child (clojure-ts--node-child-skip-metadata node 0)) + ((string= (treesit-node-type first-child) "list_lit"))) + node)) + (t node)))) + +(defun clojure-ts--convert-collection (delim-open &optional prefix) + "Convert collection at point to another collection type. + +The original collection is being unwrapped and wrapped between +DELIM-OPEN and its matching paren. If PREFIX is non-nil it's inserted +before DELIM-OPEN." + (if-let* ((coll-node (clojure-ts--collection-node-at-point))) + (save-excursion + (goto-char (treesit-node-start coll-node)) + (when (string-match-p (rx (or "set_lit" "quoting_lit")) + (treesit-node-type coll-node)) + (delete-char 1)) + (let ((parens-require-spaces nil) + (delete-pair-blink-delay 0)) + (when prefix + (insert-char prefix)) + (insert-pair 1 delim-open (matching-paren delim-open)) + (delete-pair 1))) + (user-error "No collection at point to convert"))) + +(defun clojure-ts-convert-collection-to-list () + "Convert collection at point to list." + (interactive) + (clojure-ts--convert-collection ?\()) + +(defun clojure-ts-convert-collection-to-quoted-list () + "Convert collection at point to quoted list." + (interactive) + (clojure-ts--convert-collection ?\( ?')) + +(defun clojure-ts-convert-collection-to-map () + "Convert collection at point to map." + (interactive) + (clojure-ts--convert-collection ?{)) + +(defun clojure-ts-convert-collection-to-vector () + "Convert collection at point to vector." + (interactive) + (clojure-ts--convert-collection ?\[)) + +(defun clojure-ts-convert-collection-to-set () + "Convert collection at point to set." + (interactive) + (clojure-ts--convert-collection ?{ ?#)) + +(defun clojure-ts-cycle-conditional () + "Change a surrounding conditional form to its negated counterpart, or vice versa." + (interactive) + (if-let* ((sym-regex (rx bol + (or "if" "if-not" "when" "when-not") + eol)) + (cond-node (clojure-ts--search-list-form-at-point sym-regex t)) + (cond-sym (clojure-ts--list-node-sym-text cond-node))) + (let ((beg (treesit-node-start cond-node)) + (end-marker (copy-marker (treesit-node-end cond-node))) + (new-sym (pcase cond-sym + ("if" "if-not") + ("if-not" "if") + ("when" "when-not") + ("when-not" "when")))) + (save-excursion + (goto-char (treesit-node-start cond-node)) + (down-list 1) + (delete-char (length cond-sym)) + (insert new-sym) + (when (member cond-sym '("if" "if-not")) + (forward-sexp 2) + (transpose-sexps 1)) + (indent-region beg (marker-position end-marker)))) + (user-error "No conditional expression found"))) + +(defun clojure-ts-cycle-not () + "Add or remove a not form around the current form." + (interactive) + (if-let* ((list-node (clojure-ts--parent-until (rx bol "list_lit" eol)))) + (let ((beg (treesit-node-start list-node)) + (end-marker (copy-marker (treesit-node-end list-node))) + (pos (copy-marker (point) t))) + (goto-char (clojure-ts--node-start-skip-metadata list-node)) + (if-let* ((list-parent (treesit-node-parent list-node)) + ((clojure-ts--list-node-sym-match-p list-parent (rx bol "not" eol)))) + (clojure-ts--raise-sexp) + (insert-pair 1 ?\( ?\)) + (insert "not ")) + (indent-region beg (marker-position end-marker)) + ;; `save-excursion' doesn't work well when point is at the opening + ;; paren. + (goto-char pos)) + (user-error "Must be invoked inside a list"))) + +(defvar clojure-ts-refactor-map + (let ((map (make-sparse-keymap))) + (keymap-set map "C-t" #'clojure-ts-thread) + (keymap-set map "t" #'clojure-ts-thread) + (keymap-set map "C-u" #'clojure-ts-unwind) + (keymap-set map "u" #'clojure-ts-unwind) + (keymap-set map "C-f" #'clojure-ts-thread-first-all) + (keymap-set map "f" #'clojure-ts-thread-first-all) + (keymap-set map "C-l" #'clojure-ts-thread-last-all) + (keymap-set map "l" #'clojure-ts-thread-last-all) + (keymap-set map "C-p" #'clojure-ts-cycle-privacy) + (keymap-set map "p" #'clojure-ts-cycle-privacy) + (keymap-set map "C-(" #'clojure-ts-convert-collection-to-list) + (keymap-set map "(" #'clojure-ts-convert-collection-to-list) + (keymap-set map "C-'" #'clojure-ts-convert-collection-to-quoted-list) + (keymap-set map "'" #'clojure-ts-convert-collection-to-quoted-list) + (keymap-set map "C-{" #'clojure-ts-convert-collection-to-map) + (keymap-set map "{" #'clojure-ts-convert-collection-to-map) + (keymap-set map "C-[" #'clojure-ts-convert-collection-to-vector) + (keymap-set map "[" #'clojure-ts-convert-collection-to-vector) + (keymap-set map "C-#" #'clojure-ts-convert-collection-to-set) + (keymap-set map "#" #'clojure-ts-convert-collection-to-set) + (keymap-set map "C-c" #'clojure-ts-cycle-conditional) + (keymap-set map "c" #'clojure-ts-cycle-conditional) + (keymap-set map "C-o" #'clojure-ts-cycle-not) + (keymap-set map "o" #'clojure-ts-cycle-not) + (keymap-set map "C-a" #'clojure-ts-add-arity) + (keymap-set map "a" #'clojure-ts-add-arity) + map) + "Keymap for `clojure-ts-mode' refactoring commands.") (defvar clojure-ts-mode-map (let ((map (make-sparse-keymap))) - ;(set-keymap-parent map clojure-mode-map) + ;;(set-keymap-parent map clojure-mode-map) + (keymap-set map "C-:" #'clojure-ts-cycle-keyword-string) + (keymap-set map "C-c SPC" #'clojure-ts-align) + (keymap-set map clojure-ts-refactor-map-prefix clojure-ts-refactor-map) + (easy-menu-define clojure-ts-mode-menu map "Clojure[TS] Mode Menu" + '("Clojure" + ["Toggle between string & keyword" clojure-ts-cycle-keyword-string] + ["Align expression" clojure-ts-align] + ["Cycle privacy" clojure-ts-cycle-privacy] + ["Cycle conditional" clojure-ts-cycle-conditional] + ["Cycle not" clojure-ts-cycle-not] + ["Add function/macro arity" clojure-ts-add-arity] + ("Convert collection" + ["Convert to list" clojure-ts-convert-collection-to-list] + ["Convert to quoted list" clojure-ts-convert-collection-to-quoted-list] + ["Convert to map" clojure-ts-convert-collection-to-map] + ["Convert to vector" clojure-ts-convert-collection-to-vector] + ["Convert to set" clojure-ts-convert-collection-to-set]) + ("Refactor -> and ->>" + ["Thread once more" clojure-ts-thread] + ["Fully thread a form with ->" clojure-ts-thread-first-all] + ["Fully thread a form with ->>" clojure-ts-thread-last-all] + "--" + ["Unwind once" clojure-ts-unwind] + ["Fully unwind a threading macro" clojure-ts-unwind-all]) + ["Version" clojure-mode-display-version])) + map) + "Keymap for `clojure-ts-mode'.") + +;;; Completion + +(defconst clojure-ts--completion-query-defuns + (treesit-query-compile 'clojure + `((source + (list_lit + ((sym_lit) @sym + (:match ,clojure-ts--defun-symbols-regex @sym)) + :anchor [(comment) (meta_lit) (old_meta_lit)] :* + :anchor ((sym_lit) @defun-candidate))))) + "Query that matches top-level definitions.") + +(defconst clojure-ts--completion-query-keywords + (treesit-query-compile 'clojure '((kwd_lit) @keyword-candidate)) + "Query that matches any Clojure keyword.") + +(defconst clojure-ts--completion-defn-with-args-sym-regex + (rx bol + (or "defn" + "defn-" + "fn" + "fn*" + "defmacro" + "defmethod") + eol) + "Regexp that matches a symbol of definition with arguments vector.") + +(defconst clojure-ts--completion-let-like-sym-regex + (rx bol + (or "let" + "if-let" + "when-let" + "if-some" + "when-some" + "loop" + "with-open" + "dotimes" + "with-local-vars" + "for" + "doseq") + eol) + "Regexp that matches a symbol of let-like form.") + +(defconst clojure-ts--completion-locals-query + (treesit-query-compile 'clojure `((vec_lit (sym_lit) @local-candidate) + (map_lit (sym_lit) @local-candidate))) + "Query that matches a local binding symbol. + +Symbold must be a direct child of a vector or a map. This query covers +bindings vector as well as destructuring syntax.") + +(defconst clojure-ts--completion-annotations + (list 'defun-candidate " Definition" + 'local-candidate " Local variable" + 'keyword-candidate " Keyword") + "Property list of completion candidate type and annotation string.") + +(defun clojure-ts--completion-annotation-function (candidate) + "Return annotation for a completion CANDIDATE." + (thread-last minibuffer-completion-table + (alist-get candidate) + (plist-get clojure-ts--completion-annotations))) + +(defun clojure-ts--completion-defun-with-args-node-p (node) + "Return non-nil if NODE is a function definition with arguments." + (when-let* ((sym-name (clojure-ts--list-node-sym-text node))) + (string-match-p clojure-ts--completion-defn-with-args-sym-regex sym-name))) + +(defun clojure-ts--completion-fn-args-nodes () + "Return a list of captured nodes that represent function arguments. + +The function traverses the syntax tree upwards and returns nodes from +all functions along the way." + (let ((parent-defun (clojure-ts--parent-until #'clojure-ts--completion-defun-with-args-node-p)) + (captured-nodes)) + (while parent-defun + (when-let* ((args-vec (clojure-ts--node-child parent-defun "vec_lit"))) + (setq captured-nodes + (append captured-nodes + (treesit-query-capture args-vec clojure-ts--completion-locals-query)))) + (setq parent-defun (treesit-parent-until parent-defun + #'clojure-ts--completion-defun-with-args-node-p))) + captured-nodes)) + +(defun clojure-ts--completion-let-like-node-p (node) + "Return non-nil if NODE is a let-like form." + (when-let* ((sym-name (clojure-ts--list-node-sym-text node))) + (string-match-p clojure-ts--completion-let-like-sym-regex sym-name))) + +(defun clojure-ts--completion-let-locals-nodes () + "Return a list of captured nodes that represent bindings in let forms. + +The function tranverses the syntax tree upwards and returns nodes from +all let bindings found along the way." + (let ((parent-let (clojure-ts--parent-until #'clojure-ts--completion-let-like-node-p)) + (captured-nodes)) + (while parent-let + (when-let* ((bindings-vec (clojure-ts--node-child parent-let "vec_lit"))) + (setq captured-nodes + (append captured-nodes + (treesit-query-capture bindings-vec clojure-ts--completion-locals-query)))) + (setq parent-let (treesit-parent-until parent-let + #'clojure-ts--completion-let-like-node-p))) + captured-nodes)) + +(defun clojure-ts-completion-at-point-function () + "Return a completion table for the symbol around point." + (when-let* ((bounds (bounds-of-thing-at-point 'symbol)) + (source (treesit-buffer-root-node 'clojure)) + (nodes (append (treesit-query-capture source clojure-ts--completion-query-defuns) + (treesit-query-capture source clojure-ts--completion-query-keywords) + (clojure-ts--completion-fn-args-nodes) + (clojure-ts--completion-let-locals-nodes)))) + (list (car bounds) + (cdr bounds) + (thread-last nodes + ;; Remove node at point + (seq-remove (lambda (item) (= (treesit-node-end (cdr item)) (point)))) + ;; Remove unwanted captured nodes + (seq-filter (lambda (item) + (not (equal (car item) 'sym)))) + ;; Produce alist of candidates + (seq-map (lambda (item) (cons (treesit-node-text (cdr item) t) (car item)))) + ;; Remove duplicated candidates + (seq-uniq)) + :exclusive 'no + :annotation-function #'clojure-ts--completion-annotation-function))) + +(defvar clojure-ts-clojurescript-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map clojure-ts-mode-map) + map)) + +(defvar clojure-ts-clojurec-mode-map + (let ((map (make-sparse-keymap))) + (set-keymap-parent map clojure-ts-mode-map) map)) -(defvar clojurescript-ts-mode-map +(defvar clojure-ts-clojuredart-mode-map (let ((map (make-sparse-keymap))) (set-keymap-parent map clojure-ts-mode-map) map)) -(defvar clojurec-ts-mode-map +(defvar clojure-ts-jank-mode-map (let ((map (make-sparse-keymap))) (set-keymap-parent map clojure-ts-mode-map) map)) -(defvar clojure-dart-ts-mode-map +(defvar clojure-ts-joker-mode-map (let ((map (make-sparse-keymap))) (set-keymap-parent map clojure-ts-mode-map) map)) @@ -815,50 +2736,146 @@ forms like deftype, defrecord, reify, proxy, etc." (defun clojure-ts-mode-display-version () "Display the current `clojure-mode-version' in the minibuffer." (interactive) - (message "clojure-ts-mode (version %s)" clojure-ts-mode-version)) + (let ((pkg-version (package-get-version))) + (if pkg-version + (message "clojure-ts-mode %s (package: %s)" clojure-ts-mode-version pkg-version) + (message "clojure-ts-mode %s" clojure-ts-mode-version)))) (defconst clojure-ts-grammar-recipes '((clojure "https://github.com/sogaiu/tree-sitter-clojure.git" - "v0.0.12") - (markdown_inline "https://github.com/MDeiml/tree-sitter-markdown" - "v0.1.6" - "tree-sitter-markdown-inline/src")) + "unstable-20250526") + (markdown-inline "https://github.com/MDeiml/tree-sitter-markdown" + "v0.4.1" + "tree-sitter-markdown-inline/src") + (regex "https://github.com/tree-sitter/tree-sitter-regex" + "v0.24.3")) "Intended to be used as the value for `treesit-language-source-alist'.") +;; TODO: Eventually this should be replaced with `treesit-query-valid-p' +(defun clojure-ts--query-valid-p (query) + "Return non-nil if QUERY is valid in Clojure, nil otherwise." + (ignore-errors + (treesit-query-compile 'clojure query t) + t)) + +(defun clojure-ts--clojure-grammar-outdated-p () + "Return TRUE if currently installed grammar is outdated. + +This function checks if `clojure-ts-mode' is compatible with the +currently installed grammar. The simplest way to do this is to validate +a query that is valid in a previous grammar version but invalid in the +required version." + (clojure-ts--query-valid-p '((sym_lit (meta_lit))))) + (defun clojure-ts--ensure-grammars () "Install required language grammars if not already available." (when clojure-ts-ensure-grammars - (let ((treesit-language-source-alist clojure-ts-grammar-recipes)) - (unless (treesit-language-available-p 'clojure nil) - (message "Installing clojure tree-sitter grammar.") - (treesit-install-language-grammar 'clojure)) - (unless (treesit-language-available-p 'markdown_inline nil) - (message "Installing markdown tree-sitter grammar.") - (treesit-install-language-grammar 'markdown_inline))))) - -(defun clojure-ts-mode-variables (&optional markdown-available) - "Set up initial buffer-local variables for clojure-ts-mode. -See `clojure-ts--font-lock-settings' for usage of MARKDOWN-AVAILABLE." + (dolist (recipe clojure-ts-grammar-recipes) + (let ((grammar (car recipe))) + (when (or (not (treesit-language-available-p grammar nil)) + ;; If Clojure grammar is available, but outdated, re-install + ;; it. + (and (equal grammar 'clojure) + (clojure-ts--clojure-grammar-outdated-p))) + (message "Installing %s Tree-sitter grammar" grammar) + ;; `treesit-language-source-alist' is dynamically scoped. + ;; Binding it in this let expression allows + ;; `treesit-install-language-gramamr' to pick up the grammar recipes + ;; without modifying what the user has configured themselves. + (let ((treesit-language-source-alist clojure-ts-grammar-recipes)) + (treesit-install-language-grammar grammar))))))) + +(defun clojure-ts-reinstall-grammars () + "Install the required versions of language grammars. + +If the grammars are already installed, they will be reinstalled. This +function can also be used to upgrade the grammars if they are outdated." + (interactive) + (dolist (recipe clojure-ts-grammar-recipes) + (let ((grammar (car recipe))) + (message "Installing %s Tree-sitter grammar" grammar) + (let ((treesit-language-source-alist clojure-ts-grammar-recipes)) + (treesit-install-language-grammar grammar))))) + +(defun clojure-ts--harvest-treesit-configs (mode) + "Harvest tree-sitter configs from MODE. +Return a plist with the following keys and value: + + :font-lock (from `treesit-font-lock-settings') + :simple-indent (from `treesit-simple-indent-rules')" + (with-temp-buffer + (funcall mode) + (list :font-lock treesit-font-lock-settings + :simple-indent treesit-simple-indent-rules))) + +(defun clojure-ts--add-config-for-mode (mode) + "Add configurations for MODE to current buffer. + +Configuration includes font-lock and indent. For font-lock rules, use +the same features enabled in MODE." + (let ((configs (clojure-ts--harvest-treesit-configs mode))) + (setq treesit-font-lock-settings + (append treesit-font-lock-settings + (plist-get configs :font-lock))) + ;; FIXME: This works a bit aggressively. `indent-region' always tries to + ;; use rules for embedded parser. Without it users can format embedded code + ;; in an arbitrary way. + ;; + ;; (setq treesit-simple-indent-rules + ;; (append treesit-simple-indent-rules + ;; (plist-get configs :simple-indent))) + )) + +(defun clojure-ts-mode-variables (&optional markdown-available regex-available) + "Initialize buffer-local variables for `clojure-ts-mode'. + +See `clojure-ts--font-lock-settings' for usage of MARKDOWN-AVAILABLE and +REGEX-AVAILABLE." + (setq-local indent-tabs-mode nil) + (setq-local comment-add 1) (setq-local comment-start ";") + (when (equal clojure-ts-outline-variant 'comments) + ;; NOTE: If `imenu' option is selected for `clojure-ts-outline-variant', all + ;; necessary variables will be set automatically by + ;; `treesit-major-mode-setup'. + (setq-local treesit-outline-predicate #'clojure-ts--outline-predicate + outline-search-function #'treesit-outline-search + outline-level #'clojure-ts--outline-level)) + (setq-local treesit-font-lock-settings - (clojure-ts--font-lock-settings markdown-available)) + (clojure-ts--font-lock-settings markdown-available regex-available)) + (setq-local treesit-font-lock-feature-list + '((comment definition variable) + (keyword string char symbol builtin type) + (constant number quote metadata doc regex) + (bracket deref function tagged-literals))) + (setq-local treesit-defun-prefer-top-level t) (setq-local treesit-defun-tactic 'top-level) (setq-local treesit-defun-type-regexp - (rx (or "list_lit" "vec_lit" "map_lit"))) - (setq-local treesit-simple-indent-rules - (clojure-ts--configured-indent-rules)) + (cons + ;; consider all clojure sexps as valid top level forms... + (regexp-opt clojure-ts--sexp-nodes) + ;; ...except `comment' forms if `clojure-ts-toplevel-inside-comment-form' is set + (lambda (node) + (or (not clojure-ts-toplevel-inside-comment-form) + (not (clojure-ts--definition-node-p "comment" node)))))) (setq-local treesit-defun-name-function #'clojure-ts--standard-definition-node-name) + + (setq-local treesit-simple-indent-rules + (clojure-ts--configured-indent-rules)) + (setq-local fill-paragraph-function #'clojure-ts--fill-paragraph) + (setq-local treesit-simple-imenu-settings clojure-ts--imenu-settings) - (setq-local treesit-font-lock-feature-list - '((comment definition variable) - (keyword string char symbol builtin type) - (constant number quote metadata doc) - (bracket deref function regex tagged-literals))) + (when (boundp 'treesit-thing-settings) ;; Emacs 30+ - (setq-local treesit-thing-settings clojure-ts--thing-settings))) + (setq-local treesit-thing-settings clojure-ts--thing-settings)) + + (when clojure-ts-completion-enabled + (add-hook 'completion-at-point-functions + #'clojure-ts-completion-at-point-function nil 'local))) ;;;###autoload (define-derived-mode clojure-ts-mode prog-mode "Clojure[TS]" @@ -867,76 +2884,176 @@ See `clojure-ts--font-lock-settings' for usage of MARKDOWN-AVAILABLE." \\{clojure-ts-mode-map}" :syntax-table clojure-ts-mode-syntax-table (clojure-ts--ensure-grammars) - (let ((markdown-available (treesit-ready-p 'markdown_inline t))) - (when markdown-available - (treesit-parser-create 'markdown_inline) - (setq-local treesit-range-settings clojure-ts--treesit-range-settings)) + (let ((use-markdown-inline (and clojure-ts-use-markdown-inline + (treesit-ready-p 'markdown-inline t))) + (use-regex (and clojure-ts-use-regex-parser + (treesit-ready-p 'regex t)))) + (setq-local treesit-range-settings + (clojure-ts--treesit-range-settings use-markdown-inline + use-regex)) + (when (treesit-ready-p 'clojure) (treesit-parser-create 'clojure) - (clojure-ts-mode-variables markdown-available) + (clojure-ts-mode-variables use-markdown-inline use-regex) + (when clojure-ts--debug (setq-local treesit--indent-verbose t) (when (eq clojure-ts--debug 'font-lock) (setq-local treesit--font-lock-verbose t)) (treesit-inspect-mode)) - (treesit-major-mode-setup)))) + + (treesit-major-mode-setup) + + ;; We should assign this after calling `treesit-major-mode-setup', + ;; otherwise it will be owerwritten. + (when clojure-ts-align-forms-automatically + (setq-local indent-region-function #'clojure-ts-indent-region)) + + ;; Initial indentation rules cache calculation. + (setq clojure-ts--semantic-indent-rules-cache + (clojure-ts--compute-semantic-indentation-rules-cache clojure-ts-semantic-indent-rules)) + + ;; If indentation rules or extra def forms are set in `.dir-locals.el', it + ;; is advisable to recalculate the buffer-local value whenever the value + ;; changes. + (add-hook 'hack-local-variables-hook + (lambda () + (setq clojure-ts--semantic-indent-rules-cache + (clojure-ts--compute-semantic-indentation-rules-cache clojure-ts-semantic-indent-rules) + clojure-ts--clojure-extra-queries + (clojure-ts--compute-extra-def-queries clojure-ts-extra-def-forms))) + 0 + t) + + ;; Workaround for treesit-transpose-sexps not correctly working with + ;; treesit-thing-settings on Emacs 30. + ;; Once treesit-transpose-sexps it working again this can be removed + (when (and (fboundp 'transpose-sexps-default-function) + (< emacs-major-version 31)) + (setq-local transpose-sexps-function #'transpose-sexps-default-function))))) + +;; For Emacs 30+, so that `clojure-ts-mode' is treated as deriving from +;; `clojure-mode' in the context of `derived-mode-p' +(derived-mode-add-parents 'clojure-ts-mode '(clojure-mode)) ;;;###autoload -(define-derived-mode clojurescript-ts-mode clojure-ts-mode "ClojureScript[TS]" +(define-derived-mode clojure-ts-clojurescript-mode clojure-ts-mode "ClojureScript[TS]" "Major mode for editing ClojureScript code. -\\{clojurescript-ts-mode-map}") +\\{clojure-ts-clojurescript-mode-map}" + (when (and clojure-ts-clojurescript-use-js-parser + (treesit-ready-p 'javascript t)) + (setq-local treesit-range-settings + (append treesit-range-settings + (treesit-range-rules + :embed 'javascript + :host 'clojure + :local t + '(((list_lit (sym_lit) @_sym-name + :anchor (str_lit (str_content) @capture)) + (:equal @_sym-name "js*")))))) + (clojure-ts--add-config-for-mode 'js-ts-mode) + (treesit-major-mode-setup))) ;;;###autoload -(define-derived-mode clojurec-ts-mode clojure-ts-mode "ClojureC[TS]" +(define-derived-mode clojure-ts-clojurec-mode clojure-ts-mode "ClojureC[TS]" "Major mode for editing ClojureC code. -\\{clojurec-ts-mode-map}") +\\{clojure-ts-clojurec-mode-map}") ;;;###autoload -(define-derived-mode clojure-dart-ts-mode clojure-ts-mode "ClojureDart[TS]" +(define-derived-mode clojure-ts-clojuredart-mode clojure-ts-mode "ClojureDart[TS]" "Major mode for editing Clojure Dart code. -\\{clojure-dart-ts-mode-map}") - -(defun clojure-ts--register-novel-modes () - "Set up Clojure modes not present in progenitor clojure-mode.el." - (add-to-list 'auto-mode-alist '("\\.cljd\\'" . clojure-dart-ts-mode))) - -;; Redirect clojure-mode to clojure-ts-mode if clojure-mode is present -(if (require 'clojure-mode nil 'noerror) - (progn - (add-to-list 'major-mode-remap-alist '(clojure-mode . clojure-ts-mode)) - (add-to-list 'major-mode-remap-alist '(clojurescript-mode . clojurescript-ts-mode)) - (add-to-list 'major-mode-remap-alist '(clojurec-mode . clojurec-ts-mode)) - (clojure-ts--register-novel-modes)) - ;; Clojure-mode is not present, setup auto-modes ourselves - ;; Regular clojure/edn files - ;; I believe dtm is for datomic queries and datoms, which are just edn. - (add-to-list 'auto-mode-alist - '("\\.\\(clj\\|dtm\\|edn\\)\\'" . clojure-ts-mode)) - (add-to-list 'auto-mode-alist '("\\.cljs\\'" . clojurescript-ts-mode)) - (add-to-list 'auto-mode-alist '("\\.cljc\\'" . clojurec-ts-mode)) - ;; boot build scripts are Clojure source files - (add-to-list 'auto-mode-alist '("\\(?:build\\|profile\\)\\.boot\\'" . clojure-ts-mode)) - ;; babashka scripts are Clojure source files - (add-to-list 'interpreter-mode-alist '("bb" . clojure-ts-mode)) - ;; nbb scripts are ClojureScript source files - (add-to-list 'interpreter-mode-alist '("nbb" . clojurescript-ts-mode)) - (clojure-ts--register-novel-modes)) +\\{clojure-ts-clojuredart-mode-map}") + +;;;###autoload +(define-derived-mode clojure-ts-jank-mode clojure-ts-mode "Jank[TS]" + "Major mode for editing Jank code. + +\\{clojure-ts-jank-mode-map}" + (when (and clojure-ts-jank-use-cpp-parser + (treesit-ready-p 'cpp t)) + (setq-local treesit-range-settings + (append treesit-range-settings + (treesit-range-rules + :embed 'cpp + :host 'clojure + :local t + '(((list_lit (sym_lit) @_sym-name + :anchor (str_lit (str_content) @capture)) + (:equal @_sym-name "native/raw")))))) + (clojure-ts--add-config-for-mode 'c++-ts-mode) + (treesit-major-mode-setup))) + +;;;###autoload +(define-derived-mode clojure-ts-joker-mode clojure-ts-mode "Joker[TS]" + "Major mode for editing Joker code. + +\\{clojure-ts-joker-mode-map}") + +(defun clojure-ts-activate-mode-remappings () + "Remap all `clojure-mode' file-specified modes to use `clojure-ts-mode'. + +Useful if you want to try out `clojure-ts-mode' without having to manually +update the mode mappings." + (interactive) + (dolist (entry clojure-ts-mode-remappings) + (add-to-list 'major-mode-remap-defaults entry))) + +(defun clojure-ts-deactivate-mode-remappings () + "Undo `clojure-ts-mode' file-specified mode remappings. + +Useful if you want to switch to the `clojure-mode's mode mappings." + (interactive) + (dolist (entry clojure-ts-mode-remappings) + (setq major-mode-remap-defaults (remove entry major-mode-remap-defaults)))) + +(if (treesit-available-p) + ;; Redirect clojure-mode to clojure-ts-mode if clojure-mode is present + (if (require 'clojure-mode nil 'noerror) + (when clojure-ts-auto-remap + (clojure-ts-activate-mode-remappings)) + ;; When Clojure-mode is not present, setup auto-modes ourselves + (progn + ;; Regular clojure/edn files + ;; I believe dtm is for datomic queries and datoms, which are just edn. + (add-to-list 'auto-mode-alist + '("\\.\\(clj\\|dtm\\|edn\\)\\'" . clojure-ts-mode)) + (add-to-list 'auto-mode-alist '("\\.cljs\\'" . clojure-ts-clojurescript-mode)) + (add-to-list 'auto-mode-alist '("\\.cljc\\'" . clojure-ts-clojurec-mode)) + (add-to-list 'auto-mode-alist '("\\.cljd\\'" . clojure-ts-clojuredart-mode)) + (add-to-list 'auto-mode-alist '("\\.jank\\'" . clojure-ts-jank-mode)) + (add-to-list 'auto-mode-alist '("\\.joke\\'" . clojure-ts-joker-mode)) + ;; boot build scripts are Clojure source files + (add-to-list 'auto-mode-alist '("\\(?:build\\|profile\\)\\.boot\\'" . clojure-ts-mode)) + ;; babashka scripts are Clojure source files + (add-to-list 'interpreter-mode-alist '("bb" . clojure-ts-mode)) + ;; nbb scripts are ClojureScript source files + (add-to-list 'interpreter-mode-alist '("nbb" . clojure-ts-clojurescript-mode)))) + (message "Clojure TS Mode will not be activated as Tree-sitter support is missing.")) (defvar clojure-ts--find-ns-query (treesit-query-compile 'clojure '(((source (list_lit + :anchor [(comment) (meta_lit) (old_meta_lit)] :* :anchor (sym_lit name: (sym_name) @ns) + :anchor [(comment) (meta_lit) (old_meta_lit)] :* :anchor (sym_lit name: (sym_name) @ns-name))) - (:equal @ns "ns"))))) + (:equal @ns "ns")) + ((source (list_lit + :anchor [(comment) (meta_lit) (old_meta_lit)] :* + :anchor (sym_lit name: (sym_name) @in-ns) + :anchor [(comment) (meta_lit) (old_meta_lit)] :* + :anchor (quoting_lit + :anchor (sym_lit name: (sym_name) @ns-name)))) + (:equal @in-ns "in-ns"))))) (defun clojure-ts-find-ns () "Return the name of the current namespace." (let ((nodes (treesit-query-capture 'clojure clojure-ts--find-ns-query))) - (treesit-node-text (cdr (assoc 'ns-name nodes))))) + (treesit-node-text (cdr (assoc 'ns-name nodes)) t))) (provide 'clojure-ts-mode) diff --git a/doc/design.md b/doc/design.md index 0d2df9c..c5616a8 100644 --- a/doc/design.md +++ b/doc/design.md @@ -1,57 +1,78 @@ # Design of clojure-ts-mode -This document is still a work in progress. +**Note:** This document is still a work in progress. Clojure-ts-mode is based on the tree-sitter-clojure grammar. -If you want to contribute to clojure-ts-mode, it is recommend that you familiarize yourself with how tree-sitter works. -The official documentation is a great place to start: https://tree-sitter.github.io/tree-sitter/ -These guides for Emacs tree-sitter development are also useful -- https://casouri.github.io/note/2023/tree-sitter-starter-guide/index.html +If you want to contribute to clojure-ts-mode, it is recommend that you +familiarize yourself with how Tree-sitter works. The official documentation is +a great place to start: + +These guides for Emacs Tree-sitter development are also useful: + +- - `Developing major modes with tree-sitter` (From the Emacs 29+ Manual, `C-h i`, search for `tree-sitter`) +- [How to Get Started with Tree-sitter](https://www.masteringemacs.org/article/how-to-get-started-tree-sitter) +- [Emacs 30 Tree-sitter changes](https://archive.casouri.cc/note/2024/emacs-30-tree-sitter/) In short: -Tree-sitter is a tool that generates parser libraries for programming languages, and provides an API for interacting with those parsers. -The generated parsers can create syntax trees from source code text. -The nodes of those trees are defined by the grammar. -Emacs can use these generated parsers to provide major modes with things like syntax highlighting, indentation, navigation, structural editing, and many other things. + +- Tree-sitter is a tool that generates parser libraries for programming languages, and provides an API for interacting with those parsers. +- The generated parsers can create syntax trees from source code text. +- The nodes of those trees are defined by the grammar. +- Emacs can use these generated parsers to provide major modes with things like syntax highlighting, indentation, navigation, structural editing, and many other things. ## Important Definitions -- Parser: A dynamic library compiled from C source code that is generated by the tree-sitter tool. A parser reads source code for a particular language and produces a syntax tree. -- Grammar: The rules that define how a parser will create the syntax tree for a language. The grammar is written in javascript. Tree-sitter tooling consumes the grammar as input and outputs C source (which can be compiled into a parser) -- Syntax Tree: a tree data structure comprised of syntax nodes that represents some source code text. - - Concrete Syntax Tree: Syntax trees that contain nodes for every token in the source code, including things likes brackets and parentheses. Tree-sitter creates Concrete Syntax Trees. - - Abstract Syntax Tree: A syntax tree with less important details removed. An AST may contain a node for a list, but not individual parentheses. Tree-sitter does not create Abstract Syntax Trees. -- Syntax Node: A node in a syntax tree. It represents some subset of a source code text. Each node has a type, defined by the grammar used to produce it. Some common node types represent language constructs like strings, integers, operators. - - Named Syntax Node: A node that can be identified by a name given to it in the tree-sitter Grammar. In clojure-ts-mode, `list_lit` is a named node for lists. - - Anonymous Syntax Node: A node that cannot be identified by a name. In the Grammar these are identified by simple strings, not by complex Grammar rules. In clojure-ts-mode, `"("` and `")"` are anonymous nodes. -- Font Locking: What Emacs calls "Syntax Highlighting". +- **Parser**: A dynamic library compiled from C source code that is generated by the Tree-sitter tool. A parser reads source code for a particular language and produces a syntax tree. +- **Grammar**: The rules that define how a parser will create the syntax tree for a language. The grammar is written in JavaScript. Tree-sitter tooling consumes the grammar as input and outputs C source (which can be compiled into a parser) +- **Syntax Tree**: a tree data structure comprised of syntax nodes that represents some source code text. + - **Concrete Syntax Tree**: Syntax trees that contain nodes for every token in the source code, including things likes brackets and parentheses. Tree-sitter creates Concrete Syntax Trees. + - **Abstract Syntax Tree**: A syntax tree with less important details removed. An AST may contain a node for a list, but not individual parentheses. Tree-sitter does not create Abstract Syntax Trees. +- **Syntax Node**: A node in a syntax tree. It represents some subset of a source code text. Each node has a type, defined by the grammar used to produce it. Some common node types represent language constructs like strings, integers, operators. + - **Named Syntax Node**: A node that can be identified by a name given to it in the Tree-sitter Grammar. In clojure-ts-mode, `list_lit` is a named node for lists. + - **Anonymous Syntax Node**: A node that cannot be identified by a name. In the Grammar these are identified by simple strings, not by complex Grammar rules. In clojure-ts-mode, `"("` and `")"` are anonymous nodes. +- **Font Locking**: The Emacs terminology for "syntax highlighting". ## tree-sitter-clojure -Clojure-ts-mode uses the tree-sitter-clojure grammar, which can be found at https://github.com/sogaiu/tree-sitter-clojure -The clojure-ts-mode grammar provides very basic, low level nodes that try to match clojure's very light syntax. +`clojure-ts-mode` uses the experimental version tree-sitter-clojure grammar, which +can be found at +. The +grammar provides very basic, low level nodes that try to match +Clojure's very light syntax. There are nodes to represent: -- Symbols (sym_lit) - - Contain (sym_ns) and (sym_name) nodes -- Keywords (kwd_lit) - - Contain (kwd_ns) and (kw_name) nodes -- Strings (str_lit) -- Chars (char_lit) -- Nil (nil_lit) -- Booleans (bool_lit) -- Numbers (num_lit) -- Comments (comment, dis_expr) - - dis_expr is the `#_` discard expression -- Lists (list_list) -- Vectors (vec_lit) -- Maps (map_lit) -- Sets (set_lit) - -There are also nodes to represent metadata, which appear on `meta:` child fields of the nodes the metadata is defined on. -For example a simple vector with metadata defined on it like so + +- Symbols `(sym_lit)` + - Contain `(sym_ns)` and `(sym_name)` nodes +- Keywords `(kwd_lit)` + - Contain `(kwd_ns)` and `(kw_name)` nodes +- Strings `(str_lit)` + - Contains `(str_content)` node +- Chars `(char_lit)` +- Nil `(nil_lit)` +- Booleans `(bool_lit)` +- Numbers `(num_lit)` +- Comments `(comment, dis_expr)` + - `dis_expr` is the `#_` discard expression +- Lists `(list_list)` +- Vectors `(vec_lit)` +- Maps `(map_lit)` +- Sets `(set_lit)` +- Metadata nodes `(meta_lit)` +- Regex content `(regex_content)` +- Function literals `(anon_fn_lit)` + +The best place to learn more about the tree-sitter-clojure grammar is to read +the [grammar.js file from the tree-sitter-clojure repository](https://github.com/sogaiu/tree-sitter-clojure/blob/master/grammar.js "grammar.js"). + +### Difference between stable grammar and experimental + +#### Standalone metadata nodes + +Metadata nodes in stable grammar appear as child nodes of the nodes the metadata +is defined on. For example a simple vector with metadata defined on it like so: ```clojure ^:has-metadata [1] @@ -61,21 +82,53 @@ will produce a parse tree like so ``` (vec_lit - meta: (meta_lit + meta: (meta_lit value: (kwd_lit name: (kwd_name))) value: (num_lit)) ``` -The best place to learn more about the tree-sitter-clojure grammar is to read the [grammar.js file from the tree-sitter-clojure repository](https://github.com/sogaiu/tree-sitter-clojure/blob/master/grammar.js "grammar.js"). +Although it's somewhat closer to how Clojure treats metadata itself, in the +context of a text editor it creates some problems, which were discussed +[here](https://github.com/sogaiu/tree-sitter-clojure/issues/65). To name a few: + +- `forward-sexp` command would skip both, metadata and the node it's attached + to. Called from an opening paren it would signal an error "No more sexp to + move across". +- `kill-sexp` command would kill both, metadata and the node it's attached to. +- `backward-up-list` called from the inside of a list with metadata would move + point to the beginning of metadata node. +- Internally we had to introduce some workarounds to skip metadata nodes or + figure out where the actual node starts. + +#### Special nodes for string content and regex content + +To parse the content of certain strings with a separate grammar, it is necessary +to extract the string's content, excluding its opening and closing quotes. To +achieve this, Emacs 31 allows specifying offsets for `treesit-range-settings`. +However, in Emacs 30.1, this feature is broken due to bug [#77848](https://debbugs.gnu.org/cgi/bugreport.cgi?bug=77848) (a fix is +anticipated in Emacs 30.2). The presence of `str_content` and `regex_content` nodes +allows us to support this feature across all Emacs versions without relying on +offsets. ### Clojure Syntax, not Clojure Semantics -An important observation that anyone familiar with popular tree-sitter grammars may have picked up on is that there are no nodes representing things like functions, macros, types, and other semantic concepts. -Representing the semantics of Clojure in a tree-sitter grammar is much more difficult than traditional languages that do not use macros heavily like Clojure and other lisps. -To understand what an expression represents in Clojure source code requires macro-expansion of the source code. -Macro-expansion requires a runtime, and tree-sitter does not have access to a Clojure runtime and will never have access to a Clojure runtime. -Additionally tree-sitter never looks back on what it has parsed, only forward, considering what is directly ahead of it. So even if it could identify a macro like `myspecialdef` it would forget about it as soon as it moved passed the declaring `defmacro` node. -Another way to think about this: tree-sitter is designed to be fast and good-enough for tooling to implement syntax highlighting, indentation, and other editing conveniences. It is not meant for interpreting and execution. +An important observation that anyone familiar with popular Tree-sitter grammars +may have picked up on is that there are no nodes representing things like +functions, macros, types, and other semantic concepts. Representing the +semantics of Clojure in a Tree-sitter grammar is much more difficult than +traditional languages that do not use macros heavily like Clojure and other +Lisps. + +To understand what an expression represents in Clojure source code +requires macro-expansion of the source code. Macro-expansion requires a +runtime, and Tree-sitter does not have access to a Clojure runtime and will +never have access to a Clojure runtime. Additionally Tree-sitter never looks +back on what it has parsed, only forward, considering what is directly ahead of +it. So even if it could identify a macro like `myspecialdef` it would forget +about it as soon as it moved passed the declaring `defmacro` node. Another way +to think about this: Tree-sitter is designed to be fast and good-enough for +tooling to implement syntax highlighting, indentation, and other editing +conveniences. _It is not meant for interpreting and execution._ #### Example 1: False Negative Function Classification @@ -88,9 +141,11 @@ Consider the following macro (defn2 dog [] "bark") ``` - -This macro lets the caller define a function, but a hypothetical tree-sitter-clojure semantic grammar might just see a function call where a variable dog is passed as an argument. -How should tree-sitter know that `dog` should be highlighted like function? It would have to evaluate the `defn2` macro to understand that. +This macro lets the caller define a function, but a hypothetical +tree-sitter-clojure semantic grammar might just see a function call where a +variable dog is passed as an argument. How should Tree-sitter know that `dog` +should be highlighted like function? It would have to evaluate the `defn2` macro +to understand that. #### Example 2: False Positive Function Classification @@ -105,43 +160,183 @@ How should tree-sitter know that `dog` should be highlighted like function? It w evaluates to 1, and the following -``` +```clojure (foo) ``` evaluates to 1. -How is tree-sitter supposed to understand that `(defn foo [] 2)` of the expression `(no-defn (defn foo [] 2))` is not a function declaration? It would have to evaluate the `no-defn` macro. +How is Tree-sitter supposed to understand that `(defn foo [] 2)` of the expression `(no-defn (defn foo [] 2))` is not a function declaration? It would have to evaluate the `no-defn` macro. #### Syntax and Semantics: Conclusions -While these examples are silly, they illustrate the issue with encoding semantics into the tree-sitter-clojure grammar. -If we tried to make the grammar understand functions, macros, types, and other semantic elements it will end up giving false positives and negatives in the parse tree. -While this is an inevitability for simple static analysis of Clojure code, tree-sitter-clojure chooses to avoid making these kinds of mistakes all-together. -Instead, it is up to the emacs-lisp code and other consumers of the tree-sitter-clojure grammar to make decisions about the semantic meaning of clojure-code. +While these examples are silly, they illustrate the issue with encoding +semantics into the tree-sitter-clojure grammar. If we tried to make the grammar +understand functions, macros, types, and other semantic elements it will end up +giving false positives and negatives in the parse tree. While this is an +inevitability for simple static analysis of Clojure code, tree-sitter-clojure +chooses to avoid making these kinds of mistakes all-together. Instead, it is up +to the emacs-lisp code and other consumers of the tree-sitter-clojure grammar to +make decisions about the semantic meaning of clojure-code. + +There are some pros and cons of this decision for tree-sitter-clojure to only +consider syntax and not semantics. Some of the (non-exhaustive) upsides: -There are some pros and cons of this decision for tree-sitter-clojure to only consider syntax and not semantics. -Some of the (non-exhaustive) upsides: - No semantic false positives or negatives in the parse tree. - Simple grammar to maintain with less nodes and rules - Small, fast grammar (with a small set of grammar rules, tree-sitter-clojure has one of the smallest binaries and fastest grammars in widespread use) - Stability: the grammar changes infrequently and is very stable for downstream consumers -And the primary downside: Semantics must be (re)-implemented in tools that consume the grammar. While this results in more work for tooling authors, the tools that use the grammar are easier to change than the grammar itself. The inaccurate nature of statically interpreting Clojure semantics means that not every decision made for the grammar would meet the needs of the various grammar consumers. This would lead to bugs and feature requests. Nearly all changes to the grammar will result in some sort of breakages to its consumers, so changes are best avoided once the grammar has stabilized. Therefore avoiding these semantic interpretations in the grammar is one of the best ways to minimize changes in the grammar. +And the primary downside: Semantics must be (re)-implemented in tools that +consume the grammar. While this results in more work for tooling authors, the +tools that use the grammar are easier to change than the grammar itself. The +inaccurate nature of statically interpreting Clojure semantics means that not +every decision made for the grammar would meet the needs of the various grammar +consumers. This would lead to bugs and feature requests. Nearly all changes to +the grammar will result in some sort of breakages to its consumers, so changes +are best avoided once the grammar has stabilized. Therefore avoiding these +semantic interpretations in the grammar is one of the best ways to minimize +changes in the grammar. #### Further Reading -- https://github.com/sogaiu/tree-sitter-clojure/blob/master/doc/scope.md -- https://tree-sitter.github.io/tree-sitter/using-parsers#named-vs-anonymous-nodes +- +- ## Syntax Highlighting -TODO +To set up Tree-sitter fontification, `clojure-ts-mode` sets the +`treesit-font-lock-settings` variable with the output of +`clojure-ts--font-lock-settings`, and then calls `treesit-major-mode-setup`. -## Indentation +`clojure-ts--font-lock-settings` returns a list of compiled queries. Each query +must have at least one capture name (names that start with `@`). If a capture +name matches an existing face name (e.g., `font-lock-keyword-face`), the +captured node will be fontified with that face. + +A capture name can also be arbitrary and used to check the text of the captured +node. It can also be used for both fontification and text checking. For +example in the following query: + +```emacs-lisp +`((list_lit :anchor [(comment) (meta_lit) (old_meta_lit)] :* + :anchor (sym_lit !namespace name: (sym_name) @font-lock-keyword-face)) + (:match ,clojure-ts--builtin-symbol-regexp @font-lock-keyword-face)) +``` -TODO +We match any list whose first symbol (skipping any number of comments and +metadata nodes) does not have a namespace and matches a regex stored in the +`clojure-ts--builtin-symbol-regexp` variable. The matched symbol is fontified +using `font-lock-keyword-face`. + +> [!IMPORTANT] +> +> Compiling queries at runtime is very expensive; therefore, it should be +> avoided as much as possible. Ideally, all queries should be pre-compiled and +> stored as `defconst` constants. + +### Embedded parsers + +The Clojure grammar in `clojure-ts-mode` is a main or "host" grammar. Emacs +also supports the use of any number of "embedded" grammars. `clojure-ts-mode` +currently uses the `markdown-inline` grammar to highlight Markdown constructs in +docstrings and the `regex` grammar to highlight regular expression syntax. + +To use an embedded parser, `clojure-ts-mode` must set an appropriate value for +the `treesit-range-settings` variable. The Clojure grammar provides convenient +nodes to capture only the content of strings and regexes, which makes defining +range settings for regexes quite simple: + +```emacs-lisp +(treesit-range-rules + :embed 'regex + :host 'clojure + :local t + '((regex_content) @capture)) +``` + +For docstrings, the query is a bit more complex. Therefore, we have the +function `clojure-ts--docstring-query`, which is used for syntax highlighting, +indentation rules, and range settings for the embedded Markdown parser: + +```emacs-lisp +(treesit-range-rules + :embed 'markdown-inline + :host 'clojure + :local t + (clojure-ts--docstring-query '@capture)) + ``` + +It is important to use the `:local` option for embedded parsers; otherwise, the +range will not be restricted to the captured node, which will lead to broken +fontification (see bug [#77733](https://debbugs.gnu.org/cgi/bugreport.cgi?bug=77733)). + +### Additional information + +To find more details one can evaluate the following expression in Emacs: -## Semantic Interpretation in clojure-ts-mode +```emacs-lisp +(info "(elisp) Parser-based Font Lock") +``` + +## Indentation -TODO: demonstrate how clojure-ts-mode creates semantic meaning from a given syntax tree. Show examples of how new semantic meaning can be added (with highlighting, indentation, etc). +To enable the parser-based indentation engine, `clojure-ts-mode` sets the +`treesit-simple-indent-rules` with the output of +`clojure-ts--configured-indent-rules`, and then call `treesit-major-mode-setup`. + +According to the documentation of `treesit-simple-indnet-rules` variable, its +values is: + +> A list of indent rule settings. +> Each indent rule setting should be (LANGUAGE RULE...), where LANGUAGE is +> a language symbol, and each RULE is of the form +> +> (MATCHER ANCHOR OFFSET) +> +> MATCHER determines whether this rule applies, ANCHOR and +> OFFSET together determines which column to indent to. + +For example rule like this: + +```emacs-lisp +'((clojure + ((parent-is "^vec_lit$") parent 1) + ((parent-is "^map_lit$") parent 1) + ((parent-is "^set_lit$") parent 2))) +``` + +will indent any node whose parent node is a `vec_lit` or `map_lit` with 1 space, +starting from the beginning of the parent node. For `set_lit`, it will add two +spaces because sets have two opening characters: `#` and `{`. + +In the example above, the `parent-is` matcher and `parent` anchor are built-in +presets. There are many predefined presets provided by Emacs. The list of all +available presets can be found in the documentation for the +`treesit-simple-indent-presets` variable. + +Sometimes, more complex behavior than predefined built-in presets is required. +In such cases, you can write your own matchers and anchors. One good example is +the `clojure-ts--match-form-body` matcher. It attempts to match a node at point +using the combined value of `clojure-ts--semantic-indent-rules-defaults` and +`clojure-ts-semantic-indent-rules`. These rules have a similar format to cljfmt +indentation rules. `clojure-ts-semantic-indent-rules` is a customization option +that users can tweak. `clojure-ts--match-form-body` traverses the syntax tree, +starting from the node at point, towards the top of the tree in order to find a +match. In addition to `clojure-ts--semantic-indent-rules-defaults` and +`clojure-ts-semantic-indent-rules`, it may also use `clojure-ts-get-indent-function` +if it is not `nil`. This function provides an API for dynamic indentation and +must return a value compatible with `cider-nrepl`. Searching for an indentation +rule across all these variables is slow; therefore, +`clojure-ts--semantic-indent-rules-cache` was introduced. It is set when +`clojure-ts-mode` is activated in a Clojure source buffer and refreshed every time +`clojure-ts-semantic-indent-rules` is updated (using setopt or the customization +interface) or when a `.dir-locals.el` file is updated. + +### Additional information + +To find more details one can evaluate the following expression in Emacs: + +```emacs-lisp +(info "(elisp) Parser-based Indentation") +``` diff --git a/doc/release-process b/doc/release-process new file mode 100644 index 0000000..37668c0 --- /dev/null +++ b/doc/release-process @@ -0,0 +1,25 @@ +Instructions for releasing a new version. + +Review the ## main (unreleased) heading in CHANGELOG.md. Add links to commits +for each entry so users can reference them. Add a thank you note for entries +contributed by people who are not primary maintainers. + +Add a new heading in the CHANGELOG.md file corresponding to the next version +number. Following this the ## main (unreleased) heading should be empty + +Update clojure-ts-mode.el Version: property in the package comment at the top of +the file to match the upcomming version number. + +Create a new commit on main branch with all the above changes. + +Add a new tag for the corresponding version on the commit just created. This is +needed by MELPA. The tag should follow the format (without quotes) "vM.m.p" +where M is the major number, m is the minor number, and p is the patch number. +The tag should have a comment referring readers to the CHANGELOG.md file. It +should read something like + + Release v.M.m.p + + See CHANGELOG.md for more details + +Make sure gpg signing is enabled when creating the commit and tags. diff --git a/screenshots/markdown-syntax-dark-theme.png b/screenshots/markdown-syntax-dark-theme.png new file mode 100644 index 0000000..7a908ac Binary files /dev/null and b/screenshots/markdown-syntax-dark-theme.png differ diff --git a/screenshots/regex-syntax-dark-theme.png b/screenshots/regex-syntax-dark-theme.png new file mode 100644 index 0000000..ad7ee45 Binary files /dev/null and b/screenshots/regex-syntax-dark-theme.png differ diff --git a/test/clojure-ts-mode-completion.el b/test/clojure-ts-mode-completion.el new file mode 100644 index 0000000..ffa30df --- /dev/null +++ b/test/clojure-ts-mode-completion.el @@ -0,0 +1,202 @@ +;;; clojure-ts-mode-completion.el --- clojure-ts-mode: completion tests -*- lexical-binding: t; -*- + +;; Copyright (C) 2025 Roman Rudakov + +;; Author: Roman Rudakov +;; Keywords: + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; Completion is a unique `clojure-ts-mode' feature. + +;;; Code: + +(require 'clojure-ts-mode) +(require 'buttercup) +(require 'test-helper "test/test-helper") + +(describe "clojure-ts-complete-at-point-function" + ;; NOTE: This function returns unfiltered candidates, so prefix doesn't really + ;; matter here. + + (it "should complete global vars" + (with-clojure-ts-buffer-point " +(def foo :first) + +(def bar :second) + +(defn baz + [] + (println foo bar)) + +b|" + (expect (nth 2 (clojure-ts-completion-at-point-function)) + :to-equal '(("foo" . defun-candidate) + ("bar" . defun-candidate) + ("baz" . defun-candidate) + (":first" . keyword-candidate) + (":second" . keyword-candidate))))) + + (it "should complete function arguments" + (with-clojure-ts-buffer-point " +(def foo :first) + +(def bar :second) + +(defn baz + [username] + (println u|))" + (expect (nth 2 (clojure-ts-completion-at-point-function)) + :to-equal '(("foo" . defun-candidate) + ("bar" . defun-candidate) + ("baz" . defun-candidate) + (":first" . keyword-candidate) + (":second" . keyword-candidate) + ("username" . local-candidate))))) + + (it "should not complete function arguments outside of function" + (with-clojure-ts-buffer-point " +(def foo :first) + +(def bar :second) + +(defn baz + [username] + (println bar)) + +u|" + (expect (nth 2 (clojure-ts-completion-at-point-function)) + :to-equal '(("foo" . defun-candidate) + ("bar" . defun-candidate) + ("baz" . defun-candidate) + (":first" . keyword-candidate) + (":second" . keyword-candidate))))) + + (it "should complete destructured function arguments" + (with-clojure-ts-buffer-point " +(defn baz + [{:keys [username]}] + (println u|))" + (expect (nth 2 (clojure-ts-completion-at-point-function)) + :to-equal '(("baz" . defun-candidate) + (":keys" . keyword-candidate) + ("username" . local-candidate)))) + + (with-clojure-ts-buffer-point " +(defn baz + [{:strs [username]}] + (println u|))" + (expect (nth 2 (clojure-ts-completion-at-point-function)) + :to-equal '(("baz" . defun-candidate) + (":strs" . keyword-candidate) + ("username" . local-candidate)))) + + (with-clojure-ts-buffer-point " +(defn baz + [{:syms [username]}] + (println u|))" + (expect (nth 2 (clojure-ts-completion-at-point-function)) + :to-equal '(("baz" . defun-candidate) + (":syms" . keyword-candidate) + ("username" . local-candidate)))) + + (with-clojure-ts-buffer-point " +(defn baz + [{username :name}] + (println u|))" + (expect (nth 2 (clojure-ts-completion-at-point-function)) + :to-equal '(("baz" . defun-candidate) + (":name" . keyword-candidate) + ("username" . local-candidate)))) + + (with-clojure-ts-buffer-point " +(defn baz + [[first-name last-name]] + (println f|))" + (expect (nth 2 (clojure-ts-completion-at-point-function)) + :to-equal '(("baz" . defun-candidate) + ("first-name" . local-candidate) + ("last-name" . local-candidate))))) + + (it "should complete vector bindings" + (with-clojure-ts-buffer-point " +(defn baz + [first-name] + (let [last-name \"Doe\" + address {:street \"Whatever\" :zip-code 2222} + {:keys [street zip-code]} address] + a|))" + (expect (nth 2 (clojure-ts-completion-at-point-function)) + :to-equal '(("baz" . defun-candidate) + (":street" . keyword-candidate) + (":zip-code" . keyword-candidate) + (":keys" . keyword-candidate) + ("first-name" . local-candidate) + ("last-name" . local-candidate) + ("address" . local-candidate) + ("street" . local-candidate) + ("zip-code" . local-candidate))))) + + (it "should not complete called function names" + (with-clojure-ts-buffer-point " +(defn baz + [first-name] + (let [full-name (str first-name \"Doe\")] + s|))" + ;; `str' should not be among the candidates. + (expect (nth 2 (clojure-ts-completion-at-point-function)) + :to-equal '(("baz" . defun-candidate) + ("first-name" . local-candidate) + ("full-name" . local-candidate))))) + + (it "should complete any keyword" + (with-clojure-ts-buffer-point " +(defn baz + [first-name] + (let [last-name \"Doe\" + address {:street \"Whatever\" :zip-code 2222} + {:keys [street zip-code]} address] + (println street zip-code))) + +:|" + (expect (nth 2 (clojure-ts-completion-at-point-function)) + :to-equal '(("baz" . defun-candidate) + (":street" . keyword-candidate) + (":zip-code" . keyword-candidate) + (":keys" . keyword-candidate))))) + + (it "should complete locals of for bindings" + (with-clojure-ts-buffer-point " +(for [digit [\"one\" \"two\" \"three\"] + :let [prefixed-digit (str \"hello-\" digit)]] + (println d|))" + (expect (nth 2 (clojure-ts-completion-at-point-function)) + :to-equal '((":let" . keyword-candidate) + ("digit" . local-candidate) + ("prefixed-digit" . local-candidate))))) + + (it "should complete locals of doseq bindings" + (with-clojure-ts-buffer-point " +(doseq [digit [\"one\" \"two\" \"three\"] + :let [prefixed-digit (str \"hello-\" digit)]] + (println d|))" + (expect (nth 2 (clojure-ts-completion-at-point-function)) + :to-equal '((":let" . keyword-candidate) + ("digit" . local-candidate) + ("prefixed-digit" . local-candidate)))))) + +(provide 'clojure-ts-mode-completion) +;;; clojure-ts-mode-completion.el ends here diff --git a/test/clojure-ts-mode-convert-collection-test.el b/test/clojure-ts-mode-convert-collection-test.el new file mode 100644 index 0000000..05e04f6 --- /dev/null +++ b/test/clojure-ts-mode-convert-collection-test.el @@ -0,0 +1,119 @@ +;;; clojure-ts-mode-convert-collection-test.el --- Clojure[TS] Mode convert collection type. -*- lexical-binding: t; -*- + +;; Copyright (C) 2025 Roman Rudakov + +;; Author: Roman Rudakov + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; Adapted from `clojure-mode'. + +;;; Code: + +(require 'clojure-ts-mode) +(require 'buttercup) +(require 'test-helper "test/test-helper") + +(describe "clojure-ts-convert-collection-to-map" + (when-refactoring-it "should convert a list to a map" + "(:a 1 :b 2)" + "{:a 1 :b 2}" + (backward-sexp) + (down-list) + (clojure-ts-convert-collection-to-map)) + + (it "should signal a user error when there is no collection at point" + (with-clojure-ts-buffer "false" + (backward-sexp) + (expect (clojure-ts-convert-collection-to-map) + :to-throw + 'user-error + '("No collection at point to convert"))))) + +(describe "clojure-ts-convert-collection-to-vector" + (when-refactoring-it "should convert a map to a vector" + "{:a 1 :b 2}" + "[:a 1 :b 2]" + (backward-sexp) + (down-list) + (clojure-ts-convert-collection-to-vector)) + + (it "should signal a user error when there is no collection at point" + (with-clojure-ts-buffer "false" + (backward-sexp) + (expect (clojure-ts-convert-collection-to-vector) + :to-throw + 'user-error + '("No collection at point to convert"))))) + +(describe "clojure-ts-convert-collection-to-set" + (when-refactoring-it "should convert a vector to a set" + "[1 2 3]" + "#{1 2 3}" + (backward-sexp) + (down-list) + (clojure-ts-convert-collection-to-set)) + + (when-refactoring-it "should convert a quoted list to a set" + "'(1 2 3)" + "#{1 2 3}" + (backward-sexp) + (down-list) + (clojure-ts-convert-collection-to-set)) + + (it "should signal a user error when there is no collection at point" + (with-clojure-ts-buffer "false" + (backward-sexp) + (expect (clojure-ts-convert-collection-to-set) + :to-throw + 'user-error + '("No collection at point to convert"))))) + +(describe "clojure-ts-convert-collection-to-list" + (when-refactoring-it "should convert a set to a list" + "#{1 2 3}" + "(1 2 3)" + (backward-sexp) + (down-list) + (clojure-ts-convert-collection-to-list)) + + (it "should signal a user error when there is no collection at point" + (with-clojure-ts-buffer "false" + (backward-sexp) + (expect (clojure-ts-convert-collection-to-list) + :to-throw + 'user-error + '("No collection at point to convert"))))) + +(describe "clojure-ts-convert-collection-to-quoted-list" + (when-refactoring-it "should convert a set to a quoted list" + "#{1 2 3}" + "'(1 2 3)" + (backward-sexp) + (down-list) + (clojure-ts-convert-collection-to-quoted-list)) + + (it "should signal a user error when there is no collection at point" + (with-clojure-ts-buffer "false" + (backward-sexp) + (expect (clojure-ts-convert-collection-to-quoted-list) + :to-throw + 'user-error + '("No collection at point to convert"))))) + + +(provide 'clojure-ts-mode-convert-collection-test) +;;; clojure-ts-mode-convert-collection-test.el ends here diff --git a/test/clojure-ts-mode-cycling-test.el b/test/clojure-ts-mode-cycling-test.el new file mode 100644 index 0000000..81eef67 --- /dev/null +++ b/test/clojure-ts-mode-cycling-test.el @@ -0,0 +1,272 @@ +;;; clojure-ts-mode-cycling-test.el --- Clojure[TS] Mode: cycling things tests -*- lexical-binding: t; -*- + +;; Copyright (C) 2025 Roman Rudakov + +;; Author: Roman Rudakov + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; The code is adapted from `clojure-mode'. + +;;; Code: + +(require 'clojure-ts-mode) +(require 'buttercup) +(require 'test-helper "test/test-helper") + +(describe "clojure-ts-cycle-keyword-string" + (when-refactoring-with-point-it "should convert string to keyword" + "\"hel|lo\"" + + ":hel|lo" + + (clojure-ts-cycle-keyword-string)) + + (when-refactoring-with-point-it "should convert keyword to string" + ":|hello" + + "\"|hello\"" + + (clojure-ts-cycle-keyword-string)) + + (it "should signal a user error when there is nothing to convert at point" + (with-clojure-ts-buffer "[true false]" + (goto-char 2) + (expect (clojure-ts-cycle-keyword-string) + :to-throw + 'user-error + '("No string or keyword at point")))) + + (it "should signal a user error when string at point contains spaces" + (with-clojure-ts-buffer "\"Hello world\"" + (goto-char 2) + (expect (clojure-ts-cycle-keyword-string) + :to-throw + 'user-error + '("Cannot convert a string containing spaces to keyword"))))) + +(describe "clojure-ts-cycle-privacy" + + (when-refactoring-it "should turn a public defn into a private defn" + "(defn add [a b] + (+ a b))" + + "(defn- add [a b] + (+ a b))" + + (clojure-ts-cycle-privacy)) + + (when-refactoring-it "should also work from the beginning of a sexp" + "(defn- add [a b] + (+ a b))" + + "(defn add [a b] + (+ a b))" + + (backward-sexp) + (clojure-ts-cycle-privacy)) + + (when-refactoring-it "should use metadata when clojure-use-metadata-for-privacy is set to true" + "(defn add [a b] + (+ a b))" + + "(defn ^:private add [a b] + (+ a b))" + + (let ((clojure-ts-use-metadata-for-defn-privacy t)) + (clojure-ts-cycle-privacy))) + + (when-refactoring-it "should turn a private defn into a public defn" + "(defn- add [a b] + (+ a b))" + + "(defn add [a b] + (+ a b))" + + (clojure-ts-cycle-privacy)) + + (when-refactoring-it "should turn a private defn with metadata into a public defn" + "(defn ^:private add [a b] + (+ a b))" + + "(defn add [a b] + (+ a b))" + + (let ((clojure-ts-use-metadata-for-defn-privacy t)) + (clojure-ts-cycle-privacy))) + + (when-refactoring-it "should also work with pre-existing metadata" + "(def ^:dynamic config + \"docs\" + {:env \"staging\"})" + + "(def ^:private ^:dynamic config + \"docs\" + {:env \"staging\"})" + + (clojure-ts-cycle-privacy)) + + (when-refactoring-it "should turn a private def with metadata into a public def" + "(def ^:private config + \"docs\" + {:env \"staging\"})" + + "(def config + \"docs\" + {:env \"staging\"})" + + (clojure-ts-cycle-privacy)) + + (when-refactoring-it "should turn a public defmulti into a private defmulti" + "(defmulti service-charge (juxt account-level :tag))" + + "(defmulti ^:private service-charge (juxt account-level :tag))" + + (clojure-ts-cycle-privacy)) + + (when-refactoring-it "should turn a private defmulti into a public defmulti" + "(defmulti ^:private service-charge (juxt account-level :tag))" + + "(defmulti service-charge (juxt account-level :tag))" + + (clojure-ts-cycle-privacy)) + + (when-refactoring-it "should turn a public defmacro into a private defmacro" + "(defmacro unless [pred a b] + `(if (not ~pred) ~a ~b))" + + "(defmacro ^:private unless [pred a b] + `(if (not ~pred) ~a ~b))" + + (clojure-ts-cycle-privacy)) + + (when-refactoring-it "should turn a private defmacro into a public defmacro" + "(defmacro ^:private unless [pred a b] + `(if (not ~pred) ~a ~b))" + + "(defmacro unless [pred a b] + `(if (not ~pred) ~a ~b))" + + (clojure-ts-cycle-privacy)) + + (when-refactoring-it "should turn a private definline into a public definline" + "(definline bad-sqr [x] `(* ~x ~x))" + + "(definline ^:private bad-sqr [x] `(* ~x ~x))" + + (clojure-ts-cycle-privacy)) + + (when-refactoring-it "should turn a public definline into a private definline" + "(definline ^:private bad-sqr [x] `(* ~x ~x))" + + "(definline bad-sqr [x] `(* ~x ~x))" + + (clojure-ts-cycle-privacy)) + + (when-refactoring-it "should turn a private defrecord into a public defrecord" + "(defrecord Person [fname lname address])" + + "(defrecord ^:private Person [fname lname address])" + + (clojure-ts-cycle-privacy)) + + (when-refactoring-it "should turn a public defrecord into a private defrecord" + "(defrecord ^:private Person [fname lname address])" + + "(defrecord Person [fname lname address])" + + (clojure-ts-cycle-privacy))) + +(describe "clojure-cycle-if" + + (when-refactoring-with-point-it "should cycle inner if" + "(if this + (if |that + (then AAA) + (else BBB)) + (otherwise CCC))" + + "(if this + (if-not |that + (else BBB) + (then AAA)) + (otherwise CCC))" + + (clojure-ts-cycle-conditional)) + + (when-refactoring-with-point-it "should cycle outer if" + "(if-not |this + (if that + (then AAA) + (else BBB)) + (otherwise CCC))" + + "(if |this + (otherwise CCC) + (if that + (then AAA) + (else BBB)))" + + (clojure-ts-cycle-conditional))) + +(describe "clojure-cycle-when" + + (when-refactoring-with-point-it "should cycle inner when" + "(when this + (when |that + (aaa) + (bbb)) + (ccc))" + + "(when this + (when-not |that + (aaa) + (bbb)) + (ccc))" + + (clojure-ts-cycle-conditional)) + + (when-refactoring-with-point-it "should cycle outer when" + "(when-not |this + (when that + (aaa) + (bbb)) + (ccc))" + + "(when |this + (when that + (aaa) + (bbb)) + (ccc))" + + (clojure-ts-cycle-conditional))) + +(describe "clojure-cycle-not" + + (when-refactoring-with-point-it "should add a not when missing" + "(ala bala| portokala)" + "(not (ala bala| portokala))" + + (clojure-ts-cycle-not)) + + (when-refactoring-with-point-it "should remove a not when present" + "(not (ala bala| portokala))" + "(ala bala| portokala)" + + (clojure-ts-cycle-not))) + +(provide 'clojure-ts-mode-cycling-test) +;;; clojure-ts-mode-cycling-test.el ends here diff --git a/test/clojure-ts-mode-fill-paragraph-test.el b/test/clojure-ts-mode-fill-paragraph-test.el new file mode 100644 index 0000000..a7e2dde --- /dev/null +++ b/test/clojure-ts-mode-fill-paragraph-test.el @@ -0,0 +1,62 @@ +;;; clojure-ts-mode-fill-paragraph-test.el --- -*- lexical-binding: t; -*- + +;; Copyright (C) 2025 Roman Rudakov + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; The unit test suite of CLojure TS Mode + +;;; Code: + +(require 'clojure-ts-mode) +(require 'buttercup) + +(describe "clojure-ts--fill-paragraph" + (it "should reformat only the docstring" + (with-clojure-ts-buffer "(ns foo) + +(defn hello-world + \"This is a very long docstring that should be reformatted using fill-paragraph function.\" + [] + (pringln \"Hello world\"))" + (goto-char 40) + (prog-fill-reindent-defun) + (expect (buffer-substring-no-properties (point-min) (point-max)) + :to-equal + "(ns foo) + +(defn hello-world + \"This is a very long docstring that should be reformatted using + fill-paragraph function.\" + [] + (pringln \"Hello world\"))"))) + + (it "should reformat normal comments properly" + (with-clojure-ts-buffer "(ns foo) + +;; This is a very long comment that should be reformatted using fill-paragraph function." + (goto-char 20) + (prog-fill-reindent-defun) + (expect (buffer-substring-no-properties (point-min) (point-max)) + :to-equal + "(ns foo) + +;; This is a very long comment that should be reformatted using +;; fill-paragraph function.")))) + +;;; clojure-ts-mode-fill-paragraph-test.el ends here diff --git a/test/clojure-ts-mode-font-lock-test.el b/test/clojure-ts-mode-font-lock-test.el new file mode 100644 index 0000000..4770ccf --- /dev/null +++ b/test/clojure-ts-mode-font-lock-test.el @@ -0,0 +1,251 @@ +;;; clojure-ts-mode-font-lock-test.el --- Clojure TS Mode: font lock test suite -*- lexical-binding: t; -*- + +;; Copyright © 2022-2025 Danny Freeman + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; The unit test suite of Clojure TS Mode + +(require 'clojure-ts-mode) +(require 'cl-lib) +(require 'buttercup) + +;; (use-package buttercup) + +;;;; Utilities + +(defmacro with-fontified-clojure-ts-buffer (content &rest body) + "Evaluate BODY in a temporary buffer with CONTENT." + (declare (debug t) + (indent 1)) + `(with-clojure-ts-buffer ,content + (font-lock-ensure) + (goto-char (point-min)) + ,@body)) + +(defun clojure-ts-get-face-at (start end content) + "Get the face between START and END in CONTENT." + (with-fontified-clojure-ts-buffer content + (let ((start-face (get-text-property start 'face)) + (all-faces (cl-loop for i from start to end collect (get-text-property + i 'face)))) + (if (cl-every (lambda (face) (eq face start-face)) all-faces) + start-face + 'various-faces)))) + +(defun expect-face-at (content start end face) + "Expect face in CONTENT between START and END to be equal to FACE." + (expect (clojure-ts-get-face-at start end content) :to-equal face)) + +(defun expect-faces-at (content &rest faces) + "Expect FACES in CONTENT. + +FACES is a list of the form (content (start end expected-face)*)" + (dolist (face faces) + (apply (apply-partially #'expect-face-at content) face))) + +(defmacro when-fontifying-it (description &rest tests) + "Return a buttercup spec. + +TESTS are lists of the form (content (start end expected-face)*). For each test +check that each `expected-face` is found in `content` between `start` and `end`. + +DESCRIPTION is the description of the spec." + (declare (indent 1)) + `(it ,description + (dolist (test (quote ,tests)) + (apply #'expect-faces-at test)))) + +;;;; Font locking + +(describe "clojure-ts-mode-syntax-table" + (when-fontifying-it "should handle any known def form" + ("(def a 1)" (2 4 font-lock-keyword-face)) + ("(defonce a 1)" (2 8 font-lock-keyword-face)) + ("(defn a [b])" (2 5 font-lock-keyword-face)) + ("(defmacro a [b])" (2 9 font-lock-keyword-face)) + ("(definline a [b])" (2 10 font-lock-keyword-face)) + ("(defmulti a identity)" (2 9 font-lock-keyword-face)) + ("(defmethod a :foo [b] (println \"bar\"))" (2 10 font-lock-keyword-face)) + ("(defprotocol a (b [this] \"that\"))" (2 12 font-lock-keyword-face)) + ("(definterface a (b [c]))" (2 13 font-lock-keyword-face)) + ("(defrecord a [b c])" (2 10 font-lock-keyword-face)) + ("(deftype a [b c])" (2 8 font-lock-keyword-face)) + ("(defstruct a :b :c)" (2 10 font-lock-keyword-face)) + ("(deftest a (is (= 1 1)))" (2 8 font-lock-keyword-face)) + + + ;; TODO: copied from clojure-mode, but failing + ;; ("(defne [x y])" (2 6 font-lock-keyword-face)) + ;; ("(defnm a b)" (2 6 font-lock-keyword-face)) + ;; ("(defnu)" (2 6 font-lock-keyword-face)) + ;; ("(defnc [a])" (2 6 font-lock-keyword-face)) + ;; ("(defna)" (2 6 font-lock-keyword-face)) + ;; ("(deftask a)" (2 8 font-lock-keyword-face)) + ;; ("(defstate a :start \"b\" :stop \"c\")" (2 9 font-lock-keyword-face)) + + ) + + (when-fontifying-it "variable-def-string-with-docstring" + ("(def foo \"usage\" \"hello\")" + (10 16 font-lock-doc-face) + (18 24 font-lock-string-face)) + + ("(def foo \"usage\" \"hello\" )" + (18 24 font-lock-string-face)) + + ("(def foo \"usage\" \n \"hello\")" + (21 27 font-lock-string-face)) + + ("(def foo \n \"usage\" \"hello\")" + (13 19 font-lock-doc-face)) + + ("(def foo \n \"usage\" \n \"hello\")" + (13 19 font-lock-doc-face) + (24 30 font-lock-string-face)) + + ("(def test-string\n \"this\\n\n is\n my\n string\")" + (20 24 font-lock-string-face) + (25 26 font-lock-string-face) + (27 46 font-lock-string-face))) + + (when-fontifying-it "variable-def-with-metadata-and-docstring" + ("^{:foo bar}(def foo \n \"usage\" \n \"hello\")" + (13 15 font-lock-keyword-face) + (17 19 font-lock-variable-name-face) + (24 30 font-lock-doc-face) + (35 41 font-lock-string-face))) + + (when-fontifying-it "defn-with-metadata-and-docstring" + ("^{:foo bar}(defn foo \n \"usage\" \n [] \n \"hello\")" + (13 16 font-lock-keyword-face) + (18 20 font-lock-function-name-face) + (25 31 font-lock-doc-face) + (40 46 font-lock-string-face))) + + (when-fontifying-it "fn-with-name" + ("(fn named-lambda [x] x)" + (2 3 font-lock-keyword-face) + (5 16 font-lock-function-name-face))) + + (when-fontifying-it "single-keyword-metadata" + ("(def ^:private my-private-var true)" + (2 4 font-lock-keyword-face) + (6 6 font-lock-operator-face) + (7 14 clojure-ts-keyword-face) + (16 29 font-lock-variable-name-face) + (31 34 font-lock-constant-face))) + + (when-fontifying-it "built-ins" + ("(for [x [1 2 3]] x)" + (2 4 font-lock-keyword-face)) + + ("(clojure.core/for [x [1 2 3]] x)" + (2 13 font-lock-type-face) + (15 17 font-lock-keyword-face))) + + (when-fontifying-it "non-built-ins-with-same-name" + ("(h/for query {})" + (2 2 font-lock-type-face) + (4 6 nil))) + + (when-fontifying-it "special-forms-with-metadata" + ("^long (if true 1 2)" + (2 5 font-lock-type-face) + (8 9 font-lock-keyword-face))) + + (when-fontifying-it "function literals" + ("#(or one two)" + (3 4 font-lock-keyword-face))) + + (when-fontifying-it "should highlight function name in all known forms" + ("(letfn [(add [x y] + (+ x y)) + (hello [user] + (println \"Hello\" user))] + (dotimes [_ (add 6 8)] + (hello \"John Doe\")))" + (2 6 font-lock-keyword-face) + (10 12 font-lock-function-name-face) + (48 52 font-lock-function-name-face)) + + ("(reify + AutoCloseable + (close [this] (.close this)))" + (2 6 font-lock-keyword-face) + (27 31 font-lock-function-name-face)) + + ("(defrecord TestRecord [field] + AutoCloseable + (close [this] + (.close this)))" + (2 10 font-lock-keyword-face) + (12 21 font-lock-type-face) + (50 54 font-lock-function-name-face)) + + ("(definterface MyInterface + (^String name []) + (^double mass []))" + (2 13 font-lock-keyword-face) + (15 25 font-lock-type-face) + (31 36 font-lock-type-face) + (38 41 font-lock-function-name-face) + (51 56 font-lock-type-face) + (58 61 font-lock-function-name-face)) + + ("(deftype ImageSelection [data] + Transferable + (getTransferDataFlavors + [this] + (into-array DataFlavor [DataFlavor/imageFlavor])))" + (2 8 font-lock-keyword-face) + (10 23 font-lock-type-face) + (50 71 font-lock-function-name-face)) + + ("(defprotocol P + (foo [this]) + (bar-me [this] [this y]))" + (2 12 font-lock-keyword-face) + (14 14 font-lock-type-face) + (19 21 font-lock-function-name-face) + (34 39 font-lock-function-name-face)) + + ("(extend-protocol prepare/SettableParameter + clojure.lang.IPersistentMap + (set-parameter [m ^PreparedStatement s i] + (.setObject s i (->pgobject m))))" + (81 93 font-lock-function-name-face)))) + +;;;; Extra def forms + +(describe "clojure-ts-extra-def-forms" + (it "should respect the value of clojure-ts-extra-def-forms" + (with-clojure-ts-buffer "(defelem file-upload + \"Creates a file upload input.\" + [name] + (input-field \"file\" name nil))" + (setopt clojure-ts-extra-def-forms '("defelem")) + (clojure-ts-mode) + (font-lock-ensure) + (goto-char (point-min)) + (expect (get-text-property 2 'face) + :to-equal 'font-lock-keyword-face) + (expect (get-text-property 10 'face) + :to-equal 'font-lock-function-name-face) + (expect (get-text-property 25 'face) + :to-equal 'font-lock-doc-face)))) diff --git a/test/clojure-ts-mode-imenu-test.el b/test/clojure-ts-mode-imenu-test.el new file mode 100644 index 0000000..1822231 --- /dev/null +++ b/test/clojure-ts-mode-imenu-test.el @@ -0,0 +1,46 @@ +;;; clojure-ts-mode-imenu-test.el --- Clojure TS Mode: imenu test suite -*- lexical-binding: t; -*- + +;; Copyright © 2022-2025 Danny Freeman + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; The unit test suite of Clojure TS Mode + +(require 'clojure-ts-mode) +(require 'buttercup) +(require 'imenu) + + +(describe "clojure-ts-mode imenu integration" + (it "should index def with meta data" + (with-clojure-ts-buffer "^{:foo 1}(def a 1)" + (let ((flatten-index (imenu--flatten-index-alist (imenu--make-index-alist) t))) + (expect (imenu-find-default "a" flatten-index) + :to-equal "Variable:a")))) + + (it "should index defn with meta data" + (with-clojure-ts-buffer "^{:foo 1}(defn a [])" + (let ((flatten-index (imenu--flatten-index-alist (imenu--make-index-alist) t))) + (expect (imenu-find-default "a" flatten-index) + :to-equal "Function:a")))) + + (it "should index def with keywords as a first item" + (with-clojure-ts-buffer "(s/def ::username string?)" + (let ((flatten-index (imenu--flatten-index-alist (imenu--make-index-alist) t))) + (expect (imenu-find-default "username" flatten-index) + :to-equal "Keyword:username"))))) diff --git a/test/clojure-ts-mode-indentation-test.el b/test/clojure-ts-mode-indentation-test.el new file mode 100644 index 0000000..d158ed8 --- /dev/null +++ b/test/clojure-ts-mode-indentation-test.el @@ -0,0 +1,612 @@ +;;; clojure-ts-mode-indentation-test.el --- Clojure TS Mode: indentation test suite -*- lexical-binding: t; -*- + +;; Copyright © 2022-2025 Danny Freeman + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; The unit test suite of Clojure TS Mode + +(require 'clojure-ts-mode) +(require 'cl-lib) +(require 'buttercup) +(require 's nil t) ;Don't burp if it's missing during compilation. + + +(defmacro when-indenting-with-point-it (description before after) + "Return a buttercup spec. + +Check whether the swift indentation command will correctly change the buffer. +Will also check whether point is moved to the expected position. + +BEFORE is the buffer string before indenting, where a pipe (|) represents +point. + +AFTER is the expected buffer string after indenting, where a pipe (|) +represents the expected position of point. + +DESCRIPTION is a string with the description of the spec." + (declare (indent 1)) + `(it ,description + (let* ((after ,after) + (expected-cursor-pos (1+ (clojure-ts--s-index-of "|" after))) + (expected-state (delete ?| after))) + (with-clojure-ts-buffer ,before + (goto-char (point-min)) + (search-forward "|") + (delete-char -1) + (font-lock-ensure) + (indent-according-to-mode) + (expect (buffer-string) :to-equal expected-state) + (expect (point) :to-equal expected-cursor-pos))))) + + + +;; Backtracking indent +(defmacro when-indenting-it (description &rest forms) + "Return a buttercup spec. + +Check that all FORMS correspond to properly indented sexps. + +DESCRIPTION is a string with the description of the spec." + (declare (indent 1)) + `(it ,description + (progn + ,@(mapcar (lambda (form) + `(with-temp-buffer + (clojure-ts-mode) + (insert "\n" ,form);,(replace-regexp-in-string "\n +" "\n " form)) + (indent-region (point-min) (point-max)) + (expect (buffer-string) :to-equal ,(concat "\n" form)))) + forms)))) + + +(defmacro when-aligning-it (description &rest forms) + "Return a buttercup spec. + +Check that all FORMS correspond to properly indented sexps. + +DESCRIPTION is a string with the description of the spec." + (declare (indent defun)) + `(it ,description + (let ((clojure-ts-align-forms-automatically t) + (clojure-ts-align-reader-conditionals t)) + ,@(mapcar (lambda (form) + `(with-temp-buffer + (clojure-ts-mode) + (insert "\n" ,(replace-regexp-in-string " +" " " form)) + (indent-region (point-min) (point-max)) + (should (equal (buffer-substring-no-properties (point-min) (point-max)) + ,(concat "\n" form))))) + forms)) + (let ((clojure-ts-align-forms-automatically nil)) + ,@(mapcar (lambda (form) + `(with-temp-buffer + (clojure-ts-mode) + (insert "\n" ,(replace-regexp-in-string " +" " " form)) + ;; This is to check that we did NOT align anything. Run + ;; `indent-region' and then check that no extra spaces + ;; where inserted besides the start of the line. + (indent-region (point-min) (point-max)) + (goto-char (point-min)) + (should-not (search-forward-regexp "\\([^\s\n]\\) +" nil 'noerror)))) + forms)))) + + +;; Provide font locking for easier test editing. + +(font-lock-add-keywords + 'emacs-lisp-mode + `((,(rx "(" (group "when-indenting-with-point-it") eow) + (1 font-lock-keyword-face)) + (,(rx "(" + (group "when-indenting-with-point-it") (+ space) + (group bow (+ (not space)) eow) + ) + (1 font-lock-keyword-face) + (2 font-lock-function-name-face)))) + + +;; Mock `cider--get-symbol-indent' function + +(defun cider--get-symbol-indent-mock (symbol-name) + "Return static mocked indentation specs for SYMBOL-NAME if available." + (when (stringp symbol-name) + (cond + ((string-equal symbol-name "my-with-in-str") 1) + ((string-equal symbol-name "my.alias/my-letfn") '(1 ((:defn)) :form))))) + + +(describe "indentation" + (it "should not hang on end of buffer" + (with-clojure-ts-buffer "(let [a b]" + (goto-char (point-max)) + (expect + (with-timeout (2) + (newline-and-indent) + t)))) + + (when-indenting-with-point-it "should have no indentation at top level" + "|x" + + "|x") + + (when-indenting-it "should handle non-symbol at start" + " +{\"1\" 2 + *3 4}") + + (when-indenting-it "should have no indentation at top level lists with metadata" + " +^{:foo true} +(def b 2)") + + (when-indenting-it "should have no indentation at top level vectors with metadata" + " +^{:foo true} +[1 2]") + + (when-indenting-it "should have no indentation at top level maps with metadata" + " +^{:foo true} +{:a 1}") + + (when-indenting-it "should have no indentation with metadata inside comment" + " +(comment + ^{:a 1} + (def a 2))") + + (when-indenting-it "should have params, docstring and body correctly indented in presence of metadata" + " +^{:foo true} +(defn c + \"hello\" + [_foo] + (+ 1 1))") + +(when-indenting-it "should support function calls via vars" + " +(#'foo 5 + 6)") + +(when-indenting-it "should support function literals" + " +#(or true + false + %)") + +(when-indenting-it "should support block-0 expressions" + " +(do (aligned) + (vertically))" + + " +(do + (indented) + (with-2-spaces))" + + " +(future + (body is indented))" + + " +(try + (something) + ;; A bit of block 2 rule + (catch Exception e + \"Third argument is indented with 2 spaces.\") + (catch ExceptionInfo + e-info + \"Second argument is aligned vertically with the first one.\"))") + +(when-indenting-it "should support block-1 expressions" + " +(case x + 2 (print 2) + 3 (print 3) + (print \"Default\"))" + + " +(cond-> {} + :always (assoc :hello \"World\") + false (do nothing))" + + " +(with-precision 32 + (/ (bigdec 20) (bigdec 30)))" + + " +(testing \"Something should work\" + (is (something-working?)))") + +(when-indenting-it "should support block-2 expressions" + " +(are [x y] + (= x y) + 2 3 + 4 5 + 6 6)" + + " +(as-> {} $ + (assoc $ :hello \"World\"))" + + " +(as-> {} + my-map + (assoc my-map :hello \"World\"))" + + " +(defrecord MyThingR [] + IProto + (foo [this x] x))") + +(when-indenting-it "should support inner-0 expressions" + " +(fn named-lambda [x] + (+ x x))" + + " +(defmethod hello :world + [arg1 arg2] + (+ arg1 arg2))" + + " +(reify + AutoCloseable + (close + [this] + (is properly indented)))") + +(it "should prioritize custom semantic indentation rules" + (with-clojure-ts-buffer " +(are [x y] + (= x y) + 2 3 + 4 5 + 6 6)" + (setopt clojure-ts-semantic-indent-rules '(("are" . ((:block 1))))) + (indent-region (point-min) (point-max)) + (expect (buffer-string) :to-equal " +(are [x y] + (= x y) + 2 3 + 4 5 + 6 6)"))) + +(it "should indent collections elements with metadata correctly" + " +(def x + [a b [c ^:foo + d + e]])" + + " +#{x + y ^:foo + z}" + + " +{:hello ^:foo + \"world\" + :foo + \"bar\"}") + +(it "should indent body of special forms correctly considering metadata" + " +(let [result ^long + (if true + 1 + 2)])") + +(it "should pick up dynamic indentation rules from clojure-ts-get-indent-function" + (with-clojure-ts-buffer " +(defmacro my-with-in-str + \"[DOCSTRING]\" + {:style/indent 1} + [s & body] + ~@body) + +(my-with-in-str \"34\" +(prompt \"How old are you?\"))" + (setq-local clojure-ts-get-indent-function #'cider--get-symbol-indent-mock) + (indent-region (point-min) (point-max)) + (expect (buffer-string) :to-equal " +(defmacro my-with-in-str + \"[DOCSTRING]\" + {:style/indent 1} + [s & body] + ~@body) + +(my-with-in-str \"34\" + (prompt \"How old are you?\"))")) + + (with-clojure-ts-buffer " +(defmacro my-letfn + \"[DOCSTRING]\" + {:style/indent [1 [[:defn]] :form]} + [fnspecs & body] + ~@body) + +(my.alias/my-letfn [(twice [x] + (* x 2)) + (six-times [y] + (* (twice y) 3))] +(println \"Twice 15 =\" (twice 15)) +(println \"Six times 15 =\" (six-times 15)))" + (setq-local clojure-ts-get-indent-function #'cider--get-symbol-indent-mock) + (indent-region (point-min) (point-max)) + (expect (buffer-string) :to-equal " +(defmacro my-letfn + \"[DOCSTRING]\" + {:style/indent [1 [[:defn]] :form]} + [fnspecs & body] + ~@body) + +(my.alias/my-letfn [(twice [x] + (* x 2)) + (six-times [y] + (* (twice y) 3))] + (println \"Twice 15 =\" (twice 15)) + (println \"Six times 15 =\" (six-times 15)))")))) + +(describe "clojure-ts-align" + (it "should handle improperly indented content" + (with-clojure-ts-buffer-point " +(let [a-long-name 10 +b |20])" + (call-interactively #'clojure-ts-align) + (expect (buffer-string) :to-equal " +(let [a-long-name 10 + b 20])")) + + (with-clojure-ts-buffer-point " +(let [^long my-map {:hello \"World\" ;Hello + :foo + ^String (str \"Foo\" \"Bar\") + :number ^long 132 + :zz \"hello\"} + another| {:this ^{:hello \"world\"} \"is\" + :a #long \"1234\" + :b {:this \"is\" + :nested \"map\"}}])" + (call-interactively #'clojure-ts-align) + (expect (buffer-string) :to-equal " +(let [^long my-map {:hello \"World\" ;Hello + :foo + ^String (str \"Foo\" \"Bar\") + :number ^long 132 + :zz \"hello\"} + another {:this ^{:hello \"world\"} \"is\" + :a #long \"1234\" + :b {:this \"is\" + :nested \"map\"}}])")) + + (with-clojure-ts-buffer-point " +(condp = 2 +|123 \"Hello\" +99999 \"World\" +234 nil)" + (call-interactively #'clojure-ts-align) + (expect (buffer-string) :to-equal " +(condp = 2 + 123 \"Hello\" + 99999 \"World\" + 234 nil)"))) + + (it "should not align reader conditionals by defaul" + (with-clojure-ts-buffer-point " +#?(:clj 2 + |:cljs 2)" + (call-interactively #'clojure-ts-align) + (expect (buffer-string) :to-equal " +#?(:clj 2 + :cljs 2)"))) + + (it "should align reader conditionals when clojure-ts-align-reader-conditionals is true" + (with-clojure-ts-buffer-point " +#?(:clj 2 + |:cljs 2)" + (setq-local clojure-ts-align-reader-conditionals t) + (call-interactively #'clojure-ts-align) + (expect (buffer-string) :to-equal " +#?(:clj 2 + :cljs 2)"))) + + (it "should remove extra commas" + (with-clojure-ts-buffer-point "{|:a 2, ,:c 4}" + (call-interactively #'clojure-ts-align) + (expect (buffer-string) :to-equal "{:a 2, :c 4}")))) + +(describe "clojure-ts-align-forms-automatically" + ;; Copied from `clojure-mode' + (when-aligning-it "should basic forms" + " +{:this-is-a-form b + c d}" + + " +{:this-is b + c d}" + + " +{:this b + c d}" + + " +{:a b + c d}" + + " +(let [this-is-a-form b + c d])" + + " +(let [this-is b + c d])" + + " +(let [this b + c d])" + + " +(let [a b + c d])") + + (when-aligning-it "should handle function literals" + " +#(let [hello 1 + foo \"hone\"] + (pringln hello))" + + " +^{:some :metadata} #(let [foo % + bar-zzz %] + foo)") + + (when-aligning-it "should handle a blank line" + " +(let [this-is-a-form b + c d + + another form + k g])" + + " +{:this-is-a-form b + c d + + :another form + k g}") + + (when-aligning-it "should handle basic forms (reversed)" + " +{c d + :this-is-a-form b}" + " +{c d + :this-is b}" + " +{c d + :this b}" + " +{c d + :a b}" + + " +(let [c d + this-is-a-form b])" + + " +(let [c d + this-is b])" + + " +(let [c d + this b])" + + " +(let [c d + a b])") + + (when-aligning-it "should handle multiple words" + " +(cond this is just + a test of + how well + multiple words will work)") + + (when-aligning-it "should handle nested maps" + " +{:a {:a :a + :bbbb :b} + :bbbb :b}") + + (when-aligning-it "should regard end as a marker" + " +{:a {:a :a + :aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa :a} + :b {:a :a + :aa :a}}") + + (when-aligning-it "should handle trailing commas" + " +{:a {:a :a, + :aa :a}, + :b {:a :a, + :aa :a}}") + + (when-aligning-it "should handle standard reader conditionals" + " +#?(:clj 2 + :cljs 2)") + + (when-aligning-it "should handle splicing reader conditional" + " +#?@(:clj [2] + :cljs [2])") + + (when-aligning-it "should handle sexps broken up by line comments" + " +(let [x 1 + ;; comment + xx 1] + xx)" + + " +{:x 1 + ;; comment + :xxx 2}" + + " +(case x + :aa 1 + ;; comment + :a 2)") + + (when-aligning-it "should work correctly when margin comments appear after nested, multi-line, non-terminal sexps" + " +(let [x {:a 1 + :b 2} ; comment + xx 3] + x)" + + " +{:aa {:b 1 + :cc 2} ;; comment + :a 1}}" + + " +(case x + :a (let [a 1 + aa (+ a 1)] + aa); comment + :aa 2)") + + (when-aligning-it "should work correctly when there are ignored forms" + "{:map \"with\" + :some #_\"ignored\" \"form\"}" + + "{:map \"with\" + :multiple \"ignored\" + #_#_:forms \"foo\"}") + + (when-aligning-it "should support namespaced maps" + "#:hello {:world true + :foo \"bar\" + :some-very-long \"value\"}")) diff --git a/test/clojure-ts-mode-refactor-add-arity-test.el b/test/clojure-ts-mode-refactor-add-arity-test.el new file mode 100644 index 0000000..f119607 --- /dev/null +++ b/test/clojure-ts-mode-refactor-add-arity-test.el @@ -0,0 +1,364 @@ +;;; clojure-ts-mode-refactor-add-arity-test.el --- Clojure[TS] Mode: refactor add arity test. -*- lexical-binding: t; -*- + +;; Copyright (C) 2025 Roman Rudakov + +;; Author: Roman Rudakov + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; Test for `clojure-ts-add-arity' + +;;; Code: + +(require 'clojure-ts-mode) +(require 'buttercup) +(require 'test-helper "test/test-helper") + +(describe "clojure-ts-add-arity" + + (when-refactoring-with-point-it "should add an arity to a single-arity defn with args on same line" + "(defn foo [arg] + body|)" + + "(defn foo + ([|]) + ([arg] + body))" + + (clojure-ts-add-arity)) + + (when-refactoring-with-point-it "should add an arity to a single-arity defn with args on next line" + "(defn foo + [arg] + bo|dy)" + + "(defn foo + ([|]) + ([arg] + body))" + + (clojure-ts-add-arity)) + + (when-refactoring-with-point-it "should handle a single-arity defn with a docstring" + "(defn foo + \"some docst|ring\" + [arg] + body)" + + "(defn foo + \"some docstring\" + ([|]) + ([arg] + body))" + + (clojure-ts-add-arity)) + + (when-refactoring-with-point-it "should handle a single-arity defn with metadata" + "(defn fo|o + ^{:bla \"meta\"} + [arg] + body)" + + "(defn foo + ^{:bla \"meta\"} + ([|]) + ([arg] + body))" + + (clojure-ts-add-arity)) + + (when-refactoring-with-point-it "should add an arity to a multi-arity defn" + "(defn foo + ([arg1]) + ([ar|g1 arg2] + body))" + + "(defn foo + ([|]) + ([arg1]) + ([arg1 arg2] + body))" + + (clojure-ts-add-arity)) + + (when-refactoring-with-point-it "should handle a multi-arity defn with a docstring" + "(defn foo + \"some docstring\" + ([]) + ([arg|] + body))" + + "(defn foo + \"some docstring\" + ([|]) + ([]) + ([arg] + body))" + + (clojure-ts-add-arity)) + + (when-refactoring-with-point-it "should handle a multi-arity defn with metadata" + "(defn foo + \"some docstring\" + ^{:bla \"meta\"} + ([]) + |([arg] + body))" + + "(defn foo + \"some docstring\" + ^{:bla \"meta\"} + ([|]) + ([]) + ([arg] + body))" + + (clojure-ts-add-arity)) + + (when-refactoring-with-point-it "should handle a single-arity fn" + "(fn foo [arg] + body|)" + + "(fn foo + ([|]) + ([arg] + body))" + + (clojure-ts-add-arity)) + + (when-refactoring-with-point-it "should handle a multi-arity fn" + "(fn foo + ([x y] + body) + ([a|rg] + body))" + + "(fn foo + ([|]) + ([x y] + body) + ([arg] + body))" + + (clojure-ts-add-arity)) + + (when-refactoring-with-point-it "should handle a single-arity defmacro" + "(defmacro foo [arg] + body|)" + + "(defmacro foo + ([|]) + ([arg] + body))" + + (clojure-ts-add-arity)) + + (when-refactoring-with-point-it "should handle a multi-arity defmacro" + "(defmacro foo + ([x y] + body) + ([a|rg] + body))" + + "(defmacro foo + ([|]) + ([x y] + body) + ([arg] + body))" + + (clojure-ts-add-arity)) + + (when-refactoring-with-point-it "should handle a single-arity defmethod" + "(defmethod foo :bar [arg] + body|)" + + "(defmethod foo :bar + ([|]) + ([arg] + body))" + + (clojure-ts-add-arity)) + + (when-refactoring-with-point-it "should handle a multi-arity defmethod" + "(defmethod foo :bar + ([x y] + body) + ([a|rg] + body))" + + "(defmethod foo :bar + ([|]) + ([x y] + body) + ([arg] + body))" + + (clojure-ts-add-arity)) + + (when-refactoring-with-point-it "should handle a defn inside a reader conditional" + "#?(:clj + (defn foo + \"some docstring\" + ^{:bla \"meta\"} + |([arg] + body)))" + + "#?(:clj + (defn foo + \"some docstring\" + ^{:bla \"meta\"} + ([|]) + ([arg] + body)))" + + (clojure-ts-add-arity)) + + (when-refactoring-with-point-it "should handle a defn inside a reader conditional with 2 platform tags" + "#?(:clj + (defn foo + \"some docstring\" + ^{:bla \"meta\"} + |([arg] + body)) + :cljs + (defn foo + \"some docstring\" + ^{:bla \"meta\"} + ([arg] + body)))" + + "#?(:clj + (defn foo + \"some docstring\" + ^{:bla \"meta\"} + ([|]) + ([arg] + body)) + :cljs + (defn foo + \"some docstring\" + ^{:bla \"meta\"} + ([arg] + body)))" + + (clojure-ts-add-arity)) + + (when-refactoring-with-point-it "should handle a single-arity fn inside a letfn" + "(letfn [(foo [x] + bo|dy)] + (foo 3))" + + "(letfn [(foo + ([|]) + ([x] + body))] + (foo 3))" + + (clojure-ts-add-arity)) + + (when-refactoring-with-point-it "should handle a multi-arity fn inside a letfn" + "(letfn [(foo + ([x] + body) + |([x y] + body))] + (foo 3))" + + "(letfn [(foo + ([|]) + ([x] + body) + ([x y] + body))] + (foo 3))" + + (clojure-ts-add-arity)) + + (when-refactoring-with-point-it "should handle a proxy" + "(proxy [Foo] [] + (bar [arg] + body|))" + + "(proxy [Foo] [] + (bar + ([|]) + ([arg] + body)))" + + (clojure-ts-add-arity)) + + (when-refactoring-with-point-it "should handle a defprotocol" + "(defprotocol Foo + \"some docstring\" + (bar [arg] [x |y] \"some docstring\"))" + + "(defprotocol Foo + \"some docstring\" + (bar [|] [arg] [x y] \"some docstring\"))" + + (clojure-ts-add-arity)) + + (when-refactoring-with-point-it "should handle a reify" + "(reify Foo + (bar [arg] body) + (blahs [arg]| body))" + + "(reify Foo + (bar [arg] body) + (blahs [|]) + (blahs [arg] body))" + + (clojure-ts-add-arity)) + + (when-refactoring-with-point-it "should handle an extend-protocol" + "(extend-protocol prepare/SettableParameter + clojure.lang.IPersistentMap + (set-parameter [m ^PreparedStatement s i] + (.setObject| s i (->pgobject m))))" + + "(extend-protocol prepare/SettableParameter + clojure.lang.IPersistentMap + (set-parameter [|]) + (set-parameter [m ^PreparedStatement s i] + (.setObject s i (->pgobject m))))" + + (clojure-ts-add-arity)) + + (it "should signal a user error when point is not inside a function body" + (with-clojure-ts-buffer-point " +(letf|n [(foo + ([x] + body) + ([x y] + body))] + (foo 3))" + (expect (clojure-ts-add-arity) + :to-throw + 'user-error + '("No suitable form to add an arity at point"))) + + (with-clojure-ts-buffer-point " +(defprotocol Fo|o + \"some docstring\" + (bar [arg] [x y] \"some docstring\"))" + (expect (clojure-ts-add-arity) + :to-throw + 'user-error + '("No suitable form to add an arity at point"))))) + +(provide 'clojure-ts-mode-refactor-add-arity-test) +;;; clojure-ts-mode-refactor-add-arity-test.el ends here diff --git a/test/clojure-ts-mode-refactor-threading-test.el b/test/clojure-ts-mode-refactor-threading-test.el new file mode 100644 index 0000000..35e1ebb --- /dev/null +++ b/test/clojure-ts-mode-refactor-threading-test.el @@ -0,0 +1,450 @@ +;;; clojure-ts-mode-refactor-threading-test.el --- clojure-ts-mode: refactor threading tests -*- lexical-binding: t; -*- + +;; Copyright (C) 2025 Roman Rudakov + +;; Author: Roman Rudakov +;; Keywords: + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; The threading refactoring code is adapted from clojure-mode.el. + +;;; Code: + +(require 'clojure-ts-mode) +(require 'buttercup) +(require 'test-helper "test/test-helper") + +(describe "clojure-ts-thread" + + (when-refactoring-it "should work with -> when performed once" + "(-> (dissoc (assoc {} :key \"value\") :lock))" + + "(-> (assoc {} :key \"value\") + (dissoc :lock))" + + (clojure-ts-thread)) + + (when-refactoring-it "should work with -> when performed twice" + "(-> (dissoc (assoc {} :key \"value\") :lock))" + + "(-> {} + (assoc :key \"value\") + (dissoc :lock))" + + (clojure-ts-thread) + (clojure-ts-thread)) + + (when-refactoring-it "should not thread maps" + "(-> (dissoc (assoc {} :key \"value\") :lock))" + + "(-> {} + (assoc :key \"value\") + (dissoc :lock))" + + (clojure-ts-thread) + (clojure-ts-thread) + (clojure-ts-thread)) + + (when-refactoring-it "should not thread last sexp" + "(-> (dissoc (assoc (get-a-map) :key \"value\") :lock))" + + "(-> (get-a-map) + (assoc :key \"value\") + (dissoc :lock))" + + (clojure-ts-thread) + (clojure-ts-thread) + (clojure-ts-thread)) + + (when-refactoring-it "should thread-first-easy-on-whitespace" + "(-> + (dissoc (assoc {} :key \"value\") :lock))" + + "(-> + (assoc {} :key \"value\") + (dissoc :lock))" + + (clojure-ts-thread)) + + (when-refactoring-it "should remove superfluous parens" + "(-> (square (sum [1 2 3 4 5])))" + + "(-> [1 2 3 4 5] + sum + square)" + + (clojure-ts-thread) + (clojure-ts-thread)) + + (when-refactoring-it "should work with cursor before ->" + "(-> (not (s-acc/mobile? session)))" + + "(-> (s-acc/mobile? session) + not)" + + (beginning-of-buffer) + (clojure-ts-thread)) + + (when-refactoring-it "should work with one step with ->>" + "(->> (map square (filter even? [1 2 3 4 5])))" + + "(->> (filter even? [1 2 3 4 5]) + (map square))" + + (clojure-ts-thread)) + + (when-refactoring-it "should work with two steps with ->>" + "(->> (map square (filter even? [1 2 3 4 5])))" + + "(->> [1 2 3 4 5] + (filter even?) + (map square))" + + (clojure-ts-thread) + (clojure-ts-thread)) + + (when-refactoring-it "should not thread vectors with ->>" + "(->> (map square (filter even? [1 2 3 4 5])))" + + "(->> [1 2 3 4 5] + (filter even?) + (map square))" + + (clojure-ts-thread) + (clojure-ts-thread) + (clojure-ts-thread)) + + (when-refactoring-it "should not thread last sexp with ->>" + "(->> (map square (filter even? (get-a-list))))" + + "(->> (get-a-list) + (filter even?) + (map square))" + + (clojure-ts-thread) + (clojure-ts-thread) + (clojure-ts-thread)) + + (when-refactoring-it "should work with some->" + "(some-> (+ (val (find {:a 1} :b)) 5))" + + "(some-> {:a 1} + (find :b) + val + (+ 5))" + + (clojure-ts-thread) + (clojure-ts-thread) + (clojure-ts-thread)) + + (when-refactoring-it "should work with some->>" + "(some->> (+ 5 (val (find {:a 1} :b))))" + + "(some->> :b + (find {:a 1}) + val + (+ 5))" + + (clojure-ts-thread) + (clojure-ts-thread) + (clojure-ts-thread))) + +(describe "clojure-ts-unwind" + + (when-refactoring-it "should unwind -> one step" + "(-> {} + (assoc :key \"value\") + (dissoc :lock))" + + "(-> (assoc {} :key \"value\") + (dissoc :lock))" + + (clojure-ts-unwind)) + + (when-refactoring-it "should unwind -> completely" + "(-> {} + (assoc :key \"value\") + (dissoc :lock))" + + "(dissoc (assoc {} :key \"value\") :lock)" + + (clojure-ts-unwind) + (clojure-ts-unwind)) + + (when-refactoring-it "should unwind ->> one step" + "(->> [1 2 3 4 5] + (filter even?) + (map square))" + + "(->> (filter even? [1 2 3 4 5]) + (map square))" + + (clojure-ts-unwind)) + + (when-refactoring-it "should unwind ->> completely" + "(->> [1 2 3 4 5] + (filter even?) + (map square))" + + "(map square (filter even? [1 2 3 4 5]))" + + (clojure-ts-unwind) + (clojure-ts-unwind)) + + (when-refactoring-it "should work correctly when there is only one expression" + "(->> (filter even? [1 2 3 4]))" + + "(filter even? [1 2 3 4])" + + (clojure-ts-unwind)) + + (when-refactoring-it "should unwind N steps with numeric prefix arg" + "(->> [1 2 3 4 5] + (filter even?) + (map square) + sum)" + + "(->> (map square (filter even? [1 2 3 4 5])) + sum)" + + (clojure-ts-unwind 2)) + + (when-refactoring-it "should unwind completely with universal prefix arg" + "(->> [1 2 3 4 5] + (filter even?) + (map square) + sum)" + + "(sum (map square (filter even? [1 2 3 4 5])))" + + (clojure-ts-unwind '(4))) + + (when-refactoring-it "should unwind correctly when multiple ->> are present on same line" + "(->> 1 inc) (->> [1 2 3 4 5] + (filter even?) + (map square))" + + "(->> 1 inc) (map square (filter even? [1 2 3 4 5]))" + + (clojure-ts-unwind) + (clojure-ts-unwind)) + + (when-refactoring-it "should unwind with function name" + "(->> [1 2 3 4 5] + sum + square)" + + "(->> (sum [1 2 3 4 5]) + square)" + + (clojure-ts-unwind)) + + (when-refactoring-it "should unwind with function name twice" + "(-> [1 2 3 4 5] + sum + square)" + + "(square (sum [1 2 3 4 5]))" + + (clojure-ts-unwind) + (clojure-ts-unwind)) + + (when-refactoring-it "should thread-issue-6-1" + "(defn plus [a b] + (-> a (+ b)))" + + "(defn plus [a b] + (+ a b))" + + (clojure-ts-unwind)) + + (when-refactoring-it "should thread-issue-6-2" + "(defn plus [a b] + (->> a (+ b)))" + + "(defn plus [a b] + (+ b a))" + + (clojure-ts-unwind)) + + (when-refactoring-it "should unwind some->" + "(some-> {:a 1} + (find :b) + val + (+ 5))" + + "(some-> (val (find {:a 1} :b)) + (+ 5))" + + (clojure-ts-unwind) + (clojure-ts-unwind)) + + (when-refactoring-it "should unwind some->>" + "(some->> :b + (find {:a 1}) val + (+ 5))" + + "(some->> (val (find {:a 1} :b)) + (+ 5))" + + (clojure-ts-unwind) + (clojure-ts-unwind))) + +(describe "clojure-ts-thread-first-all" + + (when-refactoring-it "should thread first all sexps" + "(->map (assoc {} :key \"value\") :lock)" + + "(-> {} + (assoc :key \"value\") + (->map :lock))" + + (beginning-of-buffer) + (clojure-ts-thread-first-all nil)) + + (when-refactoring-it "should thread a form except the last expression" + "(->map (assoc {} :key \"value\") :lock)" + + "(-> (assoc {} :key \"value\") + (->map :lock))" + + (beginning-of-buffer) + (clojure-ts-thread-first-all t)) + + (when-refactoring-it "should thread with an empty first line" + "(map + inc + [1 2])" + + "(-> inc + (map + [1 2]))" + + (goto-char (point-min)) + (clojure-ts-thread-first-all nil)) + + (when-refactoring-it "should thread-first-maybe-unjoin-lines" + "(map + inc + [1 2])" + + "(map + inc + [1 2])" + + (goto-char (point-min)) + (clojure-ts-thread-first-all nil) + (clojure-ts-unwind-all))) + +(describe "clojure-ts-thread-last-all" + + (when-refactoring-it "should fully thread a form" + "(map square (filter even? (make-things)))" + + "(->> (make-things) + (filter even?) + (map square))" + + (beginning-of-buffer) + (clojure-ts-thread-last-all nil)) + + (when-refactoring-it "should thread a form except the last expression" + "(map square (filter even? (make-things)))" + + "(->> (filter even? (make-things)) + (map square))" + + (beginning-of-buffer) + (clojure-ts-thread-last-all t)) + + (when-refactoring-it "should handle dangling parens 1" + "(map inc + (range))" + + "(->> (range) + (map inc))" + + (beginning-of-buffer) + (clojure-ts-thread-last-all nil)) + + (when-refactoring-it "should handle dangling parens 2" + "(deftask dev [] + (comp (serve) + (cljs)))" + + "(->> (cljs) + (comp (serve)) + (deftask dev []))" + + (beginning-of-buffer) + (clojure-ts-thread-last-all nil))) + +(describe "clojure-ts-unwind-all" + + (when-refactoring-it "should unwind all in ->" + "(-> {} + (assoc :key \"value\") + (dissoc :lock))" + + "(dissoc (assoc {} :key \"value\") :lock)" + + (beginning-of-buffer) + (clojure-ts-unwind-all)) + + (when-refactoring-it "should unwind all in ->>" + "(->> (make-things) + (filter even?) + (map square))" + + "(map square (filter even? (make-things)))" + + (beginning-of-buffer) + (clojure-ts-unwind-all)) + + (when-refactoring-it "should leave multiline sexp alone" + "(->> [a b] + (some (fn [x] + (when x + 10))))" + + "(some (fn [x] + (when x + 10)) + [a b])" + + (clojure-ts-unwind-all)) + + ;; NOTE: This feature is implemented in `clojure-mode' via text properties and + ;; doesn't work for the same expression after restarting Emacs. For now it's + ;; not implemented in `clojure-ts-mode', although we respect multiline + ;; expressions in some cases. + ;; + ;; (when-refactoring-it "should thread-last-maybe-unjoin-lines" "(deftask dev + ;; [] (comp (serve) (cljs (lala) 10)))" + + ;; "(deftask dev [] + ;; (comp (serve) + ;; (cljs (lala) + ;; 10)))" + + ;; (goto-char (point-min)) + ;; (clojure-ts-thread-last-all nil) + ;; (clojure-ts-unwind-all)) + ) + +(provide 'clojure-ts-mode-refactor-threading-test) +;;; clojure-ts-mode-refactor-threading-test.el ends here diff --git a/test/clojure-ts-mode-util-test.el b/test/clojure-ts-mode-util-test.el new file mode 100644 index 0000000..05b0fcc --- /dev/null +++ b/test/clojure-ts-mode-util-test.el @@ -0,0 +1,131 @@ +;;; clojure-ts-mode-util-test.el --- Clojure TS Mode: util test suite -*- lexical-binding: t; -*- + +;; Copyright © 2022-2025 Danny Freeman + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; The unit test suite of Clojure TS Mode + +(require 'clojure-ts-mode) +(require 'buttercup) + +(describe "clojure-ts-mode-version" + (it "should not be nil" + (expect clojure-ts-mode-version))) + +(describe "clojure-ts-find-ns" + (it "should find common namespace declarations" + (with-clojure-ts-buffer "(ns foo)" + (expect (clojure-ts-find-ns) :to-equal "foo")) + (with-clojure-ts-buffer "(ns + foo)" + (expect (clojure-ts-find-ns) :to-equal "foo")) + (with-clojure-ts-buffer "(ns foo.baz)" + (expect (clojure-ts-find-ns) :to-equal "foo.baz")) + (with-clojure-ts-buffer "(ns ^:bar foo)" + (expect (clojure-ts-find-ns) :to-equal "foo")) + (with-clojure-ts-buffer "(ns ^:bar ^:baz foo)" + (expect (clojure-ts-find-ns) :to-equal "foo"))) + + (it "should find namespaces with spaces before ns form" + (with-clojure-ts-buffer " (ns foo)" + (expect (clojure-ts-find-ns) :to-equal "foo"))) + + (it "should skip namespaces within any comment forms" + (with-clojure-ts-buffer "(comment + (ns foo))" + (expect (clojure-ts-find-ns) :to-equal nil)) + (with-clojure-ts-buffer " (ns foo) + (comment + (ns bar))" + (expect (clojure-ts-find-ns) :to-equal "foo")) + (with-clojure-ts-buffer " (comment + (ns foo)) + (ns bar) + (comment + (ns baz))" + (expect (clojure-ts-find-ns) :to-equal "bar"))) + + (it "should find namespace declarations with nested metadata and docstrings" + (with-clojure-ts-buffer "(ns ^{:bar true} foo)" + (expect (clojure-ts-find-ns) :to-equal "foo")) + (with-clojure-ts-buffer "(ns #^{:bar true} foo)" + (expect (clojure-ts-find-ns) :to-equal "foo")) + (with-clojure-ts-buffer "(ns #^{:fail {}} foo)" + (expect (clojure-ts-find-ns) :to-equal "foo")) + (with-clojure-ts-buffer "(ns ^{:fail2 {}} foo.baz)" + (expect (clojure-ts-find-ns) :to-equal "foo.baz")) + (with-clojure-ts-buffer "(ns ^{} foo)" + (expect (clojure-ts-find-ns) :to-equal "foo")) + (with-clojure-ts-buffer "(ns ^{:skip-wiki true} + aleph.netty)" + (expect (clojure-ts-find-ns) :to-equal "aleph.netty")) + (with-clojure-ts-buffer "(ns ^{:foo {:bar :baz} :fake (ns in.meta)} foo + \"docstring +(ns misleading)\")" + (expect (clojure-ts-find-ns) :to-equal "foo"))) + + (it "should support non-alphanumeric characters" + (with-clojure-ts-buffer "(ns foo+)" + (expect (clojure-ts-find-ns) :to-equal "foo+")) + (with-clojure-ts-buffer "(ns bar**baz$-_quux)" + (expect (clojure-ts-find-ns) :to-equal "bar**baz$-_quux")) + (with-clojure-ts-buffer "(ns aoc-2019.puzzles.day14)" + (expect (clojure-ts-find-ns) :to-equal "aoc-2019.puzzles.day14"))) + + (it "should support in-ns forms" + (with-clojure-ts-buffer "(in-ns 'bar.baz)" + (expect (clojure-ts-find-ns) :to-equal "bar.baz"))) + + (it "should take the first ns instead of closest unlike clojure-mode" + (with-clojure-ts-buffer " (ns foo1) + +(ns foo2)" + (expect (clojure-ts-find-ns) :to-equal "foo1")) + (with-clojure-ts-buffer-point " (in-ns foo1) +(ns 'foo2) +(in-ns 'foo3) +| +(ns foo4)" + (expect (clojure-ts-find-ns) :to-equal "foo3")) + (with-clojure-ts-buffer "(ns foo) +(ns-unmap *ns* 'map) +(ns.misleading 1 2 3)" + (expect (clojure-ts-find-ns) :to-equal "foo"))) + + (it "should skip leading garbage" + (with-clojure-ts-buffer " (ns foo)" + (expect (clojure-ts-find-ns) :to-equal "foo")) + (with-clojure-ts-buffer "1(ns foo)" + (expect (clojure-ts-find-ns) :to-equal "foo")) + (with-clojure-ts-buffer "1 (ns foo)" + (expect (clojure-ts-find-ns) :to-equal "foo")) + (with-clojure-ts-buffer "1 +(ns foo)" + (expect (clojure-ts-find-ns) :to-equal "foo")) + (with-clojure-ts-buffer "[1] +(ns foo)" + (expect (clojure-ts-find-ns) :to-equal "foo")) + (with-clojure-ts-buffer "[1] (ns foo)" + (expect (clojure-ts-find-ns) :to-equal "foo")) + (with-clojure-ts-buffer "[1](ns foo)" + (expect (clojure-ts-find-ns) :to-equal "foo")) + (with-clojure-ts-buffer "(ns)(ns foo)" + (expect (clojure-ts-find-ns) :to-equal "foo")) + (with-clojure-ts-buffer "(ns 'foo)(ns bar)" + (expect (clojure-ts-find-ns) :to-equal "bar")))) diff --git a/test/indentation.clj b/test/indentation.clj deleted file mode 100644 index a5fe041..0000000 --- a/test/indentation.clj +++ /dev/null @@ -1,120 +0,0 @@ -(ns indentation - "Docstring `important`. asdf" - (:require - [clojure.string :as str]) - (:import - (java.util Date - UUID))) - -; Single ; comment -;; double ; comment -(when something - ; single ; comment - ;; double ; comment - body) - -(defmethod dispatch :on-me - [x] - (bar x)) - -(defn f [x] - body) - -(defn f - ([x] (f x nil)) - ([x y] )) - -(defn f - [x] - body) - -(defn many-args [a b c - d e f] - body) - -(defn multi-arity - ([x] - body) - ([x y] - body)) - -(let [x 1 - y 2] - body) - -[1 2 3 - 4 5 6] - -{:key-1 v1 - :key-2 v2} - -#{a b c - d e f} - - -(or (condition-a) - (condition-b)) - -(filter even? (range 1 10)) - -(clojure.core/filter even? - (range 1 10)) - - -(filter - even? - (range 1 10)) - -(asdf - asdf - asdf) - -(defn foo [x 1] - x) - -(:my/keyword - {:my/keyword 1 - :another-keyword 2} - "default value") - - - -(defprotocol IProto - (foo [this x] - "`this` is a docstring.") - (bar [this y])) - -(deftype MyThing [] - IProto - (foo [this x] - x)) - -(defrecord MyThingR [] - IProto - (foo [this x] x)) - -(defn foo2 [x]b) - -(reify - IProto - (foo [this x] - x)) - -(extend-type MyThing - clojure.lang.IFn - (invoke [this] 1)) - -(extend-protocol clojure.lang.IFn - MyThingR - (invoke [this] - 2)) - -(extend AType - AProtocol - {:foo an-existing-fn - :bar (fn [a b] - a) - :baz (fn - ([a] a) - ([a b] - b))}) diff --git a/test/samples/align.clj b/test/samples/align.clj new file mode 100644 index 0000000..b7933f3 --- /dev/null +++ b/test/samples/align.clj @@ -0,0 +1,64 @@ +(ns align) + +(let [^long my-map {:hello "World" ;Hello + :foo + ^String (str "Foo" "Bar") + :number ^long 132 + :zz "hello"} + another {:this ^{:hello "world"} "is" + :a #long "1234" + :b {:this "is" + :nested "map"}}]) + + +{:foo "bar", :baz "Hello" + :a "b" :c "d"} + + +(clojure.core/with-redefs [hello "world" + foo "bar"] + (println hello foo)) + +(condp = 2 + 123 "Hello" + 99999 "World" + 234 nil) + +(let [a-long-name 10 + b 20]) + +#?(:clj 2 + :cljs 2) + +#?@(:clj [2] + :cljs [4]) + +(let [this-is-a-form b + c d + + another form + k g]) + +{:this-is-a-form b + c d + + :another form + k g} + +(let [x {:a 1 + :b 2} ; comment + xx 3] + x) + +(case x + :a (let [a 1 + aa (+ a 1)] + aa); comment + :aa 2) + +{:map "with" + :some #_"ignored" "form"} + +{:map "with" + :multiple "ignored" + #_#_:forms "foo"} diff --git a/test/samples/bug43.clj b/test/samples/bug43.clj new file mode 100644 index 0000000..85cfda1 --- /dev/null +++ b/test/samples/bug43.clj @@ -0,0 +1,7 @@ +^{:a 1} + (def b 2) + +^{:a 1} +(defn a + "hello" ;; <- + [] "world") diff --git a/test/samples/completion.clj b/test/samples/completion.clj new file mode 100644 index 0000000..7207d7f --- /dev/null +++ b/test/samples/completion.clj @@ -0,0 +1,71 @@ +(ns completion) + +(def my-var "Hello") +(def my-another-var "World") + +(defn- my-function + "This is a docstring." + [some-arg] + (let [to-print (str "Hello" some-arg)] + (println my-var my-another-var to-print))) + +(fn [anon-arg] + anon-arg) + +(def hello-string "Hello") + +(defn complete-example + "Docstring won't interfere with completion." + [arg1 arg2 & {:keys [destructured]}] + ;; Here only function args and globals should be completed. + (println arg1 arg2 destructured) + (let [foo "bar" ; comment + baz ^String hello + map-var {:users/usename "Roma"} + {:users/keys [username]} map-var + another-map {:address "Universe"} + {custom-address :address} another-map + bar :kwd] + ;; Here let bindings are available in addition to globals and function args. + (println arg1 foo map-var custom-address username) + (when-let [nested-var "Whatever"] + (with-open [output-stream (io/output-stream "some-file")] + (println foo + baz + hello + map-var + username + another-map + custom-address + bar) + ;; Here we should see everything + (output-stream nested-var output-stream another-map))) + ;; And here only let bindings, globals and function args again. + (println username))) + +(def vec-variable ["one" "two" "three"]) + +(let [[one two three] vec-variable] + (println one two three)) + +(defn nested-fn + [top-arg] + (filter (fn [item] + ;; Both arguments are available here. + (= item top-arg)) + [1 2 3 4 5])) + +;; Works for top-level bindings and for nested `:let` bindings. +(for [digit vec-variable + :let [prefixed-digit (str "hello-" digit)]] + (println prefixed-digit digit)) + +;; Same for `doseq` +(doseq [word vec-variable + :let [suffixed-word (str "hello-" word)]] + (println suffixed-word word)) + +;; Can complete any keyword from the buffer +(do :users/usename + :address + :kwd) diff --git a/test/samples/docstrings.clj b/test/samples/docstrings.clj new file mode 100644 index 0000000..e8d5821 --- /dev/null +++ b/test/samples/docstrings.clj @@ -0,0 +1,76 @@ +(ns clojure-ts-mode.docstrings + "This is a namespace + See my famous `fix-bug` macro if you need help." + (:require [clojure.test :refer [deftest]]) + (:import (java.util UUID))) + +(def foo ;;asdf + "I'm a value") +(def bar "I'm a docstring" "and I'm a value") + +(defonce ^{:doc "gotta document in metadata."} baz + "Did you know defonce doesn't have a docstring arity like def?") + +(def foobar + ;; Comments shouldn't disrupt docstring highlighting + "I'm a docstring" + 123) + +(defn ;;asdf + foobarbaz ;;asdf + "I'm the docstring!" ;;asdf + [x] + (inc x)) + +(;; starting comments break docstrings + defn busted! + "We really need to anchor symbols like defn to the front of the list. +I don't want every query to have to check for comments. +Don't format code this way." + [] + nil) + +(defn buzz "Looking for `fizz`" + [x] + (when (zero? (% x 5)) + "buzz")) + +(defn- fizz + "Pairs well with `buzz`" + [x] + (when (zero? (% x 3)) + "fizz")) + +(defmacro fix-bug + "Fixes most known bugs. + + Check markdown: + - [[some-function]] + - _emphasize_ + - [link](https://github.com) + - __strong__ + - *emphasize* + + Looks good." + [& body] + `(try + ~@body + (catch Throwable _ + nil))) + +(definline never-used-this ":)" [x] x) + +(deftype ^{:doc "asdf" :something-else "asdf"} T + java.lang.Closeable + (close [this] + (print "done"))) + +(defprotocol Fooable + (foo [this] + "Does foo")) + +(definterface Barable + (^String bar [] "Does bar")) + +(deftest ^{:doc "doctest"} some-test + (is (= 1 2))) diff --git a/test/samples/embed.cljs b/test/samples/embed.cljs new file mode 100644 index 0000000..22000a7 --- /dev/null +++ b/test/samples/embed.cljs @@ -0,0 +1,12 @@ +(ns embed) + +(js* "var hello = console.log('hello'); const now = new Date();") + +(js* "const hello = new Date(); + const someOtherVar = 'Just a string';") + +(println "This is a normal string") + +"Standalone string" + +(js* "var hello = 'world';") diff --git a/test/samples/extra_def_forms.clj b/test/samples/extra_def_forms.clj new file mode 100644 index 0000000..6ecb3a3 --- /dev/null +++ b/test/samples/extra_def_forms.clj @@ -0,0 +1,6 @@ +(ns extra-def-forms) + +(defelem file-upload + "Creates a file upload input." + [name] + (input-field "file" name nil)) diff --git a/test/samples/indentation.clj b/test/samples/indentation.clj new file mode 100644 index 0000000..52b417e --- /dev/null +++ b/test/samples/indentation.clj @@ -0,0 +1,302 @@ +(ns indentation + "Docstring `important`. asdf" + (:require + [clojure.string :as str]) + (:import + (java.util Date + UUID))) + +; Single ; comment +;; double ; comment +(when something + ; single ; comment + ;; double ; comment + body) + +(defmethod dispatch :on-me + [x] + (bar x)) + +(defn f [x] + body) + +(defn f + ([x] (f x nil)) + ([x y] )) + +(defn f + [x] + body) + +(defn many-args [a b c + d e f] + body) + +(defn multi-arity + ([x] + body) + ([x y] + body)) + +(let [x 1 + y 2] + body) + +[1 2 3 + 4 5 6] + +{:key-1 v1 + :key-2 v2} + +#{a b c + d e f} + + +(or (condition-a) + (condition-b)) + +(filter even? (range 1 10)) + +(clojure.core/filter even? + (range 1 10)) + +(#'filter even? + (range 10)) + +(filter + even? + (range 1 10)) + +(asdf + asdf + asdf) + +(defn foo [x 1] + x) + +(:my/keyword + {:my/keyword 1 + :another-keyword 2} + "default value") + +(defprotocol IProto + (foo [this x] + "`this` is a docstring.") + (bar [this y])) + +(deftype MyThing [] + IProto + (foo [this x] + x)) + +(defrecord MyThingR + [] + IProto + (foo [this x] + x)) + +(defn foo2 [x] b) + +(reify + IProto + (foo [this x] + x)) + +(extend-type MyThing + clojure.lang.IFn + (invoke [this] + 1)) + +(extend-protocol clojure.lang.IFn + MyThingR + (invoke [this] + 2)) + +(extend AType + AProtocol + {:foo an-existing-fn + :bar (fn [a b] + a) + :baz (fn + ([a] a) + ([a b] + b))}) + +^:foo +(def a 1) + +^{:foo true} +(def b 2) + +^{:foo true} +[1 2] + +(comment + ^{:a 1} + (def a 2)) + +(defn hinted + (^String []) + (^java.util.List + [a & args])) + +^{:foo true} +(defn c + "hello" + [_foo] + (+ 1 1)) + +;;; Block 0 rule + +(do (aligned) + (vertically)) + +(do + (indented) + (with-2-spaces)) + +(future + (body is indented)) + +(try + (something) + ;; A bit of block 2 rule + (catch Exception e + "Third argument is indented with 2 spaces.") + (catch ExceptionInfo + e-info + "Second argument is aligned vertically with the first one.")) + +;;; Block 1 rule + +(case x + 2 (print 2) + 3 (print 3) + (print "Default")) + +(cond-> {} + :always (assoc :hello "World") + false (do nothing)) + +(with-precision 32 + (/ (bigdec 20) (bigdec 30))) + +(testing "Something should work" + (is (something-working?))) + +;;; Block 2 rule + +(are [x y] + (= x y) + 2 3 + 4 5 + 6 6) + +(as-> {} $ + (assoc $ :hello "World")) + +(as-> {} + my-map + (assoc my-map :hello "World")) + +;;; Inner 0 rule + +(fn named-lambda [x] + (+ x x)) + +(defmethod hello :world + [arg1 arg2] + (+ arg1 arg2)) + +(reify + AutoCloseable + (close + [this] + (is properly indented))) + +(def x + [a b [c ^:foo + d + e]]) + +#{x + y ^:foo + z} + +{:hello ^:foo + "world" + :foo + "bar"} + +'(one + two ^:foo + three) + +^{:nextjournal.clerk/visibility {:code :hide}} +(defn actual + [args]) + +(println "Hello" + "World") + +#(println + "hello" + %) + +#(println "hello" + %) + +(def ^:private hello + "World") + +;; A few examples from clojure core. + +;; NOTE: This one is not indented correctly, I'm keeping it here as a reminder +;; to fix it later. +(defonce ^:dynamic + ^{:private true + :doc "A ref to a sorted set of symbols representing loaded libs"} + *loaded-libs* (ref (sorted-set))) + +(defn index-of + "Return index of value (string or char) in s, optionally searching + forward from from-index. Return nil if value not found." + {:added "1.8"} + ([^CharSequence s value] + (let [result ^long + (if (instance? Character value) + (.indexOf (.toString s) ^int (.charValue ^Character value)) + (.indexOf (.toString s) ^String value))] + (if (= result -1) + nil + result))) + ([^CharSequence s value ^long from-index] + (let [result ^long + (if (instance? Character value) + (.indexOf (.toString s) ^int (.charValue ^Character value) (unchecked-int from-index)) + (.indexOf (.toString s) ^String value (unchecked-int from-index)))] + (if (= result -1) + nil + result)))) + +;; Nested rules + +(letfn [(add [x y] + (+ x y)) + (hello [user] + (println "Hello" user))] + (let [x 2 + y 3 + user "John Doe"] + (dotimes [_ (add x y)] + (hello user)))) + +(with-open [input-stream + ^java.io.BufferedInputStream + (foo bar + baz + true) + + reader + (io/reader input-stream)] + (read-report (into [] (csv/read-csv reader)))) diff --git a/test/samples/native.jank b/test/samples/native.jank new file mode 100644 index 0000000..1eb03c7 --- /dev/null +++ b/test/samples/native.jank @@ -0,0 +1,14 @@ +(defn create-vertex-shader! [] + (native/raw "__value = make_box(glCreateShader(GL_VERTEX_SHADER));")) + +(defn set-shader-source! [shader source] + (native/raw "auto const shader(detail::to_int(~{ shader })); + auto const &source(detail::to_string(~{ source })); + __value = make_box(); + __value = make_box(glShaderSource(shader, 1, &source.data, nullptr));")) + +(defn compile-shader! [shader] + (native/raw "__value = make_box(glCompileShader(detail::to_int(~{ shader })));") + "Normal string") + +"Normal string" diff --git a/test/samples/navigation.clj b/test/samples/navigation.clj new file mode 100644 index 0000000..26bdf44 --- /dev/null +++ b/test/samples/navigation.clj @@ -0,0 +1,14 @@ +(ns navigation) + +(let [my-var ^{:foo "bar"} (= "Hello" "Hello")]) + +(let [my-var ^boolean (= "Hello" "world")]) + +#(+ % %) + +^boolean (= 2 2) + +(defn- to-string + ^String + [arg] + (.toString arg)) diff --git a/test/samples/outline.clj b/test/samples/outline.clj new file mode 100644 index 0000000..b6722d2 --- /dev/null +++ b/test/samples/outline.clj @@ -0,0 +1,19 @@ +(ns outline) + + +;;; First heading level 1 + +(defn foo + [bar] + (println bar)) + +;;;; Heading level 2 + +(def baz + {:hello "World"}) + +;;; Second heading level 1 + +(defn hello-world + [] + (println "Hello, world!")) diff --git a/test/samples/refactoring.clj b/test/samples/refactoring.clj new file mode 100644 index 0000000..5a87bf7 --- /dev/null +++ b/test/samples/refactoring.clj @@ -0,0 +1,149 @@ +(ns refactoring) + +;;; Threading + +;;;; Unwind + +(-> ;; This is comment + (foo) + ;; Another comment + (bar true + ;; Hello + false) + (baz)) + + +(let [some (->> yeah + (world foo + false) + hello)]) + +(->> coll + (filter identity) + (map :id) + (map :name)) + +(some->> coll + (filter identity) + (map :id) + (map :name)) + +(defn plus [a b] + (-> a (+ b))) + +(some->> :b + (find {:a 1}) val + (+ 5)) + +(some->> (val (find {:a 1} :b)) + (+ 5)) + +;;;; Thread + +(-> (foo (bar (baz)) "arg on a separate line")) + +(foo (bar (baz))) + +(-> (foo (bar)) + (baz)) + +(->> (filter :active? (map :status items))) + +(-> (dissoc (assoc {} :key "value") :lock)) + + +(-> inc + (map [1 2])) + +(map + inc + [1 2]) + +#(-> (.-value (.-target %))) + +(->> (range) + (map inc)) + +(->> (map square (filter even? [1 2 3 4 5]))) + +(-> (dissoc (assoc {} :key "value") :lock)) + +(deftask dev [] + (comp (serve) + (cljs (lala) + 10))) + +(def my-name "Roma") + +(defn say-hello + [] + (println "Hello" my-name)) + +(definline bad-sqr [x] `(* ~x ~x)) + +(defmulti service-charge (juxt account-level :tag)) + +;; Convert collections. + +#{1 2 3} + +[1 2 3] + +#:hello {:world true + :foo "bar" + :some-very-long "value"} + +{:name "Roma" + :foo true} + +(reify + java.io.FileFilter + (accept [this f] + (.isDirectory f)) + + (hello [world] + false)) + +(defmulti which-color-mm (fn [m & args] (:color m))) +(defmethod which-color-mm :blue + ([m] (print m)) + ([m f] (f m))) + +(letfn [(twice [x] + (* x 2)) + (six-times [y] + (* (twice y) 3))] + (println "Twice 15 =" (twice 15)) + (println "Six times 15 =" (six-times 15))) + +(let [p (proxy [java.io.InputStream] [] + (read + ([] 1) + ([^bytes bytes] 2) + ([^bytes bytes off len] 3)))] + (println (.read p)) + (println (.read p (byte-array 3))) + (println (.read p (byte-array 3) 0 3))) + +(defprotocol Fly + "A simple protocol for flying" + (fly [this] + "Method to fly")) + +(defn foo + ^{:bla "meta"} + [arg] + body) + +(if ^boolean (= 2 2) + true + false) + +(when-not true + (println "Hello world")) + +(extend-protocol prepare/SettableParameter + clojure.lang.IPersistentMap + (set-parameter []) + (set-parameter [m ^PreparedStatement s i] + (.setObject| s i (->pgobject m)))) diff --git a/test/samples/regex.clj b/test/samples/regex.clj new file mode 100644 index 0000000..f37b50a --- /dev/null +++ b/test/samples/regex.clj @@ -0,0 +1,7 @@ +(ns regex) + +(def email-pattern + #"[a-z0-9!#$%&'*+/=?^_`{|}~-]+(?:\.[a-z0-9!#$%&'*+/=?^_`{|}~-]+)*@(?:[a-z0-9](?:[a-z0-9-]*[a-z0-9])?\.)+[a-z0-9](?:[a-z0-9-]*[a-z0-9])?") + +(def simple-regex + #"^(\\d+).*[a|b|c|d].*[a-z0-9!#]$") diff --git a/test/samples/spec.clj b/test/samples/spec.clj new file mode 100644 index 0000000..b0770cf --- /dev/null +++ b/test/samples/spec.clj @@ -0,0 +1,7 @@ +(ns spec + (:require + [clojure.spec.alpha :as s])) + +(s/def ::username string?) +(s/def ::age number?) +(s/def ::email string?) diff --git a/test/test.clj b/test/samples/test.clj similarity index 82% rename from test/test.clj rename to test/samples/test.clj index ae25da8..18ead86 100644 --- a/test/test.clj +++ b/test/samples/test.clj @@ -13,6 +13,8 @@ (fn ^:m hello [x] @x) +(def ^:private my-var true) + (def ^Boolean x true) (clojure.core/defmacro my-mac [] @@ -20,16 +22,42 @@ ~x ~@x)) +;; Built-ins should be highlighted only for `clojure.core` namespace. +(for []) +(clojure.core/for []) +(honey.sql/for {}) + +;; the "add" and "hello" should both have a function name face +(letfn [(add [x y] + (+ x y)) + (hello [user] + (println "Hello" user))] + (dotimes [_ (add 6 8)] + (hello "John Doe"))) + ;; the myfn sexp should have a comment face (mysfn 101 foo 0 0i) +;; Function literals + +^{:some "metadata"} #(let [foo % + bar-zzz %] + foo) + +#(or one + two) + +#(let [hello 1 + foo "hone"] + (pringln hello)) + ;; examples of valid namespace definitions (comment (ns .validns) - + (ns =validns) (ns .ValidNs=<>?+|?*.) (ns ValidNs<>?+|?*.b*ar.ba*z) @@ -237,7 +265,6 @@ ([x y & more] (reduce1 max (max x y) more))) - ;; definitions with metadata only don't cause freezing (def ^String) ;; clojure-mode regression: the hanging metadata doesn't cause freezing @@ -289,3 +316,50 @@ clojure.core/map (def ^Integer x 1) +^{:foo true} +(defn b "hello" [] "world") + +^{:foo bar} +(def foo "usage" "hello") + +(comment + (defrecord TestRecord [field] + AutoCloseable + (close [this] + (.close this))) + + (reify + AutoCloseable + (close [this] (.close this)) + + (another [this arg] + (implement this arg))) + + (definterface MyInterface + (^String name []) + (^double mass [])) + + (defmulti my-method :hello :default ::default) + + (defmethod my-method :world + [_] + (println "Hi")) + + (deftype ImageSelection [data] + Transferable + (getTransferDataFlavors + [this] + (into-array DataFlavor [DataFlavor/imageFlavor])) + + (isDataFlavorSupported + [this flavor] + (= DataFlavor/imageFlavor flavor)) + + (getTransferData + [this flavor] + (when (= DataFlavor/imageFlavor flavor) + (.getImage (ImageIcon. data))))) + + (defprotocol P + (foo [this]) + (bar-me [this] [this y]))) diff --git a/test/test-helper.el b/test/test-helper.el new file mode 100644 index 0000000..f1515d9 --- /dev/null +++ b/test/test-helper.el @@ -0,0 +1,112 @@ +;;; test-helper.el --- Clojure TS Mode: Non-interactive unit-test setup -*- lexical-binding: t; -*- + +;; Copyright © 2022-2025 Bozhidar Batsov + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; Non-interactive test suite setup. + +;;; Code: + +(defmacro with-clojure-ts-buffer (text &rest body) + "Create a temporary buffer, insert TEXT, switch to `clojure-ts-mode'. + +And evaluate BODY." + (declare (indent 1)) + `(with-temp-buffer + (erase-buffer) + (insert ,text) + (clojure-ts-mode) + ,@body)) + +(defmacro with-clojure-ts-buffer-point (text &rest body) + "Run BODY in a temporary clojure buffer with TEXT. + +TEXT is a string with a | indicating where point is. The | will be erased +and point left there." + (declare (indent 1)) + `(progn + (with-clojure-ts-buffer ,text + (goto-char (point-min)) + (re-search-forward "|") + (delete-char -1) + ,@body))) + +(defun clojure-ts--s-index-of (needle s &optional ignore-case) + "Return first index of NEEDLE in S, or nil. + +If IGNORE-CASE is non-nil, the comparison is done without paying +attention to case differences." + (declare (pure t) (side-effect-free t)) + (let ((case-fold-search ignore-case)) + (string-match-p (regexp-quote needle) s))) + +(defmacro when-refactoring-it (description before after &rest body) + "Return a buttercup spec. + +Insert BEFORE into a buffer, evaluate BODY and compare the resulting buffer to +AFTER. + +BODY should contain the refactoring that transforms BEFORE into AFTER. + +DESCRIPTION is the description of the spec." + (declare (indent 1)) + `(it ,description + (with-clojure-ts-buffer ,before + ,@body + (expect (buffer-string) :to-equal ,after)))) + +(defmacro when-refactoring-with-point-it (description before after &rest body) + "Return a buttercup spec. + +Like when-refactor-it but also checks whether point is moved to the expected +position. + +BEFORE is the buffer string before refactoring, where a pipe (|) represents +point. + +AFTER is the expected buffer string after refactoring, where a pipe (|) +represents the expected position of point. + +DESCRIPTION is a string with the description of the spec." + (declare (indent 1)) + `(it ,description + (let* ((after ,after) + (expected-cursor-pos (1+ (clojure-ts--s-index-of "|" after))) + (expected-state (delete ?| after))) + (with-clojure-ts-buffer ,before + (goto-char (point-min)) + (search-forward "|") + (delete-char -1) + ,@body + (expect (buffer-string) :to-equal expected-state) + (expect (point) :to-equal expected-cursor-pos))))) + + +;; https://emacs.stackexchange.com/a/55031 +(defmacro with-temp-dir (temp-dir &rest body) + "Create a temporary directory and bind its to TEMP-DIR while evaluating BODY. +Removes the temp directory at the end of evaluation." + `(let ((,temp-dir (make-temp-file "" t))) + (unwind-protect + (progn + ,@body) + (delete-directory ,temp-dir t)))) + +(provide 'test-helper) +;;; test-helper.el ends here pFad - Phonifier reborn

Pfad - The Proxy pFad of © 2024 Garber Painting. All rights reserved.

Note: This service is not intended for secure transactions such as banking, social media, email, or purchasing. Use at your own risk. We assume no liability whatsoever for broken pages.


Alternative Proxies:

Alternative Proxy

pFad Proxy

pFad v3 Proxy

pFad v4 Proxy