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

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