-;; -*- lexical-binding: t -*-
+;;; context-coloring.el --- JavaScript syntax highlighting, except not for syntax. -*- lexical-binding: t; -*-
-(require 'json)
+;; Copyright (C) 2014 Jackson Ray Hamilton
+
+;; Author: Jackson Ray Hamilton <jackson@jacksonrayhamilton.com>
+;; Keywords: context coloring highlighting js javascript
+;; Version: 1.0.0
+;; Package-Requires: ((emacs "24"))
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Highlights JavaScript code according to function context.
+;;
+;; Usage:
+;;
+;; Install Node.js 0.10+.
+;; In your ~/.emacs:
+;;
+;; (require 'context-coloring)
+;; (add-hook 'js-mode-hook 'context-coloring-mode)
+
+;;; Code:
;;; Faces
+(defface context-coloring-depth--1-face
+ '((((type tty)) (:foreground "white"))
+ (((background light)) (:foreground "#7f7f7f"))
+ (((background dark)) (:foreground "#7f7f7f")))
+ "Context coloring face, depth -1; comments."
+ :group 'context-coloring-faces)
+
(defface context-coloring-depth-0-face
- '((((background light)) (:foreground "#ffffff"))
+ '((((type tty)) (:foreground "white"))
+ (((background light)) (:foreground "#000000"))
(((background dark)) (:foreground "#ffffff")))
- "Nested blocks face, depth 0 - outermost set."
- :tag "Rainbow Blocks Depth 0 Face -- OUTERMOST"
+ "Context coloring face, depth 0; global scope."
:group 'context-coloring-faces)
(defface context-coloring-depth-1-face
- '((((background light)) (:foreground "#ffff80"))
+ '((((type tty)) (:foreground "yellow"))
+ (((background light)) (:foreground "#2D6994"))
(((background dark)) (:foreground "#ffff80")))
- "Nested blocks face, depth 1."
+ "Context coloring face, depth 1."
:group 'context-coloring-faces)
(defface context-coloring-depth-2-face
- '((((background light)) (:foreground "#cdfacd"))
+ '((((type tty)) (:foreground "green"))
+ (((background light)) (:foreground "#592D94"))
(((background dark)) (:foreground "#cdfacd")))
- "Nested blocks face, depth 2."
+ "Context coloring face, depth 2."
:group 'context-coloring-faces)
(defface context-coloring-depth-3-face
- '((((background light)) (:foreground "#d8d8ff"))
+ '((((type tty)) (:foreground "cyan"))
+ (((background light)) (:foreground "#A13143"))
(((background dark)) (:foreground "#d8d8ff")))
- "Nested blocks face, depth 3."
+ "Context coloring face, depth 3."
:group 'context-coloring-faces)
(defface context-coloring-depth-4-face
- '((((background light)) (:foreground "#e7c7ff"))
+ '((((type tty)) (:foreground "blue"))
+ (((background light)) (:foreground "#AC7135"))
(((background dark)) (:foreground "#e7c7ff")))
- "Nested blocks face, depth 4."
+ "Context coloring face, depth 4."
:group 'context-coloring-faces)
(defface context-coloring-depth-5-face
- '((((background light)) (:foreground "#ffcdcd"))
+ '((((type tty)) (:foreground "magenta"))
+ (((background light)) (:foreground "#ACA135"))
(((background dark)) (:foreground "#ffcdcd")))
- "Nested blocks face, depth 5."
+ "Context coloring face, depth 5."
:group 'context-coloring-faces)
(defface context-coloring-depth-6-face
- '((((background light)) (:foreground "#ffe390"))
+ '((((type tty)) (:foreground "red"))
+ (((background light)) (:foreground "#539A2F"))
(((background dark)) (:foreground "#ffe390")))
- "Nested blocks face, depth 6."
- :group 'context-coloring-faces)
-
-(defface context-coloring-depth-7-face
- '((((background light)) (:foreground "#cdcdcd"))
- (((background dark)) (:foreground "#cdcdcd")))
- "Nested blocks face, depth 7."
+ "Context coloring face, depth 6."
:group 'context-coloring-faces)
-(defconst context-coloring-face-count 8
+(defconst context-coloring-face-count 7
"Number of faces defined for highlighting delimiter levels.
Determines depth at which to cycle through faces again.")
-;;; Face utility functions
+;;; Face functions
-(defun context-coloring-level-face (depth)
+(defsubst context-coloring-level-face (depth)
"Return face-name for DEPTH as a string \"context-coloring-depth-DEPTH-face\".
For example: \"context-coloring-depth-1-face\"."
(intern-soft
"-face")))
-;;; Path constants
+;;; Customizable variables
+
+(defcustom context-coloring-delay 0.25
+ "Delay between a buffer update and colorization.
+
+Increase this if your machine is high-performing. Decrease it if it ain't."
+ :group 'context-coloring)
+
+(defcustom context-coloring-benchmark-colorization nil
+ "If non-nil, display how long each colorization took."
+ :group 'context-coloring)
+
+
+;;; Local variables
+
+(defvar context-coloring-buffer nil
+ "Reference to this buffer (for timers).")
+(make-variable-buffer-local 'context-coloring-buffer)
+
+(defvar context-coloring-scopifier-process nil
+ "Only allow a single scopifier process to run at a time. This
+is a reference to that one process.")
+(make-variable-buffer-local 'context-coloring-scopifier-process)
+
+(defvar context-coloring-colorize-idle-timer nil
+ "Reference to currently-running idle timer.")
+(make-variable-buffer-local 'context-coloring-colorize-idle-timer)
+
+(defvar context-coloring-changed nil
+ "Indication that the buffer has changed recently, which would
+imply that it should be colorized again.")
+(make-variable-buffer-local 'context-coloring-changed)
+
+(defvar context-coloring-start-time nil
+ "Used to benchmark colorization time.")
+(make-variable-buffer-local 'context-coloring-start-time)
+
+
+;;; Scopification
(defconst context-coloring-path
(file-name-directory (or load-file-name buffer-file-name))
"This file's directory.")
-(defconst context-coloring-tokenizer-path
- (expand-file-name "./bin/tokenizer" context-coloring-path)
- "Path to the external tokenizer executable.")
-
-
-;;; Tokenization functions
+(defconst context-coloring-scopifier-path
+ (expand-file-name "./bin/scopifier" context-coloring-path)
+ "Path to the external scopifier executable.")
(defun context-coloring-apply-tokens (tokens)
- "Processes TOKENS to apply context-based coloring to the current buffer."
+ "Processes TOKENS to apply context-based coloring to the
+current buffer. Tokens are 3 integers: start, end, level. The
+array is flat, with a new token occurring after every 3rd
+number."
(with-silent-modifications
- (dolist (token tokens)
- (let ((start (cdr (assoc 's token)))
- (end (cdr (assoc 'e token)))
- (face (context-coloring-level-face (cdr (assoc 'l token)))))
- (add-text-properties start end `(font-lock-face ,face rear-nonsticky t))))))
-
-(defun context-coloring-tokenize (function)
- "Invokes the external tokenizer with the current buffer's
-contents, reading the tokenizer's response asynchronously and
-calling FUNCTION with the parsed list of tokens."
- (let ((tokenizer-process (start-process-shell-command
- "tokenizer"
- nil
- context-coloring-tokenizer-path))
- (output ""))
-
- ;; The process may produce output in multiple chunks. The chunks
- ;; collectively form a message.
- (set-process-filter tokenizer-process
+ ;; Reset in case there should be uncolored areas.
+ (remove-text-properties (point-min) (point-max) `(face nil rear-nonsticky nil))
+ (let ((i 0)
+ (len (length tokens)))
+ (while (< i len)
+ (add-text-properties
+ (elt tokens i)
+ (elt tokens (+ i 1))
+ `(face ,(context-coloring-level-face (elt tokens (+ i 2))) rear-nonsticky t))
+ (setq i (+ i 3))))))
+
+(defsubst context-coloring-kill-scopifier ()
+ "Kills the currently-running scopifier process for this
+buffer."
+ (when (not (null context-coloring-scopifier-process))
+ (delete-process context-coloring-scopifier-process)
+ (setq context-coloring-scopifier-process nil)))
+
+(defun context-coloring-parse-array (input)
+ "Specialized JSON parser for a flat array of numbers."
+ (vconcat (mapcar 'string-to-number (split-string (substring input 1 -1) ","))))
+
+(defun context-coloring-scopify ()
+ "Invokes the external scopifier with the current buffer's
+contents, reading the scopifier's response asynchronously and
+applying a parsed list of tokens to
+`context-coloring-apply-tokens'."
+
+ ;; Prior running tokenization is implicitly obsolete if this function is
+ ;; called.
+ (context-coloring-kill-scopifier)
+
+ ;; Start the process.
+ (setq context-coloring-scopifier-process
+ (start-process-shell-command "scopifier" nil context-coloring-scopifier-path))
+
+ (let ((output "")
+ (buffer context-coloring-buffer)
+ (start-time context-coloring-start-time))
+
+ ;; The process may produce output in multiple chunks. This filter
+ ;; accumulates the chunks into a message.
+ (set-process-filter context-coloring-scopifier-process
(lambda (process chunk)
(setq output (concat output chunk))))
- ;; When the message is complete, parse it as JSON and apply the tokens.
- (set-process-sentinel tokenizer-process
+ ;; When the process's message is complete, this sentinel parses it as JSON
+ ;; and applies the tokens to the buffer.
+ (set-process-sentinel context-coloring-scopifier-process
(lambda (process event)
(when (equal "finished\n" event)
- (let ((tokens (let ((json-array-type 'list))
- (json-read-from-string output))))
- (funcall function tokens)))))
+ (let ((tokens (context-coloring-parse-array output)))
+ (with-current-buffer buffer
+ (context-coloring-apply-tokens tokens))
+ (setq context-coloring-scopifier-process nil)
+ (when context-coloring-benchmark-colorization
+ (message "Colorized (after %f seconds)." (- (float-time) start-time))))))))
- ;; Give the process its input.
- (process-send-region tokenizer-process (point-min) (point-max))
- (process-send-eof tokenizer-process)))
+ ;; Give the process its input so it can begin.
+ (process-send-region context-coloring-scopifier-process (point-min) (point-max))
+ (process-send-eof context-coloring-scopifier-process))
-;;; Colorization functions
+;;; Colorization
-(defun context-coloring-colorize-buffer ()
+(defun context-coloring-colorize ()
+ "Colors the current buffer by function context."
(interactive)
- (context-coloring-tokenize 'context-coloring-apply-tokens))
-
-(defun context-coloring-colorize-if-current ()
- (when (eq context-coloring-buffer (window-buffer (selected-window)))
- (context-coloring-colorize-buffer)))
+ (when (executable-find "node")
+ (when context-coloring-benchmark-colorization
+ (setq context-coloring-start-time (float-time))
+ (message "%s" "Colorizing..."))
+ (context-coloring-scopify)))
+
+(defun context-coloring-change-function (start end length)
+ "Registers a change so that a context-colored buffer can be
+colorized soon."
+ ;; Tokenization is obsolete if there was a change.
+ (context-coloring-kill-scopifier)
+ (setq context-coloring-changed t))
+
+(defun context-coloring-maybe-colorize ()
+ "Colorize unders certain conditions. This will run as an idle
+timer, so firstly the buffer must not be some other
+buffer. Additionally, the buffer must have changed, otherwise
+colorizing would be redundant."
+ (when (and (eq context-coloring-buffer (window-buffer (selected-window)))
+ context-coloring-changed)
+ (setq context-coloring-changed nil)
+ (context-coloring-colorize)))
;;; Minor mode
nil " Context" nil
(if (not context-coloring-mode)
(progn
- (when (boundp 'context-coloring-colorize-idle-timer)
- (cancel-timer context-coloring-colorize-idle-timer)))
+ (context-coloring-kill-scopifier)
+ (when (not (null 'context-coloring-colorize-idle-timer))
+ (cancel-timer context-coloring-colorize-idle-timer))
+ (remove-hook 'after-change-functions 'context-coloring-change-function t)
+ (font-lock-mode)
+ (jit-lock-mode t))
- ;; Colorize once initially. Why this doesn't work, I cannot say.
- ;; (context-coloring-colorize-buffer)
+ ;; Remember this buffer. This value should not be dynamically-bound.
+ (setq context-coloring-buffer (current-buffer))
- ;; Preserve a reference to this buffer.
- (set (make-local-variable 'context-coloring-buffer) (current-buffer))
+ ;; Alert the user that the mode is not going to work.
+ (if (null (executable-find "node"))
+ (message "context-coloring-mode requires Node.js 0.10+ to be installed"))
- ;; Only recolor idly.
- (set (make-local-variable 'context-coloring-colorize-idle-timer)
- (run-with-idle-timer 1 t 'context-coloring-colorize-if-current))))
+ ;; Colorize once initially.
+ (context-coloring-colorize)
-;;;###autoload
-(defun context-coloring-mode-enable ()
- (context-coloring-mode 1))
+ ;; Font lock is incompatible with this mode; the converse is also true.
+ (font-lock-mode 0)
+ (jit-lock-mode nil)
-;;;###autoload
-(defun context-coloring-mode-disable ()
- (context-coloring-mode 0))
+ ;; Only recolor on change.
+ (add-hook 'after-change-functions 'context-coloring-change-function nil t)
-;;;###autoload
-(define-globalized-minor-mode global-context-coloring-mode
- context-coloring-mode context-coloring-mode-enable)
+ ;; Only recolor idly.
+ (setq context-coloring-colorize-idle-timer
+ (run-with-idle-timer context-coloring-delay t 'context-coloring-maybe-colorize))))
(provide 'context-coloring)
+
+;;; context-coloring.el ends here