comparison lisp/paren.el @ 3912:676fb29d1692

Initial revision
author Jim Blandy <jimb@redhat.com>
date Mon, 28 Jun 1993 23:41:38 +0000
parents
children d0f9cd48e8f6
comparison
equal deleted inserted replaced
3911:06dbadd0e4a7 3912:676fb29d1692
1 ;;; paren.el --- highlight matching paren.
2 ;; Copyright (C) 1993 Software Foundation, Inc.
3
4 ;; This file is part of GNU Emacs.
5
6 ;; GNU Emacs is free software; you can redistribute it and/or modify
7 ;; it under the terms of the GNU General Public License as published by
8 ;; the Free Software Foundation; either version 2, or (at your option)
9 ;; any later version.
10
11 ;; GNU Emacs is distributed in the hope that it will be useful,
12 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
13 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 ;; GNU General Public License for more details.
15
16 ;; You should have received a copy of the GNU General Public License
17 ;; along with GNU Emacs; see the file COPYING. If not, write to
18 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
19
20 ;;; Commentary:
21
22 ;; Load this and it will display highlighting on whatever
23 ;; paren matches the one before or after point.
24
25 ;;; Code:
26
27 (defvar blink-paren-overlay nil)
28
29 ;; Find the place to blink, if there is one,
30 ;; and blink it until input arrives.
31 (defun blink-paren-command-hook ()
32 (let (pos dir mismatch (oldpos (point))
33 (face (if (face-equal 'highlight 'region)
34 'underline 'highlight)))
35 (cond ((eq (char-syntax (following-char)) ?\()
36 (setq dir 1))
37 ((eq (char-syntax (preceding-char)) ?\))
38 (setq dir -1)))
39 (save-excursion
40 (save-restriction
41 ;; Determine the range within which to look for a match.
42 (if blink-matching-paren-distance
43 (narrow-to-region (max (point-min)
44 (- (point) blink-matching-paren-distance))
45 (min (point-max)
46 (+ (point) blink-matching-paren-distance))))
47 ;; Scan across one sexp within that range.
48 (condition-case ()
49 (setq pos (scan-sexps (point) dir))
50 (error nil))
51 ;; See if the "matching" paren is the right kind of paren
52 ;; to match the one we started at.
53 (if pos
54 (let ((beg (min pos oldpos)) (end (max pos oldpos)))
55 (and (/= (char-syntax (char-after beg)) ?\$)
56 (setq mismatch
57 (/= (char-after (1- end))
58 (logand (lsh (aref (syntax-table)
59 (char-after beg))
60 -8)
61 255))))))
62 ;; If they don't properly match, don't blink.
63 (if mismatch
64 (setq pos nil))))
65 (cond (pos
66 (if blink-paren-overlay
67 (move-overlay blink-paren-overlay (- pos dir) pos)
68 (setq blink-paren-overlay
69 (make-overlay (- pos dir) pos)))
70 (overlay-put blink-paren-overlay 'face face)
71 ;;; This is code to blink the highlighting.
72 ;;; It is desirable to avoid this because
73 ;;; it would interfere with auto-save and gc when idle.
74 ;;; (while (sit-for 1)
75 ;;; (overlay-put blink-paren-overlay
76 ;;; 'face
77 ;;; (if (overlay-get blink-paren-overlay
78 ;;; 'face)
79 ;;; nil face)))
80 )
81 (t
82 (delete-overlay blink-paren-overlay)))))
83
84 (add-hook 'post-command-hook 'blink-paren-command-hook)
85