doomemacs/modules/lang/emacs-lisp/autoload.el
Henrik Lissner 94ea4aa7dc
docs: add examples.org
This adds the basic framework of docs/examples.org, including the former
contents of demo.org in :lang emacs-lisp. elisp-demo has also been
reconfigured to search it instead.

Keep in mind that examples.org references a few things in as-of-yet
published documentation. This will be rectified soon.
2022-09-16 01:14:20 +02:00

607 lines
28 KiB
EmacsLisp

;;; 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))
;;
;;; Advice
;;;###autoload
(defun +emacs-lisp--add-doom-elisp-demos-a (fn symbol)
"Add Doom's own demos to `elisp-demos'.
Intended as :around advice for `elisp-demos--search'."
(let ((org-inhibit-startup t)
enable-dir-local-variables
org-mode-hook)
(or (funcall fn symbol)
(with-file-contents! (doom-path doom-docs-dir "examples.org")
(save-excursion
(when (re-search-backward
(format "^\\*+[ \t]+\\(?:TODO \\)?%s$"
(regexp-quote (symbol-name symbol)))
nil t)
(forward-line 1)
(let ((demos
(string-trim
(buffer-substring-no-properties
(point) (if (re-search-forward "^\\*+ " nil t)
(line-beginning-position)
(point-max))))))
(unless (string-blank-p demos)
demos))))))))
;;;###autoload (put 'map! 'indent-plists-as-data t)
;;;###autoload
(defun +emacs-lisp--calculate-lisp-indent-a (&optional parse-start)
"Add better indentation for quoted and backquoted lists.
Intended as :override advice for `calculate-lisp-indent'.
Adapted from 'https://www.reddit.com/r/emacs/comments/d7x7x8/finally_fixing_indentation_of_quoted_lists/'."
;; This line because `calculate-lisp-indent-last-sexp` was defined with
;; `defvar` with it's value ommited, marking it special and only defining it
;; locally. So if you don't have this, you'll get a void variable error.
(defvar calculate-lisp-indent-last-sexp)
(save-excursion
(beginning-of-line)
(let ((indent-point (point))
state
;; setting this to a number inhibits calling hook
(desired-indent nil)
(retry t)
calculate-lisp-indent-last-sexp containing-sexp)
(cond ((or (markerp parse-start) (integerp parse-start))
(goto-char parse-start))
((null parse-start)
(beginning-of-defun))
((setq state parse-start)))
(unless state
;; Find outermost containing sexp
(while (< (point) indent-point)
(setq state (parse-partial-sexp (point) indent-point 0))))
;; Find innermost containing sexp
(while (and retry
state
(> (elt state 0) 0))
(setq retry nil)
(setq calculate-lisp-indent-last-sexp (elt state 2))
(setq containing-sexp (elt state 1))
;; Position following last unclosed open.
(goto-char (1+ containing-sexp))
;; Is there a complete sexp since then?
(if (and calculate-lisp-indent-last-sexp
(> calculate-lisp-indent-last-sexp (point)))
;; Yes, but is there a containing sexp after that?
(let ((peek (parse-partial-sexp calculate-lisp-indent-last-sexp
indent-point 0)))
(if (setq retry (car (cdr peek))) (setq state peek)))))
(if retry
nil
;; Innermost containing sexp found
(goto-char (1+ containing-sexp))
(if (not calculate-lisp-indent-last-sexp)
;; indent-point immediately follows open paren. Don't call hook.
(setq desired-indent (current-column))
;; Find the start of first element of containing sexp.
(parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t)
(cond ((looking-at "\\s(")
;; First element of containing sexp is a list. Indent under
;; that list.
)
((> (save-excursion (forward-line 1) (point))
calculate-lisp-indent-last-sexp)
;; This is the first line to start within the containing sexp.
;; It's almost certainly a function call.
(if (or
;; Containing sexp has nothing before this line except the
;; first element. Indent under that element.
(= (point) calculate-lisp-indent-last-sexp)
(or
;; Align keywords in plists if each newline begins with
;; a keyword. This is useful for "unquoted plist
;; function" macros, like `map!' and `defhydra'.
(when-let ((first (elt state 1))
(char (char-after (1+ first))))
(and (eq char ?:)
(ignore-errors
(or (save-excursion
(goto-char first)
;; FIXME Can we avoid `syntax-ppss'?
(when-let* ((parse-sexp-ignore-comments t)
(end (scan-lists (point) 1 0))
(depth (ppss-depth (syntax-ppss))))
(and (re-search-forward "^\\s-*:" end t)
(= (ppss-depth (syntax-ppss))
(1+ depth)))))
(save-excursion
(cl-loop for pos in (reverse (elt state 9))
unless (memq (char-after (1+ pos)) '(?: ?\())
do (goto-char (1+ pos))
for fn = (read (current-buffer))
if (symbolp fn)
return (function-get fn 'indent-plists-as-data)))))))
;; Check for quotes or backquotes around.
(let ((positions (elt state 9))
(quotep 0))
(while positions
(let ((point (pop positions)))
(or (when-let (char (char-before point))
(cond
((eq char ?\())
((memq char '(?\' ?\`))
(or (save-excursion
(goto-char (1+ point))
(skip-chars-forward "( ")
(when-let (fn (ignore-errors (read (current-buffer))))
(if (and (symbolp fn)
(fboundp fn)
;; Only special forms and
;; macros have special
;; indent needs.
(not (functionp fn)))
(setq quotep 0))))
(cl-incf quotep)))
((memq char '(?, ?@))
(setq quotep 0))))
;; If the spelled out `quote' or `backquote'
;; are used, let's assume
(save-excursion
(goto-char (1+ point))
(and (looking-at-p "\\(\\(?:back\\)?quote\\)[\t\n\f\s]+(")
(cl-incf quotep 2)))
(setq quotep (max 0 (1- quotep))))))
(> quotep 0))))
;; Containing sexp has nothing before this line except the
;; first element. Indent under that element.
nil
;; Skip the first element, find start of second (the first
;; argument of the function call) and indent under.
(progn (forward-sexp 1)
(parse-partial-sexp (point)
calculate-lisp-indent-last-sexp
0 t)))
(backward-prefix-chars))
(t
;; Indent beneath first sexp on same line as
;; `calculate-lisp-indent-last-sexp'. Again, it's almost
;; certainly a function call.
(goto-char calculate-lisp-indent-last-sexp)
(beginning-of-line)
(parse-partial-sexp (point) calculate-lisp-indent-last-sexp
0 t)
(backward-prefix-chars)))))
;; Point is at the point to indent under unless we are inside a string.
;; Call indentation hook except when overridden by lisp-indent-offset or
;; if the desired indentation has already been computed.
(let ((normal-indent (current-column)))
(cond ((elt state 3)
;; Inside a string, don't change indentation.
nil)
((and (integerp lisp-indent-offset) containing-sexp)
;; Indent by constant offset
(goto-char containing-sexp)
(+ (current-column) lisp-indent-offset))
;; in this case calculate-lisp-indent-last-sexp is not nil
(calculate-lisp-indent-last-sexp
(or
;; try to align the parameters of a known function
(and lisp-indent-function
(not retry)
(funcall lisp-indent-function indent-point state))
;; If the function has no special alignment or it does not apply
;; to this argument, try to align a constant-symbol under the
;; last preceding constant symbol, if there is such one of the
;; last 2 preceding symbols, in the previous uncommented line.
(and (save-excursion
(goto-char indent-point)
(skip-chars-forward " \t")
(looking-at ":"))
;; The last sexp may not be at the indentation where it
;; begins, so find that one, instead.
(save-excursion
(goto-char calculate-lisp-indent-last-sexp)
;; Handle prefix characters and whitespace following an
;; open paren. (Bug#1012)
(backward-prefix-chars)
(while (not (or (looking-back "^[ \t]*\\|([ \t]+"
(line-beginning-position))
(and containing-sexp
(>= (1+ containing-sexp) (point)))))
(forward-sexp -1)
(backward-prefix-chars))
(setq calculate-lisp-indent-last-sexp (point)))
(> calculate-lisp-indent-last-sexp
(save-excursion
(goto-char (1+ containing-sexp))
(parse-partial-sexp (point) calculate-lisp-indent-last-sexp 0 t)
(point)))
(let ((parse-sexp-ignore-comments t)
indent)
(goto-char calculate-lisp-indent-last-sexp)
(or (and (looking-at ":")
(setq indent (current-column)))
(and (< (line-beginning-position)
(prog2 (backward-sexp) (point)))
(looking-at ":")
(setq indent (current-column))))
indent))
;; another symbols or constants not preceded by a constant as
;; defined above.
normal-indent))
;; in this case calculate-lisp-indent-last-sexp is nil
(desired-indent)
(normal-indent))))))
;; HACK: These functions are called often and as part of performance-sensitive
;; processes, so we compile them if the file isn't already compiled.
(mapc #'doom-compile-function '(+emacs-lisp-highlight-vars-and-faces
+emacs-lisp-truncate-pin
+emacs-lisp--calculate-lisp-indent-a))
;;; autoload.el ends here