code.delx.au - gnu-emacs-elpa/blob - context-coloring.el

   1 ;;; context-coloring.el --- JavaScript syntax highlighting, except not for syntax.  -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2014 Jackson Ray Hamilton
   4
   5 ;; Author: Jackson Ray Hamilton <jackson@jacksonrayhamilton.com>
   6 ;; Keywords: context coloring highlighting js javascript
   7 ;; Version: 1.0.0
   8 ;; Package-Requires: ((emacs "24"))
   9
  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.
  14
  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.
  19
  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/>.
  22
  23 ;;; Commentary:
  24
  25 ;; Highlights JavaScript code according to function context.
  26 ;;
  27 ;; Usage:
  28 ;;
  29 ;; Install Node.js 0.10+.
  30 ;; Run `make` in this file's directory.
  31 ;; In your ~/.emacs:
  32 ;;
  33 ;; (require 'context-coloring)
  34 ;; (add-hook 'js-mode-hook 'context-coloring-mode)
  35
  36 ;;; Code:
  37
  38 ;;; Faces
  39
  40 (defface context-coloring-depth--1-face
  41   '((((background light)) (:foreground "#7f7f7f"))
  42     (((background dark)) (:foreground "#7f7f7f")))
  43   "Context coloring face, depth -1; comments."
  44   :group 'context-coloring-faces)
  45
  46 (defface context-coloring-depth-0-face
  47   '((((background light)) (:foreground "#000000"))
  48     (((background dark)) (:foreground "#ffffff")))
  49   "Context coloring face, depth 0; global scope."
  50   :group 'context-coloring-faces)
  51
  52 (defface context-coloring-depth-1-face
  53   '((((background light)) (:foreground "#2D6994"))
  54     (((background dark)) (:foreground "#ffff80")))
  55   "Context coloring face, depth 1."
  56   :group 'context-coloring-faces)
  57
  58 (defface context-coloring-depth-2-face
  59   '((((background light)) (:foreground "#592D94"))
  60     (((background dark)) (:foreground "#cdfacd")))
  61   "Context coloring face, depth 2."
  62   :group 'context-coloring-faces)
  63
  64 (defface context-coloring-depth-3-face
  65   '((((background light)) (:foreground "#A13143"))
  66     (((background dark)) (:foreground "#d8d8ff")))
  67   "Context coloring face, depth 3."
  68   :group 'context-coloring-faces)
  69
  70 (defface context-coloring-depth-4-face
  71   '((((background light)) (:foreground "#AC7135"))
  72     (((background dark)) (:foreground "#e7c7ff")))
  73   "Context coloring face, depth 4."
  74   :group 'context-coloring-faces)
  75
  76 (defface context-coloring-depth-5-face
  77   '((((background light)) (:foreground "#ACA135"))
  78     (((background dark)) (:foreground "#ffcdcd")))
  79   "Context coloring face, depth 5."
  80   :group 'context-coloring-faces)
  81
  82 (defface context-coloring-depth-6-face
  83   '((((background light)) (:foreground "#539A2F"))
  84     (((background dark)) (:foreground "#ffe390")))
  85   "Context coloring face, depth 6."
  86   :group 'context-coloring-faces)
  87
  88 (defface context-coloring-depth--1-italic-face
  89   '((default (:inherit context-coloring-depth--1-face :slant italic)))
  90   "Context coloring face, depth -1; italic; comments."
  91   :group 'context-coloring-faces)
  92
  93 (defface context-coloring-depth-0-bold-face
  94   '((default (:inherit context-coloring-depth-0-face :weight bold)))
  95   "Context coloring face, depth 0; bold; global scope."
  96   :group 'context-coloring-faces)
  97
  98 (defface context-coloring-depth-1-bold-face
  99   '((default (:inherit context-coloring-depth-1-face :weight bold)))
 100   "Context coloring face, depth 1; bold."
 101   :group 'context-coloring-faces)
 102
 103 (defface context-coloring-depth-2-bold-face
 104   '((default (:inherit context-coloring-depth-2-face :weight bold)))
 105   "Context coloring face, depth 2; bold."
 106   :group 'context-coloring-faces)
 107
 108 (defface context-coloring-depth-3-bold-face
 109   '((default (:inherit context-coloring-depth-3-face :weight bold)))
 110   "Context coloring face, depth 3; bold."
 111   :group 'context-coloring-faces)
 112
 113 (defface context-coloring-depth-4-bold-face
 114   '((default (:inherit context-coloring-depth-4-face :weight bold)))
 115   "Context coloring face, depth 4; bold."
 116   :group 'context-coloring-faces)
 117
 118 (defface context-coloring-depth-5-bold-face
 119   '((default (:inherit context-coloring-depth-5-face :weight bold)))
 120   "Context coloring face, depth 5; bold."
 121   :group 'context-coloring-faces)
 122
 123 (defface context-coloring-depth-6-bold-face
 124   '((default (:inherit context-coloring-depth-6-face :weight bold)))
 125   "Context coloring face, depth 6; bold."
 126   :group 'context-coloring-faces)
 127
 128 (defconst context-coloring-face-count 7
 129   "Number of faces defined for highlighting delimiter levels.
 130 Determines depth at which to cycle through faces again.")
 131
 132
 133 ;;; Face functions
 134
 135 (defsubst context-coloring-level-face (depth style)
 136   "Return face-name for DEPTH and STYLE as a string \"context-coloring-depth-DEPTH-face\".
 137 For example: \"context-coloring-depth-1-face\"."
 138   (intern-soft
 139    (concat "context-coloring-depth-"
 140            (number-to-string
 141             (or
 142              ;; Has a face directly mapping to it.
 143              (and (< depth context-coloring-face-count)
 144                   depth)
 145              ;; After the number of available faces are used up, pretend the 0th
 146              ;; face doesn't exist.
 147              (+ 1
 148                 (mod (- depth 1)
 149                      (- context-coloring-face-count 1)))))
 150            (cond ((= 1 style) "-bold")
 151                  ((= 2 style) "-italic")
 152                  (t ""))
 153            "-face")))
 154
 155
 156 ;;; Customizable variables
 157
 158 (defcustom context-coloring-delay 0.25
 159   "Delay between a buffer updates and colorization.
 160
 161 Increase this if your machine is high-performing. Decrease it it if ain't."
 162   :group 'context-coloring)
 163
 164 (defcustom context-coloring-benchmark-colorization nil
 165   "If non-nil, display how long each colorization took."
 166   :group 'context-coloring)
 167
 168
 169 ;;; Local variables
 170
 171 (defvar context-coloring-buffer nil
 172   "Reference to this buffer (for timers).")
 173 (make-variable-buffer-local 'context-coloring-buffer)
 174
 175 (defvar context-coloring-scopifier-process nil
 176   "Only allow a single scopifier process to run at a time. This
 177 is a reference to that one process.")
 178 (make-variable-buffer-local 'context-coloring-scopifier-process)
 179
 180 (defvar context-coloring-colorize-idle-timer nil
 181   "Reference to currently-running idle timer.")
 182 (make-variable-buffer-local 'context-coloring-colorize-idle-timer)
 183
 184 (defvar context-coloring-changed nil
 185   "Indication that the buffer has changed recently, which would
 186 imply that it should be colorized again.")
 187 (make-variable-buffer-local 'context-coloring-changed)
 188
 189 (defvar context-coloring-start-time nil
 190   "Used to benchmark colorization time.")
 191 (make-variable-buffer-local 'context-coloring-changed)
 192
 193
 194 ;;; Scopification
 195
 196 (defconst context-coloring-path
 197   (file-name-directory (or load-file-name buffer-file-name))
 198   "This file's directory.")
 199
 200 (defconst context-coloring-scopifier-path
 201   (expand-file-name "./bin/scopifier" context-coloring-path)
 202   "Path to the external scopifier executable.")
 203
 204 (defun context-coloring-apply-tokens (tokens)
 205   "Processes TOKENS to apply context-based coloring to the
 206 current buffer. Tokens are vectors consisting of 4 integers:
 207 start, end, level, and style."
 208   (with-silent-modifications
 209     ;; Reset in case there should be uncolored areas.
 210     (remove-text-properties (point-min) (point-max) `(face nil rear-nonsticky nil))
 211     (let ((i 0)
 212           (len (length tokens)))
 213       (while (< i len)
 214         (add-text-properties
 215          (elt tokens i)
 216          (elt tokens (+ i 1))
 217          `(face ,(context-coloring-level-face
 218                   (elt tokens (+ i 2))
 219                   (elt tokens (+ i 3))) rear-nonsticky t))
 220         (setq i (+ i 4))))))
 221
 222 (defsubst context-coloring-kill-scopifier ()
 223   "Kills the currently-running scopifier process for this
 224 buffer."
 225   (when (not (null context-coloring-scopifier-process))
 226     (delete-process context-coloring-scopifier-process)
 227     (setq context-coloring-scopifier-process nil)))
 228
 229 (defun context-coloring-parse-array (input)
 230   "Specialized JSON parser for a flat array of numbers."
 231   (vconcat (mapcar 'string-to-number (split-string (substring input 1 -1) ","))))
 232
 233 (defun context-coloring-scopify ()
 234   "Invokes the external scopifier with the current buffer's
 235 contents, reading the scopifier's response asynchronously and
 236 applying a parsed list of tokens to
 237 `context-coloring-apply-tokens'."
 238
 239   ;; Prior running tokenization is implicitly obsolete if this function is
 240   ;; called.
 241   (context-coloring-kill-scopifier)
 242
 243   ;; Start the process.
 244   (setq context-coloring-scopifier-process
 245         (start-process-shell-command "scopifier" nil context-coloring-scopifier-path))
 246
 247   (let ((output "")
 248         (buffer context-coloring-buffer)
 249         (start-time context-coloring-start-time))
 250
 251     ;; The process may produce output in multiple chunks. This filter
 252     ;; accumulates the chunks into a message.
 253     (set-process-filter context-coloring-scopifier-process
 254                         (lambda (process chunk)
 255                           (setq output (concat output chunk))))
 256
 257     ;; When the process's message is complete, this sentinel parses it as JSON
 258     ;; and applies the tokens to the buffer.
 259     (set-process-sentinel context-coloring-scopifier-process
 260                           (lambda (process event)
 261                             (when (equal "finished\n" event)
 262                               (let ((tokens (context-coloring-parse-array output)))
 263                                 (with-current-buffer buffer
 264                                   (context-coloring-apply-tokens tokens))
 265                                 (setq context-coloring-scopifier-process nil)
 266                                 (when context-coloring-benchmark-colorization
 267                                   (message "Colorized (after %f seconds)." (- (float-time) start-time))))))))
 268
 269   ;; Give the process its input so it can begin.
 270   (process-send-region context-coloring-scopifier-process (point-min) (point-max))
 271   (process-send-eof context-coloring-scopifier-process))
 272
 273
 274 ;;; Colorization
 275
 276 (defun context-coloring-colorize ()
 277   "Colors the current buffer by function context."
 278   (interactive)
 279   (when context-coloring-benchmark-colorization
 280     (setq context-coloring-start-time (float-time))
 281     (message "%s" "Colorizing..."))
 282   (context-coloring-scopify))
 283
 284 (defun context-coloring-change-function (start end length)
 285   "Registers a change so that a context-colored buffer can be
 286 colorized soon."
 287   ;; Tokenization is obsolete if there was a change.
 288   (context-coloring-kill-scopifier)
 289   (setq context-coloring-changed t))
 290
 291 (defun context-coloring-maybe-colorize ()
 292   "Colorize unders certain conditions. This will run as an idle
 293 timer, so firstly the buffer must not be some other
 294 buffer. Additionally, the buffer must have changed, otherwise
 295 colorizing would be redundant."
 296   (when (and (eq context-coloring-buffer (window-buffer (selected-window)))
 297              context-coloring-changed)
 298     (setq context-coloring-changed nil)
 299     (context-coloring-colorize)))
 300
 301
 302 ;;; Minor mode
 303
 304 ;;;###autoload
 305 (define-minor-mode context-coloring-mode
 306   "Context-based code coloring for JavaScript, inspired by Douglas Crockford."
 307   nil " Context" nil
 308   (if (not context-coloring-mode)
 309       (progn
 310         (context-coloring-kill-scopifier)
 311         (when (not (null 'context-coloring-colorize-idle-timer))
 312           (cancel-timer context-coloring-colorize-idle-timer))
 313         (remove-hook 'after-change-functions 'context-coloring-change-function t)
 314         (font-lock-mode)
 315         (jit-lock-mode t))
 316
 317     ;; Remember this buffer. This value should not be dynamically-bound.
 318     (setq context-coloring-buffer (current-buffer))
 319
 320     ;; Colorize once initially.
 321     (context-coloring-colorize)
 322
 323     ;; Font lock is incompatible with this mode; the converse is also true.
 324     (font-lock-mode 0)
 325     (jit-lock-mode nil)
 326
 327     ;; Only recolor on change.
 328     (add-hook 'after-change-functions 'context-coloring-change-function nil t)
 329
 330     ;; Only recolor idly.
 331     (setq context-coloring-colorize-idle-timer
 332           (run-with-idle-timer context-coloring-delay t 'context-coloring-maybe-colorize))))
 333
 334 (provide 'context-coloring)
 335
 336 ;;; context-coloring.el ends here