[emacs] bugfix for treesitter landed in my repos, no need for the hack

1 files changed, 0 insertions, 342 deletions

diff --git a/emacs/scripts/treesit-predicate-rewrite.el b/emacs/scripts/treesit-predicate-rewrite.el
deleted file mode 100644
index 0840f62..0000000
--- a/emacs/scripts/treesit-predicate-rewrite.el
+++ /dev/null
@@ -1,342 +0,0 @@
-;;; treesit-predicate-rewrite.el --- -*- lexical-binding: t -*-
-;;
-;; Description: Generic workaround for Emacs bug#79687 -- strip
-;;  tree-sitter query predicates at `treesit-font-lock-rules' call
-;;  time, replacing them with capture-name-is-a-function fontifiers.
-;; Author: Michael Olson
-;;
-;; The contents of this file may be used, distributed, and modified
-;; without restriction.
-
-;;; Commentary:
-
-;; Emacs 30.2 serialises `:match' / `:equal' / `:pred' s-expr
-;; predicates to `#match' / `#equal' / `#pred' (no trailing `?'), and
-;; libtree-sitter >=0.26 rejects those at query-parse time. The
-;; upstream fix (commit b0143530 on master) is slated for Emacs 31 and
-;; has not been backported to emacs-30 as of 30.2. On Arch we ship
-;; libtree-sitter.so.0.26, so every mode whose `treesit-font-lock-rules'
-;; uses `:match' fails the first time it hits tree-sitter. `#match?'
-;; doesn't work either: Emacs 30.2's own predicate dispatcher hard-codes
-;; bare `match'/`equal'/`pred' and rejects `match?'/`equal?'/`pred?' at
-;; eval time, so no string-level rewrite can satisfy both sides.
-;;
-;; Instead, intercept `treesit-font-lock-rules' via `:filter-args'
-;; advice and rewrite its argument plist, replacing predicate-gated
-;; patterns with capture-name-is-a-function fontifiers. The resulting
-;; query contains NO predicates, so libtree-sitter is happy; the
-;; fontifier applies the face only when the node satisfies the
-;; original predicate, so the semantics are preserved.
-;;
-;; `treesit-range-rules' (used by e.g. js.el for JSDoc parser embed)
-;; gets the same advice, but range captures are scratch names rather
-;; than faces, so predicates there always strip cleanly (Case C). The
-;; downside is slight over-matching (e.g. JSDoc embed attaches to all
-;; comments, not just `/**' ones); benign in practice.
-;;
-;; Handled cases (in order of detection):
-;;
-;;   A. ((NODE) @FACE (:match REGEX @FACE))
-;;      -> ((NODE) @my-ts-rw--fn-FACE-HASH), and the fontifier applies
-;;      FACE when the node text matches REGEX. Also handles nested
-;;      captures like ((X Y: (Z) @FACE) (:match ... @FACE)).
-;;
-;;   B. (((NODE) @scratch (:match REGEX @scratch)) @FACE)
-;;      Outer-group-wraps-inner-scratch form (used by ruby-ts-mode
-;;      builtins). Semantically equivalent to Case A after flattening,
-;;      handled the same way.
-;;
-;;   C. Predicate where target capture is not the face capture, e.g.,
-;;      elixir-ts-mode's (call (identifier) @_fn (:match "assert" @_fn)
-;;      arguments: ...). Cannot be flattened into a single fontifier
-;;      safely; the predicate is silently stripped (set
-;;      `my-ts-rw-verbose' non-nil to log strips). This will
-;;      over-fontify, which is a minor visual regression. elixir-ts-mode
-;;      uses this pattern heavily and is best left alone -- callers
-;;      should avoid loading it with this advice active, OR accept
-;;      the over-fontification.
-;;
-;; :equal (@cap "literal") is handled for Case A/B; :pred is not
-;; (would require re-invoking the user's fn) and is treated as Case C.
-;;
-;; Removal plan: delete this whole file and its `load' in
-;; `shared-init.el' once we upgrade to an Emacs that carries the
-;; bug#79687 fix (Emacs 31+, or a backport landing in a future 30.x
-;; point release).
-
-;;; Code:
-
-(require 'cl-lib)
-(require 'seq)
-
-(defvar my-ts-rw--fontifiers (make-hash-table :test 'equal)
-  "Cache: (KIND FACE . DATA) -> interned fontifier symbol.
-KIND is `regex' or `equal'. DATA is the regex string or literal.
-Prevents symbol churn when the same rewrite is computed repeatedly
-across reloads.")
-
-(defvar my-ts-rw-verbose nil
-  "When non-nil, log each predicate rewrite or strip via `message'.
-Off by default so Case C over-fontification notes don't spam the
-echo area at mode-load time.")
-
-;;;; Entry points: :filter-args advice on query-building functions
-
-(define-advice treesit-font-lock-rules
-    (:filter-args (args) my-ts-rw-rewrite)
-  "Rewrite tree-sitter predicates into fontifier captures.
-Workaround for Emacs bug#79687 / libtree-sitter 0.26 strict predicates."
-  (condition-case err
-      (my-ts-rw--rewrite-args args)
-    (error
-     (message "treesit-predicate-rewrite: rewrite failed, passing through: %S" err)
-     args)))
-
-(define-advice treesit-range-rules
-    (:filter-args (args) my-ts-rw-rewrite)
-  "Strip tree-sitter predicates from range rules.
-Range-rule captures are scratch names, not faces, so predicates
-always fall into Case C (strip). The net effect for e.g. js.el's
-JSDoc-begin predicate is that the embedded parser attaches to all
-comments rather than just `/**' comments, which is harmless but
-may cost a little extra parser work on non-doc comments."
-  (condition-case err
-      (my-ts-rw--rewrite-args args)
-    (error
-     (message "treesit-predicate-rewrite: range-rules rewrite failed, passing through: %S" err)
-     args)))
-
-(define-advice treesit-query-compile
-    (:filter-args (args) my-ts-rw-rewrite)
-  "Strip/rewrite predicates from queries compiled directly.
-Catches call sites that bypass `treesit-font-lock-rules' and
-`treesit-range-rules' -- e.g. c-ts-mode's `c-ts-mode--emacs-c-range-query'
-defvar which calls `treesit-query-compile' with an s-expression
-containing `:match'. Predicates on face targets become fontifiers;
-others are stripped."
-  (condition-case err
-      (pcase args
-        (`(,lang ,query . ,rest)
-         (cons lang
-               (cons (if (listp query)
-                         (my-ts-rw--rewrite-query-list query)
-                       query)
-                     rest)))
-        (_ args))
-    (error
-     (message "treesit-predicate-rewrite: query-compile rewrite failed, passing through: %S" err)
-     args)))
-
-;;;; Arg-plist walker
-
-(defun my-ts-rw--rewrite-args (args)
-  "Walk ARGS (the plist-style argument list of `treesit-font-lock-rules').
-Rewrite every query-list value; leave :KEYWORD/VALUE pairs as-is."
-  (let ((result nil)
-        (tail args))
-    (while tail
-      (let ((item (car tail)))
-        (cond
-         ((keywordp item)
-          (push item result)
-          (push (cadr tail) result)
-          (setq tail (cddr tail)))
-         (t
-          (push (my-ts-rw--rewrite-query-list item) result)
-          (setq tail (cdr tail))))))
-    (nreverse result)))
-
-(defun my-ts-rw--rewrite-query-list (queries)
-  "Rewrite each top-level query in QUERIES.
-QUERIES is a list of queries, or an already-compiled query object /
-string; non-list inputs are returned unchanged."
-  (if (and (listp queries) (not (null queries)))
-      (mapcar #'my-ts-rw--walk queries)
-    queries))
-
-;;;; Per-query recursive walker
-
-(defun my-ts-rw--walk (form)
-  "Rewrite predicates within FORM recursively."
-  (cond
-   ((not (consp form)) form)
-   ;; Don't descend into a predicate form itself -- its children
-   ;; shouldn't be interpreted as predicate-containing queries.
-   ((my-ts-rw--predicate-p form) form)
-   (t
-    ;; Case B must be detected at this level BEFORE recursing into
-    ;; children; otherwise the bottom-up recursion would strip the
-    ;; inner predicate under Case C and we'd over-fontify.
-    (let ((b (my-ts-rw--try-case-b form)))
-      (if b
-          (my-ts-rw--walk b)
-        ;; Bottom-up: recurse children first, then handle Case A at
-        ;; this level so inner predicates are resolved before outer.
-        (let ((children (mapcar #'my-ts-rw--walk form)))
-          (my-ts-rw--rewrite-case-a children)))))))
-
-;;;; Case B: (((NODE) @scratch (:match REGEX @scratch)) @FACE)
-
-(defun my-ts-rw--try-case-b (form)
-  "If FORM matches Case B, return the pre-rewrite flattened form.
-Otherwise return nil. The returned form still has the inner
-predicate in place; Case A handling will lift it."
-  (when (and (consp form)
-             (= (length form) 2)
-             (consp (car form))
-             (my-ts-rw--face-symbol-p (cadr form)))
-    (let* ((group (car form))
-           (outer-face-sym (cadr form))
-           (predicates (seq-filter #'my-ts-rw--predicate-p group)))
-      (when (= (length predicates) 1)
-        (let* ((pred (car predicates))
-               (target (my-ts-rw--predicate-target pred)))
-          (when (and target
-                     (my-ts-rw--cap-symbol-p target)
-                     ;; Case B is only safe if the inner scratch capture
-                     ;; tags the same node the outer face wraps -- if
-                     ;; target appears as a direct capture marker inside
-                     ;; group (not nested inside a named-child pattern),
-                     ;; flattening is semantically sound.
-                     (my-ts-rw--cap-directly-on-root-of-p group target)
-                     ;; Avoid double-rewriting if target already is a face
-                     ;; (that's Case A in disguise, handled below).
-                     (not (my-ts-rw--face-symbol-p target)))
-            ;; Substitute the inner scratch capture with the outer
-            ;; face symbol and drop the outer wrapping. Case A will
-            ;; then recognise the predicate + face pairing.
-            (my-ts-rw--replace-capture-in-tree
-             group target outer-face-sym)))))))
-
-(defun my-ts-rw--cap-directly-on-root-of-p (group cap-sym)
-  "Non-nil if CAP-SYM appears as a top-level capture marker in GROUP.
-Specifically, CAP-SYM is a direct element of GROUP that follows the
-node pattern (i.e., `(NODE CAP-SYM ...)'). This is the signature of
-the inner scratch in Case B."
-  (and (consp group)
-       (memq cap-sym group)
-       t))
-
-;;;; Case A: ((...@FACE...) (:match REGEX @FACE))
-
-(defun my-ts-rw--rewrite-case-a (children)
-  "Process top-level predicates among CHILDREN.
-Returns the rewritten list with predicates stripped and capture
-symbols rewritten to fontifier symbols where applicable."
-  (if (not (cl-some #'my-ts-rw--predicate-p children))
-      children
-    (let ((result children))
-      (dolist (pred (seq-filter #'my-ts-rw--predicate-p children))
-        (let ((target (my-ts-rw--predicate-target pred)))
-          (cond
-           ((and target (my-ts-rw--face-symbol-p target))
-            (let* ((face (my-ts-rw--cap-to-face target))
-                   (fontifier (my-ts-rw--try-make-fontifier pred face)))
-              (if fontifier
-                  (setq result
-                        (my-ts-rw--replace-capture-in-tree
-                         result target (my-ts-rw--face-to-cap fontifier)))
-                (when my-ts-rw-verbose
-                  (message "treesit-predicate-rewrite: unsupported predicate %S (face target %s); stripping"
-                           (car pred) target)))))
-           (t
-            (when my-ts-rw-verbose
-              (message "treesit-predicate-rewrite: stripping non-face-target predicate %S"
-                       pred))))))
-      (seq-remove #'my-ts-rw--predicate-p result))))
-
-;;;; Fontifier factory
-
-(defun my-ts-rw--try-make-fontifier (predicate face)
-  "Build a fontifier applying FACE when PREDICATE is satisfied.
-Return the fontifier symbol, or nil if PREDICATE isn't supported."
-  (pcase predicate
-    (`(:match ,(and regex (pred stringp)) ,(pred my-ts-rw--cap-symbol-p))
-     (my-ts-rw--intern-fontifier
-      (list 'regex face regex)
-      (lambda (node override start end &rest _)
-        (when (string-match-p regex (treesit-node-text node t))
-          (treesit-fontify-with-override
-           (treesit-node-start node) (treesit-node-end node)
-           face override start end)))))
-    (`(:equal ,a ,b)
-     (let ((literal (cond ((and (stringp a) (my-ts-rw--cap-symbol-p b)) a)
-                          ((and (my-ts-rw--cap-symbol-p a) (stringp b)) b))))
-       (when literal
-         (my-ts-rw--intern-fontifier
-          (list 'equal face literal)
-          (lambda (node override start end &rest _)
-            (when (equal (treesit-node-text node t) literal)
-              (treesit-fontify-with-override
-               (treesit-node-start node) (treesit-node-end node)
-               face override start end)))))))
-    (_ nil)))
-
-(defun my-ts-rw--intern-fontifier (key fn)
-  "Return a fontifier symbol for KEY, defining it to FN on first sight.
-Subsequent calls with an `equal' KEY return the cached symbol and do
-not redefine it, so reloading this file does not leak symbols."
-  (or (gethash key my-ts-rw--fontifiers)
-      (let* ((face (cadr key))
-             (sym (intern (format "my-ts-rw--fn-%s-%08x"
-                                  face (abs (sxhash-equal key))))))
-        (defalias sym fn)
-        (puthash key sym my-ts-rw--fontifiers)
-        sym)))
-
-;;;; Predicate / capture helpers
-
-(defun my-ts-rw--predicate-p (form)
-  "Non-nil if FORM is a tree-sitter predicate form."
-  (and (consp form)
-       (memq (car form) '(:match :equal :pred))))
-
-(defun my-ts-rw--predicate-target (predicate)
-  "Return the capture symbol PREDICATE tests, or nil."
-  (pcase (car predicate)
-    (:match
-     (let ((tail (car (last predicate))))
-       (and (my-ts-rw--cap-symbol-p tail) tail)))
-    (:equal
-     (cl-loop for arg in (cdr predicate)
-              when (my-ts-rw--cap-symbol-p arg) return arg))
-    (:pred
-     (cl-loop for arg in (cddr predicate)
-              when (my-ts-rw--cap-symbol-p arg) return arg))))
-
-(defun my-ts-rw--cap-symbol-p (x)
-  "Non-nil if X is a tree-sitter capture symbol (starts with `@')."
-  (and (symbolp x)
-       (let ((name (symbol-name x)))
-         (and (> (length name) 1) (eq (aref name 0) ?@)))))
-
-(defun my-ts-rw--face-symbol-p (cap-sym)
-  "Non-nil if CAP-SYM names a font-lock face.
-Accepts any symbol starting with `@' whose trailing name is either
-a defined face or begins with `font-lock-'."
-  (and (my-ts-rw--cap-symbol-p cap-sym)
-       (let ((stripped (substring (symbol-name cap-sym) 1)))
-         (or (facep (intern-soft stripped))
-             (string-prefix-p "font-lock-" stripped)))))
-
-(defun my-ts-rw--cap-to-face (cap-sym)
-  "Return the face symbol underlying capture symbol CAP-SYM."
-  (intern (substring (symbol-name cap-sym) 1)))
-
-(defun my-ts-rw--face-to-cap (face-sym)
-  "Return the capture symbol (`@face-sym') for FACE-SYM."
-  (intern (format "@%s" face-sym)))
-
-;;;; Tree substitution
-
-(defun my-ts-rw--replace-capture-in-tree (tree from to)
-  "Recursively replace occurrences of FROM with TO in TREE."
-  (cond
-   ((eq tree from) to)
-   ((consp tree)
-    (cons (my-ts-rw--replace-capture-in-tree (car tree) from to)
-          (my-ts-rw--replace-capture-in-tree (cdr tree) from to)))
-   (t tree)))
-
-(provide 'treesit-predicate-rewrite)
-;;; treesit-predicate-rewrite.el ends here