Reorganize core-lib
Group like macros together.
This commit is contained in:
Henrik Lissner
parent
64b799c68e
commit
c3a84f0fbf
1 changed files with 153 additions and 147 deletions
300
core/core-lib.el
300
core/core-lib.el
|
|
@ -168,6 +168,11 @@ aliases."
|
||||||
(call-interactively command))))
|
(call-interactively command))))
|
||||||
(defalias 'lambda!! 'λ!!)
|
(defalias 'lambda!! 'λ!!)
|
||||||
|
|
||||||
|
(defun dir! ()
|
||||||
|
"Returns the directory of the emacs lisp file this macro is called from."
|
||||||
|
(when-let (path (file!))
|
||||||
|
(directory-file-name (file-name-directory path))))
|
||||||
|
|
||||||
(defun file! ()
|
(defun file! ()
|
||||||
"Return the emacs lisp file this macro is called from."
|
"Return the emacs lisp file this macro is called from."
|
||||||
(cond ((bound-and-true-p byte-compile-current-file))
|
(cond ((bound-and-true-p byte-compile-current-file))
|
||||||
|
|
@ -177,10 +182,83 @@ aliases."
|
||||||
(buffer-file-name)
|
(buffer-file-name)
|
||||||
((error "Cannot get this file-path"))))
|
((error "Cannot get this file-path"))))
|
||||||
|
|
||||||
(defun dir! ()
|
(defmacro letenv! (envvars &rest body)
|
||||||
"Returns the directory of the emacs lisp file this macro is called from."
|
"Lexically bind ENVVARS in BODY, like `let' but for `process-environment'."
|
||||||
(when-let (path (file!))
|
(declare (indent 1))
|
||||||
(directory-file-name (file-name-directory path))))
|
`(let ((process-environment (copy-sequence process-environment)))
|
||||||
|
(dolist (var (list ,@(cl-loop for (var val) in envvars
|
||||||
|
collect `(cons ,var ,val))))
|
||||||
|
(setenv (car var) (cdr var)))
|
||||||
|
,@body))
|
||||||
|
|
||||||
|
(defmacro quiet! (&rest forms)
|
||||||
|
"Run FORMS without generating any output.
|
||||||
|
|
||||||
|
This silences calls to `message', `load-file', `write-region' and anything that
|
||||||
|
writes to `standard-output'."
|
||||||
|
`(cond (doom-debug-mode ,@forms)
|
||||||
|
((not doom-interactive-mode)
|
||||||
|
(let ((old-fn (symbol-function 'write-region)))
|
||||||
|
(cl-letf ((standard-output (lambda (&rest _)))
|
||||||
|
((symbol-function 'load-file) (lambda (file) (load file nil t)))
|
||||||
|
((symbol-function 'message) (lambda (&rest _)))
|
||||||
|
((symbol-function 'write-region)
|
||||||
|
(lambda (start end filename &optional append visit lockname mustbenew)
|
||||||
|
(unless visit (setq visit 'no-message))
|
||||||
|
(funcall old-fn start end filename append visit lockname mustbenew))))
|
||||||
|
,@forms)))
|
||||||
|
((let ((inhibit-message t)
|
||||||
|
(save-silently t))
|
||||||
|
(prog1 ,@forms (message ""))))))
|
||||||
|
|
||||||
|
|
||||||
|
;;; Mutation
|
||||||
|
(defmacro appendq! (sym &rest lists)
|
||||||
|
"Append LISTS to SYM in place."
|
||||||
|
`(setq ,sym (append ,sym ,@lists)))
|
||||||
|
|
||||||
|
(defmacro setq! (&rest settings)
|
||||||
|
"A stripped-down `customize-set-variable' with the syntax of `setq'.
|
||||||
|
|
||||||
|
Use this instead of `setq' when you know a variable has a custom setter (a :set
|
||||||
|
property in its `defcustom' declaration). This trigger setters. `setq' does
|
||||||
|
not."
|
||||||
|
(macroexp-progn
|
||||||
|
(cl-loop for (var val) on settings by 'cddr
|
||||||
|
collect (list (or (get var 'custom-set) #'set)
|
||||||
|
(list 'quote 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))))
|
||||||
|
|
||||||
(defmacro after! (package &rest body)
|
(defmacro after! (package &rest body)
|
||||||
"Evaluate BODY after PACKAGE have loaded.
|
"Evaluate BODY after PACKAGE have loaded.
|
||||||
|
|
@ -232,58 +310,84 @@ This is a wrapper around `eval-after-load' that:
|
||||||
(setq body `((after! ,next ,@body))))
|
(setq body `((after! ,next ,@body))))
|
||||||
(car body))))))
|
(car body))))))
|
||||||
|
|
||||||
(defmacro setq! (&rest settings)
|
(defun doom--handle-load-error (e target path)
|
||||||
"A stripped-down `customize-set-variable' with the syntax of `setq'.
|
(let* ((source (file-name-sans-extension target))
|
||||||
|
(err (cond ((not (featurep 'core))
|
||||||
|
(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))
|
||||||
|
((cons 'doom-module-error doom-emacs-dir)))))
|
||||||
|
(signal (car err)
|
||||||
|
(list (file-relative-name
|
||||||
|
(concat source ".el")
|
||||||
|
(cdr err))
|
||||||
|
e))))
|
||||||
|
|
||||||
Use this instead of `setq' when you know a variable has a custom setter (a :set
|
(defmacro load! (filename &optional path noerror)
|
||||||
property in its `defcustom' declaration). This trigger setters. `setq' does
|
"Load a file relative to the current executing file (`load-file-name').
|
||||||
not."
|
|
||||||
(macroexp-progn
|
|
||||||
(cl-loop for (var val) on settings by 'cddr
|
|
||||||
collect `(funcall (or (get ',var 'custom-set) #'set)
|
|
||||||
',var ,val))))
|
|
||||||
|
|
||||||
(defmacro pushnew! (place &rest values)
|
FILENAME is either a file path string or a form that should evaluate to such a
|
||||||
"Push VALUES sequentially into PLACE, if they aren't already present.
|
string at run time. PATH is where to look for the file (a string representing a
|
||||||
This is a variadic `cl-pushnew'."
|
directory path). If omitted, the lookup is relative to either `load-file-name',
|
||||||
(let ((var (make-symbol "result")))
|
`byte-compile-current-file' or `buffer-file-name' (checked in that order).
|
||||||
`(dolist (,var (list ,@values) (with-no-warnings ,place))
|
|
||||||
(cl-pushnew ,var ,place :test #'equal))))
|
|
||||||
|
|
||||||
(defmacro prependq! (sym &rest lists)
|
If NOERROR is non-nil, don't throw an error if the file doesn't exist."
|
||||||
"Prepend LISTS to SYM in place."
|
(let* ((path (or path
|
||||||
`(setq ,sym (append ,@lists ,sym)))
|
(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 appendq! (sym &rest lists)
|
(defmacro defer-until! (condition &rest body)
|
||||||
"Append LISTS to SYM in place."
|
"Run BODY when CONDITION is true (checks on `after-load-functions'). Meant to
|
||||||
`(setq ,sym (append ,sym ,@lists)))
|
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 delq! (elt list &optional fetcher)
|
(defmacro defer-feature! (feature &optional fn)
|
||||||
"`delq' ELT from LIST in-place.
|
"Pretend FEATURE hasn't been loaded yet, until FEATURE-hook or FN runs.
|
||||||
|
|
||||||
If FETCHER is a function, ELT is used as the key in LIST (an alist)."
|
Some packages (like `elisp-mode' and `lisp-mode') are loaded immediately at
|
||||||
`(setq ,list
|
startup, which will prematurely trigger `after!' (and `with-eval-after-load')
|
||||||
(delq ,(if fetcher
|
blocks. To get around this we make Emacs believe FEATURE hasn't been loaded yet,
|
||||||
`(funcall ,fetcher ,elt ,list)
|
then wait until FEATURE-hook (or MODE-hook, if FN is provided) is triggered to
|
||||||
elt)
|
reverse this and trigger `after!' blocks at a more reasonable time."
|
||||||
,list)))
|
(let ((advice-fn (intern (format "doom--defer-feature-%s-a" feature)))
|
||||||
|
(fn (or fn feature)))
|
||||||
|
`(progn
|
||||||
|
(setq features (delq ',feature features))
|
||||||
|
(advice-add #',fn :before #',advice-fn)
|
||||||
|
(defun ,advice-fn (&rest _)
|
||||||
|
;; 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:
|
||||||
|
(when (and ,(intern (format "%s-hook" fn))
|
||||||
|
(not delay-mode-hooks))
|
||||||
|
;; ...Otherwise, announce to the world this package has been loaded,
|
||||||
|
;; so `after!' handlers can react.
|
||||||
|
(provide ',feature)
|
||||||
|
(advice-remove #',fn #',advice-fn))))))
|
||||||
|
|
||||||
(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)))
|
|
||||||
(dolist (var (list ,@(cl-loop for (var val) in envvars
|
|
||||||
collect `(cons ,var ,val))))
|
|
||||||
(setenv (car var) (cdr var)))
|
|
||||||
,@body))
|
|
||||||
|
|
||||||
(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))))
|
|
||||||
|
|
||||||
;;; Hooks
|
;;; Hooks
|
||||||
(defvar doom--transient-counter 0)
|
(defvar doom--transient-counter 0)
|
||||||
|
|
@ -409,106 +513,8 @@ If N and M = 1, there's no benefit to using this macro over `remove-hook'.
|
||||||
in (doom--setq-hook-fns hooks vars 'singles)
|
in (doom--setq-hook-fns hooks vars 'singles)
|
||||||
collect `(remove-hook ',hook #',fn))))
|
collect `(remove-hook ',hook #',fn))))
|
||||||
|
|
||||||
(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
|
|
||||||
(let* ((source (file-name-sans-extension ,file))
|
|
||||||
(err (cond ((not (featurep 'core))
|
|
||||||
(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))
|
|
||||||
((cons 'doom-module-error doom-emacs-dir)))))
|
|
||||||
(signal (car err)
|
|
||||||
(list (file-relative-name
|
|
||||||
(concat source ".el")
|
|
||||||
(cdr err))
|
|
||||||
e)))))))
|
|
||||||
|
|
||||||
(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 &optional fn)
|
|
||||||
"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)))
|
|
||||||
(fn (or fn feature)))
|
|
||||||
`(progn
|
|
||||||
(setq features (delq ',feature features))
|
|
||||||
(advice-add #',fn :before #',advice-fn)
|
|
||||||
(defun ,advice-fn (&rest _)
|
|
||||||
;; 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:
|
|
||||||
(when (and ,(intern (format "%s-hook" fn))
|
|
||||||
(not delay-mode-hooks))
|
|
||||||
;; ...Otherwise, announce to the world this package has been loaded,
|
|
||||||
;; so `after!' handlers can react.
|
|
||||||
(provide ',feature)
|
|
||||||
(advice-remove #',fn #',advice-fn))))))
|
|
||||||
|
|
||||||
(defmacro quiet! (&rest forms)
|
|
||||||
"Run FORMS without generating any output.
|
|
||||||
|
|
||||||
This silences calls to `message', `load-file', `write-region' and anything that
|
|
||||||
writes to `standard-output'."
|
|
||||||
`(cond (doom-debug-mode ,@forms)
|
|
||||||
((not doom-interactive-mode)
|
|
||||||
(let ((old-fn (symbol-function 'write-region)))
|
|
||||||
(cl-letf ((standard-output (lambda (&rest _)))
|
|
||||||
((symbol-function 'load-file) (lambda (file) (load file nil t)))
|
|
||||||
((symbol-function 'message) (lambda (&rest _)))
|
|
||||||
((symbol-function 'write-region)
|
|
||||||
(lambda (start end filename &optional append visit lockname mustbenew)
|
|
||||||
(unless visit (setq visit 'no-message))
|
|
||||||
(funcall old-fn start end filename append visit lockname mustbenew))))
|
|
||||||
,@forms)))
|
|
||||||
((let ((inhibit-message t)
|
|
||||||
(save-silently t))
|
|
||||||
(prog1 ,@forms (message ""))))))
|
|
||||||
|
|
||||||
|
|
||||||
;;
|
|
||||||
;;; Definers
|
;;; Definers
|
||||||
|
|
||||||
(defmacro defadvice! (symbol arglist &optional docstring &rest body)
|
(defmacro defadvice! (symbol arglist &optional docstring &rest body)
|
||||||
"Define an advice called SYMBOL and add it to PLACES.
|
"Define an advice called SYMBOL and add it to PLACES.
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue