2 files changed, 182 insertions, 1 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index dd698a0ef40..09424462f21 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,5 +1,10 @@
 2010-09-03  Stefan Monnier  <monnier@iro.umontreal.ca>
 
+        Provide blink-matching support to SMIE.
+        * emacs-lisp/smie.el (smie-bnf-closer-alist): New function.
+        (smie-blink-matching-triggers, smie-blink-matching-inners): New vars.
+        (smie-blink-matching-check, smie-blink-matching-open): New functions.
+
         * simple.el (newline): Fix last change to properly remove itself from
         the hook.
 
diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el
index e8b5c2448e8..c6df851b0e5 100644
--- a/lisp/emacs-lisp/smie.el
+++ b/lisp/emacs-lisp/smie.el
@@ -75,6 +75,26 @@
 
 ;;; Building precedence level tables from BNF specs.
 
+;; We have 4 different representations of a "grammar":
+;; - a BNF table, which is a list of BNF rules of the form
+;;   (NONTERM RHS1 ... RHSn) where each RHS is a list of terminals (tokens)
+;;   or nonterminals.  Any element in these lists which does not appear as
+;;   the `car' of a BNF rule is taken to be a terminal.
+;; - A list of precedences (key word "precs"), is a list, sorted
+;;   from lowest to highest precedence, of precedence classes that
+;;   have the form (ASSOCIATIVITY TERMINAL1 .. TERMINALn), where
+;;   ASSOCIATIVITY can be `assoc', `left', `right' or `nonassoc'.
+;; - a 2 dimensional precedence table (key word "prec2"), is a 2D
+;;   table recording the precedence relation (can be `<', `=', `>', or
+;;   nil) between each pair of tokens.
+;; - a precedence-level table (key word "levels"), while is a alist
+;;   giving for each token its left and right precedence level (a
+;;   number or nil).  This is used in `smie-op-levels'.
+;; The prec2 tables are only intermediate data structures: the source
+;; code normally provides a mix of BNF and precs tables, and then
+;; turns them into a levels table, which is what's used by the rest of
+;; the SMIE code.
+
 (defun smie-set-prec2tab (table x y val &optional override)
   (assert (and x y))
   (let* ((key (cons x y))
@@ -206,6 +226,87 @@ one of those elements share the same precedence level and associativity."
           (setq rhs (cdr rhs)))))
     prec2))
 
+;; (defun smie-prec2-closer-alist (prec2 include-inners)
+;;   "Build a closer-alist from a PREC2 table.
+;; The return value is in the same form as `smie-closer-alist'.
+;; INCLUDE-INNERS if non-nil means that inner keywords will be included
+;; in the table, e.g. the table will include things like (\"if\" . \"else\")."
+;;   (let* ((non-openers '())
+;;          (non-closers '())
+;;          ;; For each keyword, this gives the matching openers, if any.
+;;          (openers (make-hash-table :test 'equal))
+;;          (closers '())
+;;          (done nil))
+;;     ;; First, find the non-openers and non-closers.
+;;     (maphash (lambda (k v)
+;;                (unless (or (eq v '<) (member (cdr k) non-openers))
+;;                  (push (cdr k) non-openers))
+;;                (unless (or (eq v '>) (member (car k) non-closers))
+;;                  (push (car k) non-closers)))
+;;              prec2)
+;;     ;; Then find the openers and closers.
+;;     (maphash (lambda (k _)
+;;                (unless (member (car k) non-openers)
+;;                  (puthash (car k) (list (car k)) openers))
+;;                (unless (or (member (cdr k) non-closers)
+;;                            (member (cdr k) closers))
+;;                  (push (cdr k) closers)))
+;;              prec2)
+;;     ;; Then collect the matching elements.
+;;     (while (not done)
+;;       (setq done t)
+;;       (maphash (lambda (k v)
+;;                  (when (eq v '=)
+;;                    (let ((aopeners (gethash (car k) openers))
+;;                          (dopeners (gethash (cdr k) openers))
+;;                          (new nil))
+;;                      (dolist (o aopeners)
+;;                        (unless (member o dopeners)
+;;                          (setq new t)
+;;                          (push o dopeners)))
+;;                      (when new
+;;                        (setq done nil)
+;;                        (puthash (cdr k) dopeners openers)))))
+;;                prec2))
+;;     ;; Finally, dump the resulting table.
+;;     (let ((alist '()))
+;;       (maphash (lambda (k v)
+;;                  (when (or include-inners (member k closers))
+;;                    (dolist (opener v)
+;;                      (unless (equal opener k)
+;;                        (push (cons opener k) alist)))))
+;;                openers)
+;;       alist)))
+
+(defun smie-bnf-closer-alist (bnf &optional no-inners)
+  ;; We can also build this closer-alist table from a prec2 table,
+  ;; but it takes more work, and the order is unpredictable, which
+  ;; is a problem for smie-close-block.
+  ;; More convenient would be to build it from a levels table since we
+  ;; always have this table (contrary to the BNF), but it has all the
+  ;; disadvantages of the prec2 case plus the disadvantage that the levels
+  ;; table has lost some info which would result in extra invalid pairs.
+  "Build a closer-alist from a BNF table.
+The return value is in the same form as `smie-closer-alist'.
+NO-INNERS if non-nil means that inner keywords will be excluded
+from the table, e.g. the table will not include things like (\"if\" . \"else\")."
+  (let ((nts (mapcar #'car bnf))        ;non terminals.
+        (alist '()))
+    (dolist (nt bnf)
+      (dolist (rhs (cdr nt))
+        (unless (or (< (length rhs) 2) (member (car rhs) nts))
+          (if no-inners
+              (let ((last (car (last rhs))))
+                (unless (member last nts)
+                  (pushnew (cons (car rhs) last) alist :test #'equal)))
+            ;; Reverse so that the "real" closer gets there first,
+            ;; which is important for smie-close-block.
+            (dolist (term (reverse (cdr rhs)))
+              (unless (member term nts)
+                (pushnew (cons (car rhs) term) alist :test #'equal)))))))
+    (nreverse alist)))
+    
+
 (defun smie-prec2-levels (prec2)
   ;; FIXME: Rather than only return an alist of precedence levels, we should
   ;; also extract other useful data from it:
@@ -223,7 +324,7 @@ PREC2 is a table as returned by `smie-precs-precedence-table' or
 `smie-bnf-precedence-table'."
   ;; For each operator, we create two "variables" (corresponding to
   ;; the left and right precedence level), which are represented by
-  ;; cons cells.  Those are the vary cons cells that appear in the
+  ;; cons cells.  Those are the very cons cells that appear in the
   ;; final `table'.  The value of each "variable" is kept in the `car'.
   (let ((table ())
         (csts ())
@@ -596,6 +697,81 @@ This command assumes point is not in a string or comment."
                               pos end))))
              (t)))))))
 
+(defvar smie-blink-matching-triggers '(?\s ?\n)
+  "Chars which might trigger `blink-matching-open'.
+These can include the final chars of end-tokens, or chars that are
+typically inserted right after an end token.
+I.e. a good choice can be:
+    (delete-dups
+     (mapcar (lambda (kw) (aref (cdr kw) (1- (length (cdr kw)))))
+             smie-closer-alist))")
+
+(defcustom smie-blink-matching-inners t
+  "Whether SMIE should blink to matching opener for inner keywords.
+If non-nil, it will blink not only for \"begin..end\" but also for \"if...else\"."
+  :type 'boolean)
+
+(defun smie-blink-matching-check (start end)
+  (save-excursion
+    (goto-char end)
+    (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.
+        (blink-matching-check-mismatch start end))
+       ((not start) t)
+       (t
+        (goto-char start)
+        (let ((starter (funcall smie-forward-token-function)))
+          (not (member (cons starter ender) smie-closer-alist))))))))
+
+(defun smie-blink-matching-open ()
+  "Blink the matching opener when applicable.
+This uses SMIE's tables and is expected to be placed on `post-self-insert-hook'."
+  (when (and blink-matching-paren
+             smie-closer-alist                     ; Optimization.
+             (eq (char-before) last-command-event) ; Sanity check.
+             (memq last-command-event smie-blink-matching-triggers)
+             (save-excursion
+               ;; FIXME: Here we assume that closers all end
+               ;; with a word-syntax char.
+               (unless (eq ?\w (char-syntax last-command-event))
+                 (forward-char -1))
+               (and (looking-at "\\>")
+                    (not (nth 8 (syntax-ppss))))))
+    (save-excursion
+      (let ((pos (point))
+            (token (funcall smie-backward-token-function)))
+        (if (= 1 (length token))
+            ;; The trigger char is itself a token but is not
+            ;; one of the closers (e.g. ?\; in Octave mode),
+            ;; so go back to the previous token
+            (setq token (save-excursion
+                          (funcall smie-backward-token-function)))
+          (goto-char pos))
+        ;; Here we assume that smie-backward-token-function
+        ;; returns a token that is a string and whose content
+        ;; match the buffer's representation of this token.
+        (when (and (> (length token) 1) (stringp token)
+                   (memq (aref token (1- (length token)))
+                         smie-blink-matching-triggers)
+                   (not (eq (aref token (1- (length token)))
+                            last-command-event)))
+          ;; Token ends with a trigger char, so don't blink for
+          ;; anything else than this trigger char, lest we'd blink
+          ;; both when inserting the trigger char and when inserting a
+          ;; subsequent SPC.
+          (setq token nil))
+        (when (and (rassoc token smie-closer-alist)
+                   (or smie-blink-matching-inners
+                       (null (nth 2 (assoc token smie-op-levels)))))
+          ;; The major mode might set blink-matching-check-function
+          ;; buffer-locally so that interactive calls to
+          ;; blink-matching-open work right, but let's not presume
+          ;; that's the case.
+          (let ((blink-matching-check-function #'smie-blink-matching-check))
+            (blink-matching-open)))))))
+
 ;;; The indentation engine.
 
 (defcustom smie-indent-basic 4