;; Blink the matching paren, just like Zmacs.  By devin@lucid.com.
;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.

;; This file is part of GNU Emacs.

;; GNU Emacs 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.

;; GNU Emacs 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 GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

(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.)")

;;;###autoload
(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)

(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))

;; 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 (save-excursion (forward-sexp dir) (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))))


;;;###autoload
(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 ((eq on-p was-on)
	   nil)
	  (on-p
	   (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."
  (blink-paren 1))

(provide 'blink-paren)

(blink-paren 1)