[elpa] externals/beardbolt d9da365a0f 320/323: Rework rainbow overlays to make them slightly more useful

[ELPA Syncer]

branch: externals/beardbolt
commit d9da365a0fae008a725d42fd0c6947d66a544114
Author: João Távora <joaotavora@gmail.com>
Commit: João Távora <joaotavora@gmail.com>

    Rework rainbow overlays to make them slightly more useful
    
    * beardbolt.el (pulse): Require it.
    (bb--rainbowize): Make a muted color.
    (bb--recenter-maybe): Recenter to overlay.
    (bb--synch-relation-overlays): Rework.
---
 beardbolt.el | 92 +++++++++++++++++++++++++++++++++++++++---------------------
 1 file changed, 60 insertions(+), 32 deletions(-)

diff --git a/beardbolt.el b/beardbolt.el
index 39833d3be1..0e87ac733f 100644
--- a/beardbolt.el
+++ b/beardbolt.el
@@ -36,6 +36,7 @@
 (require 'disass)
 (require 'json)
 (require 'color)
+(require 'pulse)
 
 ;;; Code:
 (defgroup beardbolt nil
@@ -464,17 +465,20 @@ some parts of the buffer and setup a buffer-local value of
      (lambda (src-line asm-pos-regions)
        (when (not (zerop src-line))
          (cl-loop
-          with color =
-          (apply #'color-rgb-to-hex
-                 (color-hsl-to-rgb (mod (+ (cl-first background-hsl)
-                                           (/ (cl-incf idx) (float total)))
-                                        1)
-                                   (min (max (cl-second background-hsl)
-                                             0.25)
-                                        0.8)
-                                   (min (max (cl-third background-hsl)
-                                             0.25)
-                                        0.8)))
+          with bright-hsl =(list (mod (+ (cl-first background-hsl)
+                                         (/ (cl-incf idx) (float total)))
+                                      1)
+                                 (min (max (cl-second background-hsl)
+                                           0.25)
+                                      0.8)
+                                 (min (max (cl-third background-hsl)
+                                           0.25)
+                                      0.8))
+          with muted-hsl = (list (car bright-hsl)
+                                 (/ (cadr bright-hsl) 2.0)
+                                 (caddr bright-hsl))
+          with color = (apply #'color-rgb-to-hex (apply #'color-hsl-to-rgb 
bright-hsl))
+          with muted-color = (apply #'color-rgb-to-hex (apply 
#'color-hsl-to-rgb muted-hsl))
           for (beg . end) in asm-pos-regions
           for asm-ov = (make-overlay beg end)
           do
@@ -482,7 +486,8 @@ some parts of the buffer and setup a buffer-local value of
           (push asm-ov all-ovs)
           (overlay-put asm-ov 'face `(:background ,color))
           (overlay-put asm-ov 'beardbolt-rainbow-face `(:background ,color))
-          (overlay-put asm-ov 'beardbolt t)
+          (overlay-put asm-ov 'beardbolt-muted-face `(:background 
,muted-color))
+          (overlay-put asm-ov 'beardbolt 'asm)
           collect asm-ov into this-lines-asm-overlays
           finally
           (with-current-buffer src-buffer
@@ -497,6 +502,7 @@ some parts of the buffer and setup a buffer-local value of
                   (overlay-put o 'beardbolt-related-overlays group))
                 (overlay-put ov 'face `(:background ,color))
                 (overlay-put ov 'beardbolt-rainbow-face `(:background ,color))
+                (overlay-put ov 'beardbolt-muted-face `(:background 
,muted-color))
                 (overlay-put ov 'beardbolt t)
                 (push ov all-ovs)))))))
      ht)
@@ -666,37 +672,59 @@ With prefix argument, choose from starter files in 
`bb-starter-files'."
       (find-file sandbox-file)
       (bb-mode 1))))
 
-(defun bb--recenter-maybe (pos)
-  (cl-loop for w in (cl-remove-if (lambda (w)
-                                    (and (>= pos (* 1.1 (window-start w)))
-                                         (<= pos (* 0.9 (window-end w)))))
-                                  (get-buffer-window-list))
-           unless (eq w (selected-window))
-           do (set-window-point w pos)
-           (with-selected-window w (recenter))))
+(defun bb--recenter-maybe (ov)
+  (bb--when-live-buffer (overlay-buffer ov)
+    (cl-loop with pos = (overlay-start ov)
+             for w in (cl-remove-if (lambda (w)
+                                      (and (>= pos (* 1.1 (window-start w)))
+                                           (<= pos (* 0.9 (window-end w)))))
+                                    (get-buffer-window-list))
+             unless (eq w (selected-window))
+             do (set-window-point w pos)
+             (with-selected-window w (recenter)))))
 
 (defvar bb--currently-synched-overlays nil)
 
 (defun bb--synch-relation-overlays ()
   (let* ((at-point (overlays-at (point)))
-         has-recentered
+         (all-ovs (if (eq major-mode 'bb--asm-mode)
+                      bb--rainbow-overlays
+                    (buffer-local-value 'bb--rainbow-overlays bb--asm-buffer)))
          (ov (cl-find-if (lambda (ov) (overlay-get ov 'beardbolt-rainbow-face))
                          at-point)))
     (cond ((and ov (not (member ov bb--currently-synched-overlays)))
-           (dolist (oov bb--currently-synched-overlays)
-             (overlay-put oov 'face (overlay-get ov 'beardbolt-rainbow-face)))
+           (dolist (o all-ovs)
+             (overlay-put o 'face (overlay-get o 'beardbolt-muted-face)))
            (setq bb--currently-synched-overlays
                  (overlay-get ov 'beardbolt-related-overlays))
-           (dolist (oov bb--currently-synched-overlays)
-             (unless (or has-recentered
-                         (eq (overlay-buffer oov) (overlay-buffer ov)))
-               (bb--when-live-buffer (overlay-buffer oov)
-                 (bb--recenter-maybe (overlay-start oov))
-                 (setq has-recentered t)))
-             (overlay-put oov 'face 'bb-current-line-face)))
+           (setq bb--currently-synched-overlays
+                 (cl-sort bb--currently-synched-overlays #'< :key 
#'overlay-start))
+           (dolist (o bb--currently-synched-overlays)
+             (overlay-put o 'face 'bb-current-line-face))
+           (let* ((other-buffer-overlays
+                   (cl-remove (current-buffer)
+                              bb--currently-synched-overlays
+                              :key #'overlay-buffer))
+                  (recenter-target (car other-buffer-overlays))
+                  (pulse-delay 0.01)
+                  (asm-overlays
+                   (cl-remove-if-not (lambda (ov)
+                                       (eq 'asm (overlay-get ov 'beardbolt)))
+                                     bb--currently-synched-overlays)))
+             (if (memq recenter-target asm-overlays)
+                 (message "[beardbolt] maps to %s asm regions."
+                          (length asm-overlays))
+               (message "[beardbolt] asm region %s/%s for source line %s."
+                        (1+ (cl-position ov asm-overlays))
+                        (length asm-overlays)
+                        (with-current-buffer (overlay-buffer recenter-target)
+                          (line-number-at-pos (overlay-start 
recenter-target)))))
+             (bb--recenter-maybe recenter-target)
+             (pulse-momentary-highlight-overlay recenter-target
+                                                'bb-current-line-face)))
           ((not ov)
-           (dolist (ov bb--currently-synched-overlays)
-             (overlay-put ov 'face (overlay-get ov 'beardbolt-rainbow-face)))
+           (dolist (o all-ovs)
+             (overlay-put o 'face (overlay-get o 'beardbolt-rainbow-face)))
            (setq bb--currently-synched-overlays nil)))))
 
 (defvar bb--change-timer nil)