Mercurial > hg > xemacs-beta

comparison lisp/packages/mic-paren.el @ 72:b9518feda344 r20-0b31

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r20-0b31
author cvs
date Mon, 13 Aug 2007 09:03:46 +0200
parents 27bc7f280385
children bcdc7deadc19
comparison
equal deleted inserted replaced
71:bae944334fa4 72:b9518feda344
1 ;;; mic-paren.el --- highlight matching paren.
2 ;;; Version 1.0 - 96-08-16
3 ;;; Copyright (C) 1996 Mikael Sjödin (mic@docs.uu.se)
4 ;;;
5 ;;; Author: Mikael Sjödin -- mic@docs.uu.se
6 ;;; Keywords: languages, faces
7 ;;;
8 ;;; This file is NOT part of GNU Emacs.
9 ;;; You may however redistribute it and/or modify it under the terms of the GNU
10 ;;; General Public License as published by the Free Software Foundation; either
11 ;;; version 2, or (at your option) any later version.
12 ;;;
13 ;;; mic-paren is distributed in the hope that it will be useful,
14 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 ;;; GNU General Public License for more details.
17
18 ;;; ----------------------------------------------------------------------
19 ;;; Short Description:
20 ;;;
21 ;;; Load this file and Emacs will display highlighting on whatever
22 ;;; parenthesis matches the one before or after point. This is an extension to
23 ;;; the paren.el file distributed with Emacs. The default behaviour is similar
24 ;;; to paren.el but try the authors favourite options:
25 ;;; (setq paren-face 'bold)
26 ;;; (setq paren-sexp-mode t)
27
28 ;;; ----------------------------------------------------------------------
29 ;;; Installation:
30 ;;;
31 ;;; o Place this file in a directory in your 'load-path.
32 ;;; o Put the following in your .emacs file:
33 ;;; (if window-system
34 ;;; (require 'mic-paren))
35 ;;; o Restart your Emacs. mic-paren is now installed and activated!
36 ;;; o To list the possible customisation enter `C-h f paren-activate'
37
38 ;;; ----------------------------------------------------------------------
39 ;;; Long Description:
40 ;;;
41 ;;; mic-paren.el is an extension to the packages paren.el and stig-paren.el for
42 ;;; Emacs. When mic-paren is active (it is activated when loaded) Emacs normal
43 ;;; parenthesis matching is deactivated. Instead parenthesis matching will be
44 ;;; performed as soon as the cursor is positioned at a parenthesis. The
45 ;;; matching parenthesis (or the entire expression between the parenthesises)
46 ;;; is highlighted until the cursor is moved away from the parenthesis.
47 ;;; Features include:
48 ;;; o Both forward and backward parenthesis matching (_simultaneously_ if
49 ;;; cursor is between two expressions).
50 ;;; o Indication of mismatched parenthesises.
51 ;;; o Option to select if only the matching parenthesis or the entire
52 ;;; expression should be highlighted.
53 ;;; o Message describing the match when the matching parenthesis is
54 ;;; off-screen.
55 ;;; o Optional delayed highlighting (useful on slow systems),
56 ;;; o Functions to activate/deactivate mic-paren.el is provided.
57 ;;; o Numerous options to control the behaviour and appearance of
58 ;;; mic-paren.el.
59 ;;;
60 ;;; mic-paren.el is developed and tested under Emacs 19.28 - 19.31. It should
61 ;;; work on earlier and forthcoming Emacs versions.
62 ;;;
63 ;;; This file can be obtained from http://www.docs.uu.se/~mic/emacs.html
64
65 ;; Ported to XEmacs 15-September, 1996 Steve Baur <steve@miranova.com>
66 ;;; ======================================================================
67 ;;; User Options:
68
69 (defvar paren-priority nil
70 "*Defines the behaviour of mic-paren when point is between a closing and an
71 opening parenthesis.
72
73 A value of 'close means highlight the parenthesis matching the
74 close-parenthesis before the point.
75
76 A value of 'open means highlight the parenthesis matching the open-parenthesis
77 after the point.
78
79 Any other value means highlight both parenthesis matching the parenthesis
80 beside the point.")
81
82
83 ;;; ------------------------------
84
85 (defvar paren-sexp-mode nil
86 "*If nil only the matching parenthesis is highlighted.
87 If non-nil the whole s-expression between the matching parenthesis is
88 highlighted.")
89
90 ;;; ------------------------------
91
92 (defvar paren-highlight-at-point t
93 "*If non-nil and point is after a close parenthesis, both the close and
94 open parenthesis is highlighted. If nil, only the open parenthesis is
95 highlighted.")
96
97 ;;; ------------------------------
98
99 (defvar paren-highlight-offscreen nil
100 "*If non-nil stig-paren will highlight text which is not visible in the
101 current buffer.
102
103 This is useful if you regularly display the current buffer in multiple windows
104 or frames. For instance if you use follow-mode (by andersl@csd.uu.se), however
105 it may slow down your Emacs.
106
107 (This variable is ignored (treated as non-nil) if you set paren-sexp-mode to
108 non-nil.)")
109
110 ;;; ------------------------------
111
112 (defvar paren-message-offscreen t
113 "*Display message if matching parenthesis is off-screen.")
114
115 ;;; ------------------------------
116
117 (defvar paren-message-no-match t
118 "*Display message if no matching parenthesis is found.")
119
120 ;;; ------------------------------
121
122 (defvar paren-ding-unmatched nil
123 "*Make noise if the cursor is at an unmatched parenthesis or no matching
124 parenthesis is found.
125
126 Even if nil, typing an unmatched parenthesis produces a ding.")
127
128 ;;; ------------------------------
129
130 (defvar paren-delay nil
131 "*This variable controls when highlighting is done. The variable has
132 different meaning in different versions of Emacs.
133
134 In Emacs 19.29 and below:
135 This variable is ignored.
136
137 In Emacs 19.30:
138 A value of nil will make highlighting happen immediately (this may slow down
139 your Emacs if running on a slow system). Any non-nil value will delay
140 highlighting for the time specified by post-command-idle-delay.
141
142 In Emacs 19.31 and above:
143 A value of nil will make highlighting happen immediately (this may slow down
144 your Emacs if running on a slow system). If not nil, the value should be a
145 number (possible a floating point number if your Emacs support floating point
146 numbers). The number is the delay before mic-paren performs highlighting.
147
148 If you change this variable when mic-paren is active you have to re-activate
149 (with M-x paren-activate) mic-paren for the change to take effect.")
150
151
152 ;;; ------------------------------
153
154 (defvar paren-dont-touch-blink nil
155 "*If non-nil mic-paren will not change the value of blink-matching-paren when
156 activated of deactivated.
157
158 If nil mic-paren turns of blinking when activated and turns on blinking when
159 deactivated.")
160
161 ;;; ------------------------------
162
163 (defvar paren-dont-activate-on-load nil
164 "*If non-nil mic-paren will not activate itself when loaded.")
165
166 ;;; ------------------------------
167
168 (defvar paren-face (if (x-display-color-p) 'highlight 'underline)
169 "*Face to use for showing the matching parenthesis.")
170
171 ;;; ------------------------------
172
173 (defvar paren-mismatch-face (if (x-display-color-p)
174 (let ((fn 'paren-mismatch-face))
175 (copy-face 'default fn)
176 (set-face-background fn "DeepPink")
177 fn)
178 'modeline)
179 "*Face to use when highlighting a mismatched parenthesis.")
180
181 ;;; ======================================================================
182 ;;; User Functions:
183
184 ;; XEmacs compatibility
185 (eval-and-compile
186 (if (fboundp 'make-extent)
187 (progn
188 (fset 'mic-make-overlay 'make-extent)
189 (fset 'mic-delete-overlay 'delete-extent)
190 (fset 'mic-overlay-put 'set-extent-property)
191 (defun mic-cancel-timer (timer) (delete-itimer timer))
192 (defun mic-run-with-idle-timer (secs repeat function &rest args)
193 (start-itimer "mic-paren-idle" function secs nil))
194 )
195 (fset 'mic-make-overlay 'make-overlay)
196 (fset 'mic-delete-overlay 'delete-overlay)
197 (fset 'mic-overlay-put 'overlay-put)
198 (fset 'mic-cancel-timer 'cancel-timer)
199 (fset 'mic-run-with-idle-timer 'run-with-idle-timer)
200 ))
201
202
203 (defun paren-activate ()
204 "Activates mic-paren parenthesis highlighting.
205 paren-activate deactivates the paren.el and stig-paren.el packages if they are
206 active
207 Options:
208 paren-priority
209 paren-sexp-mode
210 paren-highlight-at-point
211 paren-highlight-offscreen
212 paren-message-offscreen
213 paren-message-no-match
214 paren-ding-unmatched
215 paren-delay
216 paren-dont-touch-blink
217 paren-dont-activate-on-load
218 paren-face
219 paren-mismatch-face"
220 (interactive)
221 ;; Deactivate mic-paren.el (To remove redundant hooks)
222 (paren-deactivate)
223 ;; Deactivate paren.el if loaded
224 (if (boundp 'post-command-idle-hook)
225 (remove-hook 'post-command-idle-hook 'show-paren-command-hook))
226 (remove-hook 'post-command-hook 'show-paren-command-hook)
227 (and (boundp 'show-paren-overlay)
228 show-paren-overlay
229 (mic-delete-overlay show-paren-overlay))
230 (and (boundp 'show-paren-overlay-1)
231 show-paren-overlay-1
232 (mic-delete-overlay show-paren-overlay-1))
233 ;; Deactivate stig-paren.el if loaded
234 (if (boundp 'post-command-idle-hook)
235 (remove-hook 'post-command-idle-hook 'stig-paren-command-hook))
236 (remove-hook 'post-command-hook 'stig-paren-command-hook)
237 (remove-hook 'post-command-hook 'stig-paren-safe-command-hook)
238 (remove-hook 'pre-command-hook 'stig-paren-delete-overlay)
239 ;; Deactivate Emacs standard parenthesis blinking
240 (or paren-dont-touch-blink
241 (setq blink-matching-paren nil))
242
243 (cond
244 ;; If timers are available use them
245 ;; (Emacs 19.31 and above)
246 ((or (featurep 'timer) (featurep 'itimer))
247 (if (numberp paren-delay)
248 (setq mic-paren-idle-timer
249 (mic-run-with-idle-timer paren-delay t
250 'mic-paren-command-idle-hook))
251 (add-hook 'post-command-hook 'mic-paren-command-hook)))
252 ;; If the idle hook exists assume it is functioning and use it
253 ;; (Emacs 19.30)
254 ((and (boundp 'post-command-idle-hook)
255 (boundp 'post-command-idle-delay))
256 (if paren-delay
257 (add-hook 'post-command-idle-hook 'mic-paren-command-idle-hook)
258 (add-hook 'post-command-hook 'mic-paren-command-hook)))
259 ;; Check if we (at least) have a post-comand-hook, and use it
260 ;; (Emacs 19.29 and below)
261 ((boundp 'post-command-hook)
262 (add-hook 'post-command-hook 'mic-paren-command-hook))
263 ;; Not possible to install mic-paren hooks
264 (t (error "Cannot activate mic-paren in this Emacs version"))))
265
266
267
268 (defun paren-deactivate ()
269 "Deactivates mic-paren parenthesis highlighting"
270 (interactive)
271 ;; Deactivate (don't bother to check where/if mic-paren is acivte, just
272 ;; delete all possible hooks and timers)
273 (if (boundp 'post-command-idle-hook)
274 (remove-hook 'post-command-idle-hook 'mic-paren-command-idle-hook))
275 (if mic-paren-idle-timer
276 (mic-cancel-timer mic-paren-idle-timer))
277 (remove-hook 'post-command-hook 'mic-paren-command-hook)
278
279 ;; Remove any old highlighs
280 (mic-delete-overlay mic-paren-backw-overlay)
281 (mic-delete-overlay mic-paren-point-overlay)
282 (mic-delete-overlay mic-paren-forw-overlay)
283
284 ;; Reactivate Emacs standard parenthesis blinking
285 (or paren-dont-touch-blink
286 (setq blink-matching-paren t))
287 )
288
289 ;;; ======================================================================
290 ;;; Internal variables:
291
292 (defvar mic-paren-backw-overlay (mic-make-overlay (point-min) (point-min))
293 "Overlay for the open-paren which matches the close-paren before
294 point. When in sexp-mode this is the overlay for the expression before point.")
295
296 (defvar mic-paren-point-overlay (mic-make-overlay (point-min) (point-min))
297 "Overlay for the close-paren before point.
298 (Not used when is sexp-mode.)")
299
300 (defvar mic-paren-forw-overlay (mic-make-overlay (point-min) (point-min))
301 "Overlay for the close-paren which matches the open-paren after
302 point. When in sexp-mode this is the overlay for the expression after point.")
303
304 (defvar mic-paren-idle-timer nil
305 "Idle-timer. Used only in Emacs 19.31 and above (and if paren-delay is nil)")
306
307
308
309
310 ;;; ======================================================================
311 ;;; Internal function:
312
313
314
315 (defun mic-paren-command-hook ()
316 (or executing-kbd-macro
317 (input-pending-p) ;[This might cause trouble since the
318 ; function is unreliable]
319 (condition-case paren-error
320 (mic-paren-highligt)
321 (error
322 (if (not (window-minibuffer-p (selected-window)))
323 (message "mic-paren catched error (please report): %s"
324 paren-error))))))
325
326 (defun mic-paren-command-idle-hook ()
327 (condition-case paren-error
328 (mic-paren-highligt)
329 (error
330 (if (not (window-minibuffer-p (selected-window)))
331 (message "mic-paren catched error (please report): %s"
332 paren-error)))))
333
334
335 (defun mic-paren-highligt ()
336 "The main-function of mic-paren. Does all highlighting, dinging, messages,
337 cleaning-up."
338 ;; Remove any old highlighting
339 (mic-delete-overlay mic-paren-forw-overlay)
340 (mic-delete-overlay mic-paren-point-overlay)
341 (mic-delete-overlay mic-paren-backw-overlay)
342
343 ;; Handle backward highlighting (when after a close-paren):
344 ;; If positioned after a close-paren, and
345 ;; not before an open-paren when priority=open, and
346 ;; the close-paren is not escaped then
347 ;; perform highlighting
348 ;; else
349 ;; remove any old backward highlights
350 (if (and (eq (char-syntax (preceding-char)) ?\))
351 (not (and (eq (char-syntax (following-char)) ?\()
352 (eq paren-priority 'open)))
353 (paren-evenp (paren-backslashes-before-char (1- (point)))))
354 (let (open)
355 ;; Find the position for the open-paren
356 (save-excursion
357 (save-restriction
358 (if blink-matching-paren-distance
359 (narrow-to-region
360 (max (point-min)
361 (- (point) blink-matching-paren-distance))
362 (point-max)))
363 (condition-case ()
364 (setq open (scan-sexps (point) -1))
365 (error nil))))
366
367 ;; If match found
368 ;; highlight and/or print messages
369 ;; else
370 ;; print no-match message
371 ;; remove any old highlights
372 (if open
373 (let ((mismatch (/= (matching-paren (preceding-char))
374 (char-after open)))
375 (visible (pos-visible-in-window-p open)))
376 ;; If highlight is appropriate
377 ;; highligt
378 ;; else
379 ;; remove any old highlight
380 (if (or visible paren-highlight-offscreen paren-sexp-mode)
381 ;; If sexp-mode
382 ;; highlight sexp
383 ;; else
384 ;; highlight the two parens
385 (if paren-sexp-mode
386 (progn
387 (setq mic-paren-backw-overlay
388 (mic-make-overlay open (point)))
389 (if mismatch
390 (mic-overlay-put mic-paren-backw-overlay
391 'face paren-mismatch-face)
392 (mic-overlay-put mic-paren-backw-overlay
393 'face paren-face)))
394 (setq mic-paren-backw-overlay
395 (mic-make-overlay open (1+ open)))
396 (and paren-highlight-at-point
397 (setq mic-paren-point-overlay
398 (mic-make-overlay (1- (point)) (point))))
399 (if mismatch
400 (progn
401 (mic-overlay-put mic-paren-backw-overlay
402 'face paren-mismatch-face)
403 (and paren-highlight-at-point
404 (mic-overlay-put mic-paren-point-overlay
405 'face paren-mismatch-face)))
406 (mic-overlay-put mic-paren-backw-overlay
407 'face paren-face)
408 (and paren-highlight-at-point
409 (mic-overlay-put mic-paren-point-overlay
410 'face paren-face)))))
411 ;; Print messages if match is offscreen
412 (and paren-message-offscreen
413 (not visible)
414 (not (window-minibuffer-p (selected-window)))
415 (message "%s %s"
416 (if mismatch "MISMATCH:" "Matches")
417 (mic-paren-get-matching-open-text open)))
418 ;; Ding if mismatch
419 (and mismatch
420 paren-ding-unmatched
421 (ding)))
422 (and paren-message-no-match
423 (not (window-minibuffer-p (selected-window)))
424 (message "No opening parenthesis found"))
425 (and paren-message-no-match
426 paren-ding-unmatched
427 (ding)))))
428
429 ;; Handle forward highlighting (when before an open-paren):
430 ;; If positioned before an open-paren, and
431 ;; not after a close-paren when priority=close, and
432 ;; the open-paren is not escaped then
433 ;; perform highlighting
434 ;; else
435 ;; remove any old forward highlights
436 (if (and (eq (char-syntax (following-char)) ?\()
437 (not (and (eq (char-syntax (preceding-char)) ?\))
438 (eq paren-priority 'close)))
439 (paren-evenp (paren-backslashes-before-char (point))))
440 (let (close)
441 ;; Find the position for the close-paren
442 (save-excursion
443 (save-restriction
444 (if blink-matching-paren-distance
445 (narrow-to-region
446 (point-min)
447 (min (point-max)
448 (+ (point) blink-matching-paren-distance))))
449 (condition-case ()
450 (setq close (scan-sexps (point) 1))
451 (error nil))))
452 ;; If match found
453 ;; highlight and/or print messages
454 ;; else
455 ;; print no-match message
456 ;; remove any old highlights
457 (if close
458 (let ((mismatch (/= (matching-paren (following-char))
459 (char-after (1- close))))
460 (visible (pos-visible-in-window-p close)))
461 ;; If highlight is appropriate
462 ;; highligt
463 ;; else
464 ;; remove any old highlight
465 (if (or visible paren-highlight-offscreen paren-sexp-mode)
466 ;; If sexp-mode
467 ;; highlight sexp
468 ;; else
469 ;; highlight the two parens
470 (if paren-sexp-mode
471 (progn
472 (setq mic-paren-forw-overlay
473 (mic-make-overlay (point) close))
474 (if mismatch
475 (mic-overlay-put mic-paren-forw-overlay
476 'face paren-mismatch-face)
477 (mic-overlay-put mic-paren-forw-overlay
478 'face paren-face)))
479 (setq mic-paren-forw-overlay
480 (mic-make-overlay (1- close) close))
481 (if mismatch
482 (mic-overlay-put mic-paren-forw-overlay
483 'face paren-mismatch-face)
484 (mic-overlay-put mic-paren-forw-overlay
485 'face paren-face))))
486
487 ;; Print messages if match is offscreen
488 (and paren-message-offscreen
489 (not visible)
490 (not (window-minibuffer-p (selected-window)))
491 (message "%s %s"
492 (if mismatch "MISMATCH:" "Matches")
493 (mic-paren-get-matching-close-text close)))
494 ;; Ding if mismatch
495 (and mismatch
496 paren-ding-unmatched
497 (ding)))
498 (and paren-message-no-match
499 (not (window-minibuffer-p (selected-window)))
500 (message "No closing parenthesis found"))
501 (and paren-message-no-match
502 paren-ding-unmatched
503 (ding))))))
504
505 ;;; --------------------------------------------------
506
507 (defun mic-paren-get-matching-open-text (open)
508 "Returns a string with the context around OPEN-paren."
509 ;; If there's stuff on this line preceding the paren, then display text from
510 ;; beginning of line to paren.
511 ;;
512 ;; If, however, the paren is at the beginning of a line, then skip whitespace
513 ;; forward and display text from paren to end of the next line containing
514 ;; non-space text.
515 ;;
516 ;; (Same as in stig-paren.el)
517 (save-excursion
518 (goto-char open)
519 (if (save-excursion
520 (skip-chars-backward " \t")
521 (not (bolp)))
522 (progn
523 (beginning-of-line)
524 (concat (buffer-substring (point) (1+ open)) "..."))
525 (forward-char 1) ;From the beginning-of-line
526 (skip-chars-forward "\n \t")
527 (end-of-line)
528 (buffer-substring open (point)))))
529
530
531 (defun mic-paren-get-matching-close-text (close)
532 "Returns a string with the context around CLOSE-paren."
533 ;; The whole line up until the close-paren with "..." appended if there are
534 ;; more text after the close-paren
535 (save-excursion
536 (goto-char close)
537 (beginning-of-line)
538 (concat
539 (buffer-substring (point) close)
540 (progn
541 (goto-char close)
542 (if (looking-at "[ \t]*$")
543 ""
544 "...")))))
545
546
547 (defun paren-evenp (number)
548 "Returns t if NUMBER is an even number, nil otherwise"
549 (eq 0 (% number 2)))
550
551 (defun paren-backslashes-before-char (pnt)
552 (setq pnt (1- pnt))
553 (let ((n 0))
554 (while (and (>= pnt (point-min))
555 (eq (char-syntax (char-after pnt)) ?\\))
556 (setq n (1+ n))
557 (setq pnt (1- pnt)))
558 n))
559
560
561
562 ;;; ======================================================================
563 ;;; Initialisation when loading:
564
565
566 (or paren-dont-activate-on-load
567 (paren-activate))
568
569 ;;; This is in case mic-paren.el is preloaded. [Does this work? /Mic]
570 (add-hook 'window-setup-hook
571 (function (lambda ()
572 (and window-system
573 (not paren-dont-activate-on-load)
574 (paren-activate)))))
575
576 (provide 'mic-paren)
577 (provide 'paren)