branch: master
commit 6a4ad31d4f86e6d1b129c17fb16deca9be148514
Author: Jackson Ray Hamilton <jack...@jacksonrayhamilton.com>
Commit: Jackson Ray Hamilton <jack...@jacksonrayhamilton.com>
Add derived mode support.
---
context-coloring.el | 18 +++++++++++----
test/context-coloring-test.el | 49 +++++++++++++++++++++++++++++++----------
2 files changed, 50 insertions(+), 17 deletions(-)
diff --git a/context-coloring.el b/context-coloring.el
index 23af23d..0249a5d 100644
--- a/context-coloring.el
+++ b/context-coloring.el
@@ -841,6 +841,15 @@ Invoke CALLBACK when complete."
(defvar context-coloring-mode-hash-table (make-hash-table :test 'eq)
"Map major mode names to dispatch property lists.")
+(defun context-coloring-get-dispatch-for-mode (mode)
+ "Return the dispatch for MODE (or a derivative mode)."
+ (let ((parent mode)
+ dispatch)
+ (while (and parent
+ (not (setq dispatch (gethash parent
context-coloring-mode-hash-table)))
+ (setq parent (get parent 'derived-mode-parent))))
+ dispatch))
+
(defun context-coloring-define-dispatch (symbol &rest properties)
"Define a new dispatch named SYMBOL with PROPERTIES.
@@ -969,7 +978,7 @@ produces (1 0 0), \"19700101\" produces (19700101), etc."
"Asynchronously invoke CALLBACK with a predicate indicating
whether the current scopifier version satisfies the minimum
version number required for the current major mode."
- (let ((dispatch (gethash major-mode context-coloring-mode-hash-table)))
+ (let ((dispatch (context-coloring-get-dispatch-for-mode major-mode)))
(when dispatch
(let ((version (plist-get dispatch :version))
(command (plist-get dispatch :command)))
@@ -1396,7 +1405,7 @@ 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))
+ (let* ((dispatch (context-coloring-get-dispatch-for-mode major-mode))
(colorizer (plist-get dispatch :colorizer))
(scopifier (plist-get dispatch :scopifier))
(command (plist-get dispatch :command))
@@ -1427,7 +1436,7 @@ elisp tracks, and asynchronously for shell command
tracks."
nil " Context" nil
(if (not context-coloring-mode)
(progn
- (let ((dispatch (gethash major-mode context-coloring-mode-hash-table)))
+ (let ((dispatch (context-coloring-get-dispatch-for-mode major-mode)))
(when dispatch
(let ((command (plist-get dispatch :command))
(teardown (plist-get dispatch :teardown)))
@@ -1448,8 +1457,7 @@ elisp tracks, and asynchronously for shell command
tracks."
;; Safely change the valye of this function as necessary.
(make-local-variable 'font-lock-syntactic-face-function)
- ;; TODO: Detect derived modes.
- (let ((dispatch (gethash major-mode context-coloring-mode-hash-table)))
+ (let ((dispatch (context-coloring-get-dispatch-for-mode major-mode)))
(if dispatch
(progn
(let ((command (plist-get dispatch :command))
diff --git a/test/context-coloring-test.el b/test/context-coloring-test.el
index 19f844b..e22ee29 100644
--- a/test/context-coloring-test.el
+++ b/test/context-coloring-test.el
@@ -348,8 +348,16 @@ EXPECTED-FACE."
(context-coloring-test-assert-region-face
start end 'font-lock-string-face))
+(defun context-coloring-test-get-last-message ()
+ (let ((messages (split-string
+ (buffer-substring-no-properties
+ (point-min)
+ (point-max))
+ "\n")))
+ (car (nthcdr (- (length messages) 2) messages))))
+
(defun context-coloring-test-assert-message (expected buffer)
- "Assert that message EXPECTED exists in BUFFER."
+ "Assert that message EXPECTED is at the end of BUFFER."
(when (null (get-buffer buffer))
(ert-fail
(format
@@ -358,20 +366,28 @@ EXPECTED-FACE."
"but the buffer did not have any messages.")
buffer expected)))
(with-current-buffer buffer
- (let ((messages (split-string
- (buffer-substring-no-properties
- (point-min)
- (point-max))
- "\n")))
- (let ((message (car (nthcdr (- (length messages) 2) messages))))
- (when (not (equal message expected))
+ (let ((message (context-coloring-test-get-last-message)))
+ (when (not (equal message expected))
+ (ert-fail
+ (format
+ (concat
+ "Expected buffer `%s' to have message \"%s\", "
+ "but instead it was \"%s\"")
+ buffer expected
+ message))))))
+
+(defun context-coloring-test-assert-not-message (expected buffer)
+ "Assert that message EXPECTED is not at the end of BUFFER."
+ (when (get-buffer buffer)
+ (with-current-buffer buffer
+ (let ((message (context-coloring-test-get-last-message)))
+ (when (equal message expected)
(ert-fail
(format
(concat
- "Expected buffer `%s' to have message \"%s\", "
- "but instead it was \"%s\"")
- buffer expected
- message)))))))
+ "Expected buffer `%s' not to have message \"%s\", "
+ "but it did")
+ buffer expected)))))))
(defun context-coloring-test-assert-no-message (buffer)
"Assert that BUFFER has no message."
@@ -506,6 +522,15 @@ FOREGROUND. Apply ARGUMENTS to
"Context coloring is not available for this major mode"
"*Messages*")))
+(ert-deftest context-coloring-test-derived-mode ()
+ (context-coloring-test-with-fixture
+ "./fixtures/empty"
+ (lisp-interaction-mode)
+ (context-coloring-mode)
+ (context-coloring-test-assert-not-message
+ "Context coloring is not available for this major mode"
+ "*Messages*")))
+
(define-derived-mode
context-coloring-test-define-dispatch-error-mode
fundamental-mode
