lisp/paren.el

   1 ;;; paren.el --- highlight matching paren.
   2
   3 ;; Copyright (C) 1993 Free Software Foundation, Inc.
   4
   5 ;; Author: rms@gnu.ai.mit.edu
   6 ;; Maintainer: FSF
   7 ;; Keywords: languages, faces
   8
   9 ;; This file is part of GNU Emacs.
  10
  11 ;; GNU Emacs is free software; you can redistribute it and/or modify
  12 ;; it under the terms of the GNU General Public License as published by
  13 ;; the Free Software Foundation; either version 2, or (at your option)
  14 ;; any later version.
  15
  16 ;; GNU Emacs is distributed in the hope that it will be useful,
  17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  19 ;; GNU General Public License for more details.
  20
  21 ;; You should have received a copy of the GNU General Public License
  22 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  23 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  24 ;; Boston, MA 02111-1307, USA.
  25
  26 ;;; Commentary:
  27
  28 ;; Load this and it will display highlighting on whatever
  29 ;; paren matches the one before or after point.
  30
  31 ;;; Code:
  32
  33 ;; This is the overlay used to highlight the matching paren.
  34 (defvar show-paren-overlay nil)
  35 ;; This is the overlay used to highlight the closeparen
  36 ;; right before point.
  37 (defvar show-paren-overlay-1 nil)
  38
  39 (defvar show-paren-mismatch-face nil)
  40
  41 (defvar show-paren-face 'region
  42   "*Name of face to use for showing the matching paren.")
  43
  44 ;; Find the place to show, if there is one,
  45 ;; and show it until input arrives.
  46 (defun show-paren-command-hook ()
  47   ;; Do nothing if no window system to display results with.
  48   ;; Do nothing if executing keyboard macro.
  49   ;; Do nothing if input is pending.
  50   (if window-system
  51       (let (pos dir mismatch (oldpos (point))
  52                 (face show-paren-face))
  53         (cond ((eq (char-syntax (preceding-char)) ?\))
  54                (setq dir -1))
  55               ((eq (char-syntax (following-char)) ?\()
  56                (setq dir 1)))
  57         (if dir
  58             (save-excursion
  59               (save-restriction
  60                 ;; Determine the range within which to look for a match.
  61                 (if blink-matching-paren-distance
  62                     (narrow-to-region (max (point-min)
  63                                            (- (point) blink-matching-paren-distance))
  64                                       (min (point-max)
  65                                            (+ (point) blink-matching-paren-distance))))
  66                 ;; Scan across one sexp within that range.
  67                 (condition-case ()
  68                     (setq pos (scan-sexps (point) dir))
  69                   (error nil))
  70                 ;; See if the "matching" paren is the right kind of paren
  71                 ;; to match the one we started at.
  72                 (if pos
  73                     (let ((beg (min pos oldpos)) (end (max pos oldpos)))
  74                       (and (/= (char-syntax (char-after beg)) ?\$)
  75                            (setq mismatch
  76                                  (not (eq (char-after (1- end))
  77                                           ;; This can give nil.
  78                                           (matching-paren (char-after beg))))))))
  79                 ;; If they don't properly match, use a different face,
  80                 ;; or print a message.
  81                 (if mismatch
  82                     (progn
  83                       (and (null show-paren-mismatch-face)
  84                            (x-display-color-p)
  85                            (progn
  86                              (add-to-list 'facemenu-unlisted-faces
  87                                           'paren-mismatch)
  88                              (make-face 'paren-mismatch)
  89                              (or (face-nontrivial-p 'paren-mismatch t)
  90                                  (progn
  91                                    (set-face-background 'paren-mismatch
  92                                                         "purple")
  93                                    (set-face-foreground 'paren-mismatch
  94                                                         "white")))
  95                              (setq show-paren-mismatch-face 'paren-mismatch)))
  96                       (if show-paren-mismatch-face
  97                           (setq face show-paren-mismatch-face)
  98                         (message "Paren mismatch"))))
  99                 )))
 100         (cond (pos
 101                (if (= dir -1)
 102                    ;; If matching backwards, highlight the closeparen
 103                    ;; before point as well as its matching open.
 104                    (progn
 105                      (if show-paren-overlay-1
 106                          (move-overlay show-paren-overlay-1
 107                                        (+ (point) dir) (point)
 108                                        (current-buffer))
 109                        (setq show-paren-overlay-1
 110                              (make-overlay (+ (point) dir) (point))))
 111                      ;; Always set the overlay face, since it varies.
 112                      (overlay-put show-paren-overlay-1 'face face))
 113                  ;; Otherwise, turn off any such highlighting.
 114                  (and show-paren-overlay-1
 115                       (overlay-buffer show-paren-overlay-1)
 116                       (delete-overlay show-paren-overlay-1)))
 117                ;; Turn on highlighting for the matching paren.
 118                (if show-paren-overlay
 119                    (move-overlay show-paren-overlay (- pos dir) pos
 120                                  (current-buffer))
 121                  (setq show-paren-overlay
 122                        (make-overlay (- pos dir) pos)))
 123                ;; Always set the overlay face, since it varies.
 124                (overlay-put show-paren-overlay 'face face))
 125               (t
 126                ;; If not at a paren that has a match,
 127                ;; turn off any previous paren highlighting.
 128                (and show-paren-overlay (overlay-buffer show-paren-overlay)
 129                     (delete-overlay show-paren-overlay))
 130                (and show-paren-overlay-1 (overlay-buffer show-paren-overlay-1)
 131                     (delete-overlay show-paren-overlay-1)))))))
 132
 133 (if window-system
 134     (progn
 135       (setq blink-matching-paren-on-screen nil)
 136       (run-with-idle-timer .1 t 'show-paren-command-hook)))
 137 ;;; This is in case paren.el is preloaded.
 138 (add-hook 'window-setup-hook
 139           (function (lambda ()
 140                       (if window-system
 141                           (progn
 142                             (setq blink-matching-paren-on-screen nil)
 143                             (run-with-idle-timer .1 t 'show-paren-command-hook))))))
 144 (provide 'paren)
 145
 146 ;;; paren.el ends here