[elpa] master 09ec36e 24/47: Add interruption mechanism.

[Jackson Ray Hamilton]

branch: master
commit 09ec36ebac10776a5982dd220ad9b6d8fd678579
Author: Jackson Ray Hamilton <address@hidden>
Commit: Jackson Ray Hamilton <address@hidden>

    Add interruption mechanism.
---
 context-coloring.el |   57 ++++++++++++++++++++++++++++++++++++++++----------
 1 files changed, 45 insertions(+), 12 deletions(-)

diff --git a/context-coloring.el b/context-coloring.el
index 2c5f44b..940b90d 100644
--- a/context-coloring.el
+++ b/context-coloring.el
@@ -407,6 +407,15 @@ generated by `js2-mode'."
 (defconst context-coloring-COMMA-CHAR 44)
 (defconst context-coloring-BACKTICK-CHAR 96)
 
+(defvar context-coloring-parse-interruptable-p t
+  "Set this to nil to force parse to continue until finished.")
+
+(defvar context-coloring-tokens-per-pause 25
+  "Pause after this many statements to check for user input.
+If user input is pending, stop the parse.  This makes for a
+smoother user experience for large files.  This appears to be
+more or less how Eclipse, IntelliJ and other editors work.")
+
 (defun context-coloring-emacs-lisp-colorize ()
   "Color the current buffer by parsing emacs lisp sexps."
   (with-silent-modifications
@@ -414,6 +423,7 @@ generated by `js2-mode'."
       ;; TODO: Can probably make this lazy to the nearest defun.
       (goto-char (point-min))
       (let* ((inhibit-point-motion-hooks t)
+             (token-count 0)
              (end (point-max))
              (last-ppss-pos (point))
              (ppss (syntax-ppss))
@@ -453,6 +463,11 @@ generated by `js2-mode'."
              child-2-end)
         (while (> end (progn (skip-syntax-forward "^()w_'" end)
                              (point)))
+          (and context-coloring-parse-interruptable-p
+               (zerop (% (setq token-count (1+ token-count))
+                         context-coloring-tokens-per-pause))
+               (input-pending-p)
+               (throw 'interrupted t))
           (setq token-pos (point))
           (setq token-syntax (syntax-after token-pos))
           (setq token-syntax-code (logand #xFFFF (car token-syntax)))
@@ -826,7 +841,11 @@ should be numeric, e.g. \"2\", \"19700101\", \"1.2.3\",
 `context-coloring-mode' is enabled.
 
 `:teardown' - Arbitrary code to tear down this dispatch when
-`context-coloring-mode' is disabled."
+`context-coloring-mode' is disabled.
+
+`:interrupt' - Arbitrary code to run if parsing or coloring is
+interrupted (for synchronous strategies like `:colorizer' and
+`:scopifier')."
   (let ((modes (plist-get properties :modes))
         (colorizer (plist-get properties :colorizer))
         (scopifier (plist-get properties :scopifier))
@@ -1322,6 +1341,10 @@ Supported modes: `js-mode', `js3-mode'"
  'emacs-lisp
  :modes '(emacs-lisp-mode)
  :colorizer 'context-coloring-emacs-lisp-colorize
+ ;; Comments and strings aren't colored till the end so it can be pretty ugly 
if
+ ;; you interrupt too far down the buffer.  TODO: Still not very satisfying,
+ ;; seeing flashes of uncolored code occassionally.
+ :interrupt 'context-coloring-maybe-colorize-comments-and-strings
  :setup
  (lambda ()
    (context-coloring-setup-idle-change-detection))
@@ -1338,18 +1361,28 @@ the current buffer, then execute it.
 
 Invoke CALLBACK when complete.  It is invoked synchronously for
 elisp tracks, and asynchronously for shell command tracks."
-  (let ((dispatch (gethash major-mode context-coloring-mode-hash-table))
-        colorizer
-        scopifier
-        command)
+  (let* ((dispatch (gethash major-mode context-coloring-mode-hash-table))
+         (colorizer (plist-get dispatch :colorizer))
+         (scopifier (plist-get dispatch :scopifier))
+         (command (plist-get dispatch :command))
+         (interrupt (plist-get dispatch :interrupt))
+         interrupted-p)
     (cond
-     ((setq colorizer (plist-get dispatch :colorizer))
-      (funcall colorizer)
-      (when callback (funcall callback)))
-     ((setq scopifier (plist-get dispatch :scopifier))
-      (context-coloring-apply-tokens (funcall scopifier))
-      (when callback (funcall callback)))
-     ((setq command (plist-get dispatch :command))
+     ((or colorizer scopifier)
+      (setq interrupted-p
+            (catch 'interrupted
+              (cond
+               (colorizer
+                (funcall colorizer))
+               (scopifier
+                (context-coloring-apply-tokens (funcall scopifier))))))
+      (cond
+       (interrupted-p
+        (when interrupt (funcall interrupt))
+        (setq context-coloring-changed t))
+       (t
+        (when callback (funcall callback)))))
+     (command
       (context-coloring-scopify-and-colorize command callback)))))