GNU bug report logs - #14395
24.3; [PATCH] new feature smie-highlight-matching-block

Previous Next

Full log

View this message in rfc822 format

From: Leo Liu <sdl.web <at> gmail.com>
To: Stefan Monnier <monnier <at> iro.umontreal.ca>
Cc: 14395 <at> debbugs.gnu.org
Subject: bug#14395: 24.3; [PATCH] new feature smie-highlight-matching-block
Date: Thu, 16 May 2013 11:27:31 +0800

On 2013-05-16 10:31 +0800, Stefan Monnier wrote:
>> +(define-minor-mode smie-highlight-matching-block-mode nil
>
> Please provide a docstring.

Is the automatically-provided docstring good enough?

New patch as follows.


diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el
index bbdd9f83..de91c21f 100644
--- a/lisp/emacs-lisp/smie.el
+++ b/lisp/emacs-lisp/smie.el
@@ -1021,6 +1021,85 @@ (defun smie-blink-matching-open ()
             (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
+  (when (timerp smie--highlight-matching-block-timer)
+    (cancel-timer smie--highlight-matching-block-timer))
+  (if smie-highlight-matching-block-mode
+      (setq smie--highlight-matching-block-timer
+            (run-with-idle-timer 0.2 t #'smie-highlight-matching-block))
+    (when (timerp smie--highlight-matching-block-timer)
+      (cancel-timer smie--highlight-matching-block-timer))
+    (setq smie--highlight-matching-block-timer nil)))
+
 ;;; The indentation engine.
 
 (defcustom smie-indent-basic 4
@@ -1698,8 +1777,11 @@ (defun smie-setup (grammar rules-function &rest 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)
+      (if smie-highlight-matching-block-mode
+          (remove-hook 'post-self-insert-hook
+                       #'smie-blink-matching-open 'local)
+        (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

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.