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