diff --git a/core/autoload/packages.el b/core/autoload/packages.el index e0c0240c3..7981d3382 100644 --- a/core/autoload/packages.el +++ b/core/autoload/packages.el @@ -47,6 +47,7 @@ deps)) deps))) +;;;###autoload (defun doom-package-depending-on (package &optional noerror) "Return a list of packages that depend on the package named NAME." (cl-check-type name symbol) @@ -189,6 +190,34 @@ ones." (doom--read-module-packages-file private-packages all-p t)) (nreverse doom-packages))) +;;;###autoload +(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)) + (with-plist! recipe (local-repo type) + (when (and local-repo (not (eq type 'built-in))) + (push recipe recipes)))) + (nreverse recipes))) + +;;;###autoload +(defmacro doom-with-package-recipes (recipes binds &rest body) + "TODO" + (declare (indent 2)) + (let ((recipe-var (make-symbol "recipe")) + (recipes-var (make-symbol "recipes"))) + `(let* ((,recipes-var ,recipes) + (built ()) + (straight-use-package-pre-build-functions + (cons (lambda (pkg) (cl-pushnew pkg built :test #'equal)) + straight-use-package-pre-build-functions))) + (dolist (,recipe-var ,recipes-var) + (cl-block nil + (straight--with-plist (append (list :recipe ,recipe-var) ,recipe-var) + ,(doom-enlist binds) + ,@body))) + (nreverse built)))) + ;; ;;; Main functions diff --git a/core/cli/packages.el b/core/cli/packages.el index 314ac1bdd..542949c31 100644 --- a/core/cli/packages.el +++ b/core/cli/packages.el @@ -59,29 +59,20 @@ list remains lean." ;; ;;; Library -(defun doom--straight-recipes () - (let (recipes) - (dolist (recipe (hash-table-values straight--recipe-cache)) - (straight--with-plist recipe (local-repo type) - (when (and local-repo (not (eq type 'built-in))) - (push recipe recipes)))) - (nreverse recipes))) +(defun doom--same-commit-p (abbrev-ref ref) + (and (stringp abbrev-ref) + (stringp ref) + (string-match-p (concat "^" (regexp-quote abbrev-ref)) + ref))) -(defmacro doom--map-recipes (recipes binds &rest body) - (declare (indent 2)) - (let ((recipe-var (make-symbol "recipe")) - (recipes-var (make-symbol "recipes"))) - `(let* ((,recipes-var ,recipes) - (built ()) - (straight-use-package-pre-build-functions - (cons (lambda (pkg) (cl-pushnew pkg built :test #'equal)) - straight-use-package-pre-build-functions))) - (dolist (,recipe-var ,recipes-var) - (cl-block nil - (straight--with-plist (append (list :recipe ,recipe-var) ,recipe-var) - ,(doom-enlist binds) - ,@body))) - (nreverse built)))) +(defun doom--abbrev-commit (commit &optional full) + (if full commit (substring commit 0 7))) + +(defun doom--commit-log-between (start-ref end-ref) + (and (straight--call + "git" "log" "--oneline" "--no-merges" + "-n" "25" end-ref (concat "^" (regexp-quote start-ref))) + (straight--process-get-output))) (defun doom-cli-packages-install () "Installs missing packages. @@ -92,7 +83,7 @@ declaration) or dependency thereof that hasn't already been." (print! (start "Installing packages...")) (print-group! (if-let (built - (doom--map-recipes (doom--straight-recipes) + (doom-with-package-recipes (doom-package-recipe-list) (recipe package type local-repo) (condition-case-unless-debug e (progn @@ -105,7 +96,7 @@ declaration) or dependency thereof that hasn't already been." (if (straight-vc-commit-present-p recipe newcommit) (progn (print! (success "Checking out %s to %s") - package (substring newcommit 0 8)) + package (doom--abbrev-commit newcommit)) (straight-vc-check-out-commit recipe newcommit) (straight-rebuild-package package t)) (ignore-errors @@ -140,7 +131,7 @@ declaration) or dependency thereof that hasn't already been." (unless force-p (straight--make-package-modifications-available)) (if-let (built - (doom--map-recipes (doom--straight-recipes) (package) + (doom-with-package-recipes (doom-package-recipe-list) (package) (straight-use-package (intern package)))) (print! (success "Rebuilt %d package(s)") (length built)) (print! (success "No packages need rebuilding")) @@ -152,101 +143,92 @@ declaration) or dependency thereof that hasn't already been." (straight--transaction-finalize) (print! (start "Updating packages (this may take a while)...")) (let* ((straight--repos-dir (straight--repos-dir)) - (straight--packages-to-rebuild (make-hash-table :test 'equal)) - (updated-repos (make-hash-table :test 'equal)) - (recipes (doom--straight-recipes)) + (packages-to-rebuild (make-hash-table :test 'equal)) + (repos-to-rebuild (make-hash-table :test 'equal)) + (recipes (doom-package-recipe-list)) (total (length recipes)) + (esc (if doom-debug-mode "" "\033[1A")) (i 0) errors) ;; TODO Log this somewhere? - (doom--map-recipes recipes (recipe package type local-repo) + (doom-with-package-recipes recipes (recipe package type local-repo) (cl-incf i) (print-group! (unless (straight--repository-is-available-p recipe) - (print! (error "(%d/%d) Couldn't find local repo for %s!") - i total package) + (print! (error "(%d/%d) Couldn't find local repo for %s!") i total package) (cl-return)) - (when (gethash local-repo updated-repos) - (puthash package t straight--packages-to-rebuild) - (ignore-errors (delete-directory (straight--build-dir package) 'recursive)) - (print! (success "(%d/%d) %s was updated indirectly (with %s)") - i total package local-repo) + (when (gethash local-repo repos-to-rebuild) + (puthash package t packages-to-rebuild) + (print! (success "(%d/%d) %s was updated indirectly (with %s)") i total package local-repo) (cl-return)) - (let ((default-directory (straight--repos-dir local-repo)) - (esc (if doom-debug-mode "" "\033[1A"))) + (let ((default-directory (straight--repos-dir local-repo))) (unless (file-in-directory-p default-directory straight--repos-dir) - (print! (warn "(%d/%d) Skipping %s because it is local") - i total package) + (print! (warn "(%d/%d) Skipping %s because it is local") i total package) (cl-return)) - ;; FIXME Dear lord refactor me (condition-case-unless-debug e - (let ((commit (straight-vc-get-commit type local-repo)) - (newcommit (cdr (assoc local-repo doom-pinned-packages)))) - (and (stringp newcommit) - (string-match-p (concat "^" newcommit) commit) - (print! (success "\033[K(%d/%d) %s is up-to-date...%s") - i total package esc) - (cl-return)) - (unless (or (and (stringp newcommit) - (straight-vc-commit-present-p recipe newcommit) - (print! (start "\033[K(%d/%d) Checking out %s (%s)...%s") - i total package (substring newcommit 0 7) esc)) - (and (print! (start "\033[K(%d/%d) Fetching %s...%s") - i total package esc) - (straight-vc-fetch-from-remote recipe))) - (print! (warn "\033[K(%d/%d) Failed to fetch %s") - i total (or local-repo package)) - (cl-return)) - (let ((output (straight--process-get-output))) - (if (stringp newcommit) - (if (straight-vc-commit-present-p recipe newcommit) - (straight-vc-check-out-commit recipe newcommit) - (print! (start "\033[K(%d/%d) Re-cloning %s...%s") i total local-repo esc) - (ignore-errors - (delete-directory (straight--repos-dir package) 'recursive)) - (straight-use-package (intern package) nil 'no-build)) - (straight-merge-package package) - (setq newcommit (straight-vc-get-commit type local-repo))) - (when (string-match-p (concat "^" newcommit) commit) - (cl-return)) - (print! (start "\033[K(%d/%d) Updating %s...%s") i total local-repo esc) - (puthash local-repo t updated-repos) - (puthash package t straight--packages-to-rebuild) - (ignore-errors - (delete-directory (straight--build-dir package) 'recursive)) - (print-group! - (unless (string-empty-p output) - (print! (info "%s") output)) - (when (eq type 'git) - (straight--call - "git" "log" "--oneline" "--no-merges" - newcommit (concat "^" commit)) - (print-group! - (print! "%s" (straight--process-get-output))))) - (print! (success "(%d/%d) %s updated (%s -> %s)") i total - (or local-repo package) - (substring commit 0 7) - (substring newcommit 0 7)))) + (let ((ref (straight-vc-get-commit type local-repo)) + (target-ref (cdr (assoc local-repo doom-pinned-packages))) + output) + (or (cond + ((not (stringp target-ref)) + (print! (start "\033[K(%d/%d) Fetching %s...%s") i total package esc) + (when (straight-vc-fetch-from-remote recipe) + (setq output (straight--process-get-output)) + (straight-merge-package package) + (setq target-ref (straight-vc-get-commit type local-repo)) + (when (doom--same-commit-p target-ref ref) + (cl-return)))) + + ((doom--same-commit-p target-ref ref) + (print! (success "\033[K(%d/%d) %s is up-to-date...%s") i total package esc) + (cl-return)) + + ((straight-vc-commit-present-p recipe target-ref) + (print! (start "\033[K(%d/%d) Checking out %s (%s)...%s") + i total package (doom--abbrev-commit target-ref) esc) + (straight-vc-check-out-commit recipe target-ref) + (or (not (eq type 'git)) + (setq output (doom--commit-log-between ref target-ref))) + (doom--same-commit-p target-ref (straight-vc-get-commit type local-repo))) + + ((print! (start "\033[K(%d/%d) Re-cloning %s...%s") i total local-repo esc) + (ignore-errors (delete-directory (straight--repos-dir package) 'recursive)) + (straight-use-package (intern package) nil 'no-build) + (prog1 (file-directory-p (straight--repos-dir package)) + (or (not (eq type 'git)) + (setq output (doom--commit-log-between ref target-ref)))))) + (progn + (print! (warn "\033[K(%d/%d) Failed to fetch %s") i total local-repo) + (cl-return))) + (puthash local-repo t repos-to-rebuild) + (puthash package t packages-to-rebuild) + (unless (string-empty-p output) + (print-group! (print! (info "%s" output)))) + (print! (success "(%d/%d) %s updated (%s -> %s)") + i total local-repo + (doom--abbrev-commit ref) + (doom--abbrev-commit target-ref))) (user-error (signal 'user-error (error-message-string e))) (error (print! (warn "\033[K(%d/%d) Encountered error with %s" i total package)) (print-group! - (print! (error "%s" e)) + (print! (error "%s") e) (print-group! (print! (info "%s" (straight--process-get-output))))) - (push package errors))))) - (princ "\033[K") - (when errors - (print! (error "Encountered %d error(s), the offending packages: %s") - (length errors) (string-join errors ", "))) - (if (hash-table-empty-p straight--packages-to-rebuild) - (ignore - (print! (success "All %d packages are up-to-date") - (hash-table-count straight--repo-cache))) - (print! (success "Updated %d package(s)") - (hash-table-count straight--packages-to-rebuild)) - (doom-cli-packages-build) - t)))) + (push package errors)))))) + (princ "\033[K") + (when errors + (print! (error "Encountered %d error(s), the offending packages: %s") + (length errors) (string-join errors ", "))) + (if (hash-table-empty-p packages-to-rebuild) + (ignore (print! (success "All %d packages are up-to-date") total)) + (let ((default-directory (straight--build-dir))) + (mapc (doom-rpartial #'delete-directory 'recursive) + (hash-table-keys packages-to-rebuild))) + (print! (success "Updated %d package(s)") + (hash-table-count packages-to-rebuild)) + (doom-cli-packages-build) + t))) ;;; PURGE (for the emperor) @@ -267,19 +249,23 @@ declaration) or dependency thereof that hasn't already been." (length (delq nil (mapcar #'doom--cli-packages-purge-build builds)))))) -(defun doom--cli-packages-regraft-repo (repo) +(cl-defun doom--cli-packages-regraft-repo (repo) (let ((default-directory (straight--repos-dir repo))) - (if (not (file-directory-p ".git")) - (ignore (print! (warn "\033[Krepos/%s is not a git repo, skipping" repo))) - (let ((before-size (doom-directory-size default-directory))) - (straight--call "git" "reset" "--hard") - (straight--call "git" "clean" "-ffd") - (if (not (car (straight--call "git" "replace" "--graft" "HEAD"))) - (print! (info "\033[Krepos/%s is already compact\033[1A" repo)) - (straight--call "git" "gc") - (print! (success "\033[KRegrafted repos/%s (from %0.1fKB to %0.1fKB)") - repo before-size (doom-directory-size default-directory)) - (print-group! (print! "%s" (straight--process-get-output))))) + (unless (file-directory-p ".git") + (print! (warn "\033[Krepos/%s is not a git repo, skipping" repo)) + (cl-return)) + (unless (file-in-directory-p default-directory straight-base-dir) + (print! (warn "\033[KSkipping repos/%s because it is local" repo)) + (cl-return)) + (let ((before-size (doom-directory-size default-directory))) + (straight--call "git" "reset" "--hard") + (straight--call "git" "clean" "-ffd") + (if (not (car (straight--call "git" "replace" "--graft" "HEAD"))) + (print! (info "\033[Krepos/%s is already compact\033[1A" repo)) + (straight--call "git" "gc") + (print! (success "\033[KRegrafted repos/%s (from %0.1fKB to %0.1fKB)") + repo before-size (doom-directory-size default-directory)) + (print-group! (print! "%s" (straight--process-get-output)))) t))) (defun doom--cli-packages-regraft-repos (repos) diff --git a/core/core-packages.el b/core/core-packages.el index 24f585d4e..cdd8a4b7e 100644 --- a/core/core-packages.el +++ b/core/core-packages.el @@ -130,7 +130,6 @@ missing) and shouldn't be deleted.") (append (apply orig-fn args) doom-pinned-packages)) - ;; ;;; Bootstrapper diff --git a/core/core.el b/core/core.el index ade8cfefb..7debec9b0 100644 --- a/core/core.el +++ b/core/core.el @@ -448,17 +448,18 @@ unreadable. Returns the names of envvars that were changed." (point-max)))) environment))) (when environment - (setq process-environment - (append (nreverse environment) process-environment) - exec-path - (if (member "PATH" envvars) - (append (split-string (getenv "PATH") path-separator t) - (list exec-directory)) - exec-path) - shell-file-name - (if (member "SHELL" envvars) - (or (getenv "SHELL") shell-file-name) - shell-file-name)) + (setq-default + process-environment + (append (nreverse environment) process-environment) + exec-path + (if (member "PATH" envvars) + (append (split-string (getenv "PATH") path-separator t) + (list exec-directory)) + exec-path) + shell-file-name + (if (member "SHELL" envvars) + (or (getenv "SHELL") shell-file-name) + shell-file-name)) envvars)))) (defun doom-initialize (&optional force-p noerror) @@ -531,11 +532,10 @@ to least)." (file-expand-wildcards (concat doom-core-dir "autoload/*.el"))) ;; Create all our core directories to quell file errors - (dolist (dir (list doom-local-dir - doom-etc-dir - doom-cache-dir)) - (unless (file-directory-p dir) - (make-directory dir 'parents))) + (mapc (doom-rpartial #'make-directory 'parents) + (list doom-local-dir + doom-etc-dir + doom-cache-dir)) ;; Ensure the package management system (and straight) are ready for ;; action (and all core packages/repos are installed)