|
0
|
1 ;;; paren.el --- highlight (un)matching parens and whole expressions
|
|
|
2
|
|
|
3 ;; Copyright (C) 1993 Free Software Foundation, Inc.
|
|
|
4 ;; Copyright (C) 1993, 1994, 1995 Tinker Systems
|
|
|
5 ;;
|
|
|
6 ;; Author: Jonathan Stigelman <Stig@hackvan.com>
|
|
|
7 ;; Note: (some code scammed from simple.el and blink-paren.el)
|
|
|
8 ;; Maintainer: Jonathan Stigelman <Stig@hackvan.com>
|
|
|
9 ;; Keywords: languages, faces
|
|
|
10
|
|
|
11 ;;; This file is part of XEmacs.
|
|
|
12 ;;;
|
|
|
13 ;;; XEmacs is free software; you can redistribute it and/or modify
|
|
|
14 ;;; it under the terms of the GNU General Public License as published by
|
|
|
15 ;;; the Free Software Foundation; either version 2 of the License, or
|
|
|
16 ;;; (at your option) any later version.
|
|
|
17 ;;;
|
|
|
18 ;;; XEmacs is distributed in the hope that it will be useful,
|
|
|
19 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
20 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|
|
21 ;;; GNU General Public License for more details.
|
|
|
22 ;;;
|
|
|
23 ;;; You should have received a copy of the GNU General Public License
|
|
|
24 ;;; along with XEmacs; if not, write to the Free Software
|
|
|
25 ;;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
26
|
|
|
27 ;;; Synched up with: Not synched with FSF.
|
|
|
28 ;;; Way different from FSF.
|
|
|
29
|
|
|
30 ;;; Commentary:
|
|
|
31
|
|
|
32 ;; Purpose of this package:
|
|
|
33 ;;
|
|
|
34 ;; This package highlights matching parens (or whole sexps) for easier
|
|
|
35 ;; editing of source code, particularly lisp source code.
|
|
|
36 ;;
|
|
|
37 ;; The `paren-highlight' hook function runs after each command and
|
|
|
38 ;; checks to see if the cursor is at a parenthesis. If so, then it
|
|
|
39 ;; highlights, in one of several ways, the matching parenthesis.
|
|
|
40 ;;
|
|
|
41 ;; Priority is given to matching parentheses right before the cursor because
|
|
|
42 ;; that's what makes sense when you're typing a lot of closed parentheses.
|
|
|
43 ;;
|
|
|
44 ;; This is especially intuitive if you frequently use forward-sexp (M-C-f)
|
|
|
45 ;; and backward-sexp (M-C-b) to maneuver around in source code.
|
|
|
46 ;;
|
|
|
47 ;; Different faces are used for matching and mismatching parens so that it
|
|
|
48 ;; is easier to see mistakes as you type them. Audible feedback is optional.
|
|
|
49 ;;
|
|
|
50 ;; If a (mis)matching paren is offscreen, then a message is sent to the modeline.
|
|
|
51 ;;
|
|
|
52 ;; If paren-mode is `sexp', entire S-expressions are highlighted instead of
|
|
|
53 ;; just matching parens.
|
|
|
54
|
|
|
55 ;;; Code:
|
|
|
56
|
|
|
57 (defvar paren-message-offscreen t
|
|
|
58 "*Display message if matching open paren is offscreen.")
|
|
|
59
|
|
|
60 (defvar paren-ding-unmatched nil
|
|
|
61 "*Make noise if the cursor is at an unmatched paren.
|
|
|
62
|
|
|
63 If T, then typing or passing over an unmatched paren will ring the bell
|
|
|
64 using the `paren' sound. If NIL, then the bell will not ring even if an
|
|
|
65 unmatched paren is typed. If neither T or NIL, then the bell will not ring
|
|
|
66 when the cursor moves over unmatched parens but will ring if one is typed.")
|
|
|
67
|
|
|
68 ;;;###autoload
|
|
|
69 (defvar paren-mode nil
|
|
|
70 "*Sets the style of parenthesis highlighting.
|
|
|
71 Valid values are nil, `blink-paren', `paren', and `sexp'.
|
|
|
72 nil no parenthesis highlighting.
|
|
|
73 blink-paren causes the matching paren to blink.
|
|
|
74 paren causes the matching paren to be highlighted but not to blink.
|
|
|
75 sexp whole expression enclosed by the local paren at its mate.
|
|
|
76 nested (not yet implemented) use variable shading to see the
|
|
|
77 nesting of an expression. Also groks regular expressions
|
|
|
78 and shell quoting.
|
|
|
79
|
|
|
80 This variable is global by default, but you can make it buffer-local and
|
|
70
|
81 highlight parentheses differrently in different major modes.")
|
|
0
|
82
|
|
|
83 (make-face 'paren-match)
|
|
|
84 (or (face-differs-from-default-p 'paren-match)
|
|
|
85 (copy-face 'highlight 'paren-match))
|
|
|
86
|
|
|
87 (make-face 'paren-mismatch)
|
|
|
88 (cond ((face-differs-from-default-p 'paren-mismatch) nil)
|
|
|
89 (t (let ((color-tag (list 'x 'color))
|
|
|
90 (mono-tag (list 'x 'mono))
|
|
|
91 (gray-tag (list 'x 'grayscale)))
|
|
|
92 (set-face-background 'paren-mismatch "DeepPink" 'global color-tag)
|
|
|
93 (set-face-reverse-p 'paren-mismatch t 'global 'tty)
|
|
|
94 (set-face-background 'paren-mismatch [modeline background] 'global
|
|
|
95 mono-tag)
|
|
|
96 (set-face-foreground 'paren-mismatch [modeline foreground] 'global
|
|
|
97 mono-tag)
|
|
|
98 (set-face-background 'paren-mismatch [modeline background] 'global
|
|
|
99 gray-tag)
|
|
|
100 (set-face-foreground 'paren-mismatch [modeline foreground] 'global
|
|
|
101 gray-tag))))
|
|
|
102
|
|
|
103 (make-face 'paren-blink-off)
|
|
|
104 (or (face-differs-from-default-p 'paren-blink-off)
|
|
|
105 (set-face-foreground 'paren-blink-off (face-background 'default)))
|
|
|
106
|
|
|
107 ;; this is either paren-match or paren-mismatch...
|
|
|
108 (defvar paren-blink-on-face nil)
|
|
|
109
|
|
|
110 (defvar paren-blink-interval 0.2
|
|
|
111 "*If the cursor is on a parenthesis, the matching parenthesis will blink.
|
|
|
112 This variable controls how long each phase of the blink lasts in seconds.
|
|
|
113 This should be a fractional part of a second (a float.)")
|
|
|
114
|
|
|
115 (defvar paren-max-blinks (* 5 60 5) ; 5 minutes is plenty...
|
|
|
116 ;; idea from Eric Eide <eeide@jaguar.cs.utah.edu>
|
|
|
117 "*Maximum number of times that a matching parenthesis will blink.
|
|
|
118 Set this to NIL if you want indefinite blinking.")
|
|
|
119
|
|
|
120 ;; timeout to blink the face
|
|
|
121 (defvar paren-timeout-id nil)
|
|
|
122
|
|
|
123 ;; Code:
|
|
|
124
|
|
|
125 (defvar paren-n-blinks)
|
|
|
126 (defvar paren-extent nil)
|
|
|
127
|
|
|
128 ;; used to suppress messages from the same position so that other messages
|
|
|
129 ;; can be seen in the modeline.
|
|
|
130 (make-variable-buffer-local
|
|
|
131 (defvar paren-message-suppress nil))
|
|
|
132
|
|
|
133 (defsubst pos-visible-in-window-safe (pos)
|
|
|
134 "safe version of pos-visible-in-window-p"
|
|
|
135 (condition-case nil
|
|
|
136 ;; #### - is this needed in XEmacs???
|
|
|
137 (pos-visible-in-window-p pos)
|
|
|
138 (args-out-of-range nil)))
|
|
|
139
|
|
|
140 ;; called before a new command is executed in the pre-command-hook
|
|
|
141 ;; cleanup by removing the extent and the time-out
|
|
|
142 (defun paren-nuke-extent ()
|
|
|
143 (condition-case c ; don't ever signal an error in pre-command-hook!
|
|
|
144 (let ((inhibit-quit t))
|
|
|
145 (if paren-timeout-id
|
|
|
146 (disable-timeout (prog1 paren-timeout-id
|
|
|
147 (setq paren-timeout-id nil))))
|
|
|
148 (if paren-extent
|
|
|
149 (delete-extent (prog1 paren-extent
|
|
|
150 (setq paren-extent nil)))))
|
|
|
151 (error
|
|
|
152 (message "paren-nuke-extent error! %s" c))))
|
|
|
153
|
|
|
154 ;; callback for the timeout
|
|
|
155 ;; swap the face of the extent on the matching paren
|
|
|
156 (defun paren-blink-timeout (arg)
|
|
|
157 ;; The extent could have been deleted for some reason and not point to a
|
|
|
158 ;; buffer anymore. So catch any error to remove the timeout.
|
|
|
159 (condition-case ()
|
|
|
160 (if (and paren-max-blinks
|
|
|
161 (> (setq paren-n-blinks (1+ paren-n-blinks)) paren-max-blinks))
|
|
|
162 (paren-nuke-extent)
|
|
|
163 (set-extent-face paren-extent
|
|
|
164 (if (eq (extent-face paren-extent)
|
|
|
165 paren-blink-on-face)
|
|
|
166 'paren-blink-off
|
|
|
167 paren-blink-on-face)))
|
|
|
168 (error (paren-nuke-extent))))
|
|
|
169
|
|
|
170
|
|
|
171 (defun paren-describe-match (pos mismatch)
|
|
|
172 (or (window-minibuffer-p (selected-window))
|
|
|
173 (save-excursion
|
|
|
174 (goto-char pos)
|
|
|
175 (message "%s %s"
|
|
|
176 (if mismatch "MISMATCH:" "Matches")
|
|
|
177 ;; if there's stuff on this line preceding the paren, then
|
|
|
178 ;; display text from beginning of line to paren.
|
|
|
179 ;;
|
|
|
180 ;; If, however, the paren is at the beginning of a line, then
|
|
|
181 ;; skip whitespace forward and display text from paren to end
|
|
|
182 ;; of the next line containing nonspace text.
|
|
|
183 ;;
|
|
|
184 ;; If paren-backwards-message gravity were implemented, then
|
|
|
185 ;; perhaps it would reverse this behavior and look to the
|
|
|
186 ;; previous line for meaningful context.
|
|
|
187 (if (save-excursion
|
|
|
188 (skip-chars-backward " \t")
|
|
|
189 (not (bolp)))
|
|
|
190 (concat (buffer-substring
|
|
|
191 (progn (beginning-of-line) (point))
|
|
|
192 (1+ pos)) "...")
|
|
|
193 (buffer-substring
|
|
|
194 pos (progn
|
|
|
195 (forward-char 1)
|
|
|
196 (skip-chars-forward "\n \t")
|
|
|
197 (end-of-line)
|
|
|
198 (point))))))))
|
|
|
199
|
|
|
200 (defun paren-maybe-ding ()
|
|
|
201 (and (or (eq paren-ding-unmatched t)
|
|
|
202 (and paren-ding-unmatched
|
|
|
203 (eq this-command 'self-insert-command)))
|
|
|
204 (progn
|
|
|
205 (message "Unmatched parenthesis.")
|
|
|
206 (ding nil 'paren))))
|
|
|
207
|
|
|
208 ;; Find the place to show, if there is one,
|
|
|
209 ;; and show it until input arrives.
|
|
|
210 (defun paren-highlight ()
|
|
|
211 "This highlights matching parentheses.
|
|
|
212
|
|
|
213 See the variables:
|
|
|
214 paren-message-offscreen use modeline when matchingparen is offscreen?
|
|
|
215 paren-ding-unmatched make noise when passing over mismatched parens?
|
|
|
216 paren-mode 'blink-paren, 'paren, or 'sexp
|
|
|
217 blink-matching-paren-distance maximum distance to search for parens.
|
|
|
218
|
|
|
219 and the following faces:
|
|
|
220 paren-match, paren-mismatch, paren-blink-off"
|
|
|
221
|
|
|
222 ;; I suppose I could check here to see if a keyboard macro is executing,
|
|
|
223 ;; but I did a quick empirical check and couldn't tell that there was any
|
|
|
224 ;; difference in performance
|
|
|
225
|
|
|
226 (let ((oldpos (point))
|
|
|
227 (pface nil) ; face for paren...nil kills the overlay
|
|
|
228 (dir (and paren-mode
|
|
|
229 (not (input-pending-p))
|
|
|
230 (not executing-kbd-macro)
|
|
|
231 (cond ((eq (char-syntax (preceding-char)) ?\))
|
|
|
232 -1)
|
|
|
233 ((eq (char-syntax (following-char)) ?\()
|
|
|
234 1))))
|
|
|
235 pos mismatch)
|
|
|
236
|
|
|
237 (save-excursion
|
|
|
238 (if (or (not dir)
|
|
|
239 (not (save-restriction
|
|
|
240 ;; Determine the range within which to look for a match.
|
|
|
241 (if blink-matching-paren-distance
|
|
|
242 (narrow-to-region
|
|
|
243 (max (point-min)
|
|
|
244 (- (point) blink-matching-paren-distance))
|
|
|
245 (min (point-max)
|
|
|
246 (+ (point) blink-matching-paren-distance))))
|
|
|
247
|
|
|
248 ;; Scan across one sexp within that range.
|
|
|
249 (condition-case nil
|
|
|
250 (setq pos (scan-sexps (point) dir))
|
|
|
251 ;; NOTE - if blink-matching-paren-distance is set,
|
|
|
252 ;; then we can have spurious unmatched parens.
|
|
|
253 (error (paren-maybe-ding)
|
|
|
254 nil)))))
|
|
|
255
|
|
|
256 ;; do nothing if we didn't find a matching paren...
|
|
|
257 nil
|
|
|
258
|
|
|
259 ;; See if the "matching" paren is the right kind of paren
|
|
|
260 ;; to match the one we started at.
|
|
|
261 (let ((beg (min pos oldpos)) (end (max pos oldpos)))
|
|
|
262 (setq mismatch
|
|
|
263 (and (/= (char-syntax (char-after beg)) ?\\)
|
|
|
264 (/= (char-syntax (char-after beg)) ?\$)
|
|
24
|
265 ;; XEmacs change
|
|
0
|
266 (/= (char-after (1- end))
|
|
70
|
267 (matching-paren (char-after beg)))))
|
|
0
|
268 (if (eq paren-mode 'sexp)
|
|
|
269 (setq paren-extent (make-extent beg end))))
|
|
|
270 (and mismatch
|
|
|
271 (paren-maybe-ding))
|
|
|
272 (setq pface (if mismatch
|
|
|
273 'paren-mismatch
|
|
|
274 'paren-match))
|
|
|
275 (and (memq paren-mode '(blink-paren paren))
|
|
|
276 (setq paren-extent (make-extent (- pos dir) pos)))
|
|
|
277
|
|
|
278 (if (and paren-message-offscreen
|
|
|
279 (eq dir -1)
|
|
|
280 (not (eq paren-message-suppress (point)))
|
|
|
281 (not (window-minibuffer-p (selected-window)))
|
|
|
282 (not (pos-visible-in-window-safe pos)))
|
|
|
283 (progn
|
|
|
284 (setq paren-message-suppress (point))
|
|
|
285 (paren-describe-match pos mismatch))
|
|
|
286 (setq paren-message-suppress nil))
|
|
|
287
|
|
|
288 ;; put the right face on the extent
|
|
|
289 (cond (pface
|
|
|
290 (set-extent-face paren-extent pface)
|
|
|
291 (set-extent-priority paren-extent 100) ; want this to be high
|
|
|
292 (and (eq paren-mode 'blink-paren)
|
|
|
293 (setq paren-blink-on-face pface
|
|
|
294 paren-n-blinks 0
|
|
|
295 paren-timeout-id
|
|
|
296 (and paren-blink-interval
|
|
|
297 (add-timeout paren-blink-interval
|
|
|
298 'paren-blink-timeout
|
|
|
299 nil
|
|
|
300 paren-blink-interval))))))
|
|
|
301 ))))
|
|
|
302
|
|
|
303 ;; kill off the competition, er, uh, eliminate redundancy...
|
|
|
304 (setq post-command-hook (delq 'show-paren-command-hook post-command-hook))
|
|
|
305 (setq pre-command-hook (delq 'blink-paren-pre-command pre-command-hook))
|
|
|
306 (setq post-command-hook (delq 'blink-paren-post-command post-command-hook))
|
|
|
307
|
|
|
308 ;;;###autoload
|
|
|
309 (defun paren-set-mode (arg &optional quiet)
|
|
|
310 "Cycles through possible values for `paren-mode', force off with negative arg.
|
|
70
|
311 When called from lisp, a symbolic value for `paren-mode' can be pased directly.
|
|
0
|
312 See also `paren-mode' and `paren-highlight'."
|
|
|
313 (interactive "P")
|
|
|
314 (let* ((paren-modes '(blink-paren paren sexp))
|
|
|
315 (paren-next-modes (cons nil (append paren-modes (list nil)))))
|
|
|
316 (setq paren-mode (if (and (numberp arg) (< arg 0))
|
|
|
317 nil ; turn paren highlighting off
|
|
|
318 (cond ((and arg (symbolp arg)) arg)
|
|
|
319 ((and (numberp arg) (> arg 0))
|
|
|
320 (nth (1- arg) paren-modes))
|
|
|
321 ((numberp arg) nil)
|
|
|
322 (t (car (cdr (memq paren-mode
|
|
|
323 paren-next-modes)))))
|
|
|
324 )))
|
|
|
325 (cond (paren-mode
|
|
|
326 (add-hook 'post-command-hook 'paren-highlight)
|
|
|
327 (add-hook 'pre-command-hook 'paren-nuke-extent)
|
|
|
328 (setq blink-matching-paren nil))
|
|
|
329 ((not (local-variable-p 'paren-mode (current-buffer)))
|
|
|
330 (remove-hook 'post-command-hook 'paren-highlight)
|
|
|
331 (remove-hook 'pre-command-hook 'paren-nuke-extent)
|
|
|
332 (paren-nuke-extent) ; overkill
|
|
|
333 (setq blink-matching-paren t)
|
|
|
334 ))
|
|
|
335 (or quiet (message "Paren mode is %s" (or paren-mode "OFF"))))
|
|
|
336
|
|
|
337 (eval-when-compile
|
|
|
338 ;; suppress compiler warning.
|
|
|
339 (defvar highlight-paren-expression))
|
|
|
340
|
|
|
341 (paren-set-mode (if (and (boundp 'highlight-paren-expression)
|
|
|
342 ;; bletcherous blink-paren no-naming-convention
|
|
|
343 highlight-paren-expression)
|
|
|
344 'sexp
|
|
|
345 (if (eq 'x (device-type (selected-device)))
|
|
|
346 'blink-paren
|
|
|
347 'paren))
|
|
|
348 t)
|
|
|
349
|
|
|
350 ;;;###autoload
|
|
|
351 (make-obsolete 'blink-paren 'paren-set-mode)
|
|
|
352
|
|
|
353 ;;;###autoload
|
|
|
354 (defun blink-paren (&optional arg)
|
|
|
355 "Obsolete. Use `paren-set-mode' instead."
|
|
|
356 (interactive "P")
|
|
|
357 (paren-set-mode (if (and (numberp arg) (> arg 0))
|
|
|
358 'blink-paren -1) t))
|
|
|
359
|
|
|
360 (provide 'blink-paren)
|
|
|
361 (provide 'paren)
|
|
|
362
|
|
|
363 ;; Local Variables:
|
|
|
364 ;; byte-optimize: t
|
|
|
365 ;; End:
|
|
|
366
|
|
|
367 ;;; paren.el ends here
|
