1 ;;; context-coloring.el --- Highlight by scope -*- lexical-binding: t; -*-
3 ;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
5 ;; Author: Jackson Ray Hamilton <jackson@jacksonrayhamilton.com>
7 ;; Keywords: convenience faces tools
8 ;; Package-Requires: ((emacs "24.3") (js2-mode "20150126"))
9 ;; URL: https://github.com/jacksonrayhamilton/context-coloring
11 ;; This file is part of GNU Emacs.
13 ;; This program is free software; you can redistribute it and/or modify
14 ;; it under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation, either version 3 of the License, or
16 ;; (at your option) any later version.
18 ;; This program is distributed in the hope that it will be useful,
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;; GNU General Public License for more details.
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
28 ;; Highlights code by scope. Top-level scopes are one color, second-level
29 ;; scopes are another color, and so on. Variables retain the color of the scope
30 ;; in which they are defined. A variable defined in an outer scope referenced
31 ;; by an inner scope is colored the same as the outer scope.
33 ;; By default, comments and strings are still highlighted syntactically.
42 (defun context-coloring-join (strings delimiter)
43 "Join a list of STRINGS with the string DELIMITER."
44 (mapconcat #'identity strings delimiter))
49 (defun context-coloring-defface (level tty light dark)
50 "Define a face for LEVEL with colors for TTY, LIGHT and DARK
52 (let ((face (intern (format "context-coloring-level-%s-face" level)))
53 (doc (format "Context coloring face, level %s." level)))
56 `((((type tty)) (:foreground ,tty))
57 (((background light)) (:foreground ,light))
58 (((background dark)) (:foreground ,dark)))
60 :group 'context-coloring)))
62 (defun context-coloring-defface-neutral (level)
63 "Define a face for LEVEL with the default neutral colors."
64 (context-coloring-defface level nil "#3f3f3f" "#cdcdcd"))
66 (context-coloring-defface 0 nil "#000000" "#ffffff")
67 (context-coloring-defface 1 "yellow" "#008b8b" "#00ffff")
68 (context-coloring-defface 2 "green" "#0000ff" "#87cefa")
69 (context-coloring-defface 3 "cyan" "#483d8b" "#b0c4de")
70 (context-coloring-defface 4 "blue" "#a020f0" "#eedd82")
71 (context-coloring-defface 5 "magenta" "#a0522d" "#98fb98")
72 (context-coloring-defface 6 "red" "#228b22" "#7fffd4")
73 (context-coloring-defface-neutral 7)
75 (defvar context-coloring-maximum-face nil
76 "Index of the highest face available for coloring.")
78 (defvar context-coloring-original-maximum-face nil
79 "Fallback value for `context-coloring-maximum-face' when all
80 themes have been disabled.")
82 (setq context-coloring-maximum-face 7)
84 (setq context-coloring-original-maximum-face
85 context-coloring-maximum-face)
87 ;; Theme authors can have up to 26 levels: 1 (0th) for globals, 24 (1st-24th)
88 ;; for nested levels, and 1 (25th) for infinity.
90 (context-coloring-defface-neutral (+ number context-coloring-maximum-face 1)))
95 (defsubst context-coloring-level-face (level)
96 "Return the symbol for a face with LEVEL."
97 ;; `concat' is faster than `format' here.
99 (concat "context-coloring-level-" (number-to-string level) "-face")))
101 (defsubst context-coloring-bounded-level-face (level)
102 "Return the symbol for a face with LEVEL, bounded by
103 `context-coloring-maximum-face'."
104 (context-coloring-level-face (min level context-coloring-maximum-face)))
109 (defvar-local context-coloring-changed-p nil
110 "Indication that the buffer has changed recently, which implies
111 that it should be colored again by
112 `context-coloring-maybe-colorize-idle-timer' if that timer is
115 (defvar-local context-coloring-changed-start nil
116 "Beginning of last text that changed.")
118 (defvar-local context-coloring-changed-end nil
119 "End of last text that changed.")
121 (defvar-local context-coloring-changed-length nil
122 "Length of last text that changed.")
124 (defun context-coloring-change-function (start end length)
125 "Register a change so that a buffer can be colorized soon.
127 START, END and LENGTH are recorded for later use."
128 ;; Tokenization is obsolete if there was a change.
129 (setq context-coloring-changed-start start)
130 (setq context-coloring-changed-end end)
131 (setq context-coloring-changed-length length)
132 (setq context-coloring-changed-p t))
134 (defun context-coloring-maybe-colorize-with-buffer (buffer)
135 "Color BUFFER and if it has changed."
136 (when (and (eq buffer (current-buffer))
137 context-coloring-changed-p)
138 (context-coloring-colorize-with-buffer buffer)
139 (setq context-coloring-changed-p nil)
140 (setq context-coloring-changed-start nil)
141 (setq context-coloring-changed-end nil)
142 (setq context-coloring-changed-length nil)))
144 (defvar-local context-coloring-maybe-colorize-idle-timer nil
145 "The currently-running idle timer for conditional coloring.")
147 (defvar-local context-coloring-colorize-idle-timer nil
148 "The currently-running idle timer for unconditional coloring.")
150 (defcustom context-coloring-default-delay 0.25
151 "Default delay between a buffer update and colorization.
153 Increase this if your machine is high-performing. Decrease it if
155 :group 'context-coloring)
157 (make-obsolete-variable
158 'context-coloring-delay
159 'context-coloring-default-delay
162 (defun context-coloring-cancel-timer (timer)
165 (cancel-timer timer)))
167 (defun context-coloring-schedule-coloring (time)
168 "Schedule coloring to occur once after Emacs is idle for TIME."
169 (context-coloring-cancel-timer context-coloring-colorize-idle-timer)
170 (setq context-coloring-colorize-idle-timer
174 #'context-coloring-colorize-with-buffer
177 (defun context-coloring-setup-idle-change-detection ()
178 "Setup idle change detection."
179 (let ((dispatch (context-coloring-get-current-dispatch)))
181 'after-change-functions #'context-coloring-change-function nil t)
183 'kill-buffer-hook #'context-coloring-teardown-idle-change-detection nil t)
184 (setq context-coloring-maybe-colorize-idle-timer
186 (or (plist-get dispatch :delay) context-coloring-default-delay)
188 #'context-coloring-maybe-colorize-with-buffer
191 (defun context-coloring-teardown-idle-change-detection ()
192 "Teardown idle change detection."
193 (dolist (timer (list context-coloring-colorize-idle-timer
194 context-coloring-maybe-colorize-idle-timer))
195 (context-coloring-cancel-timer timer))
197 'kill-buffer-hook #'context-coloring-teardown-idle-change-detection t)
199 'after-change-functions #'context-coloring-change-function t))
202 ;;; Colorization utilities
204 (defsubst context-coloring-colorize-region (start end level)
205 "Color characters from the 1-indexed START point (inclusive) to
206 the END point (exclusive) with the face corresponding to LEVEL."
210 `(face ,(context-coloring-bounded-level-face level))))
212 (make-obsolete-variable
213 'context-coloring-comments-and-strings
214 "use `context-coloring-syntactic-comments' and
215 `context-coloring-syntactic-strings' instead."
218 (defcustom context-coloring-syntactic-comments t
219 "If non-nil, also color comments using `font-lock'."
220 :group 'context-coloring)
222 (defcustom context-coloring-syntactic-strings t
223 "If non-nil, also color strings using `font-lock'."
224 :group 'context-coloring)
226 (defun context-coloring-font-lock-syntactic-comment-function (state)
227 "Tell `font-lock' to color a comment but not a string according
229 (if (nth 3 state) nil font-lock-comment-face))
231 (defun context-coloring-font-lock-syntactic-string-function (state)
232 "Tell `font-lock' to color a string but not a comment according
234 (if (nth 3 state) font-lock-string-face nil))
236 (defsubst context-coloring-colorize-comments-and-strings (&optional min max)
237 "Color the current buffer's comments or strings if
238 `context-coloring-syntactic-comments' or
239 `context-coloring-syntactic-strings' are non-nil. MIN defaults
240 to the beginning of the buffer and MAX defaults to the end."
241 (when (or context-coloring-syntactic-comments
242 context-coloring-syntactic-strings)
243 (let ((min (or min (point-min)))
244 (max (or max (point-max)))
245 (font-lock-syntactic-face-function
247 ((and context-coloring-syntactic-comments
248 (not context-coloring-syntactic-strings))
249 #'context-coloring-font-lock-syntactic-comment-function)
250 ((and context-coloring-syntactic-strings
251 (not context-coloring-syntactic-comments))
252 #'context-coloring-font-lock-syntactic-string-function)
254 font-lock-syntactic-face-function))))
256 (font-lock-fontify-syntactically-region min max)
257 ;; TODO: Make configurable at the dispatch level.
258 (when (eq major-mode 'emacs-lisp-mode)
259 (font-lock-fontify-keywords-region min max))))))
262 ;;; js2-mode colorization
264 (defvar-local context-coloring-js2-scope-level-hash-table nil
265 "Associate `js2-scope' structures and with their scope
268 (defcustom context-coloring-javascript-block-scopes nil
269 "If non-nil, also color block scopes in the scope hierarchy in JavaScript.
271 The block-scoped `let' and `const' are introduced in ES6. Enable
272 this for ES6 code; disable it elsewhere."
273 :group 'context-coloring)
275 (make-obsolete-variable
276 'context-coloring-js-block-scopes
277 'context-coloring-javascript-block-scopes
280 (defsubst context-coloring-js2-scope-level (scope)
281 "Return the level of SCOPE."
282 (cond ((gethash scope context-coloring-js2-scope-level-hash-table))
285 (current-scope scope)
287 (while (and current-scope
288 (js2-node-parent current-scope)
289 (setq enclosing-scope
290 (js2-node-get-enclosing-scope current-scope)))
291 (when (or context-coloring-javascript-block-scopes
292 (let ((type (js2-scope-type current-scope)))
293 (or (= type js2-SCRIPT)
294 (= type js2-FUNCTION)
295 (= type js2-CATCH))))
296 (setq level (+ level 1)))
297 (setq current-scope enclosing-scope))
298 (puthash scope level context-coloring-js2-scope-level-hash-table)))))
300 (defsubst context-coloring-js2-local-name-node-p (node)
301 "Determine if NODE is a `js2-name-node' representing a local
303 (and (js2-name-node-p node)
304 (let ((parent (js2-node-parent node)))
305 (not (or (and (js2-object-prop-node-p parent)
306 (eq node (js2-object-prop-node-left parent)))
307 (and (js2-prop-get-node-p parent)
308 ;; For nested property lookup, the node on the left is a
309 ;; `js2-prop-get-node', so this always works.
310 (eq node (js2-prop-get-node-right parent))))))))
312 (defvar-local context-coloring-point-max nil
313 "Cached value of `point-max'.")
315 (defsubst context-coloring-js2-colorize-node (node level)
316 "Color NODE with the color for LEVEL."
317 (let ((start (js2-node-abs-pos node)))
318 (context-coloring-colorize-region
322 (+ start (js2-node-len node))
323 ;; Somes nodes (like the ast when there is an unterminated multiline
324 ;; comment) will stretch to the value of `point-max'.
325 context-coloring-point-max)
328 (defun context-coloring-js2-colorize ()
329 "Color the current buffer using the abstract syntax tree
330 generated by `js2-mode'."
331 ;; Reset the hash table; the old one could be obsolete.
332 (setq context-coloring-js2-scope-level-hash-table (make-hash-table :test #'eq))
333 (setq context-coloring-point-max (point-max))
334 (with-silent-modifications
341 (context-coloring-js2-colorize-node
343 (context-coloring-js2-scope-level node)))
344 ((context-coloring-js2-local-name-node-p node)
345 (let* ((enclosing-scope (js2-node-get-enclosing-scope node))
346 (defining-scope (js2-get-defining-scope
348 (js2-name-node-name node))))
349 ;; The tree seems to be walked lexically, so an entire scope will
350 ;; be colored, including its name nodes, before they are reached.
351 ;; Coloring the nodes defined in that scope would be redundant, so
353 (when (not (eq defining-scope enclosing-scope))
354 (context-coloring-js2-colorize-node
356 (context-coloring-js2-scope-level defining-scope))))))
357 ;; The `t' indicates to search children.
359 (context-coloring-colorize-comments-and-strings)))
362 ;;; Emacs Lisp colorization
364 (defsubst context-coloring-forward-sws ()
365 "Move forward through whitespace and comments."
366 (while (forward-comment 1)))
368 (defsubst context-coloring-elisp-forward-sws ()
369 "Move forward through whitespace and comments, colorizing
370 comments along the way."
371 (let ((start (point)))
372 (context-coloring-forward-sws)
373 (context-coloring-colorize-comments-and-strings start (point))))
375 (defsubst context-coloring-elisp-forward-sexp ()
376 "Like `forward-sexp', but colorize comments and strings along
378 (let ((start (point)))
380 (context-coloring-elisp-colorize-comments-and-strings-in-region
383 (defsubst context-coloring-get-syntax-code ()
384 "Get the syntax code at point."
386 ;; Faster version of `syntax-after':
387 (aref (syntax-table) (char-after (point)))))
389 (defsubst context-coloring-exact-regexp (word)
390 "Create a regexp matching exactly WORD."
391 (concat "\\`" (regexp-quote word) "\\'"))
393 (defsubst context-coloring-exact-or-regexp (words)
394 "Create a regexp matching any exact word in WORDS."
395 (context-coloring-join
396 (mapcar #'context-coloring-exact-regexp words) "\\|"))
398 (defconst context-coloring-elisp-ignored-word-regexp
399 (context-coloring-join (list "\\`[-+]?[0-9]"
401 (context-coloring-exact-or-regexp
402 '("t" "nil" "." "?")))
404 "Match words that might be considered symbols but can't be
405 bound as variables.")
407 (defconst context-coloring-WORD-CODE 2)
408 (defconst context-coloring-SYMBOL-CODE 3)
409 (defconst context-coloring-OPEN-PARENTHESIS-CODE 4)
410 (defconst context-coloring-CLOSE-PARENTHESIS-CODE 5)
411 (defconst context-coloring-EXPRESSION-PREFIX-CODE 6)
412 (defconst context-coloring-STRING-QUOTE-CODE 7)
413 (defconst context-coloring-ESCAPE-CODE 9)
414 (defconst context-coloring-COMMENT-START-CODE 11)
415 (defconst context-coloring-COMMENT-END-CODE 12)
417 (defconst context-coloring-OCTOTHORPE-CHAR (string-to-char "#"))
418 (defconst context-coloring-APOSTROPHE-CHAR (string-to-char "'"))
419 (defconst context-coloring-OPEN-PARENTHESIS-CHAR (string-to-char "("))
420 (defconst context-coloring-COMMA-CHAR (string-to-char ","))
421 (defconst context-coloring-AT-CHAR (string-to-char "@"))
422 (defconst context-coloring-BACKTICK-CHAR (string-to-char "`"))
424 (defsubst context-coloring-elisp-identifier-p (syntax-code)
425 "Check if SYNTAX-CODE is an elisp identifier constituent."
426 (or (= syntax-code context-coloring-WORD-CODE)
427 (= syntax-code context-coloring-SYMBOL-CODE)))
429 (defvar context-coloring-parse-interruptable-p t
430 "Set this to nil to force parse to continue until finished.")
432 (defconst context-coloring-elisp-sexps-per-pause 350
433 "Pause after this many iterations to check for user input.
434 If user input is pending, stop the parse. This makes for a
435 smoother user experience for large files.
437 This number should trigger pausing at about 60 frames per
440 (defvar context-coloring-elisp-sexp-count 0
441 "Current number of sexps leading up to the next pause.")
443 (defsubst context-coloring-elisp-increment-sexp-count ()
444 "Maybe check if the current parse should be interrupted as a
445 result of pending user input."
446 (setq context-coloring-elisp-sexp-count
447 (1+ context-coloring-elisp-sexp-count))
448 (when (and (zerop (% context-coloring-elisp-sexp-count
449 context-coloring-elisp-sexps-per-pause))
450 context-coloring-parse-interruptable-p
452 (throw 'interrupted t)))
454 (defvar context-coloring-elisp-scope-stack '()
455 "List of scopes in the current parse.")
457 (defsubst context-coloring-elisp-make-scope (level)
458 "Make a scope object for LEVEL."
463 (defsubst context-coloring-elisp-scope-get-level (scope)
464 "Get the level of SCOPE object."
465 (plist-get scope :level))
467 (defsubst context-coloring-elisp-scope-add-variable (scope variable)
468 "Add to SCOPE a VARIABLE."
469 (plist-put scope :variables (cons variable (plist-get scope :variables))))
471 (defsubst context-coloring-elisp-scope-has-variable (scope variable)
472 "Check if SCOPE has VARIABLE."
473 (member variable (plist-get scope :variables)))
475 (defsubst context-coloring-elisp-get-variable-level (variable)
476 "Search up the scope chain for the first instance of VARIABLE
477 and return its level, or 0 (global) if it isn't found."
478 (let* ((scope-stack context-coloring-elisp-scope-stack)
481 (while (and scope-stack (not level))
482 (setq scope (car scope-stack))
484 ((context-coloring-elisp-scope-has-variable scope variable)
485 (setq level (context-coloring-elisp-scope-get-level scope)))
487 (setq scope-stack (cdr scope-stack)))))
488 ;; Assume a global variable.
491 (defsubst context-coloring-elisp-get-current-scope-level ()
492 "Get the nesting level of the current scope."
494 ((car context-coloring-elisp-scope-stack)
495 (context-coloring-elisp-scope-get-level (car context-coloring-elisp-scope-stack)))
499 (defsubst context-coloring-elisp-push-scope ()
500 "Add a new scope to the bottom of the scope chain."
501 (push (context-coloring-elisp-make-scope
502 (1+ (context-coloring-elisp-get-current-scope-level)))
503 context-coloring-elisp-scope-stack))
505 (defsubst context-coloring-elisp-pop-scope ()
506 "Remove the scope on the bottom of the scope chain."
507 (pop context-coloring-elisp-scope-stack))
509 (defsubst context-coloring-elisp-add-variable (variable)
510 "Add VARIABLE to the current scope."
511 (context-coloring-elisp-scope-add-variable
512 (car context-coloring-elisp-scope-stack)
515 (defsubst context-coloring-elisp-parse-bindable (callback)
516 "Parse the symbol at point, and if the symbol can be bound,
517 invoke CALLBACK with it."
518 (let* ((arg-string (buffer-substring-no-properties
520 (progn (context-coloring-elisp-forward-sexp)
522 (when (not (string-match-p
523 context-coloring-elisp-ignored-word-regexp
525 (funcall callback arg-string))))
527 (defun context-coloring-elisp-parse-let-varlist (type)
528 "Parse the list of variable initializers at point. If TYPE is
529 `let', all the variables are bound after all their initializers
530 are parsed; if TYPE is `let*', each variable is bound immediately
531 after its own initializer is parsed."
536 (while (/= (setq syntax-code (context-coloring-get-syntax-code))
537 context-coloring-CLOSE-PARENTHESIS-CODE)
539 ((= syntax-code context-coloring-OPEN-PARENTHESIS-CODE)
541 (context-coloring-elisp-forward-sws)
542 (setq syntax-code (context-coloring-get-syntax-code))
543 (when (context-coloring-elisp-identifier-p syntax-code)
544 (context-coloring-elisp-parse-bindable
547 (context-coloring-elisp-forward-sws)
548 (setq syntax-code (context-coloring-get-syntax-code))
549 (when (/= syntax-code context-coloring-CLOSE-PARENTHESIS-CODE)
550 (context-coloring-elisp-colorize-sexp)))
551 (context-coloring-elisp-forward-sws)
552 ;; Skip past the closing parenthesis.
554 ((context-coloring-elisp-identifier-p syntax-code)
555 (context-coloring-elisp-parse-bindable
557 (push var varlist))))
560 (context-coloring-elisp-forward-sexp)))
561 (when (eq type 'let*)
562 (context-coloring-elisp-add-variable (pop varlist)))
563 (context-coloring-elisp-forward-sws))
566 (context-coloring-elisp-add-variable (pop varlist))))
570 (defun context-coloring-elisp-parse-arglist ()
571 "Parse the list of function arguments at point."
575 (while (/= (setq syntax-code (context-coloring-get-syntax-code))
576 context-coloring-CLOSE-PARENTHESIS-CODE)
578 ((context-coloring-elisp-identifier-p syntax-code)
579 (context-coloring-elisp-parse-bindable
581 (context-coloring-elisp-add-variable arg))))
584 (context-coloring-elisp-forward-sexp)))
585 (context-coloring-elisp-forward-sws))
589 (defun context-coloring-elisp-skip-callee-name ()
590 "Skip past the opening parenthesis and name of a function."
593 (context-coloring-elisp-forward-sws)
594 ;; Skip past the function name.
596 (context-coloring-elisp-forward-sws))
598 (defun context-coloring-elisp-colorize-scope (callback)
599 "Color the whole scope at point with its one color. Handle a
601 (let ((start (point))
602 (end (progn (forward-sexp)
604 (context-coloring-elisp-push-scope)
605 ;; Splash the whole thing in one color.
606 (context-coloring-colorize-region
609 (context-coloring-elisp-get-current-scope-level))
610 ;; Even if the parse is interrupted, this region should still be colored
612 (context-coloring-elisp-colorize-comments-and-strings-in-region
616 (context-coloring-elisp-skip-callee-name)
618 (context-coloring-elisp-colorize-region (point) (1- end))
621 (context-coloring-elisp-pop-scope)))
623 (defun context-coloring-elisp-parse-header (callback)
624 "Parse a function header at point with CALLBACK."
625 (when (= (context-coloring-get-syntax-code) context-coloring-OPEN-PARENTHESIS-CODE)
628 (defun context-coloring-elisp-colorize-defun-like (callback)
629 "Color the defun-like function at point, parsing the header
631 (context-coloring-elisp-colorize-scope
633 (when (context-coloring-elisp-identifier-p (context-coloring-get-syntax-code))
634 ;; Color the defun's name with the top-level color.
635 (context-coloring-colorize-region
637 (progn (forward-sexp)
640 (context-coloring-elisp-forward-sws)
641 (context-coloring-elisp-parse-header callback)))))
643 (defun context-coloring-elisp-colorize-defun ()
644 "Color the `defun' at point."
645 (context-coloring-elisp-colorize-defun-like
646 'context-coloring-elisp-parse-arglist))
648 (defun context-coloring-elisp-colorize-defadvice ()
649 "Color the `defadvice' at point."
650 (context-coloring-elisp-colorize-defun-like
655 (while (/= (setq syntax-code (context-coloring-get-syntax-code))
656 context-coloring-CLOSE-PARENTHESIS-CODE)
658 ((= syntax-code context-coloring-OPEN-PARENTHESIS-CODE)
659 (context-coloring-elisp-parse-arglist))
662 (context-coloring-elisp-forward-sexp)))
663 (context-coloring-elisp-forward-sws))))))
665 (defun context-coloring-elisp-colorize-lambda-like (callback)
666 "Color the lambda-like function at point, parsing the header
668 (context-coloring-elisp-colorize-scope
670 (context-coloring-elisp-parse-header callback))))
672 (defun context-coloring-elisp-colorize-lambda ()
673 "Color the `lambda' at point."
674 (context-coloring-elisp-colorize-lambda-like
675 'context-coloring-elisp-parse-arglist))
677 (defun context-coloring-elisp-colorize-let ()
678 "Color the `let' at point."
679 (context-coloring-elisp-colorize-lambda-like
681 (context-coloring-elisp-parse-let-varlist 'let))))
683 (defun context-coloring-elisp-colorize-let* ()
684 "Color the `let*' at point."
685 (context-coloring-elisp-colorize-lambda-like
687 (context-coloring-elisp-parse-let-varlist 'let*))))
689 (defun context-coloring-elisp-colorize-cond ()
690 "Color the `cond' at point."
692 (context-coloring-elisp-skip-callee-name)
693 (while (/= (setq syntax-code (context-coloring-get-syntax-code))
694 context-coloring-CLOSE-PARENTHESIS-CODE)
696 ((= syntax-code context-coloring-OPEN-PARENTHESIS-CODE)
697 ;; Colorize inside the parens.
698 (let ((start (point)))
700 (context-coloring-elisp-colorize-region
701 (1+ start) (1- (point)))
706 (context-coloring-elisp-forward-sexp)))
707 (context-coloring-elisp-forward-sws))
711 (defun context-coloring-elisp-colorize-condition-case ()
712 "Color the `condition-case' at point."
717 (context-coloring-elisp-colorize-scope
719 (setq syntax-code (context-coloring-get-syntax-code))
720 ;; Gracefully ignore missing variables.
721 (when (context-coloring-elisp-identifier-p syntax-code)
722 (context-coloring-elisp-parse-bindable
723 (lambda (parsed-variable)
724 (setq variable parsed-variable)))
725 (context-coloring-elisp-forward-sws))
726 (context-coloring-elisp-colorize-sexp)
727 (context-coloring-elisp-forward-sws)
728 ;; Parse the handlers with the error variable in scope.
730 (context-coloring-elisp-add-variable variable))
731 (while (/= (setq syntax-code (context-coloring-get-syntax-code))
732 context-coloring-CLOSE-PARENTHESIS-CODE)
734 ((= syntax-code context-coloring-OPEN-PARENTHESIS-CODE)
735 (setq case-pos (point))
736 (context-coloring-elisp-forward-sexp)
737 (setq case-end (point))
741 (context-coloring-elisp-forward-sws)
742 (setq syntax-code (context-coloring-get-syntax-code))
743 (when (/= syntax-code context-coloring-CLOSE-PARENTHESIS-CODE)
744 ;; Skip the condition name(s).
745 (context-coloring-elisp-forward-sexp)
746 ;; Color the remaining portion of the handler.
747 (context-coloring-elisp-colorize-region
754 (context-coloring-elisp-forward-sexp)))
755 (context-coloring-elisp-forward-sws))))))
757 (defun context-coloring-elisp-colorize-dolist ()
758 "Color the `dolist' at point."
761 (context-coloring-elisp-colorize-scope
763 (setq syntax-code (context-coloring-get-syntax-code))
764 (when (= syntax-code context-coloring-OPEN-PARENTHESIS-CODE)
766 (context-coloring-elisp-forward-sws)
767 (while (/= (setq syntax-code (context-coloring-get-syntax-code))
768 context-coloring-CLOSE-PARENTHESIS-CODE)
771 (or (= index 0) (= index 2))
772 (context-coloring-elisp-identifier-p syntax-code))
773 ;; Add the first or third name to the scope.
774 (context-coloring-elisp-parse-bindable
776 (context-coloring-elisp-add-variable variable))))
779 (context-coloring-elisp-colorize-sexp)))
780 (context-coloring-elisp-forward-sws)
781 (setq index (1+ index)))
785 (defun context-coloring-elisp-colorize-quote ()
786 "Color the `quote' at point."
787 (let* ((start (point))
788 (end (progn (forward-sexp)
790 (context-coloring-colorize-region
793 (context-coloring-elisp-get-current-scope-level))
794 (context-coloring-elisp-colorize-comments-and-strings-in-region start end)))
796 (defvar context-coloring-elisp-callee-dispatch-hash-table
797 (let ((table (make-hash-table :test 'equal)))
798 (dolist (callee '("defun" "defun*" "defsubst" "defmacro" "cl-defun" "cl-defsubst" "cl-defmacro"))
799 (puthash callee #'context-coloring-elisp-colorize-defun table))
800 (dolist (callee '("condition-case" "condition-case-unless-debug"))
801 (puthash callee #'context-coloring-elisp-colorize-condition-case table))
802 (dolist (callee '("dolist" "dotimes"))
803 (puthash callee #'context-coloring-elisp-colorize-dolist table))
804 (puthash "let" #'context-coloring-elisp-colorize-let table)
805 (puthash "let*" #'context-coloring-elisp-colorize-let* table)
806 (puthash "lambda" #'context-coloring-elisp-colorize-lambda table)
807 (puthash "cond" #'context-coloring-elisp-colorize-cond table)
808 (puthash "defadvice" #'context-coloring-elisp-colorize-defadvice table)
809 (puthash "quote" #'context-coloring-elisp-colorize-quote table)
810 (puthash "backquote" #'context-coloring-elisp-colorize-backquote table)
812 "Map function names to their coloring functions.")
814 (defun context-coloring-elisp-colorize-parenthesized-sexp ()
815 "Color the sexp enclosed by parenthesis at point."
816 (context-coloring-elisp-increment-sexp-count)
817 (let* ((start (point))
818 (end (progn (forward-sexp)
820 (syntax-code (progn (goto-char start)
822 ;; Coloring is unnecessary here, it'll happen
824 (context-coloring-forward-sws)
825 (context-coloring-get-syntax-code)))
827 ;; Figure out if the sexp is a special form.
829 ((and (context-coloring-elisp-identifier-p syntax-code)
830 (setq dispatch-function (gethash
831 (buffer-substring-no-properties
833 (progn (forward-sexp)
835 context-coloring-elisp-callee-dispatch-hash-table)))
837 (funcall dispatch-function))
838 ;; Not a special form; just colorize the remaining region.
840 (context-coloring-colorize-region
843 (context-coloring-elisp-get-current-scope-level))
844 (context-coloring-elisp-colorize-region (point) (1- end))
847 (defun context-coloring-elisp-colorize-symbol ()
848 "Color the symbol at point."
849 (context-coloring-elisp-increment-sexp-count)
850 (let* ((symbol-pos (point))
851 (symbol-end (progn (forward-sexp)
853 (symbol-string (buffer-substring-no-properties
857 ((string-match-p context-coloring-elisp-ignored-word-regexp symbol-string))
859 (context-coloring-colorize-region
862 (context-coloring-elisp-get-variable-level
865 (defun context-coloring-elisp-colorize-backquote-form ()
866 "Color the backquote form at point."
867 (let ((start (point))
868 (end (progn (forward-sexp)
872 (while (> end (progn (forward-char)
874 (setq char (char-after))
875 (when (= char context-coloring-COMMA-CHAR)
877 (when (= (char-after) context-coloring-AT-CHAR)
878 ;; If we don't do this "@" could be interpreted as a symbol.
880 (context-coloring-elisp-forward-sws)
881 (context-coloring-elisp-colorize-sexp)))
882 ;; We could probably do this as part of the above loop but it'd be
884 (context-coloring-elisp-colorize-comments-and-strings-in-region
887 (defun context-coloring-elisp-colorize-backquote ()
888 "Color the `backquote' at point."
889 (context-coloring-elisp-skip-callee-name)
890 (context-coloring-elisp-colorize-backquote-form)
894 (defun context-coloring-elisp-colorize-expression-prefix ()
895 "Color the expression prefix and the following expression at
896 point. It could be a quoted or backquoted expression."
897 (context-coloring-elisp-increment-sexp-count)
899 ((/= (char-after) context-coloring-BACKTICK-CHAR)
900 (context-coloring-elisp-forward-sexp))
902 (context-coloring-elisp-colorize-backquote-form))))
904 (defun context-coloring-elisp-colorize-comment ()
905 "Color the comment at point."
906 (context-coloring-elisp-increment-sexp-count)
907 (context-coloring-elisp-forward-sws))
909 (defun context-coloring-elisp-colorize-string ()
910 "Color the string at point."
911 (context-coloring-elisp-increment-sexp-count)
912 (let ((start (point)))
914 (context-coloring-colorize-comments-and-strings start (point))))
916 ;; Elisp has whitespace, words, symbols, open/close parenthesis, expression
917 ;; prefix, string quote, comment starters/enders and escape syntax classes only.
919 (defun context-coloring-elisp-colorize-sexp ()
920 "Color the sexp at point."
921 (let ((syntax-code (context-coloring-get-syntax-code)))
923 ((= syntax-code context-coloring-OPEN-PARENTHESIS-CODE)
924 (context-coloring-elisp-colorize-parenthesized-sexp))
925 ((context-coloring-elisp-identifier-p syntax-code)
926 (context-coloring-elisp-colorize-symbol))
927 ((= syntax-code context-coloring-EXPRESSION-PREFIX-CODE)
928 (context-coloring-elisp-colorize-expression-prefix))
929 ((= syntax-code context-coloring-STRING-QUOTE-CODE)
930 (context-coloring-elisp-colorize-string))
931 ((= syntax-code context-coloring-ESCAPE-CODE)
934 (defun context-coloring-elisp-colorize-comments-and-strings-in-region (start end)
935 "Color comments and strings between START and END."
938 (while (> end (progn (skip-syntax-forward "^\"<\\" end)
940 (setq syntax-code (context-coloring-get-syntax-code))
942 ((= syntax-code context-coloring-STRING-QUOTE-CODE)
943 (context-coloring-elisp-colorize-string))
944 ((= syntax-code context-coloring-COMMENT-START-CODE)
945 (context-coloring-elisp-colorize-comment))
946 ((= syntax-code context-coloring-ESCAPE-CODE)
947 (forward-char 2))))))
949 (defun context-coloring-elisp-colorize-region (start end)
950 "Color everything between START and END."
953 (while (> end (progn (skip-syntax-forward "^w_('\"<\\" end)
955 (setq syntax-code (context-coloring-get-syntax-code))
957 ((= syntax-code context-coloring-OPEN-PARENTHESIS-CODE)
958 (context-coloring-elisp-colorize-parenthesized-sexp))
959 ((context-coloring-elisp-identifier-p syntax-code)
960 (context-coloring-elisp-colorize-symbol))
961 ((= syntax-code context-coloring-EXPRESSION-PREFIX-CODE)
962 (context-coloring-elisp-colorize-expression-prefix))
963 ((= syntax-code context-coloring-STRING-QUOTE-CODE)
964 (context-coloring-elisp-colorize-string))
965 ((= syntax-code context-coloring-COMMENT-START-CODE)
966 (context-coloring-elisp-colorize-comment))
967 ((= syntax-code context-coloring-ESCAPE-CODE)
968 (forward-char 2))))))
970 (defun context-coloring-elisp-colorize-region-initially (start end)
971 "Begin coloring everything between START and END."
972 (setq context-coloring-elisp-sexp-count 0)
973 (setq context-coloring-elisp-scope-stack '())
974 (let ((inhibit-point-motion-hooks t)
975 (case-fold-search nil)
976 ;; This is a recursive-descent parser, so give it a big stack.
977 (max-lisp-eval-depth (max max-lisp-eval-depth 3000))
978 (max-specpdl-size (max max-specpdl-size 3000)))
979 (context-coloring-elisp-colorize-region start end)))
981 (defun context-coloring-elisp-colorize-guard (callback)
982 "Silently color in CALLBACK."
983 (with-silent-modifications
987 ;; Scan errors can happen virtually anywhere if parenthesis are
988 ;; unbalanced. Just swallow them. (`progn' for test coverage.)
989 (scan-error (progn))))))
991 (defun context-coloring-elisp-colorize ()
992 "Color the current buffer, parsing elisp to determine its
993 scopes and variables."
995 (context-coloring-elisp-colorize-guard
998 ;; Just colorize the changed region.
999 (context-coloring-changed-p
1000 (let* ( ;; Prevent `beginning-of-defun' from making poor assumptions.
1001 (open-paren-in-column-0-is-defun-start nil)
1002 ;; Seek the beginning and end of the previous and next
1003 ;; offscreen defuns, so just enough is colored.
1004 (start (progn (goto-char context-coloring-changed-start)
1005 (while (and (< (point-min) (point))
1006 (pos-visible-in-window-p))
1008 (beginning-of-defun)
1010 (end (progn (goto-char context-coloring-changed-end)
1011 (while (and (> (point-max) (point))
1012 (pos-visible-in-window-p))
1016 (context-coloring-elisp-colorize-region-initially start end)
1017 ;; Fast coloring is nice, but if the code is not well-formed
1018 ;; (e.g. an unclosed string literal is parsed at any time) then
1019 ;; there could be leftover incorrectly-colored code offscreen. So
1020 ;; do a clean sweep as soon as appropriate.
1021 (context-coloring-schedule-coloring context-coloring-default-delay)))
1023 (context-coloring-elisp-colorize-region-initially (point-min) (point-max)))))))
1026 ;;; eval-expression colorization
1028 (defun context-coloring-eval-expression-colorize ()
1029 "Color the `eval-expression' minibuffer prompt as elisp."
1031 (context-coloring-elisp-colorize-guard
1033 (context-coloring-elisp-colorize-region-initially
1035 (string-match "\\`Eval: " (buffer-string))
1042 (defvar context-coloring-dispatch-hash-table (make-hash-table :test #'eq)
1043 "Map dispatch strategy names to their corresponding property
1044 lists, which contain details about the strategies.")
1046 (defvar context-coloring-mode-hash-table (make-hash-table :test #'eq)
1047 "Map major mode names to dispatch property lists.")
1049 (defvar context-coloring-dispatch-predicates '()
1050 "Functions which may return a dispatch.")
1052 (defun context-coloring-get-current-dispatch ()
1053 "Return the first dispatch appropriate for the current state."
1054 (let ((predicates context-coloring-dispatch-predicates)
1057 ;; Maybe a predicate will be satisfied and return a dispatch.
1058 (while (and predicates
1059 (not (setq dispatch (funcall (pop predicates))))))
1060 ;; If not, maybe a major mode (or a derivative) will define a dispatch.
1061 (when (not dispatch)
1063 (not (setq dispatch (gethash parent context-coloring-mode-hash-table)))
1064 (setq parent (get parent 'derived-mode-parent)))))
1067 (defun context-coloring-define-dispatch (symbol &rest properties)
1068 "Define a new dispatch named SYMBOL with PROPERTIES.
1070 A \"dispatch\" is a property list describing a strategy for
1073 PROPERTIES must include one of `:modes' or `:predicate', and a
1076 `:modes' - List of major modes this dispatch is valid for.
1078 `:predicate' - Function that determines if the dispatch is valid
1079 for any given state.
1081 `:colorizer' - Function that parses and colors the buffer.
1083 `:delay' - Delay between buffer update and colorization, to
1084 override `context-coloring-default-delay'.
1086 `:setup' - Arbitrary code to set up this dispatch when
1087 `context-coloring-mode' is enabled.
1089 `:teardown' - Arbitrary code to tear down this dispatch when
1090 `context-coloring-mode' is disabled."
1091 (let ((modes (plist-get properties :modes))
1092 (predicate (plist-get properties :predicate))
1093 (colorizer (plist-get properties :colorizer)))
1094 (when (null (or modes predicate))
1095 (error "No mode or predicate defined for dispatch"))
1096 (when (not colorizer)
1097 (error "No colorizer defined for dispatch"))
1098 (puthash symbol properties context-coloring-dispatch-hash-table)
1099 (dolist (mode modes)
1100 (puthash mode properties context-coloring-mode-hash-table))
1103 (when (funcall predicate)
1104 properties)) context-coloring-dispatch-predicates))))
1106 (defun context-coloring-dispatch ()
1107 "Determine the optimal track for scopification / coloring of
1108 the current buffer, then execute it."
1109 (let* ((dispatch (context-coloring-get-current-dispatch))
1110 (colorizer (plist-get dispatch :colorizer)))
1112 (funcall colorizer))))
1117 (defun context-coloring-colorize ()
1118 "Color the current buffer by function context."
1120 (context-coloring-dispatch))
1122 (defun context-coloring-colorize-with-buffer (buffer)
1124 ;; Don't select deleted buffers.
1125 (when (get-buffer buffer)
1126 (with-current-buffer buffer
1127 (context-coloring-colorize))))
1132 (defvar context-coloring-theme-hash-table (make-hash-table :test #'eq)
1133 "Map theme names to theme properties.")
1135 (defun context-coloring-theme-p (theme)
1136 "Return t if THEME is defined, nil otherwise."
1137 (and (gethash theme context-coloring-theme-hash-table)))
1139 (defconst context-coloring-level-face-regexp
1140 "context-coloring-level-\\([[:digit:]]+\\)-face"
1141 "Extract a level from a face.")
1143 (defvar context-coloring-originally-set-theme-hash-table
1144 (make-hash-table :test #'eq)
1145 "Cache custom themes who originally set their own
1146 `context-coloring-level-N-face' faces.")
1148 (defun context-coloring-theme-originally-set-p (theme)
1149 "Return t if there is a `context-coloring-level-N-face'
1150 originally set for THEME, nil otherwise."
1151 (let (originally-set)
1153 ;; `setq' might return a non-nil value for the sake of this `cond'.
1158 context-coloring-originally-set-theme-hash-table))
1159 (eq originally-set 'yes))
1161 (let* ((settings (get theme 'theme-settings))
1164 (while (and tail (not found))
1165 (and (eq (nth 0 (car tail)) 'theme-face)
1167 context-coloring-level-face-regexp
1168 (symbol-name (nth 1 (car tail))))
1170 (setq tail (cdr tail)))
1173 (defun context-coloring-cache-originally-set (theme originally-set)
1174 "Remember if THEME had colors originally set for it. If
1175 ORIGINALLY-SET is non-nil, it did, otherwise it didn't."
1176 ;; Caching whether a theme was originally set is kind of dirty, but we have to
1177 ;; do it to remember the past state of the theme. There are probably some
1178 ;; edge cases where caching will be an issue, but they are probably rare.
1181 (if originally-set 'yes 'no)
1182 context-coloring-originally-set-theme-hash-table))
1184 (defun context-coloring-warn-theme-originally-set (theme)
1185 "Warn the user that the colors for THEME are already originally
1187 (warn "Context coloring colors for theme `%s' are already defined" theme))
1189 (defun context-coloring-theme-highest-level (theme)
1190 "Return the highest level N of a face like
1191 `context-coloring-level-N-face' set for THEME, or `-1' if there
1193 (let* ((settings (get theme 'theme-settings))
1199 (and (eq (nth 0 (car tail)) 'theme-face)
1200 (setq face-string (symbol-name (nth 1 (car tail))))
1202 context-coloring-level-face-regexp
1204 (setq number (string-to-number
1205 (substring face-string
1209 (setq found number))
1210 (setq tail (cdr tail)))
1213 (defun context-coloring-apply-theme (theme)
1214 "Apply THEME's properties to its respective custom theme,
1215 which must already exist and which *should* already be enabled."
1216 (let* ((properties (gethash theme context-coloring-theme-hash-table))
1217 (colors (plist-get properties :colors))
1219 ;; Only clobber when we have to.
1220 (when (custom-theme-enabled-p theme)
1221 (setq context-coloring-maximum-face (- (length colors) 1)))
1223 #'custom-theme-set-faces
1227 (setq level (+ level 1))
1228 `(,(context-coloring-level-face level) ((t (:foreground ,color)))))
1231 (defun context-coloring-define-theme (theme &rest properties)
1232 "Define a context theme named THEME for coloring scope levels.
1234 PROPERTIES is a property list specifiying the following details:
1236 `:aliases': List of symbols of other custom themes that these
1237 colors are applicable to.
1239 `:colors': List of colors that this context theme uses.
1241 `:override': If non-nil, this context theme is intentionally
1242 overriding colors set by a custom theme. Don't set this non-nil
1243 unless there is a custom theme you want to use which sets
1244 `context-coloring-level-N-face' faces that you want to replace.
1246 `:recede': If non-nil, this context theme should not apply its
1247 colors if a custom theme already sets
1248 `context-coloring-level-N-face' faces. This option is
1249 optimistic; set this non-nil if you would rather confer the duty
1250 of picking colors to a custom theme author (if / when he ever
1253 By default, context themes will always override custom themes,
1254 even if those custom themes set `context-coloring-level-N-face'
1255 faces. If a context theme does override a custom theme, a
1256 warning will be raised, at which point you may want to enable the
1257 `:override' option, or just delete your context theme and opt to
1258 use your custom theme's author's colors instead.
1260 Context themes only work for the custom theme with the highest
1261 precedence, i.e. the car of `custom-enabled-themes'."
1262 (let ((aliases (plist-get properties :aliases))
1263 (override (plist-get properties :override))
1264 (recede (plist-get properties :recede)))
1265 (dolist (name (append `(,theme) aliases))
1266 (puthash name properties context-coloring-theme-hash-table)
1267 (when (custom-theme-p name)
1268 (let ((originally-set (context-coloring-theme-originally-set-p name)))
1269 (context-coloring-cache-originally-set name originally-set)
1270 ;; In the particular case when you innocently define colors that a
1271 ;; custom theme originally set, warn. Arguably this only has to be
1272 ;; done at enable time, but it is probably more useful to do it at
1273 ;; definition time for prompter feedback.
1274 (when (and originally-set
1277 (context-coloring-warn-theme-originally-set name))
1278 ;; Set (or overwrite) colors.
1279 (when (not (and originally-set
1281 (context-coloring-apply-theme name)))))))
1283 (defun context-coloring-enable-theme (theme)
1284 "Apply THEME if its colors are not already set, else just set
1285 `context-coloring-maximum-face' to the correct value for THEME."
1286 (let* ((properties (gethash theme context-coloring-theme-hash-table))
1287 (recede (plist-get properties :recede))
1288 (override (plist-get properties :override)))
1291 (let ((highest-level (context-coloring-theme-highest-level theme)))
1293 ;; This can be true whether originally set by a custom theme or by a
1295 ((> highest-level -1)
1296 (setq context-coloring-maximum-face highest-level))
1297 ;; It is possible that the corresponding custom theme did not exist at
1298 ;; the time of defining this context theme, and in that case the above
1299 ;; condition proves the custom theme did not originally set any faces,
1300 ;; so we have license to apply the context theme for the first time
1303 (context-coloring-apply-theme theme)))))
1305 (let ((originally-set (context-coloring-theme-originally-set-p theme)))
1306 ;; Cache now in case the context theme was defined after the custom
1308 (context-coloring-cache-originally-set theme originally-set)
1309 (when (and originally-set
1311 (context-coloring-warn-theme-originally-set theme))
1312 (context-coloring-apply-theme theme))))))
1314 (defadvice enable-theme (after context-coloring-enable-theme (theme) activate)
1315 "Enable colors for context themes just-in-time."
1316 (when (and (not (eq theme 'user)) ; Called internally by `enable-theme'.
1317 (custom-theme-p theme) ; Guard against non-existent themes.
1318 (context-coloring-theme-p theme))
1319 (when (= (length custom-enabled-themes) 1)
1320 ;; Cache because we can't reliably figure it out in reverse.
1321 (setq context-coloring-original-maximum-face
1322 context-coloring-maximum-face))
1323 (context-coloring-enable-theme theme)))
1325 (defadvice disable-theme (after context-coloring-disable-theme (theme) activate)
1326 "Update `context-coloring-maximum-face'."
1327 (when (custom-theme-p theme) ; Guard against non-existent themes.
1328 (let ((enabled-theme (car custom-enabled-themes)))
1330 ((context-coloring-theme-p enabled-theme)
1331 (context-coloring-enable-theme enabled-theme))
1333 ;; Assume we are back to no theme; act as if nothing ever happened.
1334 ;; This is still prone to intervention, but rather extraordinarily.
1335 (setq context-coloring-maximum-face
1336 context-coloring-original-maximum-face))))))
1338 (context-coloring-define-theme
1350 (context-coloring-define-theme
1365 (context-coloring-define-theme
1377 (context-coloring-define-theme
1390 (context-coloring-define-theme
1403 (context-coloring-define-theme
1406 :aliases '(solarized-light
1408 sanityinc-solarized-light
1409 sanityinc-solarized-dark)
1428 (context-coloring-define-theme
1440 (context-coloring-define-theme
1457 (context-coloring-define-theme
1473 ;;; Built-in dispatches
1475 (context-coloring-define-dispatch
1478 :colorizer #'context-coloring-js2-colorize
1481 (add-hook 'js2-post-parse-callbacks #'context-coloring-colorize nil t))
1484 (remove-hook 'js2-post-parse-callbacks #'context-coloring-colorize t)))
1486 (context-coloring-define-dispatch
1488 :modes '(emacs-lisp-mode)
1489 :colorizer #'context-coloring-elisp-colorize
1490 :delay 0.016 ;; Thanks to lazy colorization this can be 60 frames per second.
1491 :setup #'context-coloring-setup-idle-change-detection
1492 :teardown #'context-coloring-teardown-idle-change-detection)
1494 ;; `eval-expression-minibuffer-setup-hook' is not available in Emacs 24.3, so
1495 ;; the backwards-compatible recommendation is to use `minibuffer-setup-hook' and
1496 ;; rely on this predicate instead.
1497 (defun context-coloring-eval-expression-predicate ()
1498 "Non-nil if the minibuffer is for `eval-expression'."
1499 (eq this-command 'eval-expression))
1501 (context-coloring-define-dispatch
1503 :predicate #'context-coloring-eval-expression-predicate
1504 :colorizer #'context-coloring-eval-expression-colorize
1506 :setup #'context-coloring-setup-idle-change-detection
1507 :teardown #'context-coloring-teardown-idle-change-detection)
1513 (define-minor-mode context-coloring-mode
1514 "Toggle contextual code coloring.
1515 With a prefix argument ARG, enable Context Coloring mode if ARG
1516 is positive, and disable it otherwise. If called from Lisp,
1517 enable the mode if ARG is omitted or nil.
1519 Context Coloring mode is a buffer-local minor mode. When
1520 enabled, code is colored by scope. Scopes are colored
1521 hierarchically. Variables referenced from nested scopes retain
1522 the color of their defining scopes. Certain syntax, like
1523 comments and strings, is still colored with `font-lock'.
1525 The entire buffer is colored initially. Changes to the buffer
1528 Certain custom themes have predefined colors from their palettes
1529 to use for coloring. See `context-coloring-theme-hash-table' for
1530 the supported themes. If the currently-enabled custom theme is
1531 not among these, you can define colors for it with
1532 `context-coloring-define-theme', which see.
1534 New language / major mode support can be added with
1535 `context-coloring-define-dispatch', which see.
1537 Feature inspired by Douglas Crockford."
1540 (context-coloring-mode
1541 ;; Font lock is incompatible with this mode; the converse is also true.
1544 ;; ...but we do use font-lock functions here.
1545 (font-lock-set-defaults)
1546 ;; Safely change the value of this function as necessary.
1547 (make-local-variable 'font-lock-syntactic-face-function)
1548 (let ((dispatch (context-coloring-get-current-dispatch)))
1551 (let ((setup (plist-get dispatch :setup)))
1554 ;; Colorize once initially.
1555 (let ((context-coloring-parse-interruptable-p nil))
1556 (context-coloring-colorize))))
1558 (message "Context coloring is not available for this major mode")))))
1560 (let ((dispatch (context-coloring-get-current-dispatch)))
1562 (let ((teardown (plist-get dispatch :teardown)))
1564 (funcall teardown)))))
1566 (jit-lock-mode t))))
1568 (provide 'context-coloring)
1570 ;;; context-coloring.el ends here