lang/emacs-lisp: optimize var/face highlighting

A slight performance improvement in files with a lot of comments and
strings, by skipping ahead a line if in a comment and to the next double
quote if in a string. Otherwise, this function would visit every symbol
in between, and syntax-ppss calls are relatively expensive here.
This commit is contained in:
Henrik Lissner 2019-05-20 20:17:05 -04:00
parent 08bfd5879a
commit 3e15b71568
No known key found for this signature in database
GPG key ID: 5F6C0EA160557395

View file

@ -43,29 +43,31 @@ to a pop up buffer."
Functions are differentiated into special forms, built-in functions and Functions are differentiated into special forms, built-in functions and
library/userland functions" library/userland functions"
(catch 'matcher (catch 'matcher
(while (re-search-forward "\\_<.+?\\_>" end t) (while (re-search-forward "\\(?:\\sw\\|\\s_\\)+" end t)
(unless (save-excursion (let ((ppss (save-excursion (syntax-ppss))))
(let ((ppss (syntax-ppss))) (cond ((nth 3 ppss) ; strings
(or (nth 3 ppss) (nth 4 ppss)))) (search-forward "\"" end t))
(let ((symbol (intern-soft (match-string-no-properties 0)))) ((nth 4 ppss) ; comments
(and (cond ((null symbol) nil) (forward-line +1))
((eq symbol t) nil) ((let ((symbol (intern-soft (match-string-no-properties 0))))
((special-variable-p symbol) (and (cond ((null symbol) nil)
(setq +emacs-lisp--face 'font-lock-variable-name-face)) ((eq symbol t) nil)
((and (fboundp symbol) ((special-variable-p symbol)
(eq (char-before (match-beginning 0)) ?\()) (setq +emacs-lisp--face 'font-lock-variable-name-face))
(let ((unaliased (indirect-function symbol))) ((and (fboundp symbol)
(unless (or (macrop unaliased) (eq (char-before (match-beginning 0)) ?\())
(special-form-p unaliased)) (let ((unaliased (indirect-function symbol)))
(let (unadvised) (unless (or (macrop unaliased)
(while (not (eq (setq unadvised (ad-get-orig-definition unaliased)) (special-form-p unaliased))
(setq unaliased (indirect-function unadvised))))) (let (unadvised)
unaliased) (while (not (eq (setq unadvised (ad-get-orig-definition unaliased))
(setq +emacs-lisp--face (setq unaliased (indirect-function unadvised)))))
(if (subrp unaliased) unaliased)
'font-lock-constant-face (setq +emacs-lisp--face
'font-lock-function-name-face)))))) (if (subrp unaliased)
(throw 'matcher t))))) 'font-lock-constant-face
'font-lock-function-name-face))))))
(throw 'matcher t)))))))
nil)) nil))
;;;###autoload ;;;###autoload