[nongnu] elpa/rainbow-delimiters 3d1e204f04 169/188: Allow the user to customize the way faces are picked.

[ELPA Syncer]

branch: elpa/rainbow-delimiters
commit 3d1e204f04ec377ae2e598faccbadd4f38f757be
Author: Fanael Linithien <fanael4@gmail.com>
Commit: Fanael Linithien <fanael4@gmail.com>

    Allow the user to customize the way faces are picked.
---
 rainbow-delimiters-test.el | 14 +++++++++
 rainbow-delimiters.el      | 73 +++++++++++++++++++++++++++++-----------------
 2 files changed, 61 insertions(+), 26 deletions(-)

diff --git a/rainbow-delimiters-test.el b/rainbow-delimiters-test.el
index 9fb40a4879..af2e6268c2 100644
--- a/rainbow-delimiters-test.el
+++ b/rainbow-delimiters-test.el
@@ -262,5 +262,19 @@
                    1 2 (face (rainbow-delimiters-depth-2-face))
                    2 3 (face (rainbow-delimiters-depth-2-face)))))))))
 
+(ert-deftest can-customize-face-picker ()
+  (let ((rainbow-delimiters-pick-face-function
+         (lambda (_depth _loc _match)
+           'font-lock-keyword-face)))
+    (with-temp-buffer-in-mode 'emacs-lisp-mode
+      (with-string (str "(())")
+        (should (ert-equal-including-properties
+                 (buffer-string)
+                 #("(())"
+                   0 1 (face (font-lock-keyword-face))
+                   1 2 (face (font-lock-keyword-face))
+                   2 3 (face (font-lock-keyword-face))
+                   3 4 (face (font-lock-keyword-face)))))))))
+
 (provide 'rainbow-delimiters-test)
 ;;; rainbow-delimiters-test.el ends here
diff --git a/rainbow-delimiters.el b/rainbow-delimiters.el
index b9f0b5a0f2..5608652dd8 100644
--- a/rainbow-delimiters.el
+++ b/rainbow-delimiters.el
@@ -97,6 +97,21 @@ Delimiters in this list are not highlighted."
   :type '(repeat character)
   :group 'rainbow-delimiters)
 
+(defcustom rainbow-delimiters-pick-face-function
+  #'rainbow-delimiters-default-pick-face
+  "The function used to pick a face used to highlight a delimiter.
+The function should take three arguments (DEPTH MATCH LOC), where:
+  - DEPTH is the delimiter depth; when zero or negative, it's an unmatched
+    delimiter.
+  - MATCH is nil iff the delimiter is a mismatched closing delimiter.
+  - LOC is the location of the delimiter.
+The function should return a value suitable to use as a value of the `face' 
text
+property, or nil, in which case the delimiter is not highlighted.
+The function should not move the point or mark or change the match data."
+  :tag "Pick face function"
+  :type 'function
+  :group 'rainbow-delimiters)
+
 (defface rainbow-delimiters-unmatched-face
   '((((background light)) (:foreground "#88090B"))
     (((background dark)) (:foreground "#88090B")))
@@ -143,24 +158,35 @@ This should be smaller than 
`rainbow-delimiters-max-face-count'."
   :group 'rainbow-delimiters)
 
 
-(defun rainbow-delimiters--depth-face (depth)
-  "Return face name for DEPTH as a symbol 
'rainbow-delimiters-depth-DEPTH-face'.
-
-For example: `rainbow-delimiters-depth-1-face'."
-  (intern-soft
-   (concat "rainbow-delimiters-depth-"
-           (number-to-string
-            (if (<= depth rainbow-delimiters-max-face-count)
-                ;; Our nesting depth has a face defined for it.
-                depth
-              ;; Deeper than # of defined faces; cycle back through to
-              ;; `rainbow-delimiters-outermost-only-face-count' + 1.
-              ;; Return face # that corresponds to current nesting level.
-              (+ 1 rainbow-delimiters-outermost-only-face-count
-                 (mod (- depth rainbow-delimiters-max-face-count 1)
-                      (- rainbow-delimiters-max-face-count
-                         rainbow-delimiters-outermost-only-face-count)))))
-           "-face")))
+(defun rainbow-delimiters-default-pick-face (depth match _loc)
+  "Return a face name appropriate for nesting depth DEPTH.
+DEPTH and MATCH are as in `rainbow-delimiters-pick-face-function'.
+
+The returned value is either `rainbow-delimiters-unmatched-face',
+`rainbow-delimiters-mismatched-face', or one of the
+`rainbow-delimiters-depth-N-face' faces, obeying
+`rainbow-delimiters-max-face-count' and
+`rainbow-delimiters-outermost-only-face-count'."
+  (cond
+   ((<= depth 0)
+    'rainbow-delimiters-unmatched-face)
+   ((not match)
+    'rainbow-delimiters-mismatched-face)
+   (t
+    (intern-soft
+     (concat "rainbow-delimiters-depth-"
+             (number-to-string
+              (if (<= depth rainbow-delimiters-max-face-count)
+                  ;; Our nesting depth has a face defined for it.
+                  depth
+                ;; Deeper than # of defined faces; cycle back through to
+                ;; `rainbow-delimiters-outermost-only-face-count' + 1.
+                ;; Return face # that corresponds to current nesting level.
+                (+ 1 rainbow-delimiters-outermost-only-face-count
+                   (mod (- depth rainbow-delimiters-max-face-count 1)
+                        (- rainbow-delimiters-max-face-count
+                           rainbow-delimiters-outermost-only-face-count)))))
+             "-face")))))
 
 (defun rainbow-delimiters--apply-color (loc depth match)
   "Highlight a single delimiter at LOC according to DEPTH.
@@ -171,14 +197,9 @@ MATCH is nil iff it's a mismatched closing delimiter.
 
 The delimiter is not highlighted if it's a blacklisted delimiter."
   (unless (memq (char-after loc) rainbow-delimiters-delimiter-blacklist)
-    (let ((delim-face (cond
-                       ((<= depth 0)
-                        'rainbow-delimiters-unmatched-face)
-                       ((not match)
-                        'rainbow-delimiters-mismatched-face)
-                       (t
-                        (rainbow-delimiters--depth-face depth)))))
-      (font-lock-prepend-text-property loc (1+ loc) 'face delim-face))))
+    (let ((face (funcall rainbow-delimiters-pick-face-function depth match 
loc)))
+      (when face
+        (font-lock-prepend-text-property loc (1+ loc) 'face face)))))
 
 (defun rainbow-delimiters--char-ineligible-p (loc ppss delim-syntax-code)
   "Return t if char at LOC should not be highlighted.