(context-coloring-level-face (min level context-coloring-maximum-face)))
+;;; Change detection
+
+(defvar-local context-coloring-changed-p nil
+ "Indication that the buffer has changed recently, which implies
+that it should be colored again by
+`context-coloring-colorize-idle-timer' if that timer is being
+used.")
+
+(defvar-local context-coloring-changed-start nil
+ "Beginning of last text that changed.")
+
+(defvar-local context-coloring-changed-end nil
+ "End of last text that changed.")
+
+(defvar-local context-coloring-changed-length nil
+ "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."
+ ;; Tokenization is obsolete if there was a change.
+ (context-coloring-cancel-scopification)
+ (setq context-coloring-changed-start start)
+ (setq context-coloring-changed-end end)
+ (setq context-coloring-changed-length length)
+ (setq context-coloring-changed-p t))
+
+(defun context-coloring-maybe-colorize (buffer)
+ "Colorize the current buffer if it has changed."
+ (when (and (eq buffer (current-buffer))
+ context-coloring-changed-p)
+ (context-coloring-colorize)
+ (setq context-coloring-changed-p nil)
+ (setq context-coloring-changed-start nil)
+ (setq context-coloring-changed-end nil)
+ (setq context-coloring-changed-length nil)))
+
+(defvar-local context-coloring-colorize-idle-timer nil
+ "The currently-running idle timer.")
+
+(defcustom context-coloring-delay 0.25
+ "Delay between a buffer update and colorization.
+
+Increase this if your machine is high-performing. Decrease it if
+it ain't.
+
+Supported modes: `js-mode', `js3-mode', `emacs-lisp-mode'"
+ :group 'context-coloring)
+
+(defun context-coloring-setup-idle-change-detection ()
+ "Setup idle change detection."
+ (add-hook
+ 'after-change-functions 'context-coloring-change-function nil t)
+ (add-hook
+ 'kill-buffer-hook 'context-coloring-teardown-idle-change-detection nil t)
+ (setq context-coloring-colorize-idle-timer
+ (run-with-idle-timer
+ context-coloring-delay
+ t
+ 'context-coloring-maybe-colorize
+ (current-buffer))))
+
+(defun context-coloring-teardown-idle-change-detection ()
+ "Teardown idle change detection."
+ (context-coloring-cancel-scopification)
+ (when context-coloring-colorize-idle-timer
+ (cancel-timer context-coloring-colorize-idle-timer))
+ (remove-hook
+ 'kill-buffer-hook 'context-coloring-teardown-idle-change-detection t)
+ (remove-hook
+ 'after-change-functions 'context-coloring-change-function t))
+
+
;;; Colorization utilities
(defsubst context-coloring-colorize-region (start end level)
"Move forward through whitespace and comments."
(while (forward-comment 1)))
+(defsubst context-coloring-elisp-forward-sws ()
+ "Move forward through whitespace and comments, colorizing
+them along the way."
+ (let ((start (point)))
+ (context-coloring-forward-sws)
+ (context-coloring-maybe-colorize-comments-and-strings start (point))))
+
+(defsubst context-coloring-elisp-forward-sexp ()
+ "Like `forward-sexp', but colorize comments and strings along
+the way."
+ (let ((start (point)))
+ (forward-sexp)
+ (context-coloring-elisp-colorize-comments-and-strings-in-region
+ start (point))))
+
(defsubst context-coloring-get-syntax-code ()
(syntax-class
;; Faster version of `syntax-after':
'("defun" "defun*" "defsubst" "defmacro"
"cl-defun" "cl-defsubst" "cl-defmacro")))
-(defconst context-coloring-elisp-arglist-arg-regexp
- "\\`[^&:]")
+(defconst context-coloring-elisp-condition-case-regexp
+ (context-coloring-exact-or-regexp
+ '("condition-case"
+ "condition-case-unless-debug")))
(defconst context-coloring-ignored-word-regexp
(context-coloring-join (list "\\`[-+]?[0-9]"
(defconst context-coloring-elisp-sexps-per-pause 1000
"Pause after this many iterations to check for user input.
If user input is pending, stop the parse. This makes for a
-smoother user experience for large files.
-
-As of this writing, emacs lisp colorization seems to run at about
-60,000 iterations per second. A default value of 1000 should
-provide visually \"instant\" updates at 60 frames per second.")
+smoother user experience for large files.")
(defvar context-coloring-elisp-sexp-count 0)
(defsubst context-coloring-elisp-parse-arg (callback)
(let* ((arg-string (buffer-substring-no-properties
(point)
- (progn (forward-sexp)
+ (progn (context-coloring-elisp-forward-sexp)
(point)))))
- (when (string-match-p
- context-coloring-elisp-arglist-arg-regexp
- arg-string)
+ (when (not (string-match-p
+ context-coloring-ignored-word-regexp
+ arg-string))
(funcall callback arg-string))))
-;; TODO: These seem to spiral into an infinite loop sometimes.
(defun context-coloring-elisp-parse-let-varlist (type)
(let ((varlist '())
syntax-code)
(cond
((= syntax-code context-coloring-OPEN-PARENTHESIS-CODE)
(forward-char)
- (context-coloring-forward-sws)
+ (context-coloring-elisp-forward-sws)
(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
(lambda (var)
(push var varlist)))
- (context-coloring-forward-sws)
+ (context-coloring-elisp-forward-sws)
(setq syntax-code (context-coloring-get-syntax-code))
(when (/= syntax-code context-coloring-CLOSE-PARENTHESIS-CODE)
(context-coloring-elisp-colorize-sexp)))
- (context-coloring-forward-sws)
+ (context-coloring-elisp-forward-sws)
;; Skip past the closing parenthesis.
(forward-char))
((or (= syntax-code context-coloring-WORD-CODE)
(push var varlist)))))
(when (eq type 'let*)
(context-coloring-elisp-add-variable (pop varlist)))
- (context-coloring-forward-sws))
+ (context-coloring-elisp-forward-sws))
(when (eq type 'let)
(while varlist
(context-coloring-elisp-add-variable (pop varlist))))
(lambda (arg)
(context-coloring-elisp-add-variable arg))))
(t
- (forward-sexp)))
- (context-coloring-forward-sws))
+ (context-coloring-elisp-forward-sexp)))
+ (context-coloring-elisp-forward-sws))
;; Exit.
(forward-char)))
end
(context-coloring-elisp-current-scope-level))
(goto-char start)
+ ;; Enter.
+ (forward-char)
+ (context-coloring-elisp-forward-sws)
;; Skip past the "defun".
- (skip-syntax-forward "^w_")
(forward-sexp)
- (context-coloring-forward-sws)
+ (context-coloring-elisp-forward-sws)
(setq stop nil)
(unless anonymous-p
;; Check for the defun's name.
(forward-sexp)
(setq defun-name-end (point))
(context-coloring-colorize-region defun-name-pos defun-name-end 0)
- (context-coloring-forward-sws))
+ (context-coloring-elisp-forward-sws))
(t
(setq stop t))))
(cond
(stop
;; Skip it.
(goto-char start)
- (forward-sexp))
+ (context-coloring-elisp-forward-sexp))
(t
(setq syntax-code (context-coloring-get-syntax-code))
(cond
(t
;; Skip it.
(goto-char start)
- (forward-sexp)))))
- (context-coloring-elisp-pop-scope)
- (context-coloring-elisp-colorize-comments-and-strings-in-region start end)))
+ (context-coloring-elisp-forward-sexp)))))
+ (context-coloring-elisp-pop-scope)))
(defun context-coloring-elisp-colorize-defun ()
(context-coloring-elisp-colorize-defun-like))
(defun context-coloring-elisp-colorize-let* ()
(context-coloring-elisp-colorize-defun-like t 'let*))
+(defun context-coloring-elisp-colorize-cond ()
+ (let (syntax-code)
+ ;; Enter.
+ (forward-char)
+ (context-coloring-elisp-forward-sws)
+ ;; Skip past the "cond".
+ (forward-sexp)
+ (context-coloring-elisp-forward-sws)
+ (while (/= (setq syntax-code (context-coloring-get-syntax-code))
+ context-coloring-CLOSE-PARENTHESIS-CODE)
+ (cond
+ ((= syntax-code context-coloring-OPEN-PARENTHESIS-CODE)
+ ;; Colorize inside the parens.
+ (let ((start (point)))
+ (forward-sexp)
+ (context-coloring-elisp-colorize-region
+ (1+ start) (1- (point)))
+ ;; Exit.
+ (forward-char)))
+ (t
+ (context-coloring-elisp-forward-sexp)))
+ (context-coloring-elisp-forward-sws))
+ ;; Exit.
+ (forward-char)))
+
+(defun context-coloring-elisp-colorize-condition-case ()
+ (let ((start (point))
+ end
+ syntax-code
+ variable
+ case-pos
+ case-end)
+ (context-coloring-elisp-push-scope)
+ ;; Color the whole sexp.
+ (forward-sexp)
+ (setq end (point))
+ (context-coloring-colorize-region
+ start
+ end
+ (context-coloring-elisp-current-scope-level))
+ (goto-char start)
+ ;; Enter.
+ (forward-char)
+ (context-coloring-elisp-forward-sws)
+ ;; Skip past the "condition-case".
+ (forward-sexp)
+ (context-coloring-elisp-forward-sws)
+ (setq syntax-code (context-coloring-get-syntax-code))
+ ;; Gracefully ignore missing variables.
+ (when (or (= syntax-code context-coloring-WORD-CODE)
+ (= syntax-code context-coloring-SYMBOL-CODE))
+ (context-coloring-elisp-parse-arg
+ (lambda (parsed-variable)
+ (setq variable parsed-variable)))
+ (context-coloring-elisp-forward-sws))
+ (context-coloring-elisp-colorize-sexp)
+ (context-coloring-elisp-forward-sws)
+ ;; Parse the handlers with the error variable in scope.
+ (when variable
+ (context-coloring-elisp-add-variable variable))
+ (while (/= (setq syntax-code (context-coloring-get-syntax-code))
+ context-coloring-CLOSE-PARENTHESIS-CODE)
+ (cond
+ ((= syntax-code context-coloring-OPEN-PARENTHESIS-CODE)
+ (setq case-pos (point))
+ (context-coloring-elisp-forward-sexp)
+ (setq case-end (point))
+ (goto-char case-pos)
+ ;; Enter.
+ (forward-char)
+ (context-coloring-elisp-forward-sws)
+ (setq syntax-code (context-coloring-get-syntax-code))
+ (when (/= syntax-code context-coloring-CLOSE-PARENTHESIS-CODE)
+ ;; Skip the condition name(s).
+ (context-coloring-elisp-forward-sexp)
+ ;; Color the remaining portion of the handler.
+ (context-coloring-elisp-colorize-region
+ (point)
+ (1- case-end)))
+ ;; Exit.
+ (forward-char))
+ (t
+ ;; Ignore artifacts.
+ (context-coloring-elisp-forward-sexp)))
+ (context-coloring-elisp-forward-sws))
+ ;; Exit.
+ (forward-char)
+ (context-coloring-elisp-pop-scope)))
+
(defun context-coloring-elisp-colorize-parenthesized-sexp ()
(context-coloring-elisp-increment-sexp-count)
(let* ((start (point))
(point)))
(syntax-code (progn (goto-char start)
(forward-char)
+ ;; Coloring is unnecessary here, it'll happen
+ ;; presently.
(context-coloring-forward-sws)
(context-coloring-get-syntax-code))))
;; Figure out if the sexp is a special form.
(goto-char start)
(context-coloring-elisp-colorize-lambda)
t)
+ ((string-equal "cond" name-string)
+ (goto-char start)
+ (context-coloring-elisp-colorize-cond)
+ t)
+ ((string-match-p context-coloring-elisp-condition-case-regexp name-string)
+ (goto-char start)
+ (context-coloring-elisp-colorize-condition-case)
+ t)
(t
nil)))))
;; Not a special form; just colorize the remaining region.
(defun context-coloring-elisp-colorize-expression-prefix ()
(context-coloring-elisp-increment-sexp-count)
(let ((char (char-after))
- (start (point))
- (end (progn (forward-sexp)
- (point))))
+ start
+ end)
(cond
((or (= char context-coloring-APOSTROPHE-CHAR)
(= char context-coloring-OCTOTHORPE-CHAR))
- (context-coloring-elisp-colorize-comments-and-strings-in-region start end))
+ (context-coloring-elisp-forward-sexp))
((= char context-coloring-BACKTICK-CHAR)
+ (setq start (point))
+ (setq end (progn (forward-sexp)
+ (point)))
(goto-char start)
(while (> end (progn (forward-char)
(point)))
(when (= (char-after) context-coloring-AT-CHAR)
;; If we don't do this "@" could be interpreted as a symbol.
(forward-char))
- (context-coloring-forward-sws)
+ (context-coloring-elisp-forward-sws)
(context-coloring-elisp-colorize-sexp)))
- (context-coloring-elisp-colorize-comments-and-strings-in-region start end)))))
+ ;; We could probably do this as part of the above loop but it'd be
+ ;; repetitive.
+ (context-coloring-elisp-colorize-comments-and-strings-in-region
+ start end)))))
(defun context-coloring-elisp-colorize-comment ()
(context-coloring-elisp-increment-sexp-count)
- (let ((start (point)))
- (context-coloring-forward-sws)
- (context-coloring-maybe-colorize-comments-and-strings
- start
- (point))))
+ (context-coloring-elisp-forward-sws))
(defun context-coloring-elisp-colorize-string ()
(context-coloring-elisp-increment-sexp-count)
(t
(forward-char))))))
-(defun context-coloring-elisp-colorize (start end)
+(defun context-coloring-elisp-colorize-region-initially (start end)
(setq context-coloring-elisp-sexp-count 0)
(setq context-coloring-elisp-scope-stack '())
(let ((inhibit-point-motion-hooks t)
(max-specpdl-size (max max-specpdl-size 3000)))
(context-coloring-elisp-colorize-region start end)))
-(defun context-coloring-elisp-colorize-changed-region (start end)
- (with-silent-modifications
- (save-excursion
- (let ((start (progn (goto-char start)
- (beginning-of-defun)
- (point)))
- (end (progn (goto-char end)
- (end-of-defun)
- (point))))
- (context-coloring-elisp-colorize start end)))))
-
-(defun context-coloring-elisp-colorize-buffer ()
+(defun context-coloring-elisp-colorize ()
+ "Color the current buffer, parsing elisp to determine its
+scopes and variables."
(interactive)
(with-silent-modifications
(save-excursion
- (context-coloring-elisp-colorize (point-min) (point-max)))))
+ (cond
+ ;; Just colorize the changed region.
+ (context-coloring-changed-p
+ (let ((start (progn (goto-char context-coloring-changed-start)
+ (beginning-of-defun)
+ (point)))
+ (end (progn (goto-char context-coloring-changed-end)
+ (end-of-defun)
+ (point))))
+ (context-coloring-elisp-colorize-region-initially start end)))
+ (t
+ (context-coloring-elisp-colorize-region-initially (point-min) (point-max)))))))
;;; Shell command scopification / colorization
(when callback (funcall callback))
(run-hooks 'context-coloring-colorize-hook))))
-(defvar-local context-coloring-changed nil
- "Indication that the buffer has changed recently, which implies
-that it should be colored again by
-`context-coloring-colorize-idle-timer' if that timer is being
-used.")
-
-(defun context-coloring-change-function (_start _end _length)
- "Register a change so that a buffer can be colorized soon."
- ;; Tokenization is obsolete if there was a change.
- (context-coloring-cancel-scopification)
- (setq context-coloring-changed t))
-
-(defun context-coloring-maybe-colorize (buffer)
- "Colorize the current buffer if it has changed."
- (when (and (eq buffer (current-buffer))
- context-coloring-changed)
- (setq context-coloring-changed nil)
- (context-coloring-colorize)))
-
;;; Versioning
"#dca3a3"))
-;;; Change detection
-
-(defvar-local context-coloring-colorize-idle-timer nil
- "The currently-running idle timer.")
-
-(defcustom context-coloring-delay 0.25
- "Delay between a buffer update and colorization.
-
-Increase this if your machine is high-performing. Decrease it if
-it ain't.
-
-Supported modes: `js-mode', `js3-mode', `emacs-lisp-mode'"
- :group 'context-coloring)
-
-(defun context-coloring-setup-idle-change-detection ()
- "Setup idle change detection."
- (add-hook
- 'after-change-functions 'context-coloring-change-function nil t)
- (add-hook
- 'kill-buffer-hook 'context-coloring-teardown-idle-change-detection nil t)
- (setq context-coloring-colorize-idle-timer
- (run-with-idle-timer
- context-coloring-delay
- t
- 'context-coloring-maybe-colorize
- (current-buffer))))
-
-(defun context-coloring-teardown-idle-change-detection ()
- "Teardown idle change detection."
- (context-coloring-cancel-scopification)
- (when context-coloring-colorize-idle-timer
- (cancel-timer context-coloring-colorize-idle-timer))
- (remove-hook
- 'kill-buffer-hook 'context-coloring-teardown-idle-change-detection t)
- (remove-hook
- 'after-change-functions 'context-coloring-change-function t))
-
-
;;; Built-in dispatches
(context-coloring-define-dispatch
:modes '(js-mode js3-mode)
:executable "scopifier"
:command "scopifier"
- :version "v1.1.1" ; TODO: v1.2.0
+ :version "v1.2.1"
:host "localhost"
:port 6969)
(context-coloring-define-dispatch
'emacs-lisp
:modes '(emacs-lisp-mode)
- :colorizer 'context-coloring-elisp-colorize-buffer
+ :colorizer 'context-coloring-elisp-colorize
:setup 'context-coloring-setup-idle-change-detection
:teardown 'context-coloring-teardown-idle-change-detection)
(setq interrupted-p
(catch 'interrupted
(funcall colorizer)))
- (cond
- (interrupted-p
- (setq context-coloring-changed t))
- (t
- (when callback (funcall callback)))))
+ (when (and (not interrupted-p)
+ callback)
+ (funcall callback)))
(command
(cond
((and host port)