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