awesome-emacs/doomemacs
1
0
Fork 0
mirror of https://github.com/doomemacs/doomemacs synced 2025-08-01 12:17:25 -05:00
Code Issues Packages Projects Releases Wiki Activity

refactor!: restructure Doom core

Browse Source 
BREAKING CHANGE: This restructures Doom's core in an effort to slim it
down and partially mirror architectural changes coming in v3. This is
part 2 of 3 commits (part 1 being 1590434), done to facilitate a change
in part 3 that will introduce a new `doom!` syntax for pulling
third-party module libraries from remote sources (similar to `package!`
statements). I am backporting this from V3 so I can move our modules out
into separate repos sooner than later, so development on modules can
continue separately without interfering with v3's roll out.

Though this is labeled a breaking change, it shouldn't affect most users
except those few tinkering directly with Doom's internals.

Ref: 15904349cf
This commit is contained in:
Henrik Lissner
2024-10-26 17:22:13 -04:00
parent 97c0dcc2c3
commit 8cafbe4408
20 changed files with 4432 additions and 4197 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
bin/doom
View File

@ -297,7 +297,7 @@ SEE ALSO:
(let ((cli-file "cli.el"))
(defcli-group! "Module commands"
(with-doom-context 'modules
(with-doom-context 'module
(dolist (key (doom-module-list))
(when-let (path (doom-module-locate-path key cli-file))
(defcli-group! :prefix (if (cdr key) (format "+%s" (cdr key)))

6
early-init.el
View File

@ -133,8 +133,10 @@
;; fit guess. It's better than Emacs' 80kb default.
(setq gc-cons-threshold (* 16 1024 1024))
nil))
;; ...Otherwise, we're loading a Doom config, so continue as normal.
(doom-require (if noninteractive 'doom-cli 'doom-start))
;; In non-interactive sessions, leave to the consumer to call
;; `doom-initialize' at the best time, otherwise we need to initialize
;; ASAP for the Emacs session ahead.
(doom-initialize (not noninteractive))
;; If we're here, the user wants to load another config/profile (that may or
;; may not be a Doom config).
(load user-init-file 'noerror (not init-file-debug) nil 'must-suffix)))

2
lisp/cli/doctor.el
View File

@ -328,7 +328,7 @@ in."
(packages-file (doom-module-expand-path (cons group name) doom-module-packages-file)))
(when packages-file
(cl-loop with doom-output-indent = 6
for name in (with-doom-context 'packages
for name in (with-doom-context 'package
(let* (doom-packages
doom-disabled-packages)
(load packages-file 'noerror 'nomessage)

9
lisp/cli/packages.el
View File

@ -277,8 +277,8 @@ remains lean."
(straight--packages-to-rebuild
(or (if force-p :all straight--packages-to-rebuild)
(make-hash-table :test #'equal)))
(recipes (doom-package-recipe-list))
(pinned (doom-package-pinned-list)))
(recipes (doom-package-recipe-alist))
(pinned (doom-package-pinned-alist)))
(add-hook 'native-comp-async-cu-done-functions #'doom-packages--native-compile-done-h)
(straight--make-build-cache-available)
(if-let (built
@ -374,8 +374,8 @@ remains lean."
(doom-initialize-packages)
(doom-packages--barf-if-incomplete)
(let* ((repo-dir (straight--repos-dir))
(pinned (doom-package-pinned-list))
(recipes (doom-package-recipe-list))
(pinned (doom-package-pinned-alist))
(recipes (doom-package-recipe-alist))
(packages-to-rebuild (make-hash-table :test 'equal))
(repos-to-rebuild (make-hash-table :test 'equal))
(total (length recipes))
@ -585,7 +585,6 @@ remains lean."
(delq nil (mapcar #'doom-packages--purge-repo repos))))))
(defun doom-packages--purge-elpa ()
(require 'doom-packages)
(let ((dirs (doom-files-in package-user-dir :type t :depth 0)))
(if (not dirs)
(prog1 0

8
lisp/cli/profiles.el
View File

@ -69,15 +69,9 @@
(dolist (p removed) (print! (item "Removed %S") (car p)))
(dolist (p changed) (print! (item "Changed %S") (car p)))
(doom-file-write doom-cli-known-profiles-file (list new-profiles) :mode #o600)
(doom-profiles-save new-profiles load-file)
(doom-profiles-write-load-file new-profiles load-file)
(print! (success "Regenerated profile loader: %s")
(path load-file)))))))))
;;
;;; Helpers
(provide 'doom-cli-profiles)
;;; profiles.el ends here

2352
lisp/doom-cli-lib.el
View File

File diff suppressed because it is too large Load Diff

2397
lisp/doom-cli.el
View File

File diff suppressed because it is too large Load Diff

12
lisp/doom-elpaca.el Normal file
View File

@ -0,0 +1,12 @@
;;; lisp/doom-elpaca.el -*- lexical-binding: t; -*-
;;; Commentary:
;;
;; In the near future, Doom will replace Straight with Elpaca. Its configuration
;; will live here.
;;
;;; Code:
;; TODO
(provide 'doom-elpaca)
;;; doom-elpaca.el ends here.

705
lisp/doom-lib.el
View File

@ -182,7 +182,8 @@ at the values with which this function was called."
(defun doom-load (path &optional noerror)
"Load PATH and handle any Doom errors that arise from it.
If NOERROR, don't throw an error if PATH doesn't exist."
If NOERROR, don't throw an error if PATH doesn't exist.
Return non-nil if loading the file succeeds."
(doom-log "load: %s %s" (abbreviate-file-name path) noerror)
(condition-case-unless-debug e
(load path noerror 'nomessage)
@ -283,7 +284,7 @@ TRIGGER-HOOK is a list of quoted hooks and/or sharp-quoted functions."
fn (lambda (&rest _)
;; Only trigger this after Emacs has initialized.
(when (and (not running?)
(not (doom-context-p 'init))
(not (doom-context-p 'startup))
(or (daemonp)
;; In some cases, hooks may be lexically unset to
;; inhibit them during expensive batch operations on
@ -412,23 +413,35 @@ The def* forms accepted are:
(setq type (list 'symbol-function type)))
(list 'cl-letf (list (cons type rest)) body)))))))
(defmacro quiet!! (&rest forms)
"Run FORMS without generating any output (for real).
Unlike `quiet!', which will only suppress output in the echo area in interactive
sessions, this truly suppress all output from FORMS."
(declare (indent 0))
`(if init-file-debug
(progn ,@forms)
(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)))
(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*."
(declare (indent 0))
`(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)
`(quiet!! ,@forms)
`(let ((inhibit-message t)
(save-silently t))
(prog1 ,@forms (message ""))))))
@ -1059,5 +1072,677 @@ and return the value found in PLACE instead."
(defbackport! defalias 'bol #'line-beginning-position)
(defbackport! defalias 'eol #'line-end-position)
;;; Types
(cl-defstruct doom-module
"TODO"
(index 0 :read-only t)
;; source
group
name
depth
flags
features
;; sources
path
;; disabled-p
;; frozen-p
;; layer-p
;; recipe
;; alist
;; package
;; if
)
(cl-defstruct doom-module-context
"Hot cache object for the containing Doom module."
index key path flags features)
;;; `doom-context'
(defvar doom-context '(t)
"A list of symbols identifying all active Doom execution contexts.
This should never be directly changed, only let-bound, and should never be
empty. Each context describes what phase Doom is in, and may respond to.
Use `with-doom-context' instead of let-binding or setting this variable
directly.
All valid contexts:
cli -- executing a Doom CLI or doomscript
emacs -- in an interactive doom session
module -- loading any modules' elisp files
Universal sub-contexts:
compile -- byte-compiling elisp
startup -- while doom is starting up, before any user config
error -- while Doom is in an error state
`emacs' sub-contexts:
docs -- while rendering docs in `doom-docs-mode'
reload -- while reloading doom with `doom/reload'
sandbox -- this session was launched from Doom's sandbox
eval -- while interactively evaluating elisp
`module' sub-contexts:
external -- loading packages or modules outside of $EMACSDIR or $DOOMDIR
config -- loading a module's config.el or cli.el
doctor -- loading a module's doctor.el
init -- loading a module's init.el
package -- loading a module's packages.el or managing packages
source -- while initializing a module source
test -- preparing for or running Doom's unit tests
`cli' sub-contexts:
run -- running a CLI command")
(put 'doom-context 'valid
'(compile error startup emacs docs reload sandbox eval module external
config doctor init package test cli run))
(put 'doom-context 'risky-local-variable t)
(defun doom-context-p (contexts)
"Return t if all CONTEXTS are active, nil otherwise.
See `doom-context' for possible values for CONTEXT."
(declare (side-effect-free t))
(catch 'result
(let (result)
(dolist (context (ensure-list contexts) result)
(if (memq context doom-context)
(push context result)
(throw 'result nil))))))
(defun doom-context-valid-p (context)
"Return non-nil if CONTEXT is a valid `doom-context'."
(declare (pure t) (side-effect-free error-free))
(memq context (get 'doom-context 'valid)))
(defun doom-context-push (contexts)
"Add CONTEXTS to `doom-context', if not present.
Return list of successfully added contexts. Throws a `doom-context-error' if
CONTEXTS contains invalid contexts."
(let ((contexts (ensure-list contexts)))
(if (cl-loop for context in contexts
unless (doom-context-valid-p context)
return t)
(doom-context-error
(cl-remove-if #'doom-context-valid-p contexts)
"Unrecognized context")
(let (added)
(dolist (context contexts)
(unless (memq context doom-context)
(push context added)))
(when added
(setq doom-context (nconc added doom-context))
(doom-log 3 ":context: +%s %s" added doom-context)
added)))))
(defun doom-context-pop (contexts)
"Remove CONTEXTS from `doom-context'.
Return list of removed contexts if successful. Throws `doom-context-error' if
one of CONTEXTS isn't active."
(if (not (doom-context-p contexts))
(doom-context-error
doom-context "Attempt to pop missing context"
contexts)
(let ((current-context (copy-sequence doom-context))
removed)
(dolist (context (ensure-list contexts))
(setq current-context (delq context current-context))
(push context removed))
(when removed
(setq doom-context current-context)
(doom-log 3 ":context: +%s %s" removed doom-context)
removed))))
(defmacro with-doom-context (contexts &rest body)
"Evaluate BODY with CONTEXTS added to `doom-context'."
(declare (indent 1))
`(let ((doom-context doom-context))
(doom-context-push ,contexts)
,@body))
;;; `doom-module-context'
(defvar doom-module-context (make-doom-module-context)
"A `doom-module-context' for the module associated with the current file.
Never set this variable directly, use `with-doom-module'.")
(defmacro with-doom-module (key &rest body)
"Evaluate BODY with `doom-module-context' informed by KEY."
(declare (indent 1))
`(let ((doom-module-context (doom-module-context ,key)))
(doom-log ":context:module: =%s" doom-module-context)
,@body))
(defun doom-module-context (key)
"Return a `doom-module-context' from KEY.
KEY can be a `doom-module-context', `doom-module', or a `doom-module-key' cons
cell."
(declare (side-effect-free t))
(or (pcase (type-of key)
(`doom-module-context key)
(`doom-module (ignore-errors (doom-module->context key)))
(`cons (doom-module (car key) (cdr key))))
(make-doom-module-context :key (doom-module-key key))))
(defun doom-module<-context (context)
"Return a `doom-module' plist from CONTEXT."
(declare (side-effect-free t))
(doom-module-get (doom-module-context-key context)))
(defun doom-module->context (key)
"Change a `doom-module' into a `doom-module-context'."
(declare (side-effect-free t))
(pcase-let
(((doom-module index path flags group name)
(if (doom-module-p key)
key (doom-module-get (doom-module-key key)))))
(make-doom-module-context
:index index
:key (cons group name)
:path path
:flags flags)))
(defun doom-module (group name &optional property)
"Return the `doom-module-context' for any active module by GROUP NAME.
Return its PROPERTY, if specified."
(declare (side-effect-free t))
(when-let ((context (get group name)))
(if property
(aref
context
(or (plist-get
(eval-when-compile
(cl-loop with i = 1
for info in (cdr (cl-struct-slot-info 'doom-module-context))
nconc (list (doom-keyword-intern (symbol-name (car info)))
(prog1 i (cl-incf i)))))
property)
(error "Unknown doom-module-context property: %s" property)))
context)))
;;; `doom-module'
(defun doom-module-key (key)
"Normalize KEY into a (GROUP . MODULE) tuple representing a Doom module key."
(declare (pure t) (side-effect-free t))
(cond ((doom-module-p key)
(cons (doom-module-group key) (doom-module-name key)))
((doom-module-context-p key)
(doom-module-context-key key))
((car-safe key)
(if (nlistp (cdr-safe key))
key
(cons (car key) (cadr key))))
((error "Invalid key: %S" key))))
(defun doom-module--has-flag-p (flags wanted-flags)
"Return t if the list of WANTED-FLAGS satisfies the list of FLAGS."
(declare (pure t) (side-effect-free error-free))
(cl-loop with flags = (ensure-list flags)
for flag in (ensure-list wanted-flags)
for flagstr = (symbol-name flag)
if (if (eq ?- (aref flagstr 0))
(memq (intern (concat "+" (substring flagstr 1)))
flags)
(not (memq flag flags)))
return nil
finally return t))
(defun doom-module--fold-flags (flags)
"Returns a collapsed list of FLAGS (a list of +/- prefixed symbols).
FLAGS is read in sequence, cancelling out negated flags and removing
duplicates."
(declare (pure t) (side-effect-free error-free))
(let (newflags)
(while flags
(let* ((flag (car flags))
(flagstr (symbol-name flag)))
(when-let ((sym (intern-soft
(concat (if (eq ?- (aref flagstr 0)) "+" "-")
(substring flagstr 1)))))
(setq newflags (delq sym newflags)))
(cl-pushnew flag newflags :test 'eq))
(setq flags (cdr flags)))
(nreverse newflags)))
(defun doom-module-get (key &optional property)
"Returns the plist for GROUP MODULE. Gets PROPERTY, specifically, if set."
(declare (side-effect-free t))
(when-let ((m (gethash key doom-modules)))
(if property
(aref
m (or (plist-get
(eval-when-compile
(cl-loop with i = 1
for info in (cdr (cl-struct-slot-info 'doom-module))
nconc (list (doom-keyword-intern (symbol-name (car info)))
(prog1 i (cl-incf i)))))
property)
(error "Unknown doom-module property: %s" property)))
m)))
(defun doom-module-active-p (group module &optional flags)
"Return t if GROUP MODULE is active, and with FLAGS (if given)."
(declare (side-effect-free t))
(when-let ((val (doom-module-get (cons group module) (if flags :flags))))
(or (null flags)
(doom-module--has-flag-p flags val))))
(defun doom-module-exists-p (group module)
"Returns t if GROUP MODULE is present in any active source."
(declare (side-effect-free t))
(if (doom-module-get group module) t))
(cl-defun doom-module--depth< (keya keyb &optional initorder?)
"Return t if module with KEY-A comes before another with KEY-B.
If INITORDER? is non-nil, grab the car of the module's :depth, rather than it's
cdr. See `doom-module-put' for details about the :depth property."
(declare (pure t) (side-effect-free t))
(let* ((adepth (doom-module-get keya :depth))
(bdepth (doom-module-get keyb :depth))
(adepth (if initorder? (car adepth) (cdr adepth)))
(bdepth (if initorder? (car bdepth) (cdr bdepth))))
(if (or (null adepth) (null bdepth)
(= adepth bdepth))
(< (or (doom-module-get keya :index) 0)
(or (doom-module-get keyb :index) 0))
(< adepth bdepth))))
(defun doom-module-list (&optional paths-or-all initorder?)
"Return a list of (:group . name) module keys in order of their :depth.
PATHS-OR-ALL can either be a non-nil value or a list of directories. If given a
list of directories, return a list of module keys for all modules present
underneath it. If non-nil, return the same, but search `doom-module-load-path'
(includes :doom and :user). Modules that are enabled are sorted first by their
:depth, followed by disabled modules in lexicographical order (unless a :depth
is specified in their .doommodule).
If INITORDER? is non-nil, sort modules by the CAR of that module's :depth."
(sort (if paths-or-all
(delete-dups
(append (seq-remove #'cdr (doom-module-list nil initorder?))
(doom-files-in (if (listp paths-or-all)
paths-or-all
doom-module-load-path)
:map #'doom-module-from-path
:type 'dirs
:mindepth 1
:depth 1)))
(hash-table-keys doom-modules))
(doom-rpartial #'doom-module--depth< initorder?)))
(defun doom-module-expand-path (key &optional file)
"Expands a path to FILE relative to KEY, a cons cell: (GROUP . NAME)
GROUP is a keyword. MODULE is a symbol. FILE is an optional string path.
If the group isn't enabled this returns nil. For finding disabled modules use
`doom-module-locate-path' instead."
(when-let ((path (doom-module-get key :path)))
(if file
(file-name-concat path file)
path)))
(defun doom-module-locate-path (key &optional file)
"Searches `doom-module-load-path' to find the path to a module by KEY.
KEY is a cons cell (GROUP . NAME), where GROUP is a keyword (e.g. :lang) and
NAME is a symbol (e.g. \\='python). FILE is a string that will be appended to
the resulting path. If said path doesn't exist, this returns nil, otherwise an
absolute path."
(let (file-name-handler-alist)
(if-let ((path (doom-module-expand-path key file)))
(if (or (null file)
(file-exists-p path))
path)
(cl-destructuring-bind (group . module) (doom-module-key key)
(let* ((group (doom-keyword-name group))
(module (if module (symbol-name module)))
(path (file-name-concat group module file)))
(if file
;; PERF: locate-file-internal is a little faster for finding files,
;; but its interface for finding directories is clumsy.
(locate-file-internal path doom-module-load-path '("" ".elc" ".el"))
(cl-loop for default-directory in doom-module-load-path
if (file-exists-p path)
return (expand-file-name path))))))))
(defun doom-module-locate-paths (module-list file)
"Return all existing paths to FILE under each module in MODULE-LIST.
MODULE-LIST is a list of cons cells (GROUP . NAME). See `doom-module-list' for
an example."
(cl-loop for key in (or module-list (doom-module-list))
if (doom-module-locate-path key file)
collect it))
(defun doom-module-from-path (path &optional enabled-only?)
"Returns a cons cell (GROUP . NAME) derived from PATH (a file path).
If ENABLED-ONLY?, return nil if the containing module isn't enabled."
(let* ((file-name-handler-alist nil)
(path (expand-file-name path)))
(save-match-data
(cond ((string-match "/modules/\\([^/]+\\)/\\([^/]+\\)\\(?:/.*\\)?$" path)
(when-let* ((group (doom-keyword-intern (match-string 1 path)))
(name (intern (match-string 2 path))))
(and (or (null enabled-only?)
(doom-module-active-p group name))
(cons group name))))
((file-in-directory-p path doom-core-dir)
(cons :doom nil))
((file-in-directory-p path doom-user-dir)
(cons :user nil))))))
(defun doom-module-load-path (&optional module-load-path)
"Return a list of file paths to activated modules.
The list is in no particular order and its file paths are absolute. If
MODULE-DIRS is non-nil, include all modules (even disabled ones) available in
those directories."
(declare (pure t) (side-effect-free t))
(mapcar #'doom-module-locate-path
(doom-module-list (or module-load-path doom-module-load-path))))
(put :if 'lisp-indent-function 2)
(put :when 'lisp-indent-function 'defun)
(put :unless 'lisp-indent-function 'defun)
(defmacro doom! (&rest modules)
"Bootstraps DOOM Emacs and its modules.
If the first item in MODULES doesn't satisfy `keywordp', MODULES is evaluated,
otherwise, MODULES is a variadic-property list (a plist whose key may be
followed by one or more values).
This macro does nothing in interactive sessions, but in noninteractive session
iterates through MODULES, enabling and initializing them. The order of modules
in these blocks dictates their load order (unless given an explicit :depth)."
`(when noninteractive
;; REVIEW: A temporary fix for flycheck until I complete backporting
;; module/profile architecture from v3.0.
(when (fboundp 'doom-module-mplist-map)
(doom-module-mplist-map
#'doom-module--put
,@(if (keywordp (car modules))
(list (list 'quote modules))
modules)))
t))
;; DEPRECATED Remove in 3.0
(define-obsolete-function-alias 'featurep! 'modulep! "3.0.0")
(defmacro modulep! (group &optional module &rest flags)
"Return t if :GROUP MODULE (and +FLAGS) are enabled.
If FLAGS is provided, returns t if GROUP MODULE has all of FLAGS enabled.
(modulep! :config default +flag)
(modulep! :config default +flag1 +flag2 +flag3)
GROUP and MODULE may be omitted when this macro is used from a Doom module's
source (except your $DOOMDIR, which is a special module). Like so:
(modulep! +flag3 +flag1 +flag2)
(modulep! +flag)
FLAGS can be negated. E.g. This will return non-nil if ':tools lsp' is enabled
without `+eglot':
(modulep! :tools lsp -eglot)
To interpolate dynamic values, use comma:
(let ((flag '-eglot))
(modulep! :tools lsp ,flag))
For more about modules and flags, see `doom!'."
(if (keywordp group)
(if flags
`(doom-module--has-flag-p
(doom-module (backquote ,group) (backquote ,module) :flags)
(backquote ,flags))
`(and (get (backquote ,group) (backquote ,module)) t))
(let ((flags (delq nil (cons group (cons module flags)))))
(if (doom-module-context-index doom-module-context)
`(doom-module--has-flag-p
',(doom-module-context-flags doom-module-context)
(backquote ,flags))
`(let ((file (file!)))
(if-let ((module (doom-module-from-path file)))
(doom-module--has-flag-p
(doom-module (car module) (cdr module) :flags)
(backquote ,flags))
(error "(modulep! %s) couldn't resolve current module from %s"
(backquote ,flags) (abbreviate-file-name file))))))))
;;; `doom-package'
(cl-defmacro package!
(name &rest plist &key built-in recipe ignore _type _pin _disable)
"Declares a package and how to install it (if applicable).
This macro is declarative and does not load nor install packages. It is used to
populate `doom-packages' with metadata about the packages Doom needs to keep
track of.
Only use this macro in a module's packages.el file.
Accepts the following properties:
:type core|local|built-in|virtual
Specifies what kind of package this is. Can be a symbol or a list thereof.
`core' = this is a protected package and cannot be disabled!
`local' = this package is being modified in-place. This package's repo is
unshallowed and will be skipped when you update packages.
`built-in' = this package is already built-in (otherwise, will be
installed)
`virtual' = this package is not tracked by Doom's package manager. It won't
be installed or uninstalled. Use this to pin 2nd order dependencies.
:recipe RECIPE
Specifies a straight.el recipe to allow you to acquire packages from external
sources. See https://github.com/radian-software/straight.el#the-recipe-format
for details on this recipe.
:disable BOOL
Do not install or update this package AND disable all of its `use-package!'
and `after!' blocks.
:ignore FORM
Do not install this package.
:pin STR|nil
Pin this package to commit hash STR. Setting this to nil will unpin this
package if previously pinned.
:built-in BOOL|'prefer
Same as :ignore if the package is a built-in Emacs package. This is more to
inform help commands like `doom/help-packages' that this is a built-in
package. If set to 'prefer, the package will not be installed if it is
already provided by Emacs.
Returns t if package is successfully registered, and nil if it was disabled
elsewhere."
(declare (indent defun))
(when (and recipe (keywordp (car-safe recipe)))
(cl-callf plist-put plist :recipe `(quote ,recipe)))
;; :built-in t is basically an alias for :ignore (locate-library NAME)
(when built-in
(when (and (not ignore)
(equal built-in '(quote prefer)))
(setq built-in `(locate-library ,(symbol-name name) nil (get 'load-path 'initial-value))))
(cl-callf map-delete plist :built-in)
(cl-callf plist-put plist :ignore built-in))
`(let* ((name ',name)
(plist (cdr (assq name doom-packages)))
(dir (dir!))
(module (doom-module-from-path dir)))
(unless (doom-context-p 'package)
(signal 'doom-module-error
(list module "package! can only be used in packages.el files")))
;; Record what module this declaration was found in
(let ((module-list (plist-get plist :modules)))
(unless (member module module-list)
(cl-callf plist-put plist :modules
(append module-list
(list module)
(when (file-in-directory-p dir doom-user-dir)
'((:user . modules)))
nil))))
;; Merge given plist with pre-existing one
(cl-loop for (key value) on (list ,@plist) by 'cddr
when (or (eq key :pin) value)
do (cl-callf plist-put plist key value))
;; Some basic key validation; throws an error on invalid properties
(condition-case e
(when-let (recipe (plist-get plist :recipe))
(cl-destructuring-bind
(&key local-repo _files _flavor _build _pre-build _post-build
_includes _type _repo _host _branch _protocol _remote
_nonrecursive _fork _depth _source _inherit)
recipe
;; Expand :local-repo from current directory
(when local-repo
(cl-callf plist-put plist :recipe
(plist-put recipe :local-repo
(let ((local-path (expand-file-name local-repo dir)))
(if (file-directory-p local-path)
local-path
local-repo)))))))
(error
(signal 'doom-package-error
(cons ,(symbol-name name)
(error-message-string e)))))
;; These are the only side-effects of this macro!
(setf (alist-get name doom-packages) plist)
(if (plist-get plist :disable)
(add-to-list 'doom-disabled-packages name)
(with-no-warnings
(cons name plist)))))
;; DEPRECATED: Will be replaced with new `packages!' macro in v3.0
(defmacro disable-packages! (&rest packages)
"A convenience macro for disabling packages in bulk.
Only use this macro in a module's (or your private) packages.el file."
(macroexp-progn
(mapcar (lambda (p) `(package! ,p :disable t))
packages)))
;; DEPRECATED: Will be replaced with new `packages!' macro in v3.0
(defmacro unpin! (&rest targets)
"Unpin packages in TARGETS.
This unpins packages, so that `doom upgrade' or `doom sync -u' will update them
to the latest commit available. Some examples:
- To disable pinning wholesale: (unpin! t)
- To unpin individual packages: (unpin! packageA packageB ...)
- To unpin all packages in a group of modules: (unpin! :lang :tools ...)
- To unpin packages in individual modules:
(unpin! (:lang python javascript) (:tools docker))
Or any combination of the above.
This macro should only be used from the user's private packages.el. No module
should use it!"
(if (memq t targets)
`(mapc (doom-rpartial #'doom-package-set :unpin t)
(mapcar #'car doom-packages))
(macroexp-progn
(mapcar
(lambda (target)
(when target
`(doom-package-set ',target :unpin t)))
(cl-loop for target in targets
if (or (keywordp target) (listp target))
append
(cl-loop with (category . modules) = (ensure-list target)
for (name . plist) in doom-packages
for pkg-modules = (plist-get plist :modules)
if (and (assq category pkg-modules)
(or (null modules)
(cl-loop for module in modules
if (member (cons category module) pkg-modules)
return t))
name)
collect it)
else if (symbolp target)
collect target)))))
;;; `doom-profile'
(defun doom-profile-key (profile &optional default?)
"Normalize PROFILE into a (NAME . REF) doom-profile key.
PROFILE can be a `doom-profile', a profile id (i.e. a string in the NAME@REF
format), or a (NAME . REF) cons cell.
If DEFAULT? is non-nil, an unspecified CAR/CDR will fall bakc to (_default .
0)."
(declare (pure t) (side-effect-free t))
(let ((default-name (if default? "_default"))
(default-ref (if default? "0")))
(cond ((eq profile t) (cons default-name default-ref))
;; ((doom-profile-p profile)
;; (cons (or (doom-profile-name profile) default-name)
;; (or (doom-profile-ref profile) default-ref)))
((stringp profile)
(save-match-data
(let (case-fold-search)
(if (string-match "^\\([^@]+\\)@\\(.+\\)$" profile)
(cons (match-string 1 profile)
(match-string 2 profile))
(cons profile default-ref)))))
((and (consp profile) (nlistp (cdr profile)))
(cons (or (car profile) default-name)
(or (cdr profile) default-ref)))
((and (null profile) default?)
(cons default-name default-ref))
((signal 'wrong-type-argument
(list "Expected PROFILE to be a string, cons cell, or `doom-profile'"
(type-of profile) profile))))))
(defun doom-profile-init-file (profile &optional el?)
"Return the init file for PROFILE."
(declare (side-effect-free t))
(cl-destructuring-bind (name . ref)
(if profile
(doom-profile-key profile t)
(cons nil nil))
(file-name-concat doom-data-dir name "@" ref
(format "init.%d.%d.%s"
emacs-major-version
emacs-minor-version
(if el? "el" "elc")))))
(defun doom-profile-get (profile-name &optional property null-value)
"Return PROFILE-NAME's PROFILE, otherwise its PROPERTY, otherwise NULL-VALUE."
(when (stringp profile-name)
(setq profile-name (intern profile-name)))
(if-let (profile (assq profile-name (doom-profiles)))
(if property
(if-let (propval (assq property (cdr profile)))
(cdr propval)
null-value)
profile)
null-value))
(defun doom-profile->id (profile)
"Return a NAME@VERSION id string from profile cons cell (NAME . VERSION)."
(cl-check-type profile cons)
(cl-destructuring-bind (name . ref) (doom-profile-key profile)
(format "%s@%s" name ref)))
(provide 'doom-lib)
;;; doom-lib.el ends here

608
lisp/doom-modules.el
View File

@ -1,608 +0,0 @@
;;; doom-modules.el --- module & package management system -*- lexical-binding: t; -*-
;;; Commentary:
;;; Code:
;;
;;; Variables
(defvar doom-modules nil
"A table of enabled modules and metadata. See `doom-modules-initialize'.")
(define-obsolete-variable-alias 'doom-modules-dirs 'doom-module-load-path "3.0.0")
(defvar doom-module-load-path
(list (file-name-concat doom-user-dir "modules")
(file-name-concat doom-emacs-dir "modules"))
"A list of paths where Doom should search for modules.
Order determines priority (from highest to lowest).
Each entry is a string; an absolute path to the root directory of a module tree.
In other words, they should contain a two-level nested directory structure,
where the module's group and name was deduced from the first and second level of
directories. For example: if $DOOMDIR/modules/ is an entry, a
$DOOMDIR/modules/lang/ruby/ directory represents a ':lang ruby' module.")
;;; Module file variables
(defvar doom-module-init-file "init.el"
"The filename for module early initialization config files.
Init files are loaded early, just after Doom core, and before modules' config
files. They are always loaded, even in non-interactive sessions, and before
`doom-before-modules-init-hook'. Related to `doom-module-config-file'.")
(defvar doom-module-config-file "config.el"
"The filename for module configuration files.
Config files are loaded later, and almost always in interactive sessions. These
run before `doom-after-modules-config-hook' and after `doom-module-init-file'.")
(defvar doom-module-packages-file "packages.el"
"The filename for the package configuration file.
Package files are read whenever Doom's package manager wants a manifest of all
desired packages. They are rarely read in interactive sessions (unless the user
uses a straight or package.el command directly).")
(defvar doom-module-metadata-file ".doommodule"
"The filename for a module's metadata file.
NOT IMPLEMENTED YET. This file contains a module's metadata: their version,
maintainers, checks, features, submodules, debug information, etc. And are used
to locate modules in the user's file tree.")
;; DEPRECATED: Remove in v3, as it will be handled in the CLI
(make-obsolete-variable 'doom-obsolete-modules nil "3.0.0")
(defconst doom-obsolete-modules
'((:feature (version-control (:emacs vc) (:ui vc-gutter))
(spellcheck (:checkers spell))
(syntax-checker (:checkers syntax))
(evil (:editor evil))
(snippets (:editor snippets))
(file-templates (:editor file-templates))
(workspaces (:ui workspaces))
(eval (:tools eval))
(lookup (:tools lookup))
(debugger (:tools debugger)))
(:tools (rotate-text (:editor rotate-text))
(vterm (:term vterm))
(password-store (:tools pass))
(flycheck (:checkers syntax))
(flyspell (:checkers spell))
(macos (:os macos)))
(:emacs (electric-indent (:emacs electric))
(hideshow (:editor fold))
(eshell (:term eshell))
(term (:term term)))
(:ui (doom-modeline (:ui modeline))
(fci (:ui fill-column))
(evil-goggles (:ui ophints))
(tabbar (:ui tabs))
(pretty-code (:ui ligatures)))
(:app (email (:email mu4e))
(notmuch (:email notmuch)))
(:lang (perl (:lang raku))))
"A tree alist that maps deprecated modules to their replacement(s).
Each entry is a three-level tree. For example:
(:feature (version-control (:emacs vc) (:ui vc-gutter))
(spellcheck (:checkers spell))
(syntax-checker (:tools flycheck)))
This marks :feature version-control, :feature spellcheck and :feature
syntax-checker modules obsolete. e.g. If :feature version-control is found in
your `doom!' block, a warning is emitted before replacing it with :emacs vc and
:ui vc-gutter.")
(make-obsolete-variable 'doom-inhibit-module-warnings nil "3.0.0")
(defvar doom-inhibit-module-warnings (not noninteractive)
"If non-nil, don't emit deprecated or missing module warnings at startup.")
;;; Custom hooks
(defcustom doom-before-modules-init-hook nil
"Hooks run before module init.el files are loaded."
:group 'doom
:type 'hook)
(defcustom doom-after-modules-init-hook nil
"Hooks run after module init.el files are loaded."
:group 'doom
:type 'hook)
(defcustom doom-before-modules-config-hook nil
"Hooks run before module config.el files are loaded."
:group 'doom
:type 'hook)
(defcustom doom-after-modules-config-hook nil
"Hooks run after module config.el files are loaded (but before the user's)."
:group 'doom
:type 'hook)
;;
;;; Types
(cl-defstruct doom-module
"TODO"
(index 0 :read-only t)
;; source
group
name
depth
flags
features
;; sources
path
;; disabled-p
;; frozen-p
;; layer-p
;; recipe
;; alist
;; package
;; if
)
(cl-defstruct doom-module-context
"Hot cache object for the containing Doom module."
index key path flags features)
;;
;;; `doom-module-context'
(defvar doom-module-context (make-doom-module-context)
"A `doom-module-context' for the module associated with the current file.
Never set this variable directly, use `with-doom-module'.")
(defmacro with-doom-module (key &rest body)
"Evaluate BODY with `doom-module-context' informed by KEY."
(declare (indent 1))
`(let ((doom-module-context (doom-module-context ,key)))
(doom-log ":context:module: =%s" doom-module-context)
,@body))
(defun doom-module-context (key)
"Return a `doom-module-context' from KEY.
KEY can be a `doom-module-context', `doom-module', or a `doom-module-key' cons
cell."
(declare (side-effect-free t))
(or (pcase (type-of key)
(`doom-module-context key)
(`doom-module (ignore-errors (doom-module->context key)))
(`cons (doom-module (car key) (cdr key))))
(make-doom-module-context :key (doom-module-key key))))
(defun doom-module<-context (context)
"Return a `doom-module' plist from CONTEXT."
(declare (side-effect-free t))
(doom-module-get (doom-module-context-key context)))
(defun doom-module->context (key)
"Change a `doom-module' into a `doom-module-context'."
(declare (side-effect-free t))
(pcase-let
(((doom-module index path flags group name)
(if (doom-module-p key)
key (doom-module-get (doom-module-key key)))))
(make-doom-module-context
:index index
:key (cons group name)
:path path
:flags flags)))
(defun doom-module (group name &optional property)
"Return the `doom-module-context' for any active module by GROUP NAME.
Return its PROPERTY, if specified."
(declare (side-effect-free t))
(when-let ((context (get group name)))
(if property
(aref
context
(or (plist-get
(eval-when-compile
(cl-loop with i = 1
for info in (cdr (cl-struct-slot-info 'doom-module-context))
nconc (list (doom-keyword-intern (symbol-name (car info)))
(prog1 i (cl-incf i)))))
property)
(error "Unknown doom-module-context property: %s" property)))
context)))
;;
;;; Module API
(defun doom-modules-initialize (&optional force?)
"Initializes module metadata."
(when (or (null doom-modules) force?)
(setq doom-modules (make-hash-table :test 'equal))
;; Register Doom's two virtual module categories, representing Doom's core
;; and the user's config; which are always enabled.
(doom-module--put '(:doom . nil) :path doom-core-dir :depth -110)
(doom-module--put '(:user . nil) :path doom-user-dir :depth '(-105 . 105))
;; DEPRECATED: I intend to phase out our internal usage of `use-package' and
;; move it to a :config use-package module. The macro is far too complex
;; and magical for our needs, but until this move is done, ':config
;; use-package' will remain a hardcoded module for backwards
;; compatibility.
(doom-module--put '(:config . use-package)
:path (doom-module-locate-path '(:config . use-package))
:depth -111)
;; Load $DOOMDIR/init.el, where the user's `doom!' lives, which will inform
;; us of all desired modules.
(doom-load (file-name-concat doom-user-dir doom-module-init-file)
'noerror)))
(defun doom-module-key (key)
"Normalize KEY into a (GROUP . MODULE) tuple representing a Doom module key."
(declare (pure t) (side-effect-free t))
(cond ((doom-module-p key)
(cons (doom-module-group key) (doom-module-name key)))
((doom-module-context-p key)
(doom-module-context-key key))
((car-safe key)
(if (nlistp (cdr-safe key))
key
(cons (car key) (cadr key))))
((error "Invalid key: %S" key))))
(defun doom-module--has-flag-p (flags wanted-flags)
"Return t if the list of WANTED-FLAGS satisfies the list of FLAGS."
(declare (pure t) (side-effect-free error-free))
(cl-loop with flags = (ensure-list flags)
for flag in (ensure-list wanted-flags)
for flagstr = (symbol-name flag)
if (if (eq ?- (aref flagstr 0))
(memq (intern (concat "+" (substring flagstr 1)))
flags)
(not (memq flag flags)))
return nil
finally return t))
(defun doom-module--fold-flags (flags)
"Returns a collapsed list of FLAGS (a list of +/- prefixed symbols).
FLAGS is read in sequence, cancelling out negated flags and removing
duplicates."
(declare (pure t) (side-effect-free error-free))
(let (newflags)
(while flags
(let* ((flag (car flags))
(flagstr (symbol-name flag)))
(when-let ((sym (intern-soft
(concat (if (eq ?- (aref flagstr 0)) "+" "-")
(substring flagstr 1)))))
(setq newflags (delq sym newflags)))
(cl-pushnew flag newflags :test 'eq))
(setq flags (cdr flags)))
(nreverse newflags)))
(defun doom-module-get (key &optional property)
"Returns the plist for GROUP MODULE. Gets PROPERTY, specifically, if set."
(declare (side-effect-free t))
(when-let ((m (gethash key doom-modules)))
(if property
(aref
m (or (plist-get
(eval-when-compile
(cl-loop with i = 1
for info in (cdr (cl-struct-slot-info 'doom-module))
nconc (list (doom-keyword-intern (symbol-name (car info)))
(prog1 i (cl-incf i)))))
property)
(error "Unknown doom-module property: %s" property)))
m)))
(cl-defun doom-module--put ((group . name) &rest plist)
"Enable GROUP NAME and associate PLIST with it.
This enables the target module, where GROUP is a keyword, NAME is a symbol, and
PLIST is a property list accepting none, any, or all of the following
properties:
:group KEYWORD
Indicating the group this module is in. This doesn't have to match GROUP, as
it could indicate a module alias.
:name SYMBOL
Indicating the name of this module. This doesn't have to match NAME, as it
could indicate a module alias.
:path STRING
Path to the directory where this module lives.
:depth INT|(INITDEPTH . CONFIGDEPTH)
Determines module load order. If a cons cell, INITDEPTH determines the load
order of the module's init.el, while CONFIGDEPTH determines the same for all
other config files (config.el, packages.el, doctor.el, etc).
:flags (SYMBOL...)
A list of activated flags for this module. Will be collapsed into
pre-existing flags for the module.
:features (SYMBOL...)
A list of active features, determined from the module's metadata. Will be
collapsed into any pre-existing features for the module. NOT IMPLEMENTED
YET.
\(fn (GROUP . NAME) &key GROUP NAME PATH DEPTH FLAGS FEATURES)"
(let ((module
(make-doom-module
:index (hash-table-count doom-modules)
:group (or (plist-get plist :group) group)
:name (or (plist-get plist :name) name)
:path (plist-get plist :path)
:flags (plist-get plist :flags)
:features () ; TODO
:depth
(if (not (plist-member plist :depth))
'(0 . 0)
(let ((depth (plist-get plist :depth)))
(cl-check-type depth (or integer cons))
(cond ((integerp depth) (cons depth depth))
((consp depth) (cons (or (car depth) 0)
(or (cdr depth) 0)))
((error "Invalid DEPTH value: %S" depth))))))))
(doom-log 2 "module-put: %s" module)
(prog1 (puthash (cons group name) module doom-modules)
;; PERF: Doom caches module index, flags, and features in symbol plists
;; for fast lookups in `modulep!' and elsewhere. plists are lighter and
;; faster than hash tables for datasets this size, and this information
;; is looked up *very* often.
(put group name (doom-module->context module)))))
(defun doom-module-active-p (group module &optional flags)
"Return t if GROUP MODULE is active, and with FLAGS (if given)."
(declare (side-effect-free t))
(when-let ((val (doom-module-get (cons group module) (if flags :flags))))
(or (null flags)
(doom-module--has-flag-p flags val))))
(defun doom-module-exists-p (group module)
"Returns t if GROUP MODULE is present in any active source."
(declare (side-effect-free t))
(if (doom-module-get group module) t))
(cl-defun doom-module--depth< (keya keyb &optional initorder?)
"Return t if module with KEY-A comes before another with KEY-B.
If INITORDER? is non-nil, grab the car of the module's :depth, rather than it's
cdr. See `doom-module-put' for details about the :depth property."
(declare (pure t) (side-effect-free t))
(let* ((adepth (doom-module-get keya :depth))
(bdepth (doom-module-get keyb :depth))
(adepth (if initorder? (car adepth) (cdr adepth)))
(bdepth (if initorder? (car bdepth) (cdr bdepth))))
(if (or (null adepth) (null bdepth)
(= adepth bdepth))
(< (or (doom-module-get keya :index) 0)
(or (doom-module-get keyb :index) 0))
(< adepth bdepth))))
(defun doom-module-list (&optional paths-or-all initorder?)
"Return a list of (:group . name) module keys in order of their :depth.
PATHS-OR-ALL can either be a non-nil value or a list of directories. If given a
list of directories, return a list of module keys for all modules present
underneath it. If non-nil, return the same, but search `doom-module-load-path'
(includes :doom and :user). Modules that are enabled are sorted first by their
:depth, followed by disabled modules in lexicographical order (unless a :depth
is specified in their .doommodule).
If INITORDER? is non-nil, sort modules by the CAR of that module's :depth."
(sort (if paths-or-all
(delete-dups
(append (seq-remove #'cdr (doom-module-list nil initorder?))
(doom-files-in (if (listp paths-or-all)
paths-or-all
doom-module-load-path)
:map #'doom-module-from-path
:type 'dirs
:mindepth 1
:depth 1)))
(hash-table-keys doom-modules))
(doom-rpartial #'doom-module--depth< initorder?)))
(defun doom-module-expand-path (key &optional file)
"Expands a path to FILE relative to KEY, a cons cell: (GROUP . NAME)
GROUP is a keyword. MODULE is a symbol. FILE is an optional string path.
If the group isn't enabled this returns nil. For finding disabled modules use
`doom-module-locate-path' instead."
(when-let ((path (doom-module-get key :path)))
(if file
(file-name-concat path file)
path)))
(defun doom-module-locate-path (key &optional file)
"Searches `doom-module-load-path' to find the path to a module by KEY.
KEY is a cons cell (GROUP . NAME), where GROUP is a keyword (e.g. :lang) and
NAME is a symbol (e.g. \\='python). FILE is a string that will be appended to
the resulting path. If said path doesn't exist, this returns nil, otherwise an
absolute path."
(let (file-name-handler-alist)
(if-let ((path (doom-module-expand-path key file)))
(if (or (null file)
(file-exists-p path))
path)
(cl-destructuring-bind (group . module) (doom-module-key key)
(let* ((group (doom-keyword-name group))
(module (if module (symbol-name module)))
(path (file-name-concat group module file)))
(if file
;; PERF: locate-file-internal is a little faster for finding files,
;; but its interface for finding directories is clumsy.
(locate-file-internal path doom-module-load-path '("" ".elc" ".el"))
(cl-loop for default-directory in doom-module-load-path
if (file-exists-p path)
return (expand-file-name path))))))))
(defun doom-module-locate-paths (module-list file)
"Return all existing paths to FILE under each module in MODULE-LIST.
MODULE-LIST is a list of cons cells (GROUP . NAME). See `doom-module-list' for
an example."
(cl-loop for key in (or module-list (doom-module-list))
if (doom-module-locate-path key file)
collect it))
(defun doom-module-from-path (path &optional enabled-only?)
"Returns a cons cell (GROUP . NAME) derived from PATH (a file path).
If ENABLED-ONLY?, return nil if the containing module isn't enabled."
(let* ((file-name-handler-alist nil)
(path (expand-file-name path)))
(save-match-data
(cond ((string-match "/modules/\\([^/]+\\)/\\([^/]+\\)\\(?:/.*\\)?$" path)
(when-let* ((group (doom-keyword-intern (match-string 1 path)))
(name (intern (match-string 2 path))))
(and (or (null enabled-only?)
(doom-module-active-p group name))
(cons group name))))
((file-in-directory-p path doom-core-dir)
(cons :doom nil))
((file-in-directory-p path doom-user-dir)
(cons :user nil))))))
(defun doom-module-load-path (&optional module-load-path)
"Return a list of file paths to activated modules.
The list is in no particular order and its file paths are absolute. If
MODULE-DIRS is non-nil, include all modules (even disabled ones) available in
those directories."
(declare (pure t) (side-effect-free t))
(mapcar #'doom-module-locate-path
(doom-module-list (or module-load-path doom-module-load-path))))
(defun doom-module-mplist-map (fn mplist)
"Apply FN to each module in MPLIST."
(let ((mplist (copy-sequence mplist))
(inhibit-message doom-inhibit-module-warnings)
obsolete
results
group m)
(while mplist
(setq m (pop mplist))
(cond ((keywordp m)
(setq group m
obsolete (assq m doom-obsolete-modules)))
((null group)
(error "No module group specified for %s" m))
((and (listp m) (keywordp (car m)))
(pcase (car m)
(:cond
(cl-loop for (cond . mods) in (cdr m)
if (eval cond t)
return (prependq! mplist mods)))
(:if (if (eval (cadr m) t)
(push (caddr m) mplist)
(prependq! mplist (cdddr m))))
(test (if (xor (eval (cadr m) t)
(eq test :unless))
(prependq! mplist (cddr m))))))
((catch 'doom-modules
(let* ((module (if (listp m) (car m) m))
(flags (if (listp m) (cdr m))))
(when-let (new (assq module obsolete))
(let ((newkeys (cdr new)))
(if (null newkeys)
(print! (warn "%s module was removed"))
(if (cdr newkeys)
(print! (warn "%s module was removed and split into the %s modules")
(list group module)
(mapconcat #'prin1-to-string newkeys ", "))
(print! (warn "%s module was moved to %s")
(list group module)
(car newkeys)))
(push group mplist)
(dolist (key newkeys)
(push (if flags
(nconc (cdr key) flags)
(cdr key))
mplist)
(push (car key) mplist))
(throw 'doom-modules t))))
(doom-log "module: %s %s %s -> %s" group module (or flags "")
(doom-module-locate-path (cons group module)))
(push (funcall fn (cons group module)
:flags (if (listp m) (cdr m))
:path (doom-module-locate-path (cons group module)))
results))))))
(when noninteractive
(setq doom-inhibit-module-warnings t))
(nreverse results)))
;;
;;; Module config macros
(put :if 'lisp-indent-function 2)
(put :when 'lisp-indent-function 'defun)
(put :unless 'lisp-indent-function 'defun)
(defmacro doom! (&rest modules)
"Bootstraps DOOM Emacs and its modules.
If the first item in MODULES doesn't satisfy `keywordp', MODULES is evaluated,
otherwise, MODULES is a variadic-property list (a plist whose key may be
followed by one or more values).
This macro does nothing in interactive sessions, but in noninteractive session
iterates through MODULES, enabling and initializing them. The order of modules
in these blocks dictates their load order (unless given an explicit :depth)."
`(when noninteractive
(doom-module-mplist-map
#'doom-module--put
,@(if (keywordp (car modules))
(list (list 'quote modules))
modules))
t))
;; DEPRECATED Remove in 3.0
(define-obsolete-function-alias 'featurep! 'modulep! "3.0.0")
(defmacro modulep! (group &optional module &rest flags)
"Return t if :GROUP MODULE (and +FLAGS) are enabled.
If FLAGS is provided, returns t if GROUP MODULE has all of FLAGS enabled.
(modulep! :config default +flag)
(modulep! :config default +flag1 +flag2 +flag3)
GROUP and MODULE may be omitted when this macro is used from a Doom module's
source (except your $DOOMDIR, which is a special module). Like so:
(modulep! +flag3 +flag1 +flag2)
(modulep! +flag)
FLAGS can be negated. E.g. This will return non-nil if ':tools lsp' is enabled
without `+eglot':
(modulep! :tools lsp -eglot)
To interpolate dynamic values, use comma:
(let ((flag '-eglot))
(modulep! :tools lsp ,flag))
For more about modules and flags, see `doom!'."
(if (keywordp group)
(if flags
`(doom-module--has-flag-p
(doom-module (backquote ,group) (backquote ,module) :flags)
(backquote ,flags))
`(and (get (backquote ,group) (backquote ,module)) t))
(let ((flags (delq nil (cons group (cons module flags)))))
(if (doom-module-context-index doom-module-context)
`(doom-module--has-flag-p
',(doom-module-context-flags doom-module-context)
(backquote ,flags))
`(let ((file (file!)))
(if-let ((module (doom-module-from-path file)))
(doom-module--has-flag-p
(doom-module (car module) (cdr module) :flags)
(backquote ,flags))
(error "(modulep! %s) couldn't resolve current module from %s"
(backquote ,flags) (abbreviate-file-name file))))))))
(provide 'doom-modules)
;;; doom-modules.el ends here

648
lisp/doom-packages.el
View File

@ -1,648 +0,0 @@
;;; lisp/doom-packages.el -*- lexical-binding: t; -*-
;;; Commentary:
;;
;; Emacs package management is opinionated, and so is Doom. Doom uses `straight'
;; to create a declarative, lazy-loaded, and (nominally) reproducible package
;; management system. We use `straight' over `package' because the latter is
;; tempermental. ELPA sources suffer downtime occasionally and often fail to
;; build packages when GNU Tar is unavailable (e.g. MacOS users start with BSD
;; tar). Known gnutls errors plague the current stable release of Emacs (26.x)
;; which bork TLS handshakes with ELPA repos (mainly gnu.elpa.org). See
;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=3434.
;;
;; What's worse, you can only get the latest version of packages through ELPA.
;; In an ecosystem that is constantly changing, this is more frustrating than
;; convenient. Straight (and Doom) can do rolling release, but it is opt-in.
;;
;; Interacting with this package management system is done through Doom's
;; bin/doom script. Find out more about it by running 'doom help' (I highly
;; recommend you add the script to your PATH). Here are some highlights:
;;
;; - `doom install`: a wizard that guides you through setting up Doom and your
;; private config for the first time.
;; - `doom sync`: your go-to command for making sure Doom is in optimal
;; condition. It ensures all unneeded packages are removed, all needed ones
;; are installed, and all metadata associated with them is generated.
;; - `doom upgrade`: upgrades Doom Emacs and your packages to the latest
;; versions. There's also 'bin/doom sync -u' for updating only your packages.
;;
;; How this works is: the system reads packages.el files located in each
;; activated module, your private config (`doom-user-dir'), and one in
;; `doom-core-dir'. These contain `package!' declarations that tell DOOM what
;; packages to install and where from.
;;
;; All that said, you can still use package.el's commands, but 'doom sync' will
;; purge ELPA packages.
;;
;;; Code:
(defvar doom-packages ()
"A list of enabled packages. Each element is a sublist, whose CAR is the
package's name as a symbol, and whose CDR is the plist supplied to its
`package!' declaration. Set by `doom-initialize-packages'.")
(defvar doom-disabled-packages ()
"A list of packages that should be ignored by `use-package!' and `after!'.")
(defvar doom-packages-file "packages"
"The basename of packages file for modules.
Package files are read whenever Doom's package manager wants a manifest of all
desired packages. They are rarely read in interactive sessions (unless the user
uses a straight or package.el command directly).")
;;
;;; package.el
;; Ensure that, if we do need package.el, it is configured correctly. You really
;; shouldn't be using it, but it may be convenient for quickly testing packages.
(setq package-enable-at-startup nil
package-user-dir (concat doom-local-dir "elpa/")
package-gnupghome-dir (expand-file-name "gpg" package-user-dir))
(after! package
(let ((s (if gnutls-verify-error "s" "")))
(prependq! package-archives
;; I omit Marmalade because its packages are manually submitted
;; rather than pulled, and so often out of date.
`(("melpa" . ,(format "http%s://melpa.org/packages/" s))
("org" . ,(format "http%s://orgmode.org/elpa/" s))))))
;; Refresh package.el the first time you call `package-install', so it can still
;; be used (e.g. to temporarily test packages). Remember to run 'doom sync' to
;; purge them; they can conflict with packages installed via straight!
(add-transient-hook! 'package-install (package-refresh-contents))
;;
;;; Straight
(setq straight-base-dir (file-truename doom-local-dir)
straight-repository-branch "develop"
;; Since byte-code is rarely compatible across different versions of
;; Emacs, it's best we build them in separate directories, per emacs
;; version.
straight-build-dir (format "build-%s" emacs-version)
straight-cache-autoloads nil ; we already do this, and better.
;; Doom doesn't encourage you to modify packages in place. Disabling this
;; makes 'doom sync' instant (once everything set up), which is much nicer
;; UX than the several seconds modification checks.
straight-check-for-modifications nil
;; We handle package.el ourselves (and a little more comprehensively)
straight-enable-package-integration nil
;; Before switching to straight, `doom-local-dir' would average out at
;; around 100mb with half Doom's modules at ~230 packages. Afterwards, at
;; around 1gb. With shallow cloning, that is reduced to ~400mb. This has
;; no affect on packages that are pinned, however (run 'doom purge' to
;; compact those after-the-fact). Some packages break when shallow cloned
;; (like magit and org), but we'll deal with that elsewhere.
straight-vc-git-default-clone-depth '(1 single-branch))
(with-eval-after-load 'straight
;; HACK: Doom relies on deferred compilation, which spares the user 20-50min
;; of compilation at install time, but subjects them to ~50% CPU activity
;; when starting Emacs for the first time. To complete this, straight.el
;; needs to be told not to do native-compilation, but it won't obey
;; `straight-disable-native-compile'.
;;
;; It *will* obey `straight--native-comp-available', though. Trouble is:
;; it's a constant; it resets itself when straight is loaded, so it must be
;; changed afterwards.
(setq straight--native-comp-available nil)
;; `let-alist' is built into Emacs 26 and onwards
(add-to-list 'straight-built-in-pseudo-packages 'let-alist))
(defadvice! doom--read-pinned-packages-a (fn &rest args)
"Read `:pin's in `doom-packages' on top of straight's lockfiles."
:around #'straight--lockfile-read-all
(append (apply fn args) ; lockfiles still take priority
(doom-package-pinned-list)))
;; HACK: This fixes an issue introduced in emacs-mirror/emacs@0d383b592c2f and
;; is present in >=29: Straight.el uses `loaddefs-generate' if it is
;; available, which activates `emacs-lisp-mode' to read autoloads files, but
;; does so without suppressing its hooks. Some packages (like overseer) add
;; hooks to `emacs-lisp-mode-hook' in their autoloads, and once triggered,
;; they will try to load their dependencies (like dash or pkg-info), causing
;; file errors.
;; REVIEW: Report this upstream.
(defadvice! doom--fix-loaddefs-generate--parse-file-a (fn &rest args)
:around #'loaddefs-generate--parse-file
(let (emacs-lisp-mode-hook)
(apply fn args)))
;;
;;; native-comp
(when (featurep 'native-compile)
(after! comp
;; HACK Disable native-compilation for some troublesome packages
(mapc (doom-partial #'add-to-list 'native-comp-deferred-compilation-deny-list)
(list "/seq-tests\\.el\\'"
"/emacs-jupyter.*\\.el\\'"
"/evil-collection-vterm\\.el\\'"
"/vterm\\.el\\'"
"/with-editor\\.el\\'"))))
;;
;;; Bootstrappers
(defun doom--ensure-straight (recipe pin)
(letenv! (("GIT_CONFIG" nil)
("GIT_CONFIG_NOSYSTEM" "1")
("GIT_CONFIG_GLOBAL" (or (getenv "DOOMGITCONFIG")
"/dev/null")))
(let ((repo-dir (doom-path straight-base-dir "straight/repos/straight.el"))
(repo-url (concat "http" (if gnutls-verify-error "s")
"://github.com/"
(or (plist-get recipe :repo) "radian-software/straight.el")))
(branch (or (plist-get recipe :branch) straight-repository-branch))
(call (if init-file-debug
(lambda (&rest args)
(print! "%s" (cdr (apply #'doom-call-process args))))
(lambda (&rest args)
(apply #'doom-call-process args)))))
(unless (file-directory-p repo-dir)
(save-match-data
(unless (executable-find "git")
(user-error "Git isn't present on your system. Cannot proceed."))
(let* ((version (cdr (doom-call-process "git" "version")))
(version
(and (string-match "\\_<[0-9]+\\.[0-9]+\\(\\.[0-9]+\\)\\_>" version)
(match-string 0 version))))
(if version
(when (version< version "2.23")
(user-error "Git %s detected! Doom requires git 2.23 or newer!"
version)))))
(print! (start "Installing straight..."))
(print-group!
(cl-destructuring-bind (depth . options)
(ensure-list straight-vc-git-default-clone-depth)
(let ((branch-switch (if (memq 'single-branch options)
"--single-branch"
"--no-single-branch")))
(cond
((eq 'full depth)
(funcall call "git" "clone" "--origin" "origin"
branch-switch repo-url repo-dir))
((integerp depth)
(if (null pin)
(progn
(when (file-directory-p repo-dir)
(delete-directory repo-dir 'recursive))
(funcall call "git" "clone" "--origin" "origin" repo-url
"--no-checkout" repo-dir
"--depth" (number-to-string depth)
branch-switch
"--no-tags"
"--branch" straight-repository-branch))
(make-directory repo-dir 'recursive)
(let ((default-directory repo-dir))
(funcall call "git" "init")
(funcall call "git" "branch" "-m" straight-repository-branch)
(funcall call "git" "remote" "add" "origin" repo-url
"--master" straight-repository-branch)
(funcall call "git" "fetch" "origin" pin
"--depth" (number-to-string depth)
"--no-tags")
(funcall call "git" "reset" "--hard" pin)))))))))
(require 'straight (concat repo-dir "/straight.el"))
(doom-log "Initializing recipes")
(mapc #'straight-use-recipes
'((org-elpa :local-repo nil)
(melpa :type git :host github
:repo "melpa/melpa"
:build nil)
(nongnu-elpa :type git
:repo "https://git.savannah.gnu.org/git/emacs/nongnu.git"
:local-repo "nongnu-elpa"
:build nil)
(gnu-elpa-mirror :type git :host github
:repo "emacs-straight/gnu-elpa-mirror"
:build nil)
(el-get :type git :host github
:repo "dimitri/el-get"
:build nil)
(emacsmirror-mirror :type git :host github
:repo "emacs-straight/emacsmirror-mirror"
:build nil))))))
(defun doom--ensure-core-packages (packages)
(doom-log "Installing core packages")
(dolist (package packages)
(let* ((name (car package))
(repo (symbol-name name)))
(when-let (recipe (plist-get (cdr package) :recipe))
(straight-override-recipe (cons name recipe))
(when-let (local-repo (plist-get recipe :local-repo))
(setq repo local-repo)))
(print-group!
;; Only clone the package, don't build them. Straight hasn't been fully
;; configured by this point.
(straight-use-package name nil t))
;; In case the package hasn't been built yet.
(or (member (directory-file-name (straight--build-dir (symbol-name name)))
load-path)
(add-to-list 'load-path (directory-file-name (straight--repos-dir repo)))))))
(defun doom-initialize-core-packages (&optional force-p)
"Ensure `straight' is installed and was compiled with this version of Emacs."
(when (or force-p (null (bound-and-true-p straight-recipe-repositories)))
(doom-log "Initializing straight")
(let ((packages (doom-package-list '((:doom)))))
(cl-destructuring-bind (&key recipe pin &allow-other-keys)
(alist-get 'straight packages)
(doom--ensure-straight recipe pin))
(doom--ensure-core-packages
(seq-filter (fn! (eq (plist-get (cdr %) :type) 'core))
packages)))))
(defun doom-initialize-packages (&optional force-p)
"Process all packages, essential and otherwise, if they haven't already been.
If FORCE-P is non-nil, do it anyway.
This ensures `doom-packages' is populated and `straight' recipes are properly
processed."
(doom-initialize-core-packages force-p)
(when (or force-p (not (bound-and-true-p package--initialized)))
(doom-log "Initializing package.el")
(require 'package)
(package-initialize)
(unless package--initialized
(error "Failed to initialize package.el")))
(when (or force-p (null doom-packages))
(doom-log "Initializing straight.el")
(setq doom-disabled-packages nil
doom-packages (doom-package-list))
(let (packages)
(dolist (package doom-packages)
(cl-destructuring-bind
(name &key recipe disable ignore &allow-other-keys) package
(if ignore
(straight-override-recipe (cons name '(:type built-in)))
(if disable
(cl-pushnew name doom-disabled-packages)
(when recipe
(straight-override-recipe (cons name recipe)))
(appendq! packages (cons name (straight--get-dependencies name)))))))
(dolist (package (cl-delete-duplicates packages :test #'equal))
(straight-register-package package)
(let ((name (symbol-name package)))
(add-to-list 'load-path (directory-file-name (straight--build-dir name)))
(straight--load-package-autoloads name))))))
;;
;;; Package management API
(defun doom-package-get (package &optional prop nil-value)
"Returns PACKAGE's `package!' recipe from `doom-packages'."
(let ((plist (cdr (assq package doom-packages))))
(if prop
(if (plist-member plist prop)
(plist-get plist prop)
nil-value)
plist)))
(defun doom-package-set (package prop value)
"Set PROPERTY in PACKAGE's recipe to VALUE."
(setf (alist-get package doom-packages)
(plist-put (alist-get package doom-packages)
prop value)))
(defun doom-package-recipe (package &optional prop nil-value)
"Returns the `straight' recipe PACKAGE was registered with."
(let* ((recipe (straight-recipes-retrieve package))
(plist (doom-plist-merge
(plist-get (alist-get package doom-packages) :recipe)
(cdr (if (memq (car recipe) '(quote \`))
(eval recipe t)
recipe)))))
(if prop
(if (plist-member plist prop)
(plist-get plist prop)
nil-value)
plist)))
(defun doom-package-recipe-repo (package)
"Resolve and return PACKAGE's (symbol) local-repo property."
(if-let* ((recipe (copy-sequence (doom-package-recipe package)))
(recipe (if (and (not (plist-member recipe :type))
(memq (plist-get recipe :host) '(github gitlab bitbucket)))
(plist-put recipe :type 'git)
recipe))
(repo (if-let (local-repo (plist-get recipe :local-repo))
(directory-file-name local-repo)
(ignore-errors (straight-vc-local-repo-name recipe)))))
repo
(symbol-name package)))
(defun doom-package-build-recipe (package &optional prop nil-value)
"Returns the `straight' recipe PACKAGE was installed with."
(let ((plist (nth 2 (gethash (symbol-name package) straight--build-cache))))
(if prop
(if (plist-member plist prop)
(plist-get plist prop)
nil-value)
plist)))
(defun doom-package-dependencies (package &optional recursive noerror)
"Return a list of dependencies for a package.
If RECURSIVE is `tree', return a tree of dependencies.
If RECURSIVE is nil, only return PACKAGE's immediate dependencies.
If NOERROR, return nil in case of error."
(cl-check-type package symbol)
(let ((deps (straight-dependencies (symbol-name package))))
(pcase recursive
(`tree deps)
(`t (flatten-list deps))
(`nil (cl-remove-if #'listp deps)))))
(defun doom-package-depending-on (package &optional noerror)
"Return a list of packages that depend on PACKAGE.
If PACKAGE (a symbol) isn't installed, throw an error, unless NOERROR is
non-nil."
(cl-check-type package symbol)
;; can't get dependencies for built-in packages
(unless (or (doom-package-build-recipe package)
noerror)
(error "Couldn't find %s, is it installed?" package))
(straight-dependents (symbol-name package)))
;;; Predicate functions
(defun doom-package-built-in-p (package)
"Return non-nil if PACKAGE (a symbol) is built-in."
(eq (doom-package-build-recipe package :type)
'built-in))
(defun doom-package-installed-p (package)
"Return non-nil if PACKAGE (a symbol) is installed."
(file-directory-p (straight--build-dir (symbol-name package))))
(defun doom-package-is-type-p (package type)
"TODO"
(memq type (ensure-list (doom-package-get package :type))))
(defun doom-package-in-module-p (package category &optional module)
"Return non-nil if PACKAGE was installed by the user's private config."
(when-let (modules (doom-package-get package :modules))
(or (and (not module) (assq :user modules))
(member (cons category module) modules))))
(defun doom-package-backend (package)
"Return 'straight, 'builtin, 'elpa or 'other, depending on how PACKAGE is
installed."
(cond ((gethash (symbol-name package) straight--build-cache)
'straight)
((or (doom-package-built-in-p package)
(assq package package--builtins))
'builtin)
((assq package package-alist)
'elpa)
((locate-library (symbol-name package))
'other)))
;;; Package getters
(defun doom-packages--read (file &optional noeval noerror)
(condition-case-unless-debug e
(with-temp-buffer ; prevent buffer-local state from propagating
(if (not noeval)
(load file noerror 'nomessage 'nosuffix)
(when (file-exists-p file)
(insert-file-contents file)
(with-syntax-table emacs-lisp-mode-syntax-table
;; Scrape `package!' blocks from FILE for a comprehensive listing of
;; packages used by this module.
(while (search-forward "(package!" nil t)
(let ((ppss (save-excursion (syntax-ppss))))
;; Don't collect packages in comments or strings
(unless (or (nth 3 ppss)
(nth 4 ppss))
(goto-char (match-beginning 0))
(cl-destructuring-bind (_ name . plist)
(read (current-buffer))
(push (cons
name (plist-put
plist :modules
(list (doom-module-context-key doom-module-context))))
doom-packages)))))))))
(user-error
(user-error (error-message-string e)))
(error
(signal 'doom-package-error
(list (doom-module-context-key doom-module-context)
file e)))))
(defun doom-package-list (&optional module-list)
"Retrieve a list of explicitly declared packages from MODULE-LIST.
If MODULE-LIST is omitted, read enabled module list in configdepth order (see
`doom-module-set'). Otherwise, MODULE-LIST may be any symbol (or t) to mean read
all modules in `doom-modules-dir', including :doom and :user. MODULE-LIST may
also be a list of module keys."
(let ((module-list (cond ((null module-list) (doom-module-list))
((symbolp module-list) (doom-module-list 'all))
(module-list)))
(packages-file doom-module-packages-file)
doom-disabled-packages
doom-packages)
(letf! (defun read-packages (key)
(with-doom-module key
(when-let (file (doom-module-locate-path
key doom-module-packages-file))
(doom-packages--read file nil 'noerror))))
(with-doom-context 'packages
(let ((user? (assq :user module-list)))
(when user?
;; We load the private packages file twice to populate
;; `doom-disabled-packages' disabled packages are seen ASAP...
(let (doom-packages)
(read-packages (cons :user nil))))
(mapc #'read-packages module-list)
;; ...Then again to ensure privately overriden packages are properly
;; overwritten.
(if user? (read-packages (cons :user nil)))
(nreverse doom-packages))))))
(defun doom-package-pinned-list ()
"Return an alist mapping package names (strings) to pinned commits (strings)."
(let (alist)
(dolist (package doom-packages alist)
(cl-destructuring-bind (name &key disable ignore pin unpin &allow-other-keys)
package
(when (and (not ignore)
(not disable)
(or pin unpin))
(setf (alist-get (file-name-nondirectory (doom-package-recipe-repo name))
alist nil 'remove #'equal)
(unless unpin pin)))))))
(defun doom-package-recipe-list ()
"Return straight recipes for non-builtin packages with a local-repo."
(let (recipes)
(dolist (recipe (hash-table-values straight--recipe-cache))
(cl-destructuring-bind (&key local-repo type &allow-other-keys)
recipe
(unless (or (null local-repo)
(eq type 'built-in))
(push recipe recipes))))
(nreverse recipes)))
;;
;;; Module package macros
(cl-defmacro package!
(name &rest plist &key built-in recipe ignore _type _pin _disable)
"Declares a package and how to install it (if applicable).
This macro is declarative and does not load nor install packages. It is used to
populate `doom-packages' with metadata about the packages Doom needs to keep
track of.
Only use this macro in a module's packages.el file.
Accepts the following properties:
:type core|local|built-in|virtual
Specifies what kind of package this is. Can be a symbol or a list thereof.
`core' = this is a protected package and cannot be disabled!
`local' = this package is being modified in-place. This package's repo is
unshallowed and will be skipped when you update packages.
`built-in' = this package is already built-in (otherwise, will be
installed)
`virtual' = this package is not tracked by Doom's package manager. It won't
be installed or uninstalled. Use this to pin 2nd order dependencies.
:recipe RECIPE
Specifies a straight.el recipe to allow you to acquire packages from external
sources. See https://github.com/radian-software/straight.el#the-recipe-format
for details on this recipe.
:disable BOOL
Do not install or update this package AND disable all of its `use-package!'
and `after!' blocks.
:ignore FORM
Do not install this package.
:pin STR|nil
Pin this package to commit hash STR. Setting this to nil will unpin this
package if previously pinned.
:built-in BOOL|'prefer
Same as :ignore if the package is a built-in Emacs package. This is more to
inform help commands like `doom/help-packages' that this is a built-in
package. If set to 'prefer, the package will not be installed if it is
already provided by Emacs.
Returns t if package is successfully registered, and nil if it was disabled
elsewhere."
(declare (indent defun))
(when (and recipe (keywordp (car-safe recipe)))
(cl-callf plist-put plist :recipe `(quote ,recipe)))
;; :built-in t is basically an alias for :ignore (locate-library NAME)
(when built-in
(when (and (not ignore)
(equal built-in '(quote prefer)))
(setq built-in `(locate-library ,(symbol-name name) nil (get 'load-path 'initial-value))))
(cl-callf map-delete plist :built-in)
(cl-callf plist-put plist :ignore built-in))
`(let* ((name ',name)
(plist (cdr (assq name doom-packages)))
(dir (dir!))
(module (doom-module-from-path dir)))
(unless (doom-context-p 'packages)
(signal 'doom-module-error
(list module "package! can only be used in packages.el files")))
;; Record what module this declaration was found in
(let ((module-list (plist-get plist :modules)))
(unless (member module module-list)
(cl-callf plist-put plist :modules
(append module-list
(list module)
(when (file-in-directory-p dir doom-user-dir)
'((:user . modules)))
nil))))
;; Merge given plist with pre-existing one
(cl-loop for (key value) on (list ,@plist) by 'cddr
when (or (eq key :pin) value)
do (cl-callf plist-put plist key value))
;; Some basic key validation; throws an error on invalid properties
(condition-case e
(when-let (recipe (plist-get plist :recipe))
(cl-destructuring-bind
(&key local-repo _files _flavor _build _pre-build _post-build
_includes _type _repo _host _branch _protocol _remote
_nonrecursive _fork _depth _source _inherit)
recipe
;; Expand :local-repo from current directory
(when local-repo
(cl-callf plist-put plist :recipe
(plist-put recipe :local-repo
(let ((local-path (expand-file-name local-repo dir)))
(if (file-directory-p local-path)
local-path
local-repo)))))))
(error
(signal 'doom-package-error
(cons ,(symbol-name name)
(error-message-string e)))))
;; These are the only side-effects of this macro!
(setf (alist-get name doom-packages) plist)
(if (plist-get plist :disable)
(add-to-list 'doom-disabled-packages name)
(with-no-warnings
(cons name plist)))))
(defmacro disable-packages! (&rest packages)
"A convenience macro for disabling packages in bulk.
Only use this macro in a module's (or your private) packages.el file."
(macroexp-progn
(mapcar (lambda (p) `(package! ,p :disable t))
packages)))
(defmacro unpin! (&rest targets)
"Unpin packages in TARGETS.
This unpins packages, so that `doom upgrade' or `doom sync -u' will update them
to the latest commit available. Some examples:
- To disable pinning wholesale: (unpin! t)
- To unpin individual packages: (unpin! packageA packageB ...)
- To unpin all packages in a group of modules: (unpin! :lang :tools ...)
- To unpin packages in individual modules:
(unpin! (:lang python javascript) (:tools docker))
Or any combination of the above.
This macro should only be used from the user's private packages.el. No module
should use it!"
(if (memq t targets)
`(mapc (doom-rpartial #'doom-package-set :unpin t)
(mapcar #'car doom-packages))
(macroexp-progn
(mapcar
(lambda (target)
(when target
`(doom-package-set ',target :unpin t)))
(cl-loop for target in targets
if (or (keywordp target) (listp target))
append
(cl-loop with (category . modules) = (ensure-list target)
for (name . plist) in doom-packages
for pkg-modules = (plist-get plist :modules)
if (and (assq category pkg-modules)
(or (null modules)
(cl-loop for module in modules
if (member (cons category module) pkg-modules)
return t))
name)
collect it)
else if (symbolp target)
collect target)))))
(provide 'doom-packages)
;;; doom-packages.el ends here

115
lisp/doom-start.el
View File

@ -270,84 +270,11 @@ If RETURN-P, return the message as a string instead of displaying it."
(funcall (if return-p #'format #'message)
"Doom loaded %d packages across %d modules in %.03fs"
(- (length load-path) (length (get 'load-path 'initial-value)))
(hash-table-count doom-modules)
(if doom-modules (hash-table-count doom-modules) -1)
doom-init-time))
;;
;;; Load Doom's defaults and DSL
;;; Load core modules and set up their autoloads
(require 'doom-modules)
;; TODO (autoload 'doom-profiles-initialize "doom-profiles")
;; TODO (autoload 'doom-packages-initialize "doom-packages")
;; UX: There's a chance the user will later use package.el or straight in this
;; interactive session. If they do, make sure they're properly initialized
;; when they do.
(autoload 'doom-initialize-packages "doom-packages")
(with-eval-after-load 'package (require 'doom-packages))
(with-eval-after-load 'straight (doom-initialize-packages))
;;
;;; Let 'er rip!
;; A last ditch opportunity to undo dodgy optimizations or do extra
;; configuration before the session is complicated by user config and packages.
(doom-run-hooks 'doom-before-init-hook)
;;; Load envvar file
;; 'doom env' generates an envvar file. This is a snapshot of your shell
;; environment, which Doom loads here. This is helpful in scenarios where Emacs
;; is launched from an environment detached from the user's shell environment.
(when (and (or initial-window-system
(daemonp))
doom-env-file)
(doom-load-envvars-file doom-env-file 'noerror))
;;; Last minute setup
(add-hook 'doom-after-init-hook #'doom-load-packages-incrementally-h 100)
(add-hook 'doom-after-init-hook #'doom-display-benchmark-h 110)
(doom-run-hook-on 'doom-first-buffer-hook '(find-file-hook doom-switch-buffer-hook))
(doom-run-hook-on 'doom-first-file-hook '(find-file-hook dired-initial-position-hook))
(doom-run-hook-on 'doom-first-input-hook '(pre-command-hook))
;; If the user's already opened something (e.g. with command-line arguments),
;; then we should assume nothing about the user's intentions and simply treat
;; this session as fully initialized.
(add-hook! 'doom-after-init-hook :depth 100
(defun doom-run-first-hooks-if-files-open-h ()
(when file-name-history
(doom-run-hooks 'doom-first-file-hook 'doom-first-buffer-hook))))
;; PERF: Activate these later, otherwise they'll fire for every buffer created
;; between now and the end of startup.
(add-hook! 'after-init-hook
(defun doom-init-local-var-hooks-h ()
;; These fire `MAJOR-MODE-local-vars-hook' hooks, which is a Doomism. See
;; the `MODE-local-vars-hook' section above.
(add-hook 'after-change-major-mode-hook #'doom-run-local-var-hooks-h 100)
(add-hook 'hack-local-variables-hook #'doom-run-local-var-hooks-h)))
;;; Load $DOOMDIR/init.el early
;; TODO: Catch errors
(load! (string-remove-suffix ".el" doom-module-init-file) doom-user-dir t)
;; If the user is loading this file from a batch script, let's assume they want
;; to load their userland config immediately.
(when noninteractive
(doom-require 'doom-profiles)
(let ((init-file (doom-profile-init-file)))
(unless (file-exists-p init-file)
(user-error "Profile init file hasn't been generated. Did you forgot to run 'doom sync'?"))
(let (kill-emacs-query-functions
kill-emacs-hook)
;; Loads modules, then $DOOMDIR/config.el
(doom-load init-file 'noerror)
(doom-initialize-packages))))
;;; Entry point
;; HACK: This advice hijacks Emacs' initfile loader to accomplish the following:
;;
@ -378,30 +305,30 @@ If RETURN-P, return the message as a string instead of displaying it."
;; Compiling them in one place is a big reduction in startup
;; time, and by keeping a history of them, you get a snapshot
;; of your config in time.
(file-name-concat
doom-profile-dir (format "init.%d.elc" emacs-major-version))))
;; If `user-init-file' is t, then `load' will store the name of
;; the next file it loads into `user-init-file'.
(setq user-init-file t)
(when init-file-name
(load init-file-name 'noerror 'nomessage 'nosuffix)
;; HACK: if `init-file-name' happens to be higher in
;; `load-history' than a symbol's actual definition,
;; `symbol-file' (and help/helpful buffers) will report the
;; source of a symbol as `init-file-name', rather than it's
;; true source. By removing this file from `load-history', no
;; one will make that mistake.
(setq load-history (delete (assoc init-file-name load-history)
load-history)))
;; If it's still `t', then it failed to load the profile initfile.
;; This likely means the user has forgotten to run `doom sync'!
(when (eq user-init-file t)
(signal 'doom-nosync-error (list init-file-name)))
(doom-profile-init-file doom-profile)))
;; If we loaded a compiled file, set `user-init-file' to the
;; source version if that exists.
(setq user-init-file
(concat (string-remove-suffix ".elc" user-init-file)
".el"))))
".el"))
;; HACK: if `init-file-name' happens to be higher in
;; `load-history' than a symbol's actual definition,
;; `symbol-file' (and help/helpful buffers) will report the
;; source of a symbol as `init-file-name', rather than it's true
;; source. By removing this file from `load-history', no one
;; will make that mistake.
(setq load-history
(delete (assoc init-file-name load-history)
load-history))
(let ((startup-or-reload?
(or (doom-context-p 'startup)
(doom-context-p 'reload))))
(when startup-or-reload?
(doom--startup-vars))
(doom--startup-module-autoloads)
(doom--startup-package-autoloads)
(when startup-or-reload?
(doom--startup-modules)))))
;; TODO: Add safe-mode profile.
;; (error
;; ;; HACK: This is not really this variable's intended purpose, but it

317
lisp/doom-straight.el Normal file
View File

@ -0,0 +1,317 @@
;;; lisp/doom-straight.el -*- lexical-binding: t; -*-
;;; Commentary:
;;
;; Emacs package management is opinionated, and so is Doom. Doom uses `straight'
;; to create a declarative, lazy-loaded, and (nominally) reproducible package
;; management system. We use `straight' over `package' because the latter is
;; tempermental. ELPA sources suffer downtime occasionally and often fail to
;; build packages when GNU Tar is unavailable (e.g. MacOS users start with BSD
;; tar). Known gnutls errors plague the current stable release of Emacs (26.x)
;; which bork TLS handshakes with ELPA repos (mainly gnu.elpa.org). See
;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=3434.
;;
;; What's worse, you can only get the latest version of packages through ELPA.
;; In an ecosystem that is constantly changing, this is more frustrating than
;; convenient. Straight (and Doom) can do rolling release, but it is opt-in.
;;
;; Interacting with this package management system is done through Doom's
;; bin/doom script. Find out more about it by running 'doom help' (I highly
;; recommend you add the script to your PATH). Here are some highlights:
;;
;; - `doom install`: a wizard that guides you through setting up Doom and your
;; private config for the first time.
;; - `doom sync`: your go-to command for making sure Doom is in optimal
;; condition. It ensures all unneeded packages are removed, all needed ones
;; are installed, and all metadata associated with them is generated.
;; - `doom upgrade`: upgrades Doom Emacs and your packages to the latest
;; versions. There's also 'bin/doom sync -u' for updating only your packages.
;;
;; How this works is: the system reads packages.el files located in each
;; activated module, your private config (`doom-user-dir'), and one in
;; `doom-core-dir'. These contain `package!' declarations that tell DOOM what
;; packages to install and where from.
;;
;; All that said, you can still use package.el's commands, but 'doom sync' will
;; purge ELPA packages.
;;
;;; Code:
(setq straight-base-dir (file-truename doom-local-dir)
straight-repository-branch "develop"
;; Since byte-code is rarely compatible across different versions of
;; Emacs, it's best we build them in separate directories, per emacs
;; version.
straight-build-dir (format "build-%s" emacs-version)
straight-cache-autoloads nil ; we already do this, and better.
;; Doom doesn't encourage you to modify packages in place. Disabling this
;; makes 'doom sync' instant (once everything set up), which is much nicer
;; UX than the several seconds modification checks.
straight-check-for-modifications nil
;; We handle package.el ourselves (and a little more comprehensively)
straight-enable-package-integration nil
;; Before switching to straight, `doom-local-dir' would average out at
;; around 100mb with half Doom's modules at ~230 packages. Afterwards, at
;; around 1gb. With shallow cloning, that is reduced to ~400mb. This has
;; no affect on packages that are pinned, however (run 'doom sync --gc' to
;; compact those after-the-fact). Some packages break when shallow cloned
;; (like magit and org), but we'll deal with that elsewhere.
straight-vc-git-default-clone-depth '(1 single-branch))
(with-eval-after-load 'straight
;; HACK: Doom relies on deferred compilation, which spares the user 20-50min
;; of compilation at install time, but subjects them to ~50% CPU activity
;; when starting Emacs for the first time. To complete this, straight.el
;; needs to be told not to do native-compilation, but it won't obey
;; `straight-disable-native-compile'.
;;
;; It *will* obey `straight--native-comp-available', though. Trouble is:
;; it's a constant; it resets itself when straight is loaded, so it must be
;; changed afterwards.
(setq straight--native-comp-available nil)
;; `let-alist' is built into Emacs 26 and onwards
(add-to-list 'straight-built-in-pseudo-packages 'let-alist))
(defadvice! doom--read-pinned-packages-a (fn &rest args)
"Read `:pin's in `doom-packages' on top of straight's lockfiles."
:around #'straight--lockfile-read-all
(append (apply fn args) ; lockfiles still take priority
(doom-package-pinned-alist)))
;; HACK: This fixes an issue introduced in emacs-mirror/emacs@0d383b592c2f and
;; is present in >=29: Straight.el uses `loaddefs-generate' if it is
;; available, which activates `emacs-lisp-mode' to read autoloads files, but
;; does so without suppressing its hooks. Some packages (like overseer) add
;; hooks to `emacs-lisp-mode-hook' in their autoloads, and once triggered,
;; they will try to load their dependencies (like dash or pkg-info), causing
;; file errors.
;; REVIEW: Report this upstream.
(defadvice! doom--fix-loaddefs-generate--parse-file-a (fn &rest args)
:around #'loaddefs-generate--parse-file
(let (emacs-lisp-mode-hook)
(apply fn args)))
;;
;;; Hacks
;; Straight was designed primarily for interactive use, in an interactive Emacs
;; session, but Doom does its package management in the terminal. Some things
;; must be modified get straight to behave and improve its UX for our users.
(defvar doom-straight--auto-options
'(("has diverged from"
. "^Reset [^ ]+ to ")
("but recipe specifies a URL of"
. "Delete remote \"[^\"]+\", re-create it with correct URL")
("has a merge conflict:"
. "^Abort merge$")
("has a dirty worktree:"
. "^Discard changes$")
("^In repository \"[^\"]+\", [^ ]+ (on branch \"main\") is ahead of default branch \"master\""
. "^Checkout branch \"master\"")
("^In repository \"[^\"]+\", [^ ]+ (on branch \"[^\"]+\") is ahead of default branch \"[^\"]+\""
. "^Checkout branch \"")
("^In repository "
. "^Reset branch \\|^Delete remote [^,]+, re-create it with correct URL\\|^Checkout \""))
"A list of regexps, mapped to regexps.
Their CAR is tested against the prompt, and CDR is tested against the presented
option, and is used by `straight-vc-git--popup-raw' to select which option to
recommend.
It may not be obvious to users what they should do for some straight prompts,
so Doom will recommend the one that reverts a package back to its (or target)
original state.")
;; HACK Remove dired & magit options from prompt, since they're inaccessible in
;; noninteractive sessions.
(advice-add #'straight-vc-git--popup-raw :override #'straight--popup-raw)
;; HACK: `native-comp' only respects `native-comp-jit-compilation-deny-list'
;; when native-compiling packages in interactive sessions. It ignores the
;; variable when, say, straight is building packages. This advice forces it to
;; obey it, even when used by straight (but only in the CLI).
(defadvice! doom-straight--native--compile-async-skip-p (fn files &optional recursively load selector)
:around #'native-compile-async
(let (file-list)
(dolist (file-or-dir (ensure-list files))
(cond ((file-directory-p file-or-dir)
(dolist (file (if recursively
(directory-files-recursively
file-or-dir comp-valid-source-re)
(directory-files file-or-dir
t comp-valid-source-re)))
(push file file-list)))
((file-exists-p file-or-dir)
(push file-or-dir file-list))
((signal 'native-compiler-error
(list "Not a file nor directory" file-or-dir)))))
(funcall fn (seq-remove (lambda (file)
(seq-some (lambda (re) (string-match-p re file))
native-comp-deferred-compilation-deny-list))
file-list)
recursively load selector)))
;; HACK Replace GUI popup prompts (which hang indefinitely in tty Emacs) with
;; simple prompts.
(defadvice! doom-straight--fallback-to-y-or-n-prompt-a (fn &optional prompt noprompt?)
:around #'straight-are-you-sure
(or noprompt?
(if noninteractive
(y-or-n-p (format! "%s" (or prompt "")))
(funcall fn prompt))))
(defun doom-straight--recommended-option-p (prompt option)
(cl-loop for (prompt-re . opt-re) in doom-straight--auto-options
if (string-match-p prompt-re prompt)
return (string-match-p opt-re option)))
(defadvice! doom-straight--no-compute-prefixes-a (fn &rest args)
:around #'straight--build-autoloads
(let (autoload-compute-prefixes)
(apply fn args)))
(defadvice! doom-straight--suppress-confirm-a (&rest _)
:before-until #'straight-are-you-sure
(and (bound-and-true-p doom-cli--context)
(doom-cli-context-suppress-prompts-p doom-cli--context)))
(defadvice! doom-straight--fallback-to-tty-prompt-a (fn prompt actions)
"Modifies straight to prompt on the terminal when in noninteractive sessions."
:around #'straight--popup-raw
(if (bound-and-true-p async-in-child-emacs)
(error "Straight prompt: %s" prompt)
(let ((doom-straight--auto-options doom-straight--auto-options))
;; We can't intercept C-g, so no point displaying any options for this key
;; when C-c is the proper way to abort batch Emacs.
(delq! "C-g" actions 'assoc)
;; HACK: Remove actions that don't work in noninteractive Emacs (like
;; opening dired or magit).
(setq actions
(cl-remove-if (lambda (o)
(string-match-p "^\\(?:Magit\\|Dired\\)" (nth 1 o)))
actions))
(if (doom-cli-context-suppress-prompts-p doom-cli--context)
(cl-loop for (_key desc func) in actions
when desc
when (doom-straight--recommended-option-p prompt desc)
return (funcall func))
(print! (start "%s") (red prompt))
(print-group!
(terpri)
(let (recommended options)
(print-group!
(print! " 1) Abort")
(cl-loop for (_key desc func) in actions
when desc
do (push func options)
and do
(print! "%2s) %s" (1+ (length options))
(if (doom-straight--recommended-option-p prompt desc)
(progn
(setq doom-straight--auto-options nil
recommended (length options))
(green (concat desc " (Choose this if unsure)")))
desc))))
(terpri)
(let* ((options
(cons (lambda ()
(let ((doom-output-indent 0))
(terpri)
(print! (warn "Aborted")))
(doom-cli--exit 1 doom-cli--context))
(nreverse options)))
(prompt
(format! "How to proceed? (%s%s) "
(mapconcat #'number-to-string
(number-sequence 1 (length options))
", ")
(if (not recommended) ""
(format "; don't know? Pick %d" (1+ recommended)))))
answer fn)
(while (null (nth (setq answer (1- (read-number prompt))) options))
(print! (warn "%s is not a valid answer, try again.") answer))
(funcall (nth answer options)))))))))
(setq straight-arrow " > ")
(defadvice! doom-straight--respect-print-indent-a (string &rest objects)
"Same as `message' (which see for STRING and OBJECTS) normally.
However, in batch mode, print to stdout instead of stderr."
:override #'straight--output
(let ((msg (apply #'format string objects)))
(save-match-data
(when (string-match (format "^%s\\(.+\\)$" (regexp-quote straight-arrow)) msg)
(setq msg (match-string 1 msg))))
(and (string-match-p "^\\(Cloning\\|\\(Reb\\|B\\)uilding\\) " msg)
(not (string-suffix-p "...done" msg))
(doom-print (concat "> " msg) :format t))))
(defadvice! doom-straight--ignore-gitconfig-a (fn &rest args)
"Prevent user and system git configuration from interfering with git calls."
:around #'straight--process-call
(letenv! (("GIT_CONFIG" nil)
("GIT_CONFIG_NOSYSTEM" "1")
("GIT_CONFIG_GLOBAL" (or (getenv "DOOMGITCONFIG")
"/dev/null")))
(apply fn args)))
;; If the repo failed to clone correctly (usually due to a connection failure),
;; straight proceeds as normal until a later call produces a garbage result
;; (typically, when it fails to fetch the remote branch of the empty directory).
;; This causes Straight to throw an otherwise cryptic type error when it tries
;; to sanitize the result for its log buffer.
;;
;; This error is a common source of user confusion and false positive bug
;; reports, so this advice catches them to regurgitates a more cogent
;; explanation.
(defadvice! doom-straight--throw-error-on-no-branch-a (fn &rest args)
:around #'straight--process-log
(letf! ((defun shell-quote-argument (&rest args)
(unless (car args)
(error "Package was not properly cloned due to a connection failure, please try again later"))
(apply shell-quote-argument args)))
(apply fn args)))
(defadvice! doom-straight--regurgitate-empty-string-error-a (fn &rest args)
:around #'straight-vc-git-local-repo-name
(condition-case-unless-debug e
(apply fn args)
(wrong-type-argument
(if (eq (cadr e) 'stringp)
(error "Package was not properly cloned due to a connection failure, please try again later")
(signal (car e) (cdr e))))))
;; HACK: Fix an issue where straight wasn't byte-compiling some packages (or
;; some files in packages) due to missing (invisible) dependencies.
(defadvice! doom-straight--byte-compile-a (recipe)
"See https://github.com/radian-software/straight.el/pull/1132"
:override #'straight--build-compile
(let* ((pkg (plist-get recipe :package))
(dir (straight--build-dir pkg))
(emacs (concat invocation-directory invocation-name))
(buffer straight-byte-compilation-buffer)
(deps
(let (tmp)
(dolist (dep (straight--flatten (straight-dependencies pkg)) tmp)
(let ((build-dir (straight--build-dir dep)))
(when (file-exists-p build-dir)
(push build-dir tmp))))))
(print-circle nil)
(print-length nil)
(program
(format "%S" `(let ((default-directory ,(straight--build-dir))
(lp load-path))
(setq load-path (list default-directory))
(normal-top-level-add-subdirs-to-load-path)
(setq load-path (append '(,dir) ',deps load-path lp))
(byte-recompile-directory ,dir 0 'force))))
(args (list "-Q" "--batch" "--eval" program)))
(when buffer
(with-current-buffer (get-buffer-create buffer)
(insert (format "\n$ %s %s \\\n %S\n" emacs
(string-join (butlast args) " ")
program))))
(apply #'call-process `(,emacs nil ,buffer nil ,@args))))
(provide 'doom-straight)
;;; doom-packages.el ends here

295
lisp/doom.el
View File

@ -70,7 +70,7 @@
;;
;;; Code:
;; For `when-let' and `if-let' on versions of Emacs before they were autoloaded.
;; For `when-let*' and `if-let*' on versions of Emacs before they were autoloaded.
(eval-when-compile (require 'subr-x))
(eval-and-compile ; Check version at both compile and runtime.
@ -100,7 +100,8 @@
" $ EMACS=\"snap run emacs\" " command " ..."))
"\n\nAborting...")
(concat "If you believe this error is a mistake, run 'doom doctor' on the command line\n"
"to diagnose common issues with your config and system."))))))
"to diagnose common issues with your config and system.")))))
nil)
;; Doom needs to be synced/rebuilt if either Doom or Emacs has been
;; up/downgraded. This is because byte-code isn't backwards compatible, and many
@ -512,22 +513,13 @@ users).")
;; causes unnecessary redraws at startup which can impact startup time
;; drastically and cause flashes of white. It also pollutes the logs. I
;; suppress it here and load it myself, later, in a more controlled way
;; (see `startup--load-user-init-file@undo-hacks').
;; (see `doom-initialize').
(put 'site-run-file 'initial-value site-run-file)
(setq site-run-file nil)
(define-advice startup--load-user-init-file (:around (fn &rest args) undo-hacks 95)
"Undo Doom's startup optimizations to prep for the user's session."
(unwind-protect
(progn
(when (setq site-run-file (get 'site-run-file 'initial-value))
(let ((inhibit-startup-screen inhibit-startup-screen))
(letf! ((defun load-file (file)
(load file nil (not init-file-debug)))
(defun load (file &optional noerror _nomessage &rest args)
(apply load file noerror (not init-file-debug) args)))
(load site-run-file t))))
(apply fn args))
(unwind-protect (apply fn args)
;; Now it's safe to be verbose.
(setq-default inhibit-message nil)
;; COMPAT: Once startup is sufficiently complete, undo our earlier
@ -545,70 +537,6 @@ users).")
(setq command-line-x-option-alist nil))))
;;
;;; `doom-context'
(defvar doom-context '(t)
"A list of symbols identifying all active Doom execution contexts.
This should never be directly changed, only let-bound, and should never be
empty. Each context describes what phase Doom is in, and may respond to.
All valid contexts:
cli -- while executing a Doom CLI
compile -- while byte-compiling packages
eval -- during interactive evaluation of elisp
init -- while doom is formally starting up for the first time, after its
core libraries are loaded, but before $DOOMDIR is
modules -- while loading modules configuration files (but not packages)
sandbox -- This session was launched from Doom's sandbox
packages -- while a module's packages.el's file is being evaluated
reload -- while reloading doom with `doom/reload'")
(put 'doom-context 'valid-values '(cli compile eval init modules packages reload doctor sandbox))
(put 'doom-context 'risky-local-variable t)
(defun doom-context--assert (context)
(let ((valid (get 'doom-context 'valid-values)))
(unless (memq context valid)
(signal 'doom-context-error
(list context "Unrecognized context" valid)))))
(defun doom-context-p (context)
"Return t if CONTEXT is active, nil otherwise.
See `doom-context' for possible values for CONTEXT."
(if (memq context doom-context) t))
(defun doom-context-push (context)
"Add CONTEXT to `doom-context', if it isn't already.
Return non-nil if successful. Throws an error if CONTEXT is invalid."
(unless (memq context doom-context)
(doom-context--assert context)
(doom-log ":context: +%s %s" context doom-context)
(push context doom-context)))
(defun doom-context-pop (context &optional strict?)
"Remove CONTEXT from `doom-context'.
Return non-nil if successful. If STRICT? is non-nil, throw an error if CONTEXT
wasn't active when this was called."
(if (not (doom-context-p context))
(when strict?
(signal 'doom-context-error
(list doom-context "Attempt to pop missing context" context)))
(doom-log ":context: -%s %s" context doom-context)
(setq doom-context (delq context doom-context))))
(defmacro with-doom-context (contexts &rest body)
"Evaluate BODY with CONTEXTS added to `doom-context'."
(declare (indent 1))
`(let ((doom-context doom-context))
(dolist (context (ensure-list ,contexts))
(doom-context-push context))
,@body))
;;
;;; Reasonable, global defaults
@ -687,13 +615,17 @@ to `doom-cache-dir'/comp/ instead, so that Doom can safely clean it up as part
of 'doom sync' or 'doom gc'."
(let ((temporary-file-directory (expand-file-name "comp/" doom-profile-cache-dir)))
(make-directory temporary-file-directory t)
(apply fn args))))
(apply fn args)))
(after! comp
;; HACK Disable native-compilation for some troublesome packages
(mapc (doom-partial #'add-to-list 'native-comp-deferred-compilation-deny-list)
(list "/seq-tests\\.el\\'"
"/emacs-jupyter.*\\.el\\'"
"/evil-collection-vterm\\.el\\'"
"/vterm\\.el\\'"
"/with-editor\\.el\\'"))))
;;; Suppress package.el
;; Since Emacs 27, package initialization occurs before `user-init-file' is
;; loaded, but after `early-init-file'. Doom handles package initialization, so
;; we must prevent Emacs from doing it again.
(setq package-enable-at-startup nil)
;;; Reduce unnecessary/unactionable warnings/logs
;; Disable warnings from the legacy advice API. They aren't actionable or
@ -738,6 +670,35 @@ of 'doom sync' or 'doom gc'."
"gnutls-cli -p %p %h"))
;;; Package managers
;; Since Emacs 27, package initialization occurs before `user-init-file' is
;; loaded, but after `early-init-file'. Doom handles package initialization, so
;; we must prevent Emacs from doing it again.
(setq package-enable-at-startup nil)
;; Ensure that, if the user does want package.el, it is configured correctly.
;; You really shouldn't be using it, though...
(with-eval-after-load 'package
(setq package-user-dir (file-name-concat doom-local-dir "elpa/")
package-gnupghome-dir (expand-file-name "gpg" package-user-dir))
(let ((s (if gnutls-verify-error "s" "")))
(prependq! package-archives
;; I omit Marmalade because its packages are manually submitted
;; rather than pulled, and so often out of date.
`(("melpa" . ,(format "http%s://melpa.org/packages/" s))
("org" . ,(format "http%s://orgmode.org/elpa/" s)))))
;; Refresh package.el the first time you call `package-install', so it's still
;; trivially usable. Remember to run 'doom sync' to purge them; they can
;; conflict with packages installed via straight!
(add-transient-hook! 'package-install (package-refresh-contents)))
;; DEPRECATED: Interactive sessions won't be able to interact with Straight (or
;; Elpaca) in the future, so this is temporary.
(with-eval-after-load 'straight
(require 'doom-straight))
;;
;;; Custom hooks
@ -765,47 +726,155 @@ appropriately against `noninteractive' or the `cli' context."
:group 'doom
:type 'hook)
(defcustom doom-before-modules-init-hook nil
"Hooks run before module init.el files are loaded."
:group 'doom
:type 'hook)
(defcustom doom-after-modules-init-hook nil
"Hooks run after module init.el files are loaded."
:group 'doom
:type 'hook)
(defcustom doom-before-modules-config-hook nil
"Hooks run before module config.el files are loaded."
:group 'doom
:type 'hook)
(defcustom doom-after-modules-config-hook nil
"Hooks run after module config.el files are loaded (but before the user's)."
:group 'doom
:type 'hook)
;;
;;; Last minute initialization
;;; Initializers
(when (daemonp)
(message "Starting Doom Emacs in daemon mode...")
(unless doom-inhibit-log
(add-hook! 'doom-after-init-hook :depth 106
(defun doom-initialize (&optional interactive?)
"Bootstrap the Doom session ahead."
(when (doom-context-push 'startup)
(when (daemonp)
(message "Starting Doom Emacs in daemon mode...")
(unless doom-inhibit-log
(setq doom-inhibit-log (not (or noninteractive init-file-debug))))
(message "Disabling verbose mode. Have fun!"))
(add-hook! 'kill-emacs-hook :depth 110
(message "Killing Emacs. Sayonara!"))))
(add-hook! 'doom-after-init-hook :depth 106
(unless doom-inhibit-log
(setq doom-inhibit-log (not (or noninteractive init-file-debug))))
(message "Disabling verbose mode. Have fun!"))
(add-hook! 'kill-emacs-hook :depth 110
(message "Killing Emacs. Sayonara!"))))
(if interactive?
(when (doom-context-push 'emacs)
(add-hook 'doom-after-init-hook #'doom-load-packages-incrementally-h 100)
(add-hook 'doom-after-init-hook #'doom-display-benchmark-h 110)
(doom-run-hook-on 'doom-first-buffer-hook '(find-file-hook doom-switch-buffer-hook))
(doom-run-hook-on 'doom-first-file-hook '(find-file-hook dired-initial-position-hook))
(doom-run-hook-on 'doom-first-input-hook '(pre-command-hook))
;; If the user's already opened something (e.g. with command-line
;; arguments), then we should assume nothing about the user's
;; intentions and simply treat this session as fully initialized.
(add-hook! 'doom-after-init-hook :depth 100
(defun doom-run-first-hooks-if-files-open-h ()
(when file-name-history
(doom-run-hooks 'doom-first-file-hook 'doom-first-buffer-hook))))
;; These fire `MAJOR-MODE-local-vars-hook' hooks, which is a Doomism.
;; See the `MODE-local-vars-hook' section above.
(add-hook 'after-change-major-mode-hook #'doom-run-local-var-hooks-h 100)
(add-hook 'hack-local-variables-hook #'doom-run-local-var-hooks-h)
;; This is the absolute latest a hook can run in Emacs' startup
;; process.
(advice-add #'command-line-1 :after #'doom-finalize)
(require 'doom-start)
(let ((init-file (doom-profile-init-file doom-profile)))
(or (doom-load init-file t)
(signal 'doom-nosync-error (list init-file)))))
(when (doom-context-push 'cli)
;; REVIEW: Remove later. The endpoints should be responsibile for
;; ensuring they exist. For now, they exist to quell file errors.
(with-file-modes #o700
(mapc (doom-rpartial #'make-directory 'parents)
(list doom-local-dir
doom-data-dir
doom-cache-dir
doom-state-dir)))
(doom-require 'doom-lib 'debug)
(if init-file-debug (doom-debug-mode +1))
;; Then load the rest of Doom's libs eagerly, since autoloads may not
;; be generated/loaded yet.
(require 'seq)
(require 'map)
(mapc (doom-partial #'doom-require 'doom-lib)
'(process
system
git
plist
files
print
autoloads
profiles
modules
packages))
;; Ensure the CLI framework is ready.
(require 'doom-cli)
(add-hook 'doom-cli-initialize-hook #'doom-finalize)))
;; HACK: We suppress loading of site files so they can be loaded manually,
;; here. Why? To suppress the otherwise unavoidable output they commonly
;; produce (like deprecation notices, file-loaded messages, and linter
;; warnings). This output pollutes the output of doom's CLI (or scripts
;; derived from it) with potentially confusing or alarming -- but always
;; unimportant -- information to the user.
(let ((site-loader
(lambda ()
(quiet!!
(unless interactive?
(require 'cl nil t)) ; "Package cl is deprecated"
(unless site-run-file
(when-let* ((site-file (get 'site-run-file 'initial-value)))
(let ((inhibit-startup-screen inhibit-startup-screen))
(setq site-run-file site-file)
(load site-run-file t))))))))
(if interactive?
(define-advice startup--load-user-init-file (:before (&rest _) load-site-files 100)
(funcall site-loader))
(funcall site-loader)))
;; A last ditch opportunity to undo hacks or do extra configuration before
;; the session is complicated by user config and packages.
(doom-run-hooks 'doom-before-init-hook)
(add-hook! 'doom-before-init-hook :depth -105
(defun doom--begin-init-h ()
"Begin the startup process."
;; HACK: Later versions of Emacs 30 emit warnings about missing
;; lexical-bindings directives at the top of loaded files. This is a good
;; thing, but it inundates users with unactionable warnings (from old
;; packages or internal subdirs.el files), which aren't useful.
(setq-default delayed-warnings-list
(assq-delete-all 'lexical-binding delayed-warnings-list))
(when (doom-context-push 'init)
;; HACK: Ensure OS checks are as fast as possible (given their ubiquity).
(setq features (cons :system (delq :system features)))
;; Remember these variables' initial values, so we can safely reset them
;; at a later time, or consult them without fear of contamination.
(dolist (var '(exec-path load-path process-environment))
(put var 'initial-value (default-toplevel-value var))))))
(cl-callf2 assq-delete-all 'lexical-binding delayed-warnings-list)
(add-hook! 'doom-after-init-hook :depth 105
(defun doom--end-init-h ()
"Set `doom-init-time'."
(when (doom-context-pop 'init)
(setq doom-init-time (float-time (time-subtract (current-time) before-init-time))))))
;; HACK: Ensure OS checks are as fast as possible (given their ubiquity).
(setq features (cons :system (delq :system features)))
(unless noninteractive
;; This is the absolute latest a hook can run in Emacs' startup process.
(define-advice command-line-1 (:after (&rest _) run-after-init-hook)
(doom-run-hooks 'doom-after-init-hook)))
;; Remember these variables' initial values, so we can safely reset them
;; at a later time, or consult them without fear of contamination.
(dolist (var '(exec-path load-path process-environment))
(put var 'initial-value (default-toplevel-value var)))
t))
(defun doom-finalize (&rest _)
"Finalize the current Doom session, marking the end of its startup process.
Triggers `doom-after-init-hook' and sets `doom-init-time.'"
(when (doom-context-pop 'startup)
(setq doom-init-time (float-time (time-subtract (current-time) before-init-time)))
(doom-run-hooks 'doom-after-init-hook)
t))
(provide 'doom)
;;; doom.el ends here

4
lisp/lib/config.el
View File

@ -104,7 +104,7 @@ Runs `doom-after-reload-hook' afterwards."
(interactive)
(mapc #'require (cdr doom-incremental-packages))
(doom--if-compile doom-reload-command
(with-doom-context '(reload modules)
(with-doom-context '(reload module)
(doom-run-hooks 'doom-before-reload-hook)
(doom-load (file-name-concat doom-user-dir doom-module-init-file) t)
(with-demoted-errors "PRIVATE CONFIG ERROR: %s"
@ -127,7 +127,7 @@ remove orphaned ones. It also doesn't reload your private config.
It is useful to only pull in changes performed by 'doom sync' on the command
line."
(interactive)
(require 'doom-profiles)
(doom-require 'doom-lib 'profiles)
;; TODO: Make this more robust
(with-doom-context 'reload
(dolist (file (mapcar #'car doom-profile-generators))

10
lisp/lib/debug.el
View File

@ -233,7 +233,9 @@ Activate this advice with:
"Returns diagnostic information about the current Emacs session in markdown,
ready to be pasted in a bug report on github."
(require 'vc-git)
(require 'doom-packages)
(doom-require 'doom-lib 'profiles)
(doom-require 'doom-lib 'modules)
(doom-require 'doom-lib 'packages)
(let ((default-directory doom-emacs-dir))
(letf! ((defun sh (&rest args) (cdr (apply #'doom-call-process args)))
(defun cat (file &optional limit)
@ -263,11 +265,7 @@ ready to be pasted in a bug report on github."
(format "EMACSDIR=%s" (symlink-path doom-emacs-dir))
(format "EMACS=%s" (expand-file-name invocation-name invocation-directory)))))
(doom . ,(list doom-version
(if doom-profile
(format "PROFILE=%s@%s"
(car doom-profile)
(cdr doom-profile))
"PROFILE=_@0")
(format "PROFILE=%s" (doom-profile->id (doom-profile-key doom-profile t)))
(if (file-exists-p! ".git" doom-emacs-dir)
(sh "git" "log" "-1" "--format=%D %h %ci")
"[no repo]")

1
lisp/lib/help.el
View File

@ -533,7 +533,6 @@ If prefix arg is present, refresh the cache."
packages nil t nil nil
(when guess (symbol-name guess))))))))
;; TODO Refactor me.
(require 'doom-packages)
(doom-initialize-packages)
(help-setup-xref (list #'doom/help-packages package)
(called-interactively-p 'interactive))

229
lisp/lib/modules.el Normal file
View File

@ -0,0 +1,229 @@
;;; lib/modules.el -*- lexical-binding: t; -*-
;;; Commentary:
;;; Code:
(defvar doom-modules nil
"A table of enabled modules and metadata. See `doom-modules-initialize'.")
(define-obsolete-variable-alias 'doom-modules-dirs 'doom-module-load-path "3.0.0")
(defvar doom-module-load-path
(list (file-name-concat doom-user-dir "modules")
(file-name-concat doom-emacs-dir "modules"))
"A list of paths where Doom should search for modules.
Order determines priority (from highest to lowest).
Each entry is a string; an absolute path to the root directory of a module tree.
In other words, they should contain a two-level nested directory structure,
where the module's group and name was deduced from the first and second level of
directories. For example: if $DOOMDIR/modules/ is an entry, a
$DOOMDIR/modules/lang/ruby/ directory represents a ':lang ruby' module.")
;; DEPRECATED: Remove in v3, as it will be handled in the CLI
(make-obsolete-variable 'doom-obsolete-modules nil "3.0.0")
(defconst doom-obsolete-modules
'((:feature (version-control (:emacs vc) (:ui vc-gutter))
(spellcheck (:checkers spell))
(syntax-checker (:checkers syntax))
(evil (:editor evil))
(snippets (:editor snippets))
(file-templates (:editor file-templates))
(workspaces (:ui workspaces))
(eval (:tools eval))
(lookup (:tools lookup))
(debugger (:tools debugger)))
(:tools (rotate-text (:editor rotate-text))
(vterm (:term vterm))
(password-store (:tools pass))
(flycheck (:checkers syntax))
(flyspell (:checkers spell))
(macos (:os macos)))
(:emacs (electric-indent (:emacs electric))
(hideshow (:editor fold))
(eshell (:term eshell))
(term (:term term)))
(:ui (doom-modeline (:ui modeline))
(fci (:ui fill-column))
(evil-goggles (:ui ophints))
(tabbar (:ui tabs))
(pretty-code (:ui ligatures)))
(:app (email (:email mu4e))
(notmuch (:email notmuch)))
(:lang (perl (:lang raku))))
"A tree alist that maps deprecated modules to their replacement(s).
Each entry is a three-level tree. For example:
(:feature (version-control (:emacs vc) (:ui vc-gutter))
(spellcheck (:checkers spell))
(syntax-checker (:tools flycheck)))
This marks :feature version-control, :feature spellcheck and :feature
syntax-checker modules obsolete. e.g. If :feature version-control is found in
your `doom!' block, a warning is emitted before replacing it with :emacs vc and
:ui vc-gutter.")
(make-obsolete-variable 'doom-inhibit-module-warnings nil "3.0.0")
(defvar doom-inhibit-module-warnings (not noninteractive)
"If non-nil, don't emit deprecated or missing module warnings at startup.")
;;; Module file variables
(defvar doom-module-init-file "init.el"
"The filename for module early initialization config files.
Init files are loaded early, just after Doom core, and before modules' config
files. They are always loaded, even in non-interactive sessions, and before
`doom-before-modules-init-hook'. Related to `doom-module-config-file'.")
(defvar doom-module-config-file "config.el"
"The filename for module configuration files.
Config files are loaded later, and almost always in interactive sessions. These
run before `doom-after-modules-config-hook' and after `doom-module-init-file'.")
(defvar doom-module-packages-file "packages.el"
"The filename for the package configuration file.
Package files are read whenever Doom's package manager wants a manifest of all
desired packages. They are rarely read in interactive sessions (unless the user
uses a straight or package.el command directly).")
;;
;;; API
;;;###autoload
(defun doom-modules-initialize (&optional force?)
"Initializes module metadata."
(when (or (null doom-modules) force?)
(setq doom-modules (make-hash-table :test 'equal))
;; Register Doom's two virtual module categories, representing Doom's core
;; and the user's config; which are always enabled.
(doom-module--put '(:doom . nil) :path doom-core-dir :depth -110)
(doom-module--put '(:user . nil) :path doom-user-dir :depth '(-105 . 105))
;; DEPRECATED: I intend to phase out our internal usage of `use-package' and
;; move it to a :config use-package module. The macro is far too complex
;; and magical for our needs, but until this move is done, ':config
;; use-package' will remain a hardcoded module for backwards
;; compatibility.
(doom-module--put '(:config . use-package)
:path (doom-module-locate-path '(:config . use-package))
:depth -111)
;; Load $DOOMDIR/init.el, where the user's `doom!' lives, which will inform
;; us of all desired modules.
(doom-load (file-name-concat doom-user-dir doom-module-init-file)
'noerror)))
(cl-defun doom-module--put ((group . name) &rest plist)
"Enable GROUP NAME and associate PLIST with it.
This enables the target module, where GROUP is a keyword, NAME is a symbol, and
PLIST is a property list accepting none, any, or all of the following
properties:
:group KEYWORD
Indicating the group this module is in. This doesn't have to match GROUP, as
it could indicate a module alias.
:name SYMBOL
Indicating the name of this module. This doesn't have to match NAME, as it
could indicate a module alias.
:path STRING
Path to the directory where this module lives.
:depth INT|(INITDEPTH . CONFIGDEPTH)
Determines module load order. If a cons cell, INITDEPTH determines the load
order of the module's init.el, while CONFIGDEPTH determines the same for all
other config files (config.el, packages.el, doctor.el, etc).
:flags (SYMBOL...)
A list of activated flags for this module. Will be collapsed into
pre-existing flags for the module.
:features (SYMBOL...)
A list of active features, determined from the module's metadata. Will be
collapsed into any pre-existing features for the module. NOT IMPLEMENTED
YET.
\(fn (GROUP . NAME) &key GROUP NAME PATH DEPTH FLAGS FEATURES)"
(let ((module
(make-doom-module
:index (hash-table-count doom-modules)
:group (or (plist-get plist :group) group)
:name (or (plist-get plist :name) name)
:path (plist-get plist :path)
:flags (plist-get plist :flags)
:features () ; TODO
:depth
(if (not (plist-member plist :depth))
'(0 . 0)
(let ((depth (plist-get plist :depth)))
(cl-check-type depth (or integer cons))
(cond ((integerp depth) (cons depth depth))
((consp depth) (cons (or (car depth) 0)
(or (cdr depth) 0)))
((error "Invalid DEPTH value: %S" depth))))))))
(doom-log 2 "module-put: %s" module)
(prog1 (puthash (cons group name) module doom-modules)
;; PERF: Doom caches module index, flags, and features in symbol plists
;; for fast lookups in `modulep!' and elsewhere. plists are lighter and
;; faster than hash tables for datasets this size, and this information
;; is looked up *very* often.
(put group name (doom-module->context module)))))
(defun doom-module-mplist-map (fn mplist)
"Apply FN to each module in MPLIST."
(let ((mplist (copy-sequence mplist))
(inhibit-message doom-inhibit-module-warnings)
obsolete
results
group m)
(while mplist
(setq m (pop mplist))
(cond ((keywordp m)
(setq group m
obsolete (assq m doom-obsolete-modules)))
((null group)
(error "No module group specified for %s" m))
((and (listp m) (keywordp (car m)))
(pcase (car m)
(:cond
(cl-loop for (cond . mods) in (cdr m)
if (eval cond t)
return (prependq! mplist mods)))
(:if (if (eval (cadr m) t)
(push (caddr m) mplist)
(prependq! mplist (cdddr m))))
(test (if (xor (eval (cadr m) t)
(eq test :unless))
(prependq! mplist (cddr m))))))
((catch 'doom-modules
(let* ((module (if (listp m) (car m) m))
(flags (if (listp m) (cdr m))))
(when-let (new (assq module obsolete))
(let ((newkeys (cdr new)))
(if (null newkeys)
(print! (warn "%s module was removed"))
(if (cdr newkeys)
(print! (warn "%s module was removed and split into the %s modules")
(list group module)
(mapconcat #'prin1-to-string newkeys ", "))
(print! (warn "%s module was moved to %s")
(list group module)
(car newkeys)))
(push group mplist)
(dolist (key newkeys)
(push (if flags
(nconc (cdr key) flags)
(cdr key))
mplist)
(push (car key) mplist))
(throw 'doom-modules t))))
(doom-log "module: %s %s %s -> %s" group module (or flags "")
(doom-module-locate-path (cons group module)))
(push (funcall fn (cons group module)
:flags (if (listp m) (cdr m))
:path (doom-module-locate-path (cons group module)))
results))))))
(when noninteractive
(setq doom-inhibit-module-warnings t))
(nreverse results)))
(provide 'doom-lib '(modules))
;;; modules.el ends here

510
lisp/lib/packages.el
View File

@ -1,4 +1,459 @@
;;; lisp/lib/packages.el -*- lexical-binding: t; -*-
;;; Commentary:
;;
;; Emacs package management is opinionated, and so is Doom. Doom uses `straight'
;; to create a declarative, lazy-loaded, and (nominally) reproducible package
;; management system. We use `straight' over `package' because the latter is
;; tempermental. ELPA sources suffer downtime occasionally and often fail to
;; build packages when GNU Tar is unavailable (e.g. MacOS users start with BSD
;; tar). Known gnutls errors plague the current stable release of Emacs (26.x)
;; which bork TLS handshakes with ELPA repos (mainly gnu.elpa.org). See
;; https://debbugs.gnu.org/cgi/bugreport.cgi?bug=3434.
;;
;; What's worse, you can only get the latest version of packages through ELPA.
;; In an ecosystem that is constantly changing, this is more frustrating than
;; convenient. Straight (and Doom) can do rolling release, but it is opt-in.
;;
;; Interacting with this package management system is done through Doom's
;; bin/doom script. Find out more about it by running 'doom help' (I highly
;; recommend you add the script to your PATH). Here are some highlights:
;;
;; - `doom install`: a wizard that guides you through setting up Doom and your
;; private config for the first time.
;; - `doom sync`: your go-to command for making sure Doom is in optimal
;; condition. It ensures all unneeded packages are removed, all needed ones
;; are installed, and all metadata associated with them is generated.
;; - `doom upgrade`: upgrades Doom Emacs and your packages to the latest
;; versions. There's also 'bin/doom sync -u' for updating only your packages.
;;
;; How this works is: the system reads packages.el files located in each
;; activated module, your private config (`doom-user-dir'), and one in
;; `doom-core-dir'. These contain `package!' declarations that tell DOOM what
;; packages to install and where from.
;;
;; All that said, you can still use package.el's commands, but 'doom sync' will
;; purge ELPA packages.
;;
;;; Code:
;; DEPRECATED: Will be stored in the local profile in v3.0
(defvar doom-packages ()
"A list of enabled packages. Each element is a sublist, whose CAR is the
package's name as a symbol, and whose CDR is the plist supplied to its
`package!' declaration. Set by `doom-initialize-packages'.")
;; DEPRECATED: Will be stored in the local profile in v3.0
(defvar doom-disabled-packages ()
"A list of packages that should be ignored by `use-package!' and `after!'.")
;;
;;; Package management API
(defun doom--ensure-straight (recipe pin)
(letenv! (("GIT_CONFIG" nil)
("GIT_CONFIG_NOSYSTEM" "1")
("GIT_CONFIG_GLOBAL" (or (getenv "DOOMGITCONFIG")
"/dev/null")))
(let ((repo-dir (doom-path straight-base-dir "straight/repos/straight.el"))
(repo-url (concat "http" (if gnutls-verify-error "s")
"://github.com/"
(or (plist-get recipe :repo) "radian-software/straight.el")))
(branch (or (plist-get recipe :branch) straight-repository-branch))
(call (if init-file-debug
(lambda (&rest args)
(print! "%s" (cdr (apply #'doom-call-process args))))
(lambda (&rest args)
(apply #'doom-call-process args)))))
(unless (file-directory-p repo-dir)
(save-match-data
(unless (executable-find "git")
(user-error "Git isn't present on your system. Cannot proceed."))
(let* ((version (cdr (doom-call-process "git" "version")))
(version
(and (string-match "\\_<[0-9]+\\.[0-9]+\\(\\.[0-9]+\\)\\_>" version)
(match-string 0 version))))
(if version
(when (version< version "2.23")
(user-error "Git %s detected! Doom requires git 2.23 or newer!"
version)))))
(print! (start "Installing straight..."))
(print-group!
(cl-destructuring-bind (depth . options)
(ensure-list straight-vc-git-default-clone-depth)
(let ((branch-switch (if (memq 'single-branch options)
"--single-branch"
"--no-single-branch")))
(cond
((eq 'full depth)
(funcall call "git" "clone" "--origin" "origin"
branch-switch repo-url repo-dir))
((integerp depth)
(if (null pin)
(progn
(when (file-directory-p repo-dir)
(delete-directory repo-dir 'recursive))
(funcall call "git" "clone" "--origin" "origin" repo-url
"--no-checkout" repo-dir
"--depth" (number-to-string depth)
branch-switch
"--no-tags"
"--branch" straight-repository-branch))
(make-directory repo-dir 'recursive)
(let ((default-directory repo-dir))
(funcall call "git" "init")
(funcall call "git" "branch" "-m" straight-repository-branch)
(funcall call "git" "remote" "add" "origin" repo-url
"--master" straight-repository-branch)
(funcall call "git" "fetch" "origin" pin
"--depth" (number-to-string depth)
"--no-tags")
(funcall call "git" "reset" "--hard" pin)))))))))
(require 'straight (concat repo-dir "/straight.el"))
(doom-log "Initializing recipes")
(mapc #'straight-use-recipes
'((org-elpa :local-repo nil)
(melpa :type git :host github
:repo "melpa/melpa"
:build nil)
(nongnu-elpa :type git
:repo "https://git.savannah.gnu.org/git/emacs/nongnu.git"
:local-repo "nongnu-elpa"
:build nil)
(gnu-elpa-mirror :type git :host github
:repo "emacs-straight/gnu-elpa-mirror"
:build nil)
(el-get :type git :host github
:repo "dimitri/el-get"
:build nil)
(emacsmirror-mirror :type git :host github
:repo "emacs-straight/emacsmirror-mirror"
:build nil))))))
(defun doom--ensure-core-packages (packages)
(doom-log "Installing core packages")
(dolist (package packages)
(let* ((name (car package))
(repo (symbol-name name)))
(when-let (recipe (plist-get (cdr package) :recipe))
(straight-override-recipe (cons name recipe))
(when-let (local-repo (plist-get recipe :local-repo))
(setq repo local-repo)))
(print-group!
;; Only clone the package, don't build them. Straight hasn't been fully
;; configured by this point.
(straight-use-package name nil t))
;; In case the package hasn't been built yet.
(or (member (directory-file-name (straight--build-dir (symbol-name name)))
load-path)
(add-to-list 'load-path (directory-file-name (straight--repos-dir repo)))))))
;;;###autoload
(defun doom-initialize-core-packages (&optional force-p)
"Ensure `straight' is installed and was compiled with this version of Emacs."
(require 'doom-straight)
(when (or force-p (null (bound-and-true-p straight-recipe-repositories)))
(doom-log "Initializing straight")
(let ((packages (doom-package-list '((:doom)))))
(cl-destructuring-bind (&key recipe pin &allow-other-keys)
(alist-get 'straight packages)
(doom--ensure-straight recipe pin))
(doom--ensure-core-packages
(seq-filter (fn! (eq (plist-get (cdr %) :type) 'core))
packages)))))
;;;###autoload
(defun doom-initialize-packages (&optional force-p)
"Process all packages, essential and otherwise, if they haven't already been.
If FORCE-P is non-nil, do it anyway.
This ensures `doom-packages' is populated and `straight' recipes are properly
processed."
(require 'doom-straight)
(doom-initialize-core-packages force-p)
(when (or force-p (not (bound-and-true-p package--initialized)))
(doom-log "Initializing package.el")
(require 'package)
(package-initialize)
(unless package--initialized
(error "Failed to initialize package.el")))
(when (or force-p (null doom-packages))
(doom-log "Initializing straight.el")
(setq doom-disabled-packages nil
doom-packages (doom-package-list))
(let (packages)
(dolist (package doom-packages)
(cl-destructuring-bind
(name &key recipe disable ignore &allow-other-keys) package
(if ignore
(straight-override-recipe (cons name '(:type built-in)))
(if disable
(cl-pushnew name doom-disabled-packages)
(when recipe
(straight-override-recipe (cons name recipe)))
(appendq! packages (cons name (straight--get-dependencies name)))))))
(dolist (package (cl-delete-duplicates packages :test #'equal))
(straight-register-package package)
(let ((name (symbol-name package)))
(add-to-list 'load-path (directory-file-name (straight--build-dir name)))
(straight--load-package-autoloads name))))))
;;;###autoload
(defun doom-package-get (package &optional prop nil-value)
"Returns PACKAGE's `package!' recipe from `doom-packages'."
(let ((plist (cdr (assq package doom-packages))))
(if prop
(if (plist-member plist prop)
(plist-get plist prop)
nil-value)
plist)))
;;;###autoload
(defun doom-package-set (package prop value)
"Set PROPERTY in PACKAGE's recipe to VALUE."
(setf (alist-get package doom-packages)
(plist-put (alist-get package doom-packages)
prop value)))
;;;###autoload
(defun doom-package-recipe (package &optional prop nil-value)
"Returns the `straight' recipe PACKAGE was registered with."
(let* ((recipe (straight-recipes-retrieve package))
(plist (doom-plist-merge
(plist-get (alist-get package doom-packages) :recipe)
(cdr (if (memq (car recipe) '(quote \`))
(eval recipe t)
recipe)))))
(if prop
(if (plist-member plist prop)
(plist-get plist prop)
nil-value)
plist)))
;;;###autoload
(defun doom-package-recipe-repo (package)
"Resolve and return PACKAGE's (symbol) local-repo property."
(if-let* ((recipe (copy-sequence (doom-package-recipe package)))
(recipe (if (and (not (plist-member recipe :type))
(memq (plist-get recipe :host) '(github gitlab bitbucket)))
(plist-put recipe :type 'git)
recipe))
(repo (if-let (local-repo (plist-get recipe :local-repo))
(directory-file-name local-repo)
(ignore-errors (straight-vc-local-repo-name recipe)))))
repo
(symbol-name package)))
;;;###autoload
(defun doom-package-build-recipe (package &optional prop nil-value)
"Returns the `straight' recipe PACKAGE was installed with."
(let ((plist (nth 2 (gethash (symbol-name package) straight--build-cache))))
(if prop
(if (plist-member plist prop)
(plist-get plist prop)
nil-value)
plist)))
;;;###autoload
(defun doom-package-dependencies (package &optional recursive noerror)
"Return a list of dependencies for a package.
If RECURSIVE is `tree', return a tree of dependencies.
If RECURSIVE is nil, only return PACKAGE's immediate dependencies.
If NOERROR, return nil in case of error."
(cl-check-type package symbol)
(let ((deps (straight-dependencies (symbol-name package))))
(pcase recursive
(`tree deps)
(`t (flatten-list deps))
(`nil (cl-remove-if #'listp deps)))))
;;;###autoload
(defun doom-package-depending-on (package &optional noerror)
"Return a list of packages that depend on PACKAGE.
If PACKAGE (a symbol) isn't installed, throw an error, unless NOERROR is
non-nil."
(cl-check-type package symbol)
;; can't get dependencies for built-in packages
(unless (or (doom-package-build-recipe package)
noerror)
(error "Couldn't find %s, is it installed?" package))
(straight-dependents (symbol-name package)))
;;; Predicate functions
;;;###autoload
(defun doom-package-built-in-p (package)
"Return non-nil if PACKAGE (a symbol) is built-in."
(eq (doom-package-build-recipe package :type)
'built-in))
;;;###autoload
(defun doom-package-installed-p (package)
"Return non-nil if PACKAGE (a symbol) is installed."
(file-directory-p (straight--build-dir (symbol-name package))))
;;;###autoload
(defun doom-package-is-type-p (package type)
"TODO"
(memq type (ensure-list (doom-package-get package :type))))
;;;###autoload
(defun doom-package-in-module-p (package category &optional module)
"Return non-nil if PACKAGE was installed by the user's private config."
(when-let (modules (doom-package-get package :modules))
(or (and (not module) (assq :user modules))
(member (cons category module) modules))))
;;;###autoload
(defun doom-package-backend (package)
"Return 'straight, 'builtin, 'elpa or 'other, depending on how PACKAGE is
installed."
(cond ((gethash (symbol-name package) straight--build-cache)
'straight)
((or (doom-package-built-in-p package)
(assq package package--builtins))
'builtin)
((assq package package-alist)
'elpa)
((locate-library (symbol-name package))
'other)))
;;; Package getters
(defun doom-packages--read (file &optional noeval noerror)
(condition-case-unless-debug e
(with-temp-buffer ; prevent buffer-local state from propagating
(if (not noeval)
(load file noerror 'nomessage 'nosuffix)
(when (file-exists-p file)
(insert-file-contents file)
(with-syntax-table emacs-lisp-mode-syntax-table
;; Scrape `package!' blocks from FILE for a comprehensive listing of
;; packages used by this module.
(while (search-forward "(package!" nil t)
(let ((ppss (save-excursion (syntax-ppss))))
;; Don't collect packages in comments or strings
(unless (or (nth 3 ppss)
(nth 4 ppss))
(goto-char (match-beginning 0))
(cl-destructuring-bind (_ name . plist)
(read (current-buffer))
(push (cons
name (plist-put
plist :modules
(list (doom-module-context-key doom-module-context))))
doom-packages)))))))))
(user-error
(user-error (error-message-string e)))
(error
(signal 'doom-package-error
(list (doom-module-context-key doom-module-context)
file e)))))
;;;###autoload
(defun doom-package-list (&optional module-list)
"Retrieve a list of explicitly declared packages from MODULE-LIST.
If MODULE-LIST is omitted, read enabled module list in configdepth order (see
`doom-module-set'). Otherwise, MODULE-LIST may be any symbol (or t) to mean read
all modules in `doom-modules-dir', including :doom and :user. MODULE-LIST may
also be a list of module keys."
(let ((module-list (cond ((null module-list) (doom-module-list))
((symbolp module-list) (doom-module-list 'all))
(module-list)))
(packages-file doom-module-packages-file)
doom-disabled-packages
doom-packages)
(letf! (defun read-packages (key)
(with-doom-module key
(when-let (file (doom-module-locate-path
key doom-module-packages-file))
(doom-packages--read file nil 'noerror))))
(with-doom-context 'package
(let ((user? (assq :user module-list)))
(when user?
;; We load the private packages file twice to populate
;; `doom-disabled-packages' disabled packages are seen ASAP...
(let (doom-packages)
(read-packages (cons :user nil))))
(mapc #'read-packages module-list)
;; ...Then again to ensure privately overriden packages are properly
;; overwritten.
(if user? (read-packages (cons :user nil)))
(nreverse doom-packages))))))
;;;###autoload
(defun doom-package-pinned-alist ()
"Return an alist mapping package names (strings) to pinned commits (strings)."
(let (alist)
(dolist (package doom-packages alist)
(cl-destructuring-bind (name &key disable ignore pin unpin &allow-other-keys)
package
(when (and (not ignore)
(not disable)
(or pin unpin))
(setf (alist-get (file-name-nondirectory (doom-package-recipe-repo name))
alist nil 'remove #'equal)
(unless unpin pin)))))))
;;;###autoload
(defun doom-package-recipe-alist ()
"Return straight recipes for non-builtin packages with a local-repo."
(let (recipes)
(dolist (recipe (hash-table-values straight--recipe-cache))
(cl-destructuring-bind (&key local-repo type &allow-other-keys)
recipe
(unless (or (null local-repo)
(eq type 'built-in))
(push recipe recipes))))
(nreverse recipes)))
;;;###autoload
(defun doom-package-homepage (package)
"return the url to package's homepage (usually a repo)."
(doom-initialize-packages)
(or (get package 'homepage)
(put package 'homepage
(cond ((when-let (location (locate-library (symbol-name package)))
(with-temp-buffer
(if (string-match-p "\\.gz$" location)
(jka-compr-insert-file-contents location)
(insert-file-contents (concat (file-name-sans-extension location) ".el")
nil 0 4096))
(let ((case-fold-search t))
(when (re-search-forward " \\(?:url\\|homepage\\|website\\): \\(http[^\n]+\\)\n" nil t)
(match-string-no-properties 1))))))
((when-let ((recipe (straight-recipes-retrieve package)))
(straight--with-plist (straight--convert-recipe recipe)
(host repo)
(pcase host
(`github (format "https://github.com/%s" repo))
(`gitlab (format "https://gitlab.com/%s" repo))
(`bitbucket (format "https://bitbucket.com/%s" (plist-get plist :repo)))
(`git repo)
(_ nil)))))
((or package-archive-contents
(progn (package-refresh-contents)
package-archive-contents))
(pcase (ignore-errors (package-desc-archive (cadr (assq package package-archive-contents))))
(`nil nil)
("org" "https://orgmode.org")
((or "melpa" "melpa-mirror")
(format "https://melpa.org/#/%s" package))
("gnu"
(format "https://elpa.gnu.org/packages/%s.html" package))
(archive
(if-let (src (cdr (assoc package package-archives)))
(format "%s" src)
(user-error "%s isn't installed through any known source (%s)"
package archive)))))
((user-error "Can't get homepage for %S package" package))))))
;;
;;; Commands
;;;###autoload
(defun doom/reload-packages ()
@ -9,10 +464,6 @@
(doom-initialize-packages t)
(message "Reloading packages...DONE"))
;;
;;; Bump commands
(defun doom--package-merge-recipes (package plist)
(require 'straight)
(doom-plist-merge
@ -49,7 +500,7 @@
(or buffer-file-name
(bound-and-true-p org-src-source-file-name)))
(package
(with-doom-context 'packages
(with-doom-context 'package
(with-doom-module (doom-module-from-path buffer-file-name)
(eval (sexp-at-point) t)))))
(list :beg beg
@ -191,10 +642,6 @@ each package."
(when (doom-module-locate-path module doom-module-packages-file)
(doom/bump-module (car module) (cdr module))))))
;;
;;; Bump commits
;;;###autoload
(defun doom/bumpify-diff (&optional interactive)
"Copy user/repo@hash -> user/repo@hash's of changed packages to clipboard.
@ -273,50 +720,5 @@ Must be run from a magit diff buffer."
(magit-commit-create
(list "-e" "-m" (doom/bumpify-diff))))
;;
;;; Package metadata
;;;###autoload
(defun doom-package-homepage (package)
"Return the url to PACKAGE's homepage (usually a repo)."
(doom-initialize-packages)
(or (get package 'homepage)
(put package 'homepage
(cond ((when-let (location (locate-library (symbol-name package)))
(with-temp-buffer
(if (string-match-p "\\.gz$" location)
(jka-compr-insert-file-contents location)
(insert-file-contents (concat (file-name-sans-extension location) ".el")
nil 0 4096))
(let ((case-fold-search t))
(when (re-search-forward " \\(?:URL\\|homepage\\|Website\\): \\(http[^\n]+\\)\n" nil t)
(match-string-no-properties 1))))))
((when-let ((recipe (straight-recipes-retrieve package)))
(straight--with-plist (straight--convert-recipe recipe)
(host repo)
(pcase host
(`github (format "https://github.com/%s" repo))
(`gitlab (format "https://gitlab.com/%s" repo))
(`bitbucket (format "https://bitbucket.com/%s" (plist-get plist :repo)))
(`git repo)
(_ nil)))))
((or package-archive-contents
(progn (package-refresh-contents)
package-archive-contents))
(pcase (ignore-errors (package-desc-archive (cadr (assq package package-archive-contents))))
(`nil nil)
("org" "https://orgmode.org")
((or "melpa" "melpa-mirror")
(format "https://melpa.org/#/%s" package))
("gnu"
(format "https://elpa.gnu.org/packages/%s.html" package))
(archive
(if-let (src (cdr (assoc package package-archives)))
(format "%s" src)
(user-error "%S isn't installed through any known source (%s)"
package archive)))))
((user-error "Can't get homepage for %S package" package))))))
(provide 'doom-lib '(packages))
;;; packages.el ends here

399
lisp/doom-profiles.el → lisp/lib/profiles.el
View File

@ -1,11 +1,6 @@
;;; lisp/doom-profiles.el -*- lexical-binding: t; -*-
;;; lisp/lib/profiles.el -*- lexical-binding: t; -*-
;;; Commentary:
;;; Code:
(eval-when-compile (require 'doom)) ; be silent, o'byte-compiler
;;
;;; Variables
;;; File/directory variables
(defvar doom-profiles-generated-dir doom-data-dir
@ -46,29 +41,28 @@ list of paths or profile config files (semi-colon delimited on Windows).")
Can be changed externally by setting $DOOMPROFILELOADFILE.")
(defvar doom-profile-init-file-name (format "init.%d.el" emacs-major-version)
(defvar doom-profile-env-file-name "init.env.el"
"TODO")
(defvar doom-profile-init-dir-name (format "init.%d.d" emacs-major-version)
"The subdirectory of `doom-profile-dir'")
(defvar doom-profiles-config-file-name ".doomprofile"
(defvar doom-profile-rcfile ".doomprofile"
"TODO")
;;; Profile storage variables
(defvar doom-profile-generators
'(("05-init-vars.auto.el" . doom-profile--generate-init-vars)
'(("05-vars.auto.el" . doom-profile--generate-init-vars)
("80-loaddefs.auto.el" . doom-profile--generate-doom-autoloads)
("90-loaddefs-packages.auto.el" . doom-profile--generate-package-autoloads)
("95-load-modules.auto.el" . doom-profile--generate-load-modules))
("95-modules.auto.el" . doom-profile--generate-load-modules))
"An alist mapping file names to generator functions.
The file will be generated in `doom-profile-dir'/`doom-profile-init-dir-name',
and later combined into `doom-profile-dir'/`doom-profile-init-file-name' in
lexicographical order. These partials are left behind in case the use wants to
load them directly (for whatever use), or for commands to use (e.g.
`doom/reload-autoloads' loads any file with a NN-loaddefs[-.] prefix to
accomplish its namesake).
and later combined into `doom-profile-dir' in lexicographical order. These
partials are left behind in case the use wants to load them directly (for
whatever use), or for commands to use (e.g. `doom/reload-autoloads' loads any
file with a NN-loaddefs[-.] prefix to accomplish its namesake).
Files with an .auto.el suffix will be automatically deleted whenever the profile
is regenerated. Users (or Doom CLIs, like `doom env') may add their own
@ -78,7 +72,11 @@ run.")
(defvar doom--profiles ())
(defconst doom-profile-default (cons "_" "0"))
;;
;;; Bootstrappers
;; (defun doom-profile-initialize (profile &optional project-dir nocache?))
;;
@ -92,13 +90,14 @@ run.")
(defun doom-profiles-read (&rest paths)
"TODO"
(let (profiles)
(let ((key (doom-profile-key t))
profiles)
(dolist (path (delq nil (flatten-list paths)))
(cond
((file-directory-p path)
(setq path (file-truename path))
(dolist (subdir (doom-files-in path :depth 0 :match "/[^.][^/]+$" :type 'dirs :map #'file-name-base))
(if (equal subdir (car doom-profile-default))
(if (equal subdir (car key))
(signal 'doom-profile-error (list (file-name-concat path subdir) "Implicit profile has invalid name"))
(unless (string-prefix-p "_" subdir)
(cl-pushnew
@ -108,7 +107,7 @@ run.")
`(,val)
`(,(abbreviate-file-name path) ,val))))
(cons `(user-emacs-directory :path ,@val)
(if-let (profile-file (file-exists-p! doom-profiles-config-file-name path))
(if-let (profile-file (file-exists-p! doom-profile-rcfile path))
(car (doom-file-read profile-file :by 'read*))
(when (file-exists-p (doom-path path subdir "lisp/doom.el"))
'((doom-user-dir :path ,@val)))))))
@ -117,7 +116,7 @@ run.")
:key #'car)))))
((file-exists-p path)
(dolist (profile (car (doom-file-read path :by 'read*)))
(if (eq (symbol-name (car profile)) (car doom-profile-default))
(if (eq (symbol-name (car profile)) (car key))
(signal 'doom-profile-error (list path "Profile has invalid name: _"))
(unless (string-prefix-p "_" (symbol-name (car profile)))
(cl-pushnew profile profiles
@ -125,6 +124,95 @@ run.")
:key #'car)))))))
(nreverse profiles)))
(defun doom-profiles-write-load-file (profiles &optional file)
"Generate a profile bootstrapper for Doom to load at startup."
(unless file
(setq file doom-profile-load-file))
(doom-file-write
file `(";; -*- lexical-binding: t; tab-width: 8; -*-\n"
";; Updated: " ,(format-time-string "%Y-%m-%d %H:%M:%S") "\n"
";; Generated by 'doom profiles sync' or 'doom sync'.\n"
";; DO NOT EDIT THIS BY HAND!\n"
,(format "%S" doom-version)
(pcase (intern (getenv-internal "DOOMPROFILE"))
,@(cl-loop
for (profile-name . bindings) in profiles
for deferred?
= (seq-find (fn! (and (memq (car-safe (cdr %)) '(:prepend :prepend? :append :append?))
(not (stringp (car-safe %)))))
bindings)
collect
`(',profile-name
(let ,(if deferred? '(--deferred-vars--))
,@(cl-loop
for (var . val) in bindings
collect
(pcase (car-safe val)
(:path
`(,(if (stringp var) 'setenv 'setq)
,var ,(cl-loop with form = `(expand-file-name ,(cadr val) user-emacs-directory)
for dir in (cddr val)
do (setq form `(expand-file-name ,dir ,form))
finally return form)))
(:eval
(if (eq var '_)
(macroexp-progn (cdr val))
`(,(if (stringp var) 'setenv 'setq)
,var ,(macroexp-progn (cdr val)))))
(:plist
`(,(if (stringp var) 'setenv 'setq)
,var ',(if (stringp var)
(prin1-to-string (cadr val))
(cadr val))))
((or :prepend :prepend?)
(if (stringp var)
`(setenv ,var (concat ,val (getenv ,var)))
(setq deferred? t)
`(push (cons ',var
(lambda ()
(dolist (item (list ,@(cdr val)))
,(if (eq (car val) :append?)
`(add-to-list ',var item)
`(push item ,var)))))
--deferred-vars--)))
((or :append :append?)
(if (stringp var)
`(setenv ,var (concat (getenv ,var) ,val))
(setq deferred? t)
`(push (cons ',var
(lambda ()
(dolist (item (list ,@(cdr val)))
,(if (eq (car val) :append?)
`(add-to-list ',var item 'append)
`(set ',var (append ,var (list item)))))))
--deferred-vars--)))
(_ `(,(if (stringp var) 'setenv 'setq) ,var ',val))))
,@(when deferred?
`((defun --doom-profile-set-deferred-vars-- (_)
(dolist (var --deferred-vars--)
(when (boundp (car var))
(funcall (cdr var))
(setq --deferred-vars-- (delete var --deferred-vars--))))
(unless --deferred-vars--
(remove-hook 'after-load-functions #'--doom-profile-set-deferred-vars--)
(unintern '--doom-profile-set-deferred-vars-- obarray)))
(add-hook 'after-load-functions #'--doom-profile-set-deferred-vars--)
(--doom-profile-set-deferred-vars-- nil)))))))
;; `user-emacs-directory' requires that it end in a directory
;; separator, but users may forget this in their profile configs.
(setq user-emacs-directory (file-name-as-directory user-emacs-directory)))
:mode (cons #o600 #o700)
:printfn #'prin1)
(print-group!
(or (let ((byte-compile-warnings (if init-file-debug byte-compile-warnings))
(byte-compile-dest-file-function
(lambda (_) (format "%s.elc" (file-name-sans-extension file)))))
(byte-compile-file file))
;; Do it again? So the errors/warnings are visible?
;; (let ((byte-compile-warnings t))
;; (byte-compile-file file))
(signal 'doom-profile-error (list file "Failed to byte-compile bootstrap file")))))
(defun doom-profiles-autodetect (&optional _internal?)
"Return all known profiles as a nested alist.
@ -145,176 +233,7 @@ caches them in `doom--profiles'. If RELOAD? is non-nil, refresh the cache."
doom-version)))
return t))
(defun doom-profile<-id (id)
"Return a (NAME . VERSION) profile cons cell from an id string NAME@VERSION."
(save-match-data
(if (string-match "^\\([^@]+\\)@\\(.+\\)$" id)
(cons (match-string 1 id)
(match-string 2 id))
(cons id (cdr doom-profile-default)))))
(defun doom-profile->id (profile)
"Return a NAME@VERSION id string from profile cons cell (NAME . VERSION)."
(cl-check-type profile cons)
(format "%s@%s" (car profile) (cdr profile)))
;; TODO (defun doom-profile--read (profile)
;; (doom-profile-create ))
;; TODO (defun doom-profile-initialize (profile-name &optional ref)
;; )
(defun doom-profiles-save (profiles &optional file)
"Generate a profile bootstrapper for Doom to load at startup."
(unless file
(setq file doom-profile-load-file))
(doom-file-write
file (let ((profilesym (make-symbol "profile"))
(deferredsym (make-symbol "deferred-vars")))
`(";; -*- lexical-binding: t; tab-width: 8; -*-\n"
";; Updated: " ,(format-time-string "%Y-%m-%d %H:%M:%S") "\n"
";; Generated by 'doom profiles sync' or 'doom sync'.\n"
";; DO NOT EDIT THIS BY HAND!\n"
,(format "%S" doom-version)
(pcase (intern (getenv-internal "DOOMPROFILE"))
,@(cl-loop
for (profile-name . bindings) in profiles
for deferred?
= (seq-find (fn! (and (memq (car-safe (cdr %)) '(:prepend :prepend? :append :append?))
(not (stringp (car-safe %)))))
bindings)
collect
`(',profile-name
(let ,(if deferred? '(--deferred-vars--))
,@(cl-loop
for (var . val) in bindings
collect
(pcase (car-safe val)
(:path
`(,(if (stringp var) 'setenv 'setq)
,var ,(cl-loop with form = `(expand-file-name ,(cadr val) user-emacs-directory)
for dir in (cddr val)
do (setq form `(expand-file-name ,dir ,form))
finally return form)))
(:eval
(if (eq var '_)
(macroexp-progn (cdr val))
`(,(if (stringp var) 'setenv 'setq)
,var ,(macroexp-progn (cdr val)))))
(:plist
`(,(if (stringp var) 'setenv 'setq)
,var ',(if (stringp var)
(prin1-to-string (cadr val))
(cadr val))))
((or :prepend :prepend?)
(if (stringp var)
`(setenv ,var (concat ,val (getenv ,var)))
(setq deferred? t)
`(push (cons ',var
(lambda ()
(dolist (item (list ,@(cdr val)))
,(if (eq (car val) :append?)
`(add-to-list ',var item)
`(push item ,var)))))
--deferred-vars--)))
((or :append :append?)
(if (stringp var)
`(setenv ,var (concat (getenv ,var) ,val))
(setq deferred? t)
`(push (cons ',var
(lambda ()
(dolist (item (list ,@(cdr val)))
,(if (eq (car val) :append?)
`(add-to-list ',var item 'append)
`(set ',var (append ,var (list item)))))))
--deferred-vars--)))
(_ `(,(if (stringp var) 'setenv 'setq) ,var ',val))))
,@(when deferred?
`((defun --doom-profile-set-deferred-vars-- (_)
(dolist (var --deferred-vars--)
(when (boundp (car var))
(funcall (cdr var))
(setq --deferred-vars-- (delete var --deferred-vars--))))
(unless --deferred-vars--
(remove-hook 'after-load-functions #'--doom-profile-set-deferred-vars--)
(unintern '--doom-profile-set-deferred-vars-- obarray)))
(add-hook 'after-load-functions #'--doom-profile-set-deferred-vars--)
(--doom-profile-set-deferred-vars-- nil)))))))
;; `user-emacs-directory' requires that it end in a directory
;; separator, but users may forget this in their profile configs.
(setq user-emacs-directory (file-name-as-directory user-emacs-directory))))
:mode (cons #o600 #o700)
:printfn #'pp)
(print-group!
(or (let ((byte-compile-warnings (if init-file-debug byte-compile-warnings))
(byte-compile-dest-file-function
(lambda (_) (format "%s.elc" (file-name-sans-extension file)))))
(byte-compile-file file))
;; Do it again? So the errors/warnings are visible?
;; (let ((byte-compile-warnings t))
;; (byte-compile-file file))
(signal 'doom-profile-error (list file "Failed to byte-compile bootstrap file")))))
(defun doom-profile-p (profile-name)
"Return t if PROFILE-NAME is a valid and existing profile."
(when (stringp profile-name)
(setq profile-name (intern profile-name)))
(and (assq profile-name (doom-profiles))
t))
(defun doom-profile-get (profile-name &optional property null-value)
"Return PROFILE-NAME's PROFILE, otherwise its PROPERTY, otherwise NULL-VALUE."
(when (stringp profile-name)
(setq profile-name (intern profile-name)))
(if-let (profile (assq profile-name (doom-profiles)))
(if property
(if-let (propval (assq property (cdr profile)))
(cdr propval)
null-value)
profile)
null-value))
(defun doom-profile-emacs-dir (profile-name)
"Return the `user-emacs-directory' for PROFILE-NAME.
If the profile doesn't specify one, fall back to `doom-emacs-dir'."
(doom-profile-get profile-name 'user-emacs-directory doom-emacs-dir))
(defun doom-profile-init-file (&optional profile-id version)
"Return the init file for PROFILE-ID at VERSION.
Defaults to the profile at `doom-profile-default'."
(cl-destructuring-bind (profile . version)
(if (and (stringp profile-id) (null version))
(doom-profile<-id profile-id)
(cl-check-type profile-id (or null string))
(cl-check-type version (or null string))
(cons (or profile-id ;; (car doom-profile-default)
)
(or version ;; (cdr doom-profile-default)
)))
(file-name-concat doom-data-dir
profile "@" version
(format doom-profile-init-file-name emacs-major-version))))
;;
;;; Data structures
;; TODO
;;
;;; API
;; TODO (defun doom-profile-create (name))
;; TODO (defun doom-profile-hash (profile))
;; TODO (defmacro with-profile! (profile &rest body))
;;
;;; Generators
(defun doom-profile-generate (&optional _profile regenerate-only?)
@ -322,8 +241,8 @@ Defaults to the profile at `doom-profile-default'."
(doom-initialize-packages)
(let* ((default-directory doom-profile-dir)
(init-dir doom-profile-init-dir-name)
(init-file doom-profile-init-file-name))
(print! (start "(Re)building profile in %s/...") (dirname doom-profile-dir))
(init-file (doom-profile-init-file doom-profile t)))
(print! (start "(Re)building profile in %s/...") (path default-directory))
(condition-case-unless-debug e
(with-file-modes #o750
(print-group!
@ -343,7 +262,9 @@ Defaults to the profile at `doom-profile-default'."
(pcase-dolist (`(,file . ,fn) doom-profile-generators)
(let ((file (doom-path init-dir file)))
(doom-log "Building %s..." file)
(doom-file-write file (funcall fn))))))
(insert "\n;;;; START " file " ;;;;\n")
(doom-file-write file (funcall fn) :printfn #'prin1)
(insert "\n;;;; END " file " ;;;;\n")))))
(with-file! init-file
(insert ";; -*- coding: utf-8; lexical-binding: t; -*-\n"
";; This file was autogenerated; do not edit it by hand!\n")
@ -351,11 +272,19 @@ Defaults to the profile at `doom-profile-default'."
;; up/downgraded. This is because byte-code isn't backwards
;; compatible, and many packages (including Doom), bake in absolute
;; paths into their caches that need to be refreshed.
(prin1 `(unless (equal doom-version ,doom-version)
(error ,(concat
"The installed version of Doom (%s) has changed (to %s) since last "
"'doom sync'. Run 'doom sync' to bring Doom up to speed")
,doom-version doom-version))
(prin1 `(or (equal doom-version ,doom-version)
(error ,(concat
"The installed version of Doom has changed since the last 'doom sync'.\n\n"
"Run 'doom sync' to fix this.")
,doom-version doom-version))
(current-buffer))
(prin1 `(when (and (or initial-window-system
(daemonp))
doom-env-file)
(doom-load-envvars-file doom-env-file 'noerror))
(current-buffer))
(prin1 `(with-doom-context '(module init)
(doom-load (file-name-concat doom-user-dir ,doom-module-init-file) t))
(current-buffer))
(dolist (file (doom-glob init-dir "*.el"))
(print-group! :level 'info
@ -374,8 +303,7 @@ Defaults to the profile at `doom-profile-default'."
;; FIX: Make sure this only runs at startup to protect us Emacs' interpreter
;; re-evaluating this file when lazy-loading dynamic docstrings from the
;; byte-compiled init file.
`((when (or (doom-context-p 'init)
(doom-context-p 'reload))
`((defun doom--startup-vars ()
,@(cl-loop for var in doom-autoloads-cached-vars
if (boundp var)
collect `(set-default ',var ',(symbol-value var)))
@ -430,49 +358,52 @@ Defaults to the profile at `doom-profile-default'."
if (doom-module-locate-path key file)
collect (module-loader key it))))
;; FIX: Same as above (see `doom-profile--generate-init-vars').
`((if (or (doom-context-p 'init)
(doom-context-p 'reload))
(with-doom-context 'modules
(set 'doom-modules ',doom-modules)
(set 'doom-disabled-packages ',doom-disabled-packages)
;; Cache module state and flags in symbol plists for quick lookup
;; by `modulep!' later.
,@(cl-loop
for (category . modules) in (seq-group-by #'car config-modules-list)
collect
`(setplist ',category
(quote ,(cl-loop for (_ . module) in modules
nconc `(,module ,(doom-module->context (cons category module)))))))
(let ((old-custom-file custom-file))
`((defun doom--startup-modules ()
(with-doom-context 'module
(set 'doom-modules ',doom-modules)
(set 'doom-disabled-packages ',doom-disabled-packages)
;; Cache module state and flags in symbol plists for quick lookup
;; by `modulep!' later.
,@(cl-loop
for (category . modules) in (seq-group-by #'car config-modules-list)
collect
`(setplist ',category
(quote ,(cl-loop for (_ . module) in modules
nconc `(,module ,(doom-module->context (cons category module)))))))
(let ((old-custom-file custom-file))
(with-doom-context 'init
,@(module-list-loader pre-init-modules init-file)
(doom-run-hooks 'doom-before-modules-init-hook)
,@(module-list-loader init-modules init-file)
(doom-run-hooks 'doom-after-modules-init-hook)
(doom-run-hooks 'doom-after-modules-init-hook))
(with-doom-context 'config
(doom-run-hooks 'doom-before-modules-config-hook)
,@(module-list-loader config-modules config-file)
(doom-run-hooks 'doom-after-modules-config-hook)
,@(module-list-loader post-config-modules config-file)
(when (eq custom-file old-custom-file)
(doom-load custom-file 'noerror)))))))))
,@(module-list-loader post-config-modules config-file))
(when (eq custom-file old-custom-file)
(doom-load custom-file 'noerror)))))))))
(defun doom-profile--generate-doom-autoloads ()
(doom-autoloads--scan
(append (doom-glob doom-core-dir "lib/*.el")
(cl-loop for dir
in (append (doom-module-load-path)
(list doom-user-dir))
if (doom-glob dir "autoload.el") collect (car it)
if (doom-glob dir "autoload/*.el") append it)
(mapcan #'doom-glob doom-autoloads-files))
nil))
`((defun doom--startup-module-autoloads ()
,@(doom-autoloads--scan
(append (doom-glob doom-core-dir "lib/*.el")
(cl-loop for dir
in (append (doom-module-load-path)
(list doom-user-dir))
if (doom-glob dir "autoload.el") collect (car it)
if (doom-glob dir "autoload/*.el") append it)
(mapcan #'doom-glob doom-autoloads-files))
nil))))
(defun doom-profile--generate-package-autoloads ()
(doom-autoloads--scan
(mapcar #'straight--autoloads-file
(nreverse (seq-difference (hash-table-keys straight--build-cache)
doom-autoloads-excluded-packages)))
doom-autoloads-excluded-files
'literal))
`((defun doom--startup-package-autoloads ()
,@(doom-autoloads--scan
(mapcar #'straight--autoloads-file
(nreverse (seq-difference (hash-table-keys straight--build-cache)
doom-autoloads-excluded-packages)))
doom-autoloads-excluded-files
'literal))))
(provide 'doom-profiles)
;;; doom-profiles.el ends here
(provide 'doom-lib '(profiles))
;;; profiles.el ends here