|
|
@@ -0,0 +1,324 @@
|
|
|
+;;; flashparen.el --- flash matching parens a la Zmacs
|
|
|
+
|
|
|
+;; Copyright (C) 1995 Noah S. Friedman
|
|
|
+
|
|
|
+;; Author: Noah Friedman <[email protected]>
|
|
|
+;; Maintainer: [email protected]
|
|
|
+;; Keywords: extensions
|
|
|
+;; Status: Works in Emacs 19
|
|
|
+;; Created: 1995-03-03
|
|
|
+
|
|
|
+;; LCD Archive Entry:
|
|
|
+;; flashparen|Noah Friedman|[email protected]|
|
|
|
+;; flash matching parens a la Zmacs|
|
|
|
+;; 12-Nov-1995|1.8|~/misc/flashparen.el.gz|
|
|
|
+
|
|
|
+;; $Id$
|
|
|
+
|
|
|
+;; This program 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.
|
|
|
+;;
|
|
|
+;; This program 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 this program; if not, you can either send email to this
|
|
|
+;; program's maintainer or write to: The Free Software Foundation,
|
|
|
+;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
|
|
|
+
|
|
|
+;;; Commentary:
|
|
|
+
|
|
|
+;; Loading this makes emacs's paren blinking behavior more closely
|
|
|
+;; approximate the behavior of Zmacs. It should work under X or on ascii
|
|
|
+;; terminals.
|
|
|
+
|
|
|
+;; Note that in XEmacs, blink-paren.el implements this functionality in a
|
|
|
+;; more reliable manner, so use that instead of this program.
|
|
|
+
|
|
|
+;; To use this program, load this file and do
|
|
|
+;;
|
|
|
+;; (flash-matching-mode 1)
|
|
|
+;;
|
|
|
+;; It is vitally important that flash-matching-char be the *last* hook on
|
|
|
+;; post-command-hook. If anything comes after it, it won't get run until
|
|
|
+;; flash-matching-char is interrupted by user input, which is almost
|
|
|
+;; certainly undesirable. As a consequence, the function
|
|
|
+;; flash-matching-mode will make sure this is the case whenever it is run.
|
|
|
+;; The real solution is to get the flashing function off the command hook
|
|
|
+;; entirely, but since emacs has no builtin timers there seems to be no
|
|
|
+;; readily apparent way to accomplish this efficiently.
|
|
|
+
|
|
|
+;;; Code:
|
|
|
+
|
|
|
+(defvar flash-matching-mode nil
|
|
|
+ "*If non-nil, then flash corresponding matching character on display.
|
|
|
+It's best to call the function of the same name, since there are other
|
|
|
+things to be done by side effect when enabling this feature.")
|
|
|
+
|
|
|
+(defvar flash-matching-delay
|
|
|
+ (cond (window-system 0.2)
|
|
|
+ ((> baud-rate 19200) 0.2)
|
|
|
+ ((>= baud-rate 9600) 0.5)
|
|
|
+ (t 1))
|
|
|
+ "Interval (in seconds) for flash delay.
|
|
|
+This number may be a floating-point number in instances of emacs that
|
|
|
+support floating point arguments to `sit-for'.")
|
|
|
+
|
|
|
+
|
|
|
+;;;###autoload
|
|
|
+(defun flash-matching-mode (&optional prefix)
|
|
|
+ "*If non-nil, then flash corresponding matching character on display."
|
|
|
+ (interactive "P")
|
|
|
+
|
|
|
+ ;; Make sure flash-matching-char is last on post-command-hook or
|
|
|
+ ;; post-command-idle-hook. The latter is defined in Emacs 19.30 and later.
|
|
|
+ (let* ((hook (if (boundp 'post-command-idle-hook)
|
|
|
+ 'post-command-idle-hook
|
|
|
+ 'post-command-hook))
|
|
|
+ (h (memq 'flash-matching-char (symbol-value hook))))
|
|
|
+ (cond ((null h)
|
|
|
+ (add-hook hook 'flash-matching-char 'append))
|
|
|
+ ((cdr h)
|
|
|
+ (remove-hook hook 'flash-matching-char)
|
|
|
+ (add-hook hook 'flash-matching-char 'append))))
|
|
|
+
|
|
|
+ (setq flash-matching-mode
|
|
|
+ (>= (prefix-numeric-value prefix) 0))
|
|
|
+ (and (interactive-p)
|
|
|
+ (if flash-matching-mode
|
|
|
+ (message "flash-matching-mode is enabled")
|
|
|
+ (message "flash-matching-mode is disabled")))
|
|
|
+ flash-matching-mode)
|
|
|
+
|
|
|
+;; Verify that an even number of quoting characters precede char at point.
|
|
|
+(defsubst flash-matching-even-quoting-p (point)
|
|
|
+ (let ((p (point)))
|
|
|
+ (if (= point (point-min))
|
|
|
+ t
|
|
|
+ (= 1 (logand 1 (- point
|
|
|
+ (progn
|
|
|
+ (goto-char point)
|
|
|
+ (forward-char -1)
|
|
|
+ (skip-syntax-backward "/\\" (point-min))
|
|
|
+ (prog1
|
|
|
+ (point)
|
|
|
+ (goto-char p)))))))))
|
|
|
+
|
|
|
+(defun flash-matching-char ()
|
|
|
+ (and flash-matching-mode
|
|
|
+ ;; prefix args do strange things with commands; it seems that
|
|
|
+ ;; running post-command-hook after invoking one of these is delayed
|
|
|
+ ;; until the command is finished, then the hook is run twice.
|
|
|
+ ;; It's undesirable to wait for user input twice before returning to
|
|
|
+ ;; the top command loop, so skip this the first time.
|
|
|
+ (not (memq this-command '(digit-argument universal-argument)))
|
|
|
+ ;; keyboard macros run a sequence of interactive commands, each one
|
|
|
+ ;; of which will cause a call to post-command-hook; so as long as
|
|
|
+ ;; the keyboard macro is still executing, do nothing.
|
|
|
+ (null executing-macro)
|
|
|
+ (let* ((saved-point (point))
|
|
|
+ (cho (char-after saved-point))
|
|
|
+ (chc (char-after (1- saved-point)))
|
|
|
+ ch)
|
|
|
+ (cond
|
|
|
+ ((or (and (numberp cho)
|
|
|
+ (= (char-syntax cho) ?\()
|
|
|
+ (< saved-point (window-end))
|
|
|
+ (flash-matching-even-quoting-p saved-point)
|
|
|
+ (setq ch cho))
|
|
|
+ (and (numberp chc)
|
|
|
+ (= (char-syntax chc) ?\))
|
|
|
+ (> saved-point (window-start))
|
|
|
+ (flash-matching-even-quoting-p saved-point)
|
|
|
+ (setq ch chc)))
|
|
|
+
|
|
|
+ (let ((parse-sexp-ignore-comments t)
|
|
|
+ ;; this beginning of line is not necessarily the same as
|
|
|
+ ;; the one of the matching char `line-beg', below.
|
|
|
+ (bol-point (progn
|
|
|
+ (beginning-of-line)
|
|
|
+ (point)))
|
|
|
+ match-point)
|
|
|
+
|
|
|
+ ;; should be at bol now
|
|
|
+ ;; If we're inside a comment already, turn off ignoring comments.
|
|
|
+ (and comment-start
|
|
|
+ (looking-at (concat "^[ \t]*" (regexp-quote comment-start)))
|
|
|
+ (setq parse-sexp-ignore-comments nil))
|
|
|
+
|
|
|
+ ;; Find matching paren position, but don't search any further
|
|
|
+ ;; than the visible window.
|
|
|
+ (save-restriction
|
|
|
+ (condition-case ()
|
|
|
+ (progn
|
|
|
+ (narrow-to-region (window-start) (window-end))
|
|
|
+ (cond
|
|
|
+ ((= (char-syntax ch) ?\()
|
|
|
+ (setq match-point (1- (scan-sexps saved-point 1))))
|
|
|
+ (t
|
|
|
+ (setq match-point (scan-sexps saved-point -1)))))
|
|
|
+ (error nil)))
|
|
|
+
|
|
|
+ ;; Matched char must be the corresponding character for the
|
|
|
+ ;; char at the saved point, not just another paired delimiter.
|
|
|
+ ;; This can happen when parens and brackets are mismatched,
|
|
|
+ ;; for example. Also don't be fooled by things in an
|
|
|
+ ;; open/close syntax class but with no defined matching
|
|
|
+ ;; character.
|
|
|
+ (and match-point
|
|
|
+ (flashparen-matching-paren ch)
|
|
|
+ (not (= (char-after match-point)
|
|
|
+ (flashparen-matching-paren ch)))
|
|
|
+ (setq match-point nil))
|
|
|
+
|
|
|
+ ;; match char must be horizontally visible on display.
|
|
|
+ ;; Unfortunately we cannot just use pos-visible-in-window-p
|
|
|
+ ;; since that returns t for things that are actually off the
|
|
|
+ ;; display horizontally.
|
|
|
+ (and truncate-lines
|
|
|
+ match-point
|
|
|
+ (let ((window-hstart (window-hscroll))
|
|
|
+ (match-column (progn
|
|
|
+ (goto-char match-point)
|
|
|
+ (current-column))))
|
|
|
+ (if (or (< match-column window-hstart)
|
|
|
+ (> match-column (+ window-hstart (window-width))))
|
|
|
+ (setq match-point nil))))
|
|
|
+
|
|
|
+ (cond (match-point
|
|
|
+ ;; I added this to remove messages left over from
|
|
|
+ ;; blink-matching-open, but it also causes messages
|
|
|
+ ;; returned by eval-expression, etc. not to appear if
|
|
|
+ ;; point is right after a sexp, which is too annoying.
|
|
|
+ ;;(message nil)
|
|
|
+ (flash-matching-do-flash saved-point match-point))
|
|
|
+ (t
|
|
|
+ (goto-char saved-point)
|
|
|
+ (and chc
|
|
|
+ (= (char-syntax chc) ?\))
|
|
|
+ ;; blink-matching-open can sometimes signal an
|
|
|
+ ;; error if the function name is outside of a
|
|
|
+ ;; narrowed region---this can happen in C, perl,
|
|
|
+ ;; and other languages where the function label is
|
|
|
+ ;; outside the starting block character, depending
|
|
|
+ ;; on how one's narrow-to-defun function is defined.
|
|
|
+ (condition-case ()
|
|
|
+ (blink-matching-open)
|
|
|
+ (error nil)))))))))))
|
|
|
+
|
|
|
+(defun flash-matching-do-flash (flash-matching-opoint flash-matching-mpoint)
|
|
|
+ ;; Deactivate the mark now if deactivate-mark is set in transient mark
|
|
|
+ ;; mode. Normally the command loop does this itself, but because this
|
|
|
+ ;; function is on post-command-hook, deactivation is delayed and causes
|
|
|
+ ;; noticable, undesirable effects on the display.
|
|
|
+ ;; The only time I've noticed this to be of consequence is when point is
|
|
|
+ ;; right before a sexp and you insert a character. Otherwise, this
|
|
|
+ ;; function doesn't get called again because after modifying the buffer,
|
|
|
+ ;; point is no longer at the beginning or end of a sexp.
|
|
|
+ (and transient-mark-mode
|
|
|
+ deactivate-mark
|
|
|
+ (deactivate-mark))
|
|
|
+
|
|
|
+ (let ((modp (buffer-modified-p))
|
|
|
+ (buffer-file-name buffer-file-name)
|
|
|
+ (buffer-auto-save-file-name buffer-auto-save-file-name)
|
|
|
+ (auto-save-hook (and (boundp 'auto-save-hook)
|
|
|
+ auto-save-hook))
|
|
|
+
|
|
|
+ ;; Don't make any undo records while flashing.
|
|
|
+ ;; If this is nil, new undo records are appended.
|
|
|
+ ;; Setting it to t avoids consing any records at all.
|
|
|
+ (buffer-undo-list t)
|
|
|
+
|
|
|
+ (before-change-function nil)
|
|
|
+ (after-change-function nil)
|
|
|
+ ;; buffer modification messes with transient mark mode.
|
|
|
+ (deactivate-mark nil)
|
|
|
+
|
|
|
+ ;; These variables have long names because they may be referenced
|
|
|
+ ;; by a function in the auto-save-hook even if the current buffer
|
|
|
+ ;; isn't this one (e.g. because a process filter was running at the
|
|
|
+ ;; time).
|
|
|
+ (flash-matching-buffer (current-buffer))
|
|
|
+ (flash-matching-char (char-after flash-matching-mpoint))
|
|
|
+ (flash-matching-visible-p t))
|
|
|
+
|
|
|
+ (cond
|
|
|
+ ((null buffer-file-name))
|
|
|
+ (modp
|
|
|
+ ;; If buffer is already modified, do not try to disable locking or
|
|
|
+ ;; autosaving, but make sure flashed char is in the buffer exactly
|
|
|
+ ;; when autosaving occurs.
|
|
|
+ (add-hook 'auto-save-hook
|
|
|
+ (function
|
|
|
+ (lambda ()
|
|
|
+ (or flash-matching-visible-p
|
|
|
+ (save-excursion
|
|
|
+ (set-buffer flash-matching-buffer)
|
|
|
+ (let ((buffer-read-only nil))
|
|
|
+ (goto-char flash-matching-mpoint)
|
|
|
+ (insert-before-markers-and-inherit
|
|
|
+ flash-matching-char)
|
|
|
+ (goto-char flash-matching-mpoint)
|
|
|
+ (delete-char -1)
|
|
|
+ (setq flash-matching-visible-p t)
|
|
|
+ (goto-char flash-matching-opoint))))))))
|
|
|
+ (t
|
|
|
+ ;; Defeat file locking. Don't try this at home, kids!
|
|
|
+ (setq buffer-file-name nil)
|
|
|
+ (setq buffer-auto-save-file-name nil)))
|
|
|
+
|
|
|
+ ;; We insert-before-markers-and-inherit one char after the one to
|
|
|
+ ;; delete, just in case things like window-start, process-mark,
|
|
|
+ ;; etc. are at the point of interest.
|
|
|
+ (setq flash-matching-mpoint (1+ flash-matching-mpoint))
|
|
|
+ (goto-char flash-matching-opoint)
|
|
|
+ (unwind-protect
|
|
|
+ (while (sit-for flash-matching-delay)
|
|
|
+ (let ((buffer-read-only nil))
|
|
|
+ (goto-char flash-matching-mpoint)
|
|
|
+ ;; Insert char before deleting existing one, to avoid
|
|
|
+ ;; complications having to do with overlays and text
|
|
|
+ ;; properties on a region.
|
|
|
+ (if flash-matching-visible-p
|
|
|
+ (insert-before-markers-and-inherit 32)
|
|
|
+ (insert-before-markers-and-inherit flash-matching-char))
|
|
|
+ (goto-char flash-matching-mpoint)
|
|
|
+ (delete-char -1)
|
|
|
+ (setq flash-matching-visible-p
|
|
|
+ (not flash-matching-visible-p))
|
|
|
+
|
|
|
+ ;; Hide fact of temporary modification during redisplay, if
|
|
|
+ ;; buffer was unmodified originally.
|
|
|
+ (or modp
|
|
|
+ (set-buffer-modified-p modp))
|
|
|
+
|
|
|
+ (goto-char flash-matching-opoint)))
|
|
|
+ (or flash-matching-visible-p
|
|
|
+ (let ((buffer-read-only nil))
|
|
|
+ (goto-char flash-matching-mpoint)
|
|
|
+ (insert-before-markers-and-inherit flash-matching-char)
|
|
|
+ (goto-char flash-matching-mpoint)
|
|
|
+ (delete-char -1)
|
|
|
+ (or modp
|
|
|
+ (set-buffer-modified-p modp))
|
|
|
+ (goto-char flash-matching-opoint))))))
|
|
|
+
|
|
|
+;; matching-paren wasn't defined in emacs until version 19.26.
|
|
|
+(if (fboundp 'matching-paren)
|
|
|
+ (defalias 'flashparen-matching-paren 'matching-paren)
|
|
|
+ (defun flashparen-matching-paren (c)
|
|
|
+ (and (memq (char-syntax c) '(?\( ?\)))
|
|
|
+ (lsh (aref (syntax-table) c) -8))))
|
|
|
+
|
|
|
+(provide 'flashparen)
|
|
|
+
|
|
|
+;; local variables:
|
|
|
+;; vc-make-backup-files: t
|
|
|
+;; end:
|
|
|
+
|
|
|
+;;; flashparen.el ends here
|
David Rose