branch: elpa/highlight-parentheses
commit b7e748e65f118a59c10537acf8dfdcd5ea0f4d1d
Author: Nikolaj Schumacher <g...@nschum.de>
Commit: Nikolaj Schumacher <g...@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))
