|
0
|
1 ;;; blink-paren.el --- blink the matching paren, just like Zmacs
|
|
|
2 ;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
|
|
|
3
|
|
|
4 ;; Author: devin@lucid.com.
|
|
|
5 ;; Keywords: faces
|
|
|
6
|
|
|
7 ;; This file is part of XEmacs.
|
|
|
8
|
|
|
9 ;; XEmacs is free software; you can redistribute it and/or modify it
|
|
|
10 ;; under the terms of the GNU General Public License as published by
|
|
|
11 ;; the Free Software Foundation; either version 2, or (at your option)
|
|
|
12 ;; any later version.
|
|
|
13
|
|
|
14 ;; XEmacs is distributed in the hope that it will be useful, but
|
|
|
15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
|
|
|
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
|
|
17 ;; General Public License for more details.
|
|
|
18
|
|
|
19 ;; You should have received a copy of the GNU General Public License
|
|
|
20 ;; along with XEmacs; see the file COPYING. If not, write to the Free
|
|
|
21 ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
|
|
|
22
|
|
|
23 ;;; Synched up with: Not in FSF.
|
|
|
24
|
|
|
25 (defvar blink-paren-timeout 0.2
|
|
|
26 "*If the cursor is on a parenthesis, the matching parenthesis will blink.
|
|
|
27 This variable controls how long each phase of the blink lasts in seconds.
|
|
|
28 This should be a fractional part of a second (a float.)")
|
|
|
29
|
|
|
30 (defvar highlight-paren-expression nil
|
|
|
31 "*If true, highlight the whole expression of the paren under the cursor
|
|
|
32 instead of blinking (or highlighting) the matching paren. This will highlight
|
|
|
33 the expression using the `highlight-expression' face.")
|
|
|
34
|
|
|
35 ;;; The blinking paren alternates between the faces blink-paren-on and
|
|
|
36 ;;; blink-paren-off. The default is for -on to look just like default
|
|
|
37 ;;; text, and -off to be invisible. You can change this so that, for
|
|
|
38 ;;; example, the blinking paren fluctuates between bold and italic...
|
|
|
39 ;;;
|
|
|
40 ;;; You can make the matching paren merely be highlighted (and not blink)
|
|
|
41 ;;; by setting the blink-paren-on and blink-paren-off faces to have the same
|
|
|
42 ;;; attributes; if you do this, then emacs will not consume as much CPU.
|
|
|
43 ;;;
|
|
|
44 ;;; If highlight-paren-expression is true, then the whole sexp between the
|
|
|
45 ;;; parens will be displayed in the `highlight-expression' face instead.
|
|
|
46
|
|
|
47 (make-face 'blink-paren-on)
|
|
|
48 (make-face 'blink-paren-off)
|
|
|
49 (make-face 'highlight-expression)
|
|
|
50
|
|
|
51 ;; extent used to change the face of the matching paren
|
|
|
52 (defvar blink-paren-extent nil)
|
|
|
53
|
|
|
54 ;; timeout to blink the face
|
|
|
55 (defvar blink-paren-timeout-id nil)
|
|
|
56
|
|
|
57 ;; find if we should look foward or backward to find the matching paren
|
|
|
58 (defun blink-paren-sexp-dir ()
|
|
|
59 (cond ((and (< (point) (point-max))
|
|
|
60 (eq (char-syntax (char-after (point))) ?\())
|
|
|
61 1)
|
|
|
62 ((and (> (point) (point-min))
|
|
|
63 (eq (char-syntax (char-after (- (point) 1))) ?\)))
|
|
|
64 -1)
|
|
|
65 (t ())))
|
|
|
66
|
|
|
67 ;; make an extent on the matching paren if any. return it.
|
|
|
68 (defun blink-paren-make-extent ()
|
|
|
69 (let ((dir (blink-paren-sexp-dir)))
|
|
|
70 (and dir
|
|
|
71 (condition-case ()
|
|
|
72 (let* ((parse-sexp-ignore-comments t)
|
|
|
73 (other-pos (let ((pmin (point-min))
|
|
|
74 (pmax (point-max))
|
|
|
75 (point (point)))
|
|
|
76 (unwind-protect
|
|
|
77 (progn
|
|
|
78 (narrow-to-region
|
|
|
79 (max pmin (- point blink-matching-paren-distance))
|
|
|
80 (min pmax (+ point blink-matching-paren-distance)))
|
|
|
81 (forward-sexp dir) (point))
|
|
|
82 (narrow-to-region pmin pmax)
|
|
|
83 (goto-char point))))
|
|
|
84 (extent (if (= dir 1)
|
|
|
85 (make-extent (if highlight-paren-expression
|
|
|
86 (point)
|
|
|
87 (- other-pos 1))
|
|
|
88 other-pos)
|
|
|
89 (make-extent other-pos
|
|
|
90 (if highlight-paren-expression
|
|
|
91 (point)
|
|
|
92 (+ other-pos 1))))))
|
|
|
93 (set-extent-face extent (if highlight-paren-expression
|
|
|
94 'highlight-expression
|
|
|
95 'blink-paren-on))
|
|
|
96 extent)
|
|
|
97 (error nil)))))
|
|
|
98
|
|
|
99 ;; callback for the timeout
|
|
|
100 ;; swap the face of the extent on the matching paren
|
|
|
101 (defun blink-paren-timeout (arg)
|
|
|
102 ;; The extent could have been deleted for some reason and not point to a
|
|
|
103 ;; buffer anymore. So catch any error to remove the timeout.
|
|
|
104 (condition-case ()
|
|
|
105 (set-extent-face blink-paren-extent
|
|
|
106 (if (eq (extent-face blink-paren-extent)
|
|
|
107 'blink-paren-on)
|
|
|
108 'blink-paren-off
|
|
|
109 'blink-paren-on))
|
|
|
110 (error (blink-paren-pre-command))))
|
|
|
111
|
|
|
112 ;; called after each command is executed in the post-command-hook
|
|
|
113 ;; add the extent and the time-out if we are on a paren.
|
|
|
114 (defun blink-paren-post-command ()
|
|
|
115 (blink-paren-pre-command)
|
|
|
116 (if (and (setq blink-paren-extent (blink-paren-make-extent))
|
|
|
117 (not highlight-paren-expression)
|
|
|
118 (not (and (face-equal 'blink-paren-on 'blink-paren-off)
|
|
|
119 (progn
|
|
|
120 (set-extent-face blink-paren-extent 'blink-paren-on)
|
|
|
121 t)))
|
|
|
122 (or (floatp blink-paren-timeout)
|
|
|
123 (integerp blink-paren-timeout)))
|
|
|
124 (setq blink-paren-timeout-id
|
|
|
125 (add-timeout blink-paren-timeout 'blink-paren-timeout ()
|
|
|
126 blink-paren-timeout))))
|
|
|
127
|
|
|
128 ;; called before a new command is executed in the pre-command-hook
|
|
|
129 ;; cleanup by removing the extent and the time-out
|
|
|
130 (defun blink-paren-pre-command ()
|
|
|
131 (condition-case c ; don't ever signal an error in pre-command-hook!
|
|
|
132 (let ((inhibit-quit t))
|
|
|
133 (if blink-paren-timeout-id
|
|
|
134 (disable-timeout (prog1 blink-paren-timeout-id
|
|
|
135 (setq blink-paren-timeout-id nil))))
|
|
|
136 (if blink-paren-extent
|
|
|
137 (delete-extent (prog1 blink-paren-extent
|
|
|
138 (setq blink-paren-extent nil)))))
|
|
|
139 (error
|
|
|
140 (message "blink paren error! %s" c))))
|
|
|
141
|
|
|
142
|
|
|
143 (defun blink-paren (&optional arg)
|
|
|
144 "Toggles paren blinking on and off.
|
|
|
145 With a positive argument, turns it on.
|
|
|
146 With a non-positive argument, turns it off."
|
|
|
147 (interactive "P")
|
|
|
148 (let* ((was-on (not (not (memq 'blink-paren-pre-command pre-command-hook))))
|
|
|
149 (on-p (if (null arg)
|
|
|
150 (not was-on)
|
|
|
151 (> (prefix-numeric-value arg) 0))))
|
|
|
152 (cond (on-p
|
|
|
153
|
|
|
154 ;; in case blink paren was dumped, this needs to be setup
|
|
|
155 (or (face-differs-from-default-p 'blink-paren-off)
|
|
|
156 (progn
|
|
|
157 (set-face-background 'blink-paren-off (face-background 'default))
|
|
|
158 (set-face-foreground 'blink-paren-off (face-background 'default))))
|
|
|
159
|
|
|
160 (or (face-differs-from-default-p 'highlight-expression)
|
|
|
161 (set-face-underline-p 'highlight-expression t))
|
|
|
162
|
|
|
163 (add-hook 'pre-command-hook 'blink-paren-pre-command)
|
|
|
164 (add-hook 'post-command-hook 'blink-paren-post-command)
|
|
|
165 (setq blink-matching-paren nil))
|
|
|
166 (t
|
|
|
167 (remove-hook 'pre-command-hook 'blink-paren-pre-command)
|
|
|
168 (remove-hook 'post-command-hook 'blink-paren-post-command)
|
|
|
169 (and blink-paren-extent (detach-extent blink-paren-extent))
|
|
|
170 (setq blink-matching-paren t)))
|
|
|
171 on-p))
|
|
|
172
|
|
|
173 (defun blink-paren-init ()
|
|
|
174 "obsolete - use `blink-paren' instead."
|
|
|
175 (interactive)
|
|
|
176 (blink-paren 1))
|
|
|
177
|
|
|
178 (provide 'blink-paren)
|
|
|
179
|
|
|
180 (blink-paren 1)
|
