refactor!: restructure Doom core

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

lisp/lib/packages.el

@@ -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