[elpa] master f9a2481 06/25: Autoload dispatches.

[Jackson Ray Hamilton]

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

    Autoload dispatches.
---
 context-coloring-emacs-lisp.el |   29 ++++++++-------
 context-coloring-javascript.el |   20 ++++++-----
 context-coloring.el            |   77 +++++++++++++++++++---------------------
 test/context-coloring-test.el  |   48 +++++++++----------------
 4 files changed, 80 insertions(+), 94 deletions(-)

diff --git a/context-coloring-emacs-lisp.el b/context-coloring-emacs-lisp.el
index 770c66a..dbe1354 100644
--- a/context-coloring-emacs-lisp.el
+++ b/context-coloring-emacs-lisp.el
@@ -717,13 +717,15 @@ It could be a quoted or backquoted expression."
       (t
        (context-coloring-elisp-colorize-region-initially (point-min) 
(point-max)))))))
 
-(context-coloring-define-dispatch
+;;;###autoload
+(puthash
  'emacs-lisp
- :modes '(emacs-lisp-mode lisp-interaction-mode)
- :colorizer #'context-coloring-elisp-colorize
- :delay 0.016 ;; Thanks to lazy colorization this can be 60 frames per second.
- :setup #'context-coloring-setup-idle-change-detection
- :teardown #'context-coloring-teardown-idle-change-detection)
+ (list :modes '(emacs-lisp-mode lisp-interaction-mode)
+       :colorizer #'context-coloring-elisp-colorize
+       :delay 0.016 ;; Thanks to lazy colorization this can be 60 frames per 
second.
+       :setup #'context-coloring-setup-idle-change-detection
+       :teardown #'context-coloring-teardown-idle-change-detection)
+ context-coloring-dispatch-hash-table)
 
 
 ;;; eval-expression colorization
@@ -747,18 +749,21 @@ It could be a quoted or backquoted expression."
 ;; `eval-expression-minibuffer-setup-hook' is not available in Emacs 24.3, so
 ;; the backwards-compatible recommendation is to use `minibuffer-setup-hook' 
and
 ;; rely on this predicate instead.
+;;;###autoload
 (defun context-coloring-eval-expression-predicate ()
   "Non-nil if the minibuffer is for `eval-expression'."
   ;; Kinda better than checking `this-command', because `this-command' changes.
   (context-coloring-eval-expression-match))
 
-(context-coloring-define-dispatch
+;;;###autoload
+(puthash
  'eval-expression
- :predicate #'context-coloring-eval-expression-predicate
- :colorizer #'context-coloring-eval-expression-colorize
- :delay 0.016
- :setup #'context-coloring-setup-idle-change-detection
- :teardown #'context-coloring-teardown-idle-change-detection)
+ (list :predicate #'context-coloring-eval-expression-predicate
+       :colorizer #'context-coloring-eval-expression-colorize
+       :delay 0.016
+       :setup #'context-coloring-setup-idle-change-detection
+       :teardown #'context-coloring-teardown-idle-change-detection)
+ context-coloring-dispatch-hash-table)
 
 (provide 'context-coloring-emacs-lisp)
 
diff --git a/context-coloring-javascript.el b/context-coloring-javascript.el
index 7161fe6..ac0bcbd 100644
--- a/context-coloring-javascript.el
+++ b/context-coloring-javascript.el
@@ -220,16 +220,18 @@ For instance, the current file could be a Node.js 
program."
    (t
     (context-coloring-js2-colorize-ast))))
 
-(context-coloring-define-dispatch
+;;;###autoload
+(puthash
  'javascript
- :modes '(js2-mode js2-jsx-mode)
- :colorizer #'context-coloring-js2-colorize
- :setup
- (lambda ()
-   (add-hook 'js2-post-parse-callbacks #'context-coloring-colorize nil t))
- :teardown
- (lambda ()
-   (remove-hook 'js2-post-parse-callbacks #'context-coloring-colorize t)))
+ (list :modes '(js2-mode js2-jsx-mode)
+       :colorizer #'context-coloring-js2-colorize
+       :setup
+       (lambda ()
+         (add-hook 'js2-post-parse-callbacks #'context-coloring-colorize nil 
t))
+       :teardown
+       (lambda ()
+         (remove-hook 'js2-post-parse-callbacks #'context-coloring-colorize 
t)))
+ context-coloring-dispatch-hash-table)
 
 (provide 'context-coloring-javascript)
 
diff --git a/context-coloring.el b/context-coloring.el
index dae1e86..52b0844 100644
--- a/context-coloring.el
+++ b/context-coloring.el
@@ -298,35 +298,15 @@ are scoped to a file (as in Node.js), set this to `1'."
 
 ;;; Dispatch
 
+;;;###autoload
 (defvar context-coloring-dispatch-hash-table (make-hash-table :test #'eq)
-  "Map dispatch strategy names to their property lists.")
-
-(defvar context-coloring-mode-hash-table (make-hash-table :test #'eq)
-  "Map major mode names to dispatch property lists.")
-
-(defvar context-coloring-dispatch-predicates '()
-  "Functions which may return a dispatch.")
-
-(defun context-coloring-get-current-dispatch ()
-  "Return the first dispatch appropriate for the current state."
-  (let ((predicates context-coloring-dispatch-predicates)
-        dispatch)
-    ;; Maybe a predicate will be satisfied and return a dispatch.
-    (while (and predicates
-                (not (setq dispatch (funcall (pop predicates))))))
-    ;; If not, maybe a major mode (or a derivative) will define a dispatch.
-    (when (not dispatch)
-      (setq dispatch (gethash major-mode context-coloring-mode-hash-table)))
-    dispatch))
-
-(defun context-coloring-define-dispatch (symbol &rest properties)
-  "Define a new dispatch named SYMBOL with PROPERTIES.
+  "Map dispatch strategy names to their property lists.
 
 A \"dispatch\" is a property list describing a strategy for
 coloring a buffer.
 
-PROPERTIES must include one of `:modes' or `:predicate', and a
-`:colorizer'.
+Its properties must include one of `:modes' or `:predicate', and
+a `:colorizer'.
 
 `:modes' - List of major modes this dispatch is valid for.
 
@@ -342,21 +322,35 @@ override `context-coloring-default-delay'.
 `context-coloring-mode' is enabled.
 
 `:teardown' - Arbitrary code to tear down this dispatch when
-`context-coloring-mode' is disabled."
-  (let ((modes (plist-get properties :modes))
-        (predicate (plist-get properties :predicate))
-        (colorizer (plist-get properties :colorizer)))
-    (when (null (or modes predicate))
-      (error "No mode or predicate defined for dispatch"))
-    (when (not colorizer)
-      (error "No colorizer defined for dispatch"))
-    (puthash symbol properties context-coloring-dispatch-hash-table)
-    (dolist (mode modes)
-      (puthash mode properties context-coloring-mode-hash-table))
-    (when predicate
-      (push (lambda ()
-              (when (funcall predicate)
-                properties)) context-coloring-dispatch-predicates))))
+`context-coloring-mode' is disabled.")
+
+(defun context-coloring-find-dispatch (predicate)
+  "Find the first dispatch satisfying PREDICATE."
+  (let (found)
+    (maphash
+     (lambda (_ dispatch)
+       (when (and (not found)
+                  (funcall predicate dispatch))
+         (setq found dispatch)))
+     context-coloring-dispatch-hash-table)
+    found))
+
+(defun context-coloring-get-current-dispatch ()
+  "Return the first dispatch appropriate for the current state."
+  (cond
+   ;; Maybe a predicate will be satisfied.
+   ((context-coloring-find-dispatch
+     (lambda (dispatch)
+       (let ((predicate (plist-get dispatch :predicate)))
+         (and predicate (funcall predicate))))))
+   ;; If not, maybe a major mode (or a derivative) will.
+   ((context-coloring-find-dispatch
+     (lambda (dispatch)
+       (let ((modes (plist-get dispatch :modes))
+             match)
+         (while (and modes (not match))
+           (setq match (eq (pop modes) major-mode)))
+         match))))))
 
 (defun context-coloring-before-colorize ()
   "Set up environment for colorization."
@@ -367,8 +361,9 @@ override `context-coloring-default-delay'.
   (let* ((dispatch (context-coloring-get-current-dispatch))
          (colorizer (plist-get dispatch :colorizer)))
     (context-coloring-before-colorize)
-    (catch 'interrupted
-      (funcall colorizer))))
+    (when colorizer
+      (catch 'interrupted
+        (funcall colorizer)))))
 
 
 ;;; Colorization
