From dea75b3cd07f316af8216a27bae056a6c6f3f287 Mon Sep 17 00:00:00 2001
From: David Rose <david@ddrose.com>
Date: Mon, 7 Jul 2003 17:35:02 +0000
Subject: [PATCH] *** empty log message ***

---
 direct/src/directscripts/flashparen.el | 324 +++++++++++++++++++++++++
 1 file changed, 324 insertions(+)
 create mode 100644 direct/src/directscripts/flashparen.el

diff --git a/direct/src/directscripts/flashparen.el b/direct/src/directscripts/flashparen.el
new file mode 100644
index 0000000000..401dcdde53
--- /dev/null
+++ b/direct/src/directscripts/flashparen.el
@@ -0,0 +1,324 @@
+;;; flashparen.el --- flash matching parens a la Zmacs
+
+;; Copyright (C) 1995 Noah S. Friedman
+
+;; Author: Noah Friedman <friedman@prep.ai.mit.edu>
+;; Maintainer: friedman@prep.ai.mit.edu
+;; Keywords: extensions
+;; Status: Works in Emacs 19
+;; Created: 1995-03-03
+
+;; LCD Archive Entry:
+;; flashparen|Noah Friedman|friedman@prep.ai.mit.edu|
+;; 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