[elpa] master 3d3c693 22/79: Pass interrupt test with recursive colorizer.

[Jackson Ray Hamilton]

branch: master
commit 3d3c693aa6721a76a16eefbb8a2bf5ba5938b719
Author: Jackson Ray Hamilton <address@hidden>
Commit: Jackson Ray Hamilton <address@hidden>

    Pass interrupt test with recursive colorizer.
---
 context-coloring.el           |   49 ++++++++++++++++++++++++++-------------
 test/context-coloring-test.el |   51 +++++++++++++++++++---------------------
 2 files changed, 57 insertions(+), 43 deletions(-)

diff --git a/context-coloring.el b/context-coloring.el
index a3a1887..e566ce4 100644
--- a/context-coloring.el
+++ b/context-coloring.el
@@ -276,18 +276,6 @@ generated by `js2-mode'."
 
 ;;; Emacs Lisp colorization
 
-(defvar context-coloring-parse-interruptable-p t
-  "Set this to nil to force parse to continue until finished.")
-
-(defconst context-coloring-elisp-iterations-per-pause 1000
-  "Pause after this many iterations to check for user input.
-If user input is pending, stop the parse.  This makes for a
-smoother user experience for large files.
-
-As of this writing, emacs lisp colorization seems to run at about
-60,000 iterations per second.  A default value of 1000 should
-provide visually \"instant\" updates at 60 frames per second.")
-
 (defsubst context-coloring-forward-sws ()
   "Move forward through whitespace and comments."
   (while (forward-comment 1)))
@@ -622,8 +610,32 @@ provide visually \"instant\" updates at 60 frames per 
second.")
           (context-coloring-forward-sws)
           (context-coloring-elisp-colorize-sexp)))))))
 
+(defvar context-coloring-parse-interruptable-p t
+  "Set this to nil to force parse to continue until finished.")
+
+(defconst context-coloring-elisp-sexps-per-pause 1000
+  "Pause after this many iterations to check for user input.
+If user input is pending, stop the parse.  This makes for a
+smoother user experience for large files.
+
+As of this writing, emacs lisp colorization seems to run at about
+60,000 iterations per second.  A default value of 1000 should
+provide visually \"instant\" updates at 60 frames per second.")
+
+(defvar context-coloring-elisp-sexp-count 0)
+
+(defun context-coloring-elisp-increment-sexp-count ()
+  (setq context-coloring-elisp-sexp-count
+        (1+ context-coloring-elisp-sexp-count))
+  (when (and (zerop (% context-coloring-elisp-sexp-count
+                       context-coloring-elisp-sexps-per-pause))
+             context-coloring-parse-interruptable-p
+             (input-pending-p))
+    (throw 'interrupted t)))
+
 (defun context-coloring-elisp-colorize-sexp ()
   (let (syntax-code)
+    (context-coloring-elisp-increment-sexp-count)
     (setq syntax-code (context-coloring-get-syntax-code))
     (cond
      ((= syntax-code context-coloring-OPEN-PARENTHESIS-CODE)
@@ -638,6 +650,7 @@ provide visually \"instant\" updates at 60 frames per 
second.")
 
 (defun context-coloring-elisp-colorize-comment ()
   (let ((start (point)))
+    (context-coloring-elisp-increment-sexp-count)
     (skip-syntax-forward "^>")
     (context-coloring-maybe-colorize-comments-and-strings
      start
@@ -646,6 +659,7 @@ provide visually \"instant\" updates at 60 frames per 
second.")
 (defun context-coloring-elisp-colorize-string ()
   (let ((start (point))
         (syntax-code (context-coloring-get-syntax-code)))
+    (context-coloring-elisp-increment-sexp-count)
     ;; Move past the opening string delimiter.
     (forward-char)
     (while (progn
@@ -682,6 +696,11 @@ provide visually \"instant\" updates at 60 frames per 
second.")
        (t
         (forward-char))))))
 
+(defun context-coloring-elisp-colorize (start end)
+  (setq context-coloring-elisp-sexp-count 0)
+  (setq context-coloring-elisp-scope-stack '())
+  (context-coloring-elisp-colorize-region start end))
+
 (defun context-coloring-elisp-colorize-changed-region (start end)
   (with-silent-modifications
     (save-excursion
@@ -691,15 +710,13 @@ provide visually \"instant\" updates at 60 frames per 
second.")
             (end (progn (goto-char end)
                         (end-of-defun)
                         (point))))
-        (setq context-coloring-elisp-scope-stack '())
-        (context-coloring-elisp-colorize-region start end)))))
+        (context-coloring-elisp-colorize start end)))))
 
 (defun context-coloring-elisp-colorize-buffer ()
   (interactive)
   (with-silent-modifications
     (save-excursion
-      (setq context-coloring-elisp-scope-stack '())
-      (context-coloring-elisp-colorize-region (point-min) (point-max)))))
+      (context-coloring-elisp-colorize (point-min) (point-max)))))
 
 (defalias 'ccecb 'context-coloring-elisp-colorize-buffer)
 
diff --git a/test/context-coloring-test.el b/test/context-coloring-test.el
index 4d59054..2a9cdd0 100644
--- a/test/context-coloring-test.el
+++ b/test/context-coloring-test.el
@@ -1148,33 +1148,30 @@ ssssssssssss0"))
     2222 1 1 2 2 2 000022
   1111 1 1 1 0 0 000011")))
 
-;; (defun context-coloring-test-insert-unread-space ()
-;;   "Simulate the insertion of a space as if by a user."
-;;   (setq unread-command-events (cons '(t . 32)
-;;                                     unread-command-events)))
-
-;; (defun context-coloring-test-remove-faces ()
-;;   "Remove all faces in the current buffer."
-;;   (remove-text-properties (point-min) (point-max) '(face nil)))
-
-;; (context-coloring-test-deftest-emacs-lisp iteration
-;;   (lambda ()
-;;     (let ((context-coloring-emacs-lisp-iterations-per-pause 1))
-;;       (context-coloring-colorize)
-;;       (context-coloring-test-assert-coloring "
-;; cc `CC' `CC'
-;; (xxxxx x ())")
-;;       (context-coloring-test-remove-faces)
-;;       (context-coloring-test-insert-unread-space)
-;;       (context-coloring-colorize)
-;;       ;; The first iteration will color the first part of the comment, but
-;;       ;; that's it.  Then it will be interrupted.
-;;       (context-coloring-test-assert-coloring "
-;; cc nnnn nnnn
-;; nnnnnn n nnn")))
-;;   :before (lambda ()
-;;             (setq context-coloring-syntactic-comments t)
-;;             (setq context-coloring-syntactic-strings t)))
+(defun context-coloring-test-insert-unread-space ()
+  "Simulate the insertion of a space as if by a user."
+  (setq unread-command-events (cons '(t . 32)
+                                    unread-command-events)))
+
+(defun context-coloring-test-remove-faces ()
+  "Remove all faces in the current buffer."
+  (remove-text-properties (point-min) (point-max) '(face nil)))
+
+(context-coloring-test-deftest-emacs-lisp iteration
+  (lambda ()
+    (let ((context-coloring-elisp-sexps-per-pause 2))
+      (context-coloring-colorize)
+      (context-coloring-test-assert-coloring "
+cc `CC' `CC'
+(xxxxx x ())")
+      (context-coloring-test-remove-faces)
+      (context-coloring-test-insert-unread-space)
+      (context-coloring-colorize)
+      ;; Coloring is interrupted after the first "sexp" (the comment in this
+      ;; case).
+      (context-coloring-test-assert-coloring "
+cc `CC' `CC'
+nnnnnn n nnn"))))
 
 (provide 'context-coloring-test)