bug#14395: 24.3; [PATCH] new feature smie-highlight-matching-block

[Leo Liu]

Hi Stefan,

I want something for octave mode that looks like something in the
attached screenshot. But since this is generic I would like to put it in
smie.el. Do you have any objections or comments?

It doesn't make sense for this feature and smie-blink-matching-open to
be on at the same time. So in the patch nothing is enabled.


diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el
index bbdd9f83..ad23f78c 100644
--- a/lisp/emacs-lisp/smie.el
+++ b/lisp/emacs-lisp/smie.el
@@ -1021,6 +1021,61 @@ (defun smie-blink-matching-open ()
             (let ((blink-matching-check-function #'smie-blink-matching-check))
               (blink-matching-open))))))))
 
+(defface smie-matching-block-highlight (: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 (bound-and-true-p 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 ((open-re (concat "\\_<"
+                           (regexp-opt (mapcar 'car smie-closer-alist))
+                           "\\_>"))
+          (close-re (concat "\\_<"
+                            (regexp-opt (mapcar 'cdr smie-closer-alist))
+                            "\\_>"))
+          (beg-of-tok
+           (lambda (re)
+             "Move to the beginning of current token if matching RE."
+             (or (looking-at-p re)
+                 (let* ((start (point))
+                        (beg (progn
+                               (funcall smie-backward-token-function)
+                               (and (looking-at-p re) (point))))
+                        (end (and beg
+                                  (progn
+                                    (funcall smie-forward-token-function)
+                                    (point)))))
+                   (if (and beg (<= beg start) (<= start end))
+                       (goto-char beg)
+                     (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
+        (cond
+         ((funcall beg-of-tok open-re)
+          (with-demoted-errors
+            (forward-sexp 1)
+            (when (looking-back close-re)
+              (funcall highlight (match-beginning 0) (match-end 0)))))
+         ((funcall beg-of-tok close-re)
+          (funcall smie-forward-token-function)
+          (forward-sexp -1)
+          (when (looking-at open-re)
+            (funcall highlight (match-beginning 0) (match-end 0))))
+         (t (overlay-put smie-highlight-matching-block-overlay 'face nil)))))))
+
 ;;; The indentation engine.
 
 (defcustom smie-indent-basic 4

smie-highlight.png
Description: smie-highlight.png