branch: master
commit b4072c1481873e4274cd187a76ae9d4afffae52c
Author: Jackson Ray Hamilton <jack...@jacksonrayhamilton.com>
Commit: Jackson Ray Hamilton <jack...@jacksonrayhamilton.com>
Trivial refactoring for clarity.
---
context-coloring.el | 149 +++++++++++++++++++++++++++-----------------------
1 files changed, 80 insertions(+), 69 deletions(-)
diff --git a/context-coloring.el b/context-coloring.el
index 9c31314..9e1e1ed 100644
--- a/context-coloring.el
+++ b/context-coloring.el
@@ -324,7 +324,7 @@ generated by `js2-mode'."
(setq level (context-coloring-scope-get-level scope)))
(t
(setq scope-stack (cdr scope-stack)))))
- ;; Assume global
+ ;; Assume a global variable.
(or level 0)))
(defun context-coloring-make-backtick (end enabled)
@@ -341,37 +341,58 @@ generated by `js2-mode'."
(defun context-coloring-backtick-enabled-p (backtick-stack)
(context-coloring-backtick-get-enabled (car backtick-stack)))
-(defun context-coloring-make-let-value (end)
- (list
- :end end))
+(defun context-coloring-forward-sws ()
+ "Move forward through whitespace and comments."
+ (while (forward-comment 1)))
-(defun context-coloring-let-value-get-end (let-value)
- (plist-get let-value :end))
+(defun context-coloring-forward-sexp-position ()
+ (scan-sexps (point) 1))
(defun context-coloring-emacs-lisp-identifier-syntax-p (syntax-code)
(or (= 2 syntax-code)
(= 3 syntax-code)))
-(defun context-coloring-forward-sws ()
- "Move forward through whitespace and comments."
- (while (forward-comment 1)))
+(defun context-coloring-open-parenthesis-p (syntax-code)
+ (= 4 syntax-code))
+
+(defun context-coloring-close-parenthesis-p (syntax-code)
+ (= 5 syntax-code))
-(defun context-coloring-at-open-parenthesis ()
+(defun context-coloring-expression-prefix-p (syntax-code)
+ (= 6 syntax-code))
+
+(defun context-coloring-at-open-parenthesis-p ()
(= 4 (logand #xFFFF (car (syntax-after (point))))))
+(defun context-coloring-ppss-depth (ppss)
+ ;; Same as (nth 0 ppss).
+ (car ppss))
+
+(defconst context-coloring-defun-regexp
+ "\\`defun\\'\\|\\`defmacro\\'\\|\\`defsubst\\'")
+
+(defconst context-coloring-arglist-arg-regexp
+ "\\`[^&:]")
+
+(defconst context-coloring-unbindable-constant-regexp
+ "\\`[-+]?[0-9]\\|\\`t\\'\\|\\`nil\\'")
+
+(defconst context-coloring-COMMA-CHAR 44)
+(defconst context-coloring-BACKTICK-CHAR 96)
+
(defun context-coloring-emacs-lisp-colorize ()
"Color the current buffer by parsing emacs lisp sexps."
(with-silent-modifications
(save-excursion
- ;; TODO: Can probably make this lazy to the nearest defun
+ ;; TODO: Can probably make this lazy to the nearest defun.
(goto-char (point-min))
(let* ((inhibit-point-motion-hooks t)
(end (point-max))
(last-ppss-pos (point))
(ppss (syntax-ppss))
- (scope-stack `(,(context-coloring-make-scope -1 0))) ; -1 never
matches a depth
- (backtick-stack `(,(context-coloring-make-backtick -1 nil)))
- (let-value-stack `(,(context-coloring-make-let-value -1)))
+ ; -1 never matches a depth. This is a minor optimization.
+ (scope-stack `(,(context-coloring-make-scope -1 0)))
+ (backtick-stack '())
one-word-found-p
in-defun-p
in-lambda-p
@@ -403,17 +424,13 @@ generated by `js2-mode'."
(point)))
(setq token-pos (point))
(setq token-syntax (syntax-after token-pos))
+ (setq token-syntax-code (logand #xFFFF (car token-syntax)))
+ (setq token-char (char-after))
(setq ppss (parse-partial-sexp last-ppss-pos token-pos nil nil ppss))
(setq last-ppss-pos token-pos)
- ;; `skip-syntax-forward' leaves the point at the delimiter, move past
- ;; it.
- (setq token-syntax-code (logand #xFFFF (car token-syntax)))
- (setq token-char (string-to-char (buffer-substring-no-properties
- token-pos
- (1+ token-pos))))
(cond
- ;; Resolve invalid state
+ ;; Resolve an invalid state.
((cond
;; Inside string?
((nth 3 ppss)
@@ -422,54 +439,49 @@ generated by `js2-mode'."
t)
;; Inside comment?
((nth 4 ppss)
- (skip-syntax-forward "^>" end) ; comment ender
+ (skip-syntax-forward "^>" end)
t)))
- ;; Expression prefix
- ;; Has to come first in case of commas
- ((= 6 token-syntax-code)
+ ;; Need to check early in case there's a comma.
+ ((context-coloring-expression-prefix-p token-syntax-code)
(forward-char)
(cond
- ;; Just outright skip top-level symbols
- ((not (or (cadr backtick-stack)
- (= token-char 96))) ; 96 = '`'
- (goto-char (scan-sexps (point) 1)))
- ((or (= token-char 96) ; 96 = '`'
- (= token-char 44)) ; 44 = ','
- ;; Have to manage backticks
+ ;; Skip top-level symbols.
+ ((not (or backtick-stack
+ (= token-char context-coloring-BACKTICK-CHAR)))
+ (goto-char (context-coloring-forward-sexp-position)))
+ ;; Push a backtick state.
+ ((or (= token-char context-coloring-BACKTICK-CHAR)
+ (= token-char context-coloring-COMMA-CHAR))
(setq backtick-stack (cons (context-coloring-make-backtick
- (scan-sexps (point) 1) ; End of the
backtick
- (= token-char 96)) ; 96 = '`'
+
(context-coloring-forward-sexp-position)
+ (= token-char
context-coloring-BACKTICK-CHAR))
backtick-stack)))))
- ;; End backtick
- ((and (cadr backtick-stack)
+ ;; Pop a backtick state.
+ ((and backtick-stack
(>= (point) (context-coloring-backtick-get-end (car
backtick-stack))))
(setq backtick-stack (cdr backtick-stack)))
- ;; Restricted by backtick
- ((and (cadr backtick-stack)
+ ;; Restricted by an enabled backtick.
+ ((and backtick-stack
(context-coloring-backtick-enabled-p backtick-stack))
(forward-char))
- ;; Opening delimiter
- ((= 4 token-syntax-code)
+ ((context-coloring-open-parenthesis-p token-syntax-code)
(forward-char)
- ;; Lookahead for scopes / function calls
+ ;; Look for function calls.
(context-coloring-forward-sws)
(setq child-0-pos (point))
(setq child-0-syntax (syntax-after child-0-pos))
(setq child-0-syntax-code (logand #xFFFF (car child-0-syntax)))
(cond
- ;; Word
((context-coloring-emacs-lisp-identifier-syntax-p
child-0-syntax-code)
(setq one-word-found-p t)
(setq child-0-end (scan-sexps child-0-pos 1))
(setq child-0-string (buffer-substring-no-properties child-0-pos
child-0-end))
(cond
- ((string-match-p
- "\\`defun\\'\\|\\`defmacro\\'\\|\\`defsubst\\'"
- child-0-string)
+ ((string-match-p context-coloring-defun-regexp child-0-string)
(setq in-defun-p t))
((string-match-p "\\`lambda\\'" child-0-string)
(setq in-lambda-p t))
@@ -482,11 +494,11 @@ generated by `js2-mode'."
in-let-p
in-let*-p)
(setq scope-stack (cons (context-coloring-make-scope
- (nth 0 ppss)
+ (context-coloring-ppss-depth ppss)
(1+ (context-coloring-scope-get-level
(car scope-stack))))
scope-stack)))
- ;; TODO: Probably redundant and wasteful
+ ;; TODO: Probably redundant and wasteful.
(context-coloring-colorize-region token-pos
(scan-sexps token-pos 1)
(context-coloring-scope-get-level
@@ -496,48 +508,49 @@ generated by `js2-mode'."
in-lambda-p)
(goto-char child-0-end)
(when in-defun-p
- ;; Lookahead for defun name
+ ;; Look for a function name.
(context-coloring-forward-sws)
(setq child-1-pos (point))
(setq child-1-syntax (syntax-after child-1-pos))
(setq child-1-syntax-code (logand #xFFFF (car child-1-syntax)))
(cond
- ;; Word
((context-coloring-emacs-lisp-identifier-syntax-p
child-1-syntax-code)
(setq child-1-end (scan-sexps child-1-pos 1))
- ;; defuns are global so use level 0
+ ;; Defuns are global, so use level 0.
(context-coloring-colorize-region child-1-pos child-1-end 0)
(goto-char child-1-end))))
- ;; Lookahead for parameters
+ ;; Look for an arglist.
(context-coloring-forward-sws)
- (when (context-coloring-at-open-parenthesis)
- ;; Actually it should be `child-1-end' for `lambda'.
- (setq child-2-end (scan-sexps (point) 1))
+ (when (context-coloring-at-open-parenthesis-p)
+ ;; (Actually it should be `child-1-end' for `lambda'.)
+ (setq child-2-end (context-coloring-forward-sexp-position))
(setq defun-arglist (read (buffer-substring-no-properties
(point)
child-2-end)))
(while defun-arglist
(setq defun-arg (car defun-arglist))
(when (and (symbolp defun-arg)
- (string-match-p "\\`[^&:]" (symbol-name
defun-arg)))
+ (string-match-p
+ context-coloring-arglist-arg-regexp
+ (symbol-name defun-arg)))
(context-coloring-scope-add-variable
(car scope-stack)
defun-arg))
(setq defun-arglist (cdr defun-arglist)))
(goto-char child-2-end))
- ;; Cleanup
+ ;; Cleanup.
(setq in-defun-p nil)
(setq in-lambda-p nil))
((or in-let-p
in-let*-p)
(goto-char child-0-end)
- ;; Lookahead for bindings
+ ;; Look for bindings.
(context-coloring-forward-sws)
(setq child-1-pos (point))
(setq child-1-syntax (syntax-after child-1-pos))
(setq child-1-syntax-code (logand #xFFFF (car child-1-syntax)))
(when (= 4 child-1-syntax-code)
- (setq child-1-end (scan-sexps (point) 1))
+ (setq child-1-end (context-coloring-forward-sexp-position))
(setq let-varlist (read (buffer-substring-no-properties
(point)
child-1-end)))
@@ -552,11 +565,11 @@ generated by `js2-mode'."
(context-coloring-scope-add-variable
(car scope-stack)
(car let-var))
- ;; TODO: Recurse or use stack to eval var value
+ ;; TODO: Recurse or use stack to eval var value.
))
(setq let-varlist (cdr let-varlist)))
(goto-char child-1-end))
- ;; Cleanup
+ ;; Cleanup.
(setq in-let-p nil)
(setq in-let*-p nil))
(t
@@ -566,19 +579,18 @@ generated by `js2-mode'."
(1+ child-0-end))
(t
(1+ token-pos))))))
- ;; Cleanup
+ ;; Cleanup.
(setq one-word-found-p nil))
- ;; Word (variable)
((context-coloring-emacs-lisp-identifier-syntax-p token-syntax-code)
- (setq variable-end (scan-sexps (point) 1))
+ (setq variable-end (context-coloring-forward-sexp-position))
(setq variable-string (buffer-substring-no-properties
token-pos
variable-end))
(cond
- ;; Ignore constants such as numbers, keywords, t, nil. These can't
+ ;; Ignore constants such as numbers, keywords, t, nil. These
can't
;; be rebound, so they should be treated like syntax.
- ((string-match-p "\\`[-+]?[0-9]\\|\\`t\\'\\|\\`nil\\'"
variable-string))
+ ((string-match-p context-coloring-unbindable-constant-regexp
variable-string))
((keywordp (read variable-string)))
(t
(setq variable (intern variable-string))
@@ -592,13 +604,12 @@ generated by `js2-mode'."
variable-scope-level))))
(goto-char variable-end))
- ;; Closing delimiter
- ((= 5 token-syntax-code)
+ ((context-coloring-close-parenthesis-p token-syntax-code)
(forward-char)
- ;; End scope
(setq ppss (parse-partial-sexp last-ppss-pos (point) nil nil ppss))
(setq last-ppss-pos (point))
- (when (= (nth 0 ppss) (context-coloring-scope-get-depth (car
scope-stack)))
+ (when (= (context-coloring-ppss-depth ppss)
+ (context-coloring-scope-get-depth (car scope-stack)))
(setq scope-stack (cdr scope-stack))))
))))
