awesome-emacs/doomemacs
1
0
Fork 0
mirror of https://github.com/doomemacs/doomemacs synced 2025-08-09 12:57: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

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

409
lisp/lib/profiles.el Normal file
View File

@ -0,0 +1,409 @@
;;; lisp/lib/profiles.el -*- lexical-binding: t; -*-
;;; Commentary:
;;; Code:
;;; File/directory variables
(defvar doom-profiles-generated-dir doom-data-dir
"Where generated profiles are kept.
Profile directories are in the format {data-profiles-dir}/$NAME/@/$VERSION, for
example: '~/.local/share/doom/_/@/0/'")
(defvar doom-profile-load-path
(if-let (path (getenv-internal "DOOMPROFILELOADPATH"))
(mapcar #'expand-file-name (split-string-and-unquote path path-separator))
(list (file-name-concat doom-user-dir "profiles.el")
(file-name-concat doom-emacs-dir "profiles.el")
(expand-file-name "doom-profiles.el" (or (getenv "XDG_CONFIG_HOME") "~/.config"))
(expand-file-name "~/.doom-profiles.el")
(file-name-concat doom-user-dir "profiles")
(file-name-concat doom-emacs-dir "profiles")))
"A list of profile config files or directories that house implicit profiles.
`doom-profiles-initialize' loads and merges all profiles defined in the above
files/directories, then writes a profile load script to
`doom-profile-load-file'.
Can be changed externally by setting $DOOMPROFILELOADPATH to a colon-delimited
list of paths or profile config files (semi-colon delimited on Windows).")
(defvar doom-profile-load-file
;; REVIEW: Derive from `doom-data-dir' in v3
(expand-file-name
(format (or (getenv-internal "DOOMPROFILELOADFILE")
(file-name-concat (if doom--system-windows-p "doomemacs/data" "doom")
"profiles.%d.el"))
emacs-major-version)
(or (if doom--system-windows-p (getenv-internal "LOCALAPPDATA"))
(getenv-internal "XDG_DATA_HOME")
"~/.local/share"))
"Where Doom writes its interactive profile loader script.
Can be changed externally by setting $DOOMPROFILELOADFILE.")
(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-profile-rcfile ".doomprofile"
"TODO")
;;; Profile storage variables
(defvar doom-profile-generators
'(("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-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' 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
generators to this list, or to `doom-profile-dir'/`doom-profile-init-dir-name',
and they will be included in the profile init file next time `doom sync' is
run.")
(defvar doom--profiles ())
;;
;;; Bootstrappers
;; (defun doom-profile-initialize (profile &optional project-dir nocache?))
;;
;;; Helpers
(defun doom-profiles-bootloadable-p ()
"Return non-nil if `doom-emacs-dir' can be a bootloader."
(with-memoization (get 'doom 'bootloader)
(or (file-equal-p doom-emacs-dir "~/.config/emacs")
(file-equal-p doom-emacs-dir "~/.emacs.d"))))
(defun doom-profiles-read (&rest paths)
"TODO"
(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 key))
(signal 'doom-profile-error (list (file-name-concat path subdir) "Implicit profile has invalid name"))
(unless (string-prefix-p "_" subdir)
(cl-pushnew
(cons (intern subdir)
(let* ((val (abbreviate-file-name (file-name-as-directory subdir)))
(val (if (file-name-absolute-p val)
`(,val)
`(,(abbreviate-file-name path) ,val))))
(cons `(user-emacs-directory :path ,@val)
(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)))))))
profiles
:test #'eq
:key #'car)))))
((file-exists-p path)
(dolist (profile (car (doom-file-read path :by 'read*)))
(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
:test #'eq
: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.
This reads all profile configs and directories in `doom-profile-load-path', then
caches them in `doom--profiles'. If RELOAD? is non-nil, refresh the cache."
(doom-profiles-read doom-profile-load-path
;; TODO: Add in v3
;; (if internal? doom-profiles-generated-dir)
))
(defun doom-profiles-outdated-p ()
"Return non-nil if files in `doom-profile-load-file' are outdated."
(cl-loop for path in doom-profile-load-path
when (string-suffix-p path ".el")
if (or (not (file-exists-p doom-profile-load-file))
(file-newer-than-file-p path doom-profile-load-file)
(not (equal (doom-file-read doom-profile-load-file :by 'read)
doom-version)))
return t))
;;; Generators
(defun doom-profile-generate (&optional _profile regenerate-only?)
"Generate profile init files."
(doom-initialize-packages)
(let* ((default-directory doom-profile-dir)
(init-dir doom-profile-init-dir-name)
(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!
(make-directory init-dir t)
(print! (start "Deleting old init files..."))
(print-group! :level 'info
(cl-loop for file in (cons init-file (doom-glob "*.elc"))
if (file-exists-p file)
do (print! (item "Deleting %s...") file)
and do (delete-file file)))
(let ((auto-files (doom-glob init-dir "*.auto.el")))
(print! (start "Generating %d init files...") (length doom-profile-generators))
(print-group! :level 'info
(dolist (file auto-files)
(print! (item "Deleting %s...") file)
(delete-file file))
(pcase-dolist (`(,file . ,fn) doom-profile-generators)
(let ((file (doom-path init-dir file)))
(doom-log "Building %s..." file)
(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")
;; 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 packages (including Doom), bake in absolute
;; paths into their caches that need to be refreshed.
(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
(print! (start "Reading %s...") file))
(doom-file-read file :by 'insert)))
(print! (start "Byte-compiling %s...") (relpath init-file))
(print-group!
(let ((byte-compile-warnings (if init-file-debug '(suspicious make-local callargs))))
(byte-compile-file init-file)))
(print! (success "Built %s") (byte-compile-dest-file init-file))))
(error (delete-file init-file)
(delete-file (byte-compile-dest-file init-file))
(signal 'doom-autoload-error (list init-file e))))))
(defun doom-profile--generate-init-vars ()
;; 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.
`((defun doom--startup-vars ()
,@(cl-loop for var in doom-autoloads-cached-vars
if (boundp var)
collect `(set-default ',var ',(symbol-value var)))
,@(cl-loop with v = (version-to-list doom-version)
with ref = (doom-call-process "git" "-C" (doom-path doom-emacs-dir) "rev-parse" "HEAD")
with branch = (doom-call-process "git" "-C" (doom-path doom-emacs-dir) "branch" "--show-current")
for (var . val)
in `((major . ,(nth 0 v))
(minor . ,(nth 1 v))
(build . ,(nth 2 v))
(tag . ,(ignore-errors (cadr (split-string doom-version "-" t))))
(ref . ,(if (zerop (car ref)) (cdr ref)))
(branch . ,(if (zerop (car branch)) (cdr branch))))
collect `(put 'doom-version ',var ',val)))))
(defun doom-profile--generate-load-modules ()
(let* ((init-modules-list (doom-module-list nil t))
(config-modules-list (doom-module-list))
(pre-init-modules
(seq-filter (fn! (<= (car (doom-module-get % :depth)) -100))
(remove '(:user . nil) init-modules-list)))
(init-modules
(seq-filter (fn! (<= 0 (car (doom-module-get % :depth)) 100))
init-modules-list))
(config-modules
(seq-filter (fn! (<= 0 (cdr (doom-module-get % :depth)) 100))
config-modules-list))
(post-config-modules
(seq-filter (fn! (>= (cdr (doom-module-get % :depth)) 100))
config-modules-list))
(init-file doom-module-init-file)
(config-file doom-module-config-file))
(letf! ((defun module-loader (key file)
(let ((noextfile (file-name-sans-extension file)))
`(with-doom-module ',key
,(pcase key
('(:doom . nil)
`(doom-load
(file-name-concat
doom-core-dir ,(file-name-nondirectory noextfile))
t))
('(:user . nil)
`(doom-load
(file-name-concat
doom-user-dir ,(file-name-nondirectory noextfile))
t))
(_
(when (doom-file-cookie-p file "if" t)
`(doom-load ,(abbreviate-file-name noextfile) t)))))))
(defun module-list-loader (modules file)
(cl-loop for key in modules
if (doom-module-locate-path key file)
collect (module-loader key it))))
;; FIX: Same as above (see `doom-profile--generate-init-vars').
`((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))
(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)))))))))
(defun doom-profile--generate-doom-autoloads ()
`((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 ()
`((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-lib '(profiles))
;;; profiles.el ends here