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