diff options
| author | Jim Blandy | 1993-06-28 23:41:38 +0000 |
|---|---|---|
| committer | Jim Blandy | 1993-06-28 23:41:38 +0000 |
| commit | 5e28918bbbf1208b35b8d1f43a6b69b592a6c546 (patch) | |
| tree | ca7ac8a2cdaa33146e54c5d7b0215ccaa207ddc5 | |
| parent | f4b9e76b495698e972d05db8237be131ddc094c0 (diff) | |
| download | emacs-5e28918bbbf1208b35b8d1f43a6b69b592a6c546.tar.gz emacs-5e28918bbbf1208b35b8d1f43a6b69b592a6c546.zip | |
Initial revision
| -rw-r--r-- | lisp/paren.el | 85 |
1 files changed, 85 insertions, 0 deletions
diff --git a/lisp/paren.el b/lisp/paren.el new file mode 100644 index 00000000000..fa8cf5b5bfb --- /dev/null +++ b/lisp/paren.el | |||
| @@ -0,0 +1,85 @@ | |||
| 1 | ;;; paren.el --- highlight matching paren. | ||
| 2 | ;; Copyright (C) 1993 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 | ;;; Commentary: | ||
| 21 | |||
| 22 | ;; Load this and it will display highlighting on whatever | ||
| 23 | ;; paren matches the one before or after point. | ||
| 24 | |||
| 25 | ;;; Code: | ||
| 26 | |||
| 27 | (defvar blink-paren-overlay nil) | ||
| 28 | |||
| 29 | ;; Find the place to blink, if there is one, | ||
| 30 | ;; and blink it until input arrives. | ||
| 31 | (defun blink-paren-command-hook () | ||
| 32 | (let (pos dir mismatch (oldpos (point)) | ||
| 33 | (face (if (face-equal 'highlight 'region) | ||
| 34 | 'underline 'highlight))) | ||
| 35 | (cond ((eq (char-syntax (following-char)) ?\() | ||
| 36 | (setq dir 1)) | ||
| 37 | ((eq (char-syntax (preceding-char)) ?\)) | ||
| 38 | (setq dir -1))) | ||
| 39 | (save-excursion | ||
| 40 | (save-restriction | ||
| 41 | ;; Determine the range within which to look for a match. | ||
| 42 | (if blink-matching-paren-distance | ||
| 43 | (narrow-to-region (max (point-min) | ||
| 44 | (- (point) blink-matching-paren-distance)) | ||
| 45 | (min (point-max) | ||
| 46 | (+ (point) blink-matching-paren-distance)))) | ||
| 47 | ;; Scan across one sexp within that range. | ||
| 48 | (condition-case () | ||
| 49 | (setq pos (scan-sexps (point) dir)) | ||
| 50 | (error nil)) | ||
| 51 | ;; See if the "matching" paren is the right kind of paren | ||
| 52 | ;; to match the one we started at. | ||
| 53 | (if pos | ||
| 54 | (let ((beg (min pos oldpos)) (end (max pos oldpos))) | ||
| 55 | (and (/= (char-syntax (char-after beg)) ?\$) | ||
| 56 | (setq mismatch | ||
| 57 | (/= (char-after (1- end)) | ||
| 58 | (logand (lsh (aref (syntax-table) | ||
| 59 | (char-after beg)) | ||
| 60 | -8) | ||
| 61 | 255)))))) | ||
| 62 | ;; If they don't properly match, don't blink. | ||
| 63 | (if mismatch | ||
| 64 | (setq pos nil)))) | ||
| 65 | (cond (pos | ||
| 66 | (if blink-paren-overlay | ||
| 67 | (move-overlay blink-paren-overlay (- pos dir) pos) | ||
| 68 | (setq blink-paren-overlay | ||
| 69 | (make-overlay (- pos dir) pos))) | ||
| 70 | (overlay-put blink-paren-overlay 'face face) | ||
| 71 | ;;; This is code to blink the highlighting. | ||
| 72 | ;;; It is desirable to avoid this because | ||
| 73 | ;;; it would interfere with auto-save and gc when idle. | ||
| 74 | ;;; (while (sit-for 1) | ||
| 75 | ;;; (overlay-put blink-paren-overlay | ||
| 76 | ;;; 'face | ||
| 77 | ;;; (if (overlay-get blink-paren-overlay | ||
| 78 | ;;; 'face) | ||
| 79 | ;;; nil face))) | ||
| 80 | ) | ||
| 81 | (t | ||
| 82 | (delete-overlay blink-paren-overlay))))) | ||
| 83 | |||
| 84 | (add-hook 'post-command-hook 'blink-paren-command-hook) | ||
| 85 | |||