1 ;;; paren.el --- highlight matching paren.
3 ;; Copyright (C) 1993, 1996 Free Software Foundation, Inc.
5 ;; Author: rms@gnu.ai.mit.edu
7 ;; Keywords: languages, faces
9 ;; This file is part of GNU Emacs.
11 ;; GNU Emacs is free software; you can redistribute it and/or modify
12 ;; it under the terms of the GNU General Public License as published by
13 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; GNU Emacs is distributed in the hope that it will be useful,
17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19 ;; GNU General Public License for more details.
21 ;; You should have received a copy of the GNU General Public License
22 ;; along with GNU Emacs; see the file COPYING. If not, write to the
23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
24 ;; Boston, MA 02111-1307, USA.
28 ;; Load this and it will display highlighting on whatever
29 ;; paren matches the one before or after point.
33 ;; This is the overlay used to highlight the matching paren.
34 (defvar show-paren-overlay nil
)
35 ;; This is the overlay used to highlight the closeparen right before point.
36 (defvar show-paren-overlay-1 nil
)
38 (defvar show-paren-mode nil
)
39 (defvar show-paren-idle-timer nil
)
41 (defvar show-paren-mismatch-face nil
)
43 (defvar show-paren-delay
(if (featurep 'lisp-float-type
) 0.125 1)
44 "*Time in seconds to delay before showing the matching paren.")
46 (defvar show-paren-face
'region
47 "*Name of the face to use for showing the matching paren.")
50 (defun show-paren-mode (&optional arg
)
51 "Toggle Show Paren mode.
52 With prefix ARG, turn Show Paren mode on if and only if ARG is positive.
53 Returns the new status of Show Paren mode (non-nil means on).
55 When Show Paren mode is enabled, any matching parenthesis is highlighted
56 after `show-paren-delay' seconds of Emacs idle time."
60 (> (prefix-numeric-value arg
) 0)
61 (not show-paren-mode
))))
62 (setq blink-matching-paren-on-screen
(not on-p
))
63 (and show-paren-idle-timer
(cancel-timer show-paren-idle-timer
))
65 (setq show-paren-idle-timer
(run-with-idle-timer show-paren-delay t
66 'show-paren-function
))
67 (and show-paren-overlay
(overlay-buffer show-paren-overlay
)
68 (delete-overlay show-paren-overlay
))
69 (and show-paren-overlay-1
(overlay-buffer show-paren-overlay-1
)
70 (delete-overlay show-paren-overlay-1
)))
71 (setq show-paren-mode on-p
))))
73 ;; Find the place to show, if there is one,
74 ;; and show it until input arrives.
75 (defun show-paren-function ()
76 ;; Do nothing if no window system to display results with.
77 ;; Do nothing if executing keyboard macro.
78 ;; Do nothing if input is pending.
80 (let (pos dir mismatch
(oldpos (point))
81 (face show-paren-face
))
82 (cond ((eq (char-syntax (preceding-char)) ?\
))
84 ((eq (char-syntax (following-char)) ?\
()
89 ;; Determine the range within which to look for a match.
90 (if blink-matching-paren-distance
91 (narrow-to-region (max (point-min)
92 (- (point) blink-matching-paren-distance
))
94 (+ (point) blink-matching-paren-distance
))))
95 ;; Scan across one sexp within that range.
96 ;; Errors or nil mean there is a mismatch.
98 (setq pos
(scan-sexps (point) dir
))
101 ;; If found a "matching" paren, see if it is the right
102 ;; kind of paren to match the one we started at.
104 (let ((beg (min pos oldpos
)) (end (max pos oldpos
)))
105 (and (/= (char-syntax (char-after beg
)) ?\$
)
107 (not (eq (char-before end
)
108 ;; This can give nil.
109 (matching-paren (char-after beg
))))))))
110 ;; If they don't properly match, use a different face,
111 ;; or print a message.
114 (and (null show-paren-mismatch-face
)
117 (add-to-list 'facemenu-unlisted-faces
119 (make-face 'paren-mismatch
)
120 (or (face-nontrivial-p 'paren-mismatch t
)
122 (set-face-background 'paren-mismatch
124 (set-face-foreground 'paren-mismatch
126 (setq show-paren-mismatch-face
'paren-mismatch
)))
127 (if show-paren-mismatch-face
128 (setq face show-paren-mismatch-face
)
129 (message "Paren mismatch"))))
133 (not (integerp pos
)))
134 ;; If matching backwards, highlight the closeparen
135 ;; before point as well as its matching open.
136 ;; If matching forward, and the openparen is unbalanced,
137 ;; highlight the paren at point to indicate misbalance.
138 (let ((from (if (= dir
1)
144 (if show-paren-overlay-1
145 (move-overlay show-paren-overlay-1
148 (setq show-paren-overlay-1
149 (make-overlay from to
)))
150 ;; Always set the overlay face, since it varies.
151 (overlay-put show-paren-overlay-1
'face face
))
152 ;; Otherwise, turn off any such highlighting.
153 (and show-paren-overlay-1
154 (overlay-buffer show-paren-overlay-1
)
155 (delete-overlay show-paren-overlay-1
)))
156 ;; Turn on highlighting for the matching paren, if found.
157 ;; If it's an unmatched paren, turn off any such highlighting.
158 (or (and (not (integerp pos
))
159 (delete-overlay show-paren-overlay
))
162 (if show-paren-overlay
163 (move-overlay show-paren-overlay
164 (forward-point (- dir
))
167 (setq show-paren-overlay
168 (make-overlay (forward-point (- dir
)) pos
)))))
169 ;; Always set the overlay face, since it varies.
170 (overlay-put show-paren-overlay
'face face
))
172 ;; If not at a paren that has a match,
173 ;; turn off any previous paren highlighting.
174 (and show-paren-overlay
(overlay-buffer show-paren-overlay
)
175 (delete-overlay show-paren-overlay
))
176 (and show-paren-overlay-1
(overlay-buffer show-paren-overlay-1
)
177 (delete-overlay show-paren-overlay-1
)))))))
179 ;;; For back compatibility we turn ourselves on if we're dumped or loaded.
180 (add-hook 'window-setup-hook
'(lambda () (show-paren-mode t
)))
185 ;;; paren.el ends here