(while (forward-comment 1)))
(defsubst context-coloring-get-syntax-code ()
- (syntax-class (syntax-after (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."
'("defun" "defun*" "defsubst" "defmacro"
"cl-defun" "cl-defsubst" "cl-defmacro")))
-(defconst context-coloring-elisp-lambda-regexp
- (context-coloring-exact-regexp "lambda"))
-
-(defconst context-coloring-elisp-let-regexp
- (context-coloring-exact-regexp "let"))
-
-(defconst context-coloring-elisp-let*-regexp
- (context-coloring-exact-regexp "let*"))
-
(defconst context-coloring-elisp-arglist-arg-regexp
"\\`[^&:]")
(defconst context-coloring-AT-CHAR (string-to-char "@"))
(defconst context-coloring-BACKTICK-CHAR (string-to-char "`"))
+(defvar context-coloring-parse-interruptable-p t
+ "Set this to nil to force parse to continue until finished.")
+
+(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.")
+
+(defvar context-coloring-elisp-sexp-count 0)
+
+(defsubst context-coloring-elisp-increment-sexp-count ()
+ (setq context-coloring-elisp-sexp-count
+ (1+ context-coloring-elisp-sexp-count))
+ (when (and (zerop (% context-coloring-elisp-sexp-count
+ context-coloring-elisp-sexps-per-pause))
+ context-coloring-parse-interruptable-p
+ (input-pending-p))
+ (throw 'interrupted t)))
+
(defvar context-coloring-elisp-scope-stack '())
(defsubst context-coloring-elisp-make-scope (level)
(car context-coloring-elisp-scope-stack)
variable))
-(defun context-coloring-elisp-parse-arg (callback)
- (let (arg-pos
- arg-end
- arg-string)
- (setq arg-pos (point))
- (forward-sexp)
- (setq arg-end (point))
- (setq arg-string (buffer-substring-no-properties
- arg-pos
- arg-end))
+(defsubst context-coloring-elisp-parse-arg (callback)
+ (let* ((arg-string (buffer-substring-no-properties
+ (point)
+ (progn (forward-sexp)
+ (point)))))
(when (string-match-p
context-coloring-elisp-arglist-arg-regexp
arg-string)
;; Exit.
(forward-char)))
-(defun context-coloring-elisp-colorize-defun (&optional anonymous-p
- let-type)
+(defun context-coloring-elisp-colorize-defun-like (&optional anonymous-p
+ let-type)
(let ((start (point))
end
stop
(context-coloring-elisp-pop-scope)
(context-coloring-elisp-colorize-comments-and-strings-in-region start end)))
+(defun context-coloring-elisp-colorize-defun ()
+ (context-coloring-elisp-colorize-defun-like))
+
(defun context-coloring-elisp-colorize-lambda ()
- (context-coloring-elisp-colorize-defun t))
+ (context-coloring-elisp-colorize-defun-like t))
(defun context-coloring-elisp-colorize-let ()
- (context-coloring-elisp-colorize-defun t 'let))
+ (context-coloring-elisp-colorize-defun-like t 'let))
(defun context-coloring-elisp-colorize-let* ()
- (context-coloring-elisp-colorize-defun t 'let*))
+ (context-coloring-elisp-colorize-defun-like t 'let*))
(defun context-coloring-elisp-colorize-parenthesized-sexp ()
- (let ((start (point))
- end
- syntax-code
- child-0-pos
- child-0-end
- child-0-string)
- (forward-sexp)
- (setq end (point))
- (goto-char start)
- (forward-char)
- (context-coloring-forward-sws)
- (setq syntax-code (context-coloring-get-syntax-code))
+ (context-coloring-elisp-increment-sexp-count)
+ (let* ((start (point))
+ (end (progn (forward-sexp)
+ (point)))
+ (syntax-code (progn (goto-char start)
+ (forward-char)
+ (context-coloring-forward-sws)
+ (context-coloring-get-syntax-code))))
;; Figure out if the sexp is a special form.
(cond
((when (or (= syntax-code context-coloring-WORD-CODE)
(= syntax-code context-coloring-SYMBOL-CODE))
- (setq child-0-pos (point))
- (forward-sexp)
- (setq child-0-end (point))
- (setq child-0-string (buffer-substring-no-properties
- child-0-pos
- child-0-end))
- (cond
- ((string-match-p context-coloring-elisp-defun-regexp child-0-string)
- (goto-char start)
- (context-coloring-elisp-colorize-defun)
- t)
- ((string-match-p context-coloring-elisp-lambda-regexp child-0-string)
- (goto-char start)
- (context-coloring-elisp-colorize-lambda)
- t)
- ((string-match-p context-coloring-elisp-let-regexp child-0-string)
- (goto-char start)
- (context-coloring-elisp-colorize-let)
- t)
- ((string-match-p context-coloring-elisp-let*-regexp child-0-string)
- (goto-char start)
- (context-coloring-elisp-colorize-let*)
- t)
- (t
- nil))))
+ (let ((name-string (buffer-substring-no-properties
+ (point)
+ (progn (forward-sexp)
+ (point)))))
+ (cond
+ ((string-match-p context-coloring-elisp-defun-regexp name-string)
+ (goto-char start)
+ (context-coloring-elisp-colorize-defun)
+ t)
+ ((string-equal "let" name-string)
+ (goto-char start)
+ (context-coloring-elisp-colorize-let)
+ t)
+ ((string-equal "let*" name-string)
+ (goto-char start)
+ (context-coloring-elisp-colorize-let*)
+ t)
+ ((string-equal "lambda" name-string)
+ (goto-char start)
+ (context-coloring-elisp-colorize-lambda)
+ t)
+ (t
+ nil)))))
;; Not a special form; just colorize the remaining region.
(t
(context-coloring-colorize-region
(forward-char)))))
(defun context-coloring-elisp-colorize-symbol ()
- (let (symbol-pos
- symbol-end
- symbol-string)
- (setq symbol-pos (point))
- (forward-sexp)
- (setq symbol-end (point))
- (setq symbol-string (buffer-substring-no-properties
+ (context-coloring-elisp-increment-sexp-count)
+ (let* ((symbol-pos (point))
+ (symbol-end (progn (forward-sexp)
+ (point)))
+ (symbol-string (buffer-substring-no-properties
symbol-pos
- symbol-end))
+ symbol-end)))
(cond
((string-match-p context-coloring-ignored-word-regexp symbol-string))
(t
symbol-string))))))
(defun context-coloring-elisp-colorize-expression-prefix ()
+ (context-coloring-elisp-increment-sexp-count)
(let ((char (char-after))
(start (point))
(end (progn (forward-sexp)
(context-coloring-elisp-colorize-sexp)))
(context-coloring-elisp-colorize-comments-and-strings-in-region start end)))))
-(defvar context-coloring-parse-interruptable-p t
- "Set this to nil to force parse to continue until finished.")
-
-(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.")
-
-(defvar context-coloring-elisp-sexp-count 0)
+(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))))
-(defun context-coloring-elisp-increment-sexp-count ()
- (setq context-coloring-elisp-sexp-count
- (1+ context-coloring-elisp-sexp-count))
- (when (and (zerop (% context-coloring-elisp-sexp-count
- context-coloring-elisp-sexps-per-pause))
- context-coloring-parse-interruptable-p
- (input-pending-p))
- (throw 'interrupted t)))
+(defun context-coloring-elisp-colorize-string ()
+ (context-coloring-elisp-increment-sexp-count)
+ (let ((start (point)))
+ (forward-sexp)
+ (context-coloring-maybe-colorize-comments-and-strings
+ start
+ (point))))
(defun context-coloring-elisp-colorize-sexp ()
- (let (syntax-code)
- (context-coloring-elisp-increment-sexp-count)
- (setq syntax-code (context-coloring-get-syntax-code))
+ (let ((syntax-code (context-coloring-get-syntax-code)))
(cond
((= syntax-code context-coloring-OPEN-PARENTHESIS-CODE)
(context-coloring-elisp-colorize-parenthesized-sexp))
(context-coloring-elisp-colorize-expression-prefix))
((= syntax-code context-coloring-STRING-QUOTE-CODE)
(context-coloring-elisp-colorize-string))
+ ((= syntax-code context-coloring-ESCAPE-CODE)
+ (forward-char 2))
(t
(forward-char)))))
-(defun context-coloring-elisp-colorize-comment ()
- (let ((start (point)))
- (context-coloring-elisp-increment-sexp-count)
- (context-coloring-forward-sws)
- (context-coloring-maybe-colorize-comments-and-strings
- start
- (point))))
-
-(defun context-coloring-elisp-colorize-string ()
- (let ((start (point)))
- (context-coloring-elisp-increment-sexp-count)
- (forward-sexp)
- (context-coloring-maybe-colorize-comments-and-strings
- start
- (point))))
-
(defun context-coloring-elisp-colorize-comments-and-strings-in-region (start end)
(let (syntax-code)
(goto-char start)
(point)))
(setq syntax-code (context-coloring-get-syntax-code))
(cond
- ((or (= syntax-code context-coloring-OPEN-PARENTHESIS-CODE)
- (= syntax-code context-coloring-WORD-CODE)
- (= syntax-code context-coloring-SYMBOL-CODE)
- (= syntax-code context-coloring-EXPRESSION-PREFIX-CODE)
- (= syntax-code context-coloring-STRING-QUOTE-CODE))
- (context-coloring-elisp-colorize-sexp))
+ ((= syntax-code context-coloring-OPEN-PARENTHESIS-CODE)
+ (context-coloring-elisp-colorize-parenthesized-sexp))
+ ((or (= syntax-code context-coloring-WORD-CODE)
+ (= syntax-code context-coloring-SYMBOL-CODE))
+ (context-coloring-elisp-colorize-symbol))
+ ((= syntax-code context-coloring-EXPRESSION-PREFIX-CODE)
+ (context-coloring-elisp-colorize-expression-prefix))
+ ((= syntax-code context-coloring-STRING-QUOTE-CODE)
+ (context-coloring-elisp-colorize-string))
((= syntax-code context-coloring-COMMENT-START-CODE)
(context-coloring-elisp-colorize-comment))
((= syntax-code context-coloring-ESCAPE-CODE)