From: Leo Liu <sdl.web@gmail.com>
Date: Thu, 16 May 2013 22:58:58 +0000 (+0800)
Subject: * emacs-lisp/smie.el (smie-matching-block-highlight): New face.
X-Git-Tag: emacs-24.3.90~173^2^2~42^2~45^2~387^2~2026^2~229^2~54
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=ebfe68e85acc390a7f1cebed731d362ef54ff001;p=emacs.git

* emacs-lisp/smie.el (smie-matching-block-highlight): New face.
(smie--highlight-matching-block-overlay)
(smie--highlight-matching-block-lastpos)
(smie--highlight-matching-block-timer): New variables.
(smie-highlight-matching-block): New function.
(smie-highlight-matching-block-mode): New minor mode.
(smie-setup): Conditionally enable smie-blink-matching-open.

Fixes: debbugs:14395
---

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 796652554ff..84e1119bc64 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,13 @@
+2013-05-16  Leo Liu  <sdl.web@gmail.com>
+
+	* emacs-lisp/smie.el (smie-matching-block-highlight): New face.
+	(smie--highlight-matching-block-overlay)
+	(smie--highlight-matching-block-lastpos)
+	(smie--highlight-matching-block-timer): New variables.
+	(smie-highlight-matching-block): New function.
+	(smie-highlight-matching-block-mode): New minor mode.  (Bug#14395)
+	(smie-setup): Conditionally enable smie-blink-matching-open.
+
 2013-05-16  Wilson Snyder  <wsnyder@wsnyder.org>
 
 	Sync with upstream verilog-mode r840.
diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el
index c59076974e0..2113457869e 100644
--- a/lisp/emacs-lisp/smie.el
+++ b/lisp/emacs-lisp/smie.el
@@ -1021,6 +1021,85 @@ This uses SMIE's tables and is expected to be placed on `post-self-insert-hook'.
             (let ((blink-matching-check-function #'smie-blink-matching-check))
               (blink-matching-open))))))))
 
+(defface smie-matching-block-highlight '((t (:inherit highlight)))
+  "Face used to highlight matching block."
+  :group 'smie)
+
+(defvar-local smie--highlight-matching-block-overlay nil)
+(defvar-local smie--highlight-matching-block-lastpos -1)
+
+(defun smie-highlight-matching-block ()
+  (when (and smie-closer-alist
+             (/= (point) smie--highlight-matching-block-lastpos))
+    (unless (overlayp smie--highlight-matching-block-overlay)
+      (setq smie--highlight-matching-block-overlay
+            (make-overlay (point) (point))))
+    (setq smie--highlight-matching-block-lastpos (point))
+    (let ((beg-of-tok
+           (lambda (&optional start)
+             "Move to the beginning of current token at START."
+             (let* ((token)
+                    (start (or start (point)))
+                    (beg (progn
+                           (funcall smie-backward-token-function)
+                           (forward-comment (point-max))
+                           (point)))
+                    (end (progn
+                           (setq token (funcall smie-forward-token-function))
+                           (forward-comment (- (point)))
+                           (point))))
+               (if (and (<= beg start) (<= start end)
+                        (or (assoc token smie-closer-alist)
+                            (rassoc token smie-closer-alist)))
+                   (progn (goto-char beg) token)
+                 (goto-char start)
+                 nil))))
+          (highlight
+           (lambda (beg end)
+             (move-overlay smie--highlight-matching-block-overlay beg end)
+             (overlay-put smie--highlight-matching-block-overlay
+                          'face 'smie-matching-block-highlight))))
+      (save-excursion
+        (condition-case nil
+            (if (nth 8 (syntax-ppss))
+                (overlay-put smie--highlight-matching-block-overlay 'face nil)
+              (let ((token
+                     (or (funcall beg-of-tok)
+                         (funcall beg-of-tok
+                                  (prog1 (point)
+                                    (funcall smie-forward-token-function))))))
+                (cond
+                 ((assoc token smie-closer-alist) ; opener
+                  (forward-sexp 1)
+                  (let ((end (point))
+                        (closer (funcall smie-backward-token-function)))
+                    (when (rassoc closer smie-closer-alist)
+                      (funcall highlight (point) end))))
+                 ((rassoc token smie-closer-alist) ; closer
+                  (funcall smie-forward-token-function)
+                  (forward-sexp -1)
+                  (let ((beg (point))
+                        (opener (funcall smie-forward-token-function)))
+                    (when (assoc opener smie-closer-alist)
+                      (funcall highlight beg (point)))))
+                 (t (overlay-put smie--highlight-matching-block-overlay
+                                 'face nil)))))
+          (scan-error
+           (overlay-put smie--highlight-matching-block-overlay 'face nil)))))))
+
+(defvar smie--highlight-matching-block-timer nil)
+
+;;;###autoload
+(define-minor-mode smie-highlight-matching-block-mode nil
+  :global t :group 'smie
+  (when (timerp smie--highlight-matching-block-timer)
+    (cancel-timer smie--highlight-matching-block-timer))
+  (setq smie--highlight-matching-block-timer nil)
+  (when smie-highlight-matching-block-mode
+    (remove-hook 'post-self-insert-hook #'smie-blink-matching-open 'local)
+    (setq smie--highlight-matching-block-timer
+          (run-with-idle-timer 0.2 t #'smie-highlight-matching-block))))
+
 ;;; The indentation engine.
 
 (defcustom smie-indent-basic 4
@@ -1701,8 +1780,9 @@ KEYWORDS are additional arguments, which can use the following keywords:
       ;; Only needed for interactive calls to blink-matching-open.
       (set (make-local-variable 'blink-matching-check-function)
            #'smie-blink-matching-check)
-      (add-hook 'post-self-insert-hook
-                #'smie-blink-matching-open 'append 'local)
+      (unless smie-highlight-matching-block-mode
+        (add-hook 'post-self-insert-hook
+                  #'smie-blink-matching-open 'append 'local))
       (set (make-local-variable 'smie-blink-matching-triggers)
            (append smie-blink-matching-triggers
                    ;; Rather than wait for SPC to blink, try to blink as