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

   1 ;;; context-coloring.el --- Syntax highlighting, except not for syntax. -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2014-2015  Free Software Foundation, Inc.
   4
   5 ;; Author: Jackson Ray Hamilton <jackson@jacksonrayhamilton.com>
   6 ;; URL: https://github.com/jacksonrayhamilton/context-coloring
   7 ;; Keywords: context coloring syntax highlighting
   8 ;; Version: 5.0.0
   9 ;; Package-Requires: ((emacs "24") (js2-mode "20150126"))
  10
  11 ;; This file is part of GNU Emacs.
  12
  13 ;; This program is free software; you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation, either version 3 of the License, or
  16 ;; (at your option) any later version.
  17
  18 ;; This program is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
  25
  26 ;;; Commentary:
  27
  28 ;; Highlights code according to function context.
  29
  30 ;; - Code in the global scope is one color.  Code in functions within the global
  31 ;;   scope is a different color, and code within such functions is another
  32 ;;   color, and so on.
  33 ;; - Identifiers retain the color of the scope in which they are declared.
  34
  35 ;; Lexical scope information at-a-glance can assist a programmer in
  36 ;; understanding the overall structure of a program.  It can help to curb nasty
  37 ;; bugs like name shadowing.  A rainbow can indicate excessive complexity. State
  38 ;; change within a closure is easily monitored.
  39
  40 ;; By default, Context Coloring still highlights comments and strings
  41 ;; syntactically.  It is still easy to differentiate code from non-code, and
  42 ;; strings cannot be confused for variables.
  43
  44 ;; To use, add the following to your ~/.emacs:
  45
  46 ;; (require 'context-coloring)
  47 ;; (add-hook 'js2-mode-hook 'context-coloring-mode)
  48
  49 ;; js-mode or js3-mode support requires Node.js 0.10+ and the scopifier
  50 ;; executable.
  51
  52 ;; $ npm install -g scopifier
  53
  54 ;;; Code:
  55
  56 (require 'js2-mode)
  57
  58
  59 ;;; Customizable options
  60
  61 (defcustom context-coloring-delay 0.25
  62   "Delay between a buffer update and colorization.
  63
  64 Increase this if your machine is high-performing.  Decrease it if
  65 it ain't.
  66
  67 Supported modes: `js-mode', `js3-mode'"
  68   :group 'context-coloring)
  69
  70 (defcustom context-coloring-comments-and-strings t
  71   "If non-nil, also color comments and strings using `font-lock'."
  72   :group 'context-coloring)
  73
  74 (defcustom context-coloring-js-block-scopes nil
  75   "If non-nil, also color block scopes in the scope hierarchy in JavaScript.
  76
  77 The block-scoped `let' and `const' are introduced in ES6.  If you
  78 are writing ES6 code, enable this; otherwise, don't.
  79
  80 Supported modes: `js2-mode'"
  81   :group 'context-coloring)
  82
  83 (defcustom context-coloring-benchmark-colorization nil
  84   "If non-nil, track how long colorization takes and print
  85 messages with the colorization duration."
  86   :group 'context-coloring)
  87
  88
  89 ;;; Local variables
  90
  91 (defvar-local context-coloring-buffer nil
  92   "Reference to this buffer (for timers).")
  93
  94 (defvar-local context-coloring-scopifier-process nil
  95   "Reference to the single scopifier process that can be
  96   running.")
  97
  98 (defvar-local context-coloring-colorize-idle-timer nil
  99   "Reference to the currently-running idle timer.")
 100
 101 (defvar-local context-coloring-changed nil
 102   "Indication that the buffer has changed recently, which would
 103 imply that it should be colorized again by
 104 `context-coloring-colorize-idle-timer' if that timer is being
 105 used.")
 106
 107
 108 ;;; Faces
 109
 110 (defun context-coloring-defface (level tty light dark)
 111   "Dynamically define a face for LEVEL with colors for TTY, LIGHT
 112 and DARK backgrounds."
 113   (let ((face (intern (format "context-coloring-level-%s-face" level)))
 114         (doc (format "Context coloring face, level %s." level)))
 115     (eval
 116      (macroexpand
 117       `(defface ,face
 118          '((((type tty)) (:foreground ,tty))
 119            (((background light)) (:foreground ,light))
 120            (((background dark)) (:foreground ,dark)))
 121          ,doc
 122          :group 'context-coloring)))))
 123
 124 (defvar context-coloring-face-count nil
 125   "Number of faces available for coloring.")
 126
 127 (defun context-coloring-defface-default (level)
 128   "Define a face for LEVEL with the default neutral colors."
 129   (context-coloring-defface level nil "#3f3f3f" "#cdcdcd"))
 130
 131 (defun context-coloring-set-colors-default ()
 132   (context-coloring-defface 0 nil       "#000000" "#ffffff")
 133   (context-coloring-defface 1 "yellow"  "#007f80" "#ffff80")
 134   (context-coloring-defface 2 "green"   "#001580" "#cdfacd")
 135   (context-coloring-defface 3 "cyan"    "#550080" "#d8d8ff")
 136   (context-coloring-defface 4 "blue"    "#802b00" "#e7c7ff")
 137   (context-coloring-defface 5 "magenta" "#6a8000" "#ffcdcd")
 138   (context-coloring-defface 6 "red"     "#008000" "#ffe390")
 139   (context-coloring-defface-default 7)
 140   (setq context-coloring-face-count 8))
 141
 142 (context-coloring-set-colors-default)
 143
 144 ;; Color theme authors can have up to 26 levels: 1 (0th) for globals, 24
 145 ;; (1st-24th) for in-betweens, and 1 (25th) for infinity.
 146 (dotimes (number 18)
 147   (context-coloring-defface-default (+ number context-coloring-face-count)))
 148
 149
 150 ;;; Face functions
 151
 152 (defsubst context-coloring-face-symbol (level)
 153   "Returns a symbol for a face with LEVEL."
 154   ;; `concat' is faster than `format' here.
 155   (intern-soft (concat "context-coloring-level-"
 156                        (number-to-string level)
 157                        "-face")))
 158
 159 (defun context-coloring-set-colors (&rest colors)
 160   "Set context coloring's levels' coloring to COLORS, where the
 161 Nth element of COLORS is level N's color."
 162   (setq context-coloring-face-count (length colors))
 163   (let ((level 0))
 164     (dolist (color colors)
 165       ;; Ensure there are available faces to contain new colors.
 166       (when (not (context-coloring-face-symbol level))
 167         (context-coloring-defface-default level))
 168       (set-face-foreground (context-coloring-face-symbol level) color)
 169       (setq level (+ level 1)))))
 170
 171 (defsubst context-coloring-level-face (level)
 172   "Returns the face name for LEVEL."
 173   (context-coloring-face-symbol (min level context-coloring-face-count)))
 174
 175
 176 ;;; Colorization utilities
 177
 178 (defsubst context-coloring-colorize-region (start end level)
 179   "Colorizes characters from the 1-indexed START (inclusive) to
 180 END (exclusive) with the face corresponding to LEVEL."
 181   (add-text-properties
 182    start
 183    end
 184    `(face ,(context-coloring-level-face level))))
 185
 186 (defsubst context-coloring-maybe-colorize-comments-and-strings ()
 187   "Colorizes the current buffer's comments and strings if
 188 `context-coloring-comments-and-strings' is non-nil."
 189   (when context-coloring-comments-and-strings
 190     (save-excursion
 191       (font-lock-fontify-syntactically-region (point-min) (point-max)))))
 192
 193
 194 ;;; js2-mode colorization
 195
 196 (defvar-local context-coloring-js2-scope-level-hash-table nil
 197   "Associates `js2-scope' structures and with their scope
 198   levels.")
 199
 200 (defsubst context-coloring-js2-scope-level (scope)
 201   "Gets the level of SCOPE."
 202   (cond ((gethash scope context-coloring-js2-scope-level-hash-table))
 203         (t
 204          (let ((level 0)
 205                (current-scope scope)
 206                enclosing-scope)
 207            (while (and current-scope
 208                        (js2-node-parent current-scope)
 209                        (setq enclosing-scope
 210                              (js2-node-get-enclosing-scope current-scope)))
 211              (when (or context-coloring-js-block-scopes
 212                        (let ((type (js2-scope-type current-scope)))
 213                          (or (= type js2-SCRIPT)
 214                              (= type js2-FUNCTION)
 215                              (= type js2-CATCH))))
 216                (setq level (+ level 1)))
 217              (setq current-scope enclosing-scope))
 218            (puthash scope level context-coloring-js2-scope-level-hash-table)))))
 219
 220 (defsubst context-coloring-js2-local-name-node-p (node)
 221   "Determines if NODE is a js2-name-node representing a local
 222 variable."
 223   (and (js2-name-node-p node)
 224        (let ((parent (js2-node-parent node)))
 225          (not (or (and (js2-object-prop-node-p parent)
 226                        (eq node (js2-object-prop-node-left parent)))
 227                   (and (js2-prop-get-node-p parent)
 228                        ;; For nested property lookup, the node on the left is a
 229                        ;; `js2-prop-get-node', so this always works.
 230                        (eq node (js2-prop-get-node-right parent))))))))
 231
 232 (defsubst context-coloring-js2-colorize-node (node level)
 233   "Colors NODE with the color for LEVEL."
 234   (let ((start (js2-node-abs-pos node)))
 235     (context-coloring-colorize-region
 236      start
 237      (+ start (js2-node-len node)) ; End
 238      level)))
 239
 240 (defun context-coloring-js2-colorize ()
 241   "Colorizes the current buffer using the abstract syntax tree
 242 generated by js2-mode."
 243   ;; Reset the hash table; the old one could be obsolete.
 244   (setq context-coloring-js2-scope-level-hash-table (make-hash-table :test 'eq))
 245   (with-silent-modifications
 246     (js2-visit-ast
 247      js2-mode-ast
 248      (lambda (node end-p)
 249        (when (null end-p)
 250          (cond
 251           ((js2-scope-p node)
 252            (context-coloring-js2-colorize-node
 253             node
 254             (context-coloring-js2-scope-level node)))
 255           ((context-coloring-js2-local-name-node-p node)
 256            (let* ((enclosing-scope (js2-node-get-enclosing-scope node))
 257                   (defining-scope (js2-get-defining-scope
 258                                    enclosing-scope
 259                                    (js2-name-node-name node))))
 260              ;; The tree seems to be walked lexically, so an entire scope will
 261              ;; be colored, including its name nodes, before they are reached.
 262              ;; Coloring the nodes defined in that scope would be redundant, so
 263              ;; don't do it.
 264              (when (not (eq defining-scope enclosing-scope))
 265                (context-coloring-js2-colorize-node
 266                 node
 267                 (context-coloring-js2-scope-level defining-scope))))))
 268          ;; The `t' indicates to search children.
 269          t)))
 270     (context-coloring-maybe-colorize-comments-and-strings)))
 271
 272
 273 ;;; Shell command scopification / colorization
 274
 275 (defun context-coloring-apply-tokens (tokens)
 276   "Processes a vector of TOKENS to apply context-based coloring
 277 to the current buffer.  Tokens are 3 integers: start, end, level.
 278 The vector is flat, with a new token occurring after every 3rd
 279 element."
 280   (with-silent-modifications
 281     (let ((i 0)
 282           (len (length tokens)))
 283       (while (< i len)
 284         (context-coloring-colorize-region
 285          (elt tokens i)
 286          (elt tokens (+ i 1))
 287          (elt tokens (+ i 2)))
 288         (setq i (+ i 3))))
 289     (context-coloring-maybe-colorize-comments-and-strings)))
 290
 291 (defun context-coloring-parse-array (input)
 292   "Specialized JSON parser for a flat array of numbers."
 293   (vconcat
 294    (mapcar 'string-to-number (split-string (substring input 1 -1) ","))))
 295
 296 (defun context-coloring-kill-scopifier ()
 297   "Kills the currently-running scopifier process for this
 298 buffer."
 299   (when (not (null context-coloring-scopifier-process))
 300     (delete-process context-coloring-scopifier-process)
 301     (setq context-coloring-scopifier-process nil)))
 302
 303 (defun context-coloring-scopify-shell-command (command &optional callback)
 304   "Invokes a scopifier with the current buffer's contents,
 305 reading the scopifier's response asynchronously and applying a
 306 parsed list of tokens to `context-coloring-apply-tokens'.
 307
 308 Invokes CALLBACK when complete."
 309
 310   ;; Prior running tokenization is implicitly obsolete if this function is
 311   ;; called.
 312   (context-coloring-kill-scopifier)
 313
 314   ;; Start the process.
 315   (setq context-coloring-scopifier-process
 316         (start-process-shell-command "scopifier" nil command))
 317
 318   (let ((output "")
 319         (buffer context-coloring-buffer))
 320
 321     ;; The process may produce output in multiple chunks.  This filter
 322     ;; accumulates the chunks into a message.
 323     (set-process-filter
 324      context-coloring-scopifier-process
 325      (lambda (_process chunk)
 326        (setq output (concat output chunk))))
 327
 328     ;; When the process's message is complete, this sentinel parses it as JSON
 329     ;; and applies the tokens to the buffer.
 330     (set-process-sentinel
 331      context-coloring-scopifier-process
 332      (lambda (_process event)
 333        (when (equal "finished\n" event)
 334          (let ((tokens (context-coloring-parse-array output)))
 335            (with-current-buffer buffer
 336              (context-coloring-apply-tokens tokens))
 337            (setq context-coloring-scopifier-process nil)
 338            (if callback (funcall callback)))))))
 339
 340   ;; Give the process its input so it can begin.
 341   (process-send-region
 342    context-coloring-scopifier-process
 343    (point-min) (point-max))
 344   (process-send-eof
 345    context-coloring-scopifier-process))
 346
 347
 348 ;;; Dispatch
 349
 350 (defvar context-coloring-dispatch-hash-table (make-hash-table :test 'eq)
 351   "Mapping of dispatch strategy names to their corresponding
 352   property lists, which contain details about the strategies.")
 353
 354 (defvar context-coloring-mode-hash-table (make-hash-table :test 'eq)
 355   "Mapping of major mode names to dispatch property lists.")
 356
 357 (defun context-coloring-select-dispatch (mode dispatch)
 358   "Use DISPATCH for MODE."
 359   (puthash
 360    mode
 361    (gethash
 362     dispatch
 363     context-coloring-dispatch-hash-table)
 364    context-coloring-mode-hash-table))
 365
 366 (defun context-coloring-define-dispatch (symbol &rest properties)
 367   "Define a new dispatch named SYMBOL with PROPERTIES.
 368
 369 A \"dispatch\" is a property list describing a strategy for
 370 coloring a buffer.  There are three possible strategies: Parse
 371 and color in a single function (`:colorizer'), parse in a
 372 function that returns scope data (`:scopifier'), or parse with a
 373 shell command that returns scope data (`:command').  In the
 374 latter two cases, the scope data will be used to automatically
 375 color the buffer.
 376
 377 PROPERTIES must include `:modes' and one of `:colorizer',
 378 `:scopifier' or `:command'.
 379
 380 `:modes' - List of major modes this dispatch is valid for.
 381
 382 `:colorizer' - Symbol referring to a function that parses and
 383 colors the buffer.
 384
 385 `:scopifier' - Symbol referring to a function that parses the
 386 buffer a returns a flat vector of start, end and level data.
 387
 388 `:executable' - Optional name of an executable required by
 389 `:command'.
 390
 391 `:command' - Shell command to execute with the current buffer
 392 sent via stdin, and with a flat JSON array of start, end and
 393 level data returned via stdout."
 394   (let ((modes (plist-get properties :modes))
 395         (colorizer (plist-get properties :colorizer))
 396         (scopifier (plist-get properties :scopifier))
 397         (command (plist-get properties :command)))
 398     (when (null modes)
 399       (error "No mode defined for dispatch"))
 400     (when (not (or colorizer
 401                    scopifier
 402                    command))
 403       (error "No colorizer, scopifier or command defined for dispatch"))
 404     (puthash symbol properties context-coloring-dispatch-hash-table)
 405     (dolist (mode modes)
 406       (when (null (gethash mode context-coloring-mode-hash-table))
 407         (puthash mode properties context-coloring-mode-hash-table)))))
 408
 409 (context-coloring-define-dispatch
 410  'javascript-node
 411  :modes '(js-mode js3-mode)
 412  :executable "scopifier"
 413  :command "scopifier")
 414
 415 (context-coloring-define-dispatch
 416  'javascript-js2
 417  :modes '(js2-mode)
 418  :colorizer 'context-coloring-js2-colorize)
 419
 420 (defun context-coloring-dispatch (&optional callback)
 421   "Determines the optimal track for scopification / colorization
 422 of the current buffer, then executes it.
 423
 424 Invokes CALLBACK when complete.  It is invoked synchronously for
 425 elisp tracks, and asynchronously for shell command tracks."
 426   (let ((dispatch (gethash major-mode context-coloring-mode-hash-table)))
 427     (if (null dispatch)
 428         (message "%s" "Context coloring is not available for this major mode"))
 429     (let (colorizer
 430           scopifier
 431           command
 432           executable)
 433       (cond
 434        ((setq colorizer (plist-get dispatch :colorizer))
 435         (funcall colorizer)
 436         (if callback (funcall callback)))
 437        ((setq scopifier (plist-get dispatch :scopifier))
 438         (context-coloring-apply-tokens (funcall scopifier))
 439         (if callback (funcall callback)))
 440        ((setq command (plist-get dispatch :command))
 441         (setq executable (plist-get dispatch :executable))
 442         (if (and executable
 443                  (null (executable-find executable)))
 444             (message "Executable \"%s\" not found" executable)
 445           (context-coloring-scopify-shell-command command callback)))))))
 446
 447
 448 ;;; Colorization
 449
 450 (defun context-coloring-colorize (&optional callback)
 451   "Colors the current buffer by function context.
 452
 453 Invokes CALLBACK when complete; see `context-coloring-dispatch'."
 454   (interactive)
 455   (let ((start-time (float-time)))
 456     (context-coloring-dispatch
 457      (lambda ()
 458        (when context-coloring-benchmark-colorization
 459          (message "Colorization took %.3f seconds" (- (float-time) start-time)))
 460        (if callback (funcall callback))))))
 461
 462 (defun context-coloring-change-function (_start _end _length)
 463   "Registers a change so that a buffer can be colorized soon."
 464   ;; Tokenization is obsolete if there was a change.
 465   (context-coloring-kill-scopifier)
 466   (setq context-coloring-changed t))
 467
 468 (defun context-coloring-maybe-colorize ()
 469   "Colorize unders certain conditions.  This will run as an idle
 470 timer, so firstly the buffer must not be some other buffer.
 471 Additionally, the buffer must have changed, otherwise colorizing
 472 would be redundant."
 473   (when (and (eq context-coloring-buffer (window-buffer (selected-window)))
 474              context-coloring-changed)
 475     (setq context-coloring-changed nil)
 476     (context-coloring-colorize)))
 477
 478
 479 ;;; Themes
 480
 481 (defvar context-coloring-theme-hash-table (make-hash-table :test 'eq)
 482   "Mapping of theme names to theme properties.")
 483
 484 (defun context-coloring-theme-p (theme)
 485   "Return t if THEME is defined, nil otherwise."
 486   (and (gethash theme context-coloring-theme-hash-table)))
 487
 488 (defconst context-coloring-level-face-regexp
 489   "context-coloring-level-\\([[:digit:]]+\\)-face"
 490   "Regular expression for extracting a level from a face.")
 491
 492 (defvar context-coloring-originally-set-theme-hash-table
 493   (make-hash-table :test 'eq)
 494   "Cache of custom themes who originally set their own
 495   `context-coloring-level-N-face' faces.")
 496
 497 (defun context-coloring-theme-originally-set-p (theme)
 498   "Return t if there is a `context-coloring-level-N-face'
 499 originally set for THEME, nil otherwise."
 500   (let (originally-set)
 501     (cond
 502      ;; `setq' might return a non-nil value for the sake of this `cond'.
 503      ((setq
 504        originally-set
 505        (gethash
 506         theme
 507         context-coloring-originally-set-theme-hash-table))
 508       (eq originally-set 'yes))
 509      (t
 510       (let* ((settings (get theme 'theme-settings))
 511              (tail settings)
 512              found)
 513         (while (and tail (not found))
 514           (and (eq (nth 0 (car tail)) 'theme-face)
 515                (string-match
 516                 context-coloring-level-face-regexp
 517                 (symbol-name (nth 1 (car tail))))
 518                (setq found t))
 519           (setq tail (cdr tail)))
 520         found)))))
 521
 522 (defun context-coloring-cache-originally-set (theme originally-set)
 523   "Remember if THEME had colors originally set for it; if
 524 ORIGINALLY-SET is non-nil, it did, otherwise it didn't."
 525   ;; Caching whether a theme was originally set is kind of dirty, but we have to
 526   ;; do it to remember the past state of the theme.  There are probably some
 527   ;; edge cases where caching will be an issue, but they are probably rare.
 528   (puthash
 529    theme
 530    (if originally-set 'yes 'no)
 531    context-coloring-originally-set-theme-hash-table))
 532
 533 (defun context-coloring-warn-theme-originally-set (theme)
 534   "Warns the user that the colors for a theme are already
 535 originally set."
 536   (warn "Context coloring colors for theme `%s' are already defined" theme))
 537
 538 (defun context-coloring-theme-highest-level (theme)
 539   "Return the highest level N of a face like
 540 `context-coloring-level-N-face' set for THEME, or -1 if there is
 541 none."
 542   (let* ((settings (get theme 'theme-settings))
 543          (tail settings)
 544          face-string
 545          number
 546          (found -1))
 547     (while tail
 548       (and (eq (nth 0 (car tail)) 'theme-face)
 549            (setq face-string (symbol-name (nth 1 (car tail))))
 550            (string-match
 551             context-coloring-level-face-regexp
 552             face-string)
 553            (setq number (string-to-number
 554                          (substring face-string
 555                                     (match-beginning 1)
 556                                     (match-end 1))))
 557            (> number found)
 558            (setq found number))
 559       (setq tail (cdr tail)))
 560     found))
 561
 562 (defun context-coloring-apply-theme (theme)
 563   "Applies THEME's properties to its respective custom theme,
 564 which must already exist and which *should* already be enabled."
 565   (let* ((properties (gethash theme context-coloring-theme-hash-table))
 566          (colors (plist-get properties :colors))
 567          (level -1))
 568     (setq context-coloring-face-count (length colors))
 569     (apply
 570      'custom-theme-set-faces
 571      theme
 572      (mapcar
 573       (lambda (color)
 574         (setq level (+ level 1))
 575         `(,(context-coloring-face-symbol level) ((t (:foreground ,color)))))
 576       colors))))
 577
 578 (defun context-coloring-define-theme (theme &rest properties)
 579   "Define a context theme named THEME for coloring scope levels.
 580
 581 PROPERTIES is a property list specifiying the following details:
 582
 583 `:aliases': List of symbols of other custom themes that these
 584 colors are applicable to.
 585
 586 `:colors': List of colors that this context theme uses.
 587
 588 `:override': If non-nil, this context theme is intentionally
 589 overriding colors set by a custom theme.  Don't set this non-nil
 590 unless there is a custom theme you want to use which sets
 591 `context-coloring-level-N-face' faces that you want to replace.
 592
 593 `:recede': If non-nil, this context theme should not apply its
 594 colors if a custom theme already sets
 595 `context-coloring-level-N-face' faces.  This option is
 596 optimistic; set this non-nil if you would rather confer the duty
 597 of picking colors to a custom theme author (if / when he ever
 598 gets around to it).
 599
 600 By default, context themes will always override custom themes,
 601 even if those custom themes set `context-coloring-level-N-face'
 602 faces.  If a context theme does override a custom theme, a
 603 warning will be raised, at which point you may want to enable the
 604 `:override' option, or just delete your context theme and opt to
 605 use your custom theme's author's colors instead.
 606
 607 Context themes only work for the custom theme with the highest
 608 precedence, i.e. the car of `custom-enabled-themes'."
 609   (let ((aliases (plist-get properties :aliases))
 610         (override (plist-get properties :override))
 611         (recede (plist-get properties :recede)))
 612     (dolist (name (append `(,theme) aliases))
 613       (puthash name properties context-coloring-theme-hash-table)
 614       (when (custom-theme-p name)
 615         (let ((originally-set (context-coloring-theme-originally-set-p name)))
 616           (context-coloring-cache-originally-set name originally-set)
 617           ;; In the particular case when you innocently define colors that a
 618           ;; custom theme originally set, warn.  Arguably this only has to be
 619           ;; done at enable time, but it is probably more useful to do it at
 620           ;; definition time for prompter feedback.
 621           (when (and originally-set
 622                      (not recede)
 623                      (not override))
 624             (context-coloring-warn-theme-originally-set name))
 625           ;; Set (or overwrite) colors.
 626           (when (not (and originally-set
 627                           recede))
 628             (context-coloring-apply-theme name)))))))
 629
 630 (defun context-coloring-enable-theme (theme)
 631   "Applies THEME if its colors are not already set, else just
 632 sets `context-coloring-face-count' to the correct value for
 633 THEME."
 634   (let* ((properties (gethash theme context-coloring-theme-hash-table))
 635          (recede (plist-get properties :recede))
 636          (override (plist-get properties :override)))
 637     (cond
 638      (recede
 639       (let ((highest-level (context-coloring-theme-highest-level theme)))
 640         (cond
 641          ;; This can be true whether originally set by a custom theme or by a
 642          ;; context theme.
 643          ((> highest-level -1)
 644           (setq context-coloring-face-count (+ highest-level 1)))
 645          ;; It is possible that the corresponding custom theme did not exist at
 646          ;; the time of defining this context theme, and in that case the above
 647          ;; condition proves the custom theme did not originally set any faces,
 648          ;; so we have license to apply the context theme for the first time
 649          ;; here.
 650          (t
 651           (context-coloring-apply-theme theme)))))
 652      (t
 653       (let ((originally-set (context-coloring-theme-originally-set-p theme)))
 654         ;; Cache now in case the context theme was defined after the custom
 655         ;; theme.
 656         (context-coloring-cache-originally-set theme originally-set)
 657         (when (and originally-set
 658                    (not override))
 659           (context-coloring-warn-theme-originally-set theme))
 660         (context-coloring-apply-theme theme))))))
 661
 662 (defadvice enable-theme (after context-coloring-enable-theme (theme) activate)
 663   "Enable colors for context themes just-in-time.  We can't set
 664 faces for custom themes that might not exist yet."
 665   (when (and (not (eq theme 'user)) ; Called internally by `enable-theme'.
 666              (custom-theme-p theme) ; Guard against non-existent themes.
 667              (context-coloring-theme-p theme))
 668     (context-coloring-enable-theme theme)))
 669
 670 (defadvice disable-theme (after context-coloring-disable-theme (theme) activate)
 671   "Colors are disabled normally, but
 672 `context-coloring-face-count' isn't.  Update it here."
 673   (when (custom-theme-p theme) ; Guard against non-existent themes.
 674     (let ((enabled-theme (car custom-enabled-themes)))
 675       (if (context-coloring-theme-p enabled-theme)
 676           (context-coloring-enable-theme enabled-theme)
 677         (context-coloring-set-colors-default)))))
 678
 679 (context-coloring-define-theme
 680  'ample
 681  :recede t
 682  :colors '("#bdbdb3"
 683            "#baba36"
 684            "#6aaf50"
 685            "#5180b3"
 686            "#ab75c3"
 687            "#cd7542"
 688            "#dF9522"
 689            "#454545"))
 690
 691 (context-coloring-define-theme
 692  'anti-zenburn
 693  :recede t
 694  :colors '("#232333"
 695            "#6c1f1c"
 696            "#401440"
 697            "#0f2050"
 698            "#205070"
 699            "#336c6c"
 700            "#23733c"
 701            "#6b400c"
 702            "#603a60"
 703            "#2f4070"
 704            "#235c5c"))
 705
 706 (context-coloring-define-theme
 707  'grandshell
 708  :recede t
 709  :colors '("#bebebe"
 710            "#5af2ee"
 711            "#b2baf6"
 712            "#f09fff"
 713            "#efc334"
 714            "#f6df92"
 715            "#acfb5a"
 716            "#888888"))
 717
 718 (context-coloring-define-theme
 719  'leuven
 720  :recede t
 721  :colors '("#333333"
 722            "#0000FF"
 723            "#6434A3"
 724            "#BA36A5"
 725            "#D0372D"
 726            "#036A07"
 727            "#006699"
 728            "#006FE0"
 729            "#808080"))
 730
 731 (context-coloring-define-theme
 732  'monokai
 733  :recede t
 734  :colors '("#F8F8F2"
 735            "#66D9EF"
 736            "#A1EFE4"
 737            "#A6E22E"
 738            "#E6DB74"
 739            "#FD971F"
 740            "#F92672"
 741            "#FD5FF0"
 742            "#AE81FF"))
 743
 744 (context-coloring-define-theme
 745  'solarized
 746  :recede t
 747  :aliases '(solarized-light
 748             solarized-dark
 749             sanityinc-solarized-light
 750             sanityinc-solarized-dark)
 751  :colors '("#839496"
 752            "#268bd2"
 753            "#2aa198"
 754            "#859900"
 755            "#b58900"
 756            "#cb4b16"
 757            "#dc322f"
 758            "#d33682"
 759            "#6c71c4"
 760            "#69B7F0"
 761            "#69CABF"
 762            "#B4C342"
 763            "#DEB542"
 764            "#F2804F"
 765            "#FF6E64"
 766            "#F771AC"
 767            "#9EA0E5"))
 768
 769 (context-coloring-define-theme
 770  'spacegray
 771  :recede t
 772  :colors '("#ffffff"
 773            "#89AAEB"
 774            "#C189EB"
 775            "#bf616a"
 776            "#DCA432"
 777            "#ebcb8b"
 778            "#B4EB89"
 779            "#89EBCA"))
 780
 781 (context-coloring-define-theme
 782  'tango
 783  :recede t
 784  :colors '("#2e3436"
 785            "#346604"
 786            "#204a87"
 787            "#5c3566"
 788            "#a40000"
 789            "#b35000"
 790            "#c4a000"
 791            "#8ae234"
 792            "#8cc4ff"
 793            "#ad7fa8"
 794            "#ef2929"
 795            "#fcaf3e"
 796            "#fce94f"))
 797
 798 (context-coloring-define-theme
 799  'zenburn
 800  :recede t
 801  :colors '("#DCDCCC"
 802            "#93E0E3"
 803            "#BFEBBF"
 804            "#F0DFAF"
 805            "#DFAF8F"
 806            "#CC9393"
 807            "#DC8CC3"
 808            "#94BFF3"
 809            "#9FC59F"
 810            "#D0BF8F"
 811            "#DCA3A3"))
 812
 813
 814 ;;; Minor mode
 815
 816 ;;;###autoload
 817 (define-minor-mode context-coloring-mode
 818   "Context-based code coloring, inspired by Douglas Crockford."
 819   nil " Context" nil
 820   (if (not context-coloring-mode)
 821       (progn
 822         (context-coloring-kill-scopifier)
 823         (when context-coloring-colorize-idle-timer
 824           (cancel-timer context-coloring-colorize-idle-timer))
 825         (remove-hook
 826          'js2-post-parse-callbacks 'context-coloring-colorize t)
 827         (remove-hook
 828          'after-change-functions 'context-coloring-change-function t)
 829         (font-lock-mode)
 830         (jit-lock-mode t))
 831
 832     ;; Remember this buffer.  This value should not be dynamically-bound.
 833     (setq context-coloring-buffer (current-buffer))
 834
 835     ;; Font lock is incompatible with this mode; the converse is also true.
 836     (font-lock-mode 0)
 837     (jit-lock-mode nil)
 838
 839     ;; Colorize once initially.
 840     (context-coloring-colorize)
 841
 842     (cond
 843      ((equal major-mode 'js2-mode)
 844       ;; Only recolor on reparse.
 845       (add-hook 'js2-post-parse-callbacks 'context-coloring-colorize nil t))
 846      (t
 847       ;; Only recolor on change, idly.
 848       (add-hook 'after-change-functions 'context-coloring-change-function nil t)
 849       (setq context-coloring-colorize-idle-timer
 850             (run-with-idle-timer
 851              context-coloring-delay
 852              t
 853              'context-coloring-maybe-colorize))))))
 854
 855 (provide 'context-coloring)
 856
 857 ;; Local Variables:
 858 ;; eval: (when (fboundp 'rainbow-mode) (rainbow-mode 1))
 859 ;; End:
 860
 861 ;;; context-coloring.el ends here