changeset 2115:3dc020fb2aa1

An Emacs urweb-mode optimization contributed by John Wiegley
author Adam Chlipala <adam@chlipala.net>
date Wed, 11 Feb 2015 13:12:59 -0500 (2015-02-11)
parents dca8d91b4170
children ebfaab689570
files src/elisp/urweb-mode.el
diffstat 1 files changed, 37 insertions(+), 32 deletions(-) [+]
line wrap: on
line diff
--- a/src/elisp/urweb-mode.el	Tue Feb 10 09:58:35 2015 -0500
+++ b/src/elisp/urweb-mode.el	Wed Feb 11 13:12:59 2015 -0500
@@ -171,42 +171,47 @@
           (depth 0)
           (finished nil)
           (answer nil)
+          (bound (max 0 (- (point) 1024)))
           )
-      (while (and (not finished) (re-search-backward "[-<{}]" nil t))
-        (cond
-         ((looking-at "{")
-          (if (> depth 0)
-              (decf depth)
-            (setq finished t)))
-         ((looking-at "}")
-          (incf depth))
-         ((looking-at "<xml>")
-          (if (> depth 0)
-              (decf depth)
-            (progn
-              (setq answer t)
-              (setq finished t))))
-         ((looking-at "</xml>")
-          (incf depth))
+      (while (and (not finished)
+                  (re-search-backward "\\(\\([-{}]\\)\\|<\\(/?xml\\)?\\)"
+                                      bound t))
+        (let ((xml-tag (length (or (match-string 3) "")))
+              (ch (match-string 2)))
+         (cond
+          ((equal ch ?\{)
+           (if (> depth 0)
+               (decf depth)
+             (setq finished t)))
+          ((equal ch ?\})
+           (incf depth))
+          ((= xml-tag 3)
+           (if (> depth 0)
+               (decf depth)
+             (progn
+               (setq answer t)
+               (setq finished t))))
+          ((= xml-tag 4)
+           (incf depth))
 
-         ((looking-at "-")
-          (if (looking-at "->")
-            (setq finished (= depth 0))))
+          ((equal ch ?-)
+           (if (looking-at "->")
+               (setq finished (= depth 0))))
 
-         ((and (= depth 0)
-               (not (looking-at "<xml")) ;; ignore <xml/>
-               (eq font-lock-tag-face
-                   (get-text-property (point) 'face)))
-          ;; previous code was highlighted as tag, seems we are in xml
-          (progn
-            (setq answer t)
-            (setq finished t)))
+          ((and (= depth 0)
+                (not (looking-at "<xml")) ;; ignore <xml/>
+                (eq font-lock-tag-face
+                    (get-text-property (point) 'face)))
+           ;; previous code was highlighted as tag, seems we are in xml
+           (progn
+             (setq answer t)
+             (setq finished t)))
 
-         ((= depth 0)
-          ;; previous thing was a tag like, but not tag
-          ;; seems we are in usual code or comment
-          (setq finished t))
-         ))
+          ((= depth 0)
+           ;; previous thing was a tag like, but not tag
+           ;; seems we are in usual code or comment
+           (setq finished t))
+          )))
       answer)))
 
 (defun amAttribute (face)