branch: elpa/treesit-fold commit 68d16a9bc98c323f75b78bce3a63a5f4112aef5a Author: Jen-Chieh <jcs090...@gmail.com> Commit: Jen-Chieh <jcs090...@gmail.com>
Rename to ts-fold --- README.md | 50 ++--- tree-sitter-fold-indicators.el | 283 ------------------------ tree-sitter-fold-parsers.el | 218 ------------------ tree-sitter-fold-summary.el | 230 ------------------- ts-fold-indicators.el | 283 ++++++++++++++++++++++++ ts-fold-parsers.el | 218 ++++++++++++++++++ ts-fold-summary.el | 230 +++++++++++++++++++ tree-sitter-fold-util.el => ts-fold-util.el | 30 +-- tree-sitter-fold.el => ts-fold.el | 328 ++++++++++++++-------------- 9 files changed, 935 insertions(+), 935 deletions(-) diff --git a/README.md b/README.md index 7bb9732987..fa1ca828f7 100644 --- a/README.md +++ b/README.md @@ -1,11 +1,11 @@ [](https://www.gnu.org/licenses/gpl-3.0) -# tree-sitter-fold +# ts-fold > Code-folding using tree-sitter -[](https://github.com/jcs090218/tree-sitter-fold/actions/workflows/test.yml) +[](https://github.com/jcs090218/ts-fold/actions/workflows/test.yml) -tree-sitter-fold builds on top of [elisp-tree-sitter](https://github.com/emacs-tree-sitter/elisp-tree-sitter) +ts-fold builds on top of [elisp-tree-sitter](https://github.com/emacs-tree-sitter/elisp-tree-sitter) to provide code folding base on the tree-sitter syntax tree. <p align="center"> @@ -15,7 +15,7 @@ to provide code folding base on the tree-sitter syntax tree. <!-- markdown-toc start - Don't edit this section. Run M-x markdown-toc-refresh-toc --> **Table of Contents** -- [tree-sitter-fold](#tree-sitter-fold) +- [ts-fold](#ts-fold) - [💾 Installation](#💾-installation) - [🔍 Methods 1. with `straight.el` and `use-package`:](#🔍-methods-1-with-straightel-and-use-package) - [🔍 Methods 2. Manual](#🔍-methods-2-manual) @@ -32,33 +32,33 @@ to provide code folding base on the tree-sitter syntax tree. ### 🔍 Methods 1. with `straight.el` and `use-package`: ```el -(use-package tree-sitter-fold - :straight (host github repo "jcs090218/tree-sitter-fold")) +(use-package ts-fold + :straight (host github repo "jcs090218/ts-fold")) ``` ### 🔍 Methods 2. Manual ```sh -git clone https://github.com/jcs090218/tree-sitter-fold /path/to/lib +git clone https://github.com/jcs090218/ts-fold /path/to/lib ``` then in Emacs: ```el (add-to-list 'load-path "/path/to/lib") -(require 'tree-sitter-fold) +(require ts-fold) ``` ## 📇 Commands -| Commands | Description | -|-------------------------------------|-----------------------------------------------------------------------------| -| `tree-sitter-fold-close` | fold the current syntax node. | -| `tree-sitter-fold-open` | open all folds inside the current syntax node. | -| `tree-sitter-fold-open-recursively` | open the outmost fold of the current syntax node. Keep the sub-folds close. | -| `tree-sitter-fold-close-all` | close all foldable syntax nodes in the current buffer. | -| `tree-sitter-fold-open-all` | open all folded syntax nodes in the current buffer. | -| `tree-sitter-fold-toggle` | toggle the syntax node at `point'. | +| Commands | Description | +|----------------------------|-----------------------------------------------------------------------------| +| `ts-fold-close` | fold the current syntax node. | +| `ts-fold-open` | open all folds inside the current syntax node. | +| `ts-fold-open-recursively` | open the outmost fold of the current syntax node. Keep the sub-folds close. | +| `ts-fold-close-all` | close all foldable syntax nodes in the current buffer. | +| `ts-fold-open-all` | open all folded syntax nodes in the current buffer. | +| `ts-fold-toggle` | toggle the syntax node at `point'. | ## 🔨 Supported languages @@ -99,25 +99,25 @@ has an excellent documentation on how to write `tree-sitter` queries. You can enable this manually by doing the folloiwng ``` -M-x tree-sitter-fold-indicators-mode +M-x ts-fold-indicators-mode ``` To enable this automatically whenever `tree-sitter-mode` is enabled: ```el -(add-hook 'tree-sitter-after-on-hook #'tree-sitter-fold-indicators-mode) +(add-hook 'tree-sitter-after-on-hook #ts-fold-indicators-mode) ``` To switch to left/right fringe: (Default is `left-fringe`) ```el -(setq tree-sitter-fold-indicators-fringe 'right-fringe) +(setq ts-fold-indicators-fringe 'right-fringe) ``` To lower/higher the fringe overlays: (Default is `30`) ```el -(setq tree-sitter-fold-indicators-priority 30) +(setq ts-fold-indicators-priority 30) ``` To apply different face depends on some conditions: (Default is `nil`) @@ -126,7 +126,7 @@ For example, to coordinate [line-reminder](https://github.com/emacs-vs/line-remi with this plugin. ```el -(setq tree-sitter-fold-indicators-face-function +(setq ts-fold-indicators-face-function (lambda (pos &rest _) (let ((ln (line-number-at-pos pos))) (cond @@ -147,23 +147,23 @@ so you can have a nice way to peek what's inside the fold range. If you don't want this to happen, do: (Default is `t`) ```el -(setq tree-sitter-fold-summary-show nil) +(setq ts-fold-summary-show nil) ``` Summary are truncated by length: (Default is `60`) ```el -(setq tree-sitter-fold-summary-max-length 60) +(setq ts-fold-summary-max-length 60) ``` The exceeding string are replace by: (Default is `"..."`) ```el -(setq tree-sitter-fold-summary-exceeded-string "...") +(setq ts-fold-summary-exceeded-string "...") ``` To change summary format: (Default is `" <S> %s "`) ```el -(setq tree-sitter-fold-summary-format " <S> %s ") +(setq ts-fold-summary-format " <S> %s ") ``` diff --git a/tree-sitter-fold-indicators.el b/tree-sitter-fold-indicators.el deleted file mode 100644 index 4bde1c5bd6..0000000000 --- a/tree-sitter-fold-indicators.el +++ /dev/null @@ -1,283 +0,0 @@ -;;; tree-sitter-fold-indicators.el --- Display indicators for folding range -*- lexical-binding: t; -*- - -;; Copyright (C) 2021 Shen, Jen-Chieh -;; Created date 2021-10-04 20:03:12 - -;; This file is NOT part of GNU Emacs. - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <https://www.gnu.org/licenses/>. - -;;; Commentary: -;; -;; Display indicators for folding range -;; - -;;; Code: - -(require 'cl-lib) -(require 'seq) -(require 'subr-x) - -(require 'fringe-helper) - -(require 'tree-sitter-fold-util) -(require 'tree-sitter-fold) - -(defcustom tree-sitter-fold-indicators-fringe 'left-fringe - "Display indicators on the left/right fringe." - :type '(choice (const :tag "On the right fringe" right-fringe) - (const :tag "On the left fringe" left-fringe)) - :group 'tree-sitter-fold) - -(defcustom tree-sitter-fold-indicators-priority 30 - "Indicators fringe priority." - :type 'integer - :group 'tree-sitter-fold) - -(defcustom tree-sitter-fold-indicators-face-function nil - "Function call when apply to indicators face." - :type 'function - :group 'tree-sitter-fold) - -(fringe-helper-define 'tree-sitter-fold-indicators-fr-plus nil - "XXXXXXX" - "X.....X" - "X..X..X" - "X.XXX.X" - "X..X..X" - "X.....X" - "XXXXXXX") - -(fringe-helper-define 'tree-sitter-fold-indicators-fr-minus-tail nil - "........" "........" "........" "........" "........" - "........" "........" "........" "........" "........" - "XXXXXXX" - "X.....X" - "X.....X" - "X.XXX.X" - "X.....X" - "X.....X" - "XXXXXXX" - "...XX..." "...XX..." "...XX..." "...XX..." "...XX..." - "...XX..." "...XX..." "...XX..." "...XX..." "...XX...") - -(fringe-helper-define 'tree-sitter-fold-indicators-fr-center nil - "...XX..." "...XX..." "...XX..." "...XX..." "...XX..." - "...XX..." "...XX..." "...XX..." "...XX..." "...XX..." - "...XX..." "...XX..." "...XX..." "...XX..." "...XX..." - "...XX..." "...XX..." "...XX..." "...XX..." "...XX..." - "...XX..." "...XX..." "...XX...") - -(fringe-helper-define 'tree-sitter-fold-indicators-fr-end-left nil - "...XX..." "...XX..." "...XX..." "...XX..." "...XX..." - "...XX..." "...XX..." "...XX..." "...XX..." "...XX..." - "...XX..." "...XXXXX" "...XXXXX" - "........" "........" "........" "........" "........" - "........" "........" "........" "........" "........") - -(fringe-helper-define 'tree-sitter-fold-indicators-fr-end-right nil - "...XX..." "...XX..." "...XX..." "...XX..." "...XX..." - "...XX..." "...XX..." "...XX..." "...XX..." "...XX..." - "...XX..." "XXXXX..." "XXXXX..." - "........" "........" "........" "........" "........" - "........" "........" "........" "........" "........") - -;; -;; (@* "Entry" ) -;; - -(defvar tree-sitter-fold-indicators-mode-map - (let ((map (make-sparse-keymap))) - (define-key map [left-fringe mouse-1] #'tree-sitter-fold-indicators-click-fringe) - (define-key map [right-fringe mouse-1] #'tree-sitter-fold-indicators-click-fringe) - map) - "Keymap for function `tree-sitter-fold-indicators-mode'.") - -(defun tree-sitter-fold-indicators--enable () - "Enable `tree-sitter-fold-indicators' mode." - (if (tree-sitter-fold-mode 1) ; Enable `tree-sitter-fold-mode' automatically - (progn - (add-hook 'tree-sitter-after-change-functions #'tree-sitter-fold-indicators-refresh nil t) - (add-hook 'after-save-hook #'tree-sitter-fold-indicators-refresh nil t)) - (tree-sitter-fold-indicators-mode -1))) - -(defun tree-sitter-fold-indicators--disable () - "Disable `tree-sitter-fold-indicators' mode." - (remove-hook 'tree-sitter-after-change-functions #'tree-sitter-fold-indicators-refresh t) - (remove-hook 'after-save-hook #'tree-sitter-fold-indicators-refresh t) - (tree-sitter-fold-indicators--remove-overlays)) - -;;;###autoload -(define-minor-mode tree-sitter-fold-indicators-mode - "Minor mode for indicators mode." - :group 'tree-sitter-fold-indicators - :lighter nil - :keymap tree-sitter-fold-indicators-mode-map - :init-value nil - (if tree-sitter-fold-indicators-mode (tree-sitter-fold-indicators--enable) - (tree-sitter-fold-indicators--disable))) - -;;;###autoload -(define-global-minor-mode global-tree-sitter-fold-indicators-mode tree-sitter-fold-indicators-mode - (lambda () (tree-sitter-fold-indicators-mode 1))) - -;; -;; (@* "Events" ) -;; - -(defun tree-sitter-fold-indicators-click-fringe (event) - "EVENT click on fringe." - (interactive "e") - (let ((current-fringe (nth 1 (car (cdr event)))) ovs ov cur-ln) - (when (eq current-fringe tree-sitter-fold-indicators-fringe) - (mouse-set-point event) - (beginning-of-line) - (setq cur-ln (line-number-at-pos (point))) - (setq ovs (append (tree-sitter-fold-util--overlays-in 'type 'tree-sitter-fold-indicators-fr-plus) - (tree-sitter-fold-util--overlays-in 'type 'tree-sitter-fold-indicators-fr-minus-tail))) - (when ovs - (setq ov (cl-some - (lambda (ov) (= cur-ln (line-number-at-pos (overlay-start ov)))) - ovs)) - (when ov - (or (save-excursion - (end-of-line) - (when (nth 4 (syntax-ppss)) (back-to-indentation)) - (tree-sitter-fold-toggle)) - (tree-sitter-fold-toggle))))))) - -;; -;; (@* "Core" ) -;; - -(defun tree-sitter-fold-indicators--create-overlay-at-point () - "Create indicator overlay at current point." - (let* ((pos (line-beginning-position)) - (ov (make-overlay pos (1+ pos)))) - (overlay-put ov 'creator 'tree-sitter-fold-indicators) - ov)) - -(defun tree-sitter-fold-indicators--create-overlays (beg end folded) - "Create indicators overlays in range of BEG to END. - -If argument FOLDED is non-nil, means the region is close/hidden (overlay -is created); this is used to determie what indicators' bitmap to use." - (let (ov-lst) - (save-excursion - (goto-char beg) - (while (and (<= (line-beginning-position) end) (not (eobp))) - (push (tree-sitter-fold-indicators--create-overlay-at-point) ov-lst) - (forward-line 1))) - (tree-sitter-fold-indicators--update-overlays (reverse ov-lst) folded))) - -(defun tree-sitter-fold-indicators--get-priority (bitmap) - "Return the priority integer depends on the type of the BITMAP. - -This is a static/constant method." - (let ((prior tree-sitter-fold-indicators-priority)) - (cl-case bitmap - (tree-sitter-fold-indicators-fr-plus (+ prior 2)) - (tree-sitter-fold-indicators-fr-minus-tail (+ prior 2)) - (tree-sitter-fold-indicators-fr-end-left (+ prior 1)) - (tree-sitter-fold-indicators-fr-end-right (+ prior 1)) - (t prior)))) - -(defun tree-sitter-fold-indicators--get-string (folded ov bitmap) - "Return a string or nil for indicators overlay (OV). - -If argument FOLDED is nil, it must return a string so all indicators are shown -in range. Otherwise, we should only return string only when BITMAP is the -head (first line) of the region." - (let* ((face (or (and (functionp tree-sitter-fold-indicators-face-function) - (funcall tree-sitter-fold-indicators-face-function (overlay-start ov))) - 'tree-sitter-fold-fringe-face)) - (str (propertize "." 'display `(,tree-sitter-fold-indicators-fringe ,bitmap ,face)))) - (if (not folded) str - (cl-case bitmap - (tree-sitter-fold-indicators-fr-plus str) ; return string only in head - (tree-sitter-fold-indicators-fr-minus-tail nil) - (tree-sitter-fold-indicators-fr-end-left nil) - (tree-sitter-fold-indicators-fr-end-right nil) - (t nil))))) - -(defun tree-sitter-fold-indicators--active-ov (folded ov bitmap) - "SHOW the indicator OV with BITMAP." - (when (overlayp ov) - (overlay-put ov 'tree-sitter-fold-indicators-active folded) - (overlay-put ov 'type bitmap) - (overlay-put ov 'priority (tree-sitter-fold-indicators--get-priority bitmap)) - (overlay-put ov 'before-string (tree-sitter-fold-indicators--get-string folded ov bitmap)))) - -(defun tree-sitter-fold-indicators--get-end-fringe () - "Return end fringe bitmap according to variable `tree-sitter-fold-indicators-fringe'." - (cl-case tree-sitter-fold-indicators-fringe - (left-fringe 'tree-sitter-fold-indicators-fr-end-left) - (right-fringe 'tree-sitter-fold-indicators-fr-end-right) - (t (user-error "Invalid indicators fringe type: %s" tree-sitter-fold-indicators-fringe)))) - -(defun tree-sitter-fold-indicators--update-overlays (ov-lst folded) - "SHOW indicators overlays OV-LST." - (when-let* ((len (length ov-lst)) - ((> len 1)) - (len-1 (1- len)) - (first-ov (nth 0 ov-lst)) - (last-ov (nth len-1 ov-lst)) - (index 1)) - ;; Head - (tree-sitter-fold-indicators--active-ov - folded first-ov - (if folded 'tree-sitter-fold-indicators-fr-plus - 'tree-sitter-fold-indicators-fr-minus-tail)) - ;; Last - (tree-sitter-fold-indicators--active-ov folded last-ov (tree-sitter-fold-indicators--get-end-fringe)) - ;; In between `head' and `last' - (while (< index len-1) - (tree-sitter-fold-indicators--active-ov folded (nth index ov-lst) 'tree-sitter-fold-indicators-fr-center) - (cl-incf index))) - ov-lst) - -;; -;; (@* "Update" ) -;; - -(defun tree-sitter-fold-indicators--create (node) - "Create indicators using NODE." - (when-let* ((range (tree-sitter-fold--get-fold-range node)) - (beg (car range)) (end (cdr range))) - (let ((folded (tree-sitter-fold-overlay-at node))) - (tree-sitter-fold-indicators--create-overlays beg end folded)))) - -;;;###autoload -(defun tree-sitter-fold-indicators-refresh (&rest _) - "Refresh indicators for all folding range." - (when tree-sitter-fold-indicators-mode - (tree-sitter-fold--ensure-ts - (when-let* ((node (tsc-root-node tree-sitter-tree)) - (patterns (seq-mapcat (lambda (type) `(,(list type) @name)) - (alist-get major-mode tree-sitter-fold-foldable-node-alist) - 'vector)) - (query (ignore-errors - (tsc-make-query tree-sitter-language patterns))) - (nodes-to-fold (tsc-query-captures query node #'ignore))) - (tree-sitter-fold-indicators--remove-overlays) - (thread-last nodes-to-fold - (mapcar #'cdr) - (mapc #'tree-sitter-fold-indicators--create)))))) - -(defun tree-sitter-fold-indicators--remove-overlays () - "Remove all indicators overlays." - (remove-overlays (point-min) (point-max) 'creator 'tree-sitter-fold-indicators)) - -(provide 'tree-sitter-fold-indicators) -;;; tree-sitter-fold-indicators.el ends here diff --git a/tree-sitter-fold-parsers.el b/tree-sitter-fold-parsers.el deleted file mode 100644 index 0bcf1a222d..0000000000 --- a/tree-sitter-fold-parsers.el +++ /dev/null @@ -1,218 +0,0 @@ -;;; tree-sitter-fold-parsers.el --- Adapter layer to Tree-Sitter -*- lexical-binding: t; -*- - -;; Copyright (C) 2021 Shen, Jen-Chieh -;; Created date 2021-10-04 17:45:48 - -;; This file is NOT part of GNU Emacs. - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <https://www.gnu.org/licenses/>. - -;;; Commentary: -;; -;; Adapter layer to Tree-Sitter -;; -;; This isn't a real parser implementation, but records down the rule -;; in order to let the Tree-Sitter to parse things correctly. Think of -;; the rule sets! -;; - -;;; Code: - -;; -;; (@* "Externals" ) -;; - -(declare-function tree-sitter-fold-range-seq "tree-sitter-fold.el") -(declare-function tree-sitter-fold-range-line-comment "tree-sitter-fold.el") -(declare-function tree-sitter-fold-range-block-comment "tree-sitter-fold.el") -(declare-function tree-sitter-fold-range-c-like-comment "tree-sitter-fold.el") - -(declare-function tree-sitter-fold-range-c-preproc-ifdef "tree-sitter-fold.el") -(declare-function tree-sitter-fold-range-c-preproc-if "tree-sitter-fold.el") -(declare-function tree-sitter-fold-range-c-preproc-elif "tree-sitter-fold.el") -(declare-function tree-sitter-fold-range-c-preproc-else "tree-sitter-fold.el") -(declare-function tree-sitter-fold-range-html "tree-sitter-fold.el") -(declare-function tree-sitter-fold-range-python "tree-sitter-fold.el") -(declare-function tree-sitter-fold-range-ruby "tree-sitter-fold.el") -(declare-function tree-sitter-fold-range-rust-macro "tree-sitter-fold.el") - -;; -;; (@* "Parsers" ) -;; - -(defun tree-sitter-fold-parsers-agda () - "Rule sets for Agda." - '(())) - -(defun tree-sitter-fold-parsers-bash () - "Rule sets for Bash." - '((compound_statement . tree-sitter-fold-range-seq) - (expansion . tree-sitter-fold-range-seq) - (comment - . (lambda (node offset) - (tree-sitter-fold-range-line-comment node offset "#"))))) - -(defun tree-sitter-fold-parsers-c () - "Rule sets for C." - '((compound_statement . tree-sitter-fold-range-seq) - (declaration_list . tree-sitter-fold-range-seq) - (enumerator_list . tree-sitter-fold-range-seq) - (field_declaration_list . tree-sitter-fold-range-seq) - (preproc_if . tree-sitter-fold-range-c-preproc-if) - (preproc_ifdef . tree-sitter-fold-range-c-preproc-ifdef) - (preproc_elif . tree-sitter-fold-range-c-preproc-elif) - (preproc_else . tree-sitter-fold-range-c-preproc-else) - (comment . tree-sitter-fold-range-c-like-comment))) - -(defun tree-sitter-fold-parsers-c++ () - "Rule sets for C++." - (append (tree-sitter-fold-parsers-c))) - -(defun tree-sitter-fold-parsers-csharp () - "Rule sets for C#." - '((block . tree-sitter-fold-range-seq) - (accessor_list . tree-sitter-fold-range-seq) - (enum_member_declaration_list . tree-sitter-fold-range-seq) - (declaration_list . tree-sitter-fold-range-seq) - (switch_body . tree-sitter-fold-range-seq) - (anonymous_object_creation_expression . tree-sitter-fold-range-seq) - (initializer_expression . tree-sitter-fold-range-seq) - ;;(if_directive . tree-sitter-fold-range-seq) - ;;(else_directive . tree-sitter-fold-range-seq) - ;;(elif_directive . tree-sitter-fold-range-seq) - ;;(endif_directive . tree-sitter-fold-range-seq) - ;;(region_directive . tree-sitter-fold-range-seq) - ;;(endregion_directive . tree-sitter-fold-range-seq) - (comment . tree-sitter-fold-range-c-like-comment))) - -(defun tree-sitter-fold-parsers-css () - "Rule sets for CSS." - '((keyframe_block_list . tree-sitter-fold-range-seq) - (block . tree-sitter-fold-range-seq) - (comment . tree-sitter-fold-range-c-like-comment))) - -(defun tree-sitter-fold-parsers-go () - "Rule sets for Go." - '((block . tree-sitter-fold-range-seq) - (comment . tree-sitter-fold-range-seq))) - -(defun tree-sitter-fold-parsers-html () - "Rule sets for HTML." - '((element . tree-sitter-fold-range-html) - (comment . (tree-sitter-fold-range-seq 1 -1)))) - -(defun tree-sitter-fold-parsers-java () - "Rule sets for Java." - '((switch_block . tree-sitter-fold-range-seq) - (block . tree-sitter-fold-range-seq) - (element_value_array_initializer . tree-sitter-fold-range-seq) - (module_body . tree-sitter-fold-range-seq) - (enum_body . tree-sitter-fold-range-seq) - (class_body . tree-sitter-fold-range-seq) - (constructor_body . tree-sitter-fold-range-seq) - (annotation_type_body . tree-sitter-fold-range-seq) - (interface_body . tree-sitter-fold-range-seq) - (array_initializer . tree-sitter-fold-range-seq) - (comment . (tree-sitter-fold-range-seq 1 -1)))) - -(defun tree-sitter-fold-parsers-javascript () - "Rule sets for JavaScript." - '((export_clause . tree-sitter-fold-range-seq) - (statement_block . tree-sitter-fold-range-seq) - (comment . tree-sitter-fold-range-c-like-comment))) - -(defun tree-sitter-fold-parsers-json () - "Rule sets for JSON." - '((object . tree-sitter-fold-range-seq) - (array . tree-sitter-fold-range-seq))) - -(defun tree-sitter-fold-parsers-nix () - "Rule sets for Nix." - '((attrset . tree-sitter-fold-range-seq) - (interpolation . tree-sitter-fold-range-seq) - (list . tree-sitter-fold-range-seq))) - -(defun tree-sitter-fold-parsers-php () - "Rule sets for PHP." - '((namespace_use_group . tree-sitter-fold-range-seq) - (declaration_list . tree-sitter-fold-range-seq) - (use_list . tree-sitter-fold-range-seq) - (switch_block . tree-sitter-fold-range-seq) - (compound_statement . tree-sitter-fold-range-seq) - (comment - . (lambda (node offset) - (if (string-prefix-p "#" (tsc-node-text node)) - (tree-sitter-fold-range-line-comment node offset "#") - (tree-sitter-fold-range-c-like-comment node offset)))))) - -(defun tree-sitter-fold-parsers-python () - "Rule sets for Python." - '((function_definition . tree-sitter-fold-range-python) - (class_definition . tree-sitter-fold-range-python) - (list . tree-sitter-fold-range-seq) - (comment - . (lambda (node offset) - (tree-sitter-fold-range-line-comment node offset "#"))))) - -(defun tree-sitter-fold-parsers-r () - "Rule sets for R." - '((brace_list . tree-sitter-fold-range-seq))) - -(defun tree-sitter-fold-parsers-ruby () - "Rule sets for Ruby." - '((class . tree-sitter-fold-range-ruby) - (method . tree-sitter-fold-range-ruby) - (array . tree-sitter-fold-range-seq) - (comment - . (lambda (node offset) - (tree-sitter-fold-range-line-comment node offset "#"))))) - -(defun tree-sitter-fold-parsers-rust () - "Rule sets for Rust." - '((declaration_list . tree-sitter-fold-range-seq) - (enum_variant_list . tree-sitter-fold-range-seq) - (field_declaration_list . tree-sitter-fold-range-seq) - (use_list . tree-sitter-fold-range-seq) - (field_initializer_list . tree-sitter-fold-range-seq) - (match_block . tree-sitter-fold-range-seq) - (macro_definition . (tree-sitter-fold-range-rust-macro 1 -1)) - (block . tree-sitter-fold-range-seq) - (line_comment . (lambda (node offset) - (tree-sitter-fold-range-line-comment node offset "///"))) - (block_comment . tree-sitter-fold-range-block-comment))) - -(defun tree-sitter-fold-parsers-scala () - "Rule sets for Scala." - '((import_selectors . tree-sitter-fold-range-seq) - (template_body . tree-sitter-fold-range-seq) - (block . tree-sitter-fold-range-seq) - (comment . tree-sitter-fold-range-c-like-comment))) - -(defun tree-sitter-fold-parsers-swift () - "Rule sets for Swift." - '((switch_statement . tree-sitter-fold-range-seq) - (function_declaration . tree-sitter-fold-range-seq) - (enum_declaration . tree-sitter-fold-range-seq) - (struct_declaration . tree-sitter-fold-range-seq) - (class_declaration . tree-sitter-fold-range-seq) - (protocol_declaration . tree-sitter-fold-range-seq) - (extension_declaration . tree-sitter-fold-range-seq) - (comment . tree-sitter-fold-range-c-like-comment))) - -(defun tree-sitter-fold-parsers-typescript () - "Rule sets for TypeScript." - (append (tree-sitter-fold-parsers-javascript))) - -(provide 'tree-sitter-fold-parsers) -;;; tree-sitter-fold-parsers.el ends here diff --git a/tree-sitter-fold-summary.el b/tree-sitter-fold-summary.el deleted file mode 100644 index 686c9732df..0000000000 --- a/tree-sitter-fold-summary.el +++ /dev/null @@ -1,230 +0,0 @@ -;;; tree-sitter-fold-summary.el --- Extract summary from fold region -*- lexical-binding: t; -*- - -;; Copyright (C) 2021 Shen, Jen-Chieh -;; Created date 2021-10-04 16:59:22 - -;; This file is NOT part of GNU Emacs. - -;; This program is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published by -;; the Free Software Foundation, either version 3 of the License, or -;; (at your option) any later version. - -;; This program is distributed in the hope that it will be useful, -;; but WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -;; GNU General Public License for more details. - -;; You should have received a copy of the GNU General Public License -;; along with this program. If not, see <https://www.gnu.org/licenses/>. - -;;; Commentary: -;; -;; Extract summary from fold region. -;; - -;;; Code: - -(require 's) - -(defcustom tree-sitter-fold-summary-show t - "Flag to show summary if available." - :type 'boolean - :group 'tree-sitter-fold) - -(defcustom tree-sitter-fold-summary-max-length 60 - "Maximum length for summary to display." - :type '(choice (const :tag "nil" nil) - (integer :tag "positive integer number")) - :group 'tree-sitter-fold) - -(defcustom tree-sitter-fold-summary-exceeded-string "..." - "String that added after display summary. -This happens only when summary length is larger than variable -`tree-sitter-fold-summary-max-length'." - :type 'string - :group 'tree-sitter-fold) - -(defcustom tree-sitter-fold-summary-format " <S> %s " - "Prefix string added before summary overlay." - :type 'string - :group 'tree-sitter-fold) - -;; -;; (@* "Externals" ) -;; - -(defvar tree-sitter-fold-replacement-face) - -;; -;; (@* "Parsers" ) -;; - -(defun tree-sitter-fold-summary--valid-content-p (content) - "Return non-nil if CONTENT is a valid document string for extraction. -Some programmers use some type of characters for splitting the code module -into sections. For instance, ===, ---, ///, =-=, etc. Try to omit these -type of content by checking the word boundary's existence." - (string-match-p "\\w" content)) - -(defun tree-sitter-fold-summary--apply-sym (line sym) - "Remove SYM from LINE." - (when (string-prefix-p sym line) - (setq line (substring line (length sym) (length line)) - line (string-trim line))) - line) - -(defun tree-sitter-fold-summary--extract-summary (doc-str sym) - "Extract only document summary from DOC-STR using SYM" - (let ((lines (split-string doc-str "\n")) new-lines) - (dolist (line lines) - (setq line (string-trim line)) - (cond ((listp sym) - (dolist (c sym) (setq line (tree-sitter-fold-summary--apply-sym line c)))) - (t (setq line (tree-sitter-fold-summary--apply-sym line sym)))) - (when (tree-sitter-fold-summary--valid-content-p line) (push line new-lines))) - (reverse new-lines))) - -(defun tree-sitter-fold-summary--doc-extract (doc-str sym) - "Default way to extract the doc summary from DOC-STR." - (let* ((lines (tree-sitter-fold-summary--extract-summary doc-str sym)) (summary (nth 0 lines))) - (when summary (setq summary (string-trim summary))) - (if (string-empty-p summary) nil summary))) - -(defun tree-sitter-fold-summary--generic (doc-str sym) - "Generic DOC-STR extraction using SYM." - (when (tree-sitter-fold-util--doc-faces-p doc-str) - (tree-sitter-fold-summary--doc-extract doc-str sym))) - -(defun tree-sitter-fold-summary-batch (doc-str) - "Extract summary from DOC-STR in Batch." - (tree-sitter-fold-summary--generic doc-str '("::" "rem" "REM"))) - -(defun tree-sitter-fold-summary-csharp-vsdoc (doc-str) - "Extract summary from DOC-STR in C# vsdoc." - (let ((type-triple (string-match-p "///" doc-str))) - (setq doc-str (s-replace-regexp "<[/]*[^>]+." "" doc-str)) - (tree-sitter-fold-summary--generic doc-str (if type-triple "///" "//")))) - -(defun tree-sitter-fold-summary-csharp (doc-str) - "Extract summary from DOC-STR in C#." - (cond ((string-match-p "///" doc-str) - (tree-sitter-fold-summary-csharp-vsdoc doc-str)) - (t (tree-sitter-fold-summary-javadoc doc-str)))) - -(defun tree-sitter-fold-summary-javadoc (doc-str) - "Extract summary from DOC-STR in Javadoc." - (tree-sitter-fold-summary--generic doc-str "*")) - -(defun tree-sitter-fold-summary-go (doc-str) - "Extract summary from DOC-STR in Go." - (tree-sitter-fold-summary--generic doc-str "//")) - -(defun tree-sitter-fold-summary-lua-doc (doc-str) - "Extract summary from DOC-STR in Lua." - (tree-sitter-fold-summary--generic doc-str "--")) - -(defun tree-sitter-fold-summary-python-doc (doc-str) - "Extract summary from DOC-STR in Python." - (tree-sitter-fold-summary--generic doc-str "\"\"\"")) - -(defun tree-sitter-fold-summary-ruby-doc (doc-str) - "Extract summary from DOC-STR in Ruby." - (tree-sitter-fold-summary--generic doc-str "#")) - -(defun tree-sitter-fold-summary-rust-doc (doc-str) - "Extract summary from DOC-STR in Rust." - (tree-sitter-fold-summary--generic doc-str "///")) - -(defun tree-sitter-fold-summary-c-macro (doc-str) - "Parse C macro summary from DOC-STR." - (when (tree-sitter-fold-util--is-face doc-str - '(font-lock-preprocessor-face - preproc-font-lock-preprocessor-background)) - (tree-sitter-fold-summary--doc-extract doc-str ""))) - -(defun tree-sitter-fold-summary-c (doc-str) - "Extract summary from DOC-STR in C comment." - (or (tree-sitter-fold-summary-javadoc doc-str) - (tree-sitter-fold-summary-c-macro doc-str))) - -(defun tree-sitter-fold-summary-markdown (doc-str) - "Extract summary from DOC-STR in Markdown block." - (tree-sitter-fold-summary--doc-extract doc-str '())) - -(defun tree-sitter-fold-summary-org (doc-str) - "Extract summary from DOC-STR in Org block." - (tree-sitter-fold-summary--doc-extract doc-str '())) - -(defun tree-sitter-fold-summary-xml (doc-str) - "Extract summary from DOC-STR in XML." - (tree-sitter-fold-summary--generic doc-str "-")) - -;; -;; (@* "Core" ) -;; - -(defun tree-sitter-fold-summary--keep-length (summary) - "Keep the SUMMARY length to `tree-sitter-fold-summary-max-length'." - (let ((len-sum (length summary)) - (len-exc (length tree-sitter-fold-summary-exceeded-string))) - (when (< tree-sitter-fold-summary-max-length len-sum) - (setq summary (substring summary 0 (- tree-sitter-fold-summary-max-length len-exc)) - summary (concat summary tree-sitter-fold-summary-exceeded-string)))) - summary) - -(defun tree-sitter-fold-summary--apply-format (summary) - "Return the SUMMARY that has added the summary prefix." - (format tree-sitter-fold-summary-format summary)) - -(defun tree-sitter-fold-summary--parser () - "Return the summary parser from `tree-sitter-fold-summary-parsers-alist'." - (assoc (buffer-local-value 'major-mode (current-buffer)) tree-sitter-fold-summary-parsers-alist)) - -(defun tree-sitter-fold-summary--get (doc-str) - "Extract summary from DOC-STR in order to display ontop of the overlay." - (let ((parser (cdr (tree-sitter-fold-summary--parser))) summary) - (when parser - (setq summary (funcall parser doc-str)) - (when (integerp tree-sitter-fold-summary-max-length) - (setq summary (tree-sitter-fold-summary--keep-length summary))) - (when summary - (setq summary (tree-sitter-fold-summary--apply-format summary) - summary (propertize summary 'face 'tree-sitter-fold-replacement-face)))) - summary)) - -(defcustom tree-sitter-fold-summary-parsers-alist - `((actionscript-mode . tree-sitter-fold-summary-javadoc) - (bat-mode . tree-sitter-fold-summary-batch) - (c-mode . tree-sitter-fold-summary-c) - (c++-mode . tree-sitter-fold-summary-c) - (csharp-mode . tree-sitter-fold-summary-csharp) - (css-mode . tree-sitter-fold-summary-javadoc) - (go-mode . tree-sitter-fold-summary-go) - (html-mode . tree-sitter-fold-summary-xml) - (java-mode . tree-sitter-fold-summary-javadoc) - (javascript-mode . tree-sitter-fold-summary-javadoc) - (js-mode . tree-sitter-fold-summary-javadoc) - (js2-mode . tree-sitter-fold-summary-javadoc) - (js3-mode . tree-sitter-fold-summary-javadoc) - (kotlin-mode . tree-sitter-fold-summary-javadoc) - (lua-mode . tree-sitter-fold-summary-lua-doc) - (markdown-mode . tree-sitter-fold-summary-markdown) - (objc-mode . tree-sitter-fold-summary-c) - (org-mode . tree-sitter-fold-summary-org) - (php-mode . tree-sitter-fold-summary-javadoc) - (python-mode . tree-sitter-fold-summary-python-doc) - (rjsx-mode . tree-sitter-fold-summary-javadoc) - (ruby-mode . tree-sitter-fold-summary-ruby-doc) - (rust-mode . tree-sitter-fold-summary-rust-doc) - (scala-mode . tree-sitter-fold-summary-javadoc) - (sh-mode . tree-sitter-fold-summary-javadoc) - (swift-mode . tree-sitter-fold-summary-c) - (typescript-mode . tree-sitter-fold-summary-javadoc) - (nxml-mode . tree-sitter-fold-summary-xml)) - "Alist mapping major-mode to doc parser function." - :type 'hook - :group 'tree-sitter-fold) - -(provide 'tree-sitter-fold-summary) -;;; tree-sitter-fold-summary.el ends here diff --git a/ts-fold-indicators.el b/ts-fold-indicators.el new file mode 100644 index 0000000000..27bcbb946a --- /dev/null +++ b/ts-fold-indicators.el @@ -0,0 +1,283 @@ +;;; ts-fold-indicators.el --- Display indicators for folding range -*- lexical-binding: t; -*- + +;; Copyright (C) 2021 Shen, Jen-Chieh +;; Created date 2021-10-04 20:03:12 + +;; This file is NOT part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; Display indicators for folding range +;; + +;;; Code: + +(require 'cl-lib) +(require 'seq) +(require 'subr-x) + +(require 'fringe-helper) + +(require 'ts-fold-util) +(require 'ts-fold) + +(defcustom ts-fold-indicators-fringe 'left-fringe + "Display indicators on the left/right fringe." + :type '(choice (const :tag "On the right fringe" right-fringe) + (const :tag "On the left fringe" left-fringe)) + :group 'ts-fold) + +(defcustom ts-fold-indicators-priority 30 + "Indicators fringe priority." + :type 'integer + :group 'ts-fold) + +(defcustom ts-fold-indicators-face-function nil + "Function call when apply to indicators face." + :type 'function + :group 'ts-fold) + +(fringe-helper-define 'ts-fold-indicators-fr-plus nil + "XXXXXXX" + "X.....X" + "X..X..X" + "X.XXX.X" + "X..X..X" + "X.....X" + "XXXXXXX") + +(fringe-helper-define 'ts-fold-indicators-fr-minus-tail nil + "........" "........" "........" "........" "........" + "........" "........" "........" "........" "........" + "XXXXXXX" + "X.....X" + "X.....X" + "X.XXX.X" + "X.....X" + "X.....X" + "XXXXXXX" + "...XX..." "...XX..." "...XX..." "...XX..." "...XX..." + "...XX..." "...XX..." "...XX..." "...XX..." "...XX...") + +(fringe-helper-define 'ts-fold-indicators-fr-center nil + "...XX..." "...XX..." "...XX..." "...XX..." "...XX..." + "...XX..." "...XX..." "...XX..." "...XX..." "...XX..." + "...XX..." "...XX..." "...XX..." "...XX..." "...XX..." + "...XX..." "...XX..." "...XX..." "...XX..." "...XX..." + "...XX..." "...XX..." "...XX...") + +(fringe-helper-define 'ts-fold-indicators-fr-end-left nil + "...XX..." "...XX..." "...XX..." "...XX..." "...XX..." + "...XX..." "...XX..." "...XX..." "...XX..." "...XX..." + "...XX..." "...XXXXX" "...XXXXX" + "........" "........" "........" "........" "........" + "........" "........" "........" "........" "........") + +(fringe-helper-define 'ts-fold-indicators-fr-end-right nil + "...XX..." "...XX..." "...XX..." "...XX..." "...XX..." + "...XX..." "...XX..." "...XX..." "...XX..." "...XX..." + "...XX..." "XXXXX..." "XXXXX..." + "........" "........" "........" "........" "........" + "........" "........" "........" "........" "........") + +;; +;; (@* "Entry" ) +;; + +(defvar ts-fold-indicators-mode-map + (let ((map (make-sparse-keymap))) + (define-key map [left-fringe mouse-1] #'ts-fold-indicators-click-fringe) + (define-key map [right-fringe mouse-1] #'ts-fold-indicators-click-fringe) + map) + "Keymap for function `ts-fold-indicators-mode'.") + +(defun ts-fold-indicators--enable () + "Enable `ts-fold-indicators' mode." + (if (ts-fold-mode 1) ; Enable `ts-fold-mode' automatically + (progn + (add-hook 'tree-sitter-after-change-functions #'ts-fold-indicators-refresh nil t) + (add-hook 'after-save-hook #'ts-fold-indicators-refresh nil t)) + (ts-fold-indicators-mode -1))) + +(defun ts-fold-indicators--disable () + "Disable `ts-fold-indicators' mode." + (remove-hook 'tree-sitter-after-change-functions #'ts-fold-indicators-refresh t) + (remove-hook 'after-save-hook #'ts-fold-indicators-refresh t) + (ts-fold-indicators--remove-overlays)) + +;;;###autoload +(define-minor-mode ts-fold-indicators-mode + "Minor mode for indicators mode." + :group 'ts-fold-indicators + :lighter nil + :keymap ts-fold-indicators-mode-map + :init-value nil + (if ts-fold-indicators-mode (ts-fold-indicators--enable) + (ts-fold-indicators--disable))) + +;;;###autoload +(define-global-minor-mode global-ts-fold-indicators-mode ts-fold-indicators-mode + (lambda () (ts-fold-indicators-mode 1))) + +;; +;; (@* "Events" ) +;; + +(defun ts-fold-indicators-click-fringe (event) + "EVENT click on fringe." + (interactive "e") + (let ((current-fringe (nth 1 (car (cdr event)))) ovs ov cur-ln) + (when (eq current-fringe ts-fold-indicators-fringe) + (mouse-set-point event) + (beginning-of-line) + (setq cur-ln (line-number-at-pos (point))) + (setq ovs (append (ts-fold-util--overlays-in 'type 'ts-fold-indicators-fr-plus) + (ts-fold-util--overlays-in 'type 'ts-fold-indicators-fr-minus-tail))) + (when ovs + (setq ov (cl-some + (lambda (ov) (= cur-ln (line-number-at-pos (overlay-start ov)))) + ovs)) + (when ov + (or (save-excursion + (end-of-line) + (when (nth 4 (syntax-ppss)) (back-to-indentation)) + (ts-fold-toggle)) + (ts-fold-toggle))))))) + +;; +;; (@* "Core" ) +;; + +(defun ts-fold-indicators--create-overlay-at-point () + "Create indicator overlay at current point." + (let* ((pos (line-beginning-position)) + (ov (make-overlay pos (1+ pos)))) + (overlay-put ov 'creator 'ts-fold-indicators) + ov)) + +(defun ts-fold-indicators--create-overlays (beg end folded) + "Create indicators overlays in range of BEG to END. + +If argument FOLDED is non-nil, means the region is close/hidden (overlay +is created); this is used to determie what indicators' bitmap to use." + (let (ov-lst) + (save-excursion + (goto-char beg) + (while (and (<= (line-beginning-position) end) (not (eobp))) + (push (ts-fold-indicators--create-overlay-at-point) ov-lst) + (forward-line 1))) + (ts-fold-indicators--update-overlays (reverse ov-lst) folded))) + +(defun ts-fold-indicators--get-priority (bitmap) + "Return the priority integer depends on the type of the BITMAP. + +This is a static/constant method." + (let ((prior ts-fold-indicators-priority)) + (cl-case bitmap + (ts-fold-indicators-fr-plus (+ prior 2)) + (ts-fold-indicators-fr-minus-tail (+ prior 2)) + (ts-fold-indicators-fr-end-left (+ prior 1)) + (ts-fold-indicators-fr-end-right (+ prior 1)) + (t prior)))) + +(defun ts-fold-indicators--get-string (folded ov bitmap) + "Return a string or nil for indicators overlay (OV). + +If argument FOLDED is nil, it must return a string so all indicators are shown +in range. Otherwise, we should only return string only when BITMAP is the +head (first line) of the region." + (let* ((face (or (and (functionp ts-fold-indicators-face-function) + (funcall ts-fold-indicators-face-function (overlay-start ov))) + 'ts-fold-fringe-face)) + (str (propertize "." 'display `(,ts-fold-indicators-fringe ,bitmap ,face)))) + (if (not folded) str + (cl-case bitmap + (ts-fold-indicators-fr-plus str) ; return string only in head + (ts-fold-indicators-fr-minus-tail nil) + (ts-fold-indicators-fr-end-left nil) + (ts-fold-indicators-fr-end-right nil) + (t nil))))) + +(defun ts-fold-indicators--active-ov (folded ov bitmap) + "SHOW the indicator OV with BITMAP." + (when (overlayp ov) + (overlay-put ov 'ts-fold-indicators-active folded) + (overlay-put ov 'type bitmap) + (overlay-put ov 'priority (ts-fold-indicators--get-priority bitmap)) + (overlay-put ov 'before-string (ts-fold-indicators--get-string folded ov bitmap)))) + +(defun ts-fold-indicators--get-end-fringe () + "Return end fringe bitmap according to variable `ts-fold-indicators-fringe'." + (cl-case ts-fold-indicators-fringe + (left-fringe 'ts-fold-indicators-fr-end-left) + (right-fringe 'ts-fold-indicators-fr-end-right) + (t (user-error "Invalid indicators fringe type: %s" ts-fold-indicators-fringe)))) + +(defun ts-fold-indicators--update-overlays (ov-lst folded) + "SHOW indicators overlays OV-LST." + (when-let* ((len (length ov-lst)) + ((> len 1)) + (len-1 (1- len)) + (first-ov (nth 0 ov-lst)) + (last-ov (nth len-1 ov-lst)) + (index 1)) + ;; Head + (ts-fold-indicators--active-ov + folded first-ov + (if folded 'ts-fold-indicators-fr-plus + 'ts-fold-indicators-fr-minus-tail)) + ;; Last + (ts-fold-indicators--active-ov folded last-ov (ts-fold-indicators--get-end-fringe)) + ;; In between `head' and `last' + (while (< index len-1) + (ts-fold-indicators--active-ov folded (nth index ov-lst) 'ts-fold-indicators-fr-center) + (cl-incf index))) + ov-lst) + +;; +;; (@* "Update" ) +;; + +(defun ts-fold-indicators--create (node) + "Create indicators using NODE." + (when-let* ((range (ts-fold--get-fold-range node)) + (beg (car range)) (end (cdr range))) + (let ((folded (ts-fold-overlay-at node))) + (ts-fold-indicators--create-overlays beg end folded)))) + +;;;###autoload +(defun ts-fold-indicators-refresh (&rest _) + "Refresh indicators for all folding range." + (when ts-fold-indicators-mode + (ts-fold--ensure-ts + (when-let* ((node (tsc-root-node tree-sitter-tree)) + (patterns (seq-mapcat (lambda (type) `(,(list type) @name)) + (alist-get major-mode ts-fold-foldable-node-alist) + 'vector)) + (query (ignore-errors + (tsc-make-query tree-sitter-language patterns))) + (nodes-to-fold (tsc-query-captures query node #'ignore))) + (ts-fold-indicators--remove-overlays) + (thread-last nodes-to-fold + (mapcar #'cdr) + (mapc #'ts-fold-indicators--create)))))) + +(defun ts-fold-indicators--remove-overlays () + "Remove all indicators overlays." + (remove-overlays (point-min) (point-max) 'creator 'ts-fold-indicators)) + +(provide 'ts-fold-indicators) +;;; ts-fold-indicators.el ends here diff --git a/ts-fold-parsers.el b/ts-fold-parsers.el new file mode 100644 index 0000000000..bd3c0e7460 --- /dev/null +++ b/ts-fold-parsers.el @@ -0,0 +1,218 @@ +;;; ts-fold-parsers.el --- Adapter layer to Tree-Sitter -*- lexical-binding: t; -*- + +;; Copyright (C) 2021 Shen, Jen-Chieh +;; Created date 2021-10-04 17:45:48 + +;; This file is NOT part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; Adapter layer to Tree-Sitter +;; +;; This isn't a real parser implementation, but records down the rule +;; in order to let the Tree-Sitter to parse things correctly. Think of +;; the rule sets! +;; + +;;; Code: + +;; +;; (@* "Externals" ) +;; + +(declare-function ts-fold-range-seq "ts-fold.el") +(declare-function ts-fold-range-line-comment "ts-fold.el") +(declare-function ts-fold-range-block-comment "ts-fold.el") +(declare-function ts-fold-range-c-like-comment "ts-fold.el") + +(declare-function ts-fold-range-c-preproc-ifdef "ts-fold.el") +(declare-function ts-fold-range-c-preproc-if "ts-fold.el") +(declare-function ts-fold-range-c-preproc-elif "ts-fold.el") +(declare-function ts-fold-range-c-preproc-else "ts-fold.el") +(declare-function ts-fold-range-html "ts-fold.el") +(declare-function ts-fold-range-python "ts-fold.el") +(declare-function ts-fold-range-ruby "ts-fold.el") +(declare-function ts-fold-range-rust-macro "ts-fold.el") + +;; +;; (@* "Parsers" ) +;; + +(defun ts-fold-parsers-agda () + "Rule sets for Agda." + '(())) + +(defun ts-fold-parsers-bash () + "Rule sets for Bash." + '((compound_statement . ts-fold-range-seq) + (expansion . ts-fold-range-seq) + (comment + . (lambda (node offset) + (ts-fold-range-line-comment node offset "#"))))) + +(defun ts-fold-parsers-c () + "Rule sets for C." + '((compound_statement . ts-fold-range-seq) + (declaration_list . ts-fold-range-seq) + (enumerator_list . ts-fold-range-seq) + (field_declaration_list . ts-fold-range-seq) + (preproc_if . ts-fold-range-c-preproc-if) + (preproc_ifdef . ts-fold-range-c-preproc-ifdef) + (preproc_elif . ts-fold-range-c-preproc-elif) + (preproc_else . ts-fold-range-c-preproc-else) + (comment . ts-fold-range-c-like-comment))) + +(defun ts-fold-parsers-c++ () + "Rule sets for C++." + (append (ts-fold-parsers-c))) + +(defun ts-fold-parsers-csharp () + "Rule sets for C#." + '((block . ts-fold-range-seq) + (accessor_list . ts-fold-range-seq) + (enum_member_declaration_list . ts-fold-range-seq) + (declaration_list . ts-fold-range-seq) + (switch_body . ts-fold-range-seq) + (anonymous_object_creation_expression . ts-fold-range-seq) + (initializer_expression . ts-fold-range-seq) + ;;(if_directive . ts-fold-range-seq) + ;;(else_directive . ts-fold-range-seq) + ;;(elif_directive . ts-fold-range-seq) + ;;(endif_directive . ts-fold-range-seq) + ;;(region_directive . ts-fold-range-seq) + ;;(endregion_directive . ts-fold-range-seq) + (comment . ts-fold-range-c-like-comment))) + +(defun ts-fold-parsers-css () + "Rule sets for CSS." + '((keyframe_block_list . ts-fold-range-seq) + (block . ts-fold-range-seq) + (comment . ts-fold-range-c-like-comment))) + +(defun ts-fold-parsers-go () + "Rule sets for Go." + '((block . ts-fold-range-seq) + (comment . ts-fold-range-seq))) + +(defun ts-fold-parsers-html () + "Rule sets for HTML." + '((element . ts-fold-range-html) + (comment . (ts-fold-range-seq 1 -1)))) + +(defun ts-fold-parsers-java () + "Rule sets for Java." + '((switch_block . ts-fold-range-seq) + (block . ts-fold-range-seq) + (element_value_array_initializer . ts-fold-range-seq) + (module_body . ts-fold-range-seq) + (enum_body . ts-fold-range-seq) + (class_body . ts-fold-range-seq) + (constructor_body . ts-fold-range-seq) + (annotation_type_body . ts-fold-range-seq) + (interface_body . ts-fold-range-seq) + (array_initializer . ts-fold-range-seq) + (comment . (ts-fold-range-seq 1 -1)))) + +(defun ts-fold-parsers-javascript () + "Rule sets for JavaScript." + '((export_clause . ts-fold-range-seq) + (statement_block . ts-fold-range-seq) + (comment . ts-fold-range-c-like-comment))) + +(defun ts-fold-parsers-json () + "Rule sets for JSON." + '((object . ts-fold-range-seq) + (array . ts-fold-range-seq))) + +(defun ts-fold-parsers-nix () + "Rule sets for Nix." + '((attrset . ts-fold-range-seq) + (interpolation . ts-fold-range-seq) + (list . ts-fold-range-seq))) + +(defun ts-fold-parsers-php () + "Rule sets for PHP." + '((namespace_use_group . ts-fold-range-seq) + (declaration_list . ts-fold-range-seq) + (use_list . ts-fold-range-seq) + (switch_block . ts-fold-range-seq) + (compound_statement . ts-fold-range-seq) + (comment + . (lambda (node offset) + (if (string-prefix-p "#" (tsc-node-text node)) + (ts-fold-range-line-comment node offset "#") + (ts-fold-range-c-like-comment node offset)))))) + +(defun ts-fold-parsers-python () + "Rule sets for Python." + '((function_definition . ts-fold-range-python) + (class_definition . ts-fold-range-python) + (list . ts-fold-range-seq) + (comment + . (lambda (node offset) + (ts-fold-range-line-comment node offset "#"))))) + +(defun ts-fold-parsers-r () + "Rule sets for R." + '((brace_list . ts-fold-range-seq))) + +(defun ts-fold-parsers-ruby () + "Rule sets for Ruby." + '((class . ts-fold-range-ruby) + (method . ts-fold-range-ruby) + (array . ts-fold-range-seq) + (comment + . (lambda (node offset) + (ts-fold-range-line-comment node offset "#"))))) + +(defun ts-fold-parsers-rust () + "Rule sets for Rust." + '((declaration_list . ts-fold-range-seq) + (enum_variant_list . ts-fold-range-seq) + (field_declaration_list . ts-fold-range-seq) + (use_list . ts-fold-range-seq) + (field_initializer_list . ts-fold-range-seq) + (match_block . ts-fold-range-seq) + (macro_definition . (ts-fold-range-rust-macro 1 -1)) + (block . ts-fold-range-seq) + (line_comment . (lambda (node offset) + (ts-fold-range-line-comment node offset "///"))) + (block_comment . ts-fold-range-block-comment))) + +(defun ts-fold-parsers-scala () + "Rule sets for Scala." + '((import_selectors . ts-fold-range-seq) + (template_body . ts-fold-range-seq) + (block . ts-fold-range-seq) + (comment . ts-fold-range-c-like-comment))) + +(defun ts-fold-parsers-swift () + "Rule sets for Swift." + '((switch_statement . ts-fold-range-seq) + (function_declaration . ts-fold-range-seq) + (enum_declaration . ts-fold-range-seq) + (struct_declaration . ts-fold-range-seq) + (class_declaration . ts-fold-range-seq) + (protocol_declaration . ts-fold-range-seq) + (extension_declaration . ts-fold-range-seq) + (comment . ts-fold-range-c-like-comment))) + +(defun ts-fold-parsers-typescript () + "Rule sets for TypeScript." + (append (ts-fold-parsers-javascript))) + +(provide 'ts-fold-parsers) +;;; ts-fold-parsers.el ends here diff --git a/ts-fold-summary.el b/ts-fold-summary.el new file mode 100644 index 0000000000..628d4c9e8b --- /dev/null +++ b/ts-fold-summary.el @@ -0,0 +1,230 @@ +;;; ts-fold-summary.el --- Extract summary from fold region -*- lexical-binding: t; -*- + +;; Copyright (C) 2021 Shen, Jen-Chieh +;; Created date 2021-10-04 16:59:22 + +;; This file is NOT part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see <https://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; Extract summary from fold region. +;; + +;;; Code: + +(require 's) + +(defcustom ts-fold-summary-show t + "Flag to show summary if available." + :type 'boolean + :group 'ts-fold) + +(defcustom ts-fold-summary-max-length 60 + "Maximum length for summary to display." + :type '(choice (const :tag "nil" nil) + (integer :tag "positive integer number")) + :group 'ts-fold) + +(defcustom ts-fold-summary-exceeded-string "..." + "String that added after display summary. +This happens only when summary length is larger than variable +`ts-fold-summary-max-length'." + :type 'string + :group 'ts-fold) + +(defcustom ts-fold-summary-format " <S> %s " + "Prefix string added before summary overlay." + :type 'string + :group 'ts-fold) + +;; +;; (@* "Externals" ) +;; + +(defvar ts-fold-replacement-face) + +;; +;; (@* "Parsers" ) +;; + +(defun ts-fold-summary--valid-content-p (content) + "Return non-nil if CONTENT is a valid document string for extraction. +Some programmers use some type of characters for splitting the code module +into sections. For instance, ===, ---, ///, =-=, etc. Try to omit these +type of content by checking the word boundary's existence." + (string-match-p "\\w" content)) + +(defun ts-fold-summary--apply-sym (line sym) + "Remove SYM from LINE." + (when (string-prefix-p sym line) + (setq line (substring line (length sym) (length line)) + line (string-trim line))) + line) + +(defun ts-fold-summary--extract-summary (doc-str sym) + "Extract only document summary from DOC-STR using SYM" + (let ((lines (split-string doc-str "\n")) new-lines) + (dolist (line lines) + (setq line (string-trim line)) + (cond ((listp sym) + (dolist (c sym) (setq line (ts-fold-summary--apply-sym line c)))) + (t (setq line (ts-fold-summary--apply-sym line sym)))) + (when (ts-fold-summary--valid-content-p line) (push line new-lines))) + (reverse new-lines))) + +(defun ts-fold-summary--doc-extract (doc-str sym) + "Default way to extract the doc summary from DOC-STR." + (let* ((lines (ts-fold-summary--extract-summary doc-str sym)) (summary (nth 0 lines))) + (when summary (setq summary (string-trim summary))) + (if (string-empty-p summary) nil summary))) + +(defun ts-fold-summary--generic (doc-str sym) + "Generic DOC-STR extraction using SYM." + (when (ts-fold-util--doc-faces-p doc-str) + (ts-fold-summary--doc-extract doc-str sym))) + +(defun ts-fold-summary-batch (doc-str) + "Extract summary from DOC-STR in Batch." + (ts-fold-summary--generic doc-str '("::" "rem" "REM"))) + +(defun ts-fold-summary-csharp-vsdoc (doc-str) + "Extract summary from DOC-STR in C# vsdoc." + (let ((type-triple (string-match-p "///" doc-str))) + (setq doc-str (s-replace-regexp "<[/]*[^>]+." "" doc-str)) + (ts-fold-summary--generic doc-str (if type-triple "///" "//")))) + +(defun ts-fold-summary-csharp (doc-str) + "Extract summary from DOC-STR in C#." + (cond ((string-match-p "///" doc-str) + (ts-fold-summary-csharp-vsdoc doc-str)) + (t (ts-fold-summary-javadoc doc-str)))) + +(defun ts-fold-summary-javadoc (doc-str) + "Extract summary from DOC-STR in Javadoc." + (ts-fold-summary--generic doc-str "*")) + +(defun ts-fold-summary-go (doc-str) + "Extract summary from DOC-STR in Go." + (ts-fold-summary--generic doc-str "//")) + +(defun ts-fold-summary-lua-doc (doc-str) + "Extract summary from DOC-STR in Lua." + (ts-fold-summary--generic doc-str "--")) + +(defun ts-fold-summary-python-doc (doc-str) + "Extract summary from DOC-STR in Python." + (ts-fold-summary--generic doc-str "\"\"\"")) + +(defun ts-fold-summary-ruby-doc (doc-str) + "Extract summary from DOC-STR in Ruby." + (ts-fold-summary--generic doc-str "#")) + +(defun ts-fold-summary-rust-doc (doc-str) + "Extract summary from DOC-STR in Rust." + (ts-fold-summary--generic doc-str "///")) + +(defun ts-fold-summary-c-macro (doc-str) + "Parse C macro summary from DOC-STR." + (when (ts-fold-util--is-face doc-str + '(font-lock-preprocessor-face + preproc-font-lock-preprocessor-background)) + (ts-fold-summary--doc-extract doc-str ""))) + +(defun ts-fold-summary-c (doc-str) + "Extract summary from DOC-STR in C comment." + (or (ts-fold-summary-javadoc doc-str) + (ts-fold-summary-c-macro doc-str))) + +(defun ts-fold-summary-markdown (doc-str) + "Extract summary from DOC-STR in Markdown block." + (ts-fold-summary--doc-extract doc-str '())) + +(defun ts-fold-summary-org (doc-str) + "Extract summary from DOC-STR in Org block." + (ts-fold-summary--doc-extract doc-str '())) + +(defun ts-fold-summary-xml (doc-str) + "Extract summary from DOC-STR in XML." + (ts-fold-summary--generic doc-str "-")) + +;; +;; (@* "Core" ) +;; + +(defun ts-fold-summary--keep-length (summary) + "Keep the SUMMARY length to `ts-fold-summary-max-length'." + (let ((len-sum (length summary)) + (len-exc (length ts-fold-summary-exceeded-string))) + (when (< ts-fold-summary-max-length len-sum) + (setq summary (substring summary 0 (- ts-fold-summary-max-length len-exc)) + summary (concat summary ts-fold-summary-exceeded-string)))) + summary) + +(defun ts-fold-summary--apply-format (summary) + "Return the SUMMARY that has added the summary prefix." + (format ts-fold-summary-format summary)) + +(defun ts-fold-summary--parser () + "Return the summary parser from `ts-fold-summary-parsers-alist'." + (assoc (buffer-local-value 'major-mode (current-buffer)) ts-fold-summary-parsers-alist)) + +(defun ts-fold-summary--get (doc-str) + "Extract summary from DOC-STR in order to display ontop of the overlay." + (let ((parser (cdr (ts-fold-summary--parser))) summary) + (when parser + (setq summary (funcall parser doc-str)) + (when (integerp ts-fold-summary-max-length) + (setq summary (ts-fold-summary--keep-length summary))) + (when summary + (setq summary (ts-fold-summary--apply-format summary) + summary (propertize summary 'face 'ts-fold-replacement-face)))) + summary)) + +(defcustom ts-fold-summary-parsers-alist + `((actionscript-mode . ts-fold-summary-javadoc) + (bat-mode . ts-fold-summary-batch) + (c-mode . ts-fold-summary-c) + (c++-mode . ts-fold-summary-c) + (csharp-mode . ts-fold-summary-csharp) + (css-mode . ts-fold-summary-javadoc) + (go-mode . ts-fold-summary-go) + (html-mode . ts-fold-summary-xml) + (java-mode . ts-fold-summary-javadoc) + (javascript-mode . ts-fold-summary-javadoc) + (js-mode . ts-fold-summary-javadoc) + (js2-mode . ts-fold-summary-javadoc) + (js3-mode . ts-fold-summary-javadoc) + (kotlin-mode . ts-fold-summary-javadoc) + (lua-mode . ts-fold-summary-lua-doc) + (markdown-mode . ts-fold-summary-markdown) + (objc-mode . ts-fold-summary-c) + (org-mode . ts-fold-summary-org) + (php-mode . ts-fold-summary-javadoc) + (python-mode . ts-fold-summary-python-doc) + (rjsx-mode . ts-fold-summary-javadoc) + (ruby-mode . ts-fold-summary-ruby-doc) + (rust-mode . ts-fold-summary-rust-doc) + (scala-mode . ts-fold-summary-javadoc) + (sh-mode . ts-fold-summary-javadoc) + (swift-mode . ts-fold-summary-c) + (typescript-mode . ts-fold-summary-javadoc) + (nxml-mode . ts-fold-summary-xml)) + "Alist mapping major-mode to doc parser function." + :type 'hook + :group 'ts-fold) + +(provide 'ts-fold-summary) +;;; ts-fold-summary.el ends here diff --git a/tree-sitter-fold-util.el b/ts-fold-util.el similarity index 68% rename from tree-sitter-fold-util.el rename to ts-fold-util.el index 8873c13b06..a05b2dc746 100644 --- a/tree-sitter-fold-util.el +++ b/ts-fold-util.el @@ -1,4 +1,4 @@ -;;; tree-sitter-fold-util.el --- Utility module -*- lexical-binding: t; -*- +;;; ts-fold-util.el --- Utility module -*- lexical-binding: t; -*- ;; Copyright (C) 2021 Shen, Jen-Chieh ;; Created date 2021-10-04 20:19:42 @@ -29,7 +29,7 @@ ;; (@* "Cons" ) ;; -(defun tree-sitter-fold-util--cons-add (c1 c2) +(defun ts-fold-util--cons-add (c1 c2) "Addition for two cons C1 and C2." (cons (+ (car c1) (car c2)) (+ (cdr c1) (cdr c2)))) @@ -37,7 +37,7 @@ ;; (@* "Overlay" ) ;; -(defun tree-sitter-fold-util--overlays-in (prop name &optional beg end) +(defun ts-fold-util--overlays-in (prop name &optional beg end) "Return overlays with PROP of NAME, from region BEG to END." (unless beg (setq beg (point-min))) (unless end (setq end (point-max))) (let ((lst '()) (ovs (overlays-in beg end))) @@ -50,7 +50,7 @@ ;; (@* "Face" ) ;; -(defvar tree-sitter-fold-util--doc-faces +(defvar ts-fold-util--doc-faces '(font-lock-doc-face font-lock-comment-face font-lock-comment-delimiter-face @@ -59,32 +59,32 @@ hl-todo) "List of face that apply for document string.") -(defun tree-sitter-fold-util--get-face (obj trim) +(defun ts-fold-util--get-face (obj trim) "Return face name from OBJ. If argument TRIM is non-nil, trim the OBJ." (get-text-property 0 'face (if trim (string-trim obj) obj))) -(defun tree-sitter-fold-util--is-face (obj lst-face &optional trim) +(defun ts-fold-util--is-face (obj lst-face &optional trim) "Return non-nil if OBJ's face is define inside list LST-FACE. -Optional argument TRIM, see function `tree-sitter-fold-util--get-face'." +Optional argument TRIM, see function `ts-fold-util--get-face'." (unless (listp lst-face) (setq lst-face (list lst-face))) - (let ((faces (tree-sitter-fold-util--get-face obj trim))) + (let ((faces (ts-fold-util--get-face obj trim))) (cond ((listp faces) (cl-some (lambda (face) (memq face lst-face)) faces)) (t (memq faces lst-face))))) -(defun tree-sitter-fold-util--doc-faces-p (obj &optional trim) - "Return non-nil if face at OBJ is within `tree-sitter-fold-util--doc-faces' list. -Optional argument TRIM, see function `tree-sitter-fold-util--get-face'." - (tree-sitter-fold-util--is-face obj tree-sitter-fold-util--doc-faces trim)) +(defun ts-fold-util--doc-faces-p (obj &optional trim) + "Return non-nil if face at OBJ is within `ts-fold-util--doc-faces' list. +Optional argument TRIM, see function `ts-fold-util--get-face'." + (ts-fold-util--is-face obj ts-fold-util--doc-faces trim)) ;; ;; (@* "Math" ) ;; -(defun tree-sitter-fold-util--in-range-p (in-val in-min in-max) +(defun ts-fold-util--in-range-p (in-val in-min in-max) "Check to see if IN-VAL is between IN-MIN and IN-MAX." (and (<= in-min in-val) (<= in-val in-max))) -(provide 'tree-sitter-fold-util) -;;; tree-sitter-fold-util.el ends here +(provide 'ts-fold-util) +;;; ts-fold-util.el ends here diff --git a/tree-sitter-fold.el b/ts-fold.el similarity index 54% rename from tree-sitter-fold.el rename to ts-fold.el index deec57d367..4899e501d0 100644 --- a/tree-sitter-fold.el +++ b/ts-fold.el @@ -1,4 +1,4 @@ -;;; tree-sitter-fold.el --- Code folding using tree-sitter -*- lexical-binding: t; -*- +;;; ts-fold.el --- Code folding using tree-sitter -*- lexical-binding: t; -*- ;; Copyright (C) 2021 Junyi Hou ;; Copyright (C) 2021 Shen, Jen-Chieh @@ -11,7 +11,7 @@ ;; Keyword: folding tree-sitter ;; Version: 0.1.0 ;; Package-Requires: ((emacs "26.1") (tree-sitter "0.15.1") (s "1.9.0") (fringe-helper "1.0.1")) -;; URL: https://github.com/jcs090218/tree-sitter-fold +;; URL: https://github.com/jcs090218/ts-fold ;; This file is NOT part of GNU Emacs. @@ -31,10 +31,10 @@ ;;; Commentary: ;; ;; This package provides a code-folding mechanism based on tree-sitter -;; package. Turn on the minor-mode `tree-sitter-fold-mode' to enable +;; package. Turn on the minor-mode `ts-fold-mode' to enable ;; this mechanism. Note that all functionalities provided here based on the ;; `tree-sitter-mode', and thus it should be enabled before -;; `tree-sitter-fold-mode' can properly fold codes. +;; `ts-fold-mode' can properly fold codes. ;;; Code: @@ -44,146 +44,146 @@ (require 's) (require 'tree-sitter) -(require 'tree-sitter-fold-util) -(require 'tree-sitter-fold-parsers) -(require 'tree-sitter-fold-summary) +(require 'ts-fold-util) +(require 'ts-fold-parsers) +(require 'ts-fold-summary) ;; ;; (@* "Customization" ) ;; -(defgroup tree-sitter-fold nil +(defgroup ts-fold nil "Code folding using tree-sitter." :group 'tree-sitter - :prefix "tree-sitter-fold-") + :prefix "ts-fold-") -(defvar tree-sitter-fold-foldable-node-alist nil - "Collect a list of foldable node from variable `tree-sitter-fold-range-alist'. +(defvar ts-fold-foldable-node-alist nil + "Collect a list of foldable node from variable `ts-fold-range-alist'. The alist is in form of (major-mode . (foldable-node-type)).") -(defcustom tree-sitter-fold-range-alist - `((agda-mode . ,(tree-sitter-fold-parsers-agda)) - (sh-mode . ,(tree-sitter-fold-parsers-bash)) - (c-mode . ,(tree-sitter-fold-parsers-c)) - (c++-mode . ,(tree-sitter-fold-parsers-c++)) - (csharp-mode . ,(tree-sitter-fold-parsers-csharp)) - (css-mode . ,(tree-sitter-fold-parsers-css)) - (ess-r-mode . ,(tree-sitter-fold-parsers-r)) - (go-mode . ,(tree-sitter-fold-parsers-go)) - (html-mode . ,(tree-sitter-fold-parsers-html)) - (java-mode . ,(tree-sitter-fold-parsers-java)) - (javascript-mode . ,(tree-sitter-fold-parsers-javascript)) - (js-mode . ,(tree-sitter-fold-parsers-javascript)) - (js2-mode . ,(tree-sitter-fold-parsers-javascript)) - (js3-mode . ,(tree-sitter-fold-parsers-javascript)) - (json-mode . ,(tree-sitter-fold-parsers-json)) - (jsonc-mode . ,(tree-sitter-fold-parsers-json)) - (nix-mode . ,(tree-sitter-fold-parsers-nix)) - (php-mode . ,(tree-sitter-fold-parsers-php)) - (python-mode . ,(tree-sitter-fold-parsers-python)) - (rjsx-mode . ,(tree-sitter-fold-parsers-javascript)) - (ruby-mode . ,(tree-sitter-fold-parsers-ruby)) - (rust-mode . ,(tree-sitter-fold-parsers-rust)) - (rustic-mode . ,(tree-sitter-fold-parsers-rust)) - (scala-mode . ,(tree-sitter-fold-parsers-scala)) - (swift-mode . ,(tree-sitter-fold-parsers-swift)) - (typescript-mode . ,(tree-sitter-fold-parsers-typescript))) +(defcustom ts-fold-range-alist + `((agda-mode . ,(ts-fold-parsers-agda)) + (sh-mode . ,(ts-fold-parsers-bash)) + (c-mode . ,(ts-fold-parsers-c)) + (c++-mode . ,(ts-fold-parsers-c++)) + (csharp-mode . ,(ts-fold-parsers-csharp)) + (css-mode . ,(ts-fold-parsers-css)) + (ess-r-mode . ,(ts-fold-parsers-r)) + (go-mode . ,(ts-fold-parsers-go)) + (html-mode . ,(ts-fold-parsers-html)) + (java-mode . ,(ts-fold-parsers-java)) + (javascript-mode . ,(ts-fold-parsers-javascript)) + (js-mode . ,(ts-fold-parsers-javascript)) + (js2-mode . ,(ts-fold-parsers-javascript)) + (js3-mode . ,(ts-fold-parsers-javascript)) + (json-mode . ,(ts-fold-parsers-json)) + (jsonc-mode . ,(ts-fold-parsers-json)) + (nix-mode . ,(ts-fold-parsers-nix)) + (php-mode . ,(ts-fold-parsers-php)) + (python-mode . ,(ts-fold-parsers-python)) + (rjsx-mode . ,(ts-fold-parsers-javascript)) + (ruby-mode . ,(ts-fold-parsers-ruby)) + (rust-mode . ,(ts-fold-parsers-rust)) + (rustic-mode . ,(ts-fold-parsers-rust)) + (scala-mode . ,(ts-fold-parsers-scala)) + (swift-mode . ,(ts-fold-parsers-swift)) + (typescript-mode . ,(ts-fold-parsers-typescript))) "An alist of (major-mode . (foldable-node-type . function)). FUNCTION is used to determine where the beginning and end for FOLDABLE-NODE-TYPE in MAJOR-MODE. It should take a single argument (the syntax node with type FOLDABLE-NODE-TYPE) and return the buffer positions of the beginning and end of -the fold in a cons cell. See `tree-sitter-fold-range-python' for an example." +the fold in a cons cell. See `ts-fold-range-python' for an example." :type '(alist :key-type symbol :value-type (alist :key-type symbol :value-type function)) :set (lambda (symbol value) (set-default symbol value) - (setq tree-sitter-fold-foldable-node-alist + (setq ts-fold-foldable-node-alist (let (alist) - (dolist (item tree-sitter-fold-range-alist) + (dolist (item ts-fold-range-alist) (let ((mode (car item)) nodes) (dolist (rule (cdr item)) (push (car rule) nodes)) (push (cons mode nodes) alist))) alist))) - :group 'tree-sitter-fold) + :group 'ts-fold) -(defcustom tree-sitter-fold-mode-hook nil - "Hook to run when enabling `tree-sitter-fold-mode`." +(defcustom ts-fold-mode-hook nil + "Hook to run when enabling `ts-fold-mode`." :type 'hook - :group 'tree-sitter-fold) + :group 'ts-fold) -(defcustom tree-sitter-fold-replacement "..." +(defcustom ts-fold-replacement "..." "Show this string instead of the folded text." :type 'string - :group 'tree-sitter-fold) + :group 'ts-fold) -(defface tree-sitter-fold-replacement-face +(defface ts-fold-replacement-face '((t :foreground "#808080" :box '(:line-width -1 :style 'pressed-button))) "Face used to display the fold replacement text." - :group 'tree-sitter-fold) + :group 'ts-fold) -(defface tree-sitter-fold-fringe-face +(defface ts-fold-fringe-face '((t ())) "Face used to display fringe contents." - :group 'tree-sitter-fold) + :group 'ts-fold) ;; ;; (@* "Externals" ) ;; -(declare-function tree-sitter-fold-indicators-refresh "tree-sitter-fold-indicators.el") +(declare-function ts-fold-indicators-refresh "ts-fold-indicators.el") ;; ;; (@* "Entry" ) ;; -(defun tree-sitter-fold--enable () +(defun ts-fold--enable () "Start folding minor mode." (setq-local line-move-ignore-invisible t) - (add-to-invisibility-spec '(tree-sitter-fold . t)) + (add-to-invisibility-spec '(ts-fold . t)) ;; evil integration (when (bound-and-true-p evil-fold-list) (add-to-list 'evil-fold-list - '((tree-sitter-fold-mode) - :open tree-sitter-fold-open - :close tree-sitter-fold-close - :open-rec tree-sitter-fold-open-recursively - :open-all tree-sitter-fold-open-all - :close-all tree-sitter-fold-close-all))) + '((ts-fold-mode) + :open ts-fold-open + :close ts-fold-close + :open-rec ts-fold-open-recursively + :open-all ts-fold-open-all + :close-all ts-fold-close-all))) - (run-hooks 'tree-sitter-fold-mode-hook)) + (run-hooks 'ts-fold-mode-hook)) -(defun tree-sitter-fold--disable () +(defun ts-fold--disable () "Stop folding minor mode." - (remove-from-invisibility-spec '(tree-sitter-fold . t)) + (remove-from-invisibility-spec '(ts-fold . t)) (let ((tree-sitter-mode t)) - (tree-sitter-fold-open-all))) + (ts-fold-open-all))) ;;;###autoload -(define-minor-mode tree-sitter-fold-mode +(define-minor-mode ts-fold-mode "Folding code using tree sitter." :init-value nil :lighter "TS-Fold" - (if tree-sitter-fold-mode (tree-sitter-fold--enable) (tree-sitter-fold--disable))) + (if ts-fold-mode (ts-fold--enable) (ts-fold--disable))) ;;;###autoload -(define-global-minor-mode global-tree-sitter-fold-mode tree-sitter-fold-mode - (lambda () (tree-sitter-fold-mode 1))) +(define-global-minor-mode global-ts-fold-mode ts-fold-mode + (lambda () (ts-fold-mode 1))) ;; ;; (@* "Core" ) ;; -(defun tree-sitter-fold--foldable-node-at-pos (&optional pos) +(defun ts-fold--foldable-node-at-pos (&optional pos) "Return the smallest foldable node at POS. If POS is nil, use `point'. Raise `user-error' if no foldable node is found. This function is borrowed from `tree-sitter-node-at-point'." (let* ((pos (or pos (point))) - (foldable-types (alist-get major-mode tree-sitter-fold-foldable-node-alist)) + (foldable-types (alist-get major-mode ts-fold-foldable-node-alist)) (root (tsc-root-node tree-sitter-tree)) (node (tsc-get-descendant-for-position-range root pos pos))) (let ((current node) result) @@ -194,43 +194,43 @@ This function is borrowed from `tree-sitter-node-at-point'." (setq current (tsc-get-parent current)))) (or result (user-error "No foldable node found at POS"))))) -(defun tree-sitter-fold--get-fold-range (node) +(defun ts-fold--get-fold-range (node) "Return the beginning (as buffer position) of fold for NODE." - (when-let* ((fold-alist (alist-get major-mode tree-sitter-fold-range-alist)) + (when-let* ((fold-alist (alist-get major-mode ts-fold-range-alist)) (item (alist-get (tsc-node-type node) fold-alist))) (cond ((functionp item) (funcall item node (cons 0 0))) ((listp item) (funcall (nth 0 item) node (cons (nth 1 item) (nth 2 item)))) - (t (user-error "Current node is not found in `tree-sitter-fold-range-alist' in %s" major-mode))))) + (t (user-error "Current node is not found in `ts-fold-range-alist' in %s" major-mode))))) ;; ;; (@* "Overlays" ) ;; -(defun tree-sitter-fold--create-overlay (range) +(defun ts-fold--create-overlay (range) "Create invisible overlay in RANGE." (when range (let* ((beg (car range)) (end (cdr range)) (ov (make-overlay beg end))) - (overlay-put ov 'creator 'tree-sitter-fold) - (overlay-put ov 'invisible 'tree-sitter-fold) - (overlay-put ov 'display (or (and tree-sitter-fold-summary-show - (tree-sitter-fold-summary--get (buffer-substring beg end))) - tree-sitter-fold-replacement)) - (overlay-put ov 'face 'tree-sitter-fold-replacement-face) - (overlay-put ov 'isearch-open-invisible #'tree-sitter-fold--isearch-open)))) - -(defun tree-sitter-fold--isearch-open (ov) + (overlay-put ov 'creator 'ts-fold) + (overlay-put ov 'invisible 'ts-fold) + (overlay-put ov 'display (or (and ts-fold-summary-show + (ts-fold-summary--get (buffer-substring beg end))) + ts-fold-replacement)) + (overlay-put ov 'face 'ts-fold-replacement-face) + (overlay-put ov 'isearch-open-invisible #'ts-fold--isearch-open)))) + +(defun ts-fold--isearch-open (ov) "Open overlay OV during `isearch' session." (delete-overlay ov)) -(defun tree-sitter-fold-overlay-at (node) - "Return the tree-sitter-fold overlay at NODE if NODE is foldable and folded. +(defun ts-fold-overlay-at (node) + "Return the ts-fold overlay at NODE if NODE is foldable and folded. Return nil otherwise." - (when-let* ((foldable-types (alist-get major-mode tree-sitter-fold-foldable-node-alist)) + (when-let* ((foldable-types (alist-get major-mode ts-fold-foldable-node-alist)) ((memq (tsc-node-type node) foldable-types)) - (range (tree-sitter-fold--get-fold-range node))) + (range (ts-fold--get-fold-range node))) (thread-last (overlays-in (car range) (cdr range)) (seq-filter (lambda (ov) - (and (eq (overlay-get ov 'invisible) 'tree-sitter-fold) + (and (eq (overlay-get ov 'invisible) 'ts-fold) (= (overlay-start ov) (car range)) (= (overlay-end ov) (cdr range))))) car))) @@ -239,7 +239,7 @@ Return nil otherwise." ;; (@* "Commands" ) ;; -(defmacro tree-sitter-fold--ensure-ts (&rest body) +(defmacro ts-fold--ensure-ts (&rest body) "Run BODY only if `tree-sitter-mode` is enabled." (declare (indent 0)) `(if (bound-and-true-p tree-sitter-mode) @@ -247,100 +247,100 @@ Return nil otherwise." (user-error "Ignored, tree-sitter-mode is not enable in the current buffer"))) ;;;###autoload -(defun tree-sitter-fold-close (&optional node) +(defun ts-fold-close (&optional node) "Fold the syntax node at `point` if it is foldable. -Foldable nodes are defined in `tree-sitter-fold-foldable-node-alist' for the +Foldable nodes are defined in `ts-fold-foldable-node-alist' for the current `major-mode'. If no foldable NODE is found in point, do nothing." (interactive) - (tree-sitter-fold--ensure-ts - (let ((node (or node (tree-sitter-fold--foldable-node-at-pos)))) + (ts-fold--ensure-ts + (let ((node (or node (ts-fold--foldable-node-at-pos)))) ;; make sure I do not create multiple overlays for the same fold - (when-let* ((ov (tree-sitter-fold-overlay-at node))) + (when-let* ((ov (ts-fold-overlay-at node))) (delete-overlay ov)) - (tree-sitter-fold--create-overlay (tree-sitter-fold--get-fold-range node))))) + (ts-fold--create-overlay (ts-fold--get-fold-range node))))) ;;;###autoload -(defun tree-sitter-fold-open () +(defun ts-fold-open () "Open the fold of the syntax node in which `point' resides. If the current node is not folded or not foldable, do nothing." (interactive) - (tree-sitter-fold--ensure-ts - (when-let* ((node (tree-sitter-fold--foldable-node-at-pos)) - (ov (tree-sitter-fold-overlay-at node))) + (ts-fold--ensure-ts + (when-let* ((node (ts-fold--foldable-node-at-pos)) + (ov (ts-fold-overlay-at node))) (delete-overlay ov)))) ;;;###autoload -(defun tree-sitter-fold-open-recursively () +(defun ts-fold-open-recursively () "Open recursively folded syntax NODE that are contained in the node at point." (interactive) - (tree-sitter-fold--ensure-ts - (when-let* ((node (tree-sitter-fold--foldable-node-at-pos)) + (ts-fold--ensure-ts + (when-let* ((node (ts-fold--foldable-node-at-pos)) (beg (tsc-node-start-position node)) (end (tsc-node-end-position node))) (thread-last (overlays-in beg end) - (seq-filter (lambda (ov) (eq (overlay-get ov 'invisible) 'tree-sitter-fold))) + (seq-filter (lambda (ov) (eq (overlay-get ov 'invisible) 'ts-fold))) (mapc #'delete-overlay))))) ;;;###autoload -(defun tree-sitter-fold-close-all () +(defun ts-fold-close-all () "Fold all foldable syntax nodes in the buffer." (interactive) - (tree-sitter-fold--ensure-ts + (ts-fold--ensure-ts (let* ((node (tsc-root-node tree-sitter-tree)) (patterns (seq-mapcat (lambda (type) `(,(list type) @name)) - (alist-get major-mode tree-sitter-fold-foldable-node-alist) + (alist-get major-mode ts-fold-foldable-node-alist) 'vector)) (query (tsc-make-query tree-sitter-language patterns)) (nodes-to-fold (tsc-query-captures query node #'ignore))) (thread-last nodes-to-fold (mapcar #'cdr) - (mapc #'tree-sitter-fold-close))))) + (mapc #'ts-fold-close))))) ;;;###autoload -(defun tree-sitter-fold-open-all () +(defun ts-fold-open-all () "Unfold all syntax nodes in the buffer." (interactive) - (tree-sitter-fold--ensure-ts + (ts-fold--ensure-ts (thread-last (overlays-in (point-min) (point-max)) - (seq-filter (lambda (ov) (eq (overlay-get ov 'invisible) 'tree-sitter-fold))) + (seq-filter (lambda (ov) (eq (overlay-get ov 'invisible) 'ts-fold))) (mapc #'delete-overlay)))) ;;;###autoload -(defun tree-sitter-fold-toggle () +(defun ts-fold-toggle () "Toggle the syntax node at `point'. If the current syntax node is not foldable, do nothing." (interactive) - (tree-sitter-fold--ensure-ts - (if-let* ((node (tree-sitter-fold--foldable-node-at-pos (point))) - (ov (tree-sitter-fold-overlay-at node))) + (ts-fold--ensure-ts + (if-let* ((node (ts-fold--foldable-node-at-pos (point))) + (ov (ts-fold-overlay-at node))) (progn (delete-overlay ov) t) - (tree-sitter-fold-close)))) + (ts-fold-close)))) -(defun tree-sitter-fold--after-command (&rest _) +(defun ts-fold--after-command (&rest _) "Function call after interactive commands." - (tree-sitter-fold-indicators-refresh)) - -(let ((commands '(tree-sitter-fold-close - tree-sitter-fold-open - tree-sitter-fold-open-recursively - tree-sitter-fold-close-all - tree-sitter-fold-open-all - tree-sitter-fold-toggle))) + (ts-fold-indicators-refresh)) + +(let ((commands '(ts-fold-close + ts-fold-open + ts-fold-open-recursively + ts-fold-close-all + ts-fold-open-all + ts-fold-toggle))) (dolist (command commands) - (advice-add command :after #'tree-sitter-fold--after-command))) + (advice-add command :after #'ts-fold--after-command))) ;; ;; (@* "Rule Helpers" ) ;; -(defun tree-sitter-fold--next-prev-node (node next) +(defun ts-fold--next-prev-node (node next) "Return previous/next sibling node starting from NODE. If NEXT is non-nil, return next sibling. Otherwirse, return previouse sibling." (if next (tsc-get-next-sibling node) (tsc-get-prev-sibling node))) -(defun tree-sitter-fold--continuous-node-prefix (node prefix next) +(defun ts-fold--continuous-node-prefix (node prefix next) "Iterate through node starting from NODE and compare node-text to PREFIX; then return the last iterated node. @@ -354,99 +354,99 @@ in backward direction." line (car (tsc-node-start-point iter-node)) line-range (1+ (s-count-matches "\n" text)) max-line-range (max line-range last-line-range)) - (if (and (tree-sitter-fold-util--in-range-p line (- last-line max-line-range) (+ last-line max-line-range)) + (if (and (ts-fold-util--in-range-p line (- last-line max-line-range) (+ last-line max-line-range)) (string-prefix-p prefix text)) (setq last-node iter-node last-line line last-line-range (1+ (s-count-matches "\n" text))) (setq break t)) - (setq iter-node (tree-sitter-fold--next-prev-node iter-node next))) + (setq iter-node (ts-fold--next-prev-node iter-node next))) last-node)) -(defun tree-sitter-fold-range-seq (node offset) +(defun ts-fold-range-seq (node offset) "Return the fold range in sequence starting from NODE. Argument OFFSET can be used to tweak the final beginning and end position." (let ((beg (1+ (tsc-node-start-position node))) (end (1- (tsc-node-end-position node)))) - (tree-sitter-fold-util--cons-add (cons beg end) offset))) + (ts-fold-util--cons-add (cons beg end) offset))) -(defun tree-sitter-fold-range-line-comment (node offset prefix) +(defun ts-fold-range-line-comment (node offset prefix) "Define fold range for line comment. -For arguments NODE and OFFSET, see function `tree-sitter-fold-range-seq' for +For arguments NODE and OFFSET, see function `ts-fold-range-seq' for more information. Argument PREFIX is the comment prefix in string." - (when-let* ((first-node (tree-sitter-fold--continuous-node-prefix node prefix nil)) - (last-node (tree-sitter-fold--continuous-node-prefix node prefix t)) + (when-let* ((first-node (ts-fold--continuous-node-prefix node prefix nil)) + (last-node (ts-fold--continuous-node-prefix node prefix t)) (prefix-len (length prefix)) (beg (+ (tsc-node-start-position first-node) prefix-len)) (end (tsc-node-end-position last-node))) - (tree-sitter-fold-util--cons-add (cons beg end) offset))) + (ts-fold-util--cons-add (cons beg end) offset))) -(defun tree-sitter-fold-range-block-comment (node offset) +(defun ts-fold-range-block-comment (node offset) "Define fold range for block comment. -For arguments NODE and OFFSET, see function `tree-sitter-fold-range-seq' for +For arguments NODE and OFFSET, see function `ts-fold-range-seq' for more information." - (tree-sitter-fold-range-seq node (tree-sitter-fold-util--cons-add '(1 . -1) offset))) + (ts-fold-range-seq node (ts-fold-util--cons-add '(1 . -1) offset))) -(defun tree-sitter-fold-range-c-like-comment (node offset) +(defun ts-fold-range-c-like-comment (node offset) "Define fold range for C-like comemnt." (let ((text (tsc-node-text node))) (if (and (string-match-p "\n" text) (string-prefix-p "/*" text)) - (tree-sitter-fold-range-block-comment node offset) + (ts-fold-range-block-comment node offset) (if (string-prefix-p "///" text) - (tree-sitter-fold-range-line-comment node offset "///") - (tree-sitter-fold-range-line-comment node offset "//"))))) + (ts-fold-range-line-comment node offset "///") + (ts-fold-range-line-comment node offset "//"))))) ;; ;; (@* "Languages" ) ;; -(defun tree-sitter-fold-range-c-preproc-if (node offset) +(defun ts-fold-range-c-preproc-if (node offset) "Define fold range for `if' preprocessor." (let* ((named-node (tsc-get-child-by-field node :condition)) (else (tsc-get-child-by-field node :alternative)) (beg (tsc-node-end-position named-node)) (end (1- (tsc-node-start-position else)))) - (tree-sitter-fold-util--cons-add (cons beg end) offset))) + (ts-fold-util--cons-add (cons beg end) offset))) -(defun tree-sitter-fold-range-c-preproc-ifdef (node offset) +(defun ts-fold-range-c-preproc-ifdef (node offset) "Define fold range for `ifdef' and `ifndef' preprocessor." (when-let* ((named-node (tsc-get-child-by-field node :name)) (else (tsc-get-child-by-field node :alternative)) (beg (tsc-node-end-position named-node)) (end (1- (tsc-node-start-position else)))) - (tree-sitter-fold-util--cons-add (cons beg end) offset))) + (ts-fold-util--cons-add (cons beg end) offset))) -(defun tree-sitter-fold-range-c-preproc-elif (node offset) +(defun ts-fold-range-c-preproc-elif (node offset) "Define fold range for `elif' preprocessor." (when-let* ((named-node (tsc-get-child-by-field node :condition)) (else (tsc-get-child-by-field node :alternative)) (beg (tsc-node-end-position named-node)) (end (1- (tsc-node-start-position else)))) - (tree-sitter-fold-util--cons-add (cons beg end) offset))) + (ts-fold-util--cons-add (cons beg end) offset))) -(defun tree-sitter-fold-range-c-preproc-else (node offset) +(defun ts-fold-range-c-preproc-else (node offset) "Define fold range for `else' preprocessor." (when-let* ((target "#else") (len (length target)) (beg (+ (tsc-node-start-position node) len)) (end (tsc-node-end-position node))) - (tree-sitter-fold-util--cons-add (cons beg end) offset))) + (ts-fold-util--cons-add (cons beg end) offset))) -(defun tree-sitter-fold-range-html (node offset) +(defun ts-fold-range-html (node offset) "Define fold range for tag in HTML." (let* ((beg (tsc-node-end-position (tsc-get-nth-child node 0))) (end-node (tsc-get-nth-child node (1- (tsc-count-children node)))) (end (tsc-node-start-position end-node))) - (tree-sitter-fold-util--cons-add (cons beg end) offset))) + (ts-fold-util--cons-add (cons beg end) offset))) -(defun tree-sitter-fold-range-python (node offset) +(defun ts-fold-range-python (node offset) "Define fold range for `function_definition' and `class_definition'. -For arguments NODE and OFFSET, see function `tree-sitter-fold-range-seq' for +For arguments NODE and OFFSET, see function `ts-fold-range-seq' for more information." (when-let* ((named-node (or (tsc-get-child-by-field node :superclasses) (tsc-get-child-by-field node :return_type) @@ -455,31 +455,31 @@ more information." ;; the colon is an anonymous node after return_type or parameters node (beg (tsc-node-end-position (tsc-get-next-sibling named-node))) (end (tsc-node-end-position node))) - (tree-sitter-fold-util--cons-add (cons beg end) offset))) + (ts-fold-util--cons-add (cons beg end) offset))) -(defun tree-sitter-fold-range-ruby (node offset) +(defun ts-fold-range-ruby (node offset) "Define fold range for `method' and `class' in Ruby. -For arguments NODE and OFFSET, see function `tree-sitter-fold-range-seq' for +For arguments NODE and OFFSET, see function `ts-fold-range-seq' for more information." (when-let* ((named-node (or (tsc-get-child-by-field node :superclass) (tsc-get-child-by-field node :parameters) (tsc-get-child-by-field node :name))) (beg (tsc-node-end-position named-node)) (end (tsc-node-end-position node))) - (tree-sitter-fold-util--cons-add (cons beg end) offset))) + (ts-fold-util--cons-add (cons beg end) offset))) -(defun tree-sitter-fold-range-rust-macro (node offset) +(defun ts-fold-range-rust-macro (node offset) "Return the fold range for `macro_definition' NODE in Rust. -For arguments NODE and OFFSET, see function `tree-sitter-fold-range-seq' for +For arguments NODE and OFFSET, see function `ts-fold-range-seq' for more information." (when-let* ((children (tsc-count-children node)) (last_bracket (tsc-get-nth-child node (- children 1))) (first_bracket (tsc-get-nth-child node 2)) (beg (tsc-node-start-position first_bracket)) (end (1+ (tsc-node-start-position last_bracket)))) - (tree-sitter-fold-util--cons-add (cons beg end) offset))) + (ts-fold-util--cons-add (cons beg end) offset))) -(provide 'tree-sitter-fold) -;;; tree-sitter-fold.el ends here +(provide 'ts-fold) +;;; ts-fold.el ends here