[nongnu] elpa/highlight-parentheses b9fe4eb 03/49: Rewrote engine.

[ELPA Syncer]

branch: elpa/highlight-parentheses
commit b9fe4eb04266abb0ed0e0184b46086f126b64b76
Author: Nikolaj Schumacher <git@nschum.de>
Commit: Nikolaj Schumacher <git@nschum.de>

    Rewrote engine.
---
 highlight-parentheses.el | 95 +++++++++++++++++++++---------------------------
 1 file changed, 41 insertions(+), 54 deletions(-)

diff --git a/highlight-parentheses.el b/highlight-parentheses.el
index ea4c752..f445819 100644
--- a/highlight-parentheses.el
+++ b/highlight-parentheses.el
@@ -75,6 +75,10 @@ Color attributes might be overriden by `hl-paren-colors' and
 
 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+(defvar hl-paren-overlays nil
+  "This buffers currently active overlays.")
+(make-variable-buffer-local 'hl-paren-overlays)
+
 (defvar hl-paren-last-point 0
   "The last point for which parentheses were highlighted.
 This is used to prevent analyzing the same context over and over.")
@@ -83,53 +87,22 @@ This is used to prevent analyzing the same context over and 
over.")
 (defun hl-paren-highlight ()
   "Highlight the parentheses around point."
   (unless (= (point) hl-paren-last-point)
-    (save-excursion
-      (let ((pos (point))
-            (match-pos (point))
-            (level -1)
-            (max (1- (length hl-paren-overlays))))
-        (while (and match-pos (< level max))
-          (setq match-pos
-                (when (setq pos (cadr (syntax-ppss pos)))
-                  (ignore-errors (scan-sexps pos 1))))
-          (when match-pos
-            (hl-paren-put-overlay (incf level) pos 'hl-paren-face)
-            (hl-paren-put-overlay (incf level) (1- match-pos) 'hl-paren-face)))
-        (while (< level max)
-          (hl-paren-put-overlay (incf level) nil nil))))
-    (setq hl-paren-last-point (point))))
-
-(defun hl-paren-put-overlay (n pos face)
-  "Move or create the N'th overlay so its shown at POS."
-  (let ((ov (elt hl-paren-overlays n)) end)
-    (if (null pos)
-        (when ov
-          (delete-overlay ov)
-          (aset hl-paren-overlays n nil))
-      (if (atom pos)
-          (setq end (1+ pos))
-        (setq end (cdr pos))
-        (setq pos (car pos)))
-      (if ov
-          (move-overlay ov pos end)
-        (let ((face-attributes (face-attr-construct face))
-              (color-value (nth (/ n 2) hl-paren-colors))
-              (background-value (nth (/ n 2) hl-paren-background-colors)))
-          (when color-value
-            (let ((attribute (memq :foreground face-attributes)))
-              (if attribute
-                  (setcar (cdr attribute) color-value)
-                (push color-value face-attributes)
-                (push :foreground face-attributes))))
-          (when background-value
-            (let ((attribute (memq :background face-attributes)))
-              (if attribute
-                  (setcar (cdr attribute) background-value)
-                (push background-value face-attributes)
-                (push :background face-attributes))))
-          (setq ov (make-overlay pos end))
-          (aset hl-paren-overlays n ov)
-          (overlay-put ov 'face face-attributes))))))
+    (setq hl-paren-last-point (point))
+    (let ((overlays hl-paren-overlays)
+          pos1 pos2
+          (pos (point)))
+      (save-excursion
+        (condition-case err
+            (while (and (setq pos1 (cadr (syntax-ppss pos1)))
+                        (cddr overlays))
+              (move-overlay (pop overlays) pos1 (1+ pos1))
+              (when (setq pos2 (scan-sexps pos1 1))
+                (move-overlay (pop overlays) (1- pos2) pos2)
+                ))
+          (error nil))
+        (goto-char pos))
+      (dolist (ov overlays)
+        (move-overlay ov 1 1)))))
 
 ;;;###autoload
 (define-minor-mode highlight-parentheses-mode
@@ -137,18 +110,32 @@ This is used to prevent analyzing the same context over 
and over.")
   nil " hl-p" nil
   (if highlight-parentheses-mode
       (progn
-        (setq hl-paren-overlays
-              (make-vector (* 2 (max (length hl-paren-colors)
-                                     (length hl-paren-background-colors))) 
nil))
+        (hl-paren-create-overlays)
         (add-hook 'post-command-hook 'hl-paren-highlight nil t))
-    (let (ov)
-      (dotimes (i (length hl-paren-overlays))
-        (when (setq ov (elt hl-paren-overlays i))
-          (delete-overlay ov))))
+    (mapc 'delete-overlay hl-paren-overlays)
     (kill-local-variable 'hl-paren-overlays)
     (kill-local-variable 'hl-paren-point)
     (remove-hook 'post-command-hook 'hl-paren-highlight t)))
 
+;;; overlays 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun hl-paren-create-overlays ()
+  (let ((fg hl-paren-colors)
+        (bg hl-paren-background-colors)
+        attributes)
+    (while (or fg bg)
+      (setq attributes (face-attr-construct 'hl-paren-face))
+      (when (car fg)
+        (setq attributes (plist-put attributes :foreground (car fg))))
+      (pop fg)
+      (when (car bg)
+        (setq attributes (plist-put attributes :background (car bg))))
+      (pop bg)
+      (dotimes (i 2) ;; front and back
+        (push (make-overlay 0 0) hl-paren-overlays)
+        (overlay-put (car hl-paren-overlays) 'face attributes)))
+    (setq hl-paren-overlays (nreverse hl-paren-overlays))))
+
 (provide 'highlight-parentheses)
 
 ;;; highlight-parentheses.el ends here