[Emacs-diffs] /srv/bzr/emacs/trunk r112853: Re-implement smie matching block highlight using show-paren-data-function.

[Leo Liu]

------------------------------------------------------------
revno: 112853
fixes bug: http://debbugs.gnu.org/14395
committer: Leo Liu <address@hidden>
branch nick: trunk
timestamp: Wed 2013-06-05 15:40:02 +0800
message:
  Re-implement smie matching block highlight using show-paren-data-function. 
  
  * emacs-lisp/smie.el (smie-matching-block-highlight)
  (smie--highlight-matching-block-overlay)
  (smie--highlight-matching-block-lastpos)
  (smie-highlight-matching-block)
  (smie-highlight-matching-block-mode): Remove.
  (smie--matching-block-data-cache): New variable.
  (smie--matching-block-data): New function.
  (smie-setup): Use smie--matching-block-data for
  show-paren-data-function.
  
  * progmodes/octave.el (octave-mode-menu): Fix.
  (octave-find-definition): Skip garbage lines.
modified:
  lisp/ChangeLog
  lisp/emacs-lisp/smie.el
  lisp/progmodes/octave.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2013-06-05 02:35:40 +0000
+++ b/lisp/ChangeLog    2013-06-05 07:40:02 +0000
@@ -1,3 +1,20 @@
+2013-06-05  Leo Liu  <address@hidden>
+
+       Re-implement smie matching block highlight using
+       show-paren-data-function.  (Bug#14395)
+       * emacs-lisp/smie.el (smie-matching-block-highlight)
+       (smie--highlight-matching-block-overlay)
+       (smie--highlight-matching-block-lastpos)
+       (smie-highlight-matching-block)
+       (smie-highlight-matching-block-mode): Remove.
+       (smie--matching-block-data-cache): New variable.
+       (smie--matching-block-data): New function.
+       (smie-setup): Use smie--matching-block-data for
+       show-paren-data-function.
+
+       * progmodes/octave.el (octave-mode-menu): Fix.
+       (octave-find-definition): Skip garbage lines.
+
 2013-06-05  Stefan Monnier  <address@hidden>
 
        Fix compilation error with simultaneous dynamic+lexical scoping.

=== modified file 'lisp/emacs-lisp/smie.el'
--- a/lisp/emacs-lisp/smie.el   2013-05-29 06:50:48 +0000
+++ b/lisp/emacs-lisp/smie.el   2013-06-05 07:40:02 +0000
@@ -1021,87 +1021,63 @@
             (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
-                           (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
+(defvar-local smie--matching-block-data-cache nil)
+
+(defun smie--matching-block-data (orig &rest args)
+  "A function suitable for `show-paren-data-function' (which see)."
+  (when smie-closer-alist
+    (if (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)))
+      (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) (list token beg end))
+                    (goto-char start)
+                    nil))))
+             (tok-at-pt
+              (lambda ()
+                (or (funcall beg-of-tok)
+                    (funcall beg-of-tok
+                             (prog1 (point)
+                               (funcall smie-forward-token-function)))))))
+        (unless (nth 8 (syntax-ppss))
           (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)))
+              (let ((here (funcall tok-at-pt)))
+                (when here
+                  (let (pair there)
+                    (cond
+                     ((assoc (car here) smie-closer-alist) ; opener
+                      (forward-sexp 1)
+                      (setq there (funcall tok-at-pt))
+                      (setq pair (cons (car here) (car there))))
+                     ((rassoc (car here) smie-closer-alist) ; closer
+                      (funcall smie-forward-token-function)
+                      (forward-sexp -1)
+                      (setq there (funcall tok-at-pt))
+                      (setq pair (cons (car there) (car here)))))
+                    ;; Update the cache
+                    (setcdr smie--matching-block-data-cache
+                            (list (nth 1 here) (nth 2 here)
+                                  (nth 1 there) (nth 2 there)
+                                  (not (member pair smie-closer-alist)))))))
+            (scan-error))
+          (goto-char (car smie--matching-block-data-cache))))
+      (apply #'smie--matching-block-data orig args))))
 
 ;;; The indentation engine.
 
@@ -1799,9 +1775,10 @@
       (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))

=== modified file 'lisp/progmodes/octave.el'
--- a/lisp/progmodes/octave.el  2013-06-01 03:38:36 +0000
+++ b/lisp/progmodes/octave.el  2013-06-05 07:40:02 +0000
@@ -153,10 +153,10 @@
                                 'eldoc-mode))
      :style toggle :selected (or eldoc-post-insert-mode eldoc-mode)
      :help "Display function signatures after typing `SPC' or `('"]
-    ["Delimiter Matching"           smie-highlight-matching-block-mode
-     :style toggle :selected smie-highlight-matching-block-mode
+    ["Delimiter Matching"           show-paren-mode
+     :style toggle :selected show-paren-mode
      :help "Highlight matched pairs such as `if ... end'"
-     :visible (fboundp 'smie-highlight-matching-block-mode)]
+     :visible (fboundp 'smie--matching-block-data)]
     ["Auto Fill"                    auto-fill-mode
      :style toggle :selected auto-fill-function
      :help "Automatic line breaking"]
@@ -1715,9 +1715,13 @@
    (list (format "\
 if iskeyword(\"%s\") disp(\"`%s' is a keyword\") else which(\"%s\") endif\n"
                  fn fn fn)))
-  (let* ((line (car inferior-octave-output-list))
-         (file (when (and line (string-match "from the file \\(.*\\)$" line))
-                 (match-string 1 line))))
+  (let (line file)
+    ;; Skip garbage lines such as
+    ;;     warning: fmincg.m: possible Matlab-style ....
+    (while (and (not file) (consp inferior-octave-output-list))
+      (setq line (pop inferior-octave-output-list))
+      (when (string-match "from the file \\(.*\\)$" line)
+        (setq file (match-string 1 line))))
     (if (not file)
         (user-error "%s" (or line (format "`%s' not found" fn)))
       (require 'etags)