emenel/doomemacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity
doomemacs/modules/lang/emacs-lisp/autoload.el
Henrik Lissner afa154db27
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: c05e61536e
2022-09-12 11:45:56 +02:00

373 lines
16 KiB
EmacsLisp
Raw Blame History

;;; lang/emacs-lisp/autoload.el -*- lexical-binding: t; -*-
;;
;;; 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)))
;;
;;; 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
(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))))
'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))
;;;###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)))
((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)
(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)
load-path))
(buttercup-suites nil))
(buttercup-run-discover)))
;;;###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
(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)
("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)
("Inline functions" "\\s-*(\\(?:cl-\\)?defsubst +\\([^ )\n]+\\)" 1)
("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))))
(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
(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))))
;;
;;; 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)
(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)
((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))))
Reference in a new issue View git blame Copy permalink