--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/packages/blink-paren.el	Mon Aug 13 08:45:50 2007 +0200
@@ -0,0 +1,180 @@
+;;; blink-paren.el --- blink the matching paren, just like Zmacs
+;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
+
+;; Author: devin@lucid.com.
+;; Keywords: faces
+
+;; This file is part of XEmacs.
+
+;; XEmacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XEmacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the Free
+;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
+
+;;; Synched up with: Not in FSF.
+
+(defvar blink-paren-timeout 0.2
+  "*If the cursor is on a parenthesis, the matching parenthesis will blink.
+This variable controls how long each phase of the blink lasts in seconds.
+This should be a fractional part of a second (a float.)")
+
+(defvar highlight-paren-expression nil
+  "*If true, highlight the whole expression of the paren under the cursor
+instead of blinking (or highlighting) the matching paren.  This will highlight
+the expression using the `highlight-expression' face.")
+
+;;; The blinking paren alternates between the faces blink-paren-on and
+;;; blink-paren-off.  The default is for -on to look just like default
+;;; text, and -off to be invisible.  You can change this so that, for
+;;; example, the blinking paren fluctuates between bold and italic...
+;;;
+;;; You can make the matching paren merely be highlighted (and not blink)
+;;; by setting the blink-paren-on and blink-paren-off faces to have the same
+;;; attributes; if you do this, then emacs will not consume as much CPU.
+;;;
+;;; If highlight-paren-expression is true, then the whole sexp between the
+;;; parens will be displayed in the `highlight-expression' face instead.
+
+(make-face 'blink-paren-on)
+(make-face 'blink-paren-off)
+(make-face 'highlight-expression)
+
+;; extent used to change the face of the matching paren
+(defvar blink-paren-extent nil)
+
+;; timeout to blink the face
+(defvar blink-paren-timeout-id nil)
+
+;; find if we should look foward or backward to find the matching paren
+(defun blink-paren-sexp-dir ()
+  (cond ((and (< (point) (point-max))
+	      (eq (char-syntax (char-after (point))) ?\())
+	 1)
+	((and (> (point) (point-min))
+	      (eq (char-syntax (char-after (- (point) 1))) ?\)))
+	 -1)
+	(t ())))
+
+;; make an extent on the matching paren if any.  return it.
+(defun blink-paren-make-extent ()
+  (let ((dir (blink-paren-sexp-dir)))
+    (and dir
+	 (condition-case ()
+	     (let* ((parse-sexp-ignore-comments t)
+		    (other-pos (let ((pmin (point-min))
+				     (pmax (point-max))
+				     (point (point)))
+				 (unwind-protect
+				     (progn
+				       (narrow-to-region
+					(max pmin (- point blink-matching-paren-distance))
+					(min pmax (+ point blink-matching-paren-distance)))
+				       (forward-sexp dir) (point))
+				   (narrow-to-region pmin pmax)
+				   (goto-char point))))
+		    (extent (if (= dir 1)
+				(make-extent (if highlight-paren-expression
+						 (point)
+					       (- other-pos 1))
+					     other-pos)
+			      (make-extent other-pos
+					   (if highlight-paren-expression
+					       (point)
+					     (+ other-pos 1))))))
+	       (set-extent-face extent (if highlight-paren-expression
+					   'highlight-expression
+					 'blink-paren-on))
+	       extent)
+	   (error nil)))))
+
+;; callback for the timeout
+;; swap the face of the extent on the matching paren
+(defun blink-paren-timeout (arg)
+  ;; The extent could have been deleted for some reason and not point to a
+  ;; buffer anymore.  So catch any error to remove the timeout.
+  (condition-case ()
+      (set-extent-face blink-paren-extent 
+		       (if (eq (extent-face blink-paren-extent)
+			       'blink-paren-on)
+			   'blink-paren-off
+			 'blink-paren-on))
+    (error (blink-paren-pre-command))))
+
+;; called after each command is executed in the post-command-hook
+;; add the extent and the time-out if we are on a paren.
+(defun blink-paren-post-command ()
+  (blink-paren-pre-command)
+  (if (and (setq blink-paren-extent (blink-paren-make-extent))
+	   (not highlight-paren-expression)
+	   (not (and (face-equal 'blink-paren-on 'blink-paren-off)
+		     (progn
+		       (set-extent-face blink-paren-extent 'blink-paren-on)
+		       t)))
+	   (or (floatp blink-paren-timeout)
+	       (integerp blink-paren-timeout)))
+      (setq blink-paren-timeout-id
+	    (add-timeout blink-paren-timeout 'blink-paren-timeout ()
+			 blink-paren-timeout))))
+
+;; called before a new command is executed in the pre-command-hook
+;; cleanup by removing the extent and the time-out
+(defun blink-paren-pre-command ()
+  (condition-case c  ; don't ever signal an error in pre-command-hook!
+      (let ((inhibit-quit t))
+	(if blink-paren-timeout-id
+	    (disable-timeout (prog1 blink-paren-timeout-id
+			       (setq blink-paren-timeout-id nil))))
+	(if blink-paren-extent
+	    (delete-extent (prog1 blink-paren-extent
+			     (setq blink-paren-extent nil)))))
+    (error
+     (message "blink paren error! %s" c))))
+
+
+(defun blink-paren (&optional arg)
+  "Toggles paren blinking on and off.
+With a positive argument, turns it on.
+With a non-positive argument, turns it off."
+  (interactive "P")
+  (let* ((was-on (not (not (memq 'blink-paren-pre-command pre-command-hook))))
+	 (on-p (if (null arg)
+		   (not was-on)
+		(> (prefix-numeric-value arg) 0))))
+    (cond (on-p
+
+	   ;; in case blink paren was dumped, this needs to be setup
+	   (or (face-differs-from-default-p 'blink-paren-off)
+	       (progn
+		 (set-face-background 'blink-paren-off (face-background 'default))
+		 (set-face-foreground 'blink-paren-off (face-background 'default))))
+
+	   (or (face-differs-from-default-p 'highlight-expression)
+	       (set-face-underline-p 'highlight-expression t))
+	   
+	   (add-hook 'pre-command-hook 'blink-paren-pre-command)
+	   (add-hook 'post-command-hook 'blink-paren-post-command)
+	   (setq blink-matching-paren nil))
+	  (t
+	   (remove-hook 'pre-command-hook 'blink-paren-pre-command)
+	   (remove-hook 'post-command-hook 'blink-paren-post-command)
+	   (and blink-paren-extent (detach-extent blink-paren-extent))
+	   (setq blink-matching-paren t)))
+    on-p))
+
+(defun blink-paren-init ()
+  "obsolete - use `blink-paren' instead."
+  (interactive)
+  (blink-paren 1))
+
+(provide 'blink-paren)
+
+(blink-paren 1)