[elpa] externals/indent-bars d5e6fb0fa9 384/431: Initial window-scroll based supplemental draw

[ELPA Syncer]

branch: externals/indent-bars
commit d5e6fb0fa91980b29365f438e0da34c3cdc152cf
Author: JD Smith <93749+jdtsmith@users.noreply.github.com>
Commit: JD Smith <93749+jdtsmith@users.noreply.github.com>

    Initial window-scroll based supplemental draw
---
 indent-bars-ts.el | 142 ++++++++++++++++++++++++++++++++++++++++++------------
 1 file changed, 112 insertions(+), 30 deletions(-)

diff --git a/indent-bars-ts.el b/indent-bars-ts.el
index 4ae1a0acd0..6d52d31e09 100644
--- a/indent-bars-ts.el
+++ b/indent-bars-ts.el
@@ -323,6 +323,27 @@ recently clipped node ranges in scope."
                                         (ibts/start-bars ibtcs)
                                         (car indent-bars-ts-in-out-style))))))
 
+(defun indent-bars-ts--draw-all-bars-between (start end)
+  "Search for and draw all bars between START and END.
+The beginning of line at START is used to locate real and (if
+configured) blank-line bars, which are drawn according to the
+appropriate style.  This is basically a very tiny, bar-only
+version of what `font-lock-fontify-region-keywords' does."
+  (save-excursion
+    (goto-char start)
+    (forward-line 0)
+    (setq start (point))
+    (while (and (< (point) end)
+               (re-search-forward
+                (caar indent-bars--font-lock-keywords) end t))
+      (indent-bars-ts--display))
+    (when indent-bars-display-on-blank-lines
+      (goto-char start)
+      (while (and (< (point) end)
+                 (re-search-forward
+                  (caar indent-bars--font-lock-blank-line-keywords) end t))
+       (indent-bars-ts--handle-blank-lines)))))
+
 (defmacro indent-bars-ts--order-ranges (a b)
   "Order ranges A and B by start position."
   `(if (< (car ,b) (car ,a)) (setq ,b (prog1 ,a (setq ,a ,b)))))
@@ -336,39 +357,73 @@ of ranges that either cover."
       (list a b) ; no overlap, use both
     (list (cons (car a) (max (cdr a) (cdr b))))))
 
+(defun indent-bars-ts--intersection (a b)
+  "Return the intersection between ranges A and B.
+Ranges A and B are (start . end) conses.  Their intersection is a
+single range that both cover, or nil if none."
+  (indent-bars-ts--order-ranges a b)
+  (unless (or (< (cdr a) (car b)) (> (car b) (cdr a)))
+    (cons (car b) (min (cdr a) (cdr b)))))
+
+(defun indent-bars-ts--intersect-all (clip ranges)
+  "Clip the range CLIP against all RANGES, returning all which are non-nil.
+RANGES is a list of (start . end) conses, and CLIP is one such
+range to clip against."
+  (cl-loop for r in ranges
+          for i = (indent-bars-ts--intersection clip r)
+          if i collect i))
+
+(defun indent-bars-ts--update-bars-on-scroll (win start)
+  "Update bars as needed within the window WIN after START.
+To be added to `window-scroll-functions'.  Consults the invalid
+ranges of the current scope."
+  (let* ((end (window-end win t))
+        (scope (buffer-local-value 'ibtcs (window-buffer win)))
+        (rngs (indent-bars-ts--intersect-all
+               (cons start end) (ibts/invalid-ranges scope))))
+    (message "On scroll with %S: %d" (selected-window) start)
+    (cl-loop for (beg . end) in rngs do
+            (indent-bars-ts--add-bars-in-range beg end))))
+
 (defun indent-bars-ts--update-scope1 (buf)
   "Perform the treesitter scope font-lock update in buffer BUF.
-If the buffer is modified or the point has moved, re-query the
-scope bounds at point.  If the current scope range, clipped to
-the window's bounds, falls outside the prior scope (beyond simple
-marker movement), refontify the union of all old invalid ranges
-and the new window ranges clipped to the window(s) showing BUF.
-Note that the updated node range clips to an \"extended window\"
-with 50% padding on either side."
+Re-query the scope node at point, and if it has moved (beyond
+simple marker movement), refontify the union of the old and new
+scope range, and mark with the `indent-bars-invalid' property.
+Finally, check and possibly update the bars in the current
+window."
   (with-current-buffer buf
-    (setq indent-bars-ts--scope-timer nil)
-    (let* ((pmn (point-min)) (pmx (point-max))
-          (old (ibts/range ibtcs))
-          (node (treesit-node-on
-                 (max pmn (1- (point))) (point)
-                 indent-bars-ts--parser))
-          (scope (and node
-                      (indent-bars-ts--node-query
-                       node (ibts/query ibtcs) nil 'innermost
-                       indent-bars-treesit-scope-min-lines)))
-          (new (if scope               ; no scope = full file
-                   (cons (treesit-node-start scope) (treesit-node-end scope))
-                 (cons pmn pmx))))
-      (unless (and (= (car new) (car old))  ; if node is unchanged (spans
-                  (= (cdr new) (cdr old))) ; same range) no update needed
-       (setf (ibts/start-bars ibtcs)
-             (save-excursion
-               (goto-char (car new))
-               (indent-bars--current-indentation-depth)))
-       (dolist (inv (indent-bars-ts--union old new))
-         (font-lock-flush (car inv) (cdr inv)))
-       (set-marker (car old) (car new)) ;updates ibts/range
-       (set-marker (cdr old) (cdr new))))))
+    (with-silent-modifications
+      (setq indent-bars-ts--scope-timer nil)
+      (let* ((pmn (point-min)) (pmx (point-max))
+            (old (ibts/range ibtcs))
+            (node (treesit-node-on
+                   (max pmn (1- (point))) (point)
+                   indent-bars-ts--parser))
+            (scope (and node
+                        (indent-bars-ts--node-query
+                         node (ibts/query ibtcs) nil 'innermost
+                         indent-bars-treesit-scope-min-lines)))
+            (new (if scope             ; no scope = full file
+                     (cons (treesit-node-start scope) (treesit-node-end scope))
+                   (cons pmn pmx))))
+       (unless (and (= (car new) (car old)) ; if node is unchanged (spans
+                    (= (cdr new) (cdr old))) ; same range) no update needed
+         (setf (ibts/start-bars ibtcs)
+               (save-excursion
+                 (goto-char (car new))
+                 (indent-bars--current-indentation-depth)))
+         (setf (ibts/invalid-ranges ibtcs) (indent-bars-ts--union old new))
+         (cl-loop for (beg . end) in (ibts/invalid-ranges ibtcs) do
+                  (put-text-property beg end 'indent-bars-invalid t))
+         (set-marker (car old) (car new)) ;updates ibts/range
+         (set-marker (cdr old) (cdr new))
+         ;; Arrange to check the current window's bars, just in case
+         ;; font-lock doesn't handle everything itself
+         (run-at-time 0 nil (let ((win (selected-window)))
+                              (lambda ()
+                                (indent-bars-ts--update-bars-on-scroll
+                                 win (window-start win))))))))))
 
 (defun indent-bars-ts--update-scope ()
   "Update treesit scope when possible."
@@ -378,6 +433,30 @@ with 50% padding on either side."
                               #'indent-bars-ts--update-scope1
                               (current-buffer)))))
 
