|
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
|
|
124
|
57 (defcustom paren-message-offscreen t
|
|
|
58 "*Display message if matching open paren is offscreen."
|
|
|
59 :type 'boolean
|
|
126
|
60 :group 'paren-matching)
|
|
124
|
61
|
|
|
62 (defcustom paren-ding-unmatched nil
|
|
0
|
63 "*Make noise if the cursor is at an unmatched paren.
|
|
|
64
|
|
|
65 If T, then typing or passing over an unmatched paren will ring the bell
|
|
|
66 using the `paren' sound. If NIL, then the bell will not ring even if an
|
|
|
67 unmatched paren is typed. If neither T or NIL, then the bell will not ring
|
|
124
|
68 when the cursor moves over unmatched parens but will ring if one is typed."
|
|
|
69 :type '(choice (const :tag "off" nil)
|
|
|
70 (const :tag "on" t)
|
|
|
71 (const :tag "other" other))
|
|
126
|
72 :group 'paren-matching)
|
|
0
|
73
|
|
|
74 ;;;###autoload
|
|
124
|
75 (defcustom paren-mode nil
|
|
0
|
76 "*Sets the style of parenthesis highlighting.
|
|
|
77 Valid values are nil, `blink-paren', `paren', and `sexp'.
|
|
|
78 nil no parenthesis highlighting.
|
|
|
79 blink-paren causes the matching paren to blink.
|
|
|
80 paren causes the matching paren to be highlighted but not to blink.
|
|
|
81 sexp whole expression enclosed by the local paren at its mate.
|
|
|
82 nested (not yet implemented) use variable shading to see the
|
|
|
83 nesting of an expression. Also groks regular expressions
|
|
|
84 and shell quoting.
|
|
|
85
|
|
|
86 This variable is global by default, but you can make it buffer-local and
|
|
124
|
87 highlight parentheses differently in different major modes."
|
|
|
88 :type '(radio (const nil) (const blink-paren) (const paren)
|
|
|
89 (const sexp) (const nested))
|
|
126
|
90 :group 'paren-matching)
|
|
0
|
91
|
|
|
92 (make-face 'paren-match)
|
|
|
93 (or (face-differs-from-default-p 'paren-match)
|
|
|
94 (copy-face 'highlight 'paren-match))
|
|
|
95
|
|
|
96 (make-face 'paren-mismatch)
|
|
|
97 (cond ((face-differs-from-default-p 'paren-mismatch) nil)
|
|
|
98 (t (let ((color-tag (list 'x 'color))
|
|
|
99 (mono-tag (list 'x 'mono))
|
|
|
100 (gray-tag (list 'x 'grayscale)))
|
|
|
101 (set-face-background 'paren-mismatch "DeepPink" 'global color-tag)
|
|
|
102 (set-face-reverse-p 'paren-mismatch t 'global 'tty)
|
|
|
103 (set-face-background 'paren-mismatch [modeline background] 'global
|
|
|
104 mono-tag)
|
|
|
105 (set-face-foreground 'paren-mismatch [modeline foreground] 'global
|
|
|
106 mono-tag)
|
|
|
107 (set-face-background 'paren-mismatch [modeline background] 'global
|
|
|
108 gray-tag)
|
|
|
109 (set-face-foreground 'paren-mismatch [modeline foreground] 'global
|
|
|
110 gray-tag))))
|
|
|
111
|
|
|
112 (make-face 'paren-blink-off)
|
|
|
113 (or (face-differs-from-default-p 'paren-blink-off)
|
|
|
114 (set-face-foreground 'paren-blink-off (face-background 'default)))
|
|
|
115
|
|
|
116 ;; this is either paren-match or paren-mismatch...
|
|
|
117 (defvar paren-blink-on-face nil)
|
|
|
118
|
|
|
119 (defvar paren-blink-interval 0.2
|
|
|
120 "*If the cursor is on a parenthesis, the matching parenthesis will blink.
|
|
|
121 This variable controls how long each phase of the blink lasts in seconds.
|
|
|
122 This should be a fractional part of a second (a float.)")
|
|
|
123
|
|
|
124 (defvar paren-max-blinks (* 5 60 5) ; 5 minutes is plenty...
|
|
|
125 ;; idea from Eric Eide <eeide@jaguar.cs.utah.edu>
|
|
|
126 "*Maximum number of times that a matching parenthesis will blink.
|
|
|
127 Set this to NIL if you want indefinite blinking.")
|
|
|
128
|
|
|
129 ;; timeout to blink the face
|
|
|
130 (defvar paren-timeout-id nil)
|
|
|
131
|
|
|
132 ;; Code:
|
|
|
133
|
|
|
134 (defvar paren-n-blinks)
|
|
|
135 (defvar paren-extent nil)
|
|
|
136
|
|
|
137 ;; used to suppress messages from the same position so that other messages
|
|
|
138 ;; can be seen in the modeline.
|
|
|
139 (make-variable-buffer-local
|
|
|
140 (defvar paren-message-suppress nil))
|
|
|
141
|
|
|
142 (defsubst pos-visible-in-window-safe (pos)
|
|
|
143 "safe version of pos-visible-in-window-p"
|
|
|
144 (condition-case nil
|
|
|
145 ;; #### - is this needed in XEmacs???
|
|
|
146 (pos-visible-in-window-p pos)
|
|
|
147 (args-out-of-range nil)))
|
|
|
148
|
|
|
149 ;; called before a new command is executed in the pre-command-hook
|
|
|
150 ;; cleanup by removing the extent and the time-out
|
|
|
151 (defun paren-nuke-extent ()
|
|
|
152 (condition-case c ; don't ever signal an error in pre-command-hook!
|
|
|
153 (let ((inhibit-quit t))
|
|
|
154 (if paren-timeout-id
|
|
|
155 (disable-timeout (prog1 paren-timeout-id
|
|
|
156 (setq paren-timeout-id nil))))
|
|
|
157 (if paren-extent
|
|
|
158 (delete-extent (prog1 paren-extent
|
|
|
159 (setq paren-extent nil)))))
|
|
|
160 (error
|
|
|
161 (message "paren-nuke-extent error! %s" c))))
|
|
|
162
|
|
|
163 ;; callback for the timeout
|
|
|
164 ;; swap the face of the extent on the matching paren
|
|
|
165 (defun paren-blink-timeout (arg)
|
|
|
166 ;; The extent could have been deleted for some reason and not point to a
|
|
|
167 ;; buffer anymore. So catch any error to remove the timeout.
|
|
|
168 (condition-case ()
|
|
|
169 (if (and paren-max-blinks
|
|
|
170 (> (setq paren-n-blinks (1+ paren-n-blinks)) paren-max-blinks))
|
|
|
171 (paren-nuke-extent)
|
|
|
172 (set-extent-face paren-extent
|
|
|
173 (if (eq (extent-face paren-extent)
|
|
|
174 paren-blink-on-face)
|
|
|
175 'paren-blink-off
|
|
|
176 paren-blink-on-face)))
|
|
|
177 (error (paren-nuke-extent))))
|
|
|
178
|
|
|
179
|
|
|
180 (defun paren-describe-match (pos mismatch)
|
|
|
181 (or (window-minibuffer-p (selected-window))
|
|
|
182 (save-excursion
|
|
|
183 (goto-char pos)
|
|
|
184 (message "%s %s"
|
|
|
185 (if mismatch "MISMATCH:" "Matches")
|
|
|
186 ;; if there's stuff on this line preceding the paren, then
|
|
|
187 ;; display text from beginning of line to paren.
|
|
|
188 ;;
|
|
|
189 ;; If, however, the paren is at the beginning of a line, then
|
|
|
190 ;; skip whitespace forward and display text from paren to end
|
|
|
191 ;; of the next line containing nonspace text.
|
|
|
192 ;;
|
|
|
193 ;; If paren-backwards-message gravity were implemented, then
|
|
|
194 ;; perhaps it would reverse this behavior and look to the
|
|
|
195 ;; previous line for meaningful context.
|
|
|
196 (if (save-excursion
|
|
|
197 (skip-chars-backward " \t")
|
|
|
198 (not (bolp)))
|
|
|
199 (concat (buffer-substring
|
|
|
200 (progn (beginning-of-line) (point))
|
|
|
201 (1+ pos)) "...")
|
|
|
202 (buffer-substring
|
|
|
203 pos (progn
|
|
|
204 (forward-char 1)
|
|
|
205 (skip-chars-forward "\n \t")
|
|
|
206 (end-of-line)
|
|
|
207 (point))))))))
|
|
|
208
|
|
|
209 (defun paren-maybe-ding ()
|
|
|
210 (and (or (eq paren-ding-unmatched t)
|
|
|
211 (and paren-ding-unmatched
|
|
|
212 (eq this-command 'self-insert-command)))
|
|
|
213 (progn
|
|
|
214 (message "Unmatched parenthesis.")
|
|
|
215 (ding nil 'paren))))
|
|
|
216
|
|
|
217 ;; Find the place to show, if there is one,
|
|
|
218 ;; and show it until input arrives.
|
|
|
219 (defun paren-highlight ()
|
|
|
220 "This highlights matching parentheses.
|
|
|
221
|
|
|
222 See the variables:
|
|
|
223 paren-message-offscreen use modeline when matchingparen is offscreen?
|
|
|
224 paren-ding-unmatched make noise when passing over mismatched parens?
|
|
|
225 paren-mode 'blink-paren, 'paren, or 'sexp
|
|
|
226 blink-matching-paren-distance maximum distance to search for parens.
|
|
|
227
|
|
|
228 and the following faces:
|
|
|
229 paren-match, paren-mismatch, paren-blink-off"
|
|
|
230
|
|
|
231 ;; I suppose I could check here to see if a keyboard macro is executing,
|
|
|
232 ;; but I did a quick empirical check and couldn't tell that there was any
|
|
|
233 ;; difference in performance
|
|
|
234
|
|
|
235 (let ((oldpos (point))
|
|
|
236 (pface nil) ; face for paren...nil kills the overlay
|
|
|
237 (dir (and paren-mode
|
|
|
238 (not (input-pending-p))
|
|
|
239 (not executing-kbd-macro)
|
|
|
240 (cond ((eq (char-syntax (preceding-char)) ?\))
|
|
|
241 -1)
|
|
|
242 ((eq (char-syntax (following-char)) ?\()
|
|
|
243 1))))
|
|
|
244 pos mismatch)
|
|
|
245
|
|
|
246 (save-excursion
|
|
|
247 (if (or (not dir)
|
|
|
248 (not (save-restriction
|
|
|
249 ;; Determine the range within which to look for a match.
|
|
|
250 (if blink-matching-paren-distance
|
|
|
251 (narrow-to-region
|
|
|
252 (max (point-min)
|
|
|
253 (- (point) blink-matching-paren-distance))
|
|
|
254 (min (point-max)
|
|
|
255 (+ (point) blink-matching-paren-distance))))
|
|
|
256
|
|
|
257 ;; Scan across one sexp within that range.
|
|
|
258 (condition-case nil
|
|
|
259 (setq pos (scan-sexps (point) dir))
|
|
|
260 ;; NOTE - if blink-matching-paren-distance is set,
|
|
|
261 ;; then we can have spurious unmatched parens.
|
|
|
262 (error (paren-maybe-ding)
|
|
|
263 nil)))))
|
|
|
264
|
|
|
265 ;; do nothing if we didn't find a matching paren...
|
|
|
266 nil
|
|
|
267
|
|
|
268 ;; See if the "matching" paren is the right kind of paren
|
|
|
269 ;; to match the one we started at.
|
|
|
270 (let ((beg (min pos oldpos)) (end (max pos oldpos)))
|
|
|
271 (setq mismatch
|
|
|
272 (and (/= (char-syntax (char-after beg)) ?\\)
|
|
|
273 (/= (char-syntax (char-after beg)) ?\$)
|
|
24
|
274 ;; XEmacs change
|
|
100
|
275 (matching-paren (char-after beg))
|
|
0
|
276 (/= (char-after (1- end))
|
|
70
|
277 (matching-paren (char-after beg)))))
|
|
0
|
278 (if (eq paren-mode 'sexp)
|
|
|
279 (setq paren-extent (make-extent beg end))))
|
|
|
280 (and mismatch
|
|
|
281 (paren-maybe-ding))
|
|
|
282 (setq pface (if mismatch
|
|
|
283 'paren-mismatch
|
|
|
284 'paren-match))
|
|
|
285 (and (memq paren-mode '(blink-paren paren))
|
|
|
286 (setq paren-extent (make-extent (- pos dir) pos)))
|
|
|
287
|
|
|
288 (if (and paren-message-offscreen
|
|
|
289 (eq dir -1)
|
|
|
290 (not (eq paren-message-suppress (point)))
|
|
|
291 (not (window-minibuffer-p (selected-window)))
|
|
|
292 (not (pos-visible-in-window-safe pos)))
|
|
|
293 (progn
|
|
|
294 (setq paren-message-suppress (point))
|
|
|
295 (paren-describe-match pos mismatch))
|
|
|
296 (setq paren-message-suppress nil))
|
|
|
297
|
|
|
298 ;; put the right face on the extent
|
|
|
299 (cond (pface
|
|
|
300 (set-extent-face paren-extent pface)
|
|
|
301 (set-extent-priority paren-extent 100) ; want this to be high
|
|
|
302 (and (eq paren-mode 'blink-paren)
|
|
|
303 (setq paren-blink-on-face pface
|
|
|
304 paren-n-blinks 0
|
|
|
305 paren-timeout-id
|
|
|
306 (and paren-blink-interval
|
|
|
307 (add-timeout paren-blink-interval
|
|
|
308 'paren-blink-timeout
|
|
|
309 nil
|
|
|
310 paren-blink-interval))))))
|
|
|
311 ))))
|
|
|
312
|
|
|
313 ;; kill off the competition, er, uh, eliminate redundancy...
|
|
|
314 (setq post-command-hook (delq 'show-paren-command-hook post-command-hook))
|
|
|
315 (setq pre-command-hook (delq 'blink-paren-pre-command pre-command-hook))
|
|
|
316 (setq post-command-hook (delq 'blink-paren-post-command post-command-hook))
|
|
|
317
|
|
|
318 ;;;###autoload
|
|
|
319 (defun paren-set-mode (arg &optional quiet)
|
|
|
320 "Cycles through possible values for `paren-mode', force off with negative arg.
|
|
108
|
321 When called from lisp, a symbolic value for `paren-mode' can be passed directly.
|
|
0
|
322 See also `paren-mode' and `paren-highlight'."
|
|
|
323 (interactive "P")
|
|
|
324 (let* ((paren-modes '(blink-paren paren sexp))
|
|
|
325 (paren-next-modes (cons nil (append paren-modes (list nil)))))
|
|
|
326 (setq paren-mode (if (and (numberp arg) (< arg 0))
|
|
|
327 nil ; turn paren highlighting off
|
|
|
328 (cond ((and arg (symbolp arg)) arg)
|
|
|
329 ((and (numberp arg) (> arg 0))
|
|
|
330 (nth (1- arg) paren-modes))
|
|
|
331 ((numberp arg) nil)
|
|
|
332 (t (car (cdr (memq paren-mode
|
|
|
333 paren-next-modes)))))
|
|
|
334 )))
|
|
|
335 (cond (paren-mode
|
|
|
336 (add-hook 'post-command-hook 'paren-highlight)
|
|
|
337 (add-hook 'pre-command-hook 'paren-nuke-extent)
|
|
|
338 (setq blink-matching-paren nil))
|
|
|
339 ((not (local-variable-p 'paren-mode (current-buffer)))
|
|
|
340 (remove-hook 'post-command-hook 'paren-highlight)
|
|
|
341 (remove-hook 'pre-command-hook 'paren-nuke-extent)
|
|
|
342 (paren-nuke-extent) ; overkill
|
|
|
343 (setq blink-matching-paren t)
|
|
|
344 ))
|
|
|
345 (or quiet (message "Paren mode is %s" (or paren-mode "OFF"))))
|
|
|
346
|
|
|
347 (eval-when-compile
|
|
|
348 ;; suppress compiler warning.
|
|
|
349 (defvar highlight-paren-expression))
|
|
|
350
|
|
|
351 (paren-set-mode (if (and (boundp 'highlight-paren-expression)
|
|
|
352 ;; bletcherous blink-paren no-naming-convention
|
|
|
353 highlight-paren-expression)
|
|
|
354 'sexp
|
|
|
355 (if (eq 'x (device-type (selected-device)))
|
|
|
356 'blink-paren
|
|
|
357 'paren))
|
|
|
358 t)
|
|
|
359
|
|
|
360 ;;;###autoload
|
|
|
361 (make-obsolete 'blink-paren 'paren-set-mode)
|
|
|
362
|
|
|
363 ;;;###autoload
|
|
|
364 (defun blink-paren (&optional arg)
|
|
|
365 "Obsolete. Use `paren-set-mode' instead."
|
|
|
366 (interactive "P")
|
|
|
367 (paren-set-mode (if (and (numberp arg) (> arg 0))
|
|
|
368 'blink-paren -1) t))
|
|
|
369
|
|
|
370 (provide 'blink-paren)
|
|
|
371 (provide 'paren)
|
|
|
372
|
|
|
373 ;; Local Variables:
|
|
|
374 ;; byte-optimize: t
|
|
|
375 ;; End:
|
|
|
376
|
|
|
377 ;;; paren.el ends here
|
