[elpa] master 6a4ad31 43/47: Add derived mode support.

[Jackson Ray Hamilton]

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

    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