home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / gnu / lucid / lemacs-19.6 / lisp / packages / blink-paren.el < prev    next >
Encoding:
Text File  |  1993-02-17  |  4.3 KB  |  120 lines
  1. ;; Blink the matching paren, just like Zmacs.  By devin@lucid.com.
  2. ;; Copyright (C) 1992-1993 Free Software Foundation, Inc.
  3.  
  4. ;; This file is part of GNU Emacs.
  5.  
  6. ;; GNU Emacs is free software; you can redistribute it and/or modify
  7. ;; it under the terms of the GNU General Public License as published by
  8. ;; the Free Software Foundation; either version 2, or (at your option)
  9. ;; any later version.
  10.  
  11. ;; GNU Emacs is distributed in the hope that it will be useful,
  12. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  13. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14. ;; GNU General Public License for more details.
  15.  
  16. ;; You should have received a copy of the GNU General Public License
  17. ;; along with GNU Emacs; see the file COPYING.  If not, write to
  18. ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  19.  
  20. (defvar blink-paren-timeout 0.2
  21.   "*If the cursor is on a parenthesis, the matching parenthesis will blink.
  22. This variable controls how long each phase of the blink lasts in seconds.
  23. This should be a fractional part of a second (a float.)")
  24.  
  25.  
  26. ;;; The blinking paren alternates between the faces blink-paren-on and
  27. ;;; blink-paren-off.  The default is for -on to look just like default
  28. ;;; text, and -off to be invisible.  You can change this so that, for
  29. ;;; example, the blinking paren fluctuates between bold and italic...
  30.  
  31. (make-face 'blink-paren-on)
  32. (make-face 'blink-paren-off)
  33.  
  34. (or (face-differs-from-default-p 'blink-paren-off)
  35.     (progn
  36.       (set-face-background 'blink-paren-off (face-background 'default))
  37.       (set-face-foreground 'blink-paren-off (face-background 'default))))
  38.  
  39.  
  40. ;; extent used to change the face of the matching paren
  41. (defvar blink-paren-extent ())
  42.  
  43. ;; timeout to blink the face
  44. (defvar blink-paren-timeout-id ())
  45.  
  46. ;; find if we should look foward or backward to find the matching paren
  47. (defun blink-paren-sexp-dir ()
  48.   (cond ((and (< (point) (point-max))
  49.           (eq (char-syntax (char-after (point))) ?\())
  50.      1)
  51.     ((and (> (point) (point-min))
  52.           (eq (char-syntax (char-after (- (point) 1))) ?\)))
  53.      -1)
  54.     (t ())))
  55.  
  56. ;; make an extent on the matching paren if any.  return it.
  57. (defun blink-paren-make-extent ()
  58.   (let ((dir (blink-paren-sexp-dir)))
  59.     (and dir
  60.      (condition-case ()
  61.          (let* ((other-pos (save-excursion (forward-sexp dir) (point)))
  62.             (extent (if (= dir 1)
  63.                 (make-extent (- other-pos 1) other-pos)
  64.                   (make-extent other-pos (+ other-pos 1)))))
  65.            (set-extent-face extent 'blink-paren-on)
  66.            extent)
  67.        (error nil)))))
  68.  
  69. ;; callback for the timeout
  70. ;; swap the face of the extent on the matching paren
  71. (defun blink-paren-timeout (arg)
  72.   ;; The extent could have been deleted for some reason and not point to a
  73.   ;; buffer anymore.  So catch any error to remove the timeout.
  74.   (condition-case ()
  75.       (set-extent-face blink-paren-extent 
  76.                (if (eq (extent-face blink-paren-extent)
  77.                    'blink-paren-on)
  78.                'blink-paren-off
  79.              'blink-paren-on))
  80.     (error (blink-paren-pre-command))))
  81.  
  82. ;; called after each command is executed in the post-command-hook
  83. ;; add the extent and the time-out if we are on a paren.
  84. (defun blink-paren-post-command ()
  85.   (blink-paren-pre-command)
  86.   (if (and (setq blink-paren-extent (blink-paren-make-extent))
  87.        (not (and (face-equal 'blink-paren-on 'blink-paren-off)
  88.              (progn
  89.                (set-extent-face blink-paren-extent 'blink-paren-on)
  90.                t)))
  91.        (or (floatp blink-paren-timeout)
  92.            (integerp blink-paren-timeout)))
  93.       (setq blink-paren-timeout-id
  94.         (add-timeout blink-paren-timeout 'blink-paren-timeout ()
  95.              blink-paren-timeout))))
  96.  
  97. ;; called before a new command is executed in the pre-command-hook
  98. ;; cleanup by removing the extent and the time-out
  99. (defun blink-paren-pre-command ()
  100.   (condition-case c  ; don't ever signal an error in pre-command-hook!
  101.       (let ((inhibit-quit t))
  102.     (if blink-paren-timeout-id
  103.         (disable-timeout (prog1 blink-paren-timeout-id
  104.                    (setq blink-paren-timeout-id nil))))
  105.     (if blink-paren-extent
  106.         (delete-extent (prog1 blink-paren-extent
  107.                  (setq blink-paren-extent nil)))))
  108.     (error
  109.      (message "blink paren error! %s" c))))
  110.  
  111.  
  112. (defun blink-paren-init ()
  113.   (add-hook 'pre-command-hook 'blink-paren-pre-command)
  114.   (add-hook 'post-command-hook 'blink-paren-post-command)
  115.   (setq blink-matching-paren nil)  ; don't need this loser any more
  116.   )
  117.  
  118. ;; go go go johnny go
  119. (blink-paren-init)
  120.