[nongnu] elpa/hl-block-mode 333490cf2d 45/64: Add hl-block-multi-line option

[ELPA Syncer]

branch: elpa/hl-block-mode
commit 333490cf2ddbf4dfca7ccafce49fa12a66e532eb
Author: Campbell Barton <ideasman42@gmail.com>
Commit: Campbell Barton <ideasman42@gmail.com>

    Add hl-block-multi-line option
    
    Useful to avoid over-nesting for languages that use S-expressions.
---
 hl-block-mode.el | 41 ++++++++++++++++++++++++++++++++++-------
 readme.rst       |  2 ++
 2 files changed, 36 insertions(+), 7 deletions(-)

diff --git a/hl-block-mode.el b/hl-block-mode.el
index 00bd90594b..4d84398565 100644
--- a/hl-block-mode.el
+++ b/hl-block-mode.el
@@ -57,6 +57,13 @@ Set to nil to use all brackets."
   :group 'hl-block-mode
   :type 'float)
 
+(defcustom hl-block-multi-line nil
+  "Skip highlighting nested blocks on the same line.
+
+Useful for languages that use S-expressions to avoid overly nested 
highlighting."
+  :group 'hl-block-mode
+  :type 'boolean)
+
 (defcustom hl-block-mode-lighter ""
   "Lighter for option `hl-block-mode'."
   :group 'hl-block-mode
@@ -100,12 +107,20 @@ PT is typically the '(point)'."
         (cons (cons beg end) range-prev)
         (list (cons beg end))))))
 
-(defun hl-block--find-all-ranges-or-fallback (pt)
-  "Return ranges starting from PT, outer-most to inner-most (with fallback)."
-  (when-let ((block-list (hl-block--find-all-ranges pt)))
-    (if (cdr block-list)
-      (reverse block-list)
-      (cons (cons (point-min) (point-max)) block-list))))
+(defun hl-block--syntax-skip-to-multi-line ()
+  "Move point to the first multi-line block.
+
+The point will only ever be moved backward."
+  (let
+    (
+      (line-min (line-beginning-position))
+      (line-max (line-end-position))
+      (beg (point))
+      (end (point)))
+    (while (and beg (>= beg line-min) end (<= end line-max))
+      (setq beg (ignore-errors (elt (syntax-ppss beg) 1)))
+      (when beg
+        (setq end (ignore-errors (scan-sexps beg 1)))))))
 
 (defun hl-block--color-values-as-string (color)
   "Build a color from COLOR.
@@ -134,7 +149,19 @@ Inverse of `color-values'."
 (defun hl-block--overlay-refresh ()
   "Update the overlays based on the cursor location."
   (hl-block--overlay-clear)
-  (let ((block-list (save-excursion (hl-block--find-all-ranges-or-fallback 
(point)))))
+  (let
+    (
+      (block-list
+        (save-excursion
+          (when hl-block-multi-line
+            (hl-block--syntax-skip-to-multi-line))
+          (hl-block--find-all-ranges (point)))))
+
+    (when block-list
+      (if (cdr block-list)
+        (setq block-list (reverse block-list))
+        (cons (cons (point-min) (point-max)) block-list)))
+
     (when block-list
       (let*
         (
diff --git a/readme.rst b/readme.rst
index 86ecc80dc7..ad56e8a6fa 100644
--- a/readme.rst
+++ b/readme.rst
@@ -20,6 +20,8 @@ Options
    (float) delay in seconds until the drawing the block scope.
 :hl-block-color-tint:
    (color) color tint for each level.
+:hl-block-multi-line:
+   Skip highlighting blocks that begin and end on the same line.
 
 TODO
 ====