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