[Emacs-diffs] /srv/bzr/emacs/trunk r112615: * emacs-lisp/smie.el (smie-matching-block-highlight): New face.

[Leo Liu]

------------------------------------------------------------
revno: 112615
fixes bug: http://debbugs.gnu.org/14395
committer: Leo Liu <address@hidden>
branch nick: trunk
timestamp: Fri 2013-05-17 06:58:58 +0800
message:
  * 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.
modified:
  lisp/ChangeLog
  lisp/emacs-lisp/smie.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2013-05-16 16:11:38 +0000
+++ b/lisp/ChangeLog    2013-05-16 22:58:58 +0000
@@ -1,3 +1,13 @@
+2013-05-16  Leo Liu  <address@hidden>
+
+       * 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  <address@hidden>
 
        Sync with upstream verilog-mode r840.

=== modified file 'lisp/emacs-lisp/smie.el'
--- a/lisp/emacs-lisp/smie.el   2013-04-25 03:25:34 +0000
+++ b/lisp/emacs-lisp/smie.el   2013-05-16 22:58:58 +0000
@@ -1021,6 +1021,85 @@
             (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 @@
       ;; 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