merge from trunk

1 files changed, 91 insertions, 84 deletions

diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el
index a88b9d70930..f9d0fd9366b 100644
--- a/lisp/emacs-lisp/smie.el
+++ b/lisp/emacs-lisp/smie.el
@@ -957,7 +957,7 @@ If non-nil, it will blink not only for \"begin..end\" but also for \"if...else\"
     (let ((ender (funcall smie-backward-token-function)))
       (cond
        ((not (and ender (rassoc ender smie-closer-alist)))
-        ;; This not is one of the begin..end we know how to check.
+        ;; This is not one of the begin..end we know how to check.
         (blink-matching-check-mismatch start end))
        ((not start) t)
        ((eq t (car (rassoc ender smie-closer-alist))) nil)
@@ -1012,6 +1012,9 @@ This uses SMIE's tables and is expected to be placed on `post-self-insert-hook'.
                      (or (eq (char-before) last-command-event)
                          (not (memq (char-before)
                                     smie-blink-matching-triggers)))
+                     ;; FIXME: For octave's "switch ... case ... case" we flash
+                     ;; `switch' at the end of the first `case' and we burp
+                     ;; "mismatch" at the end of the second `case'.
                      (or smie-blink-matching-inners
                          (not (numberp (nth 2 (assoc token smie-grammar))))))
             ;; The major mode might set blink-matching-check-function
@@ -1021,87 +1024,90 @@ 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 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
+(defvar-local smie--matching-block-data-cache nil)
+
+(defun smie--opener/closer-at-point ()
+  "Return (OPENER TOKEN START END) or nil.
+OPENER is non-nil if TOKEN is an opener and nil if it's a closer."
+  (let* ((start (point))
+         ;; Move to a previous position outside of a token.
+         (_ (funcall smie-backward-token-function))
+         ;; Move to the end of the token before point.
+         (btok (funcall smie-forward-token-function))
+         (bend (point)))
+    (cond
+     ;; Token before point is a closer?
+     ((and (>= bend start) (rassoc btok smie-closer-alist))
+      (funcall smie-backward-token-function)
+      (when (< (point) start)
+        (prog1 (list nil btok (point) bend)
+          (goto-char bend))))
+     ;; Token around point is an opener?
+     ((and (> bend start) (assoc btok smie-closer-alist))
+      (funcall smie-backward-token-function)
+      (when (<= (point) start) (list t btok (point) bend)))
+     ((<= bend start)
+      (let ((atok (funcall smie-forward-token-function))
+            (aend (point)))
+        (cond
+         ((< aend start) nil)           ;Hopefully shouldn't happen.
+         ;; Token after point is a closer?
+         ((assoc atok smie-closer-alist)
+          (funcall smie-backward-token-function)
+          (when (<= (point) start)
+            (list t atok (point) aend)))))))))
+
+(defun smie--matching-block-data (orig &rest args)
+  "A function suitable for `show-paren-data-function' (which see)."
+  (if (or (null smie-closer-alist)
+          (eq (point) (car smie--matching-block-data-cache)))
+      (or (cdr smie--matching-block-data-cache)
+          (apply orig args))
+    (setq smie--matching-block-data-cache (list (point)))
+    (unless (nth 8 (syntax-ppss))
+      (condition-case nil
+          (let ((here (smie--opener/closer-at-point)))
+            (when (and here
+                       (or smie-blink-matching-inners
+                           (not (numberp
+                                 (nth (if (nth 0 here) 1 2)
+                                      (assoc (nth 1 here) smie-grammar))))))
+              (let ((there
+                     (cond
+                      ((car here)       ; Opener.
+                       (let ((data (smie-forward-sexp 'halfsexp))
+                             (tend (point)))
+                         (unless (car data)
                            (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 (current-buffer))
-             (overlay-put smie--highlight-matching-block-overlay
-                          'face 'smie-matching-block-highlight))))
-      (overlay-put smie--highlight-matching-block-overlay 'face nil)
-      (unless (nth 8 (syntax-ppss))
-        (save-excursion
-          (condition-case 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)))))))
-            (scan-error)))))))
-
-(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)
-  (if smie-highlight-matching-block-mode
-      (progn
-        (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)))
-    (when smie--highlight-matching-block-overlay
-      (delete-overlay smie--highlight-matching-block-overlay)
-      (setq smie--highlight-matching-block-overlay nil))
-    (kill-local-variable 'smie--highlight-matching-block-lastpos)))
+                           (list (member (cons (nth 1 here) (nth 2 data))
+                                         smie-closer-alist)
+                                 (point) tend))))
+                      (t                ;Closer.
+                       (let ((data (smie-backward-sexp 'halfsexp))
+                             (htok (nth 1 here)))
+                         (if (car data)
+                             (let* ((hprec (nth 2 (assoc htok smie-grammar)))
+                                    (ttok (nth 2 data))
+                                    (tprec (nth 1 (assoc ttok smie-grammar))))
+                               (when (and (numberp hprec) ;Here is an inner.
+                                          (eq hprec tprec))
+                                 (goto-char (nth 1 data))
+                                 (let ((tbeg (point)))
+                                   (funcall smie-forward-token-function)
+                                   (list t tbeg (point)))))
+                           (let ((tbeg (point)))
+                             (funcall smie-forward-token-function)
+                             (list (member (cons (nth 2 data) htok)
+                                           smie-closer-alist)
+                                   tbeg (point)))))))))
+                ;; Update the cache.
+                (setcdr smie--matching-block-data-cache
+                        (list (nth 2 here)  (nth 3 here)
+                              (nth 1 there) (nth 2 there)
+                              (not (nth 0 there)))))))
+        (scan-error nil))
+      (goto-char (car smie--matching-block-data-cache)))
+    (apply #'smie--matching-block-data orig args)))
 
 ;;; The indentation engine.
 
@@ -1799,9 +1805,10 @@ KEYWORDS are additional arguments, which can use the following keywords:
       (setq-local smie-closer-alist ca)
       ;; Only needed for interactive calls to blink-matching-open.
       (setq-local blink-matching-check-function #'smie-blink-matching-check)
-      (unless smie-highlight-matching-block-mode
-        (add-hook 'post-self-insert-hook
-                  #'smie-blink-matching-open 'append 'local))
+      (add-hook 'post-self-insert-hook
+                #'smie-blink-matching-open 'append 'local)
+      (add-function :around (local 'show-paren-data-function)
+                    #'smie--matching-block-data)
       ;; Setup smie-blink-matching-triggers.  Rather than wait for SPC to
       ;; blink, try to blink as soon as we type the last char of a block ender.
       (let ((closers (sort (mapcar #'cdr smie-closer-alist) #'string-lessp))