mirror of
https://github.com/doomemacs/doomemacs
synced 2025-08-01 12:17:25 -05:00
refactor(cli): remove cli/packages.el
This file is mostly redundant. There is much more trimming/culling of Doom's package API pending, but I'll save that for v3.
This commit is contained in:
Henrik Lissner
8
bin/doom
8
bin/doom
@ -272,16 +272,18 @@ SEE ALSO:
|
||||
(defcli-autoload! ((profiles profile)))
|
||||
(defcli-autoload! ((upgrade up)))
|
||||
(defcli-autoload! (env))
|
||||
(defcli-autoload! ((build b purge p gc rollback)) "packages")
|
||||
(defcli-autoload! (gc))
|
||||
(defcli-autoload! (install))
|
||||
|
||||
(defcli-obsolete! ((build b)) (sync "--rebuild") "3.0.0")
|
||||
(defcli-obsolete! ((purge p)) (gc) "3.0.0")
|
||||
|
||||
;; TODO Post-3.0 commands
|
||||
;; (load! "gc" dir)
|
||||
;; (load! "module" dir)
|
||||
;; (load! "nuke" dir)
|
||||
;; (load! "package" dir)
|
||||
;; (load! "profile" dir)
|
||||
)
|
||||
(defcli-stub! rollback))
|
||||
|
||||
(defcli-group! "Development"
|
||||
:docs "Commands for developing or launching Doom."
|
||||
|
||||
@ -183,9 +183,6 @@ remains lean."
|
||||
(doom-gc--eln)))))))
|
||||
t)
|
||||
|
||||
;;;###autoload
|
||||
(defcli-obsolete! ((purge p)) (gc) "3.0.0")
|
||||
|
||||
;; (defcli! gc
|
||||
;; ((keep ( "--keep" time) "Don't delete generations in the last TIME units")
|
||||
;; (keep-last ( "--keep-last" num) "Don't delete last NUM generations")
|
||||
|
||||
@ -2,7 +2,7 @@
|
||||
;;; Commentary:
|
||||
;;; Code:
|
||||
|
||||
(load! "packages")
|
||||
(doom-require 'doom-lib 'packages)
|
||||
|
||||
|
||||
;;
|
||||
|
||||
@ -1,670 +0,0 @@
|
||||
;;; lisp/cli/packages.el --- package management commands -*- lexical-binding: t; -*-
|
||||
;;; Commentary:
|
||||
;;; Code:
|
||||
|
||||
(require 'comp nil t)
|
||||
|
||||
;;
|
||||
;;; Variables
|
||||
|
||||
;; None yet!
|
||||
|
||||
|
||||
;;
|
||||
;;; Commands
|
||||
|
||||
(defcli-obsolete! ((build b)) (sync "--rebuild") "3.0.0")
|
||||
|
||||
(defcli-obsolete! ((purge p)) (gc) "3.0.0")
|
||||
|
||||
;; TODO Rename to "doom gc" and move to its own file
|
||||
(defcli! (gc)
|
||||
((nobuilds-p ("-b" "--no-builds") "Don't purge unneeded (built) packages")
|
||||
(noelpa-p ("-p" "--no-elpa") "Don't purge ELPA packages")
|
||||
(norepos-p ("-r" "--no-repos") "Don't purge unused straight repos")
|
||||
(noeln-p ("-e" "--no-eln") "Don't purge old ELN bytecode")
|
||||
(noregraft-p ("-g" "--no-regraft") "Don't regraft git repos (ie. compact them)"))
|
||||
"Deletes orphaned packages & repos, and compacts them.
|
||||
|
||||
Purges all installed ELPA packages (as they are considered temporary). Purges
|
||||
all orphaned package repos and builds. Also regrafts and compacts package repos
|
||||
to ensure they are as small as possible.
|
||||
|
||||
It is a good idea to occasionally run this command to ensure your package list
|
||||
remains lean."
|
||||
:benchmark t
|
||||
(require 'comp nil t)
|
||||
(doom-initialize-core-packages)
|
||||
(straight-check-all)
|
||||
(when (doom-packages-purge
|
||||
(not noelpa-p)
|
||||
(not norepos-p)
|
||||
(not nobuilds-p)
|
||||
(not noregraft-p)
|
||||
(not noeln-p))
|
||||
(doom-profile-generate))
|
||||
t)
|
||||
|
||||
(defcli-stub! rollback) ; TODO Implement me post-3.0
|
||||
|
||||
|
||||
;;
|
||||
;;; Library
|
||||
|
||||
;; FIXME Enforce naming conventions for all functions below
|
||||
|
||||
(defun doom-packages--same-commit-p (abbrev-ref ref)
|
||||
(and (stringp abbrev-ref)
|
||||
(stringp ref)
|
||||
(string-match-p (concat "^" (regexp-quote abbrev-ref))
|
||||
ref)))
|
||||
|
||||
(defun doom-packages--abbrev-commit (commit &optional full)
|
||||
(if full commit (substring commit 0 7)))
|
||||
|
||||
(defun doom-packages--commit-log-between (start-ref end-ref)
|
||||
(straight--process-with-result
|
||||
(straight--process-run
|
||||
"git" "log" "--oneline" "--no-merges"
|
||||
end-ref (concat "^" (regexp-quote start-ref)))
|
||||
(if success
|
||||
(string-trim-right (or stdout ""))
|
||||
(format "ERROR: Couldn't collect commit list because: %s" stderr))))
|
||||
|
||||
(defmacro doom-packages--straight-with (form &rest body)
|
||||
(declare (indent 1))
|
||||
`(let-alist
|
||||
(let* ((buffer (straight--process-buffer))
|
||||
(start (with-current-buffer buffer (point-max)))
|
||||
(retval ,form)
|
||||
(output (with-current-buffer buffer (buffer-substring start (point-max)))))
|
||||
(save-match-data
|
||||
(list (cons 'it retval)
|
||||
(cons 'stdout (substring-no-properties output))
|
||||
(cons 'success (if (string-match "\n+\\[Return code: \\([0-9-]+\\)\\]\n+" output)
|
||||
(string-to-number (match-string 1 output))))
|
||||
(cons 'output (string-trim output
|
||||
"^\\(\\$ [^\n]+\n\\)*\n+"
|
||||
"\n+\\[Return code: [0-9-]+\\]\n+")))))
|
||||
,@body))
|
||||
|
||||
(defun doom-packages--barf-if-incomplete ()
|
||||
(let ((straight-safe-mode t))
|
||||
(condition-case _ (straight-check-all)
|
||||
(error (user-error "Package state is incomplete. Run 'doom sync' first")))))
|
||||
|
||||
(defmacro doom-packages--with-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 &rest _) (cl-pushnew pkg built :test #'equal))
|
||||
straight-use-package-pre-build-functions)))
|
||||
(dolist (,recipe-var ,recipes-var (nreverse built))
|
||||
(cl-block nil
|
||||
(straight--with-plist (append (list :recipe ,recipe-var) ,recipe-var)
|
||||
,(ensure-list binds)
|
||||
,@body))))))
|
||||
|
||||
(defvar doom-packages--cli-updated-recipes nil)
|
||||
(defun doom-packages--cli-recipes-update ()
|
||||
"Updates straight and recipe repos."
|
||||
(unless doom-packages--cli-updated-recipes
|
||||
(straight--make-build-cache-available)
|
||||
(print! (start "Updating recipe repos..."))
|
||||
(print-group!
|
||||
(doom-packages--with-recipes
|
||||
(delq
|
||||
nil (mapcar (doom-rpartial #'gethash straight--repo-cache)
|
||||
(mapcar #'symbol-name straight-recipe-repositories)))
|
||||
(recipe package type local-repo)
|
||||
(let ((esc (if init-file-debug "" "\033[1A"))
|
||||
(ref (straight-vc-get-commit type local-repo))
|
||||
newref output)
|
||||
(print! (start "\rUpdating recipes for %s...%s") package esc)
|
||||
(doom-packages--straight-with (straight-vc-fetch-from-remote recipe)
|
||||
(when .it
|
||||
(setq output .output)
|
||||
(straight-merge-package package)
|
||||
(unless (equal ref (setq newref (straight-vc-get-commit type local-repo)))
|
||||
(print! (success "\r%s updated (%s -> %s)")
|
||||
package
|
||||
(doom-packages--abbrev-commit ref)
|
||||
(doom-packages--abbrev-commit newref))
|
||||
(unless (string-empty-p output)
|
||||
(print-group! (print! (item "%s" output))))))))))
|
||||
(setq straight--recipe-lookup-cache (make-hash-table :test #'eq)
|
||||
doom-packages--cli-updated-recipes t)))
|
||||
|
||||
(defvar doom-packages--eln-output-expected nil)
|
||||
|
||||
(defvar doom-packages--eln-output-path (car (bound-and-true-p native-comp-eln-load-path)))
|
||||
|
||||
(defun doom-packages--eln-file-name (file)
|
||||
"Return the short .eln file name corresponding to `file'."
|
||||
(file-name-concat
|
||||
comp-native-version-dir
|
||||
(file-name-nondirectory
|
||||
(comp-el-to-eln-filename file))))
|
||||
|
||||
(defun doom-packages--eln-output-file (eln-name)
|
||||
"Return the expected .eln file corresponding to `eln-name'."
|
||||
(file-name-concat doom-packages--eln-output-path eln-name))
|
||||
|
||||
(defun doom-packages--eln-error-file (eln-name)
|
||||
"Return the expected .error file corresponding to `eln-name'."
|
||||
(file-name-concat doom-packages--eln-output-path eln-name ".error"))
|
||||
|
||||
(defun doom-packages--find-eln-file (eln-name)
|
||||
"Find `eln-name' on the `native-comp-eln-load-path'."
|
||||
(cl-some (fn! (file-exists-p! eln-name %))
|
||||
native-comp-eln-load-path))
|
||||
|
||||
(defun doom-packages--elc-file-outdated-p (file)
|
||||
"Check whether the corresponding .elc for `file' is outdated."
|
||||
(let ((elc-file (byte-compile-dest-file file)))
|
||||
;; NOTE Ignore missing elc files, they could be missing due to
|
||||
;; `no-byte-compile'. Rebuilding unnecessarily is expensive.
|
||||
(when (and (file-exists-p elc-file)
|
||||
(file-newer-than-file-p file elc-file))
|
||||
(doom-log "packages:elc: %s is newer than %s" file elc-file)
|
||||
t)))
|
||||
|
||||
(defun doom-packages--eln-file-outdated-p (file)
|
||||
"Check whether the corresponding .eln for `file' is outdated."
|
||||
(when (file-exists-p file)
|
||||
(let* ((eln-name (doom-packages--eln-file-name file))
|
||||
(eln-file (doom-packages--find-eln-file eln-name))
|
||||
(error-file (doom-packages--eln-error-file eln-name)))
|
||||
(cond (eln-file
|
||||
(when (file-newer-than-file-p file eln-file)
|
||||
(doom-log "packages:eln: %s is newer than %s" file eln-file)
|
||||
t))
|
||||
((file-exists-p error-file)
|
||||
(when (file-newer-than-file-p file error-file)
|
||||
(doom-log "packages:eln: %s is newer than %s" file error-file)
|
||||
t))))))
|
||||
|
||||
(defun doom-packages--native-compile-done-h (file)
|
||||
"Callback fired when an item has finished async compilation."
|
||||
(when file
|
||||
(let* ((eln-name (doom-packages--eln-file-name file))
|
||||
(eln-file (doom-packages--eln-output-file eln-name))
|
||||
(error-file (doom-packages--eln-error-file eln-name)))
|
||||
(if (file-exists-p eln-file)
|
||||
(doom-log "packages:nativecomp: Compiled %s" eln-file)
|
||||
(let ((error-dir (file-name-directory error-file)))
|
||||
(if (not (file-writable-p error-dir))
|
||||
(doom-log "packages:nativecomp: failed to write %s" error-file)
|
||||
(make-directory error-dir 'parents)
|
||||
(write-region "" nil error-file)
|
||||
(doom-log "packages:nativecomp: wrote %s" error-file)))))))
|
||||
|
||||
(defun doom-packages--wait-for-native-compile-jobs ()
|
||||
"Wait for all pending async native compilation jobs."
|
||||
(cl-loop with previous = 0
|
||||
with timeout = 30
|
||||
with timer = 0
|
||||
for pending = (+ (length comp-files-queue)
|
||||
(if (functionp 'comp--async-runnings)
|
||||
(comp--async-runnings)
|
||||
(comp-async-runnings)))
|
||||
while (not (zerop pending))
|
||||
if (/= previous pending) do
|
||||
(print! (start "\rNatively compiling %d files...\033[1A" pending))
|
||||
(setq previous pending
|
||||
timer 0)
|
||||
else do
|
||||
(let ((inhibit-message t))
|
||||
(if (> timer timeout)
|
||||
(cl-loop for file-name being each hash-key of comp-async-compilations
|
||||
for prc = (gethash file-name comp-async-compilations)
|
||||
unless (process-live-p prc)
|
||||
do (setq timer 0)
|
||||
and do (print! (warn "Native compilation of %S timed out" (path file-name)))
|
||||
and return (kill-process prc))
|
||||
(cl-incf timer 0.1))
|
||||
(sleep-for 0.1))))
|
||||
|
||||
(defun doom-packages--write-missing-eln-errors ()
|
||||
"Write .error files for any expected .eln files that are missing."
|
||||
(cl-loop for file in doom-packages--eln-output-expected
|
||||
for eln-name = (doom-packages--eln-file-name file)
|
||||
for eln-file = (doom-packages--eln-output-file eln-name)
|
||||
for error-file = (doom-packages--eln-error-file eln-name)
|
||||
for error-dir = (file-name-directory error-file)
|
||||
unless (or (file-exists-p eln-file)
|
||||
(file-newer-than-file-p error-file file)
|
||||
(not (file-writable-p error-dir)))
|
||||
do (make-directory error-dir 'parents)
|
||||
(write-region "" nil error-file)
|
||||
(doom-log "Wrote %s" error-file))
|
||||
(setq doom-packages--eln-output-expected nil))
|
||||
|
||||
(defun doom-packages--compile-site-files ()
|
||||
"Queue async compilation for all non-doom Elisp files."
|
||||
(cl-loop with paths = (cl-loop for path in load-path
|
||||
unless (file-in-directory-p path doom-local-dir)
|
||||
collect path)
|
||||
for file in (doom-files-in paths :match "\\.el\\(?:\\.gz\\)?$")
|
||||
if (and (file-exists-p (byte-compile-dest-file file))
|
||||
(not (doom-packages--find-eln-file (doom-packages--eln-file-name file)))
|
||||
(not (cl-some (fn! (string-match-p % file))
|
||||
native-comp-deferred-compilation-deny-list))) do
|
||||
(doom-log "Compiling %s" file)
|
||||
(native-compile-async file)))
|
||||
|
||||
(defun doom-packages-ensure (&optional force-p)
|
||||
"Ensure packages are installed, built"
|
||||
(doom-initialize-packages)
|
||||
(if (not (file-directory-p (straight--repos-dir)))
|
||||
(print! (start "Installing all packages for the first time (this may take a while)..."))
|
||||
(if force-p
|
||||
(print! (start "Rebuilding all packages (this may take a while)..."))
|
||||
(print! (start "Ensuring packages are installed and built..."))))
|
||||
(print-group!
|
||||
(let ((straight-check-for-modifications
|
||||
(when (file-directory-p (straight--modified-dir))
|
||||
'(find-when-checking)))
|
||||
(straight--allow-find
|
||||
(and straight-check-for-modifications
|
||||
(executable-find straight-find-executable)
|
||||
t))
|
||||
(straight--packages-not-to-rebuild
|
||||
(or straight--packages-not-to-rebuild (make-hash-table :test #'equal)))
|
||||
(straight--packages-to-rebuild
|
||||
(or (if force-p :all straight--packages-to-rebuild)
|
||||
(make-hash-table :test #'equal)))
|
||||
(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
|
||||
(doom-packages--with-recipes recipes (package local-repo recipe)
|
||||
(let ((repo-dir (straight--repos-dir (or local-repo package)))
|
||||
(build-dir (straight--build-dir package)))
|
||||
(unless force-p
|
||||
;; Ensure packages with outdated files/bytecode are rebuilt
|
||||
(let* ((build (if (plist-member recipe :build)
|
||||
(plist-get recipe :build)
|
||||
t))
|
||||
(want-byte-compile
|
||||
(or (eq build t)
|
||||
(memq 'compile build)))
|
||||
(want-native-compile
|
||||
(or (eq build t)
|
||||
(memq 'native-compile build))))
|
||||
(and (eq (car-safe build) :not)
|
||||
(setq want-byte-compile (not want-byte-compile)
|
||||
want-native-compile (not want-native-compile)))
|
||||
(when (or (not (featurep 'native-compile))
|
||||
(not straight--native-comp-available))
|
||||
(setq want-native-compile nil))
|
||||
(and (or want-byte-compile want-native-compile)
|
||||
(or (file-newer-than-file-p repo-dir build-dir)
|
||||
(file-exists-p (straight--modified-dir package))
|
||||
(cl-loop with outdated = nil
|
||||
for file in (doom-files-in build-dir :match "\\.el$" :full t)
|
||||
if (or (if want-byte-compile (doom-packages--elc-file-outdated-p file))
|
||||
(if want-native-compile (doom-packages--eln-file-outdated-p file)))
|
||||
do (setq outdated t)
|
||||
(when want-native-compile
|
||||
(push file doom-packages--eln-output-expected))
|
||||
finally return outdated))
|
||||
(puthash package t straight--packages-to-rebuild))))
|
||||
(unless (file-directory-p repo-dir)
|
||||
(doom-packages--cli-recipes-update))
|
||||
(condition-case-unless-debug e
|
||||
(let ((straight-vc-git-post-clone-hook
|
||||
(cons (lambda! (&key commit)
|
||||
(print-group!
|
||||
(if-let (pin (cdr (assoc package pinned)))
|
||||
(print! (item "Pinned to %s") pin)
|
||||
(when commit
|
||||
(print! (item "Checked out %s") commit)))))
|
||||
straight-vc-git-post-clone-hook)))
|
||||
(straight-use-package (intern package))
|
||||
(when (file-in-directory-p repo-dir straight-base-dir)
|
||||
;; HACK: Straight can sometimes fail to clone a repo,
|
||||
;; leaving behind an empty directory which, in
|
||||
;; future invocations, it will assume indicates a
|
||||
;; successful clone (causing load errors later).
|
||||
(let ((try 0))
|
||||
(while (not (file-directory-p (doom-path repo-dir ".git")))
|
||||
(when (= try 3)
|
||||
(error "Failed to clone package"))
|
||||
(print! (warn "Failed to clone %S, trying again (attempt #%d)...") package (1+ try))
|
||||
(delete-directory repo-dir t)
|
||||
(delete-directory build-dir t)
|
||||
(straight-use-package (intern package))
|
||||
(cl-incf try)))
|
||||
;; HACK: Line encoding issues can plague repos with
|
||||
;; dirty worktree prompts when updating packages or
|
||||
;; "Local variables entry is missing the suffix"
|
||||
;; errors when installing them (see #2637), so have
|
||||
;; git handle conversion by force.
|
||||
(when doom--system-windows-p
|
||||
(let ((default-directory repo-dir))
|
||||
(straight--process-run "git" "config" "core.autocrlf" "true")))))
|
||||
(error
|
||||
(signal 'doom-package-error (list package e)))))))
|
||||
(progn
|
||||
(when (and (featurep 'native-compile)
|
||||
straight--native-comp-available)
|
||||
(doom-packages--compile-site-files)
|
||||
(doom-packages--wait-for-native-compile-jobs)
|
||||
(doom-packages--write-missing-eln-errors))
|
||||
;; HACK: Every time you save a file in a package that straight
|
||||
;; tracks, it is recorded in ~/.emacs.d/.local/straight/modified/.
|
||||
;; Typically, straight will clean these up after rebuilding, but
|
||||
;; Doom's use-case circumnavigates that, leaving these files there
|
||||
;; and causing a rebuild of those packages each time `doom sync'
|
||||
;; or similar is run, so we clean it up ourselves:
|
||||
(delete-directory (straight--modified-dir) 'recursive)
|
||||
(print! (success "\rBuilt %d package(s)") (length built)))
|
||||
(print! (item "No packages need attention"))
|
||||
nil))))
|
||||
|
||||
|
||||
|
||||
(defun doom-packages-update (&optional pinned-only-p)
|
||||
"Updates packages."
|
||||
(doom-initialize-packages)
|
||||
(doom-packages--barf-if-incomplete)
|
||||
(let* ((repo-dir (straight--repos-dir))
|
||||
(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))
|
||||
(esc (if init-file-debug "" "\033[1A"))
|
||||
(i 0))
|
||||
(if pinned-only-p
|
||||
(print! (start "Updating pinned packages..."))
|
||||
(print! (start "Updating all packages (this may take a while)...")))
|
||||
(doom-packages--with-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)
|
||||
(cl-return))
|
||||
(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)))
|
||||
(unless (file-in-directory-p default-directory repo-dir)
|
||||
(print! (warn "(%d/%d) Skipping %s because it is out-of-tree...") i total package)
|
||||
(cl-return))
|
||||
(when (eq type 'git)
|
||||
(unless (file-exists-p ".git")
|
||||
(error "%S is not a valid repository" package)))
|
||||
(when (and pinned-only-p (not (assoc local-repo pinned)))
|
||||
(cl-return))
|
||||
(condition-case-unless-debug e
|
||||
(let ((ref (straight-vc-get-commit type local-repo))
|
||||
(target-ref
|
||||
(cdr (or (assoc local-repo pinned)
|
||||
(assoc package pinned))))
|
||||
commits
|
||||
output)
|
||||
(or (cond
|
||||
((not (stringp target-ref))
|
||||
(print! (start "\r(%d/%d) Fetching %s...%s") i total package esc)
|
||||
(doom-packages--straight-with (straight-vc-fetch-from-remote recipe)
|
||||
(when .it
|
||||
(straight-merge-package package)
|
||||
(setq target-ref (straight-vc-get-commit type local-repo))
|
||||
(setq output (doom-packages--commit-log-between ref target-ref)
|
||||
commits (length (split-string output "\n" t)))
|
||||
(or (not (doom-packages--same-commit-p target-ref ref))
|
||||
(cl-return)))))
|
||||
|
||||
((doom-packages--same-commit-p target-ref ref)
|
||||
(print! (item "\r(%d/%d) %s is up-to-date...%s") i total package esc)
|
||||
(cl-return))
|
||||
|
||||
((if (straight-vc-commit-present-p recipe target-ref)
|
||||
(print! (start "\r(%d/%d) Checking out %s (%s)...%s")
|
||||
i total package (doom-packages--abbrev-commit target-ref) esc)
|
||||
(print! (start "\r(%d/%d) Fetching %s...%s") i total package esc)
|
||||
(and (straight-vc-fetch-from-remote recipe)
|
||||
(straight-vc-commit-present-p recipe target-ref)))
|
||||
(straight-vc-check-out-commit recipe target-ref)
|
||||
(or (not (eq type 'git))
|
||||
(setq output (doom-packages--commit-log-between ref target-ref)
|
||||
commits (length (split-string output "\n" t))))
|
||||
(doom-packages--same-commit-p target-ref (straight-vc-get-commit type local-repo)))
|
||||
|
||||
((print! (start "\r(%d/%d) Re-cloning %s...") i total local-repo esc)
|
||||
(let ((repo (straight--repos-dir local-repo))
|
||||
(straight-vc-git-default-clone-depth 'full))
|
||||
(delete-directory repo 'recursive)
|
||||
(print-group!
|
||||
(straight-use-package (intern package) nil 'no-build))
|
||||
(prog1 (file-directory-p repo)
|
||||
(or (not (eq type 'git))
|
||||
(setq output (doom-packages--commit-log-between ref target-ref)
|
||||
commits (length (split-string output "\n" t))))))))
|
||||
(progn
|
||||
(print! (warn "\r(%d/%d) Failed to fetch %s")
|
||||
i total local-repo)
|
||||
(unless (string-empty-p output)
|
||||
(print-group! (print! (item "%s" output))))
|
||||
(cl-return)))
|
||||
(puthash local-repo t repos-to-rebuild)
|
||||
;; HACK: Rebuild all packages that depend on PACKAGE after
|
||||
;; updating it. This ensures their bytecode don't contain stale
|
||||
;; references to symbols in silent dependencies.
|
||||
;; TODO: Allow `package!' to control this.
|
||||
;; TODO: Add cache+optimization step for this rebuild table.
|
||||
(letf! ((dependents (straight-dependents package))
|
||||
(n 0)
|
||||
(defun* add-to-rebuild (tree)
|
||||
(cond ((null tree) nil)
|
||||
((stringp tree)
|
||||
(unless (gethash tree packages-to-rebuild)
|
||||
(cl-incf n 1)
|
||||
(puthash tree t packages-to-rebuild)))
|
||||
((listp tree)
|
||||
(add-to-rebuild (car tree))
|
||||
(add-to-rebuild (cdr tree))))))
|
||||
(add-to-rebuild dependents)
|
||||
(puthash package t packages-to-rebuild)
|
||||
(print! (success "\r(%d/%d) %s: %s -> %s%s%s")
|
||||
i total local-repo
|
||||
(doom-packages--abbrev-commit ref)
|
||||
(doom-packages--abbrev-commit target-ref)
|
||||
(if (and (integerp commits) (> commits 0))
|
||||
(format " [%d commit(s)]" commits)
|
||||
"")
|
||||
(if (> n 0)
|
||||
(format " (w/ %d dependents)" n)
|
||||
"")))
|
||||
(unless (string-empty-p output)
|
||||
(let ((lines (split-string output "\n")))
|
||||
(setq output
|
||||
(if (> (length lines) 20)
|
||||
(concat (string-join (cl-subseq (butlast lines 1) 0 20) "\n")
|
||||
"\n[...]")
|
||||
output)))
|
||||
(print-group! (print! "%s" (indent output 2)))))
|
||||
(user-error
|
||||
(signal 'user-error (error-message-string e)))
|
||||
(error
|
||||
(signal 'doom-package-error (list package e)))))))
|
||||
(print-group!
|
||||
(if (hash-table-empty-p packages-to-rebuild)
|
||||
(ignore (print! (success "\rAll %d packages are up-to-date") total))
|
||||
(doom-packages--cli-recipes-update)
|
||||
(straight--transaction-finalize)
|
||||
(let ((default-directory (straight--build-dir)))
|
||||
(mapc (doom-rpartial #'delete-directory 'recursive)
|
||||
(hash-table-keys packages-to-rebuild)))
|
||||
(print! (success "\rUpdated %d package(s)")
|
||||
(hash-table-count packages-to-rebuild))
|
||||
(doom-packages-ensure)
|
||||
t))))
|
||||
|
||||
|
||||
;;; PURGE (for the emperor)
|
||||
(defun doom-packages--purge-build (build)
|
||||
(let ((build-dir (straight--build-dir build)))
|
||||
(delete-directory build-dir 'recursive)
|
||||
(if (file-directory-p build-dir)
|
||||
(ignore (print! (error "Failed to purg build/%s" build)))
|
||||
(print! (success "Purged build/%s" build))
|
||||
t)))
|
||||
|
||||
(defun doom-packages--purge-builds (builds)
|
||||
(if (not builds)
|
||||
(prog1 0
|
||||
(print! (item "No builds to purge")))
|
||||
(print! (start "Purging straight builds..." (length builds)))
|
||||
(print-group!
|
||||
(length
|
||||
(delq nil (mapcar #'doom-packages--purge-build builds))))))
|
||||
|
||||
(cl-defun doom-packages--regraft-repo (repo)
|
||||
(unless repo
|
||||
(error "No repo specified for regrafting"))
|
||||
(let ((default-directory (straight--repos-dir repo)))
|
||||
(unless (file-directory-p ".git")
|
||||
(print! (warn "\rrepos/%s is not a git repo, skipping" repo))
|
||||
(cl-return))
|
||||
(unless (file-in-directory-p default-directory straight-base-dir)
|
||||
(print! (warn "\rSkipping repos/%s because it is local" repo))
|
||||
(cl-return))
|
||||
(let ((before-size (doom-directory-size default-directory)))
|
||||
(doom-call-process "git" "reset" "--hard")
|
||||
(doom-call-process "git" "clean" "-ffd")
|
||||
(if (not (zerop (car (doom-call-process "git" "replace" "--graft" "HEAD"))))
|
||||
(print! (item "\rrepos/%s is already compact\033[1A" repo))
|
||||
(doom-call-process "git" "reflog" "expire" "--expire=all" "--all")
|
||||
(doom-call-process "git" "gc" "--prune=now")
|
||||
(let ((after-size (doom-directory-size default-directory)))
|
||||
(if (equal after-size before-size)
|
||||
(print! (success "\rrepos/%s cannot be compacted further" repo))
|
||||
(print! (success "\rRegrafted repos/%s (from %0.1fKB to %0.1fKB)")
|
||||
repo before-size after-size)))))
|
||||
t))
|
||||
|
||||
(defun doom-packages--regraft-repos (repos)
|
||||
(if (not repos)
|
||||
(prog1 0
|
||||
(print! (item "No repos to regraft")))
|
||||
(print! (start "Regrafting %d repos..." (length repos)))
|
||||
(let ((before-size (doom-directory-size (straight--repos-dir))))
|
||||
(print-group!
|
||||
(prog1 (delq nil (mapcar #'doom-packages--regraft-repo repos))
|
||||
;; (princ "\r\033[K")
|
||||
(let ((after-size (doom-directory-size (straight--repos-dir))))
|
||||
(print! (success "\rFinished regrafting. Size before: %0.1fKB and after: %0.1fKB (%0.1fKB)")
|
||||
before-size after-size
|
||||
(- after-size before-size))))))))
|
||||
|
||||
(defun doom-packages--purge-repo (repo)
|
||||
(let ((repo-dir (straight--repos-dir repo)))
|
||||
(when (file-directory-p repo-dir)
|
||||
(delete-directory repo-dir 'recursive)
|
||||
(delete-file (straight--modified-file repo))
|
||||
(if (file-directory-p repo-dir)
|
||||
(ignore (print! (error "Failed to purge repos/%s" repo)))
|
||||
(print! (success "Purged repos/%s" repo))
|
||||
t))))
|
||||
|
||||
(defun doom-packages--purge-repos (repos)
|
||||
(if (not repos)
|
||||
(prog1 0
|
||||
(print! (item "No repos to purge")))
|
||||
(print! (start "Purging straight repositories..."))
|
||||
(print-group!
|
||||
(length
|
||||
(delq nil (mapcar #'doom-packages--purge-repo repos))))))
|
||||
|
||||
(defun doom-packages--purge-elpa ()
|
||||
(let ((dirs (doom-files-in package-user-dir :type t :depth 0)))
|
||||
(if (not dirs)
|
||||
(prog1 0
|
||||
(print! (item "No ELPA packages to purge")))
|
||||
(print! (start "Purging ELPA packages..."))
|
||||
(dolist (path dirs (length dirs))
|
||||
(condition-case e
|
||||
(print-group!
|
||||
(if (file-directory-p path)
|
||||
(delete-directory path 'recursive)
|
||||
(delete-file path))
|
||||
(print! (success "Deleted %s") (filename path)))
|
||||
(error
|
||||
(print! (error "Failed to delete %s because: %s")
|
||||
(filename path)
|
||||
e)))))))
|
||||
|
||||
(defun doom-packages--purge-eln ()
|
||||
(if-let (dirs
|
||||
(cl-delete (expand-file-name comp-native-version-dir doom-packages--eln-output-path)
|
||||
(directory-files doom-packages--eln-output-path t "^[^.]" t)
|
||||
:test #'file-equal-p))
|
||||
(progn
|
||||
(print! (start "Purging old native bytecode..."))
|
||||
(print-group!
|
||||
(dolist (dir dirs)
|
||||
(print! (item "Deleting %S") (relpath dir doom-packages--eln-output-path))
|
||||
(delete-directory dir 'recursive))
|
||||
(print! (success "Purged %d directory(ies)" (length dirs))))
|
||||
(length dirs))
|
||||
(print! (item "No ELN directories to purge"))
|
||||
0))
|
||||
|
||||
(defun doom-packages-purge (&optional elpa-p builds-p repos-p regraft-repos-p eln-p)
|
||||
"Auto-removes orphaned packages and repos.
|
||||
|
||||
An orphaned package is a package that isn't a primary package (i.e. doesn't have
|
||||
a `package!' declaration) or isn't depended on by another primary package.
|
||||
|
||||
If BUILDS-P, include straight package builds.
|
||||
If REPOS-P, include straight repos.
|
||||
If ELPA-P, include packages installed with package.el (M-x package-install)."
|
||||
(doom-initialize-packages)
|
||||
(doom-packages--barf-if-incomplete)
|
||||
(print! (start "Purging orphaned packages (for the emperor)..."))
|
||||
(quiet! (straight-prune-build-cache))
|
||||
(cl-destructuring-bind (&optional builds-to-purge repos-to-purge repos-to-regraft)
|
||||
(let ((rdirs
|
||||
(and (or repos-p regraft-repos-p)
|
||||
(straight--directory-files (straight--repos-dir) nil nil 'sort))))
|
||||
(list (when builds-p
|
||||
(let ((default-directory (straight--build-dir)))
|
||||
(seq-filter #'file-directory-p
|
||||
(seq-remove (doom-rpartial #'gethash straight--profile-cache)
|
||||
(straight--directory-files default-directory nil nil 'sort)))))
|
||||
(when repos-p
|
||||
(seq-remove (doom-rpartial #'straight--checkhash straight--repo-cache)
|
||||
rdirs))
|
||||
(when regraft-repos-p
|
||||
(seq-filter (doom-rpartial #'straight--checkhash straight--repo-cache)
|
||||
rdirs))))
|
||||
(print-group!
|
||||
(delq
|
||||
nil (list
|
||||
(if (not builds-p)
|
||||
(ignore (print! (item "Skipping builds")))
|
||||
(/= 0 (doom-packages--purge-builds builds-to-purge)))
|
||||
(if (not elpa-p)
|
||||
(ignore (print! (item "Skipping elpa packages")))
|
||||
(/= 0 (doom-packages--purge-elpa)))
|
||||
(if (not repos-p)
|
||||
(ignore (print! (item "Skipping repos")))
|
||||
(/= 0 (doom-packages--purge-repos repos-to-purge)))
|
||||
(if (not regraft-repos-p)
|
||||
(ignore (print! (item "Skipping regrafting")))
|
||||
(doom-packages--regraft-repos repos-to-regraft))
|
||||
(when (featurep 'native-compile)
|
||||
(if (not eln-p)
|
||||
(ignore (print! (item "Skipping native bytecode")))
|
||||
(doom-packages--purge-eln))))))))
|
||||
|
||||
(provide 'doom-cli-packages)
|
||||
;;; packages.el ends here
|
||||
@ -2,7 +2,7 @@
|
||||
;;; Commentary:
|
||||
;;; Code:
|
||||
|
||||
(load! "packages")
|
||||
(doom-require 'doom-lib 'packages)
|
||||
|
||||
|
||||
;;
|
||||
|
||||
@ -2,7 +2,7 @@
|
||||
;;; Commentary:
|
||||
;;; Code:
|
||||
|
||||
(load! "packages")
|
||||
(doom-require 'doom-lib 'packages)
|
||||
|
||||
|
||||
;;
|
||||
|
||||
@ -36,6 +36,7 @@
|
||||
;;
|
||||
;;; Code:
|
||||
|
||||
(require 'comp nil t)
|
||||
(require 'doom-straight)
|
||||
(doom-require 'doom-lib 'modules)
|
||||
|
||||
@ -726,5 +727,620 @@ Must be run from a magit diff buffer."
|
||||
(magit-commit-create
|
||||
(list "-e" "-m" (doom/bumpify-diff))))
|
||||
|
||||
|
||||
;;
|
||||
;;; CLI API
|
||||
|
||||
(defun doom-packages--same-commit-p (abbrev-ref ref)
|
||||
(and (stringp abbrev-ref)
|
||||
(stringp ref)
|
||||
(string-match-p (concat "^" (regexp-quote abbrev-ref))
|
||||
ref)))
|
||||
|
||||
(defun doom-packages--abbrev-commit (commit &optional full)
|
||||
(if full commit (substring commit 0 7)))
|
||||
|
||||
(defun doom-packages--commit-log-between (start-ref end-ref)
|
||||
(straight--process-with-result
|
||||
(straight--process-run
|
||||
"git" "log" "--oneline" "--no-merges"
|
||||
end-ref (concat "^" (regexp-quote start-ref)))
|
||||
(if success
|
||||
(string-trim-right (or stdout ""))
|
||||
(format "ERROR: Couldn't collect commit list because: %s" stderr))))
|
||||
|
||||
(defmacro doom-packages--straight-with (form &rest body)
|
||||
(declare (indent 1))
|
||||
`(let-alist
|
||||
(let* ((buffer (straight--process-buffer))
|
||||
(start (with-current-buffer buffer (point-max)))
|
||||
(retval ,form)
|
||||
(output (with-current-buffer buffer (buffer-substring start (point-max)))))
|
||||
(save-match-data
|
||||
(list (cons 'it retval)
|
||||
(cons 'stdout (substring-no-properties output))
|
||||
(cons 'success (if (string-match "\n+\\[Return code: \\([0-9-]+\\)\\]\n+" output)
|
||||
(string-to-number (match-string 1 output))))
|
||||
(cons 'output (string-trim output
|
||||
"^\\(\\$ [^\n]+\n\\)*\n+"
|
||||
"\n+\\[Return code: [0-9-]+\\]\n+")))))
|
||||
,@body))
|
||||
|
||||
(defun doom-packages--barf-if-incomplete ()
|
||||
(let ((straight-safe-mode t))
|
||||
(condition-case _ (straight-check-all)
|
||||
(error (user-error "Package state is incomplete. Run 'doom sync' first")))))
|
||||
|
||||
(defmacro doom-packages--with-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 &rest _) (cl-pushnew pkg built :test #'equal))
|
||||
straight-use-package-pre-build-functions)))
|
||||
(dolist (,recipe-var ,recipes-var (nreverse built))
|
||||
(cl-block nil
|
||||
(straight--with-plist (append (list :recipe ,recipe-var) ,recipe-var)
|
||||
,(ensure-list binds)
|
||||
,@body))))))
|
||||
|
||||
(defvar doom-packages--cli-updated-recipes nil)
|
||||
(defun doom-packages--cli-recipes-update ()
|
||||
"Updates straight and recipe repos."
|
||||
(unless doom-packages--cli-updated-recipes
|
||||
(straight--make-build-cache-available)
|
||||
(print! (start "Updating recipe repos..."))
|
||||
(print-group!
|
||||
(doom-packages--with-recipes
|
||||
(delq
|
||||
nil (mapcar (doom-rpartial #'gethash straight--repo-cache)
|
||||
(mapcar #'symbol-name straight-recipe-repositories)))
|
||||
(recipe package type local-repo)
|
||||
(let ((esc (if init-file-debug "" "\033[1A"))
|
||||
(ref (straight-vc-get-commit type local-repo))
|
||||
newref output)
|
||||
(print! (start "\rUpdating recipes for %s...%s") package esc)
|
||||
(doom-packages--straight-with (straight-vc-fetch-from-remote recipe)
|
||||
(when .it
|
||||
(setq output .output)
|
||||
(straight-merge-package package)
|
||||
(unless (equal ref (setq newref (straight-vc-get-commit type local-repo)))
|
||||
(print! (success "\r%s updated (%s -> %s)")
|
||||
package
|
||||
(doom-packages--abbrev-commit ref)
|
||||
(doom-packages--abbrev-commit newref))
|
||||
(unless (string-empty-p output)
|
||||
(print-group! (print! (item "%s" output))))))))))
|
||||
(setq straight--recipe-lookup-cache (make-hash-table :test #'eq)
|
||||
doom-packages--cli-updated-recipes t)))
|
||||
|
||||
(defvar doom-packages--eln-output-expected nil)
|
||||
|
||||
(defvar doom-packages--eln-output-path (car (bound-and-true-p native-comp-eln-load-path)))
|
||||
|
||||
(defun doom-packages--eln-file-name (file)
|
||||
"Return the short .eln file name corresponding to `file'."
|
||||
(file-name-concat
|
||||
comp-native-version-dir
|
||||
(file-name-nondirectory
|
||||
(comp-el-to-eln-filename file))))
|
||||
|
||||
(defun doom-packages--eln-output-file (eln-name)
|
||||
"Return the expected .eln file corresponding to `eln-name'."
|
||||
(file-name-concat doom-packages--eln-output-path eln-name))
|
||||
|
||||
(defun doom-packages--eln-error-file (eln-name)
|
||||
"Return the expected .error file corresponding to `eln-name'."
|
||||
(file-name-concat doom-packages--eln-output-path eln-name ".error"))
|
||||
|
||||
(defun doom-packages--find-eln-file (eln-name)
|
||||
"Find `eln-name' on the `native-comp-eln-load-path'."
|
||||
(cl-some (fn! (file-exists-p! eln-name %))
|
||||
native-comp-eln-load-path))
|
||||
|
||||
(defun doom-packages--elc-file-outdated-p (file)
|
||||
"Check whether the corresponding .elc for `file' is outdated."
|
||||
(let ((elc-file (byte-compile-dest-file file)))
|
||||
;; NOTE Ignore missing elc files, they could be missing due to
|
||||
;; `no-byte-compile'. Rebuilding unnecessarily is expensive.
|
||||
(when (and (file-exists-p elc-file)
|
||||
(file-newer-than-file-p file elc-file))
|
||||
(doom-log "packages:elc: %s is newer than %s" file elc-file)
|
||||
t)))
|
||||
|
||||
(defun doom-packages--eln-file-outdated-p (file)
|
||||
"Check whether the corresponding .eln for `file' is outdated."
|
||||
(when (file-exists-p file)
|
||||
(let* ((eln-name (doom-packages--eln-file-name file))
|
||||
(eln-file (doom-packages--find-eln-file eln-name))
|
||||
(error-file (doom-packages--eln-error-file eln-name)))
|
||||
(cond (eln-file
|
||||
(when (file-newer-than-file-p file eln-file)
|
||||
(doom-log "packages:eln: %s is newer than %s" file eln-file)
|
||||
t))
|
||||
((file-exists-p error-file)
|
||||
(when (file-newer-than-file-p file error-file)
|
||||
(doom-log "packages:eln: %s is newer than %s" file error-file)
|
||||
t))))))
|
||||
|
||||
(defun doom-packages--native-compile-done-h (file)
|
||||
"Callback fired when an item has finished async compilation."
|
||||
(when file
|
||||
(let* ((eln-name (doom-packages--eln-file-name file))
|
||||
(eln-file (doom-packages--eln-output-file eln-name))
|
||||
(error-file (doom-packages--eln-error-file eln-name)))
|
||||
(if (file-exists-p eln-file)
|
||||
(doom-log "packages:nativecomp: Compiled %s" eln-file)
|
||||
(let ((error-dir (file-name-directory error-file)))
|
||||
(if (not (file-writable-p error-dir))
|
||||
(doom-log "packages:nativecomp: failed to write %s" error-file)
|
||||
(make-directory error-dir 'parents)
|
||||
(write-region "" nil error-file)
|
||||
(doom-log "packages:nativecomp: wrote %s" error-file)))))))
|
||||
|
||||
(defun doom-packages--wait-for-native-compile-jobs ()
|
||||
"Wait for all pending async native compilation jobs."
|
||||
(cl-loop with previous = 0
|
||||
with timeout = 30
|
||||
with timer = 0
|
||||
for pending = (+ (length comp-files-queue)
|
||||
(if (functionp 'comp--async-runnings)
|
||||
(comp--async-runnings)
|
||||
(comp-async-runnings)))
|
||||
while (not (zerop pending))
|
||||
if (/= previous pending) do
|
||||
(print! (start "\rNatively compiling %d files...\033[1A" pending))
|
||||
(setq previous pending
|
||||
timer 0)
|
||||
else do
|
||||
(let ((inhibit-message t))
|
||||
(if (> timer timeout)
|
||||
(cl-loop for file-name being each hash-key of comp-async-compilations
|
||||
for prc = (gethash file-name comp-async-compilations)
|
||||
unless (process-live-p prc)
|
||||
do (setq timer 0)
|
||||
and do (print! (warn "Native compilation of %S timed out" (path file-name)))
|
||||
and return (kill-process prc))
|
||||
(cl-incf timer 0.1))
|
||||
(sleep-for 0.1))))
|
||||
|
||||
(defun doom-packages--write-missing-eln-errors ()
|
||||
"Write .error files for any expected .eln files that are missing."
|
||||
(cl-loop for file in doom-packages--eln-output-expected
|
||||
for eln-name = (doom-packages--eln-file-name file)
|
||||
for eln-file = (doom-packages--eln-output-file eln-name)
|
||||
for error-file = (doom-packages--eln-error-file eln-name)
|
||||
for error-dir = (file-name-directory error-file)
|
||||
unless (or (file-exists-p eln-file)
|
||||
(file-newer-than-file-p error-file file)
|
||||
(not (file-writable-p error-dir)))
|
||||
do (make-directory error-dir 'parents)
|
||||
(write-region "" nil error-file)
|
||||
(doom-log "Wrote %s" error-file))
|
||||
(setq doom-packages--eln-output-expected nil))
|
||||
|
||||
(defun doom-packages--compile-site-files ()
|
||||
"Queue async compilation for all non-doom Elisp files."
|
||||
(cl-loop with paths = (cl-loop for path in load-path
|
||||
unless (file-in-directory-p path doom-local-dir)
|
||||
collect path)
|
||||
for file in (doom-files-in paths :match "\\.el\\(?:\\.gz\\)?$")
|
||||
if (and (file-exists-p (byte-compile-dest-file file))
|
||||
(not (doom-packages--find-eln-file (doom-packages--eln-file-name file)))
|
||||
(not (cl-some (fn! (string-match-p % file))
|
||||
native-comp-deferred-compilation-deny-list))) do
|
||||
(doom-log "Compiling %s" file)
|
||||
(native-compile-async file)))
|
||||
|
||||
(defun doom-packages-ensure (&optional force-p)
|
||||
"Ensure packages are installed, built"
|
||||
(doom-initialize-packages)
|
||||
(if (not (file-directory-p (straight--repos-dir)))
|
||||
(print! (start "Installing all packages for the first time (this may take a while)..."))
|
||||
(if force-p
|
||||
(print! (start "Rebuilding all packages (this may take a while)..."))
|
||||
(print! (start "Ensuring packages are installed and built..."))))
|
||||
(print-group!
|
||||
(let ((straight-check-for-modifications
|
||||
(when (file-directory-p (straight--modified-dir))
|
||||
'(find-when-checking)))
|
||||
(straight--allow-find
|
||||
(and straight-check-for-modifications
|
||||
(executable-find straight-find-executable)
|
||||
t))
|
||||
(straight--packages-not-to-rebuild
|
||||
(or straight--packages-not-to-rebuild (make-hash-table :test #'equal)))
|
||||
(straight--packages-to-rebuild
|
||||
(or (if force-p :all straight--packages-to-rebuild)
|
||||
(make-hash-table :test #'equal)))
|
||||
(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
|
||||
(doom-packages--with-recipes recipes (package local-repo recipe)
|
||||
(let ((repo-dir (straight--repos-dir (or local-repo package)))
|
||||
(build-dir (straight--build-dir package)))
|
||||
(unless force-p
|
||||
;; Ensure packages with outdated files/bytecode are rebuilt
|
||||
(let* ((build (if (plist-member recipe :build)
|
||||
(plist-get recipe :build)
|
||||
t))
|
||||
(want-byte-compile
|
||||
(or (eq build t)
|
||||
(memq 'compile build)))
|
||||
(want-native-compile
|
||||
(or (eq build t)
|
||||
(memq 'native-compile build))))
|
||||
(and (eq (car-safe build) :not)
|
||||
(setq want-byte-compile (not want-byte-compile)
|
||||
want-native-compile (not want-native-compile)))
|
||||
(when (or (not (featurep 'native-compile))
|
||||
(not straight--native-comp-available))
|
||||
(setq want-native-compile nil))
|
||||
(and (or want-byte-compile want-native-compile)
|
||||
(or (file-newer-than-file-p repo-dir build-dir)
|
||||
(file-exists-p (straight--modified-dir package))
|
||||
(cl-loop with outdated = nil
|
||||
for file in (doom-files-in build-dir :match "\\.el$" :full t)
|
||||
if (or (if want-byte-compile (doom-packages--elc-file-outdated-p file))
|
||||
(if want-native-compile (doom-packages--eln-file-outdated-p file)))
|
||||
do (setq outdated t)
|
||||
(when want-native-compile
|
||||
(push file doom-packages--eln-output-expected))
|
||||
finally return outdated))
|
||||
(puthash package t straight--packages-to-rebuild))))
|
||||
(unless (file-directory-p repo-dir)
|
||||
(doom-packages--cli-recipes-update))
|
||||
(condition-case-unless-debug e
|
||||
(let ((straight-vc-git-post-clone-hook
|
||||
(cons (lambda! (&key commit)
|
||||
(print-group!
|
||||
(if-let (pin (cdr (assoc package pinned)))
|
||||
(print! (item "Pinned to %s") pin)
|
||||
(when commit
|
||||
(print! (item "Checked out %s") commit)))))
|
||||
straight-vc-git-post-clone-hook)))
|
||||
(straight-use-package (intern package))
|
||||
(when (file-in-directory-p repo-dir straight-base-dir)
|
||||
;; HACK: Straight can sometimes fail to clone a repo,
|
||||
;; leaving behind an empty directory which, in
|
||||
;; future invocations, it will assume indicates a
|
||||
;; successful clone (causing load errors later).
|
||||
(let ((try 0))
|
||||
(while (not (file-directory-p (doom-path repo-dir ".git")))
|
||||
(when (= try 3)
|
||||
(error "Failed to clone package"))
|
||||
(print! (warn "Failed to clone %S, trying again (attempt #%d)...") package (1+ try))
|
||||
(delete-directory repo-dir t)
|
||||
(delete-directory build-dir t)
|
||||
(straight-use-package (intern package))
|
||||
(cl-incf try)))
|
||||
;; HACK: Line encoding issues can plague repos with
|
||||
;; dirty worktree prompts when updating packages or
|
||||
;; "Local variables entry is missing the suffix"
|
||||
;; errors when installing them (see #2637), so have
|
||||
;; git handle conversion by force.
|
||||
(when doom--system-windows-p
|
||||
(let ((default-directory repo-dir))
|
||||
(straight--process-run "git" "config" "core.autocrlf" "true")))))
|
||||
(error
|
||||
(signal 'doom-package-error (list package e)))))))
|
||||
(progn
|
||||
(when (and (featurep 'native-compile)
|
||||
straight--native-comp-available)
|
||||
(doom-packages--compile-site-files)
|
||||
(doom-packages--wait-for-native-compile-jobs)
|
||||
(doom-packages--write-missing-eln-errors))
|
||||
;; HACK: Every time you save a file in a package that straight
|
||||
;; tracks, it is recorded in ~/.emacs.d/.local/straight/modified/.
|
||||
;; Typically, straight will clean these up after rebuilding, but
|
||||
;; Doom's use-case circumnavigates that, leaving these files there
|
||||
;; and causing a rebuild of those packages each time `doom sync'
|
||||
;; or similar is run, so we clean it up ourselves:
|
||||
(delete-directory (straight--modified-dir) 'recursive)
|
||||
(print! (success "\rBuilt %d package(s)") (length built)))
|
||||
(print! (item "No packages need attention"))
|
||||
nil))))
|
||||
|
||||
(defun doom-packages-update (&optional pinned-only-p)
|
||||
"Updates packages."
|
||||
(doom-initialize-packages)
|
||||
(doom-packages--barf-if-incomplete)
|
||||
(let* ((repo-dir (straight--repos-dir))
|
||||
(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))
|
||||
(esc (if init-file-debug "" "\033[1A"))
|
||||
(i 0))
|
||||
(if pinned-only-p
|
||||
(print! (start "Updating pinned packages..."))
|
||||
(print! (start "Updating all packages (this may take a while)...")))
|
||||
(doom-packages--with-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)
|
||||
(cl-return))
|
||||
(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)))
|
||||
(unless (file-in-directory-p default-directory repo-dir)
|
||||
(print! (warn "(%d/%d) Skipping %s because it is out-of-tree...") i total package)
|
||||
(cl-return))
|
||||
(when (eq type 'git)
|
||||
(unless (file-exists-p ".git")
|
||||
(error "%S is not a valid repository" package)))
|
||||
(when (and pinned-only-p (not (assoc local-repo pinned)))
|
||||
(cl-return))
|
||||
(condition-case-unless-debug e
|
||||
(let ((ref (straight-vc-get-commit type local-repo))
|
||||
(target-ref
|
||||
(cdr (or (assoc local-repo pinned)
|
||||
(assoc package pinned))))
|
||||
commits
|
||||
output)
|
||||
(or (cond
|
||||
((not (stringp target-ref))
|
||||
(print! (start "\r(%d/%d) Fetching %s...%s") i total package esc)
|
||||
(doom-packages--straight-with (straight-vc-fetch-from-remote recipe)
|
||||
(when .it
|
||||
(straight-merge-package package)
|
||||
(setq target-ref (straight-vc-get-commit type local-repo))
|
||||
(setq output (doom-packages--commit-log-between ref target-ref)
|
||||
commits (length (split-string output "\n" t)))
|
||||
(or (not (doom-packages--same-commit-p target-ref ref))
|
||||
(cl-return)))))
|
||||
|
||||
((doom-packages--same-commit-p target-ref ref)
|
||||
(print! (item "\r(%d/%d) %s is up-to-date...%s") i total package esc)
|
||||
(cl-return))
|
||||
|
||||
((if (straight-vc-commit-present-p recipe target-ref)
|
||||
(print! (start "\r(%d/%d) Checking out %s (%s)...%s")
|
||||
i total package (doom-packages--abbrev-commit target-ref) esc)
|
||||
(print! (start "\r(%d/%d) Fetching %s...%s") i total package esc)
|
||||
(and (straight-vc-fetch-from-remote recipe)
|
||||
(straight-vc-commit-present-p recipe target-ref)))
|
||||
(straight-vc-check-out-commit recipe target-ref)
|
||||
(or (not (eq type 'git))
|
||||
(setq output (doom-packages--commit-log-between ref target-ref)
|
||||
commits (length (split-string output "\n" t))))
|
||||
(doom-packages--same-commit-p target-ref (straight-vc-get-commit type local-repo)))
|
||||
|
||||
((print! (start "\r(%d/%d) Re-cloning %s...") i total local-repo esc)
|
||||
(let ((repo (straight--repos-dir local-repo))
|
||||
(straight-vc-git-default-clone-depth 'full))
|
||||
(delete-directory repo 'recursive)
|
||||
(print-group!
|
||||
(straight-use-package (intern package) nil 'no-build))
|
||||
(prog1 (file-directory-p repo)
|
||||
(or (not (eq type 'git))
|
||||
(setq output (doom-packages--commit-log-between ref target-ref)
|
||||
commits (length (split-string output "\n" t))))))))
|
||||
(progn
|
||||
(print! (warn "\r(%d/%d) Failed to fetch %s")
|
||||
i total local-repo)
|
||||
(unless (string-empty-p output)
|
||||
(print-group! (print! (item "%s" output))))
|
||||
(cl-return)))
|
||||
(puthash local-repo t repos-to-rebuild)
|
||||
;; HACK: Rebuild all packages that depend on PACKAGE after
|
||||
;; updating it. This ensures their bytecode don't contain stale
|
||||
;; references to symbols in silent dependencies.
|
||||
;; TODO: Allow `package!' to control this.
|
||||
;; TODO: Add cache+optimization step for this rebuild table.
|
||||
(letf! ((dependents (straight-dependents package))
|
||||
(n 0)
|
||||
(defun* add-to-rebuild (tree)
|
||||
(cond ((null tree) nil)
|
||||
((stringp tree)
|
||||
(unless (gethash tree packages-to-rebuild)
|
||||
(cl-incf n 1)
|
||||
(puthash tree t packages-to-rebuild)))
|
||||
((listp tree)
|
||||
(add-to-rebuild (car tree))
|
||||
(add-to-rebuild (cdr tree))))))
|
||||
(add-to-rebuild dependents)
|
||||
(puthash package t packages-to-rebuild)
|
||||
(print! (success "\r(%d/%d) %s: %s -> %s%s%s")
|
||||
i total local-repo
|
||||
(doom-packages--abbrev-commit ref)
|
||||
(doom-packages--abbrev-commit target-ref)
|
||||
(if (and (integerp commits) (> commits 0))
|
||||
(format " [%d commit(s)]" commits)
|
||||
"")
|
||||
(if (> n 0)
|
||||
(format " (w/ %d dependents)" n)
|
||||
"")))
|
||||
(unless (string-empty-p output)
|
||||
(let ((lines (split-string output "\n")))
|
||||
(setq output
|
||||
(if (> (length lines) 20)
|
||||
(concat (string-join (cl-subseq (butlast lines 1) 0 20) "\n")
|
||||
"\n[...]")
|
||||
output)))
|
||||
(print-group! (print! "%s" (indent output 2)))))
|
||||
(user-error
|
||||
(signal 'user-error (error-message-string e)))
|
||||
(error
|
||||
(signal 'doom-package-error (list package e)))))))
|
||||
(print-group!
|
||||
(if (hash-table-empty-p packages-to-rebuild)
|
||||
(ignore (print! (success "\rAll %d packages are up-to-date") total))
|
||||
(doom-packages--cli-recipes-update)
|
||||
(straight--transaction-finalize)
|
||||
(let ((default-directory (straight--build-dir)))
|
||||
(mapc (doom-rpartial #'delete-directory 'recursive)
|
||||
(hash-table-keys packages-to-rebuild)))
|
||||
(print! (success "\rUpdated %d package(s)")
|
||||
(hash-table-count packages-to-rebuild))
|
||||
(doom-packages-ensure)
|
||||
t))))
|
||||
|
||||
|
||||
;;; PURGE (for the emperor)
|
||||
(defun doom-packages--purge-build (build)
|
||||
(let ((build-dir (straight--build-dir build)))
|
||||
(delete-directory build-dir 'recursive)
|
||||
(if (file-directory-p build-dir)
|
||||
(ignore (print! (error "Failed to purg build/%s" build)))
|
||||
(print! (success "Purged build/%s" build))
|
||||
t)))
|
||||
|
||||
(defun doom-packages--purge-builds (builds)
|
||||
(if (not builds)
|
||||
(prog1 0
|
||||
(print! (item "No builds to purge")))
|
||||
(print! (start "Purging straight builds..." (length builds)))
|
||||
(print-group!
|
||||
(length
|
||||
(delq nil (mapcar #'doom-packages--purge-build builds))))))
|
||||
|
||||
(cl-defun doom-packages--regraft-repo (repo)
|
||||
(unless repo
|
||||
(error "No repo specified for regrafting"))
|
||||
(let ((default-directory (straight--repos-dir repo)))
|
||||
(unless (file-directory-p ".git")
|
||||
(print! (warn "\rrepos/%s is not a git repo, skipping" repo))
|
||||
(cl-return))
|
||||
(unless (file-in-directory-p default-directory straight-base-dir)
|
||||
(print! (warn "\rSkipping repos/%s because it is local" repo))
|
||||
(cl-return))
|
||||
(let ((before-size (doom-directory-size default-directory)))
|
||||
(doom-call-process "git" "reset" "--hard")
|
||||
(doom-call-process "git" "clean" "-ffd")
|
||||
(if (not (zerop (car (doom-call-process "git" "replace" "--graft" "HEAD"))))
|
||||
(print! (item "\rrepos/%s is already compact\033[1A" repo))
|
||||
(doom-call-process "git" "reflog" "expire" "--expire=all" "--all")
|
||||
(doom-call-process "git" "gc" "--prune=now")
|
||||
(let ((after-size (doom-directory-size default-directory)))
|
||||
(if (equal after-size before-size)
|
||||
(print! (success "\rrepos/%s cannot be compacted further" repo))
|
||||
(print! (success "\rRegrafted repos/%s (from %0.1fKB to %0.1fKB)")
|
||||
repo before-size after-size)))))
|
||||
t))
|
||||
|
||||
(defun doom-packages--regraft-repos (repos)
|
||||
(if (not repos)
|
||||
(prog1 0
|
||||
(print! (item "No repos to regraft")))
|
||||
(print! (start "Regrafting %d repos..." (length repos)))
|
||||
(let ((before-size (doom-directory-size (straight--repos-dir))))
|
||||
(print-group!
|
||||
(prog1 (delq nil (mapcar #'doom-packages--regraft-repo repos))
|
||||
;; (princ "\r\033[K")
|
||||
(let ((after-size (doom-directory-size (straight--repos-dir))))
|
||||
(print! (success "\rFinished regrafting. Size before: %0.1fKB and after: %0.1fKB (%0.1fKB)")
|
||||
before-size after-size
|
||||
(- after-size before-size))))))))
|
||||
|
||||
(defun doom-packages--purge-repo (repo)
|
||||
(let ((repo-dir (straight--repos-dir repo)))
|
||||
(when (file-directory-p repo-dir)
|
||||
(delete-directory repo-dir 'recursive)
|
||||
(delete-file (straight--modified-file repo))
|
||||
(if (file-directory-p repo-dir)
|
||||
(ignore (print! (error "Failed to purge repos/%s" repo)))
|
||||
(print! (success "Purged repos/%s" repo))
|
||||
t))))
|
||||
|
||||
(defun doom-packages--purge-repos (repos)
|
||||
(if (not repos)
|
||||
(prog1 0
|
||||
(print! (item "No repos to purge")))
|
||||
(print! (start "Purging straight repositories..."))
|
||||
(print-group!
|
||||
(length
|
||||
(delq nil (mapcar #'doom-packages--purge-repo repos))))))
|
||||
|
||||
(defun doom-packages--purge-elpa ()
|
||||
(let ((dirs (doom-files-in package-user-dir :type t :depth 0)))
|
||||
(if (not dirs)
|
||||
(prog1 0
|
||||
(print! (item "No ELPA packages to purge")))
|
||||
(print! (start "Purging ELPA packages..."))
|
||||
(dolist (path dirs (length dirs))
|
||||
(condition-case e
|
||||
(print-group!
|
||||
(if (file-directory-p path)
|
||||
(delete-directory path 'recursive)
|
||||
(delete-file path))
|
||||
(print! (success "Deleted %s") (filename path)))
|
||||
(error
|
||||
(print! (error "Failed to delete %s because: %s")
|
||||
(filename path)
|
||||
e)))))))
|
||||
|
||||
(defun doom-packages--purge-eln ()
|
||||
(if-let (dirs
|
||||
(cl-delete (expand-file-name comp-native-version-dir doom-packages--eln-output-path)
|
||||
(directory-files doom-packages--eln-output-path t "^[^.]" t)
|
||||
:test #'file-equal-p))
|
||||
(progn
|
||||
(print! (start "Purging old native bytecode..."))
|
||||
(print-group!
|
||||
(dolist (dir dirs)
|
||||
(print! (item "Deleting %S") (relpath dir doom-packages--eln-output-path))
|
||||
(delete-directory dir 'recursive))
|
||||
(print! (success "Purged %d directory(ies)" (length dirs))))
|
||||
(length dirs))
|
||||
(print! (item "No ELN directories to purge"))
|
||||
0))
|
||||
|
||||
(defun doom-packages-purge (&optional elpa-p builds-p repos-p regraft-repos-p eln-p)
|
||||
"Auto-removes orphaned packages and repos.
|
||||
|
||||
An orphaned package is a package that isn't a primary package (i.e. doesn't have
|
||||
a `package!' declaration) or isn't depended on by another primary package.
|
||||
|
||||
If BUILDS-P, include straight package builds.
|
||||
If REPOS-P, include straight repos.
|
||||
If ELPA-P, include packages installed with package.el (M-x package-install)."
|
||||
(doom-initialize-packages)
|
||||
(doom-packages--barf-if-incomplete)
|
||||
(print! (start "Purging orphaned packages (for the emperor)..."))
|
||||
(quiet! (straight-prune-build-cache))
|
||||
(cl-destructuring-bind (&optional builds-to-purge repos-to-purge repos-to-regraft)
|
||||
(let ((rdirs
|
||||
(and (or repos-p regraft-repos-p)
|
||||
(straight--directory-files (straight--repos-dir) nil nil 'sort))))
|
||||
(list (when builds-p
|
||||
(let ((default-directory (straight--build-dir)))
|
||||
(seq-filter #'file-directory-p
|
||||
(seq-remove (doom-rpartial #'gethash straight--profile-cache)
|
||||
(straight--directory-files default-directory nil nil 'sort)))))
|
||||
(when repos-p
|
||||
(seq-remove (doom-rpartial #'straight--checkhash straight--repo-cache)
|
||||
rdirs))
|
||||
(when regraft-repos-p
|
||||
(seq-filter (doom-rpartial #'straight--checkhash straight--repo-cache)
|
||||
rdirs))))
|
||||
(print-group!
|
||||
(delq
|
||||
nil (list
|
||||
(if (not builds-p)
|
||||
(ignore (print! (item "Skipping builds")))
|
||||
(/= 0 (doom-packages--purge-builds builds-to-purge)))
|
||||
(if (not elpa-p)
|
||||
(ignore (print! (item "Skipping elpa packages")))
|
||||
(/= 0 (doom-packages--purge-elpa)))
|
||||
(if (not repos-p)
|
||||
(ignore (print! (item "Skipping repos")))
|
||||
(/= 0 (doom-packages--purge-repos repos-to-purge)))
|
||||
(if (not regraft-repos-p)
|
||||
(ignore (print! (item "Skipping regrafting")))
|
||||
(doom-packages--regraft-repos repos-to-regraft))
|
||||
(when (featurep 'native-compile)
|
||||
(if (not eln-p)
|
||||
(ignore (print! (item "Skipping native bytecode")))
|
||||
(doom-packages--purge-eln))))))))
|
||||
|
||||
(provide 'doom-lib '(packages))
|
||||
;;; packages.el ends here
|
||||
|
||||
Reference in New Issue
Block a user