[elpa] master 0a12708 164/399: swiper.el: Add swiper background faces

[Oleh Krehel]

branch: master
commit 0a1270801fb238fed0cad2a6fd6553c47e854946
Author: Oleh Krehel <address@hidden>
Commit: Oleh Krehel <address@hidden>

    swiper.el: Add swiper background faces
---
 swiper.el | 113 +++++++++++++++++++++++++++++++++++++++++++-------------------
 1 file changed, 79 insertions(+), 34 deletions(-)

diff --git a/swiper.el b/swiper.el
index ad29724..2f5a578 100644
--- a/swiper.el
+++ b/swiper.el
@@ -57,6 +57,22 @@
   '((t (:inherit isearch-fail)))
   "Face for `swiper' matches modulo 3.")
 
+(defface swiper-background-match-face-1
+  '((t (:inherit swiper-match-face-1)))
+  "The background face for non-current `swiper' matches.")
+
+(defface swiper-background-match-face-2
+  '((t (:inherit swiper-match-face-2)))
+  "Face for non-current `swiper' matches modulo 1.")
+
+(defface swiper-background-match-face-3
+  '((t (:inherit swiper-match-face-3)))
+  "Face for non-current `swiper' matches modulo 2.")
+
+(defface swiper-background-match-face-4
+  '((t (:inherit swiper-match-face-4)))
+  "Face for non-current `swiper' matches modulo 3.")
+
 (defface swiper-line-face
   '((t (:inherit highlight)))
   "Face for current `swiper' line.")
@@ -69,6 +85,31 @@
   :group 'ivy-faces
   :type '(repeat face))
 
+(defvar swiper-background-faces
+  '(swiper-background-match-face-1
+    swiper-background-match-face-2
+    swiper-background-match-face-3
+    swiper-background-match-face-4)
+  "Like `swiper-faces', but used for all matches except the current one.")
+
+(defun swiper--recompute-background-faces ()
+  (let ((faces '(swiper-background-match-face-1
+                 swiper-background-match-face-2
+                 swiper-background-match-face-3
+                 swiper-background-match-face-4))
+        (colir-compose-method #'colir-compose-soft-light))
+    (cl-mapc (lambda (f1 f2)
+               (let ((bg (face-background f1)))
+                 (when bg
+                   (set-face-background
+                    f2
+                    (colir-blend
+                     (colir-color-parse bg)
+                     (colir-color-parse "#ffffff"))))))
+             swiper-faces
+             faces)))
+(swiper--recompute-background-faces)
+
 (defcustom swiper-min-highlight 2
   "Only highlight matches for regexps at least this long."
   :type 'integer)
@@ -781,7 +822,8 @@ Matched candidates should have `swiper-invocation-face'."
 BEG and END, when specified, are the point bounds.
 WND, when specified is the window."
   (setq wnd (or wnd (ivy-state-window ivy-last)))
-  (let ((ov (if visual-line-mode
+  (let ((pt (point))
+        (ov (if visual-line-mode
                 (make-overlay
                  (save-excursion
                    (beginning-of-visual-line)
@@ -815,39 +857,42 @@ WND, when specified is the window."
             ;; greater otherwise. We hope that the inclusion of the
             ;; newline will not ever be a problem in practice.
             (when (< (count-lines (match-beginning 0) (match-end 0)) 2)
-              (unless (and (consp ivy--old-re)
-                           (null
-                            (save-match-data
-                              (ivy--re-filter ivy--old-re
-                                              (list
-                                               (buffer-substring-no-properties
-                                                (line-beginning-position)
-                                                (line-end-position)))))))
-                (let ((mb (match-beginning 0))
-                      (me (match-end 0)))
-                  (unless (> (- me mb) 2017)
-                    (swiper--add-overlay mb me
-                                         (if (zerop ivy--subexps)
-                                             (cadr swiper-faces)
-                                           (car swiper-faces))
-                                         wnd 0))))
-              (let ((i 1)
-                    (j 0))
-                (while (<= (cl-incf j) ivy--subexps)
-                  (let ((bm (match-beginning j))
-                        (em (match-end j)))
-                    (when (and (integerp em)
-                               (integerp bm))
-                      (while (and (< j ivy--subexps)
-                                  (integerp (match-beginning (+ j 1)))
-                                  (= em (match-beginning (+ j 1))))
-                        (setq em (match-end (cl-incf j))))
-                      (swiper--add-overlay
-                       bm em
-                       (nth (1+ (mod (+ i 2) (1- (length swiper-faces))))
-                            swiper-faces)
-                       wnd i)
-                      (cl-incf i))))))))))))
+              (let ((faces (if (= (match-end 0) pt)
+                               swiper-faces
+                             swiper-background-faces)))
+                (unless (and (consp ivy--old-re)
+                             (null
+                              (save-match-data
+                                (ivy--re-filter ivy--old-re
+                                                (list
+                                                 
(buffer-substring-no-properties
+                                                  (line-beginning-position)
+                                                  (line-end-position)))))))
+                  (let ((mb (match-beginning 0))
+                        (me (match-end 0)))
+                    (unless (> (- me mb) 2017)
+                      (swiper--add-overlay mb me
+                                           (if (zerop ivy--subexps)
+                                               (cadr faces)
+                                             (car faces))
+                                           wnd 0))))
+                (let ((i 1)
+                      (j 0))
+                  (while (<= (cl-incf j) ivy--subexps)
+                    (let ((bm (match-beginning j))
+                          (em (match-end j)))
+                      (when (and (integerp em)
+                                 (integerp bm))
+                        (while (and (< j ivy--subexps)
+                                    (integerp (match-beginning (+ j 1)))
+                                    (= em (match-beginning (+ j 1))))
+                          (setq em (match-end (cl-incf j))))
+                        (swiper--add-overlay
+                         bm em
+                         (nth (1+ (mod (+ i 2) (1- (length faces))))
+                              faces)
+                         wnd i)
+                        (cl-incf i)))))))))))))
 
 (defun swiper--add-overlay (beg end face wnd priority)
   "Add overlay bound by BEG and END to `swiper--overlays'.