diff options
Diffstat (limited to 'lisp/treesit.el')
| -rw-r--r-- | lisp/treesit.el | 1294 |
1 files changed, 967 insertions, 327 deletions
diff --git a/lisp/treesit.el b/lisp/treesit.el index 2676ed932dc..2b4893e6129 100644 --- a/lisp/treesit.el +++ b/lisp/treesit.el @@ -32,9 +32,8 @@ ;;; Code: -(eval-when-compile (require 'cl-lib)) (eval-when-compile (require 'subr-x)) ; For `string-join'. -(require 'cl-seq) +(require 'cl-lib) (require 'font-lock) (require 'seq) @@ -56,6 +55,7 @@ (declare-function treesit-parser-list "treesit.c") (declare-function treesit-parser-buffer "treesit.c") (declare-function treesit-parser-language "treesit.c") +(declare-function treesit-parser-tag "treesit.c") (declare-function treesit-parser-root-node "treesit.c") @@ -88,9 +88,12 @@ (declare-function treesit-search-forward "treesit.c") (declare-function treesit-induce-sparse-tree "treesit.c") (declare-function treesit-subtree-stat "treesit.c") +(declare-function treesit-node-match-p "treesit.c") (declare-function treesit-available-p "treesit.c") +(defvar treesit-thing-settings) + ;;; Custom options ;; Tree-sitter always appear as treesit in symbols. @@ -106,7 +109,7 @@ indent, imenu, etc." ;; 40MB for 64-bit systems, 15 for 32-bit. (if (or (< most-positive-fixnum (* 2.0 1024 mb)) ;; 32-bit system with wide ints. - (string-match-p "--with-wide-int" system-configuration-options)) + (string-search "--with-wide-int" system-configuration-options)) (* 15 mb) (* 40 mb))) "Maximum buffer size (in bytes) for enabling tree-sitter parsing. @@ -143,10 +146,15 @@ cumbersome and can't deal with some edge cases.") (defun treesit-language-at (position) "Return the language at POSITION. + This function assumes that parser ranges are up-to-date. It returns the return value of `treesit-language-at-point-function' if it's non-nil, otherwise it returns the language of the first -parser in `treesit-parser-list', or nil if there is no parser." +parser in `treesit-parser-list', or nil if there is no parser. + +In a multi-language buffer, make sure +`treesit-language-at-point-function' is implemented! Otherwise +`treesit-language-at' wouldn't return the correct result." (if treesit-language-at-point-function (funcall treesit-language-at-point-function position) (when-let ((parser (car (treesit-parser-list)))) @@ -190,11 +198,20 @@ only look for named nodes. If PARSER-OR-LANG is a parser, use that parser; if PARSER-OR-LANG is a language, find the first parser for that language in the current buffer, or create one if none exists; If PARSER-OR-LANG -is nil, try to guess the language at POS using `treesit-language-at'." +is nil, try to guess the language at POS using `treesit-language-at'. + +If there's a local parser at POS, the local parser takes priority +unless PARSER-OR-LANG is a parser, or PARSER-OR-LANG is a +language and doesn't match the language of the local parser." (let* ((root (if (treesit-parser-p parser-or-lang) (treesit-parser-root-node parser-or-lang) - (treesit-buffer-root-node - (or parser-or-lang (treesit-language-at pos))))) + (or (when-let ((parser + (car (treesit-local-parsers-at + pos parser-or-lang)))) + (treesit-parser-root-node parser)) + (treesit-buffer-root-node + (or parser-or-lang + (treesit-language-at pos)))))) (node root) (node-before root) (pos-1 (max (1- pos) (point-min))) @@ -239,11 +256,20 @@ named node. If PARSER-OR-LANG is a parser, use that parser; if PARSER-OR-LANG is a language, find the first parser for that language in the current buffer, or create one if none exists; If PARSER-OR-LANG -is nil, try to guess the language at BEG using `treesit-language-at'." - (let ((root (if (treesit-parser-p parser-or-lang) - (treesit-parser-root-node parser-or-lang) - (treesit-buffer-root-node - (or parser-or-lang (treesit-language-at beg)))))) +is nil, try to guess the language at BEG using `treesit-language-at'. + +If there's a local parser between BEG and END, try to use that +parser first." + (let* ((lang-at-point (treesit-language-at beg)) + (root (if (treesit-parser-p parser-or-lang) + (treesit-parser-root-node parser-or-lang) + (or (when-let ((parser + (car (treesit-local-parsers-on + beg end (or parser-or-lang + lang-at-point))))) + (treesit-parser-root-node parser)) + (treesit-buffer-root-node + (or parser-or-lang lang-at-point)))))) (treesit-node-descendant-for-range root beg (or end beg) named))) (defun treesit-node-top-level (node &optional pred include-node) @@ -252,33 +278,32 @@ is nil, try to guess the language at BEG using `treesit-language-at'." Specifically, return the highest parent of NODE that has the same type as it. If no such parent exists, return nil. -If PRED is non-nil, match each parent's type with PRED as a -regexp, rather than using NODE's type. PRED can also be a -function that takes the node as an argument, and return -non-nil/nil for match/no match. +If PRED is non-nil, match each parent's type with PRED rather +than using NODE's type. PRED can also be a predicate function, +and more. See `treesit-thing-settings' for details. If INCLUDE-NODE is non-nil, return NODE if it satisfies PRED." - (let ((pred (or pred (treesit-node-type node))) + (let ((pred (or pred (rx bos (literal (treesit-node-type node)) eos))) (result nil)) (cl-loop for cursor = (if include-node node (treesit-node-parent node)) then (treesit-node-parent cursor) while cursor - if (if (stringp pred) - (string-match-p pred (treesit-node-type cursor)) - (funcall pred cursor)) + if (treesit-node-match-p cursor pred t) do (setq result cursor)) result)) -(defun treesit-buffer-root-node (&optional language) +(defun treesit-buffer-root-node (&optional language tag) "Return the root node of the current buffer. Use the first parser in the parser list if LANGUAGE is omitted. -If LANGUAGE is non-nil, use the first parser for LANGUAGE in the -parser list, or create one if none exists." + +If LANGUAGE is non-nil, use the first parser for LANGUAGE with +TAG in the parser list, or create one if none exists. TAG +defaults to nil." (if-let ((parser (if language - (treesit-parser-create language) + (treesit-parser-create language nil nil tag) (or (car (treesit-parser-list)) (signal 'treesit-no-parser (list (current-buffer))))))) (treesit-parser-root-node parser))) @@ -319,14 +344,13 @@ ancestor node which satisfies the predicate PRED; then it returns that ancestor node. It returns nil if no ancestor node was found that satisfies PRED. -PRED should be a function that takes one argument, the node to -examine, and returns a boolean value indicating whether that -node is a match. +PRED can be a predicate function, a regexp matching node type, +and more; see docstring of `treesit-thing-settings'. If INCLUDE-NODE is non-nil, return NODE if it satisfies PRED." (let ((node (if include-node node (treesit-node-parent node)))) - (while (and node (not (funcall pred node))) + (while (and node (not (treesit-node-match-p node pred))) (setq node (treesit-node-parent node))) node)) @@ -339,11 +363,10 @@ no longer satisfies the predicate PRED; it returns the last examined node that satisfies PRED. If no node satisfies PRED, it returns nil. -PRED should be a function that takes one argument, the node to -examine, and returns a boolean value indicating whether that -node is a match." +PRED can be a predicate function, a regexp matching node type, +and more; see docstring of `treesit-thing-settings'." (let ((last nil)) - (while (and node (funcall pred node)) + (while (and node (treesit-node-match-p node pred)) (setq last node node (treesit-node-parent node))) last)) @@ -370,6 +393,85 @@ If NAMED is non-nil, count named child only." (idx (treesit-node-index node))) (treesit-node-field-name-for-child parent idx))) +(defun treesit-node-get (node instructions) + "Get things from NODE by INSTRUCTIONS. + +This is a convenience function that chains together multiple node +accessor functions together. For example, to get NODE's parent's +next sibling's second child's text, call + + (treesit-node-get node + \\='((parent 1) + (sibling 1 nil) + (child 1 nil) + (text nil))) + +INSTRUCTION is a list of INSTRUCTIONs of the form (FN ARG...). +The following FN's are supported: + +\(child IDX NAMED) Get the IDX'th child +\(parent N) Go to parent N times +\(field-name) Get the field name of the current node +\(type) Get the type of the current node +\(text NO-PROPERTY) Get the text of the current node +\(children NAMED) Get a list of children +\(sibling STEP NAMED) Get the nth prev/next sibling, negative STEP + means prev sibling, positive means next + +Note that arguments like NAMED and NO-PROPERTY can't be omitted, +unlike in their original functions." + (declare (indent 1)) + (while (and node instructions) + (pcase (pop instructions) + ('(field-name) (setq node (treesit-node-field-name node))) + ('(type) (setq node (treesit-node-type node))) + (`(child ,idx ,named) (setq node (treesit-node-child node idx named))) + (`(parent ,n) (dotimes (_ n) + (setq node (treesit-node-parent node)))) + (`(text ,no-property) (setq node (treesit-node-text node no-property))) + (`(children ,named) (setq node (treesit-node-children node named))) + (`(sibling ,step ,named) + (dotimes (_ (abs step)) + (setq node (if (> step 0) + (treesit-node-next-sibling node named) + (treesit-node-prev-sibling node named))))))) + node) + +(defun treesit-node-enclosed-p (smaller larger &optional strict) + "Return non-nil if SMALLER is enclosed in LARGER. +SMALLER and LARGER can be either (BEG . END) or a node. + +Return non-nil if LARGER's start <= SMALLER's start and LARGER's +end <= SMALLER's end. + +If STRICT is t, compare with < rather than <=. + +If STRICT is \\='partial, consider LARGER encloses SMALLER when +at least one side is strictly enclosing." + (unless (and (or (consp larger) (treesit-node-p larger)) + (or (consp smaller) (treesit-node-p smaller))) + (signal 'wrong-type-argument '((or cons treesit-node)))) + (let ((larger-start (if (consp larger) + (car larger) + (treesit-node-start larger))) + (larger-end (if (consp larger) + (cdr larger) + (treesit-node-end larger))) + (smaller-start (if (consp smaller) + (car smaller) + (treesit-node-start smaller))) + (smaller-end (if (consp smaller) + (cdr smaller) + (treesit-node-end smaller)))) + (pcase strict + ('t (and (< larger-start smaller-start) + (< smaller-end larger-end))) + ('partial (and (or (not (eq larger-start smaller-start)) + (not (eq larger-end smaller-end))) + (<= larger-start smaller-start + smaller-end larger-end))) + (_ (<= larger-start smaller-start smaller-end larger-end))))) + ;;; Query API supplement (defun treesit-query-string (string query language) @@ -382,32 +484,40 @@ See `treesit-query-capture' for QUERY." (treesit-parser-root-node parser) query)))) -(defun treesit-query-range (node query &optional beg end) +(defun treesit-query-range (node query &optional beg end offset) "Query the current buffer and return ranges of captured nodes. QUERY, NODE, BEG, END are the same as in `treesit-query-capture'. This function returns a list of (START . END), where START and -END specifics the range of each captured node. Capture names -generally don't matter, but names that starts with an underscore -are ignored." - (cl-loop for capture - in (treesit-query-capture node query beg end) - for name = (car capture) - for node = (cdr capture) - if (not (string-prefix-p "_" (symbol-name name))) - collect (cons (treesit-node-start node) - (treesit-node-end node)))) +END specifics the range of each captured node. OFFSET is an +optional pair of numbers (START-OFFSET . END-OFFSET). The +respective offset values are added to each (START . END) range +being returned. Capture names generally don't matter, but names +that starts with an underscore are ignored." + (let ((offset-left (or (car offset) 0)) + (offset-right (or (cdr offset) 0))) + (cl-loop for capture + in (treesit-query-capture node query beg end) + for name = (car capture) + for node = (cdr capture) + if (not (string-prefix-p "_" (symbol-name name))) + collect (cons (+ (treesit-node-start node) offset-left) + (+ (treesit-node-end node) offset-right))))) ;;; Range API supplement (defvar-local treesit-range-settings nil "A list of range settings. -Each element of the list is of the form (QUERY LANGUAGE). -When updating the range of each parser in the buffer, +Each element of the list is of the form (QUERY LANGUAGE LOCAL-P +OFFSET). When updating the range of each parser in the buffer, `treesit-update-ranges' queries each QUERY, and sets LANGUAGE's range to the range spanned by captured nodes. QUERY must be a -compiled query. +compiled query. If LOCAL-P is t, give each range a separate +local parser rather than using a single parser for all the +ranges. If OFFSET is non-nil, it should be a cons of +numbers (START-OFFSET . END-OFFSET), where the start and end +offset are added to each queried range to get the result ranges. Capture names generally don't matter, but names that starts with an underscore are ignored. @@ -440,6 +550,7 @@ it. For example, (treesit-range-rules :embed \\='javascript :host \\='html + :offset \\='(1 . -1) \\='((script_element (raw_text) @cap))) The `:embed' keyword specifies the embedded language, and the @@ -448,15 +559,28 @@ this way: Emacs queries QUERY in the host language's parser, computes the ranges spanned by the captured nodes, and applies these ranges to parsers for the embedded language. +If there's a `:local' keyword with value t, the range computed by +this QUERY is given a dedicated local parser. Otherwise, the +range shares the same parser with other ranges. + +If there's an `:offset' keyword with a pair of numbers, each +captured range is offset by those numbers. For example, an +offset of (1 . -1) will update a captured range of (2 . 8) to +be (3 . 7). This can be used to exclude things like surrounding +delimiters from being included in the range covered by an +embedded parser. + QUERY can also be a function that takes two arguments, START and END. If QUERY is a function, it doesn't need the :KEYWORD VALUE pair preceding it. This function should set the ranges for parsers in the current buffer in the region between START and END. It is OK for this function to set ranges in a larger region that encompasses the region between START and END." - (let (host embed result) + (let (host embed offset result local) (while query-specs (pcase (pop query-specs) + (:local (when (eq t (pop query-specs)) + (setq local t))) (:host (let ((host-lang (pop query-specs))) (unless (symbolp host-lang) (signal 'treesit-error (list "Value of :host option should be a symbol" host-lang))) @@ -465,6 +589,12 @@ that encompasses the region between START and END." (unless (symbolp embed-lang) (signal 'treesit-error (list "Value of :embed option should be a symbol" embed-lang))) (setq embed embed-lang))) + (:offset (let ((range-offset (pop query-specs))) + (unless (and (consp range-offset) + (numberp (car range-offset)) + (numberp (cdr range-offset))) + (signal 'treesit-error (list "Value of :offset option should be a pair of numbers" range-offset))) + (setq offset range-offset))) (query (if (functionp query) (push (list query nil nil) result) (when (null embed) @@ -472,9 +602,9 @@ that encompasses the region between START and END." (when (null host) (signal 'treesit-error (list "Value of :host option cannot be omitted"))) (push (list (treesit-query-compile host query) - embed host) + embed local offset) result)) - (setq host nil embed nil)))) + (setq host nil embed nil offset nil local nil)))) (nreverse result))) (defun treesit--merge-ranges (old-ranges new-ranges start end) @@ -523,6 +653,85 @@ those inside are kept." if (<= start (car range) (cdr range) end) collect range)) +(defun treesit-local-parsers-at (&optional pos language with-host) + "Return all the local parsers at POS. + +POS defaults to point. +Local parsers are those which only parse a limited region marked +by an overlay with non-nil `treesit-parser' property. +If LANGUAGE is non-nil, only return parsers for LANGUAGE. + +If WITH-HOST is non-nil, return a list of (PARSER . HOST-PARSER) +instead. HOST-PARSER is the host parser which created the local +PARSER." + (let ((res nil)) + (dolist (ov (overlays-at (or pos (point)))) + (when-let ((parser (overlay-get ov 'treesit-parser)) + (host-parser (overlay-get ov 'treesit-host-parser))) + (when (or (null language) + (eq (treesit-parser-language parser) + language)) + (push (if with-host (cons parser host-parser) parser) res)))) + (nreverse res))) + +(defun treesit-local-parsers-on (&optional beg end language with-host) + "Return all the local parsers between BEG END. + +BEG and END default to the beginning and end of the buffer's +accessible portion. +Local parsers are those which have an `embedded' tag, and only parse +a limited region marked by an overlay with a non-nil `treesit-parser' +property. If LANGUAGE is non-nil, only return parsers for LANGUAGE. + +If WITH-HOST is non-nil, return a list of (PARSER . HOST-PARSER) +instead. HOST-PARSER is the host parser which created the local +PARSER." + (let ((res nil)) + (dolist (ov (overlays-in (or beg (point-min)) (or end (point-max)))) + (when-let ((parser (overlay-get ov 'treesit-parser)) + (host-parser (overlay-get ov 'treesit-host-parser))) + (when (or (null language) + (eq (treesit-parser-language parser) + language)) + (push (if with-host (cons parser host-parser) parser) res)))) + (nreverse res))) + +(defun treesit--update-ranges-local + (query embedded-lang &optional beg end) + "Update range for local parsers between BEG and END. +Use QUERY to get the ranges, and make sure each range has a local +parser for EMBEDDED-LANG." + ;; Clean up. + (dolist (ov (overlays-in (or beg (point-min)) (or end (point-max)))) + (when-let ((parser (overlay-get ov 'treesit-parser))) + (when (eq (overlay-start ov) (overlay-end ov)) + (delete-overlay ov) + (treesit-parser-delete parser)))) + ;; Update range. + (let* ((host-lang (treesit-query-language query)) + (host-parser (treesit-parser-create host-lang)) + (ranges (treesit-query-range host-parser query beg end))) + (pcase-dolist (`(,beg . ,end) ranges) + (let ((has-parser nil)) + (dolist (ov (overlays-in beg end)) + ;; Update range of local parser. + (let ((embedded-parser (overlay-get ov 'treesit-parser))) + (when (and (treesit-parser-p embedded-parser) + (eq (treesit-parser-language embedded-parser) + embedded-lang)) + (treesit-parser-set-included-ranges + embedded-parser `((,beg . ,end))) + (setq has-parser t)))) + ;; Create overlay and local parser. + (when (not has-parser) + (let ((embedded-parser (treesit-parser-create + embedded-lang nil t 'embedded)) + (ov (make-overlay beg end nil nil t))) + (overlay-put ov 'treesit-parser embedded-parser) + (overlay-put ov 'treesit-host-parser host-parser) + (treesit-parser-set-included-ranges + embedded-parser `((,beg . ,end))))))))) + (defun treesit-update-ranges (&optional beg end) "Update the ranges for each language in the current buffer. If BEG and END are non-nil, only update parser ranges in that @@ -535,21 +744,25 @@ region." (dolist (setting treesit-range-settings) (let ((query (nth 0 setting)) (language (nth 1 setting)) + (local (nth 2 setting)) + (offset (nth 3 setting)) (beg (or beg (point-min))) (end (or end (point-max)))) - (if (functionp query) (funcall query beg end) + (cond + ((functionp query) (funcall query beg end)) + (local + (treesit--update-ranges-local query language beg end)) + (t (let* ((host-lang (treesit-query-language query)) (parser (treesit-parser-create language)) (old-ranges (treesit-parser-included-ranges parser)) (new-ranges (treesit-query-range - host-lang query beg end)) + host-lang query beg end offset)) (set-ranges (treesit--clip-ranges (treesit--merge-ranges old-ranges new-ranges beg end) (point-min) (point-max)))) - (dolist (parser (treesit-parser-list)) - (when (eq (treesit-parser-language parser) - language) + (dolist (parser (treesit-parser-list nil language)) (treesit-parser-set-included-ranges parser (or set-ranges ;; When there's no range for the embedded @@ -724,6 +937,8 @@ Other keywords include: `append' Append the new face to existing ones. `prepend' Prepend the new face to existing ones. `keep' Fill-in regions without an existing face. + :default-language LANGUAGE Every QUERY after this keyword + will use LANGUAGE by default. Capture names in QUERY should be face names like `font-lock-keyword-face'. The captured node will be fontified @@ -753,12 +968,22 @@ name, it is ignored." ;; that following queries will apply to. current-language current-override current-feature + ;; DEFAULT-LANGUAGE will be chosen when current-language is + ;; not set. + default-language ;; The list this function returns. (result nil)) (while query-specs (let ((token (pop query-specs))) (pcase token ;; (1) Process keywords. + (:default-language + (let ((lang (pop query-specs))) + (when (or (not (symbolp lang)) (null lang)) + (signal 'treesit-font-lock-error + `("Value of :default-language should be a symbol" + ,lang))) + (setq default-language lang))) (:language (let ((lang (pop query-specs))) (when (or (not (symbolp lang)) (null lang)) @@ -786,23 +1011,24 @@ name, it is ignored." (setq current-feature var))) ;; (2) Process query. ((pred treesit-query-p) - (when (null current-language) - (signal 'treesit-font-lock-error - `("Language unspecified, use :language keyword to specify a language for this query" ,token))) - (when (null current-feature) - (signal 'treesit-font-lock-error - `("Feature unspecified, use :feature keyword to specify the feature name for this query" ,token))) - (if (treesit-compiled-query-p token) - (push `(,current-language token) result) - (push `(,(treesit-query-compile current-language token) - t - ,current-feature - ,current-override) - result)) - ;; Clears any configurations set for this query. - (setq current-language nil - current-override nil - current-feature nil)) + (let ((lang (or default-language current-language))) + (when (null lang) + (signal 'treesit-font-lock-error + `("Language unspecified, use :language keyword or :default-language to specify a language for this query" ,token))) + (when (null current-feature) + (signal 'treesit-font-lock-error + `("Feature unspecified, use :feature keyword to specify the feature name for this query" ,token))) + (if (treesit-compiled-query-p token) + (push `(,lang token) result) + (push `(,(treesit-query-compile lang token) + t + ,current-feature + ,current-override) + result)) + ;; Clears any configurations set for this query. + (setq current-language nil + current-override nil + current-feature nil))) (_ (signal 'treesit-font-lock-error `("Unexpected value" ,token)))))) (nreverse result)))) @@ -814,7 +1040,8 @@ name, it is ignored." (defvar treesit--font-lock-verbose nil "If non-nil, print debug messages when fontifying.") -(defun treesit-font-lock-recompute-features (&optional add-list remove-list) +(defun treesit-font-lock-recompute-features + (&optional add-list remove-list language) "Enable/disable font-lock features. Enable each feature in ADD-LIST, disable each feature in @@ -829,7 +1056,10 @@ the features are disabled. ADD-LIST and REMOVE-LIST are lists of feature symbols. The same feature symbol cannot appear in both lists; the function -signals the `treesit-font-lock-error' error if that happens." +signals the `treesit-font-lock-error' error if that happens. + +If LANGUAGE is non-nil, only compute features for that language, +and leave settings for other languages unchanged." (when-let ((intersection (cl-intersection add-list remove-list))) (signal 'treesit-font-lock-error (list "ADD-LIST and REMOVE-LIST contain the same feature" @@ -849,9 +1079,13 @@ signals the `treesit-font-lock-error' error if that happens." (additive (or add-list remove-list))) (cl-loop for idx = 0 then (1+ idx) for setting in treesit-font-lock-settings + for lang = (treesit-query-language (nth 0 setting)) for feature = (nth 2 setting) for current-value = (nth 1 setting) - ;; Set the ENABLE flag for the setting. + ;; Set the ENABLE flag for the setting if its language is + ;; relevant. + if (or (null language) + (eq language lang)) do (setf (nth 1 (nth idx treesit-font-lock-settings)) (cond ((not additive) @@ -864,13 +1098,12 @@ signals the `treesit-font-lock-error' error if that happens." (start end face override &optional bound-start bound-end) "Apply FACE to the region between START and END. OVERRIDE can be nil, t, `append', `prepend', or `keep'. -See `treesit-font-lock-rules' for their semantic. +See `treesit-font-lock-rules' for their semantics. If BOUND-START and BOUND-END are non-nil, only fontify the region in between them." (when (or (null bound-start) (null bound-end) - (and bound-start bound-end - (<= bound-start end) + (and (<= bound-start end) (>= bound-end start))) (when (and bound-start bound-end) (setq start (max bound-start start) @@ -1009,72 +1242,92 @@ If LOUDLY is non-nil, display some debugging information." (message "Fontifying region: %s-%s" start end)) (treesit-update-ranges start end) (font-lock-unfontify-region start end) - (dolist (setting treesit-font-lock-settings) - (let* ((query (nth 0 setting)) - (enable (nth 1 setting)) - (override (nth 3 setting)) - (language (treesit-query-language query))) - - ;; Use deterministic way to decide whether to turn on "fast - ;; mode". (See bug#60691, bug#60223.) - (when (eq treesit--font-lock-fast-mode 'unspecified) - (pcase-let ((`(,max-depth ,max-width) - (treesit-subtree-stat - (treesit-buffer-root-node language)))) - (if (or (> max-depth 100) (> max-width 4000)) - (setq treesit--font-lock-fast-mode t) - (setq treesit--font-lock-fast-mode nil)))) - - (when-let* ((root (treesit-buffer-root-node language)) - (nodes (if (eq t treesit--font-lock-fast-mode) - (treesit--children-covering-range-recurse - root start end (* 4 jit-lock-chunk-size)) - (list (treesit-buffer-root-node language)))) - ;; Only activate if ENABLE flag is t. - (activate (eq t enable))) - (ignore activate) - - ;; Query each node. - (dolist (sub-node nodes) - (let* ((delta-start (car treesit--font-lock-query-expand-range)) - (delta-end (cdr treesit--font-lock-query-expand-range)) - (captures (treesit-query-capture - sub-node query - (max (- start delta-start) (point-min)) - (min (+ end delta-end) (point-max))))) - - ;; For each captured node, fontify that node. - (with-silent-modifications - (dolist (capture captures) - (let* ((face (car capture)) - (node (cdr capture)) - (node-start (treesit-node-start node)) - (node-end (treesit-node-end node))) - - ;; If node is not in the region, take them out. See - ;; comment #3 above for more detail. - (if (and (facep face) - (or (>= start node-end) (>= node-start end))) - (when (or loudly treesit--font-lock-verbose) - (message "Captured node %s(%s-%s) but it is outside of fontifing region" node node-start node-end)) - - (cond - ((facep face) - (treesit-fontify-with-override - (max node-start start) (min node-end end) - face override)) - ((functionp face) - (funcall face node override start end))) - - ;; Don't raise an error if FACE is neither a face nor - ;; a function. This is to allow intermediate capture - ;; names used for #match and #eq. - (when (or loudly treesit--font-lock-verbose) - (message "Fontifying text from %d to %d, Face: %s, Node: %s" - (max node-start start) (min node-end end) - face (treesit-node-type node)))))))))))) + (let* ((local-parsers (treesit-local-parsers-on start end)) + (global-parsers (treesit-parser-list)) + (root-nodes + (mapcar #'treesit-parser-root-node + (append local-parsers global-parsers)))) + (dolist (setting treesit-font-lock-settings) + (let* ((query (nth 0 setting)) + (enable (nth 1 setting)) + (override (nth 3 setting)) + (language (treesit-query-language query)) + (root-nodes (cl-remove-if-not + (lambda (node) + (eq (treesit-node-language node) language)) + root-nodes))) + + ;; Use deterministic way to decide whether to turn on "fast + ;; mode". (See bug#60691, bug#60223.) + (when (eq treesit--font-lock-fast-mode 'unspecified) + (pcase-let ((`(,max-depth ,max-width) + (treesit-subtree-stat + (treesit-buffer-root-node language)))) + (if (or (> max-depth 100) (> max-width 4000)) + (setq treesit--font-lock-fast-mode t) + (setq treesit--font-lock-fast-mode nil)))) + + ;; Only activate if ENABLE flag is t. + (when-let + ((activate (eq t enable)) + (nodes (if (eq t treesit--font-lock-fast-mode) + (mapcan + (lambda (node) + (treesit--children-covering-range-recurse + node start end (* 4 jit-lock-chunk-size))) + root-nodes) + root-nodes))) + (ignore activate) + + ;; Query each node. + (dolist (sub-node nodes) + (treesit--font-lock-fontify-region-1 + sub-node query start end override loudly)))))) `(jit-lock-bounds ,start . ,end)) +(defun treesit--font-lock-fontify-region-1 (node query start end override loudly) + "Fontify the region between START and END by querying NODE with QUERY. + +If OVERRIDE is non-nil, override existing faces, if LOUDLY is +non-nil, print debugging information." + (let* ((delta-start (car treesit--font-lock-query-expand-range)) + (delta-end (cdr treesit--font-lock-query-expand-range)) + (captures (treesit-query-capture + node query + (max (- start delta-start) (point-min)) + (min (+ end delta-end) (point-max))))) + + ;; For each captured node, fontify that node. + (with-silent-modifications + (dolist (capture captures) + (let* ((face (car capture)) + (node (cdr capture)) + (node-start (treesit-node-start node)) + (node-end (treesit-node-end node))) + + ;; If node is not in the region, take them out. See + ;; comment #3 above for more detail. + (if (and (facep face) + (or (>= start node-end) (>= node-start end))) + (when (or loudly treesit--font-lock-verbose) + (message "Captured node %s(%s-%s) but it is outside of fontifing region" node node-start node-end)) + + (cond + ((facep face) + (treesit-fontify-with-override + (max node-start start) (min node-end end) + face override)) + ((functionp face) + (funcall face node override start end))) + + ;; Don't raise an error if FACE is neither a face nor + ;; a function. This is to allow intermediate capture + ;; names used for #match and #eq. + (when (or loudly treesit--font-lock-verbose) + (message "Fontifying text from %d to %d, Face: %s, Node: %s" + (max node-start start) (min node-end end) + face (treesit-node-type node))))))))) + (defun treesit--font-lock-notifier (ranges parser) "Ensures updated parts of the parse-tree are refontified. RANGES is a list of (BEG . END) ranges, PARSER is the tree-sitter @@ -1129,7 +1382,15 @@ as comment due to incomplete parse tree." ;; `treesit-update-ranges' will force the host language's parser to ;; reparse and set correct ranges for embedded parsers. Then ;; `treesit-parser-root-node' will force those parsers to reparse. - (treesit-update-ranges) + (let ((len (+ (* (window-body-height) (window-body-width)) 800))) + ;; FIXME: As a temporary fix, this prevents Emacs from updating + ;; every single local parsers in the buffer every time there's an + ;; edit. Moving forward, we need some way to properly track the + ;; regions which need update on parser ranges, like what jit-lock + ;; and syntax-ppss does. + (treesit-update-ranges + (max (point-min) (- (point) len)) + (min (point-max) (+ (point) len)))) ;; Force repase on _all_ the parsers might not be necessary, but ;; this is probably the most robust way. (dolist (parser (treesit-parser-list)) @@ -1557,9 +1818,18 @@ Return (ANCHOR . OFFSET). This function is used by (forward-line 0) (skip-chars-forward " \t") (point))) + (local-parsers (treesit-local-parsers-at bol nil t)) (smallest-node - (cond ((null (treesit-parser-list)) nil) - ((eq 1 (length (treesit-parser-list))) + (cond ((car local-parsers) + (let ((local-parser (caar local-parsers)) + (host-parser (cdar local-parsers))) + (if (eq (treesit-node-start + (treesit-parser-root-node local-parser)) + bol) + (treesit-node-at bol host-parser) + (treesit-node-at bol local-parser)))) + ((null (treesit-parser-list)) nil) + ((eq 1 (length (treesit-parser-list nil nil t))) (treesit-node-at bol)) ((treesit-language-at bol) (treesit-node-at bol (treesit-language-at bol))) @@ -1740,12 +2010,28 @@ OFFSET." (message "No matched rule")) (cons nil nil)))))) -(defun treesit-check-indent (mode) - "Check current buffer's indentation against a major mode MODE. +(defun treesit--read-major-mode () + "Read a major mode using completion. +Helper function to use in the `interactive' spec of `treesit-check-indent'." + (let* ((default (and (symbolp major-mode) (symbol-name major-mode))) + (mode + (completing-read + (format-prompt "Target major mode" default) + obarray + (lambda (sym) + (and (string-suffix-p "-mode" (symbol-name sym)) + (not (or (memq sym minor-mode-list) + (string-suffix-p "-minor-mode" + (symbol-name sym)))))) + nil nil nil default nil))) + (cond + ((equal mode "nil") nil) + ((and (stringp mode) (fboundp (intern mode))) (intern mode)) + (t mode)))) -Pop up a diff buffer showing the difference. Correct -indentation (target) is in green, current indentation is in red." - (interactive "CTarget major mode: ") +(defun treesit-check-indent (mode) + "Compare the current buffer with how major mode MODE would indent it." + (interactive (list (treesit--read-major-mode))) (let ((source-buf (current-buffer))) (with-temp-buffer (insert-buffer-substring source-buf) @@ -1838,6 +2124,73 @@ BACKWARD and ALL are the same as in `treesit-search-forward'." (goto-char current-pos))) node)) +(make-obsolete 'treesit-sexp-type-regexp + "`treesit-sexp-type-regexp' will be removed soon, use `treesit-thing-settings' instead." "30.1") + +(defvar-local treesit-sexp-type-regexp nil + "A regexp that matches the node type of sexp nodes. + +A sexp node is a node that is bigger than punctuation, and +delimits medium sized statements in the source code. It is, +however, smaller in scope than sentences. This is used by +`treesit-forward-sexp' and friends.") + +(defun treesit-forward-sexp (&optional arg) + "Tree-sitter implementation for `forward-sexp-function'. + +ARG is described in the docstring of `forward-sexp-function'. If +there are no further sexps to move across, signal `scan-error' +like `forward-sexp' does. If point is already at top-level, +return nil without moving point." + (interactive "^p") + (let ((arg (or arg 1)) + (pred (or treesit-sexp-type-regexp 'sexp))) + (or (if (> arg 0) + (treesit-end-of-thing pred (abs arg) 'restricted) + (treesit-beginning-of-thing pred (abs arg) 'restricted)) + ;; If we couldn't move, we should signal an error and report + ;; the obstacle, like `forward-sexp' does. If we couldn't + ;; find a parent, we simply return nil without moving point, + ;; then functions like `up-list' will signal "at top level". + (when-let* ((parent (treesit--thing-at (point) pred t)) + (boundary (if (> arg 0) + (treesit-node-child parent -1) + (treesit-node-child parent 0)))) + (signal 'scan-error (list "No more sexp to move across" + (treesit-node-start boundary) + (treesit-node-end boundary))))))) + +(defun treesit-transpose-sexps (&optional arg) + "Tree-sitter `transpose-sexps' function. +ARG is the same as in `transpose-sexps'. + +Locate the node closest to POINT, and transpose that node with +its sibling node ARG nodes away. + +Return a pair of positions as described by +`transpose-sexps-function' for use in `transpose-subr' and +friends." + ;; First arrive at the right level at where the node at point is + ;; considered a sexp. If sexp isn't defined, or we can't find any + ;; node that's a sexp, use the node at point. + (let* ((node (or (treesit-thing-at-point 'sexp 'nested) + (treesit-node-at (point)))) + (parent (treesit-node-parent node)) + (child (treesit-node-child parent 0 t))) + (named-let loop ((prev child) + (next (treesit-node-next-sibling child t))) + (when (and prev next) + (if (< (point) (treesit-node-end next)) + (if (= arg -1) + (cons (treesit-node-start prev) + (treesit-node-end prev)) + (when-let ((n (treesit-node-child + parent (+ arg (treesit-node-index prev t)) t))) + (cons (treesit-node-end n) + (treesit-node-start n)))) + (loop (treesit-node-next-sibling prev t) + (treesit-node-next-sibling next t))))))) + ;;; Navigation, defun, things ;; ;; Emacs lets you define "things" by a regexp that matches the type of @@ -1853,7 +2206,8 @@ BACKWARD and ALL are the same as in `treesit-search-forward'." ;; - treesit-thing/defun-at-point ;; ;; And more generic functions like: -;; - treesit--things-around +;; - treesit--thing-prev/next +;; - treesit--thing-at ;; - treesit--top-level-thing ;; - treesit--navigate-thing ;; @@ -1862,11 +2216,13 @@ BACKWARD and ALL are the same as in `treesit-search-forward'." ;; ;; TODO: I'm not entirely sure how would this go, so I only documented ;; the "defun" functions and didn't document any "thing" functions. -;; We should also document `treesit-block-type-regexp' and support it -;; in major modes if we can meaningfully integrate hideshow: I tried -;; and failed, we need SomeOne that understands hideshow to look at -;; it. (BTW, hideshow should use its own -;; `treesit-hideshow-block-type-regexp'.) +;; We should also document `treesit-thing-settings'. + +;; TODO: Integration with thing-at-point: once our thing interface is +;; stable. +;; +;; TODO: Integration with hideshow: I tried and failed, we need +;; SomeOne that understands hideshow to look at it. (defvar-local treesit-defun-type-regexp nil "A regexp that matches the node type of defun nodes. @@ -1880,11 +2236,8 @@ for invalid node. This is used by `treesit-beginning-of-defun' and friends.") -(defvar-local treesit-block-type-regexp nil - "Like `treesit-defun-type-regexp', but for blocks.") - (defvar-local treesit-defun-tactic 'nested - "Determines how does Emacs treat nested defuns. + "Determines how Emacs treats nested defuns. If the value is `top-level', Emacs only moves across top-level defuns, if the value is `nested', Emacs recognizes nested defuns.") @@ -1900,52 +2253,73 @@ If the value is nil, no skipping is performed.") (defvar-local treesit-defun-name-function nil "A function that is called with a node and returns its defun name or nil. If the node is a defun node, return the defun name, e.g., the -function name of a function. If the node is not a defun node, or -the defun node doesn't have a name, or the node is nil, return -nil.") +name of a function. If the node is not a defun node, or the +defun node doesn't have a name, or the node is nil, return nil.") (defvar-local treesit-add-log-defun-delimiter "." "The delimiter used to connect several defun names. This is used in `treesit-add-log-current-defun'.") -(defsubst treesit--thing-unpack-pattern (pattern) - "Unpack PATTERN in the shape of `treesit-defun-type-regexp'. +(defun treesit-thing-definition (thing language) + "Return the predicate for THING if it's defined for LANGUAGE. +A thing is considered defined if it has an entry in +`treesit-thing-settings'. -Basically, +If LANGUAGE is nil, return the first definition for THING in +`treesit-thing-settings'." + (if language + (car (alist-get thing (alist-get language + treesit-thing-settings))) + (car (alist-get thing (mapcan (lambda (entry) + (copy-tree (cdr entry))) + treesit-thing-settings))))) - (unpack REGEXP) = (REGEXP . nil) - (unpack (REGEXP . PRED)) = (REGEXP . PRED)" - (if (consp pattern) - pattern - (cons pattern nil))) +(defalias 'treesit-thing-defined-p #'treesit-thing-definition + "Return non-nil if THING is defined.") -(defun treesit-beginning-of-thing (pattern &optional arg) +(defun treesit-beginning-of-thing (thing &optional arg tactic) "Like `beginning-of-defun', but generalized into things. -PATTERN is like `treesit-defun-type-regexp', ARG -is the same as in `beginning-of-defun'. +THING can be a thing defined in `treesit-thing-settings', which see, +or a predicate. ARG is the same as in `beginning-of-defun'. + +TACTIC determines how does this function move between things. It +can be `nested', `top-level', `restricted', or nil. `nested' +means normal nested navigation: try to move to siblings first, +and if there aren't enough siblings, move to the parent and its +siblings. `top-level' means only consider top-level things, and +nested things are ignored. `restricted' means movement is +restricted inside the thing that encloses POS (i.e., parent), +should there be one. If omitted, TACTIC is considered to be +`nested'. Return non-nil if successfully moved, nil otherwise." (pcase-let* ((arg (or arg 1)) - (`(,regexp . ,pred) (treesit--thing-unpack-pattern - pattern)) (dest (treesit--navigate-thing - (point) (- arg) 'beg regexp pred))) + (point) (- arg) 'beg thing tactic))) (when dest (goto-char dest)))) -(defun treesit-end-of-thing (pattern &optional arg) +(defun treesit-end-of-thing (thing &optional arg tactic) "Like `end-of-defun', but generalized into things. -PATTERN is like `treesit-defun-type-regexp', ARG is the same as -in `end-of-defun'. +THING can be a thing defined in `treesit-thing-settings', which +see, or a predicate. ARG is the same as in `end-of-defun'. + +TACTIC determines how does this function move between things. It +can be `nested', `top-level', `restricted', or nil. `nested' +means normal nested navigation: try to move to siblings first, +and if there aren't enough siblings, move to the parent and its +siblings. `top-level' means only consider top-level things, and +nested things are ignored. `restricted' means movement is +restricted inside the thing that encloses POS (i.e., parent), +should there be one. If omitted, TACTIC is considered to be +`nested'. Return non-nil if successfully moved, nil otherwise." (pcase-let* ((arg (or arg 1)) - (`(,regexp . ,pred) (treesit--thing-unpack-pattern - pattern)) (dest (treesit--navigate-thing - (point) arg 'end regexp pred))) + (point) arg 'end thing tactic))) (when dest (goto-char dest)))) @@ -1959,18 +2333,21 @@ If search is successful, return t, otherwise return nil. This is a tree-sitter equivalent of `beginning-of-defun'. Behavior of this function depends on `treesit-defun-type-regexp' -and `treesit-defun-skipper'." +and `treesit-defun-skipper'. If `treesit-defun-type-regexp' is +not set, Emacs also looks for definition of defun in +`treesit-thing-settings'." (interactive "^p") (or (not (eq this-command 'treesit-beginning-of-defun)) (eq last-command 'treesit-beginning-of-defun) (and transient-mark-mode mark-active) (push-mark)) (let ((orig-point (point)) - (success nil)) + (success nil) + (pred (or treesit-defun-type-regexp 'defun))) (catch 'done (dotimes (_ 2) - (when (treesit-beginning-of-thing treesit-defun-type-regexp arg) + (when (treesit-beginning-of-thing pred arg treesit-defun-tactic) (when treesit-defun-skipper (funcall treesit-defun-skipper) (setq success t))) @@ -1991,9 +2368,12 @@ Negative argument -N means move back to Nth preceding end of defun. This is a tree-sitter equivalent of `end-of-defun'. Behavior of this function depends on `treesit-defun-type-regexp' and -`treesit-defun-skipper'." +`treesit-defun-skipper'. If `treesit-defun-type-regexp' is not +set, Emacs also looks for definition of defun in +`treesit-thing-settings'." (interactive "^p\nd") - (let ((orig-point (point))) + (let ((orig-point (point)) + (pred (or treesit-defun-type-regexp 'defun))) (if (or (null arg) (= arg 0)) (setq arg 1)) (or (not (eq this-command 'treesit-end-of-defun)) (eq last-command 'treesit-end-of-defun) @@ -2002,7 +2382,7 @@ this function depends on `treesit-defun-type-regexp' and (catch 'done (dotimes (_ 2) ; Not making progress is better than infloop. - (when (treesit-end-of-thing treesit-defun-type-regexp arg) + (when (treesit-end-of-thing pred arg treesit-defun-tactic) (when treesit-defun-skipper (funcall treesit-defun-skipper))) @@ -2014,6 +2394,46 @@ this function depends on `treesit-defun-type-regexp' and (throw 'done nil) (setq arg (if (> arg 0) (1+ arg) (1- arg)))))))) +(make-obsolete 'treesit-text-type-regexp + "`treesit-text-type-regexp' will be removed soon, use `treesit-thing-settings' instead." "30.1") + +(defvar-local treesit-text-type-regexp "\\`comment\\'" + "A regexp that matches the node type of textual nodes. + +A textual node is a node that is not normal code, such as +comments and multiline string literals. For example, +\"(line|block)_comment\" in the case of a comment, or +\"text_block\" in the case of a string. This is used by +`prog-fill-reindent-defun' and friends.") + +(make-obsolete 'treesit-sentence-type-regexp + "`treesit-sentence-type-regexp' will be removed soon, use `treesit-thing-settings' instead." "30.1") + +(defvar-local treesit-sentence-type-regexp nil + "A regexp that matches the node type of sentence nodes. + +A sentence node is a node that is bigger than a sexp, and +delimits larger statements in the source code. It is, however, +smaller in scope than defuns. This is used by +`treesit-forward-sentence' and friends.") + +(defun treesit-forward-sentence (&optional arg) + "Tree-sitter `forward-sentence-function' implementation. + +ARG is the same as in `forward-sentence'. + +If point is inside a text environment, go forward a prose +sentence using `forward-sentence-default-function'. If point is +inside code, go forward a source code sentence. + +What constitutes as text and source code sentence is determined +by `text' and `sentence' in `treesit-thing-settings'." + (if (treesit-node-match-p (treesit-node-at (point)) 'text t) + (funcall #'forward-sentence-default-function arg) + (funcall + (if (> arg 0) #'treesit-end-of-thing #'treesit-beginning-of-thing) + 'sentence (abs arg)))) + (defun treesit-default-defun-skipper () "Skips spaces after navigating a defun. This function tries to move to the beginning of a line, either by @@ -2031,18 +2451,9 @@ the current line if the beginning of the defun is indented." (line-beginning-position)) (beginning-of-line)))) -;; prev-sibling: -;; 1. end-of-node before pos -;; 2. highest such node -;; -;; next-sibling: -;; 1. beg-of-node after pos -;; 2. highest such node -;; -;; parent: -;; 1. node covers pos -;; 2. smallest such node -(defun treesit--things-around (pos regexp &optional pred) +(make-obsolete 'treesit--things-around + "`treesit--things-around' will be removed soon, use `treesit--thing-prev', `treesit--thing-next', `treesit--thing-at' instead." "30.1") +(defun treesit--things-around (pos thing) "Return the previous, next, and parent thing around POS. Return a list of (PREV NEXT PARENT), where PREV and NEXT are @@ -2050,7 +2461,8 @@ previous and next sibling things around POS, and PARENT is the parent thing surrounding POS. All of three could be nil if no sound things exists. -REGEXP and PRED are the same as in `treesit-thing-at-point'." +THING should be a thing defined in `treesit-thing-settings', +which see; it can also be a predicate." (let* ((node (treesit-node-at pos)) (result (list nil nil nil))) ;; 1. Find previous and next sibling defuns. @@ -2073,9 +2485,7 @@ REGEXP and PRED are the same as in `treesit-thing-at-point'." when node do (let ((cursor node) (iter-pred (lambda (node) - (and (string-match-p - regexp (treesit-node-type node)) - (or (null pred) (funcall pred node)) + (and (treesit-node-match-p node thing t) (funcall pos-pred node))))) ;; Find the node just before/after POS to start searching. (save-excursion @@ -2089,13 +2499,11 @@ REGEXP and PRED are the same as in `treesit-thing-at-point'." (setf (nth idx result) (treesit-node-top-level cursor iter-pred t)) (setq cursor (treesit-search-forward - cursor regexp backward backward))))) + cursor thing backward backward))))) ;; 2. Find the parent defun. (let ((cursor (or (nth 0 result) (nth 1 result) node)) (iter-pred (lambda (node) - (and (string-match-p - regexp (treesit-node-type node)) - (or (null pred) (funcall pred node)) + (and (treesit-node-match-p node thing t) (not (treesit-node-eq node (nth 0 result))) (not (treesit-node-eq node (nth 1 result))) (< (treesit-node-start node) @@ -2105,14 +2513,76 @@ REGEXP and PRED are the same as in `treesit-thing-at-point'." (treesit-parent-until cursor iter-pred))) result)) -(defun treesit--top-level-thing (node regexp &optional pred) - "Return the top-level parent thing of NODE. -REGEXP and PRED are the same as in `treesit-thing-at-point'." - (treesit-node-top-level - node (lambda (node) - (and (string-match-p regexp (treesit-node-type node)) - (or (null pred) (funcall pred node)))) - t)) +(defun treesit--thing-sibling (pos thing prev) + "Return the next or previous THING at POS. + +If PREV is non-nil, return the previous THING. It's guaranteed +that returned previous sibling's end <= POS, and returned next +sibling's beginning >= POS. + +Return nil if no THING can be found. THING should be a thing +defined in `treesit-thing-settings', or a predicate as described +in `treesit-thing-settings'." + (let* ((cursor (treesit-node-at pos)) + (pos-pred (if prev + (lambda (n) (<= (treesit-node-end n) pos)) + (lambda (n) (>= (treesit-node-start n) pos)))) + (iter-pred (lambda (node) + (and (treesit-node-match-p node thing t) + (funcall pos-pred node)))) + (sibling nil)) + (when cursor + ;; Find the node just before/after POS to start searching. + (save-excursion + (while (and cursor (not (funcall pos-pred cursor))) + (setq cursor (treesit-search-forward-goto + cursor "" prev prev t)))) + ;; Keep searching until we run out of candidates or found a + ;; return value. + (while (and cursor + (funcall pos-pred cursor) + (null sibling)) + (setq sibling (treesit-node-top-level cursor iter-pred t)) + (setq cursor (treesit-search-forward cursor thing prev prev))) + sibling))) + +(defun treesit--thing-prev (pos thing) + "Return the previous THING at POS. + +The returned node, if non-nil, must be before POS, i.e., its end +<= POS. + +THING should be a thing defined in `treesit-thing-settings', or a +predicate as described in `treesit-thing-settings'." + (treesit--thing-sibling pos thing t)) + +(defun treesit--thing-next (pos thing) + "Return the next THING at POS. + +The returned node, if non-nil, must be after POS, i.e., its +start >= POS. + +THING should be a thing defined in `treesit-thing-settings', or a +predicate as described in `treesit-thing-settings'." + (treesit--thing-sibling pos thing nil)) + +(defun treesit--thing-at (pos thing &optional strict) + "Return the smallest THING enclosing POS. + +The returned node, if non-nil, must enclose POS, i.e., its start +<= POS, its end > POS. If STRICT is non-nil, the returned node's +start must < POS rather than <= POS. + +THING should be a thing defined in `treesit-thing-settings', or +it can be a predicate described in `treesit-thing-settings'." + (let* ((cursor (treesit-node-at pos)) + (iter-pred (lambda (node) + (and (treesit-node-match-p node thing t) + (if strict + (< (treesit-node-start node) pos) + (<= (treesit-node-start node) pos)) + (< pos (treesit-node-end node)))))) + (treesit-parent-until cursor iter-pred t))) ;; The basic idea for nested defun navigation is that we first try to ;; move across sibling defuns in the same level, if no more siblings @@ -2141,7 +2611,7 @@ REGEXP and PRED are the same as in `treesit-thing-at-point'." ;; -> Obviously we don't want to go to parent's end, instead, we ;; want to go to parent's prev-sibling's end. Again, we recurse ;; in the function to do that. -(defun treesit--navigate-thing (pos arg side regexp &optional pred recursing) +(defun treesit--navigate-thing (pos arg side thing &optional tactic recursing) "Navigate thing ARG steps from POS. If ARG is positive, move forward that many steps, if negative, @@ -2152,7 +2622,18 @@ This function doesn't actually move point, it just returns the position it would move to. If there aren't enough things to move across, return nil. -REGEXP and PRED are the same as in `treesit-thing-at-point'. +THING can be a regexp, a predicate function, and more. See +`treesit-thing-settings' for details. + +TACTIC determines how does this function move between things. It +can be `nested', `top-level', `restricted', or nil. `nested' +means normal nested navigation: try to move to siblings first, +and if there aren't enough siblings, move to the parent and its +siblings. `top-level' means only consider top-level things, and +nested things are ignored. `restricted' means movement is +restricted inside the thing that encloses POS (i.e., parent), +should there be one. If omitted, TACTIC is considered to be +`nested'. RECURSING is an internal parameter, if non-nil, it means this function is called recursively." @@ -2169,101 +2650,108 @@ function is called recursively." dest))))) (catch 'term (while (> counter 0) - (pcase-let - ((`(,prev ,next ,parent) - (treesit--things-around pos regexp pred))) + (let ((prev (treesit--thing-prev pos thing)) + (next (treesit--thing-next pos thing)) + (parent (treesit--thing-at pos thing t))) + (when (and parent prev + (not (treesit-node-enclosed-p prev parent))) + (setq prev nil)) + (when (and parent next + (not (treesit-node-enclosed-p next parent))) + (setq next nil)) ;; When PARENT is nil, nested and top-level are the same, if ;; there is a PARENT, make PARENT to be the top-level parent ;; and pretend there is no nested PREV and NEXT. - (when (and (eq treesit-defun-tactic 'top-level) + (when (and (eq tactic 'top-level) parent) - (setq parent (treesit--top-level-thing - parent regexp pred) + (setq parent (treesit-node-top-level parent thing t) prev nil next nil)) - ;; Move... - (if (> arg 0) - ;; ...forward. - (if (and (eq side 'beg) - ;; Should we skip the defun (recurse)? - (cond (next (and (not recursing) ; [1] (see below) - (eq pos (funcall advance next)))) - (parent t))) ; [2] - ;; Special case: go to next beg-of-defun, but point - ;; is already on beg-of-defun. Set POS to the end - ;; of next-sib/parent defun, and run one more step. - ;; If there is a next-sib defun, we only need to - ;; recurse once, so we don't need to recurse if we - ;; are already recursing [1]. If there is no - ;; next-sib but a parent, keep stepping out - ;; (recursing) until we got out of the parents until - ;; (1) there is a next sibling defun, or (2) no more - ;; parents [2]. - ;; - ;; If point on beg-of-defun but we are already - ;; recurring, that doesn't count as special case, - ;; because we have already made progress (by moving - ;; the end of next before recurring.) + ;; If TACTIC is `restricted', the implementation is simple. + ;; In principle we don't go to parent's beg/end for + ;; `restricted' tactic, but if the parent is a "leaf thing" + ;; (doesn't have any child "thing" inside it), then we can + ;; move to the beg/end of it (bug#68899). + (if (eq tactic 'restricted) + (setq pos (funcall + advance + (cond ((and (null next) (null prev)) parent) + ((> arg 0) next) + (t prev)))) + ;; For `nested', it's a bit more work: + ;; Move... + (if (> arg 0) + ;; ...forward. + (if (and (eq side 'beg) + ;; Should we skip the defun (recurse)? + (cond (next (and (not recursing) ; [1] (see below) + (eq pos (funcall advance next)))) + (parent t))) ; [2] + ;; Special case: go to next beg-of-defun, but point + ;; is already on beg-of-defun. Set POS to the end + ;; of next-sib/parent defun, and run one more step. + ;; If there is a next-sib defun, we only need to + ;; recurse once, so we don't need to recurse if we + ;; are already recursing [1]. If there is no + ;; next-sib but a parent, keep stepping out + ;; (recursing) until we got out of the parents until + ;; (1) there is a next sibling defun, or (2) no more + ;; parents [2]. + ;; + ;; If point on beg-of-defun but we are already + ;; recurring, that doesn't count as special case, + ;; because we have already made progress (by moving + ;; the end of next before recurring.) + (setq pos (or (treesit--navigate-thing + (treesit-node-end (or next parent)) + 1 'beg thing tactic t) + (throw 'term nil))) + ;; Normal case. + (setq pos (funcall advance (or next parent)))) + ;; ...backward. + (if (and (eq side 'end) + (cond (prev (and (not recursing) + (eq pos (funcall advance prev)))) + (parent t))) + ;; Special case: go to prev end-of-defun. (setq pos (or (treesit--navigate-thing - (treesit-node-end (or next parent)) - 1 'beg regexp pred t) + (treesit-node-start (or prev parent)) + -1 'end thing tactic t) (throw 'term nil))) ;; Normal case. - (setq pos (funcall advance (or next parent)))) - ;; ...backward. - (if (and (eq side 'end) - (cond (prev (and (not recursing) - (eq pos (funcall advance prev)))) - (parent t))) - ;; Special case: go to prev end-of-defun. - (setq pos (or (treesit--navigate-thing - (treesit-node-start (or prev parent)) - -1 'end regexp pred t) - (throw 'term nil))) - ;; Normal case. - (setq pos (funcall advance (or prev parent))))) + (setq pos (funcall advance (or prev parent)))))) ;; A successful step! Decrement counter. (cl-decf counter)))) ;; Counter equal to 0 means we successfully stepped ARG steps. (if (eq counter 0) pos nil))) ;; TODO: In corporate into thing-at-point. -(defun treesit-thing-at-point (pattern tactic) - "Return the thing node at point or nil if none is found. - -\"Thing\" is defined by PATTERN, which can be either a string -REGEXP or a cons cell (REGEXP . PRED): if a node's type matches -REGEXP, it is a thing. The \"thing\" could be further restricted -by PRED: if non-nil, PRED should be a function that takes a node -and returns t if the node is a \"thing\", and nil if not. - -Return the top-level defun if TACTIC is `top-level', return the -immediate parent thing if TACTIC is `nested'." - (pcase-let* ((`(,regexp . ,pred) - (treesit--thing-unpack-pattern pattern)) - (`(,_ ,next ,parent) - (treesit--things-around (point) regexp pred)) - ;; If point is at the beginning of a thing, we - ;; prioritize that thing over the parent in nested - ;; mode. - (node (or (and (eq (treesit-node-start next) (point)) - next) - parent))) +(defun treesit-thing-at-point (thing tactic) + "Return the THING at point, or nil if none is found. + +THING can be a symbol, a regexp, a predicate function, and more; +see `treesit-thing-settings' for details. + +Return the top-level THING if TACTIC is `top-level'; return the +smallest enclosing THING as POS if TACTIC is `nested'." + + (let ((node (treesit--thing-at (point) thing))) (if (eq tactic 'top-level) - (treesit--top-level-thing node regexp pred) + (treesit-node-top-level node thing t) node))) (defun treesit-defun-at-point () - "Return the defun node at point or nil if none is found. + "Return the defun node at point, or nil if none is found. -Respects `treesit-defun-tactic': return the top-level defun if it -is `top-level', return the immediate parent defun if it is -`nested'. +Respects `treesit-defun-tactic': returns the top-level defun if it +is `top-level', otherwise return the immediate parent defun if it +is `nested'. -Return nil if `treesit-defun-type-regexp' is not set." - (when treesit-defun-type-regexp +Return nil if `treesit-defun-type-regexp' isn't set and `defun' +isn't defined in `treesit-thing-settings'." + (when (or treesit-defun-type-regexp (treesit-thing-defined-p 'defun)) (treesit-thing-at-point - treesit-defun-type-regexp treesit-defun-tactic))) + (or treesit-defun-type-regexp 'defun) treesit-defun-tactic))) (defun treesit-defun-name (node) "Return the defun name of NODE. @@ -2379,6 +2867,71 @@ ENTRY. MARKER marks the start of each tree-sitter node." index)))) treesit-simple-imenu-settings))) +;;; Outline minor mode + +(defvar-local treesit-outline-predicate nil + "Predicate used to find outline headings in the syntax tree. +The predicate can be a function, a regexp matching node type, +and more; see docstring of `treesit-thing-settings'. +It matches the nodes located on lines with outline headings. +Intended to be set by a major mode. When nil, the predicate +is constructed from the value of `treesit-simple-imenu-settings' +when a major mode sets it.") + +(defun treesit-outline-predicate--from-imenu (node) + ;; Return an outline searching predicate created from Imenu. + ;; Return the value suitable to set `treesit-outline-predicate'. + ;; Create this predicate from the value `treesit-simple-imenu-settings' + ;; that major modes set to find Imenu entries. The assumption here + ;; is that the positions of Imenu entries most of the time coincide + ;; with the lines of outline headings. When this assumption fails, + ;; you can directly set a proper value to `treesit-outline-predicate'. + (seq-some + (lambda (setting) + (and (string-match-p (nth 1 setting) (treesit-node-type node)) + (or (null (nth 2 setting)) + (funcall (nth 2 setting) node)))) + treesit-simple-imenu-settings)) + +(defun treesit-outline-search (&optional bound move backward looking-at) + "Search for the next outline heading in the syntax tree. +See the descriptions of arguments in `outline-search-function'." + (if looking-at + (when-let* ((node (or (treesit--thing-at (pos-eol) treesit-outline-predicate) + (treesit--thing-at (pos-bol) treesit-outline-predicate))) + (start (treesit-node-start node))) + (eq (pos-bol) (save-excursion (goto-char start) (pos-bol)))) + + (let* ((pos + ;; When function wants to find the current outline, point + ;; is at the beginning of the current line. When it wants + ;; to find the next outline, point is at the second column. + (if (eq (point) (pos-bol)) + (if (bobp) (point) (1- (point))) + (pos-eol))) + (found (treesit--navigate-thing pos (if backward -1 1) 'beg + treesit-outline-predicate))) + (if found + (if (or (not bound) (if backward (>= found bound) (<= found bound))) + (progn + (goto-char found) + (goto-char (pos-bol)) + (set-match-data (list (point) (pos-eol))) + t) + (when move (goto-char bound)) + nil) + (when move (goto-char (or bound (if backward (point-min) (point-max))))) + nil)))) + +(defun treesit-outline-level () + "Return the depth of the current outline heading." + (let* ((node (treesit-node-at (point) nil t)) + (level (if (treesit-node-match-p node treesit-outline-predicate) + 1 0))) + (while (setq node (treesit-parent-until node treesit-outline-predicate)) + (setq level (1+ level))) + (if (zerop level) 1 level))) + ;;; Activating tree-sitter (defun treesit-ready-p (language &optional quiet) @@ -2436,14 +2989,18 @@ and enable `font-lock-mode'. If `treesit-simple-indent-rules' is non-nil, set up indentation. -If `treesit-defun-type-regexp' is non-nil, set up -`beginning-of-defun-function' and `end-of-defun-function'. +If `treesit-defun-type-regexp' is non-nil or `defun' is defined +in `treesit-thing-settings', set up `beginning-of-defun-function' +and `end-of-defun-function'. If `treesit-defun-name-function' is non-nil, set up `add-log-current-defun'. If `treesit-simple-imenu-settings' is non-nil, set up Imenu. +If `sexp', `sentence' are defined in `treesit-thing-settings', +enable tree-sitter navigation commands for them. + Make sure necessary parsers are created for the current buffer before calling this function." ;; Font-lock. @@ -2473,7 +3030,8 @@ before calling this function." (setq-local indent-line-function #'treesit-indent) (setq-local indent-region-function #'treesit-indent-region)) ;; Navigation. - (when treesit-defun-type-regexp + (when (or treesit-defun-type-regexp + (treesit-thing-defined-p 'defun nil)) (keymap-set (current-local-map) "<remap> <beginning-of-defun>" #'treesit-beginning-of-defun) (keymap-set (current-local-map) "<remap> <end-of-defun>" @@ -2491,10 +3049,35 @@ before calling this function." (when treesit-defun-name-function (setq-local add-log-current-defun-function #'treesit-add-log-current-defun)) + + (when (treesit-thing-defined-p 'sexp nil) + (setq-local forward-sexp-function #'treesit-forward-sexp) + (setq-local transpose-sexps-function #'treesit-transpose-sexps)) + + (when (treesit-thing-defined-p 'sentence nil) + (setq-local forward-sentence-function #'treesit-forward-sentence)) + ;; Imenu. (when treesit-simple-imenu-settings (setq-local imenu-create-index-function - #'treesit-simple-imenu))) + #'treesit-simple-imenu)) + + ;; Outline minor mode. + (when (and (or treesit-outline-predicate treesit-simple-imenu-settings) + (not (seq-some #'local-variable-p + '(outline-search-function + outline-regexp outline-level)))) + (unless treesit-outline-predicate + (setq treesit-outline-predicate + #'treesit-outline-predicate--from-imenu)) + (setq-local outline-search-function #'treesit-outline-search + outline-level #'treesit-outline-level)) + + ;; Remove existing local parsers. + (dolist (ov (overlays-in (point-min) (point-max))) + (when-let ((parser (overlay-get ov 'treesit-parser))) + (treesit-parser-delete parser) + (delete-overlay ov)))) ;;; Debugging @@ -2740,7 +3323,6 @@ in the region." (defun treesit--explorer-jump (button) "Mark the original text corresponding to BUTTON." - (interactive) (when (and (derived-mode-p 'treesit--explorer-tree-mode) (buffer-live-p treesit--explorer-source-buffer)) (with-current-buffer treesit--explorer-source-buffer @@ -2891,10 +3473,12 @@ the text in the active region is highlighted in the explorer window." :lighter " TSexplore" (if treesit-explore-mode - (let ((language (intern (completing-read - "Language: " - (mapcar #'treesit-parser-language - (treesit-parser-list)))))) + (let ((language + (intern (completing-read + "Language: " + (cl-remove-duplicates + (mapcar #'treesit-parser-language + (treesit-parser-list nil nil t))))))) (if (not (treesit-language-available-p language)) (user-error "Cannot find tree-sitter grammar for %s: %s" language (cdr (treesit-language-available-p @@ -2940,7 +3524,8 @@ The value should be an alist where each element has the form (LANG . (URL REVISION SOURCE-DIR CC C++)) Only LANG and URL are mandatory. LANG is the language symbol. -URL is the Git repository URL for the grammar. +URL is the URL of the grammar's Git repository or a directory +where the repository has been cloned. REVISION is the Git tag or branch of the desired version, defaulting to the latest default branch. @@ -2986,8 +3571,11 @@ See `treesit-language-source-alist' for details." (buffer-local-value 'url-http-response-status buffer) 200))))) +(defvar treesit--install-language-grammar-out-dir-history nil + "History for OUT-DIR for `treesit-install-language-grammar'.") + ;;;###autoload -(defun treesit-install-language-grammar (lang) +(defun treesit-install-language-grammar (lang &optional out-dir) "Build and install the tree-sitter language grammar library for LANG. Interactively, if `treesit-language-source-alist' doesn't already @@ -3001,20 +3589,41 @@ and the linker to be installed and on PATH. It also requires that the recipe for LANG exists in `treesit-language-source-alist'. See `exec-path' for the current path where Emacs looks for -executable programs, such as the C/C++ compiler and linker." +executable programs, such as the C/C++ compiler and linker. + +Interactively, prompt for the directory in which to install the +compiled grammar files. Non-interactively, use OUT-DIR; if it's +nil, the grammar is installed to the standard location, the +\"tree-sitter\" directory under `user-emacs-directory'." (interactive (list (intern (completing-read "Language: " - (mapcar #'car treesit-language-source-alist))))) + (mapcar #'car treesit-language-source-alist))) + 'interactive)) (when-let ((recipe (or (assoc lang treesit-language-source-alist) - (treesit--install-language-grammar-build-recipe - lang)))) + (if (eq out-dir 'interactive) + (treesit--install-language-grammar-build-recipe + lang) + (signal 'treesit-error `("Cannot find recipe for this language" ,lang))))) + (default-out-dir + (or (car treesit--install-language-grammar-out-dir-history) + (locate-user-emacs-file "tree-sitter"))) + (out-dir + (if (eq out-dir 'interactive) + (read-string + (format "Install to (default: %s): " + default-out-dir) + nil + 'treesit--install-language-grammar-out-dir-history + default-out-dir) + ;; When called non-interactively, OUT-DIR should + ;; default to DEFAULT-OUT-DIR. + (or out-dir default-out-dir)))) (condition-case err (progn (apply #'treesit--install-language-grammar-1 - ;; The nil is OUT-DIR. - (cons nil recipe)) + (cons out-dir recipe)) ;; Check that the installed language grammar is loadable. (pcase-let ((`(,available . ,err) @@ -3050,6 +3659,26 @@ content as signal data, and erase buffer afterwards." (buffer-string))) (erase-buffer))) +(defun treesit--git-checkout-branch (repo-dir revision) + "Checkout REVISION in a repo located in REPO-DIR." + (treesit--call-process-signal + "git" nil t nil "-C" repo-dir "checkout" revision)) + +(defun treesit--git-clone-repo (url revision workdir) + "Clone repo pointed by URL at commit REVISION to WORKDIR. + +REVISION may be nil, in which case the cloned repo will be at its +default branch." + (message "Cloning repository") + ;; git clone xxx --depth 1 --quiet [-b yyy] workdir + (if revision + (treesit--call-process-signal + "git" nil t nil "clone" url "--depth" "1" "--quiet" + "-b" revision workdir) + (treesit--call-process-signal + "git" nil t nil "clone" url "--depth" "1" "--quiet" + workdir))) + (defun treesit--install-language-grammar-1 (out-dir lang url &optional revision source-dir cc c++) "Install and compile a tree-sitter language grammar library. @@ -3063,8 +3692,12 @@ For LANG, URL, REVISION, SOURCE-DIR, GRAMMAR-DIR, CC, C++, see `treesit-language-source-alist'. If anything goes wrong, this function signals an error." (let* ((lang (symbol-name lang)) + (maybe-repo-dir (expand-file-name url)) + (url-is-dir (file-accessible-directory-p maybe-repo-dir)) (default-directory (make-temp-file "treesit-workdir" t)) - (workdir (expand-file-name "repo")) + (workdir (if url-is-dir + maybe-repo-dir + (expand-file-name "repo"))) (source-dir (expand-file-name (or source-dir "src") workdir)) (cc (or cc (seq-find #'executable-find '("cc" "gcc" "c99")) ;; If no C compiler found, just use cc and let @@ -3079,15 +3712,10 @@ function signals an error." (lib-name (concat "libtree-sitter-" lang soext))) (unwind-protect (with-temp-buffer - (message "Cloning repository") - ;; git clone xxx --depth 1 --quiet [-b yyy] workdir - (if revision - (treesit--call-process-signal - "git" nil t nil "clone" url "--depth" "1" "--quiet" - "-b" revision workdir) - (treesit--call-process-signal - "git" nil t nil "clone" url "--depth" "1" "--quiet" - workdir)) + (if url-is-dir + (when revision + (treesit--git-checkout-branch workdir revision)) + (treesit--git-clone-repo url revision workdir)) ;; We need to go into the source directory because some ;; header files use relative path (#include "../xxx"). ;; cd "${sourcedir}" @@ -3108,11 +3736,17 @@ function signals an error." (apply #'treesit--call-process-signal (if (file-exists-p "scanner.cc") c++ cc) nil t nil - `("-fPIC" "-shared" - ,@(directory-files - default-directory nil - (rx bos (+ anychar) ".o" eos)) - "-o" ,lib-name)) + (if (eq system-type 'cygwin) + `("-shared" "-Wl,-dynamicbase" + ,@(directory-files + default-directory nil + (rx bos (+ anychar) ".o" eos)) + "-o" ,lib-name) + `("-fPIC" "-shared" + ,@(directory-files + default-directory nil + (rx bos (+ anychar) ".o" eos)) + "-o" ,lib-name))) ;; Copy out. (unless (file-exists-p out-dir) (make-directory out-dir t)) @@ -3128,7 +3762,9 @@ function signals an error." ;; Ignore errors, in case the old version is still used. (ignore-errors (delete-file old-fname))) (message "Library installed to %s/%s" out-dir lib-name)) - (when (file-exists-p workdir) + ;; Remove workdir if it's not a repo owned by user and we + ;; managed to create it in the first place. + (when (and (not url-is-dir) (file-exists-p workdir)) (delete-directory workdir t))))) ;;; Etc @@ -3142,7 +3778,7 @@ function signals an error." (with-temp-buffer (insert-file-contents (find-library-name "treesit")) (cl-remove-if - (lambda (name) (string-match "treesit--" name)) + (lambda (name) (string-search "treesit--" name)) (cl-sort (save-excursion (goto-char (point-min)) @@ -3191,7 +3827,6 @@ function signals an error." (define-short-documentation-group treesit - "Parsers" (treesit-parser-create :no-eval (treesit-parser-create 'c) @@ -3241,6 +3876,9 @@ function signals an error." "Retrieving a node from another node" + (treesit-node-get + :no-eval (treesit-node-get node '((parent 1) (sibling 1) (text))) + :eg-result-string "#<treesit-node (declaration) in 1-11>") (treesit-node-parent :no-eval (treesit-node-parent node) :eg-result-string "#<treesit-node (declaration) in 1-11>") @@ -3334,7 +3972,9 @@ function signals an error." (treesit-node-check :no-eval (treesit-node-check node 'named) :eg-result t) - + (treesit-node-enclosed-p + :no-eval (treesit-node-enclosed-p node1 node2) + :no-eval (treesit-node-enclosed-p node1 '(12 . 18))) (treesit-node-field-name-for-child :no-eval (treesit-node-field-name-for-child node) |