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 (defconst context-coloring-face-count 7
  89   "Number of faces defined for highlighting delimiter levels.
  90 Determines depth at which to cycle through faces again.")
  91
  92 (defface context-coloring-depth--1-italic-face
  93   '((default (:inherit context-coloring-depth--1-face :slant italic)))
  94   "Context coloring face, depth -1; italic; comments."
  95   :group 'context-coloring-faces)
  96
  97 (defface context-coloring-depth-0-bold-face
  98   '((default (:inherit context-coloring-depth-0-face :weight bold)))
  99   "Context coloring face, depth 0; bold; global scope."
 100   :group 'context-coloring-faces)
 101
 102 (defface context-coloring-depth-1-bold-face
 103   '((default (:inherit context-coloring-depth-1-face :weight bold)))
 104   "Context coloring face, depth 1; bold."
 105   :group 'context-coloring-faces)
 106
 107 (defface context-coloring-depth-2-bold-face
 108   '((default (:inherit context-coloring-depth-2-face :weight bold)))
 109   "Context coloring face, depth 2; bold."
 110   :group 'context-coloring-faces)
 111
 112 (defface context-coloring-depth-3-bold-face
 113   '((default (:inherit context-coloring-depth-3-face :weight bold)))
 114   "Context coloring face, depth 3; bold."
 115   :group 'context-coloring-faces)
 116
 117 (defface context-coloring-depth-4-bold-face
 118   '((default (:inherit context-coloring-depth-4-face :weight bold)))
 119   "Context coloring face, depth 4; bold."
 120   :group 'context-coloring-faces)
 121
 122 (defface context-coloring-depth-5-bold-face
 123   '((default (:inherit context-coloring-depth-5-face :weight bold)))
 124   "Context coloring face, depth 5; bold."
 125   :group 'context-coloring-faces)
 126
 127 (defface context-coloring-depth-6-bold-face
 128   '((default (:inherit context-coloring-depth-6-face :weight bold)))
 129   "Context coloring face, depth 6; bold."
 130   :group 'context-coloring-faces)
 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 update and colorization.
 160
 161 If your performance is poor, you might want to increase this."
 162   :group 'context-coloring)
 163
 164
 165 ;;; Local variables
 166
 167 (defvar context-coloring-buffer nil
 168   "Reference to this buffer (for timers).")
 169 (make-variable-buffer-local 'context-coloring-buffer)
 170
 171 (defvar context-coloring-scopifier-process nil
 172   "Only allow a single scopifier process to run at a time. This
 173 is a reference to that one process.")
 174 (make-variable-buffer-local 'context-coloring-scopifier-process)
 175
 176 (defvar context-coloring-colorize-idle-timer nil
 177   "Reference to currently-running idle timer.")
 178 (make-variable-buffer-local 'context-coloring-colorize-idle-timer)
 179
 180 (defvar context-coloring-changed nil
 181   "Indication that the buffer has changed recently, which would
 182 imply that it should be colorized again.")
 183 (make-variable-buffer-local 'context-coloring-changed)
 184
 185
 186 ;;; Scopification
 187
 188 (defconst context-coloring-path
 189   (file-name-directory (or load-file-name buffer-file-name))
 190   "This file's directory.")
 191
 192 (defconst context-coloring-scopifier-path
 193   (expand-file-name "./bin/scopifier" context-coloring-path)
 194   "Path to the external scopifier executable.")
 195
 196 (defsubst context-coloring-apply-tokens (tokens)
 197   "Processes TOKENS to apply context-based coloring to the
 198 current buffer. Tokens are vectors consisting of 4 integers:
 199 start, end, level, and style."
 200   (with-silent-modifications
 201     ;; Reset in case there should be uncolored areas.
 202     (remove-text-properties (point-min) (point-max) `(face nil rear-nonsticky nil))
 203     (let ((i 0)
 204           (len (length tokens)))
 205       (while (< i len)
 206         (add-text-properties
 207          (elt tokens i)
 208          (elt tokens (+ i 1))
 209          `(face ,(context-coloring-level-face
 210                   (elt tokens (+ i 2))
 211                   (elt tokens (+ i 3))) rear-nonsticky t))
 212         (setq i (+ i 4))))))
 213
 214 (defsubst context-coloring-kill-scopifier ()
 215   "Kills the currently-running scopifier process for this
 216 buffer."
 217   (when (not (null context-coloring-scopifier-process))
 218     (delete-process context-coloring-scopifier-process)
 219     (setq context-coloring-scopifier-process nil)))
 220
 221 (defsubst context-coloring-parse-array (input)
 222   "Specialized alternative JSON parser."
 223   (vconcat (mapcar 'string-to-number (split-string (substring input 1 -1) ","))))
 224
 225 (defsubst context-coloring-scopify ()
 226   "Invokes the external scopifier with the current buffer's
 227 contents, reading the scopifier's response asynchronously and
 228 applying a parsed list of tokens to
 229 `context-coloring-apply-tokens'."
 230
 231   ;; Prior running tokenization is implicitly obsolete if this function is
 232   ;; called.
 233   (context-coloring-kill-scopifier)
 234
 235   ;; Start the process.
 236   (setq context-coloring-scopifier-process
 237         (start-process-shell-command "scopifier" nil context-coloring-scopifier-path))
 238
 239   (let ((output "")
 240         (buffer context-coloring-buffer))
 241
 242     ;; The process may produce output in multiple chunks. This filter
 243     ;; accumulates the chunks into a message.
 244     (set-process-filter context-coloring-scopifier-process
 245                         (lambda (process chunk)
 246                           (setq output (concat output chunk))))
 247
 248     ;; When the process's message is complete, this sentinel parses it as JSON
 249     ;; and applies the tokens to the buffer.
 250     (set-process-sentinel context-coloring-scopifier-process
 251                           (lambda (process event)
 252                             (when (equal "finished\n" event)
 253                               (let ((tokens (context-coloring-parse-array output)))
 254                                 (with-current-buffer buffer
 255                                   (context-coloring-apply-tokens tokens))
 256                                 (setq context-coloring-scopifier-process nil))))))
 257
 258   ;; Give the process its input.
 259   (process-send-region context-coloring-scopifier-process (point-min) (point-max))
 260   (process-send-eof context-coloring-scopifier-process))
 261
 262
 263 ;;; Colorization
 264
 265 (defun context-coloring-colorize ()
 266   "Colors the current buffer by function context."
 267   (interactive)
 268   (context-coloring-scopify))
 269
 270 (defun context-coloring-change-function (start end length)
 271   "Registers a change so that a context-colored buffer can be
 272 colorized soon."
 273   ;; Tokenization is obsolete if there was a change.
 274   (context-coloring-kill-scopifier)
 275   (setq context-coloring-changed t))
 276
 277 (defun context-coloring-maybe-colorize ()
 278   "Colorize unders certain conditions. This will run as an idle
 279 timer, so firstly the buffer must not be some other
 280 buffer. Additionally, the buffer must have changed, otherwise
 281 colorizing would be redundant."
 282   (when (and (eq context-coloring-buffer (window-buffer (selected-window)))
 283              context-coloring-changed)
 284     (setq context-coloring-changed nil)
 285     (context-coloring-colorize)))
 286
 287
 288 ;;; Minor mode
 289
 290 ;;;###autoload
 291 (define-minor-mode context-coloring-mode
 292   "Context-based code coloring for JavaScript, inspired by Douglas Crockford."
 293   nil " Context" nil
 294   (if (not context-coloring-mode)
 295       (progn
 296         (context-coloring-kill-scopifier)
 297         (when (not (null 'context-coloring-colorize-idle-timer))
 298           (cancel-timer context-coloring-colorize-idle-timer))
 299         (remove-hook 'after-change-functions 'context-coloring-change-function t)
 300         (font-lock-mode)
 301         (jit-lock-mode t))
 302
 303     (setq context-coloring-buffer (current-buffer))
 304
 305     ;; Colorize once initially.
 306     (context-coloring-colorize)
 307
 308     ;; Font lock is not compatible with this mode; the converse is also true.
 309     (font-lock-mode 0)
 310     (jit-lock-mode nil)
 311
 312     ;; Only recolor on change.
 313     (add-hook 'after-change-functions 'context-coloring-change-function nil t)
 314
 315     ;; Only recolor idly.
 316     (setq context-coloring-colorize-idle-timer
 317           (run-with-idle-timer context-coloring-delay t 'context-coloring-maybe-colorize))))
 318
 319 ;;;###autoload
 320 (defun context-coloring-mode-enable ()
 321   (context-coloring-mode 1))
 322
 323 ;;;###autoload
 324 (defun context-coloring-mode-disable ()
 325   (context-coloring-mode 0))
 326
 327 ;;;###autoload
 328 (define-globalized-minor-mode global-context-coloring-mode
 329   context-coloring-mode context-coloring-mode-enable)
 330
 331 (provide 'context-coloring)
 332
 333 ;;; context-coloring.el ends here