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 (defconst context-coloring-face-count 7
  96   "Number of faces defined for highlighting delimiter levels.
  97 Determines depth at which to cycle through faces again.")
  98
  99
 100 ;;; Face functions
 101
 102 (defsubst context-coloring-level-face (depth)
 103   "Return face-name for DEPTH as a string \"context-coloring-depth-DEPTH-face\".
 104 For example: \"context-coloring-depth-1-face\"."
 105   (intern-soft
 106    (concat "context-coloring-depth-"
 107            (number-to-string
 108             (or
 109              ;; Has a face directly mapping to it.
 110              (and (< depth context-coloring-face-count)
 111                   depth)
 112              ;; After the number of available faces are used up, pretend the 0th
 113              ;; face doesn't exist.
 114              (+ 1
 115                 (mod (- depth 1)
 116                      (- context-coloring-face-count 1)))))
 117            "-face")))
 118
 119
 120 ;;; Customizable variables
 121
 122 (defcustom context-coloring-delay 0.25
 123   "Delay between a buffer update and colorization.
 124
 125 Increase this if your machine is high-performing. Decrease it if it ain't."
 126   :group 'context-coloring)
 127
 128 (defcustom context-coloring-benchmark-colorization nil
 129   "If non-nil, display how long each colorization took."
 130   :group 'context-coloring)
 131
 132
 133 ;;; Local variables
 134
 135 (defvar context-coloring-buffer nil
 136   "Reference to this buffer (for timers).")
 137 (make-variable-buffer-local 'context-coloring-buffer)
 138
 139 (defvar context-coloring-scopifier-process nil
 140   "Only allow a single scopifier process to run at a time. This
 141 is a reference to that one process.")
 142 (make-variable-buffer-local 'context-coloring-scopifier-process)
 143
 144 (defvar context-coloring-colorize-idle-timer nil
 145   "Reference to currently-running idle timer.")
 146 (make-variable-buffer-local 'context-coloring-colorize-idle-timer)
 147
 148 (defvar context-coloring-changed nil
 149   "Indication that the buffer has changed recently, which would
 150 imply that it should be colorized again.")
 151 (make-variable-buffer-local 'context-coloring-changed)
 152
 153 (defvar context-coloring-start-time nil
 154   "Used to benchmark colorization time.")
 155 (make-variable-buffer-local 'context-coloring-start-time)
 156
 157
 158 ;;; Scopification
 159
 160 (defconst context-coloring-path
 161   (file-name-directory (or load-file-name buffer-file-name))
 162   "This file's directory.")
 163
 164 (defconst context-coloring-scopifier-path
 165   (expand-file-name "./bin/scopifier" context-coloring-path)
 166   "Path to the external scopifier executable.")
 167
 168 (defun context-coloring-apply-tokens (tokens)
 169   "Processes TOKENS to apply context-based coloring to the
 170 current buffer. Tokens are 3 integers: start, end, level. The
 171 array is flat, with a new token occurring after every 3rd
 172 number."
 173   (with-silent-modifications
 174     ;; Reset in case there should be uncolored areas.
 175     (remove-text-properties (point-min) (point-max) `(face nil rear-nonsticky nil))
 176     (let ((i 0)
 177           (len (length tokens)))
 178       (while (< i len)
 179         (add-text-properties
 180          (elt tokens i)
 181          (elt tokens (+ i 1))
 182          `(face ,(context-coloring-level-face (elt tokens (+ i 2))) rear-nonsticky t))
 183         (setq i (+ i 3))))))
 184
 185 (defsubst context-coloring-kill-scopifier ()
 186   "Kills the currently-running scopifier process for this
 187 buffer."
 188   (when (not (null context-coloring-scopifier-process))
 189     (delete-process context-coloring-scopifier-process)
 190     (setq context-coloring-scopifier-process nil)))
 191
 192 (defun context-coloring-parse-array (input)
 193   "Specialized JSON parser for a flat array of numbers."
 194   (vconcat (mapcar 'string-to-number (split-string (substring input 1 -1) ","))))
 195
 196 (defun context-coloring-scopify ()
 197   "Invokes the external scopifier with the current buffer's
 198 contents, reading the scopifier's response asynchronously and
 199 applying a parsed list of tokens to
 200 `context-coloring-apply-tokens'."
 201
 202   ;; Prior running tokenization is implicitly obsolete if this function is
 203   ;; called.
 204   (context-coloring-kill-scopifier)
 205
 206   ;; Start the process.
 207   (setq context-coloring-scopifier-process
 208         (start-process-shell-command "scopifier" nil context-coloring-scopifier-path))
 209
 210   (let ((output "")
 211         (buffer context-coloring-buffer)
 212         (start-time context-coloring-start-time))
 213
 214     ;; The process may produce output in multiple chunks. This filter
 215     ;; accumulates the chunks into a message.
 216     (set-process-filter context-coloring-scopifier-process
 217                         (lambda (process chunk)
 218                           (setq output (concat output chunk))))
 219
 220     ;; When the process's message is complete, this sentinel parses it as JSON
 221     ;; and applies the tokens to the buffer.
 222     (set-process-sentinel context-coloring-scopifier-process
 223                           (lambda (process event)
 224                             (when (equal "finished\n" event)
 225                               (let ((tokens (context-coloring-parse-array output)))
 226                                 (with-current-buffer buffer
 227                                   (context-coloring-apply-tokens tokens))
 228                                 (setq context-coloring-scopifier-process nil)
 229                                 (when context-coloring-benchmark-colorization
 230                                   (message "Colorized (after %f seconds)." (- (float-time) start-time))))))))
 231
 232   ;; Give the process its input so it can begin.
 233   (process-send-region context-coloring-scopifier-process (point-min) (point-max))
 234   (process-send-eof context-coloring-scopifier-process))
 235
 236
 237 ;;; Colorization
 238
 239 (defun context-coloring-colorize ()
 240   "Colors the current buffer by function context."
 241   (interactive)
 242   (when (executable-find "node")
 243     (when context-coloring-benchmark-colorization
 244       (setq context-coloring-start-time (float-time))
 245       (message "%s" "Colorizing..."))
 246     (context-coloring-scopify)))
 247
 248 (defun context-coloring-change-function (start end length)
 249   "Registers a change so that a context-colored buffer can be
 250 colorized soon."
 251   ;; Tokenization is obsolete if there was a change.
 252   (context-coloring-kill-scopifier)
 253   (setq context-coloring-changed t))
 254
 255 (defun context-coloring-maybe-colorize ()
 256   "Colorize unders certain conditions. This will run as an idle
 257 timer, so firstly the buffer must not be some other
 258 buffer. Additionally, the buffer must have changed, otherwise
 259 colorizing would be redundant."
 260   (when (and (eq context-coloring-buffer (window-buffer (selected-window)))
 261              context-coloring-changed)
 262     (setq context-coloring-changed nil)
 263     (context-coloring-colorize)))
 264
 265
 266 ;;; Minor mode
 267
 268 ;;;###autoload
 269 (define-minor-mode context-coloring-mode
 270   "Context-based code coloring for JavaScript, inspired by Douglas Crockford."
 271   nil " Context" nil
 272   (if (not context-coloring-mode)
 273       (progn
 274         (context-coloring-kill-scopifier)
 275         (when (not (null 'context-coloring-colorize-idle-timer))
 276           (cancel-timer context-coloring-colorize-idle-timer))
 277         (remove-hook 'after-change-functions 'context-coloring-change-function t)
 278         (font-lock-mode)
 279         (jit-lock-mode t))
 280
 281     ;; Remember this buffer. This value should not be dynamically-bound.
 282     (setq context-coloring-buffer (current-buffer))
 283
 284     ;; Alert the user that the mode is not going to work.
 285     (if (null (executable-find "node"))
 286         (message "context-coloring-mode requires Node.js 0.10+ to be installed"))
 287
 288     ;; Colorize once initially.
 289     (context-coloring-colorize)
 290
 291     ;; Font lock is incompatible with this mode; the converse is also true.
 292     (font-lock-mode 0)
 293     (jit-lock-mode nil)
 294
 295     ;; Only recolor on change.
 296     (add-hook 'after-change-functions 'context-coloring-change-function nil t)
 297
 298     ;; Only recolor idly.
 299     (setq context-coloring-colorize-idle-timer
 300           (run-with-idle-timer context-coloring-delay t 'context-coloring-maybe-colorize))))
 301
 302 (provide 'context-coloring)
 303
 304 ;;; context-coloring.el ends here