doomemacs/modules/lang/emacs-lisp/autoload.el

374 lines
16 KiB
EmacsLisp
Raw Normal View History

;;; lang/emacs-lisp/autoload.el -*- lexical-binding: t; -*-
2017-01-16 23:30:11 -05:00
;;
;;; Library
;;;###autoload
(defun +emacs-lisp-eval (beg end)
"Evaluate a region and print it to the echo area (if one line long), otherwise
to a pop up buffer."
(+eval-display-results
(string-trim-right
(let ((buffer (generate-new-buffer " *+eval-output*"))
(debug-on-error t))
(unwind-protect
(condition-case-unless-debug e
(let ((doom--current-module (ignore-errors (doom-module-from-path buffer-file-name))))
(eval-region beg end buffer load-read-function)
(with-current-buffer buffer
(let ((pp-max-width nil))
(require 'pp)
(pp-buffer)
(replace-regexp-in-string "\\\\n" "\n" (string-trim-left (buffer-string))))))
(error (format "ERROR: %s" e)))
(kill-buffer buffer))))
(current-buffer)))
2020-05-10 18:45:40 -04:00
;;
;;; Handlers
(defun +emacs-lisp--module-at-point ()
"Return (CATEGORY MODULE FLAG) at point inside a `doom!' block."
(let ((origin (point))
(syntax (syntax-ppss)))
(when (and (> (ppss-depth syntax) 0) (not (ppss-string-terminator syntax)))
(save-excursion
(let ((parens (ppss-open-parens syntax))
(doom-depth 1))
(while (and parens (progn (goto-char (car parens))
(not (looking-at "(doom!\\_>"))))
(setq parens (cdr parens)
doom-depth (1+ doom-depth)))
(when parens ;; Are we inside a `doom!' block?
(goto-char origin)
(let* ((doom-start (car parens))
(bare-symbol
(if (ppss-comment-depth syntax)
(= (save-excursion (beginning-of-thing 'list)) doom-start)
(null (cdr parens))))
(sexp-start (if bare-symbol
(beginning-of-thing 'symbol)
(or (cadr parens) (beginning-of-thing 'list))))
(match-start nil))
(goto-char sexp-start)
(while (and (not match-start)
(re-search-backward
"\\_<:\\(?:\\sw\\|\\s_\\)+\\_>" ;; Find a keyword.
doom-start 'noerror))
(unless (looking-back "(")
(let ((kw-syntax (syntax-ppss)))
(when (and (= (ppss-depth kw-syntax) doom-depth)
(not (ppss-string-terminator kw-syntax))
(not (ppss-comment-depth kw-syntax)))
(setq match-start (point))))))
(when match-start
(let (category module flag)
;; `point' is already at `match-start'.
(setq category (symbol-at-point))
(goto-char origin)
(if bare-symbol
(setq module (symbol-at-point))
(let ((symbol (symbol-at-point))
(head (car (list-at-point))))
(if (and (symbolp head) (not (keywordp head))
(not (eq head symbol)))
(setq module head
flag symbol)
(setq module symbol))))
(list category module flag))))))))))
;;;###autoload
2020-02-06 15:30:50 -05:00
(defun +emacs-lisp-lookup-definition (_thing)
"Lookup definition of THING."
(if-let (module (+emacs-lisp--module-at-point))
(doom/help-modules (car module) (cadr module) 'visit-dir)
(call-interactively #'elisp-def)))
;;;###autoload
(defun +emacs-lisp-lookup-documentation (thing)
"Lookup THING with `helpful-variable' if it's a variable, `helpful-callable'
if it's callable, `apropos' otherwise."
(cond ((when-let (module (+emacs-lisp--module-at-point))
(doom/help-modules (car module) (cadr module))
(when (eq major-mode 'org-mode)
(with-demoted-errors "%s"
(re-search-forward
(if (caddr module)
"\\* Module flags$"
"\\* Description$"))
(when (caddr module)
(re-search-forward (format "=\\%s=" (caddr module))
nil t))
(when (invisible-p (point))
(org-show-hidden-entry))))
2020-01-12 22:35:03 -05:00
'deferred))
(thing (helpful-symbol (intern thing)))
((call-interactively #'helpful-at-point))))
;; DEPRECATED Remove when 28 support is dropped.
(unless (fboundp 'lisp--local-defform-body-p)
(fset 'lisp--local-defform-body-p #'ignore))
2020-05-10 18:45:40 -04:00
;;;###autoload
(defun +emacs-lisp-indent-function (indent-point state)
"A replacement for `lisp-indent-function'.
Indents plists more sensibly. Adapted from
https://emacs.stackexchange.com/questions/10230/how-to-indent-keywords-aligned"
(let ((normal-indent (current-column))
(orig-point (point))
;; TODO Refactor `target' usage (ew!)
target)
(goto-char (1+ (elt state 1)))
(parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t)
(cond ((and (elt state 2)
(or (eq (char-after) ?:)
(not (looking-at-p "\\sw\\|\\s_"))))
(if (lisp--local-defform-body-p state)
(lisp-indent-defform state indent-point)
(unless (> (save-excursion (forward-line 1) (point))
calculate-lisp-indent-last-sexp)
(goto-char calculate-lisp-indent-last-sexp)
(beginning-of-line)
(parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t))
(backward-prefix-chars)
(current-column)))
2020-05-10 18:45:40 -04:00
((and (save-excursion
(goto-char indent-point)
(skip-syntax-forward " ")
(not (eq (char-after) ?:)))
(save-excursion
(goto-char orig-point)
(and (eq (char-after) ?:)
(eq (char-before) ?\()
(setq target (current-column)))))
(save-excursion
(move-to-column target t)
target))
((let* ((function (buffer-substring (point) (progn (forward-sexp 1) (point))))
(method (or (function-get (intern-soft function) 'lisp-indent-function)
(get (intern-soft function) 'lisp-indent-hook))))
(cond ((or (eq method 'defun)
(and (null method)
(> (length function) 3)
(string-match-p "\\`def" function)))
(lisp-indent-defform state indent-point))
((integerp method)
(lisp-indent-specform method state indent-point normal-indent))
(method
(funcall method indent-point state))))))))
;;
;;; Commands
;;;###autoload
(defun +emacs-lisp/open-repl ()
"Open the Emacs Lisp REPL (`ielm')."
(interactive)
(pop-to-buffer
(or (get-buffer "*ielm*")
(progn (ielm)
(let ((buf (get-buffer "*ielm*")))
(bury-buffer buf)
buf)))))
;;;###autoload
(defun +emacs-lisp/buttercup-run-file ()
"Run all buttercup tests in the focused buffer."
(interactive)
2021-05-23 21:48:38 -04:00
(let ((load-path
(append (list (doom-path (dir!) "..")
(or (doom-project-root)
default-directory))
load-path))
(buttercup-suites nil))
(save-selected-window
(eval-buffer)
(buttercup-run))
(message "File executed successfully")))
;;;###autoload
(defun +emacs-lisp/buttercup-run-project ()
"Run all buttercup tests in the project."
(interactive)
(let* ((default-directory (doom-project-root))
(load-path (append (list (doom-path "test")
default-directory)
2021-05-23 21:48:38 -04:00
load-path))
(buttercup-suites nil))
(buttercup-run-discover)))
2020-05-10 18:45:40 -04:00
;;;###autoload
(defun +emacs-lisp/edebug-instrument-defun-on ()
"Toggle on instrumentalisation for the function under `defun'."
(interactive)
(eval-defun 'edebugit))
;;;###autoload
(defun +emacs-lisp/edebug-instrument-defun-off ()
"Toggle off instrumentalisation for the function under `defun'."
(interactive)
(eval-defun nil))
;;
;;; Hooks
2020-05-25 02:29:30 -04:00
(autoload 'straight-register-file-modification "straight")
;;;###autoload
(defun +emacs-lisp-init-straight-maybe-h ()
"Make sure straight sees modifications to installed packages."
(when (file-in-directory-p (or buffer-file-name default-directory) doom-local-dir)
(add-hook 'after-save-hook #'straight-register-file-modification
nil 'local)))
;;;###autoload
(defun +emacs-lisp-extend-imenu-h ()
"Improve imenu support in `emacs-lisp-mode', including recognition for Doom's API."
(setq imenu-generic-expression
`(("Section" "^[ \t]*;;;;*[ \t]+\\([^\n]+\\)" 1)
("Evil commands" "^\\s-*(evil-define-\\(?:command\\|operator\\|motion\\) +\\(\\_<[^ ()\n]+\\_>\\)" 1)
("Unit tests" "^\\s-*(\\(?:ert-deftest\\|describe\\) +\"\\([^\")]+\\)\"" 1)
("Package" "^\\s-*\\(?:;;;###package\\|(\\(?:package!\\|use-package!?\\|after!\\)\\) +\\(\\_<[^ ()\n]+\\_>\\)" 1)
("Major modes" "^\\s-*(define-derived-mode +\\([^ ()\n]+\\)" 1)
("Minor modes" "^\\s-*(define-\\(?:global\\(?:ized\\)?-minor\\|generic\\|minor\\)-mode +\\([^ ()\n]+\\)" 1)
("Modelines" "^\\s-*(def-modeline! +\\([^ ()\n]+\\)" 1)
2019-03-09 02:42:03 -05:00
("Modeline segments" "^\\s-*(def-modeline-segment! +\\([^ ()\n]+\\)" 1)
("Advice" "^\\s-*(\\(?:def\\(?:\\(?:ine-\\)?advice!?\\)\\) +\\([^ )\n]+\\)" 1)
("Macros" "^\\s-*(\\(?:cl-\\)?def\\(?:ine-compile-macro\\|macro\\) +\\([^ )\n]+\\)" 1)
2019-03-09 02:42:03 -05:00
("Inline functions" "\\s-*(\\(?:cl-\\)?defsubst +\\([^ )\n]+\\)" 1)
refactor!(cli): rewrite CLI framework libraries BREAKING CHANGE: this changes Doom's CLI framework in subtle ways, which is listed in greater detail below. If you've never extended Doom's CLI, then this won't affect you, but otherwise it'd be recommended you read on below. This commit focuses on the CLI framework itself and backports some foundational changes to its DSL and how it resolves command line arguments to CLIs, validates input, displays documentation, and persists state across sessions -- and more. This is done in preparation for the final stretch towarding completing the CLI rewrite (see #4273). This is also an effort to generalize Doom's CLI (both its framework and bin/doom), to increase it versatility and make it a viable dev tool for other Doom projects (on our Github org) and beyond. However, there is a *lot* to cover so I'll try to be brief: - Refactor: generalize Doom's CLI framework by moving all bin/doom specific configuration/commands out of core-cli into bin/doom. This makes it easier to use bin/doom as a project-agnostic development tool (or for users to write their own). - Refactor: change the namespace for CLI variables/functions from doom-cli-X to doom-X. - Fix: subcommands being mistaken as arguments. "doom make index" will resolve to (defcli! (doom make index)) if it exists, otherwise (defcli! (doom make)) with "index" as an argument. Before this, it would resolve to the latter no matter what. &rest can override this; with (defcli! (doom make) (&rest args)), (defcli! (doom make index)) will never be invoked. - Refactor!: redesign our output library (was core/autoload/output.el, is now core/autoload/print.el), and how our CLI framework buffers and logs output, and now merges logs across (exit! ...) restarts. - Feat: add support for :before and :after pseudo commands. E.g. (defcli! (:before doom help) () ...) (defcli! (:after doom sync) () ...) Caveat: unlike advice, only one of each can be defined per-command. - Feat: option arguments now have rudimentary type validation (see `doom-cli-option-arg-types`). E.g. (defcli! (doom foo) ((foo ("--foo" num))) ...) If NUM is not a numeric, it will throw a validation error. Any type that isn't in `doom-cli-option-arg-types` will be treated as a wildcard string type. `num` can also be replaced with a specification, e.g. "HOST[:PORT]", and can be formatted by using symbol quotes: "`HOST'[:`PORT']". - Feat: it is no longer required that options *immediately* follow the command that defines them (but it must be somewhere after it, not before). E.g. With: (defcli! (:before doom foo) ((foo ("--foo"))) ...) (defcli! (doom foo baz) () ...) Before: FAIL: doom --foo foo baz GOOD: doom foo --foo baz FAIL: doom foo baz --foo After: FAIL: doom --foo foo baz GOOD: doom foo --foo baz GOOD: doom foo baz --foo - Refactor: CLI session state is now kept in a doom-cli-context struct (which can be bound to a CLI-local variable with &context in the arglist): (defcli! (doom sync) (&context context) (print! "Command: " (doom-cli-context-command context))) These contexts are persisted across sessions (when restarted). This is necessary to support seamless script restarting (i.e. execve emulation) in post-3.0. - Feat: Doom's CLI framework now understands "--". Everything after it will be treated as regular arguments, instead of sub-commands or options. - Refactor!: the semantics of &rest for CLIs has changed. It used to be "all extra literal, non-option arguments". It now means *all* unprocessed arguments, and its use will suppress "unrecognized option" errors, and tells the framework not to process any further subcommands. Use &args if you just want "all literal arguments following this command". - Feat: add new auxiliary keywords for CLI arglists: &context, &multiple, &flags, &args, &stdin, &whole, and &cli. - &context SYM: binds the currently running context to SYM (a `doom-cli-context` struct). Helpful for introspection or passing along state when calling subcommands by hand (with `call!`). - &stdin SYM: SYM will be bound to a string containing any input piped into the running script, or nil if none. Use `doom-cli-context-pipe-p` to detect whether the script has been piped into or out of. - &multiple OPTIONS...: allows all following OPTIONS to be repeated. E.g. "foo -x a -x b -x c" will pass (list ("-x" . "a") ("-x" . "b") ("-x" . "c")) as -x's value. - &flags OPTIONS...: All options after "&flags" get an implicit --no-* switch and cannot accept arguments. Will be set to :yes or :no depending on which flag is provided, and nil if the flag isn't provided. Otherwise, a default value can be specified in that options' arglist. E.g. (defcli! (doom foo) (&flags (foo ("--foo" :no))) ...) When called, this command sets FOO to :yes if --foo, :no if --no-foo, and defaults to :no otherwise. - &args SYM: this replaces what &rest used to be; it binds to SYM a list of all unprocessed (non-option) arguments. - &rest SYM: now binds SYM to a list of all unprocessed arguments, including options. This also suppresses "unrecognized option" errors, but will render any sub-commands inaccessible. E.g. (defcli! (doom make) (&rest rest) ...) ;; These are now inaccessible! (defcli! (doom make foo) (&rest rest) ...) (defcli! (doom make bar) (&rest rest) ...) - &cli SYM: binds SYM to the currently running `doom-cli` struct. Can also be obtained via `(doom-cli-get (doom-cli-context-command context))`. Possibly useful for introspection. - feat: add defobsolete! macro for quickly defining obsolete commands. - feat: add defalias! macro for quickly defining alias commands. - feat: add defautoload! macro for defining an autoloaded command (won't be loaded until it is called for). - refactor!: rename defcligroup! to defgroup! for consistency. - fix: CLIs will now recursively inherit plist properties from parent defcli-group!'s (but will stack :prefix). - refactor!: remove obsolete 'doom update': - refactor!: further generalize 'doom ci' - In an effort to generalize 'doom ci' (so other Doom--or non-doom--projects can use it), all its subcommands have been changed to operate on the current working directory's repo instead of $EMACSDIR. - Doom-specific CI configuration was moved to .github/ci.el. - All 'doom ci' commands will now preload one of \$CURRENT_REPO_ROOT/ci.el or \$DOOMDIR/ci.el before executing. - refactor!: changed 'doom env' - 'doom env {-c,--clear}' is now 'doom env {clear,c}' - -r/--reject and -a/--allow may now be specified multiple times - refactor!: rewrote CLI help framework and error handling to be more sophisticated and detailed. - feat: can now initiate $PAGER on output with (exit! :pager) (or use :pager? to only invoke pager is output is longer than the terminal is tall). - refactor!: changed semantics+conventions for global bin/doom options - Single-character global options are now uppercased, to distinguish them from local options: - -d (for debug mode) is now -D - -y (to suppress prompts) is now -! - -l (to load elisp) is now -L - -h (short for --help) is now -? - Replace --yes/-y switches with --force/-! - -L/--load FILE: now silently ignores file errors. - Add --strict-load FILE: does the same as -L/--load, but throws an error if FILE does not exist/is unreadable. - Add -E/--eval FORM: evaluates arbitrary lisp before commands are processed. - -L/--load, --strict-load, and -E/--eval can now be used multiple times in one command. - Add --pager COMMAND to specify an explicit pager. Will also obey $DOOMPAGER envvar. Does not obey $PAGER. - Fix #3746: which was likely caused by the generated post-script overwriting the old mid-execution. By salting the postscript filenames (with both an overarching session ID and a step counter). - Docs: document websites, environment variables, and exit codes in 'doom --help' - Feat: add imenu support for def{cli,alias,obsolete}! Ref: #4273 Fix: #3746 Fix: #3844
2022-06-18 19:16:06 +02:00
("CLI Command" "^\\s-*(\\(def\\(?:cli\\|alias\\|obsolete\\|autoload\\)! +\\([^\n]+\\)\\)" 1)
("Functions" "^\\s-*(\\(?:cl-\\)?def\\(?:un\\|un\\*\\|method\\|generic\\|-memoized!\\) +\\([^ ,)\n]+\\)" 1)
("Variables" "^\\s-*(\\(def\\(?:c\\(?:onst\\(?:ant\\)?\\|ustom\\)\\|ine-symbol-macro\\|parameter\\|var\\(?:-local\\)?\\)\\)\\s-+\\(\\(?:\\sw\\|\\s_\\|\\\\.\\)+\\)" 2)
("Types" "^\\s-*(\\(cl-def\\(?:struct\\|type\\)\\|def\\(?:class\\|face\\|group\\|ine-\\(?:condition\\|error\\|widget\\)\\|package\\|struct\\|t\\(?:\\(?:hem\\|yp\\)e\\)\\)\\)\\s-+'?\\(\\(?:\\sw\\|\\s_\\|\\\\.\\)+\\)" 2))))
refactor!(emacs-lisp): flycheck config in non-packages BREAKING CHANGE: This performs the following backwards-incompatible changes: - Replaces `+emacs-lisp-reduce-flycheck-errors-in-emacs-config-h` with a `+emacs-lisp-non-package-mode` minor-mode. - Removed the `+emacs-lisp-disable-flycheck-in-dirs` variable, as this mechanism no longer checks a directory list to detect a "non-package". If you've referenced either of these symbols, you'll need to update/remove them from your config. No extra config is needed otherwise. Why: Doom has always tried to reduce the verbosity of Flycheck when viewing elisp config files or scripts (i.e. non-packages). These are so stateful that the byte-compiler, package-lint, and checkdoc inundate users with false positives that are more overwhelming than helpful. The heuristic for this has always been a simple "is this file in $DOOMDIR or $EMACSDIR", but this wasn't robust enough, especially in cases where symlinking was involved, so I've employed a new, more general heuristic for detecting non-package files: - The file isn't a theme in `custom-theme-load-path`, - The file doesn't have a (provide ...) or (provide-theme ...) statement whose first argument matches the file name, - The file lives in a project with a .doommodule file (doom modules never have convention package files in them), - Or the file is a dotfile (like .dir-locals.el or .doomrc). I've also tweaked byte-compile-warnings to yield a little more output, but not by much. Whether this is too permissive or not will require further testing to determine. What's more, I've updated this to reflect recent changes to Doom's startup process (in c05e615). Ref: c05e61536ed9
2022-09-10 15:33:10 +02:00
(defun +emacs-lisp--in-package-buffer-p ()
(let* ((file-path (buffer-file-name (buffer-base-buffer)))
(file-base (if file-path (file-name-base file-path))))
(and (derived-mode-p 'emacs-lisp-mode)
(or (null file-base)
(locate-file file-base (custom-theme--load-path) '(".elc" ".el"))
(save-excursion
(save-restriction
(widen)
(goto-char (point-max))
(when (re-search-backward "^ *\\((provide\\)\\(?:-theme\\)? +'"
(max (point-min) (- (point-max) 512))
t)
(goto-char (match-beginning 1))
(ignore-errors
(and (stringp file-base)
(equal (symbol-name (doom-unquote (nth 1 (read (current-buffer)))))
file-base)))))))
(not (locate-dominating-file default-directory ".doommodule")))))
;;;###autoload
refactor!(emacs-lisp): flycheck config in non-packages BREAKING CHANGE: This performs the following backwards-incompatible changes: - Replaces `+emacs-lisp-reduce-flycheck-errors-in-emacs-config-h` with a `+emacs-lisp-non-package-mode` minor-mode. - Removed the `+emacs-lisp-disable-flycheck-in-dirs` variable, as this mechanism no longer checks a directory list to detect a "non-package". If you've referenced either of these symbols, you'll need to update/remove them from your config. No extra config is needed otherwise. Why: Doom has always tried to reduce the verbosity of Flycheck when viewing elisp config files or scripts (i.e. non-packages). These are so stateful that the byte-compiler, package-lint, and checkdoc inundate users with false positives that are more overwhelming than helpful. The heuristic for this has always been a simple "is this file in $DOOMDIR or $EMACSDIR", but this wasn't robust enough, especially in cases where symlinking was involved, so I've employed a new, more general heuristic for detecting non-package files: - The file isn't a theme in `custom-theme-load-path`, - The file doesn't have a (provide ...) or (provide-theme ...) statement whose first argument matches the file name, - The file lives in a project with a .doommodule file (doom modules never have convention package files in them), - Or the file is a dotfile (like .dir-locals.el or .doomrc). I've also tweaked byte-compile-warnings to yield a little more output, but not by much. Whether this is too permissive or not will require further testing to determine. What's more, I've updated this to reflect recent changes to Doom's startup process (in c05e615). Ref: c05e61536ed9
2022-09-10 15:33:10 +02:00
(define-minor-mode +emacs-lisp-non-package-mode
"Reduce flycheck verbosity where it is appropriate.
Essentially, this means in any elisp file that either:
- Is not a theme in `custom-theme-load-path',
- Lacks a `provide' statement,
- Lives in a project with a .doommodule file,
- Is a dotfile (like .dir-locals.el or .doomrc).
This generally applies to your private config (`doom-user-dir') or Doom's source
\(`doom-emacs-dir')."
:since "3.0.0"
(unless (and (bound-and-true-p flycheck-mode)
(not (+emacs-lisp--in-package-buffer-p)))
(setq +emacs-lisp-non-package-mode nil))
(when (derived-mode-p 'emacs-lisp-mode)
(add-hook 'after-save-hook #'+emacs-lisp-non-package-mode nil t))
(if (not +emacs-lisp-non-package-mode)
(when (get 'flycheck-disabled-checkers 'initial-value)
(setq-local flycheck-disabled-checkers (get 'flycheck-disabled-checkers 'initial-value))
(kill-local-variable 'flycheck-emacs-lisp-check-form))
(with-memoization (get 'flycheck-disabled-checkers 'initial-value)
flycheck-disabled-checkers)
(setq-local flycheck-emacs-lisp-check-form
(prin1-to-string
`(progn
(setq doom-modules ',doom-modules
doom-disabled-packages ',doom-disabled-packages
byte-compile-warnings ',+emacs-lisp-linter-warnings)
(condition-case e
(progn
(require 'doom)
(require 'doom-cli)
(require 'doom-start)
(defmacro map! (&rest _)))
(error
(princ
(format "%s:%d:%d:Error:Failed to load Doom: %s\n"
,(file-name-nondirectory (buffer-file-name (buffer-base-buffer)))
0 0 (error-message-string e)))))
,(read (default-toplevel-value 'flycheck-emacs-lisp-check-form))))
flycheck-disabled-checkers (cons 'emacs-lisp-checkdoc
flycheck-disabled-checkers))))
2020-05-25 02:29:30 -04:00
;;
;;; Fontification
;;;###autoload
(defun +emacs-lisp-truncate-pin ()
"Truncates long SHA1 hashes in `package!' :pin's."
(save-excursion
(goto-char (match-beginning 0))
(and (stringp (plist-get (sexp-at-point) :pin))
(search-forward ":pin" nil t)
(let ((start (re-search-forward "\"[^\"\n]\\{12\\}" nil t))
(finish (and (re-search-forward "\"" (line-end-position) t)
(match-beginning 0))))
(when (and start finish)
(put-text-property start finish 'display "...")))))
nil)
2020-05-25 02:29:30 -04:00
(defvar +emacs-lisp--face nil)
;;;###autoload
(defun +emacs-lisp-highlight-vars-and-faces (end)
"Match defined variables and functions.
Functions are differentiated into special forms, built-in functions and
library/userland functions"
(catch 'matcher
(while (re-search-forward "\\(?:\\sw\\|\\s_\\)+" end t)
(let ((ppss (save-excursion (syntax-ppss))))
(cond ((nth 3 ppss) ; strings
(search-forward "\"" end t))
((nth 4 ppss) ; comments
(forward-line +1))
((let ((symbol (intern-soft (match-string-no-properties 0))))
(and (cond ((null symbol) nil)
((eq symbol t) nil)
((keywordp symbol) nil)
2020-05-25 02:29:30 -04:00
((special-variable-p symbol)
(setq +emacs-lisp--face 'font-lock-variable-name-face))
((and (fboundp symbol)
(eq (char-before (match-beginning 0)) ?\()
(not (memq (char-before (1- (match-beginning 0)))
(list ?\' ?\`))))
(let ((unaliased (indirect-function symbol)))
(unless (or (macrop unaliased)
(special-form-p unaliased))
(let (unadvised)
(while (not (eq (setq unadvised (ad-get-orig-definition unaliased))
(setq unaliased (indirect-function unadvised)))))
unaliased)
(setq +emacs-lisp--face
(if (subrp unaliased)
'font-lock-constant-face
'font-lock-function-name-face))))))
(throw 'matcher t)))))))
nil))
;; HACK Fontification is already expensive enough. We byte-compile
;; `+emacs-lisp-highlight-vars-and-faces' and `+emacs-lisp-truncate-pin' to
;; ensure they run as fast as possible:
(dolist (fn '(+emacs-lisp-highlight-vars-and-faces +emacs-lisp-truncate-pin))
(unless (byte-code-function-p (symbol-function fn))
(with-no-warnings (byte-compile fn))))