* 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 796652554ffe561d59b02d7b7f21f6e140f92b26..84e1119bc64c3b19ad576ce7c3d97ea0aac14194 100644 (file)
--- 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 c59076974e05b4db2e1ff96a15857fdd0cd0ed0b..2113457869ecc4f27ba0872fe3dc4d09ebac923f 100644 (file)
--- 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