(defvar context-coloring-original-maximum-face nil
"Fallback value for `context-coloring-maximum-face' when all
- themes have been disabled.")
+themes have been disabled.")
(setq context-coloring-maximum-face 7)
"Length of last text that changed.")
(defun context-coloring-change-function (start end length)
- "Register a change so that a buffer can be colorized soon."
+ "Register a change so that a buffer can be colorized soon.
+
+START, END and LENGTH are recorded for later use."
;; Tokenization is obsolete if there was a change.
(context-coloring-cancel-scopification)
(setq context-coloring-changed-start start)
(setq context-coloring-changed-p t))
(defun context-coloring-maybe-colorize (buffer)
- "Colorize the current buffer if it has changed."
+ "Colorize the current buffer if it is BUFFER and has changed."
(when (and (eq buffer (current-buffer))
context-coloring-changed-p)
(context-coloring-colorize)
"Tell `font-lock' to color a string but not a comment."
(if (nth 3 state) font-lock-string-face nil))
-(defsubst context-coloring-maybe-colorize-comments-and-strings (&optional min max)
+(defsubst context-coloring-colorize-comments-and-strings (&optional min max)
"Color the current buffer's comments or strings if
`context-coloring-syntactic-comments' or
-`context-coloring-syntactic-strings' are non-nil."
+`context-coloring-syntactic-strings' are non-nil. MIN defaults
+to the beginning of the buffer and MAX defaults to the end."
(when (or context-coloring-syntactic-comments
context-coloring-syntactic-strings)
(let ((min (or min (point-min)))
(context-coloring-js2-scope-level defining-scope))))))
;; The `t' indicates to search children.
t)))
- (context-coloring-maybe-colorize-comments-and-strings)))
+ (context-coloring-colorize-comments-and-strings)))
;;; Emacs Lisp colorization
(defsubst context-coloring-elisp-forward-sws ()
"Move forward through whitespace and comments, colorizing
-them along the way."
+comments along the way."
(let ((start (point)))
(context-coloring-forward-sws)
- (context-coloring-maybe-colorize-comments-and-strings start (point))))
+ (context-coloring-colorize-comments-and-strings start (point))))
(defsubst context-coloring-elisp-forward-sexp ()
"Like `forward-sexp', but colorize comments and strings along
start (point))))
(defsubst context-coloring-get-syntax-code ()
+ "Get the syntax code at point."
(syntax-class
;; Faster version of `syntax-after':
(aref (syntax-table) (char-after (point)))))
(defsubst context-coloring-exact-regexp (word)
- "Create a regexp that matches exactly WORD."
+ "Create a regexp matching exactly WORD."
(concat "\\`" (regexp-quote word) "\\'"))
(defsubst context-coloring-exact-or-regexp (words)
- "Create a regexp that matches any exact word in WORDS."
+ "Create a regexp matching any exact word in WORDS."
(context-coloring-join
(mapcar #'context-coloring-exact-regexp words) "\\|"))
'("condition-case"
"condition-case-unless-debug")))
-(defconst context-coloring-ignored-word-regexp
+(defconst context-coloring-elisp-ignored-word-regexp
(context-coloring-join (list "\\`[-+]?[0-9]"
"\\`[&:].+"
(context-coloring-exact-or-regexp
'("t" "nil" "." "?")))
- "\\|"))
+ "\\|")
+ "Match words that might be considered symbols but can't be
+bound as variables.")
(defconst context-coloring-WORD-CODE 2)
(defconst context-coloring-SYMBOL-CODE 3)
If user input is pending, stop the parse. This makes for a
smoother user experience for large files.")
-(defvar context-coloring-elisp-sexp-count 0)
+(defvar context-coloring-elisp-sexp-count 0
+ "Current number of sexps leading up to the next pause.")
(defsubst context-coloring-elisp-increment-sexp-count ()
+ "Maybe check if the current parse should be interrupted as a
+result of pending user input."
(setq context-coloring-elisp-sexp-count
(1+ context-coloring-elisp-sexp-count))
(when (and (zerop (% context-coloring-elisp-sexp-count
(input-pending-p))
(throw 'interrupted t)))
-(defvar context-coloring-elisp-scope-stack '())
+(defvar context-coloring-elisp-scope-stack '()
+ "List of scopes in the current parse.")
(defsubst context-coloring-elisp-make-scope (level)
+ "Make a scope object for LEVEL."
(list
:level level
:variables '()))
(defsubst context-coloring-elisp-scope-get-level (scope)
+ "Get the level of SCOPE object."
(plist-get scope :level))
(defsubst context-coloring-elisp-scope-add-variable (scope variable)
+ "Add to SCOPE a VARIABLE."
(plist-put scope :variables (cons variable (plist-get scope :variables))))
(defsubst context-coloring-elisp-scope-has-variable (scope variable)
+ "Check if SCOPE has VARIABLE."
(member variable (plist-get scope :variables)))
(defsubst context-coloring-elisp-get-variable-level (variable)
+ "Search up the scope chain for the first instance of VARIABLE
+and return its level, or 0 (global) if it isn't found."
(let* ((scope-stack context-coloring-elisp-scope-stack)
scope
level)
;; Assume a global variable.
(or level 0)))
-(defsubst context-coloring-elisp-current-scope-level ()
+(defsubst context-coloring-elisp-get-current-scope-level ()
+ "Get the nesting level of the current scope."
(cond
((car context-coloring-elisp-scope-stack)
(context-coloring-elisp-scope-get-level (car context-coloring-elisp-scope-stack)))
0)))
(defsubst context-coloring-elisp-push-scope ()
+ "Add a new scope to the bottom of the scope chain."
(push (context-coloring-elisp-make-scope
- (1+ (context-coloring-elisp-current-scope-level)))
+ (1+ (context-coloring-elisp-get-current-scope-level)))
context-coloring-elisp-scope-stack))
(defsubst context-coloring-elisp-pop-scope ()
+ "Remove the scope on the bottom of the scope chain."
(pop context-coloring-elisp-scope-stack))
(defsubst context-coloring-elisp-add-variable (variable)
+ "Add VARIABLE to the current scope."
(context-coloring-elisp-scope-add-variable
(car context-coloring-elisp-scope-stack)
variable))
-(defsubst context-coloring-elisp-parse-arg (callback)
+(defsubst context-coloring-elisp-parse-bindable (callback)
+ "Parse the symbol at point, and if the symbol can be bound,
+invoke CALLBACK with it."
(let* ((arg-string (buffer-substring-no-properties
(point)
(progn (context-coloring-elisp-forward-sexp)
(point)))))
(when (not (string-match-p
- context-coloring-ignored-word-regexp
+ context-coloring-elisp-ignored-word-regexp
arg-string))
(funcall callback arg-string))))
(defun context-coloring-elisp-parse-let-varlist (type)
+ "Parse the list of variable initializers at point. If TYPE is
+`let', all the variables are bound after all their initializers
+are parsed; if TYPE is `let*', each variable is bound immediately
+after its own initializer is parsed."
(let ((varlist '())
syntax-code)
;; Enter.
(setq syntax-code (context-coloring-get-syntax-code))
(when (or (= syntax-code context-coloring-WORD-CODE)
(= syntax-code context-coloring-SYMBOL-CODE))
- (context-coloring-elisp-parse-arg
+ (context-coloring-elisp-parse-bindable
(lambda (var)
(push var varlist)))
(context-coloring-elisp-forward-sws)
(forward-char))
((or (= syntax-code context-coloring-WORD-CODE)
(= syntax-code context-coloring-SYMBOL-CODE))
- (context-coloring-elisp-parse-arg
+ (context-coloring-elisp-parse-bindable
(lambda (var)
(push var varlist)))))
(when (eq type 'let*)
(forward-char)))
(defun context-coloring-elisp-parse-arglist ()
+ "Parse the list of function arguments at point."
(let (syntax-code)
;; Enter.
(forward-char)
(cond
((or (= syntax-code context-coloring-WORD-CODE)
(= syntax-code context-coloring-SYMBOL-CODE))
- (context-coloring-elisp-parse-arg
+ (context-coloring-elisp-parse-bindable
(lambda (arg)
(context-coloring-elisp-add-variable arg))))
(t
+ ;; Ignore artifacts.
(context-coloring-elisp-forward-sexp)))
(context-coloring-elisp-forward-sws))
;; Exit.
(defun context-coloring-elisp-colorize-defun-like (&optional anonymous-p
let-type)
+ "Color the defun-like function at point. ANONYMOUS-P indicates
+the function doesn't name itself (e.g. `lambda', `let').
+LET-TYPE can be one of `let' or `let*'."
(let ((start (point))
end
stop
(context-coloring-colorize-region
start
end
- (context-coloring-elisp-current-scope-level))
+ (context-coloring-elisp-get-current-scope-level))
(goto-char start)
;; Enter.
(forward-char)
(context-coloring-elisp-pop-scope)))
(defun context-coloring-elisp-colorize-defun ()
+ "Color the `defun' (or defun-like function) at point."
(context-coloring-elisp-colorize-defun-like))
(defun context-coloring-elisp-colorize-lambda ()
+ "Color the `lambda' at point."
(context-coloring-elisp-colorize-defun-like t))
(defun context-coloring-elisp-colorize-let ()
+ "Color the `let' at point."
(context-coloring-elisp-colorize-defun-like t 'let))
(defun context-coloring-elisp-colorize-let* ()
+ "Color the `let*' at point."
(context-coloring-elisp-colorize-defun-like t 'let*))
(defun context-coloring-elisp-colorize-cond ()
+ "Color the `cond' at point."
(let (syntax-code)
;; Enter.
(forward-char)
;; Exit.
(forward-char)))
(t
+ ;; Ignore artifacts.
(context-coloring-elisp-forward-sexp)))
(context-coloring-elisp-forward-sws))
;; Exit.
(forward-char)))
(defun context-coloring-elisp-colorize-condition-case ()
+ "Color the `condition-case' at point."
(let ((start (point))
end
syntax-code
(context-coloring-colorize-region
start
end
- (context-coloring-elisp-current-scope-level))
+ (context-coloring-elisp-get-current-scope-level))
(goto-char start)
;; Enter.
(forward-char)
;; Gracefully ignore missing variables.
(when (or (= syntax-code context-coloring-WORD-CODE)
(= syntax-code context-coloring-SYMBOL-CODE))
- (context-coloring-elisp-parse-arg
+ (context-coloring-elisp-parse-bindable
(lambda (parsed-variable)
(setq variable parsed-variable)))
(context-coloring-elisp-forward-sws))
(context-coloring-elisp-pop-scope)))
(defun context-coloring-elisp-colorize-parenthesized-sexp ()
+ "Color the sexp enclosed by parenthesis at point."
(context-coloring-elisp-increment-sexp-count)
(let* ((start (point))
(end (progn (forward-sexp)
(context-coloring-colorize-region
start
end
- (context-coloring-elisp-current-scope-level))
+ (context-coloring-elisp-get-current-scope-level))
(context-coloring-elisp-colorize-region (point) (1- end))
(forward-char)))))
(defun context-coloring-elisp-colorize-symbol ()
+ "Color the symbol at point."
(context-coloring-elisp-increment-sexp-count)
(let* ((symbol-pos (point))
(symbol-end (progn (forward-sexp)
symbol-pos
symbol-end)))
(cond
- ((string-match-p context-coloring-ignored-word-regexp symbol-string))
+ ((string-match-p context-coloring-elisp-ignored-word-regexp symbol-string))
(t
(context-coloring-colorize-region
symbol-pos
symbol-string))))))
(defun context-coloring-elisp-colorize-expression-prefix ()
+ "Color the expression prefix and the following expression at
+point. It could be a quoted or backquoted expression."
(context-coloring-elisp-increment-sexp-count)
(let ((char (char-after))
start
start end)))))
(defun context-coloring-elisp-colorize-comment ()
+ "Color the comment at point."
(context-coloring-elisp-increment-sexp-count)
(context-coloring-elisp-forward-sws))
(defun context-coloring-elisp-colorize-string ()
+ "Color the string at point."
(context-coloring-elisp-increment-sexp-count)
(let ((start (point)))
(forward-sexp)
- (context-coloring-maybe-colorize-comments-and-strings
- start
- (point))))
+ (context-coloring-colorize-comments-and-strings start (point))))
(defun context-coloring-elisp-colorize-sexp ()
+ "Color the sexp at point."
(let ((syntax-code (context-coloring-get-syntax-code)))
(cond
((= syntax-code context-coloring-OPEN-PARENTHESIS-CODE)
(forward-char)))))
(defun context-coloring-elisp-colorize-comments-and-strings-in-region (start end)
+ "Color comments and strings between START and END."
(let (syntax-code)
(goto-char start)
(while (> end (progn (skip-syntax-forward "^<\"\\" end)
(forward-char))))))
(defun context-coloring-elisp-colorize-region (start end)
+ "Color everything between START and END."
(let (syntax-code)
(goto-char start)
(while (> end (progn (skip-syntax-forward "^()w_'<\"\\" end)
(forward-char))))))
(defun context-coloring-elisp-colorize-region-initially (start end)
+ "Begin coloring everything between START and END."
(setq context-coloring-elisp-sexp-count 0)
(setq context-coloring-elisp-scope-stack '())
(let ((inhibit-point-motion-hooks t)
(pop tokens)
(pop tokens)
(pop tokens))))
- (context-coloring-maybe-colorize-comments-and-strings))
+ (context-coloring-colorize-comments-and-strings))
(defun context-coloring-parse-array (array)
"Parse ARRAY as a flat JSON array of numbers and use the tokens
context-coloring-scopifier-process))
(defun context-coloring-start-scopifier-server (command host port callback)
+ "Connect to or start a scopifier server with COMMAND, HOST and PORT.
+Invoke CALLBACK with a network stream when the server is ready
+for connections."
(let* ((connect
(lambda ()
(let ((stream (open-network-stream "context-coloring-stream" nil host port)))
(funcall connect)))))))))
(defun context-coloring-send-buffer-to-scopifier-server (command host port callback)
+ "Send the current buffer to the scopifier server running with
+COMMAND, HOST and PORT. Invoke CALLBACK with the server's
+response (a stringified JSON array)."
(context-coloring-start-scopifier-server
command host port
(lambda (process)
(setq active nil)))))))
(defun context-coloring-scopify-and-colorize-server (command host port &optional callback)
- "Contact or start a scopifier server via COMMAND at HOST and
-PORT with the current buffer's contents, read the scopifier's
-response asynchronously and apply a parsed list of tokens to
-`context-coloring-apply-tokens'.
-
-Invoke CALLBACK when complete."
+ "Color the current buffer via the server started with COMMAND,
+HOST and PORT. Invoke CALLBACK when complete."
(let ((buffer (current-buffer)))
(context-coloring-send-buffer-to-scopifier-server
command host port
(when callback (funcall callback))))))
(defun context-coloring-scopify-and-colorize (command &optional callback)
- "Invoke a scopifier via COMMAND with the current buffer's contents,
-read the scopifier's response asynchronously and apply a parsed
-list of tokens to `context-coloring-apply-tokens'.
-
-Invoke CALLBACK when complete."
+ "Color the current buffer via COMMAND. Invoke CALLBACK when
+complete."
(let ((buffer (current-buffer)))
(context-coloring-scopify-shell-command
command
(defvar context-coloring-dispatch-hash-table (make-hash-table :test #'eq)
"Map dispatch strategy names to their corresponding property
- lists, which contain details about the strategies.")
+lists, which contain details about the strategies.")
(defvar context-coloring-mode-hash-table (make-hash-table :test #'eq)
"Map major mode names to dispatch property lists.")
(defvar context-coloring-originally-set-theme-hash-table
(make-hash-table :test #'eq)
"Cache custom themes who originally set their own
- `context-coloring-level-N-face' faces.")
+`context-coloring-level-N-face' faces.")
(defun context-coloring-theme-originally-set-p (theme)
"Return t if there is a `context-coloring-level-N-face'