* paren.el (show-paren-function): Undo 2007-04-19 and 2007-04-20
[bpt/emacs.git] / lisp / paren.el
CommitLineData
55535639 1;;; paren.el --- highlight matching paren
b578f267 2
0d30b337 3;; Copyright (C) 1993, 1996, 2001, 2002, 2003, 2004,
d7a0267c 4;; 2005, 2006, 2007 Free Software Foundation, Inc.
5e28918b 5
5762abec 6;; Author: rms@gnu.org
e4c37df7
JB
7;; Maintainer: FSF
8;; Keywords: languages, faces
5e2325c9 9
5e28918b
JB
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
b578f267 23;; along with GNU Emacs; see the file COPYING. If not, write to the
086add15
LK
24;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
25;; Boston, MA 02110-1301, USA.
5e28918b
JB
26
27;;; Commentary:
28
ca5b46fc
EZ
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.
5e28918b
JB
35
36;;; Code:
37
173f2341
SM
38(defgroup paren-showing nil
39 "Showing (un)matching of parens and expressions."
40 :prefix "show-paren-"
41 :group 'paren-matching)
42
eb0d9f08 43;; This is the overlay used to highlight the matching paren.
d1475aa1 44(defvar show-paren-overlay nil)
673cc3c5 45;; This is the overlay used to highlight the closeparen right before point.
eb0d9f08
RS
46(defvar show-paren-overlay-1 nil)
47
173f2341
SM
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
5780586e
GM
63(defcustom show-paren-priority 1000
64 "*Priority of paren highlighting overlays."
65 :type 'integer
66 :group 'paren-showing
67 :version "21.1")
f1180544 68
2fe66dda
RS
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")
f1180544 74
3d3d2b8a
JL
75(defgroup paren-showing-faces nil
76 "Group for faces of Show Paren mode."
d6f0f3e0
RS
77 :group 'paren-showing
78 :group 'faces
79 :version "22.1")
80
2ec46551 81(defface show-paren-match
05e122fe
MB
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"))
173f2341 90 "Show Paren mode face used for a matching paren."
3d3d2b8a 91 :group 'paren-showing-faces)
2ec46551
MB
92;; backward-compatibility alias
93(put 'show-paren-match-face 'face-alias 'show-paren-match)
173f2341 94
2ec46551 95(defface show-paren-mismatch
173f2341 96 '((((class color)) (:foreground "white" :background "purple"))
2e8f6012 97 (t (:inverse-video t)))
173f2341 98 "Show Paren mode face used for a mismatching paren."
3d3d2b8a 99 :group 'paren-showing-faces)
2ec46551
MB
100;; backward-compatibility alias
101(put 'show-paren-mismatch-face 'face-alias 'show-paren-mismatch)
30322a27 102
6afd5d68
JL
103(defvar show-paren-highlight-openparen t
104 "*Non-nil turns on openparen highlighting when matching forward.")
105
12eb8433
RS
106(defvar show-paren-idle-timer nil)
107
108;;;###autoload
2b497eda 109(define-minor-mode show-paren-mode
12eb8433
RS
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."
83bfc0d9 116 :global t :group 'paren-showing
965cd29a 117 ;; Enable or disable the mechanism.
050d5fc2
KH
118 ;; First get rid of the old idle timer.
119 (if show-paren-idle-timer
12eb8433 120 (cancel-timer show-paren-idle-timer))
050d5fc2
KH
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)))
2b497eda 131 (unless show-paren-mode
050d5fc2
KH
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))
2b497eda 137 (delete-overlay show-paren-overlay-1))))
12eb8433 138
d1475aa1
JB
139;; Find the place to show, if there is one,
140;; and show it until input arrives.
673cc3c5 141(defun show-paren-function ()
050d5fc2 142 (if show-paren-mode
9fe9d55a 143 (let ((oldpos (point))
95ed7b42
SM
144 (dir (cond ((eq (syntax-class (syntax-after (1- (point)))) 5) -1)
145 ((eq (syntax-class (syntax-after (point))) 4) 1)))
bbcda6be 146 (window-start (window-start))
9fe9d55a 147 pos mismatch face)
173f2341 148 ;;
050d5fc2
KH
149 ;; Find the other end of the sexp.
150 (when dir
151 (save-excursion
152 (save-restriction
153 ;; Determine the range within which to look for a match.
154 (when blink-matching-paren-distance
155 (narrow-to-region
156 (max (point-min) (- (point) blink-matching-paren-distance))
157 (min (point-max) (+ (point) blink-matching-paren-distance))))
158 ;; Scan across one sexp within that range.
159 ;; Errors or nil mean there is a mismatch.
160 (condition-case ()
161 (setq pos (scan-sexps (point) dir))
162 (error (setq pos t mismatch t)))
6be7b127
RS
163 ;; Move back the other way and verify we get back to the
164 ;; starting point. If not, these two parens don't really match.
165 ;; Maybe the one at point is escaped and doesn't really count.
166 (when (integerp pos)
167 (unless (condition-case ()
168 (eq (point) (scan-sexps pos (- dir)))
169 (error nil))
170 (setq pos nil)))
050d5fc2
KH
171 ;; If found a "matching" paren, see if it is the right
172 ;; kind of paren to match the one we started at.
173 (when (integerp pos)
174 (let ((beg (min pos oldpos)) (end (max pos oldpos)))
95ed7b42 175 (unless (eq (syntax-class (syntax-after beg)) 8)
050d5fc2 176 (setq mismatch
96bda29d
SM
177 (not (or (eq (char-before end)
178 ;; This can give nil.
179 (cdr (syntax-after beg)))
180 (eq (char-after beg)
181 ;; This can give nil.
1793ac75
SM
182 (cdr (syntax-after (1- end))))
183 ;; The cdr might hold a new paren-class
184 ;; info rather than a matching-char info,
185 ;; in which case the two CDRs should match.
186 (eq (cdr (syntax-after (1- end)))
187 (cdr (syntax-after beg))))))))))))
173f2341 188 ;;
050d5fc2
KH
189 ;; Highlight the other end of the sexp, or unhighlight if none.
190 (if (not pos)
191 (progn
192 ;; If not at a paren that has a match,
193 ;; turn off any previous paren highlighting.
194 (and show-paren-overlay (overlay-buffer show-paren-overlay)
195 (delete-overlay show-paren-overlay))
196 (and show-paren-overlay-1 (overlay-buffer show-paren-overlay-1)
197 (delete-overlay show-paren-overlay-1)))
198 ;;
199 ;; Use the correct face.
200 (if mismatch
201 (progn
202 (if show-paren-ring-bell-on-mismatch
203 (beep))
2ec46551
MB
204 (setq face 'show-paren-mismatch))
205 (setq face 'show-paren-match))
050d5fc2
KH
206 ;;
207 ;; If matching backwards, highlight the closeparen
208 ;; before point as well as its matching open.
209 ;; If matching forward, and the openparen is unbalanced,
210 ;; highlight the paren at point to indicate misbalance.
211 ;; Otherwise, turn off any such highlighting.
6afd5d68 212 (if (and (not show-paren-highlight-openparen) (= dir 1) (integerp pos))
050d5fc2
KH
213 (when (and show-paren-overlay-1
214 (overlay-buffer show-paren-overlay-1))
215 (delete-overlay show-paren-overlay-1))
216 (let ((from (if (= dir 1)
217 (point)
218 (forward-point -1)))
219 (to (if (= dir 1)
220 (forward-point 1)
221 (point))))
222 (if show-paren-overlay-1
223 (move-overlay show-paren-overlay-1 from to (current-buffer))
f9914209 224 (setq show-paren-overlay-1 (make-overlay from to nil t)))
050d5fc2 225 ;; Always set the overlay face, since it varies.
5780586e 226 (overlay-put show-paren-overlay-1 'priority show-paren-priority)
050d5fc2
KH
227 (overlay-put show-paren-overlay-1 'face face)))
228 ;;
229 ;; Turn on highlighting for the matching paren, if found.
230 ;; If it's an unmatched paren, turn off any such highlighting.
231 (unless (integerp pos)
232 (delete-overlay show-paren-overlay))
233 (let ((to (if (or (eq show-paren-style 'expression)
173f2341
SM
234 (and (eq show-paren-style 'mixed)
235 (not (pos-visible-in-window-p pos))))
050d5fc2
KH
236 (point)
237 pos))
238 (from (if (or (eq show-paren-style 'expression)
239 (and (eq show-paren-style 'mixed)
240 (not (pos-visible-in-window-p pos))))
241 pos
242 (save-excursion
243 (goto-char pos)
244 (forward-point (- dir))))))
245 (if show-paren-overlay
246 (move-overlay show-paren-overlay from to (current-buffer))
f9914209 247 (setq show-paren-overlay (make-overlay from to nil t))))
050d5fc2
KH
248 ;;
249 ;; Always set the overlay face, since it varies.
5780586e 250 (overlay-put show-paren-overlay 'priority show-paren-priority)
bbcda6be
CY
251 (overlay-put show-paren-overlay 'face face))
252 ;; If there are continued lines, the above operations can
253 ;; force redisplay to recenter the window (since there is no
254 ;; way for it to know that the overlay changes to the buffer
255 ;; are harmless). So reset the window-start.
1b6c47f5
CY
256 (unless (window-minibuffer-p)
257 (set-window-start (selected-window) window-start)))
050d5fc2
KH
258 ;; show-paren-mode is nil in this buffer.
259 (and show-paren-overlay
260 (delete-overlay show-paren-overlay))
261 (and show-paren-overlay-1
262 (delete-overlay show-paren-overlay-1))))
5e28918b 263
3a3236d2
JB
264(provide 'paren)
265
d8ac3d27 266;; arch-tag: d0969b88-7ac0-4bd0-bd53-e73b892b86a9
3a3236d2 267;;; paren.el ends here