branch: master
commit 3d3c693aa6721a76a16eefbb8a2bf5ba5938b719
Author: Jackson Ray Hamilton <jack...@jacksonrayhamilton.com>
Commit: Jackson Ray Hamilton <jack...@jacksonrayhamilton.com>
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)
