1 ;;; context-coloring.el --- Syntax highlighting, except not for syntax. -*- lexical-binding: t; -*-
3 ;; Copyright (C) 2014 Jackson Ray Hamilton
5 ;; Author: Jackson Ray Hamilton <jackson@jacksonrayhamilton.com>
6 ;; Keywords: context coloring syntax highlighting
8 ;; Package-Requires: ((emacs "24"))
10 ;; This program is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
15 ;; This program is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
25 ;; Colors code by scope, rather than by syntax.
27 ;; A range of characters encompassing a scope is colored according to its level;
28 ;; the global scope is white, scopes within the global scope are yellow, scopes
29 ;; within scopes within the global scope are green, etc. Variables defined in a
30 ;; parent scope which are referenced from child scopes retain the same color as
31 ;; the scope in which they are defined; a variable defined in the global scope
32 ;; will be the same color when referenced from nested scopes.
34 ;; To use, add the following to your ~/.emacs:
36 ;; (require 'context-coloring)
37 ;; (add-hook 'js-mode-hook 'context-coloring-mode) ; Requires Node.js 0.10+.
44 (defconst context-coloring-path
45 (file-name-directory (or load-file-name buffer-file-name))
46 "This file's directory.")
49 ;;; Customizable options
51 (defcustom context-coloring-delay 0.25
52 "Delay between a buffer update and colorization.
54 Increase this if your machine is high-performing. Decrease it if it ain't."
55 :group 'context-coloring)
57 (defcustom context-coloring-block-scopes nil
58 "If non-nil, add block scopes to the scope hierarchy.
60 The block-scope-inducing `let' and `const' are introduced in
61 ES6. If you are writing ES6 code, then turn this on; otherwise,
62 confusion will ensue."
63 :group 'context-coloring)
68 (defvar-local context-coloring-buffer nil
69 "Reference to this buffer (for timers).")
71 (defvar-local context-coloring-scopifier-process nil
72 "Only allow a single scopifier process to run at a time. This
73 is a reference to that one process.")
75 (defvar-local context-coloring-colorize-idle-timer nil
76 "Reference to currently-running idle timer.")
78 (defvar-local context-coloring-changed nil
79 "Indication that the buffer has changed recently, which would
80 imply that it should be colorized again.")
85 (defface context-coloring-level--1-face
86 '((((type tty)) (:foreground "white"))
87 (t (:foreground "#7f7f7f")))
88 "Context coloring face, level -1; comments."
89 :group 'context-coloring-faces)
91 (defface context-coloring-level-0-face
92 '((((type tty)) (:foreground "white"))
93 (((background light)) (:foreground "#000000"))
94 (((background dark)) (:foreground "#ffffff")))
95 "Context coloring face, level 0; global scope."
96 :group 'context-coloring-faces)
98 (defface context-coloring-level-1-face
99 '((((type tty)) (:foreground "yellow"))
100 (((background light)) (:foreground "#007f80"))
101 (((background dark)) (:foreground "#ffff80")))
102 "Context coloring face, level 1."
103 :group 'context-coloring-faces)
105 (defface context-coloring-level-2-face
106 '((((type tty)) (:foreground "green"))
107 (((background light)) (:foreground "#001580"))
108 (((background dark)) (:foreground "#cdfacd")))
109 "Context coloring face, level 2."
110 :group 'context-coloring-faces)
112 (defface context-coloring-level-3-face
113 '((((type tty)) (:foreground "cyan"))
114 (((background light)) (:foreground "#550080"))
115 (((background dark)) (:foreground "#d8d8ff")))
116 "Context coloring face, level 3."
117 :group 'context-coloring-faces)
119 (defface context-coloring-level-4-face
120 '((((type tty)) (:foreground "blue"))
121 (((background light)) (:foreground "#802b00"))
122 (((background dark)) (:foreground "#e7c7ff")))
123 "Context coloring face, level 4."
124 :group 'context-coloring-faces)
126 (defface context-coloring-level-5-face
127 '((((type tty)) (:foreground "magenta"))
128 (((background light)) (:foreground "#6a8000"))
129 (((background dark)) (:foreground "#ffcdcd")))
130 "Context coloring face, level 5."
131 :group 'context-coloring-faces)
133 (defface context-coloring-level-6-face
134 '((((type tty)) (:foreground "red"))
135 (((background light)) (:foreground "#008000"))
136 (((background dark)) (:foreground "#ffe390")))
137 "Context coloring face, level 6."
138 :group 'context-coloring-faces)
140 ;;; Additional 6 faces for insane levels of nesting
142 (defface context-coloring-level-7-face
143 '((t (:inherit context-coloring-level-1-face)))
144 "Context coloring face, level 7."
145 :group 'context-coloring-faces)
147 (defface context-coloring-level-8-face
148 '((t (:inherit context-coloring-level-2-face)))
149 "Context coloring face, level 8."
150 :group 'context-coloring-faces)
152 (defface context-coloring-level-9-face
153 '((t (:inherit context-coloring-level-3-face)))
154 "Context coloring face, level 9."
155 :group 'context-coloring-faces)
157 (defface context-coloring-level-10-face
158 '((t (:inherit context-coloring-level-4-face)))
159 "Context coloring face, level 10."
160 :group 'context-coloring-faces)
162 (defface context-coloring-level-11-face
163 '((t (:inherit context-coloring-level-5-face)))
164 "Context coloring face, level 11."
165 :group 'context-coloring-faces)
167 (defface context-coloring-level-12-face
168 '((t (:inherit context-coloring-level-6-face)))
169 "Context coloring face, level 12."
170 :group 'context-coloring-faces)
172 (defcustom context-coloring-face-count 7
173 "Number of faces defined for highlighting delimiter levels.
174 Determines level at which to cycle through faces again.")
179 (defsubst context-coloring-level-face (level)
180 "Return face-name for LEVEL as a string \"context-coloring-level-LEVEL-face\".
181 For example: \"context-coloring-level-1-face\"."
183 (concat "context-coloring-level-"
186 ;; Has a face directly mapping to it.
187 (and (< level context-coloring-face-count)
189 ;; After the number of available faces are used up, pretend the 0th
190 ;; face doesn't exist.
193 (- context-coloring-face-count 1)))))
197 ;;; Colorization utilities
199 (defun context-coloring-uncolorize-buffer ()
200 "Clears all coloring in the current buffer."
201 (remove-text-properties (point-min) (point-max) `(face nil rear-nonsticky nil)))
203 (defsubst context-coloring-colorize-region (start end level)
204 "Colorizes characters from 1-indexed START (inclusive) to END
205 \(exclusive) with the face corresponding to LEVEL."
209 `(face ,(context-coloring-level-face level) rear-nonsticky t)))
212 ;;; js2-mode colorization
214 (defsubst context-coloring-js2-scope-level (scope)
215 "Gets the level of SCOPE."
218 (while (and (not (null scope))
219 (not (null (js2-node-parent scope)))
220 (not (null (setq enclosing-scope (js2-node-get-enclosing-scope scope)))))
221 (when (or context-coloring-block-scopes
222 (let ((type (js2-scope-type scope)))
223 (or (= type js2-SCRIPT)
224 (= type js2-FUNCTION)
227 (setq level (+ level 1)))
228 (setq scope enclosing-scope))
231 ;; Adapted from js2-refactor.el/js2r-vars.el
232 (defsubst context-coloring-js2-local-name-node-p (node)
233 (and (js2-name-node-p node)
234 (let ((start (js2-node-abs-pos node)))
236 ;; (save-excursion ; not key in object literal { key: value }
237 ;; (goto-char (+ (js2-node-abs-pos node) (js2-node-len node)))
238 ;; (looking-at "[\n\t ]*:"))
239 (let ((end (+ start (js2-node-len node))))
240 (not (string-match "[\n\t ]*:" (buffer-substring-no-properties
243 ;; (save-excursion ; not property lookup on object
244 ;; (goto-char (js2-node-abs-pos node))
245 ;; (looking-back "\\.[\n\t ]*"))
246 (not (string-match "\\.[\n\t ]*" (buffer-substring-no-properties
247 (max 1 (- start 1)) ; 0 throws an
252 (defun context-coloring-js2-colorize ()
253 (with-silent-modifications
254 (context-coloring-uncolorize-buffer)
261 (let ((start (js2-node-abs-pos node)))
262 (context-coloring-colorize-region
264 (+ start (js2-scope-len node)) ; End
265 (context-coloring-js2-scope-level node) ; Level
267 ((context-coloring-js2-local-name-node-p node)
268 (let ((start (js2-node-abs-pos node)))
269 (context-coloring-colorize-region
271 (+ start (js2-name-node-len node)) ; End
272 (context-coloring-js2-scope-level ; Level
273 (js2-get-defining-scope
274 (js2-node-get-enclosing-scope node)
275 (js2-name-node-name node)))))))
276 ;; The `t' indicates to search children.
280 ;;; Shell command copification / colorization
282 (defun context-coloring-apply-tokens (tokens)
283 "Processes a vector of TOKENS to apply context-based coloring
284 to the current buffer. Tokens are 3 integers: start, end,
285 level. The vector is flat, with a new token occurring after every
287 (with-silent-modifications
288 (context-coloring-uncolorize-buffer)
290 (len (length tokens)))
292 (context-coloring-colorize-region
295 (elt tokens (+ i 2)))
298 (defun context-coloring-parse-array (input)
299 "Specialized JSON parser for a flat array of numbers."
300 (vconcat (mapcar 'string-to-number (split-string (substring input 1 -1) ","))))
302 (defun context-coloring-kill-scopifier ()
303 "Kills the currently-running scopifier process for this
305 (when (not (null context-coloring-scopifier-process))
306 (delete-process context-coloring-scopifier-process)
307 (setq context-coloring-scopifier-process nil)))
309 (defun context-coloring-scopify-shell-command (command)
310 "Invokes a scopifier with the current buffer's contents,
311 reading the scopifier's response asynchronously and applying a
312 parsed list of tokens to `context-coloring-apply-tokens'."
314 ;; Prior running tokenization is implicitly obsolete if this function is
316 (context-coloring-kill-scopifier)
318 ;; Start the process.
319 (setq context-coloring-scopifier-process
320 (start-process-shell-command "scopifier" nil command))
323 (buffer context-coloring-buffer))
325 ;; The process may produce output in multiple chunks. This filter
326 ;; accumulates the chunks into a message.
328 context-coloring-scopifier-process
329 (lambda (process chunk)
330 (setq output (concat output chunk))))
332 ;; When the process's message is complete, this sentinel parses it as JSON
333 ;; and applies the tokens to the buffer.
334 (set-process-sentinel
335 context-coloring-scopifier-process
336 (lambda (process event)
337 (when (equal "finished\n" event)
338 (let ((tokens (context-coloring-parse-array output)))
339 (with-current-buffer buffer
340 (context-coloring-apply-tokens tokens))
341 (setq context-coloring-scopifier-process nil))))))
343 ;; Give the process its input so it can begin.
344 (process-send-region context-coloring-scopifier-process (point-min) (point-max))
345 (process-send-eof context-coloring-scopifier-process))
350 (defvar context-coloring-javascript-scopifier
351 `(:type shell-command
353 :command ,(expand-file-name
354 "./languages/javascript/bin/scopifier"
355 context-coloring-path)))
357 (defvar context-coloring-js2-colorizer
359 :colorizer context-coloring-js2-colorize))
361 (defcustom context-coloring-dispatch-plist
362 `(js-mode ,context-coloring-javascript-scopifier
363 js2-mode ,context-coloring-js2-colorizer
364 js3-mode ,context-coloring-javascript-scopifier)
365 "Property list mapping major modes to scopification programs."
366 :group 'context-coloring)
368 (defun context-coloring-dispatch ()
369 "Determines the optimal track for scopification / colorization
370 of the current buffer, then does it."
371 (let ((dispatch (plist-get context-coloring-dispatch-plist major-mode)))
373 (message "%s" "Context coloring is not available for this major mode"))
374 (let ((type (plist-get dispatch :type)))
377 (let ((colorizer (plist-get dispatch :colorizer))
378 (scopifier (plist-get dispatch :scopifier)))
380 ((not (null colorizer))
382 ((not (null scopifier))
383 (context-coloring-apply-tokens (funcall scopifier)))
385 (error "No `:colorizer' nor `:scopifier' specified for dispatch of `:type' elisp")))))
386 ((eq type 'shell-command)
387 (let ((executable (plist-get dispatch :executable))
388 (command (plist-get dispatch :command)))
390 (error "No `:command' specified for dispatch of `:type' shell-command"))
391 (if (and (not (null executable))
392 (null (executable-find executable)))
393 (message "Executable \"%s\" not found" executable))
394 (context-coloring-scopify-shell-command command)))))))
399 (defun context-coloring-colorize ()
400 "Colors the current buffer by function context."
402 (context-coloring-dispatch))
404 (defun context-coloring-change-function (start end length)
405 "Registers a change so that a context-colored buffer can be
407 ;; Tokenization is obsolete if there was a change.
408 (context-coloring-kill-scopifier)
409 (setq context-coloring-changed t))
411 (defun context-coloring-maybe-colorize ()
412 "Colorize unders certain conditions. This will run as an idle
413 timer, so firstly the buffer must not be some other
414 buffer. Additionally, the buffer must have changed, otherwise
415 colorizing would be redundant."
416 (when (and (eq context-coloring-buffer (window-buffer (selected-window)))
417 context-coloring-changed)
418 (setq context-coloring-changed nil)
419 (context-coloring-colorize)))
425 (define-minor-mode context-coloring-mode
426 "Context-based code coloring, inspired by Douglas Crockford."
428 (if (not context-coloring-mode)
430 (context-coloring-kill-scopifier)
431 (when (not (null 'context-coloring-colorize-idle-timer))
432 (cancel-timer context-coloring-colorize-idle-timer))
433 (remove-hook 'after-change-functions 'context-coloring-change-function t)
437 ;; Remember this buffer. This value should not be dynamically-bound.
438 (setq context-coloring-buffer (current-buffer))
440 ;; Font lock is incompatible with this mode; the converse is also true.
444 ;; Colorize once initially.
445 ;; (let ((start-time (float-time)))
446 (context-coloring-colorize)
447 ;; (message "Elapsed time: %f" (- (float-time) start-time)))
449 ;; Only recolor on change.
450 (add-hook 'after-change-functions 'context-coloring-change-function nil t)
452 ;; Only recolor idly.
453 (setq context-coloring-colorize-idle-timer
454 (run-with-idle-timer context-coloring-delay t 'context-coloring-maybe-colorize))))
456 (provide 'context-coloring)
458 ;;; context-coloring.el ends here