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-level--1-face
  40   '((((type tty)) (:foreground "white"))
  41     (t (:foreground "#7f7f7f")))
  42   "Context coloring face, level -1; comments."
  43   :group 'context-coloring-faces)
  44
  45 (defface context-coloring-level-0-face
  46   '((((type tty)) (:foreground "white"))
  47     (((background light)) (:foreground "#000000"))
  48     (((background dark)) (:foreground "#ffffff")))
  49   "Context coloring face, level 0; global scope."
  50   :group 'context-coloring-faces)
  51
  52 (defface context-coloring-level-1-face
  53   '((((type tty)) (:foreground "yellow"))
  54     (((background light)) (:foreground "#007f80"))
  55     (((background dark)) (:foreground "#ffff80")))
  56   "Context coloring face, level 1."
  57   :group 'context-coloring-faces)
  58
  59 (defface context-coloring-level-2-face
  60   '((((type tty)) (:foreground "green"))
  61     (((background light)) (:foreground "#001580"))
  62     (((background dark)) (:foreground "#cdfacd")))
  63   "Context coloring face, level 2."
  64   :group 'context-coloring-faces)
  65
  66 (defface context-coloring-level-3-face
  67   '((((type tty)) (:foreground "cyan"))
  68     (((background light)) (:foreground "#550080"))
  69     (((background dark)) (:foreground "#d8d8ff")))
  70   "Context coloring face, level 3."
  71   :group 'context-coloring-faces)
  72
  73 (defface context-coloring-level-4-face
  74   '((((type tty)) (:foreground "blue"))
  75     (((background light)) (:foreground "#802b00"))
  76     (((background dark)) (:foreground "#e7c7ff")))
  77   "Context coloring face, level 4."
  78   :group 'context-coloring-faces)
  79
  80 (defface context-coloring-level-5-face
  81   '((((type tty)) (:foreground "magenta"))
  82     (((background light)) (:foreground "#6a8000"))
  83     (((background dark)) (:foreground "#ffcdcd")))
  84   "Context coloring face, level 5."
  85   :group 'context-coloring-faces)
  86
  87 (defface context-coloring-level-6-face
  88   '((((type tty)) (:foreground "red"))
  89     (((background light)) (:foreground "#008000"))
  90     (((background dark)) (:foreground "#ffe390")))
  91   "Context coloring face, level 6."
  92   :group 'context-coloring-faces)
  93
  94 (defface context-coloring-level-7-face
  95   '((t (:inherit context-coloring-level-1-face)))
  96   "Context coloring face, level 7."
  97   :group 'context-coloring-faces)
  98
  99 (defface context-coloring-level-8-face
 100   '((t (:inherit context-coloring-level-2-face)))
 101   "Context coloring face, level 8."
 102   :group 'context-coloring-faces)
 103
 104 (defface context-coloring-level-9-face
 105   '((t (:inherit context-coloring-level-3-face)))
 106   "Context coloring face, level 9."
 107   :group 'context-coloring-faces)
 108
 109 (defface context-coloring-level-10-face
 110   '((t (:inherit context-coloring-level-4-face)))
 111   "Context coloring face, level 10."
 112   :group 'context-coloring-faces)
 113
 114 (defface context-coloring-level-11-face
 115   '((t (:inherit context-coloring-level-5-face)))
 116   "Context coloring face, level 11."
 117   :group 'context-coloring-faces)
 118
 119 (defface context-coloring-level-12-face
 120   '((t (:inherit context-coloring-level-6-face)))
 121   "Context coloring face, level 12."
 122   :group 'context-coloring-faces)
 123
 124 (defcustom context-coloring-face-count 7
 125   "Number of faces defined for highlighting delimiter levels.
 126 Determines level at which to cycle through faces again.")
 127
 128
 129 ;;; Face functions
 130
 131 (defsubst context-coloring-level-face (level)
 132   "Return face-name for LEVEL as a string \"context-coloring-level-LEVEL-face\".
 133 For example: \"context-coloring-level-1-face\"."
 134   (intern-soft
 135    (concat "context-coloring-level-"
 136            (number-to-string
 137             (or
 138              ;; Has a face directly mapping to it.
 139              (and (< level context-coloring-face-count)
 140                   level)
 141              ;; After the number of available faces are used up, pretend the 0th
 142              ;; face doesn't exist.
 143              (+ 1
 144                 (mod (- level 1)
 145                      (- context-coloring-face-count 1)))))
 146            "-face")))
 147
 148
 149 ;;; Constants
 150
 151 (defconst context-coloring-path
 152   (file-name-directory (or load-file-name buffer-file-name))
 153   "This file's directory.")
 154
 155
 156 ;;; Customizable variables
 157
 158 (let ((javascript-scopifier `(:type shell-command
 159                               :executable "node"
 160                               :command ,(expand-file-name
 161                                          "./bin/scopifier"
 162                                          context-coloring-path))))
 163   (defcustom context-coloring-scopifier-plist
 164     `(js-mode ,javascript-scopifier
 165       js2-mode ,javascript-scopifier
 166       js3-mode ,javascript-scopifier)
 167     "Property list mapping major modes to scopification programs."))
 168
 169 (defcustom context-coloring-delay 0.25
 170   "Delay between a buffer update and colorization.
 171
 172 Increase this if your machine is high-performing. Decrease it if it ain't."
 173   :group 'context-coloring)
 174
 175
 176 ;;; Local variables
 177
 178 (defvar-local context-coloring-buffer nil
 179   "Reference to this buffer (for timers).")
 180
 181 (defvar-local context-coloring-scopifier-process nil
 182   "Only allow a single scopifier process to run at a time. This
 183 is a reference to that one process.")
 184
 185 (defvar-local context-coloring-colorize-idle-timer nil
 186   "Reference to currently-running idle timer.")
 187
 188 (defvar-local context-coloring-changed nil
 189   "Indication that the buffer has changed recently, which would
 190 imply that it should be colorized again.")
 191
 192
 193 ;;; Scopification
 194
 195 (defun context-coloring-apply-tokens (tokens)
 196   "Processes TOKENS to apply context-based coloring to the
 197 current buffer. Tokens are 3 integers: start, end, level. The
 198 array is flat, with a new token occurring after every 3rd
 199 number."
 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 (elt tokens (+ i 2))) rear-nonsticky t))
 210         (setq i (+ i 3))))))
 211
 212 (defsubst context-coloring-kill-scopifier ()
 213   "Kills the currently-running scopifier process for this
 214 buffer."
 215   (when (not (null context-coloring-scopifier-process))
 216     (delete-process context-coloring-scopifier-process)
 217     (setq context-coloring-scopifier-process nil)))
 218
 219 (defun context-coloring-parse-array (input)
 220   "Specialized JSON parser for a flat array of numbers."
 221   (vconcat (mapcar 'string-to-number (split-string (substring input 1 -1) ","))))
 222
 223 (defun context-coloring-scopify-shell-command (command)
 224   "Invokes a scopifier with the current buffer's contents,
 225 reading the scopifier's response asynchronously and applying a
 226 parsed list of tokens to `context-coloring-apply-tokens'."
 227
 228   ;; Prior running tokenization is implicitly obsolete if this function is
 229   ;; called.
 230   (context-coloring-kill-scopifier)
 231
 232   ;; Start the process.
 233   (setq context-coloring-scopifier-process
 234         (start-process-shell-command "scopifier" nil command))
 235
 236   (let ((output "")
 237         (buffer context-coloring-buffer))
 238
 239     ;; The process may produce output in multiple chunks. This filter
 240     ;; accumulates the chunks into a message.
 241     (set-process-filter
 242      context-coloring-scopifier-process
 243      (lambda (process chunk)
 244        (setq output (concat output chunk))))
 245
 246     ;; When the process's message is complete, this sentinel parses it as JSON
 247     ;; and applies the tokens to the buffer.
 248     (set-process-sentinel
 249      context-coloring-scopifier-process
 250      (lambda (process event)
 251        (when (equal "finished\n" event)
 252          (let ((tokens (context-coloring-parse-array output)))
 253            (with-current-buffer buffer
 254              (context-coloring-apply-tokens tokens))
 255            (setq context-coloring-scopifier-process nil))))))
 256
 257   ;; Give the process its input so it can begin.
 258   (process-send-region context-coloring-scopifier-process (point-min) (point-max))
 259   (process-send-eof context-coloring-scopifier-process))
 260
 261 (defun context-coloring-scopify ()
 262   "Determines the optimal track for scopification of the current
 263 buffer, then scopifies the current buffer."
 264   (let ((scopifier (plist-get context-coloring-scopifier-plist major-mode)))
 265     (cond ((null scopifier)
 266            (message "%s" "Context coloring is not available for this major mode"))
 267           ((eq (plist-get scopifier :type) 'shell-command)
 268            (let ((executable (plist-get scopifier :executable)))
 269              (if (null (executable-find executable))
 270                  (message "Context coloring executable \"%s\" not found" executable)
 271                (context-coloring-scopify-shell-command (plist-get scopifier :command))))))))
 272
 273
 274 ;;; Colorization
 275
 276 (defun context-coloring-colorize ()
 277   "Colors the current buffer by function context."
 278   (interactive)
 279   (context-coloring-scopify))
 280
 281 (defun context-coloring-change-function (start end length)
 282   "Registers a change so that a context-colored buffer can be
 283 colorized soon."
 284   ;; Tokenization is obsolete if there was a change.
 285   (context-coloring-kill-scopifier)
 286   (setq context-coloring-changed t))
 287
 288 (defun context-coloring-maybe-colorize ()
 289   "Colorize unders certain conditions. This will run as an idle
 290 timer, so firstly the buffer must not be some other
 291 buffer. Additionally, the buffer must have changed, otherwise
 292 colorizing would be redundant."
 293   (when (and (eq context-coloring-buffer (window-buffer (selected-window)))
 294              context-coloring-changed)
 295     (setq context-coloring-changed nil)
 296     (context-coloring-colorize)))
 297
 298
 299 ;;; Minor mode
 300
 301 ;;;###autoload
 302 (define-minor-mode context-coloring-mode
 303   "Context-based code coloring for JavaScript, inspired by Douglas Crockford."
 304   nil " Context" nil
 305   (if (not context-coloring-mode)
 306       (progn
 307         (context-coloring-kill-scopifier)
 308         (when (not (null 'context-coloring-colorize-idle-timer))
 309           (cancel-timer context-coloring-colorize-idle-timer))
 310         (remove-hook 'after-change-functions 'context-coloring-change-function t)
 311         (font-lock-mode)
 312         (jit-lock-mode t))
 313
 314     ;; Remember this buffer. This value should not be dynamically-bound.
 315     (setq context-coloring-buffer (current-buffer))
 316
 317     ;; Colorize once initially.
 318     (context-coloring-colorize)
 319
 320     ;; Font lock is incompatible 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 (provide 'context-coloring)
 332
 333 ;;; context-coloring.el ends here