[nongnu] elpa/why-this 340194b6d2 24/59: Calculate background for message

[ELPA Syncer]

branch: elpa/why-this
commit 340194b6d2013c4b4488ba29124fa3667f314ccc
Author: Akib Azmain Turja <akib@disroot.org>
Commit: Akib Azmain Turja <akib@disroot.org>

    Calculate background for message
---
 images/blame-region.png | Bin 182406 -> 173866 bytes
 images/blame.png        | Bin 136015 -> 159057 bytes
 why-this.el             |  58 ++++++++++++++++++++++++++++++++++++++++++++++--
 3 files changed, 56 insertions(+), 2 deletions(-)

diff --git a/images/blame-region.png b/images/blame-region.png
index abd2663631..804e817cd2 100644
Binary files a/images/blame-region.png and b/images/blame-region.png differ
diff --git a/images/blame.png b/images/blame.png
index c1693824aa..038de12e09 100644
Binary files a/images/blame.png and b/images/blame.png differ
diff --git a/why-this.el b/why-this.el
index e707e11536..5fe971d04d 100644
--- a/why-this.el
+++ b/why-this.el
@@ -132,6 +132,12 @@ NICK."
   :package-version '(why-this "1.0")
   :group 'why-this)
 
+(defcustom why-this-calculate-background t
+  "Non-nil means calculate background for message."
+  :type 'boolean
+  :package-version '(why-this "1.0")
+  :group 'why-this)
+
 (defface why-this-face
   '((t :foreground "#82b0ec"
        :background nil
@@ -225,6 +231,41 @@ When EXACT is non-nil, be as exact as possible."
                  str)))))
        format t t))))
 
+(defun why-this--overlay-bg-type (pos)
+  "Return the background type for overlay at POS."
+  (cond
+   ((and (use-region-p)
+         (>= pos (region-beginning))
+         (< pos (region-end)))
+    'region)
+   ((eq (line-number-at-pos)
+        (line-number-at-pos pos))
+    'line)
+   (t
+    nil)))
+
+(defun why-this--get-face (type)
+  "Return face for showing message with background type TYPE."
+  (if (not why-this-calculate-background)
+      'why-this-face
+    `(:background
+      ,(face-background
+        (pcase type
+          ('region
+           (if (bound-and-true-p solaire-mode)
+               'solaire-region-face
+             'region))
+          ('line
+           (if (bound-and-true-p hl-line-mode)
+               (if (bound-and-true-p solaire-mode)
+                   'solaire-hl-line-face
+                 'hl-line)
+             'why-this-face))
+          (_
+           'why-this-face))
+        nil t)
+      :inherit why-this-face)))
+
 (defvar why-this-mode)
 
 (defun why-this--render ()
@@ -244,13 +285,15 @@ When EXACT is non-nil, be as exact as possible."
         (let ((pos (save-excursion
                      (goto-char (point-min))
                      (line-end-position (+ begin i)))))
-          (let ((ov (make-overlay pos pos)))
+          (let ((ov (make-overlay pos pos))
+                (type (why-this--overlay-bg-type pos)))
             (overlay-put ov 'after-string
                          (propertize (why-this-format-data
                                       why-this-message-format
                                       (append `(:backend ,backend)
                                               (nth i data)))
-                                     'cursor t 'face 'why-this-face
+                                     'cursor t
+                                     'face (why-this--get-face type)
                                      'help-echo
                                      (when why-this-enable-tooltip
                                        (why-this-format-data
@@ -258,6 +301,7 @@ When EXACT is non-nil, be as exact as possible."
                                         (append `(:backend ,backend)
                                                 (nth i data))))))
             (overlay-put ov 'why-this-line (+ begin i))
+            (overlay-put ov 'why-this-bg-type type)
             (push (cons ov (current-buffer)) why-this--overlays)))))))
 
 (defun why-this--render-non-blocking ()
@@ -292,6 +336,16 @@ When EXACT is non-nil, be as exact as possible."
                              (line-end-position))))
                  (unless (eq ov-start pos)
                    (move-overlay (car ov) pos pos)))
+               (when why-this-calculate-background
+                 (let ((type (why-this--overlay-bg-type
+                              (overlay-start (car ov)))))
+                   (unless (eq (overlay-get (car ov) 'why-this-bg-type)
+                               type)
+                     (overlay-put (car ov) 'after-string
+                                  (propertize
+                                   (overlay-get (car ov) 'after-string)
+                                   'face (why-this--get-face type)))
+                     (overlay-put (car ov) 'why-this-bg-type type))))
                ov)
            (delete-overlay (car ov))
            nil))