refactor!: restructure Doom core
BREAKING CHANGE: This restructures the project in preparation for Doom to be split into two repos. Users that have reconfigured Doom's CLI stand a good chance of seeing breakage, especially if they've referred to any core-* feature, e.g. (after! core-cli-ci ...) To fix it, simply s/core-/doom-/, i.e. (after! doom-cli-ci ...) What this commit specifically changes is: - Renames all core features from core-* to doom-* - Moves core/core-* -> lisp/doom-* - Moves core/autoloads/* -> lisp/lib/* - Moves core/templates -> templates/ Ref: #4273
This commit is contained in:
Henrik Lissner
parent
a9866e37e4
commit
b9933e6637
69 changed files with 147 additions and 145 deletions
817
lisp/doom-lib.el
Normal file
817
lisp/doom-lib.el
Normal file
|
|
@ -0,0 +1,817 @@
|
|||
;;; doom-lib.el -*- lexical-binding: t; -*-
|
||||
|
||||
(require 'cl-lib)
|
||||
|
||||
|
||||
;;
|
||||
;;; Helpers
|
||||
|
||||
(defun doom--resolve-hook-forms (hooks)
|
||||
"Converts a list of modes into a list of hook symbols.
|
||||
|
||||
If a mode is quoted, it is left as is. If the entire HOOKS list is quoted, the
|
||||
list is returned as-is."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(let ((hook-list (doom-enlist (doom-unquote hooks))))
|
||||
(if (eq (car-safe hooks) 'quote)
|
||||
hook-list
|
||||
(cl-loop for hook in hook-list
|
||||
if (eq (car-safe hook) 'quote)
|
||||
collect (cadr hook)
|
||||
else collect (intern (format "%s-hook" (symbol-name hook)))))))
|
||||
|
||||
(defun doom--setq-hook-fns (hooks rest &optional singles)
|
||||
(unless (or singles (= 0 (% (length rest) 2)))
|
||||
(signal 'wrong-number-of-arguments (list #'evenp (length rest))))
|
||||
(cl-loop with vars = (let ((args rest)
|
||||
vars)
|
||||
(while args
|
||||
(push (if singles
|
||||
(list (pop args))
|
||||
(cons (pop args) (pop args)))
|
||||
vars))
|
||||
(nreverse vars))
|
||||
for hook in (doom--resolve-hook-forms hooks)
|
||||
for mode = (string-remove-suffix "-hook" (symbol-name hook))
|
||||
append
|
||||
(cl-loop for (var . val) in vars
|
||||
collect
|
||||
(list var val hook
|
||||
(intern (format "doom--setq-%s-for-%s-h"
|
||||
var mode))))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Public library
|
||||
|
||||
(define-obsolete-function-alias 'doom-enlist 'ensure-list "v3.0.0")
|
||||
|
||||
(defun doom-unquote (exp)
|
||||
"Return EXP unquoted."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(while (memq (car-safe exp) '(quote function))
|
||||
(setq exp (cadr exp)))
|
||||
exp)
|
||||
|
||||
(defun doom-enlist (exp)
|
||||
"Return EXP wrapped in a list, or as-is if already a list."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(if (proper-list-p exp) exp (list exp)))
|
||||
|
||||
(defun doom-keyword-intern (str)
|
||||
"Converts STR (a string) into a keyword (`keywordp')."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(cl-check-type str string)
|
||||
(intern (concat ":" str)))
|
||||
|
||||
(defun doom-keyword-name (keyword)
|
||||
"Returns the string name of KEYWORD (`keywordp') minus the leading colon."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(cl-check-type keyword keyword)
|
||||
(substring (symbol-name keyword) 1))
|
||||
|
||||
(defalias 'doom-partial #'apply-partially)
|
||||
|
||||
(defun doom-rpartial (fn &rest args)
|
||||
"Return a partial application of FUN to right-hand ARGS.
|
||||
|
||||
ARGS is a list of the last N arguments to pass to FUN. The result is a new
|
||||
function which does the same as FUN, except that the last N arguments are fixed
|
||||
at the values with which this function was called."
|
||||
(declare (side-effect-free t))
|
||||
(lambda (&rest pre-args)
|
||||
(apply fn (append pre-args args))))
|
||||
|
||||
(defun doom-lookup-key (keys &rest keymaps)
|
||||
"Like `lookup-key', but search active keymaps if KEYMAP is omitted."
|
||||
(if keymaps
|
||||
(cl-some (doom-rpartial #'lookup-key keys) keymaps)
|
||||
(cl-loop for keymap
|
||||
in (append (cl-loop for alist in emulation-mode-map-alists
|
||||
append (mapcar #'cdr
|
||||
(if (symbolp alist)
|
||||
(if (boundp alist) (symbol-value alist))
|
||||
alist)))
|
||||
(list (current-local-map))
|
||||
(mapcar #'cdr minor-mode-overriding-map-alist)
|
||||
(mapcar #'cdr minor-mode-map-alist)
|
||||
(list (current-global-map)))
|
||||
if (keymapp keymap)
|
||||
if (lookup-key keymap keys)
|
||||
return it)))
|
||||
|
||||
(defun doom-load-envvars-file (file &optional noerror)
|
||||
"Read and set envvars from FILE.
|
||||
If NOERROR is non-nil, don't throw an error if the file doesn't exist or is
|
||||
unreadable. Returns the names of envvars that were changed."
|
||||
(if (null (file-exists-p file))
|
||||
(unless noerror
|
||||
(signal 'file-error (list "No envvar file exists" file)))
|
||||
(with-temp-buffer
|
||||
(insert-file-contents file)
|
||||
(when-let (env (read (current-buffer)))
|
||||
(let ((tz (getenv-internal "TZ")))
|
||||
(setq-default
|
||||
process-environment
|
||||
(append env (default-value 'process-environment))
|
||||
exec-path
|
||||
(append (split-string (getenv "PATH") path-separator t)
|
||||
(list exec-directory))
|
||||
shell-file-name
|
||||
(or (getenv "SHELL")
|
||||
(default-value 'shell-file-name)))
|
||||
(when-let (newtz (getenv-internal "TZ"))
|
||||
(unless (equal tz newtz)
|
||||
(set-time-zone-rule newtz))))
|
||||
env))))
|
||||
|
||||
(defun doom-run-hook (hook)
|
||||
"Run HOOK (a hook function) with better error handling.
|
||||
Meant to be used with `run-hook-wrapped'."
|
||||
(condition-case-unless-debug e
|
||||
(funcall hook)
|
||||
(error
|
||||
(signal 'doom-hook-error (list hook e))))
|
||||
;; return nil so `run-hook-wrapped' won't short circuit
|
||||
nil)
|
||||
|
||||
(defun doom-run-hooks (&rest hooks)
|
||||
"Run HOOKS (a list of hook variable symbols) with better error handling.
|
||||
Is used as advice to replace `run-hooks'."
|
||||
(dolist (hook hooks)
|
||||
(condition-case-unless-debug e
|
||||
(run-hook-wrapped hook #'doom-run-hook)
|
||||
(doom-hook-error
|
||||
(unless debug-on-error
|
||||
(lwarn hook :error "Error running hook %S because: %s"
|
||||
(if (symbolp (cadr e))
|
||||
(symbol-name (cadr e))
|
||||
(cadr e))
|
||||
(caddr e)))
|
||||
(signal 'doom-hook-error (cons hook (cdr e)))))))
|
||||
|
||||
(defun doom-run-hook-on (hook-var trigger-hooks)
|
||||
"Configure HOOK-VAR to be invoked exactly once when any of the TRIGGER-HOOKS
|
||||
are invoked *after* Emacs has initialized (to reduce false positives). Once
|
||||
HOOK-VAR is triggered, it is reset to nil.
|
||||
|
||||
HOOK-VAR is a quoted hook.
|
||||
TRIGGER-HOOK is a list of quoted hooks and/or sharp-quoted functions."
|
||||
(dolist (hook trigger-hooks)
|
||||
(let ((fn (intern (format "%s-init-on-%s-h" hook-var hook))))
|
||||
(fset
|
||||
fn (lambda (&rest _)
|
||||
;; Only trigger this after Emacs has initialized.
|
||||
(when (and after-init-time
|
||||
(or (daemonp)
|
||||
;; In some cases, hooks may be lexically unset to
|
||||
;; inhibit them during expensive batch operations on
|
||||
;; buffers (such as when processing buffers
|
||||
;; internally). In these cases we should assume this
|
||||
;; hook wasn't invoked interactively.
|
||||
(and (boundp hook)
|
||||
(symbol-value hook))))
|
||||
(doom-run-hooks hook-var)
|
||||
(set hook-var nil))))
|
||||
(cond ((daemonp)
|
||||
;; In a daemon session we don't need all these lazy loading
|
||||
;; shenanigans. Just load everything immediately.
|
||||
(add-hook 'after-init-hook fn 'append))
|
||||
((eq hook 'find-file-hook)
|
||||
;; Advise `after-find-file' instead of using `find-file-hook'
|
||||
;; because the latter is triggered too late (after the file has
|
||||
;; opened and modes are all set up).
|
||||
(advice-add 'after-find-file :before fn '((depth . -101))))
|
||||
((add-hook hook fn -101)))
|
||||
fn)))
|
||||
|
||||
|
||||
;;
|
||||
;;; Sugars
|
||||
|
||||
(defun dir! ()
|
||||
"Returns the directory of the emacs lisp file this function is called from."
|
||||
(when-let (path (file!))
|
||||
(directory-file-name (file-name-directory path))))
|
||||
|
||||
(defun file! ()
|
||||
"Return the emacs lisp file this function is called from."
|
||||
(cond (load-in-progress load-file-name)
|
||||
((bound-and-true-p byte-compile-current-file))
|
||||
((stringp (car-safe current-load-list))
|
||||
(car current-load-list))
|
||||
(buffer-file-name)
|
||||
((error "Cannot get this file-path"))))
|
||||
|
||||
(defmacro letenv! (envvars &rest body)
|
||||
"Lexically bind ENVVARS in BODY, like `let' but for `process-environment'."
|
||||
(declare (indent 1))
|
||||
`(let ((process-environment (copy-sequence process-environment)))
|
||||
,@(cl-loop for (var val) in envvars
|
||||
collect `(setenv ,var ,val))
|
||||
,@body))
|
||||
|
||||
(defmacro letf! (bindings &rest body)
|
||||
"Temporarily rebind function, macros, and advice in BODY.
|
||||
|
||||
Intended as syntax sugar for `cl-letf', `cl-labels', `cl-macrolet', and
|
||||
temporary advice.
|
||||
|
||||
BINDINGS is either:
|
||||
|
||||
A list of, or a single, `defun', `defun*', `defmacro', or `defadvice' forms.
|
||||
A list of (PLACE VALUE) bindings as `cl-letf*' would accept.
|
||||
|
||||
TYPE is one of:
|
||||
|
||||
`defun' (uses `cl-letf')
|
||||
`defun*' (uses `cl-labels'; allows recursive references),
|
||||
`defmacro' (uses `cl-macrolet')
|
||||
`defadvice' (uses `defadvice!' before BODY, then `undefadvice!' after)
|
||||
|
||||
NAME, ARGLIST, and BODY are the same as `defun', `defun*', `defmacro', and
|
||||
`defadvice!', respectively.
|
||||
|
||||
\(fn ((TYPE NAME ARGLIST &rest BODY) ...) BODY...)"
|
||||
(declare (indent defun))
|
||||
(setq body (macroexp-progn body))
|
||||
(when (memq (car bindings) '(defun defun* defmacro defadvice))
|
||||
(setq bindings (list bindings)))
|
||||
(dolist (binding (reverse bindings) body)
|
||||
(let ((type (car binding))
|
||||
(rest (cdr binding)))
|
||||
(setq
|
||||
body (pcase type
|
||||
(`defmacro `(cl-macrolet ((,@rest)) ,body))
|
||||
(`defadvice `(progn (defadvice! ,@rest)
|
||||
(unwind-protect ,body (undefadvice! ,@rest))))
|
||||
((or `defun `defun*)
|
||||
`(cl-letf ((,(car rest) (symbol-function #',(car rest))))
|
||||
(ignore ,(car rest))
|
||||
,(if (eq type 'defun*)
|
||||
`(cl-labels ((,@rest)) ,body)
|
||||
`(cl-letf (((symbol-function #',(car rest))
|
||||
(lambda! ,(cadr rest) ,@(cddr rest))))
|
||||
,body))))
|
||||
(_
|
||||
(when (eq (car-safe type) 'function)
|
||||
(setq type (list 'symbol-function type)))
|
||||
(list 'cl-letf (list (cons type rest)) body)))))))
|
||||
|
||||
(defmacro quiet! (&rest forms)
|
||||
"Run FORMS without generating any output.
|
||||
|
||||
This silences calls to `message', `load', `write-region' and anything that
|
||||
writes to `standard-output'. In interactive sessions this inhibits output to the
|
||||
echo-area, but not to *Messages*."
|
||||
`(if init-file-debug
|
||||
(progn ,@forms)
|
||||
,(if noninteractive
|
||||
`(letf! ((standard-output (lambda (&rest _)))
|
||||
(defun message (&rest _))
|
||||
(defun load (file &optional noerror nomessage nosuffix must-suffix)
|
||||
(funcall load file noerror t nosuffix must-suffix))
|
||||
(defun write-region (start end filename &optional append visit lockname mustbenew)
|
||||
(unless visit (setq visit 'no-message))
|
||||
(funcall write-region start end filename append visit lockname mustbenew)))
|
||||
,@forms)
|
||||
`(let ((inhibit-message t)
|
||||
(save-silently t))
|
||||
(prog1 ,@forms (message ""))))))
|
||||
|
||||
(defmacro eval-if! (cond then &rest body)
|
||||
"Expands to THEN if COND is non-nil, to BODY otherwise.
|
||||
COND is checked at compile/expansion time, allowing BODY to be omitted entirely
|
||||
when the elisp is byte-compiled. Use this for forms that contain expensive
|
||||
macros that could safely be removed at compile time."
|
||||
(declare (indent 2))
|
||||
(if (eval cond)
|
||||
then
|
||||
(macroexp-progn body)))
|
||||
|
||||
(defmacro eval-when! (cond &rest body)
|
||||
"Expands to BODY if CONDITION is non-nil at compile/expansion time.
|
||||
See `eval-if!' for details on this macro's purpose."
|
||||
(declare (indent 1))
|
||||
(when (eval cond)
|
||||
(macroexp-progn body)))
|
||||
|
||||
|
||||
;;; Closure factories
|
||||
(defmacro lambda! (arglist &rest body)
|
||||
"Returns (cl-function (lambda ARGLIST BODY...))
|
||||
The closure is wrapped in `cl-function', meaning ARGLIST will accept anything
|
||||
`cl-defun' will. Implicitly adds `&allow-other-keys' if `&key' is present in
|
||||
ARGLIST."
|
||||
(declare (indent defun) (doc-string 1) (pure t) (side-effect-free t))
|
||||
`(cl-function
|
||||
(lambda
|
||||
,(letf! (defun* allow-other-keys (args)
|
||||
(mapcar
|
||||
(lambda (arg)
|
||||
(cond ((nlistp (cdr-safe arg)) arg)
|
||||
((listp arg) (allow-other-keys arg))
|
||||
(arg)))
|
||||
(if (and (memq '&key args)
|
||||
(not (memq '&allow-other-keys args)))
|
||||
(if (memq '&aux args)
|
||||
(let (newargs arg)
|
||||
(while args
|
||||
(setq arg (pop args))
|
||||
(when (eq arg '&aux)
|
||||
(push '&allow-other-keys newargs))
|
||||
(push arg newargs))
|
||||
(nreverse newargs))
|
||||
(append args (list '&allow-other-keys)))
|
||||
args)))
|
||||
(allow-other-keys arglist))
|
||||
,@body)))
|
||||
|
||||
(put 'doom--fn-crawl 'lookup-table
|
||||
'((_ . 0) (_ . 1) (%2 . 2) (%3 . 3) (%4 . 4)
|
||||
(%5 . 5) (%6 . 6) (%7 . 7) (%8 . 8) (%9 . 9)))
|
||||
(defun doom--fn-crawl (data args)
|
||||
(cond ((symbolp data)
|
||||
(when-let
|
||||
(pos (cond ((eq data '%*) 0)
|
||||
((memq data '(% %1)) 1)
|
||||
((cdr (assq data (get 'doom--fn-crawl 'lookup-table))))))
|
||||
(when (and (= pos 1)
|
||||
(aref args 1)
|
||||
(not (eq data (aref args 1))))
|
||||
(error "%% and %%1 are mutually exclusive"))
|
||||
(aset args pos data)))
|
||||
((and (not (eq (car-safe data) '!))
|
||||
(or (listp data)
|
||||
(vectorp data)))
|
||||
(let ((len (length data))
|
||||
(i 0))
|
||||
(while (< i len)
|
||||
(doom--fn-crawl (elt data i) args)
|
||||
(cl-incf i))))))
|
||||
|
||||
(defmacro fn! (&rest args)
|
||||
"Return an lambda with implicit, positional arguments.
|
||||
|
||||
The function's arguments are determined recursively from ARGS. Each symbol from
|
||||
`%1' through `%9' that appears in ARGS is treated as a positional argument.
|
||||
Missing arguments are named `_%N', which keeps the byte-compiler quiet. `%' is
|
||||
a shorthand for `%1'; only one of these can appear in ARGS. `%*' represents
|
||||
extra `&rest' arguments.
|
||||
|
||||
Instead of:
|
||||
|
||||
(lambda (a _ c &rest d)
|
||||
(if a c (cadr d)))
|
||||
|
||||
you can use this macro and write:
|
||||
|
||||
(fn! (if %1 %3 (cadr %*)))
|
||||
|
||||
which expands to:
|
||||
|
||||
(lambda (%1 _%2 %3 &rest %*)
|
||||
(if %1 %3 (cadr %*)))
|
||||
|
||||
This macro was adapted from llama.el (see https://git.sr.ht/~tarsius/llama),
|
||||
minus font-locking, the outer function call, and minor optimizations."
|
||||
`(lambda ,(let ((argv (make-vector 10 nil)))
|
||||
(doom--fn-crawl args argv)
|
||||
`(,@(let ((i (1- (length argv)))
|
||||
(n -1)
|
||||
sym arglist)
|
||||
(while (> i 0)
|
||||
(setq sym (aref argv i))
|
||||
(unless (and (= n -1) (null sym))
|
||||
(cl-incf n)
|
||||
(push (or sym (intern (format "_%%%d" (1+ n))))
|
||||
arglist))
|
||||
(cl-decf i))
|
||||
arglist)
|
||||
,@(and (aref argv 0) '(&rest %*))))
|
||||
,@args))
|
||||
|
||||
(defmacro cmd! (&rest body)
|
||||
"Returns (lambda () (interactive) ,@body)
|
||||
A factory for quickly producing interaction commands, particularly for keybinds
|
||||
or aliases."
|
||||
(declare (doc-string 1) (pure t) (side-effect-free t))
|
||||
`(lambda (&rest _) (interactive) ,@body))
|
||||
|
||||
(defmacro cmd!! (command &optional prefix-arg &rest args)
|
||||
"Returns a closure that interactively calls COMMAND with ARGS and PREFIX-ARG.
|
||||
Like `cmd!', but allows you to change `current-prefix-arg' or pass arguments to
|
||||
COMMAND. This macro is meant to be used as a target for keybinds (e.g. with
|
||||
`define-key' or `map!')."
|
||||
(declare (doc-string 1) (pure t) (side-effect-free t))
|
||||
`(lambda (arg &rest _) (interactive "P")
|
||||
(let ((current-prefix-arg (or ,prefix-arg arg)))
|
||||
(,(if args
|
||||
#'funcall-interactively
|
||||
#'call-interactively)
|
||||
,command ,@args))))
|
||||
|
||||
(defmacro cmds! (&rest branches)
|
||||
"Returns a dispatcher that runs the a command in BRANCHES.
|
||||
Meant to be used as a target for keybinds (e.g. with `define-key' or `map!').
|
||||
|
||||
BRANCHES is a flat list of CONDITION COMMAND pairs. CONDITION is a lisp form
|
||||
that is evaluated when (and each time) the dispatcher is invoked. If it returns
|
||||
non-nil, COMMAND is invoked, otherwise it falls through to the next pair.
|
||||
|
||||
The last element of BRANCHES can be a COMMANd with no CONDITION. This acts as
|
||||
the fallback if all other conditions fail.
|
||||
|
||||
Otherwise, Emacs will fall through the keybind and search the next keymap for a
|
||||
keybind (as if this keybind never existed).
|
||||
|
||||
See `general-key-dispatch' for what other arguments it accepts in BRANCHES."
|
||||
(declare (doc-string 1))
|
||||
(let ((docstring (if (stringp (car branches)) (pop branches) ""))
|
||||
fallback)
|
||||
(when (cl-oddp (length branches))
|
||||
(setq fallback (car (last branches))
|
||||
branches (butlast branches)))
|
||||
(let ((defs (cl-loop for (key value) on branches by 'cddr
|
||||
unless (keywordp key)
|
||||
collect (list key value))))
|
||||
`'(menu-item
|
||||
,(or docstring "") nil
|
||||
:filter (lambda (&optional _)
|
||||
(let (it)
|
||||
(cond ,@(mapcar (lambda (pred-def)
|
||||
`((setq it ,(car pred-def))
|
||||
,(cadr pred-def)))
|
||||
defs)
|
||||
(t ,fallback))))))))
|
||||
|
||||
(defalias 'kbd! #'general-simulate-key)
|
||||
|
||||
;; For backwards compatibility
|
||||
(defalias 'λ! #'cmd!)
|
||||
(defalias 'λ!! #'cmd!!)
|
||||
|
||||
|
||||
;;; Mutation
|
||||
(defmacro appendq! (sym &rest lists)
|
||||
"Append LISTS to SYM in place."
|
||||
`(setq ,sym (append ,sym ,@lists)))
|
||||
|
||||
(defmacro setq! (&rest settings)
|
||||
"A more sensible `setopt' for setting customizable variables.
|
||||
|
||||
This can be used as a drop-in replacement for `setq' and *should* be used
|
||||
instead of `setopt'. Unlike `setq', this triggers custom setters on variables.
|
||||
Unlike `setopt', this won't needlessly pull in dependencies."
|
||||
(macroexp-progn
|
||||
(cl-loop for (var val) on settings by 'cddr
|
||||
collect `(funcall (or (get ',var 'custom-set) #'set)
|
||||
',var ,val))))
|
||||
|
||||
(defmacro delq! (elt list &optional fetcher)
|
||||
"`delq' ELT from LIST in-place.
|
||||
|
||||
If FETCHER is a function, ELT is used as the key in LIST (an alist)."
|
||||
`(setq ,list (delq ,(if fetcher
|
||||
`(funcall ,fetcher ,elt ,list)
|
||||
elt)
|
||||
,list)))
|
||||
|
||||
(defmacro pushnew! (place &rest values)
|
||||
"Push VALUES sequentially into PLACE, if they aren't already present.
|
||||
This is a variadic `cl-pushnew'."
|
||||
(let ((var (make-symbol "result")))
|
||||
`(dolist (,var (list ,@values) (with-no-warnings ,place))
|
||||
(cl-pushnew ,var ,place :test #'equal))))
|
||||
|
||||
(defmacro prependq! (sym &rest lists)
|
||||
"Prepend LISTS to SYM in place."
|
||||
`(setq ,sym (append ,@lists ,sym)))
|
||||
|
||||
|
||||
;;; Loading
|
||||
(defmacro add-load-path! (&rest dirs)
|
||||
"Add DIRS to `load-path', relative to the current file.
|
||||
The current file is the file from which `add-to-load-path!' is used."
|
||||
`(let ((default-directory ,(dir!))
|
||||
file-name-handler-alist)
|
||||
(dolist (dir (list ,@dirs))
|
||||
(cl-pushnew (expand-file-name dir) load-path :test #'string=))))
|
||||
|
||||
(defmacro after! (package &rest body)
|
||||
"Evaluate BODY after PACKAGE have loaded.
|
||||
|
||||
PACKAGE is a symbol or list of them. These are package names, not modes,
|
||||
functions or variables. It can be:
|
||||
|
||||
- An unquoted package symbol (the name of a package)
|
||||
(after! helm BODY...)
|
||||
- An unquoted list of package symbols (i.e. BODY is evaluated once both magit
|
||||
and git-gutter have loaded)
|
||||
(after! (magit git-gutter) BODY...)
|
||||
- An unquoted, nested list of compound package lists, using any combination of
|
||||
:or/:any and :and/:all
|
||||
(after! (:or package-a package-b ...) BODY...)
|
||||
(after! (:and package-a package-b ...) BODY...)
|
||||
(after! (:and package-a (:or package-b package-c) ...) BODY...)
|
||||
Without :or/:any/:and/:all, :and/:all are implied.
|
||||
|
||||
This is a wrapper around `eval-after-load' that:
|
||||
|
||||
1. Suppresses warnings for disabled packages at compile-time
|
||||
2. No-ops for package that are disabled by the user (via `package!')
|
||||
3. Supports compound package statements (see below)
|
||||
4. Prevents eager expansion pulling in autoloaded macros all at once"
|
||||
(declare (indent defun) (debug t))
|
||||
(if (symbolp package)
|
||||
(unless (memq package (bound-and-true-p doom-disabled-packages))
|
||||
(list (if (or (not (bound-and-true-p byte-compile-current-file))
|
||||
(require package nil 'noerror))
|
||||
#'progn
|
||||
#'with-no-warnings)
|
||||
;; We intentionally avoid `with-eval-after-load' to prevent eager
|
||||
;; macro expansion from pulling (or failing to pull) in autoloaded
|
||||
;; macros/packages.
|
||||
`(eval-after-load ',package ',(macroexp-progn body))))
|
||||
(let ((p (car package)))
|
||||
(cond ((memq p '(:or :any))
|
||||
(macroexp-progn
|
||||
(cl-loop for next in (cdr package)
|
||||
collect `(after! ,next ,@body))))
|
||||
((memq p '(:and :all))
|
||||
(dolist (next (reverse (cdr package)) (car body))
|
||||
(setq body `((after! ,next ,@body)))))
|
||||
(`(after! (:and ,@package) ,@body))))))
|
||||
|
||||
(defun doom--handle-load-error (e target path)
|
||||
(let* ((source (file-name-sans-extension target))
|
||||
(err (cond ((not (featurep 'doom))
|
||||
(cons 'error (file-name-directory path)))
|
||||
((file-in-directory-p source doom-core-dir)
|
||||
(cons 'doom-error doom-core-dir))
|
||||
((file-in-directory-p source doom-private-dir)
|
||||
(cons 'doom-private-error doom-private-dir))
|
||||
((file-in-directory-p source (expand-file-name "cli" doom-core-dir))
|
||||
(cons 'doom-cli-error (expand-file-name "cli" doom-core-dir)))
|
||||
((cons 'doom-module-error doom-emacs-dir)))))
|
||||
(signal (car err)
|
||||
(list (file-relative-name
|
||||
(concat source ".el")
|
||||
(cdr err))
|
||||
e))))
|
||||
|
||||
(defmacro load! (filename &optional path noerror)
|
||||
"Load a file relative to the current executing file (`load-file-name').
|
||||
|
||||
FILENAME is either a file path string or a form that should evaluate to such a
|
||||
string at run time. PATH is where to look for the file (a string representing a
|
||||
directory path). If omitted, the lookup is relative to either `load-file-name',
|
||||
`byte-compile-current-file' or `buffer-file-name' (checked in that order).
|
||||
|
||||
If NOERROR is non-nil, don't throw an error if the file doesn't exist."
|
||||
(let* ((path (or path
|
||||
(dir!)
|
||||
(error "Could not detect path to look for '%s' in"
|
||||
filename)))
|
||||
(file (if path
|
||||
`(expand-file-name ,filename ,path)
|
||||
filename)))
|
||||
`(condition-case-unless-debug e
|
||||
(let (file-name-handler-alist)
|
||||
(load ,file ,noerror 'nomessage))
|
||||
(doom-error (signal (car e) (cdr e)))
|
||||
(error (doom--handle-load-error e ,file ,path)))))
|
||||
|
||||
(defmacro defer-until! (condition &rest body)
|
||||
"Run BODY when CONDITION is true (checks on `after-load-functions'). Meant to
|
||||
serve as a predicated alternative to `after!'."
|
||||
(declare (indent defun) (debug t))
|
||||
`(if ,condition
|
||||
(progn ,@body)
|
||||
,(let ((fn (intern (format "doom--delay-form-%s-h" (sxhash (cons condition body))))))
|
||||
`(progn
|
||||
(fset ',fn (lambda (&rest args)
|
||||
(when ,(or condition t)
|
||||
(remove-hook 'after-load-functions #',fn)
|
||||
(unintern ',fn nil)
|
||||
(ignore args)
|
||||
,@body)))
|
||||
(put ',fn 'permanent-local-hook t)
|
||||
(add-hook 'after-load-functions #',fn)))))
|
||||
|
||||
(defmacro defer-feature! (feature &rest fns)
|
||||
"Pretend FEATURE hasn't been loaded yet, until FEATURE-hook or FN runs.
|
||||
|
||||
Some packages (like `elisp-mode' and `lisp-mode') are loaded immediately at
|
||||
startup, which will prematurely trigger `after!' (and `with-eval-after-load')
|
||||
blocks. To get around this we make Emacs believe FEATURE hasn't been loaded yet,
|
||||
then wait until FEATURE-hook (or MODE-hook, if FN is provided) is triggered to
|
||||
reverse this and trigger `after!' blocks at a more reasonable time."
|
||||
(let ((advice-fn (intern (format "doom--defer-feature-%s-a" feature))))
|
||||
`(progn
|
||||
(delq! ',feature features)
|
||||
(defadvice! ,advice-fn (&rest _)
|
||||
:before ',fns
|
||||
;; Some plugins (like yasnippet) will invoke a fn early to parse
|
||||
;; code, which would prematurely trigger this. In those cases, well
|
||||
;; behaved plugins will use `delay-mode-hooks', which we can check for:
|
||||
(unless delay-mode-hooks
|
||||
;; ...Otherwise, announce to the world this package has been loaded,
|
||||
;; so `after!' handlers can react.
|
||||
(provide ',feature)
|
||||
(dolist (fn ',fns)
|
||||
(advice-remove fn #',advice-fn)))))))
|
||||
|
||||
|
||||
;;; Hooks
|
||||
(defmacro add-transient-hook! (hook-or-function &rest forms)
|
||||
"Attaches a self-removing function to HOOK-OR-FUNCTION.
|
||||
|
||||
FORMS are evaluated once, when that function/hook is first invoked, then never
|
||||
again.
|
||||
|
||||
HOOK-OR-FUNCTION can be a quoted hook or a sharp-quoted function (which will be
|
||||
advised)."
|
||||
(declare (indent 1))
|
||||
(let ((append (if (eq (car forms) :after) (pop forms)))
|
||||
;; Avoid `make-symbol' and `gensym' here because an interned symbol is
|
||||
;; easier to debug in backtraces (and is visible to `describe-function')
|
||||
(fn (intern (format "doom--transient-%d-h"
|
||||
(put 'add-transient-hook! 'counter
|
||||
(1+ (or (get 'add-transient-hook! 'counter)
|
||||
0)))))))
|
||||
`(let ((sym ,hook-or-function))
|
||||
(defun ,fn (&rest _)
|
||||
,(format "Transient hook for %S" (doom-unquote hook-or-function))
|
||||
,@forms
|
||||
(let ((sym ,hook-or-function))
|
||||
(cond ((functionp sym) (advice-remove sym #',fn))
|
||||
((symbolp sym) (remove-hook sym #',fn))))
|
||||
(unintern ',fn nil))
|
||||
(cond ((functionp sym)
|
||||
(advice-add ,hook-or-function ,(if append :after :before) #',fn))
|
||||
((symbolp sym)
|
||||
(put ',fn 'permanent-local-hook t)
|
||||
(add-hook sym #',fn ,append))))))
|
||||
|
||||
(defmacro add-hook! (hooks &rest rest)
|
||||
"A convenience macro for adding N functions to M hooks.
|
||||
|
||||
This macro accepts, in order:
|
||||
|
||||
1. The mode(s) or hook(s) to add to. This is either an unquoted mode, an
|
||||
unquoted list of modes, a quoted hook variable or a quoted list of hook
|
||||
variables.
|
||||
2. Optional properties :local, :append, and/or :depth [N], which will make the
|
||||
hook buffer-local or append to the list of hooks (respectively),
|
||||
3. The function(s) to be added: this can be a quoted function, a quoted list
|
||||
thereof, a list of `defun' or `cl-defun' forms, or arbitrary forms (will
|
||||
implicitly be wrapped in a lambda).
|
||||
|
||||
\(fn HOOKS [:append :local [:depth N]] FUNCTIONS-OR-FORMS...)"
|
||||
(declare (indent (lambda (indent-point state)
|
||||
(goto-char indent-point)
|
||||
(when (looking-at-p "\\s-*(")
|
||||
(lisp-indent-defform state indent-point))))
|
||||
(debug t))
|
||||
(let* ((hook-forms (doom--resolve-hook-forms hooks))
|
||||
(func-forms ())
|
||||
(defn-forms ())
|
||||
append-p local-p remove-p depth)
|
||||
(while (keywordp (car rest))
|
||||
(pcase (pop rest)
|
||||
(:append (setq append-p t))
|
||||
(:depth (setq depth (pop rest)))
|
||||
(:local (setq local-p t))
|
||||
(:remove (setq remove-p t))))
|
||||
(while rest
|
||||
(let* ((next (pop rest))
|
||||
(first (car-safe next)))
|
||||
(push (cond ((memq first '(function nil))
|
||||
next)
|
||||
((eq first 'quote)
|
||||
(let ((quoted (cadr next)))
|
||||
(if (atom quoted)
|
||||
next
|
||||
(when (cdr quoted)
|
||||
(setq rest (cons (list first (cdr quoted)) rest)))
|
||||
(list first (car quoted)))))
|
||||
((memq first '(defun cl-defun))
|
||||
(push next defn-forms)
|
||||
(list 'function (cadr next)))
|
||||
((prog1 `(lambda (&rest _) ,@(cons next rest))
|
||||
(setq rest nil))))
|
||||
func-forms)))
|
||||
`(progn
|
||||
,@defn-forms
|
||||
(dolist (hook (nreverse ',hook-forms))
|
||||
(dolist (func (list ,@func-forms))
|
||||
,(if remove-p
|
||||
`(remove-hook hook func ,local-p)
|
||||
`(add-hook hook func ,(or depth append-p) ,local-p)))))))
|
||||
|
||||
(defmacro remove-hook! (hooks &rest rest)
|
||||
"A convenience macro for removing N functions from M hooks.
|
||||
|
||||
Takes the same arguments as `add-hook!'.
|
||||
|
||||
If N and M = 1, there's no benefit to using this macro over `remove-hook'.
|
||||
|
||||
\(fn HOOKS [:append :local] FUNCTIONS)"
|
||||
(declare (indent defun) (debug t))
|
||||
`(add-hook! ,hooks :remove ,@rest))
|
||||
|
||||
(defmacro setq-hook! (hooks &rest var-vals)
|
||||
"Sets buffer-local variables on HOOKS.
|
||||
|
||||
\(fn HOOKS &rest [SYM VAL]...)"
|
||||
(declare (indent 1))
|
||||
(macroexp-progn
|
||||
(cl-loop for (var val hook fn) in (doom--setq-hook-fns hooks var-vals)
|
||||
collect `(defun ,fn (&rest _)
|
||||
,(format "%s = %s" var (pp-to-string val))
|
||||
(setq-local ,var ,val))
|
||||
collect `(remove-hook ',hook #',fn) ; ensure set order
|
||||
collect `(add-hook ',hook #',fn))))
|
||||
|
||||
(defmacro unsetq-hook! (hooks &rest vars)
|
||||
"Unbind setq hooks on HOOKS for VARS.
|
||||
|
||||
\(fn HOOKS &rest [SYM VAL]...)"
|
||||
(declare (indent 1))
|
||||
(macroexp-progn
|
||||
(cl-loop for (_var _val hook fn)
|
||||
in (doom--setq-hook-fns hooks vars 'singles)
|
||||
collect `(remove-hook ',hook #',fn))))
|
||||
|
||||
|
||||
;;; Definers
|
||||
(defmacro defadvice! (symbol arglist &optional docstring &rest body)
|
||||
"Define an advice called SYMBOL and add it to PLACES.
|
||||
|
||||
ARGLIST is as in `defun'. WHERE is a keyword as passed to `advice-add', and
|
||||
PLACE is the function to which to add the advice, like in `advice-add'.
|
||||
DOCSTRING and BODY are as in `defun'.
|
||||
|
||||
\(fn SYMBOL ARGLIST &optional DOCSTRING &rest [WHERE PLACES...] BODY\)"
|
||||
(declare (doc-string 3) (indent defun))
|
||||
(unless (stringp docstring)
|
||||
(push docstring body)
|
||||
(setq docstring nil))
|
||||
(let (where-alist)
|
||||
(while (keywordp (car body))
|
||||
(push `(cons ,(pop body) (doom-enlist ,(pop body)))
|
||||
where-alist))
|
||||
`(progn
|
||||
(defun ,symbol ,arglist ,docstring ,@body)
|
||||
(dolist (targets (list ,@(nreverse where-alist)))
|
||||
(dolist (target (cdr targets))
|
||||
(advice-add target (car targets) #',symbol))))))
|
||||
|
||||
(defmacro undefadvice! (symbol _arglist &optional docstring &rest body)
|
||||
"Undefine an advice called SYMBOL.
|
||||
|
||||
This has the same signature as `defadvice!' an exists as an easy undefiner when
|
||||
testing advice (when combined with `rotate-text').
|
||||
|
||||
\(fn SYMBOL ARGLIST &optional DOCSTRING &rest [WHERE PLACES...] BODY\)"
|
||||
(declare (doc-string 3) (indent defun))
|
||||
(let (where-alist)
|
||||
(unless (stringp docstring)
|
||||
(push docstring body))
|
||||
(while (keywordp (car body))
|
||||
(push `(cons ,(pop body) (doom-enlist ,(pop body)))
|
||||
where-alist))
|
||||
`(dolist (targets (list ,@(nreverse where-alist)))
|
||||
(dolist (target (cdr targets))
|
||||
(advice-remove target #',symbol)))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Backports
|
||||
|
||||
;; `format-spec' wasn't autoloaded until 28.1
|
||||
(unless (fboundp 'format-spec)
|
||||
(autoload #'format-spec "format-spec"))
|
||||
|
||||
;; Introduced in Emacs 28.1
|
||||
(unless (fboundp 'ensure-list)
|
||||
(defun ensure-list (object)
|
||||
"Return OBJECT as a list.
|
||||
If OBJECT is already a list, return OBJECT itself. If it's
|
||||
not a list, return a one-element list containing OBJECT."
|
||||
(declare (pure t) (side-effect-free t))
|
||||
(if (listp object)
|
||||
object
|
||||
(list object))))
|
||||
|
||||
;; Introduced in Emacs 28.1
|
||||
(unless (fboundp 'always)
|
||||
(defun always (&rest _arguments)
|
||||
"Do nothing and return t.
|
||||
This function accepts any number of ARGUMENTS, but ignores them.
|
||||
Also see `ignore'."
|
||||
t))
|
||||
|
||||
(provide 'doom-lib)
|
||||
;;; doom-lib.el ends here
|
||||
Loading…
Add table
Add a link
Reference in a new issue