Mercurial > hg > xemacs-beta

comparison lisp/packages/blink-paren.el @ 0:376386a54a3c r19-14

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r19-14
author cvs
date Mon, 13 Aug 2007 08:45:50 +0200
parents
children 0293115a14e9
comparison
equal deleted inserted replaced
-1:000000000000 0:376386a54a3c
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)