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