mirror of
https://github.com/lliding/ld-emacs.git
synced 2025-10-13 05:23:05 +00:00
158 lines
5.4 KiB
EmacsLisp
158 lines
5.4 KiB
EmacsLisp
;;; highlight-parentheses.el --- highlight surrounding parentheses
|
|
;;
|
|
;; Copyright (C) 2007 Nikolaj Schumacher
|
|
;;
|
|
;; Author: Nikolaj Schumacher <bugs * nschum de>
|
|
;; Version: 1.0
|
|
;; Keywords: faces, matching
|
|
;; URL: http://nschum.de/src/emacs/highlight-parentheses/
|
|
;; Compatibility: GNU Emacs 22.x
|
|
;;
|
|
;; This file is NOT part of GNU Emacs.
|
|
;;
|
|
;; This program is free software; you can redistribute it and/or
|
|
;; modify it under the terms of the GNU General Public License
|
|
;; as published by the Free Software Foundation; either version 2
|
|
;; of the License, or (at your option) any later version.
|
|
;;
|
|
;; This program is distributed in the hope that it will be useful,
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
;; GNU General Public License for more details.
|
|
;;
|
|
;; You should have received a copy of the GNU General Public License
|
|
;; along with this program; if not, write to the Free Software
|
|
;; Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
|
|
;;
|
|
;;; Commentary:
|
|
;;
|
|
;; Add the following to your .emacs file:
|
|
;; (require 'highlight-parentheses)
|
|
;;
|
|
;; Enable `highlight-symbol-mode'.
|
|
;;
|
|
;;; Changes Log:
|
|
;;
|
|
;; 2007-07-30 (1.0)
|
|
;; Added background highlighting and faces.
|
|
;;
|
|
;; 2007-05-15 (0.9.1)
|
|
;; Support for defcustom. Changed from vector to list.
|
|
;;
|
|
;; 2007-04-26 (0.9)
|
|
;; Initial Release.
|
|
;;
|
|
;;; Code:
|
|
|
|
(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.
|
|
The list starts with the the inside parentheses and moves outwards."
|
|
:type '(repeat color)
|
|
:group 'highlight-parentheses)
|
|
|
|
(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.
|
|
This is used to prevent analyzing the same context over and over.")
|
|
(make-variable-buffer-local 'hl-paren-last-point)
|
|
|
|
(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 (cl-incf level) pos 'hl-paren-face)
|
|
(hl-paren-put-overlay (cl-incf level) (1- match-pos) 'hl-paren-face)))
|
|
(while (< level max)
|
|
(hl-paren-put-overlay (cl-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))))))
|
|
|
|
;;;###autoload
|
|
(define-minor-mode highlight-parentheses-mode
|
|
"Minor mode to highlight the surrounding parentheses."
|
|
:init-value nil
|
|
:lighter " hl-p"
|
|
:keymap nil
|
|
(if highlight-parentheses-mode
|
|
(progn
|
|
(setq hl-paren-overlays
|
|
(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))
|
|
(when (setq ov (elt hl-paren-overlays i))
|
|
(delete-overlay ov))))
|
|
(kill-local-variable 'hl-paren-overlays)
|
|
(kill-local-variable 'hl-paren-point)
|
|
(remove-hook 'post-command-hook 'hl-paren-highlight t)))
|
|
|
|
(provide 'highlight-parentheses)
|
|
|
|
;;; highlight-parentheses.el ends here
|