[nongnu] elpa/highlight-parentheses b7e748e 02/49: Import of version 1.0.

[ELPA Syncer]

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

    Import of version 1.0.
---
 highlight-parentheses.el | 79 ++++++++++++++++++++++++++++++++++--------------
 1 file changed, 57 insertions(+), 22 deletions(-)

diff --git a/highlight-parentheses.el b/highlight-parentheses.el
index 15bf3f8..ea4c752 100644
--- a/highlight-parentheses.el
+++ b/highlight-parentheses.el
@@ -3,7 +3,7 @@
 ;; Copyright (C) 2007 Nikolaj Schumacher
 ;;
 ;; Author: Nikolaj Schumacher <bugs * nschum de>
-;; Version: 0.9.1
+;; Version: 1.0
 ;; Keywords: faces, matching
 ;; URL: http://nschum.de/src/emacs/highlight-parentheses/
 ;; Compatibility: GNU Emacs 22.x
@@ -28,10 +28,13 @@
 ;; Add the following to your .emacs file:
 ;; (require 'highlight-parentheses)
 ;;
-;; Enable `highlight-symbol-mode'.
+;; Enable `highlight-parentheses-mode'.
 ;;
 ;;; Change Log:
 ;;
+;; 2007-07-30 (1.0)
+;;    Added background highlighting and faces.
+;;
 ;; 2007-05-15 (0.9.1)
 ;;    Support for defcustom.
 ;;
@@ -40,13 +43,17 @@
 ;;
 ;;; Code:
 
-(require 'cl)
+(eval-when-compile (require 'cl))
 
 (defgroup highlight-parentheses nil
   "Highlight surrounding parentheses"
   :group 'faces
   :group 'matching)
 
+(defvar hl-paren-overlays nil
+  "This buffers currently active overlays.")
+(make-variable-buffer-local 'hl-paren-overlays)
+
 (defcustom hl-paren-colors
   '("firebrick1" "IndianRed4" "IndianRed")
   "*List of colors for the highlighted parentheses.
@@ -54,9 +61,19 @@ The list starts with the the inside parentheses and moves 
outwards."
   :type '(repeat color)
   :group 'highlight-parentheses)
 
-(defvar hl-paren-overlays nil
-  "This buffers currently active overlays.")
-(make-variable-buffer-local 'hl-paren-overlays)
+(defcustom hl-paren-background-colors nil
+  "*List of colors for the background highlighted parentheses.
+The list starts with the the inside parentheses and moves outwards."
+  :type '(repeat color)
+  :group 'highlight-parentheses)
+
+(defface hl-paren-face nil
+  "*Face used for highlighting parentheses.
+Color attributes might be overriden by `hl-paren-colors' and
+`hl-paren-background-colors'."
+  :group 'highlight-parentheses)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 (defvar hl-paren-last-point 0
   "The last point for which parentheses were highlighted.
@@ -76,26 +93,43 @@ This is used to prevent analyzing the same context over and 
over.")
                 (when (setq pos (cadr (syntax-ppss pos)))
                   (ignore-errors (scan-sexps pos 1))))
           (when match-pos
-            (hl-paren-put-overlay pos (incf level))
-            (hl-paren-put-overlay (1- match-pos) (incf level))))
+            (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 nil (incf level)))))
+          (hl-paren-put-overlay (incf level) nil nil))))
     (setq hl-paren-last-point (point))))
 
-(defun hl-paren-put-overlay (pos n)
+(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)))
-    (if pos
-        (if ov
-            (move-overlay ov pos (1+ pos))
-          (setq ov (make-overlay pos (1+ 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
-                       (cons 'foreground-color
-                             (nth (/ n 2) hl-paren-colors))))
-      (when ov
-        (delete-overlay ov)
-        (aset hl-paren-overlays n nil)))))
+          (overlay-put ov 'face face-attributes))))))
 
 ;;;###autoload
 (define-minor-mode highlight-parentheses-mode
@@ -104,7 +138,8 @@ This is used to prevent analyzing the same context over and 
over.")
   (if highlight-parentheses-mode
       (progn
         (setq hl-paren-overlays
-              (make-vector (* 2 (length hl-paren-colors)) nil))
+              (make-vector (* 2 (max (length hl-paren-colors)
+                                     (length hl-paren-background-colors))) 
nil))
         (add-hook 'post-command-hook 'hl-paren-highlight nil t))
     (let (ov)
       (dotimes (i (length hl-paren-overlays))