diff --git a/test/context-coloring-test.el b/test/context-coloring-test.el
index 8c74413..559128a 100644
--- a/test/context-coloring-test.el
+++ b/test/context-coloring-test.el
@@ -231,10 +231,10 @@ signaled."
 
 (context-coloring-test-deftest mode-startup
   (lambda ()
-    (context-coloring-define-dispatch
+    (puthash
      'mode-startup
-     :modes '(context-coloring-test-mode-startup-mode)
-     :colorizer #'ignore)
+     (list :modes '(context-coloring-test-mode-startup-mode))
+     context-coloring-dispatch-hash-table)
     (context-coloring-test-mode-startup-mode)
     (context-coloring-test-assert-causes-coloring
      (context-coloring-mode)))
@@ -245,12 +245,12 @@ signaled."
 
 (context-coloring-test-deftest change-detection
   (lambda ()
-    (context-coloring-define-dispatch
+    (puthash
      'idle-change
-     :modes '(context-coloring-test-change-detection-mode)
-     :colorizer #'ignore
-     :setup #'context-coloring-setup-idle-change-detection
-     :teardown #'context-coloring-teardown-idle-change-detection)
+     (list :modes '(context-coloring-test-change-detection-mode)
+           :setup #'context-coloring-setup-idle-change-detection
+           :teardown #'context-coloring-teardown-idle-change-detection)
+     context-coloring-dispatch-hash-table)
     (context-coloring-test-change-detection-mode)
     (context-coloring-mode)
     (context-coloring-test-assert-causes-coloring
@@ -281,33 +281,17 @@ signaled."
         [?\C-u]
         [?\M-!])))))
 
-(context-coloring-test-define-derived-mode define-dispatch-error)
-
-(context-coloring-test-deftest define-dispatch-error
-  (lambda ()
-    (context-coloring-test-assert-error
-     (lambda ()
-       (context-coloring-define-dispatch
-        'define-dispatch-no-modes))
-     "No mode or predicate defined for dispatch")
-    (context-coloring-test-assert-error
-     (lambda ()
-       (context-coloring-define-dispatch
-        'define-dispatch-no-strategy
-        :modes '(context-coloring-test-define-dispatch-error-mode)))
-     "No colorizer defined for dispatch")))
-
 (context-coloring-test-define-derived-mode disable-mode)
 
 (context-coloring-test-deftest disable-mode
   (lambda ()
     (let (torn-down)
-      (context-coloring-define-dispatch
+      (puthash
        'disable-mode
-       :modes '(context-coloring-test-disable-mode-mode)
-       :colorizer #'ignore
-       :teardown (lambda ()
-                   (setq torn-down t)))
+       (list :modes '(context-coloring-test-disable-mode-mode)
+             :teardown (lambda ()
+                         (setq torn-down t)))
+       context-coloring-dispatch-hash-table)
       (context-coloring-test-disable-mode-mode)
       (context-coloring-mode)
       (context-coloring-mode -1)
@@ -333,10 +317,10 @@ signaled."
     (custom-set-faces
      '(context-coloring-level-0-face ((t :foreground "#aaaaaa"))))
     (enable-theme 'context-coloring-test-custom-theme)
-    (context-coloring-define-dispatch
+    (puthash
      'theme
-     :modes '(context-coloring-test-custom-theme-mode)
-     :colorizer #'ignore)
+     (list :modes '(context-coloring-test-custom-theme-mode))
+     context-coloring-dispatch-hash-table)
     (context-coloring-test-custom-theme-mode)
     (context-coloring-colorize)
     (context-coloring-test-assert-maximum-face 1)