+(defun indent-bars-ts--add-bars-in-range (start end)
+  "Add bars if needed between START and END.
+Bars are added on all visible ranges of text (considering both
+text properties and overlays) with a non-nil
+`indent-bars-invalid' property.  START is assumed to be visible.
+Based loosely on `jit-lock-function' and `jit-lock-fontify-now'."
+  (when-let ((invld-start (text-property-any start end 'indent-bars-invalid t))
+            (invld-rngs
+             (cl-loop for vs = invld-start then
+                      (next-single-char-property-change ve 
'indent-bars-invalid nil end)
+                      for ve = (next-single-char-property-change vs 
'indent-bars-invalid nil end)
+                      collect (cons vs ve) while (< ve end))))
+    (message "abir: found some invalid ranges: %S" invld-rngs)
+    (with-silent-modifications
+      (save-match-data
+       (cl-loop
+        for vs = start then (next-single-char-property-change ve 'invisible 
nil end)
+        for ve = (next-single-char-property-change vs 'invisible nil end) do
+        (cl-loop for (beg . end) in (indent-bars-ts--intersect-all (cons vs 
ve) invld-rngs) do
+                 (message "Adding invalid bars %d:%d" beg end)
+                 (put-text-property beg end 'indent-bars-invalid nil)
+                 (indent-bars-ts--draw-all-bars-between beg end))
+        while (< ve end))))))
+
 ;;;; Setup
 (defun indent-bars-ts--init-scope (&optional force)
   "Initialize scope style and variables.
@@ -432,7 +511,10 @@ performed."
      indent-bars--handle-blank-lines-form 
'(indent-bars-ts--handle-blank-lines))
     (setf (ibts/query ibtcs)
          (treesit-query-compile lang `([,@(mapcar #'list types)] @ctx)))
+    (make-local-variable 'font-lock-extra-managed-props)
+    (cl-pushnew 'indent-bars-invalid font-lock-extra-managed-props)
     (add-hook 'post-command-hook #'indent-bars-ts--update-scope nil t)
+    (add-hook 'window-scroll-functions #'indent-bars-ts--update-bars-on-scroll 
nil t)
     (add-hook 'indent-bars--teardown-functions 'indent-bars-ts--teardown)))
 
 (defun indent-bars-ts--teardown ()