1;;; paren.el --- highlight matching paren 2 3;; Copyright (C) 1993, 1996, 2001, 2002, 2003, 2004, 4;; 2005, 2006, 2007 Free Software Foundation, Inc. 5 6;; Author: rms@gnu.org 7;; Maintainer: FSF 8;; Keywords: languages, faces 9 10;; This file is part of GNU Emacs. 11 12;; GNU Emacs is free software; you can redistribute it and/or modify 13;; it under the terms of the GNU General Public License as published by 14;; the Free Software Foundation; either version 2, or (at your option) 15;; any later version. 16 17;; GNU Emacs is distributed in the hope that it will be useful, 18;; but WITHOUT ANY WARRANTY; without even the implied warranty of 19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 20;; GNU General Public License for more details. 21 22;; You should have received a copy of the GNU General Public License 23;; along with GNU Emacs; see the file COPYING. If not, write to the 24;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 25;; Boston, MA 02110-1301, USA. 26 27;;; Commentary: 28 29;; Put this into your ~/.emacs: 30 31;; (show-paren-mode t) 32 33;; It will display highlighting on whatever paren matches the one 34;; before or after point. 35 36;;; Code: 37 38(defgroup paren-showing nil 39 "Showing (un)matching of parens and expressions." 40 :prefix "show-paren-" 41 :group 'paren-matching) 42 43;; This is the overlay used to highlight the matching paren. 44(defvar show-paren-overlay nil) 45;; This is the overlay used to highlight the closeparen right before point. 46(defvar show-paren-overlay-1 nil) 47 48(defcustom show-paren-style 'parenthesis 49 "*Style used when showing a matching paren. 50Valid styles are `parenthesis' (meaning show the matching paren), 51`expression' (meaning show the entire expression enclosed by the paren) and 52`mixed' (meaning show the matching paren if it is visible, and the expression 53otherwise)." 54 :type '(choice (const parenthesis) (const expression) (const mixed)) 55 :group 'paren-showing) 56 57(defcustom show-paren-delay 58 (if (featurep 'lisp-float-type) (/ (float 1) (float 8)) 1) 59 "*Time in seconds to delay before showing a matching paren." 60 :type '(number :tag "seconds") 61 :group 'paren-showing) 62 63(defcustom show-paren-priority 1000 64 "*Priority of paren highlighting overlays." 65 :type 'integer 66 :group 'paren-showing 67 :version "21.1") 68 69(defcustom show-paren-ring-bell-on-mismatch nil 70 "*If non-nil, beep if mismatched paren is detected." 71 :type 'boolean 72 :group 'paren-showing 73 :version "20.3") 74 75(defgroup paren-showing-faces nil 76 "Group for faces of Show Paren mode." 77 :group 'paren-showing 78 :group 'faces 79 :version "22.1") 80 81(defface show-paren-match 82 '((((class color) (background light)) 83 :background "turquoise") ; looks OK on tty (becomes cyan) 84 (((class color) (background dark)) 85 :background "steelblue3") ; looks OK on tty (becomes blue) 86 (((background dark)) 87 :background "grey50") 88 (t 89 :background "gray")) 90 "Show Paren mode face used for a matching paren." 91 :group 'paren-showing-faces) 92;; backward-compatibility alias 93(put 'show-paren-match-face 'face-alias 'show-paren-match) 94 95(defface show-paren-mismatch 96 '((((class color)) (:foreground "white" :background "purple")) 97 (t (:inverse-video t))) 98 "Show Paren mode face used for a mismatching paren." 99 :group 'paren-showing-faces) 100;; backward-compatibility alias 101(put 'show-paren-mismatch-face 'face-alias 'show-paren-mismatch) 102 103(defvar show-paren-highlight-openparen t 104 "*Non-nil turns on openparen highlighting when matching forward.") 105 106(defvar show-paren-idle-timer nil) 107 108;;;###autoload 109(define-minor-mode show-paren-mode 110 "Toggle Show Paren mode. 111With prefix ARG, turn Show Paren mode on if and only if ARG is positive. 112Returns the new status of Show Paren mode (non-nil means on). 113 114When Show Paren mode is enabled, any matching parenthesis is highlighted 115in `show-paren-style' after `show-paren-delay' seconds of Emacs idle time." 116 :global t :group 'paren-showing 117 ;; Enable or disable the mechanism. 118 ;; First get rid of the old idle timer. 119 (if show-paren-idle-timer 120 (cancel-timer show-paren-idle-timer)) 121 (setq show-paren-idle-timer nil) 122 ;; If show-paren-mode is enabled in some buffer now, 123 ;; set up a new timer. 124 (when (memq t (mapcar (lambda (buffer) 125 (with-current-buffer buffer 126 show-paren-mode)) 127 (buffer-list))) 128 (setq show-paren-idle-timer (run-with-idle-timer 129 show-paren-delay t 130 'show-paren-function))) 131 (unless show-paren-mode 132 (and show-paren-overlay 133 (eq (overlay-buffer show-paren-overlay) (current-buffer)) 134 (delete-overlay show-paren-overlay)) 135 (and show-paren-overlay-1 136 (eq (overlay-buffer show-paren-overlay-1) (current-buffer)) 137 (delete-overlay show-paren-overlay-1)))) 138 139;; Find the place to show, if there is one, 140;; and show it until input arrives. 141(defun show-paren-function () 142 (if show-paren-mode 143 (let ((oldpos (point)) 144 (dir (cond ((eq (syntax-class (syntax-after (1- (point)))) 5) -1) 145 ((eq (syntax-class (syntax-after (point))) 4) 1))) 146 pos mismatch face) 147 ;; 148 ;; Find the other end of the sexp. 149 (when dir 150 (save-excursion 151 (save-restriction 152 ;; Determine the range within which to look for a match. 153 (when blink-matching-paren-distance 154 (narrow-to-region 155 (max (point-min) (- (point) blink-matching-paren-distance)) 156 (min (point-max) (+ (point) blink-matching-paren-distance)))) 157 ;; Scan across one sexp within that range. 158 ;; Errors or nil mean there is a mismatch. 159 (condition-case () 160 (setq pos (scan-sexps (point) dir)) 161 (error (setq pos t mismatch t))) 162 ;; Move back the other way and verify we get back to the 163 ;; starting point. If not, these two parens don't really match. 164 ;; Maybe the one at point is escaped and doesn't really count. 165 (when (integerp pos) 166 (unless (condition-case () 167 (eq (point) (scan-sexps pos (- dir))) 168 (error nil)) 169 (setq pos nil))) 170 ;; If found a "matching" paren, see if it is the right 171 ;; kind of paren to match the one we started at. 172 (when (integerp pos) 173 (let ((beg (min pos oldpos)) (end (max pos oldpos))) 174 (unless (eq (syntax-class (syntax-after beg)) 8) 175 (setq mismatch 176 (not (or (eq (char-before end) 177 ;; This can give nil. 178 (cdr (syntax-after beg))) 179 (eq (char-after beg) 180 ;; This can give nil. 181 (cdr (syntax-after (1- end)))) 182 ;; The cdr might hold a new paren-class 183 ;; info rather than a matching-char info, 184 ;; in which case the two CDRs should match. 185 (eq (cdr (syntax-after (1- end))) 186 (cdr (syntax-after beg)))))))))))) 187 ;; 188 ;; Highlight the other end of the sexp, or unhighlight if none. 189 (if (not pos) 190 (progn 191 ;; If not at a paren that has a match, 192 ;; turn off any previous paren highlighting. 193 (and show-paren-overlay (overlay-buffer show-paren-overlay) 194 (delete-overlay show-paren-overlay)) 195 (and show-paren-overlay-1 (overlay-buffer show-paren-overlay-1) 196 (delete-overlay show-paren-overlay-1))) 197 ;; 198 ;; Use the correct face. 199 (if mismatch 200 (progn 201 (if show-paren-ring-bell-on-mismatch 202 (beep)) 203 (setq face 'show-paren-mismatch)) 204 (setq face 'show-paren-match)) 205 ;; 206 ;; If matching backwards, highlight the closeparen 207 ;; before point as well as its matching open. 208 ;; If matching forward, and the openparen is unbalanced, 209 ;; highlight the paren at point to indicate misbalance. 210 ;; Otherwise, turn off any such highlighting. 211 (if (and (not show-paren-highlight-openparen) (= dir 1) (integerp pos)) 212 (when (and show-paren-overlay-1 213 (overlay-buffer show-paren-overlay-1)) 214 (delete-overlay show-paren-overlay-1)) 215 (let ((from (if (= dir 1) 216 (point) 217 (forward-point -1))) 218 (to (if (= dir 1) 219 (forward-point 1) 220 (point)))) 221 (if show-paren-overlay-1 222 (move-overlay show-paren-overlay-1 from to (current-buffer)) 223 (setq show-paren-overlay-1 (make-overlay from to nil t))) 224 ;; Always set the overlay face, since it varies. 225 (overlay-put show-paren-overlay-1 'priority show-paren-priority) 226 (overlay-put show-paren-overlay-1 'face face))) 227 ;; 228 ;; Turn on highlighting for the matching paren, if found. 229 ;; If it's an unmatched paren, turn off any such highlighting. 230 (unless (integerp pos) 231 (delete-overlay show-paren-overlay)) 232 (let ((to (if (or (eq show-paren-style 'expression) 233 (and (eq show-paren-style 'mixed) 234 (not (pos-visible-in-window-p pos)))) 235 (point) 236 pos)) 237 (from (if (or (eq show-paren-style 'expression) 238 (and (eq show-paren-style 'mixed) 239 (not (pos-visible-in-window-p pos)))) 240 pos 241 (save-excursion 242 (goto-char pos) 243 (forward-point (- dir)))))) 244 (if show-paren-overlay 245 (move-overlay show-paren-overlay from to (current-buffer)) 246 (setq show-paren-overlay (make-overlay from to nil t)))) 247 ;; 248 ;; Always set the overlay face, since it varies. 249 (overlay-put show-paren-overlay 'priority show-paren-priority) 250 (overlay-put show-paren-overlay 'face face))) 251 ;; show-paren-mode is nil in this buffer. 252 (and show-paren-overlay 253 (delete-overlay show-paren-overlay)) 254 (and show-paren-overlay-1 255 (delete-overlay show-paren-overlay-1)))) 256 257(provide 'paren) 258 259;; arch-tag: d0969b88-7ac0-4bd0-bd53-e73b892b86a9 260;;; paren.el ends here 261