💥 Replace package.el/quelpa with straight #374
There are a few kinks to iron out, but for the most part it's done. Doom Emacs, powered by straight. Goodbye gnutls and elpa/quelpa issues. This update doesn't come with rollback or lockfile support yet, but I will eventually include one with Doom, and packages will be (by default, anyway) updated in sync with Doom. Relevant threads: #1577 #1566 #1473
This commit is contained in:
Henrik Lissner
parent
492f2dea1e
commit
b90dede1ab
35 changed files with 1542 additions and 1771 deletions
|
|
@ -1,55 +1,47 @@
|
|||
;; -*- no-byte-compile: t; -*-
|
||||
;;; core/cli/packages.el
|
||||
|
||||
;;
|
||||
;;; Helpers
|
||||
|
||||
(defmacro doom--condition-case! (&rest body)
|
||||
`(condition-case-unless-debug e
|
||||
(progn ,@body)
|
||||
('user-error
|
||||
(print! (bold (red " NOTICE: %s")) e))
|
||||
('file-error
|
||||
(print! " %s\n %s"
|
||||
(bold (red "FILE ERROR: %s" (error-message-string e)))
|
||||
"Trying again...")
|
||||
(quiet! (doom-refresh-packages-maybe t))
|
||||
,@body)
|
||||
('error
|
||||
(print! (bold (red " %s %s\n %s"))
|
||||
"FATAL ERROR: " e
|
||||
"Run again with the -d flag for details"))))
|
||||
|
||||
(defsubst doom--ensure-autoloads-while (fn)
|
||||
(doom-reload-doom-autoloads)
|
||||
(when (funcall fn doom-auto-accept)
|
||||
(doom-reload-package-autoloads)))
|
||||
(defmacro doom--ensure-autoloads-while (&rest body)
|
||||
`(progn
|
||||
(doom-reload-core-autoloads)
|
||||
(when (progn ,@body)
|
||||
(doom-reload-package-autoloads 'force-p))
|
||||
t))
|
||||
|
||||
|
||||
;;
|
||||
;;; Dispatchers
|
||||
|
||||
(dispatcher! (install i)
|
||||
(doom--ensure-autoloads-while #'doom-packages-install)
|
||||
"Installs wanted packages that aren't installed.
|
||||
|
||||
Package management in Doom is declarative. A `package!' declaration in an
|
||||
enabled module or your private packages.el marks a package as 'wanted'.")
|
||||
|
||||
(dispatcher! (update u)
|
||||
(doom--ensure-autoloads-while #'doom-packages-update)
|
||||
(def-command! (update u) ()
|
||||
"Updates packages.
|
||||
|
||||
This excludes packages whose `package!' declaration contains a non-nil :freeze
|
||||
or :ignore property.")
|
||||
or :ignore property."
|
||||
(doom--ensure-autoloads-while
|
||||
(straight-check-all)
|
||||
(when (doom-packages-update doom-auto-accept)
|
||||
(doom-packages-rebuild doom-auto-accept)
|
||||
t)))
|
||||
|
||||
(dispatcher! (autoremove r)
|
||||
(doom--ensure-autoloads-while #'doom-packages-autoremove)
|
||||
"Removes packages that are no longer needed.
|
||||
(def-command! (rebuild b) ()
|
||||
"Rebuilds all installed packages.
|
||||
|
||||
This includes packages installed with 'M-x package-install' without an
|
||||
accompanying `package!' declaration in an enabled module's packages.el file or
|
||||
your private one.")
|
||||
This ensures that all needed files are symlinked from their package repo and
|
||||
their elisp files are byte-compiled."
|
||||
(doom--ensure-autoloads-while
|
||||
(doom-packages-rebuild doom-auto-accept (member "all" args))))
|
||||
|
||||
(def-command! (purge p) ()
|
||||
"Deletes any unused packages and package repos.
|
||||
|
||||
You should run this once in a while, as repos tend to build up over time."
|
||||
(doom--ensure-autoloads-while
|
||||
(straight-check-all)
|
||||
(doom-packages-purge doom-auto-accept)))
|
||||
|
||||
;; (def-command! rollback () ; TODO rollback
|
||||
;; "<Not implemented yet>"
|
||||
;; (user-error "Not implemented yet, sorry!"))
|
||||
|
||||
|
||||
;;
|
||||
|
|
@ -63,153 +55,212 @@ declaration) or dependency thereof that hasn't already been.
|
|||
|
||||
Unless AUTO-ACCEPT-P is non-nil, this function will prompt for confirmation with
|
||||
a list of packages that will be installed."
|
||||
(print! "Looking for packages to install...")
|
||||
(let ((packages (doom-get-missing-packages)))
|
||||
(cond ((not packages)
|
||||
(print! (green "No packages to install!"))
|
||||
nil)
|
||||
(print! "> Installing & building packages...")
|
||||
(print-group!
|
||||
(let ((n 0))
|
||||
(dolist (package (hash-table-keys straight--recipe-cache))
|
||||
(straight--with-plist (gethash package straight--recipe-cache)
|
||||
(local-repo)
|
||||
(let ((existed-p (file-directory-p (straight--repos-dir package))))
|
||||
(condition-case-unless-debug e
|
||||
(and (straight-use-package (intern package) nil nil " ")
|
||||
(not existed-p)
|
||||
(file-directory-p (straight--repos-dir package))
|
||||
(cl-incf n))
|
||||
(error
|
||||
(signal 'doom-package-error
|
||||
(list e (straight--process-get-output))))))))
|
||||
(if (= n 0)
|
||||
(ignore (print! (success "No packages need to be installed")))
|
||||
(print! (success "Installed & built %d packages") n)
|
||||
t))))
|
||||
|
||||
((not (or auto-accept-p
|
||||
(y-or-n-p
|
||||
(format "%s packages will be installed:\n\n%s\n\nProceed?"
|
||||
(length packages)
|
||||
(mapconcat
|
||||
(lambda (pkg)
|
||||
(format "+ %s (%s)"
|
||||
(car pkg)
|
||||
(cond ((doom-package-different-recipe-p (car pkg))
|
||||
"new recipe")
|
||||
((doom-package-different-backend-p (car pkg))
|
||||
(format "%s -> %s"
|
||||
(doom-package-backend (car pkg) 'noerror)
|
||||
(doom-package-recipe-backend (car pkg) 'noerror)))
|
||||
((plist-get (cdr pkg) :recipe)
|
||||
"quelpa")
|
||||
("elpa"))))
|
||||
(cl-sort (cl-copy-list packages) #'string-lessp
|
||||
:key #'car)
|
||||
"\n")))))
|
||||
(user-error "Aborted!"))
|
||||
|
||||
((let (success)
|
||||
(doom-refresh-packages-maybe doom-debug-mode)
|
||||
(dolist (pkg packages)
|
||||
(print! "Installing %s" (car pkg))
|
||||
(doom--condition-case!
|
||||
(let ((result
|
||||
(or (and (doom-package-installed-p (car pkg))
|
||||
(not (doom-package-different-backend-p (car pkg)))
|
||||
(not (doom-package-different-recipe-p (car pkg)))
|
||||
'already-installed)
|
||||
(and (doom-install-package (car pkg) (cdr pkg))
|
||||
(setq success t)
|
||||
'success)
|
||||
'failure))
|
||||
(pin-label
|
||||
(and (plist-member (cdr pkg) :pin)
|
||||
(format " [pinned: %s]" (plist-get (cdr pkg) :pin)))))
|
||||
(print! "%s%s"
|
||||
(pcase result
|
||||
(`already-installed (dark (white "⚠ ALREADY INSTALLED")))
|
||||
(`success (green "✓ DONE"))
|
||||
(`failure (red "✕ FAILED")))
|
||||
(or pin-label "")))))
|
||||
(print! (bold (green "Finished!")))
|
||||
(when success
|
||||
(set-file-times doom-packages-dir)
|
||||
(doom-delete-autoloads-file doom-package-autoload-file))
|
||||
success)))))
|
||||
(defun doom-packages-rebuild (&optional auto-accept-p all)
|
||||
"(Re)build all packages."
|
||||
(print! (start "(Re)building %spackages...") (if all "all " ""))
|
||||
(print-group!
|
||||
(let ((n 0))
|
||||
(if all
|
||||
(let ((straight--packages-to-rebuild :all)
|
||||
(straight--packages-not-to-rebuild (make-hash-table :test #'equal)))
|
||||
(dolist (package (hash-table-keys straight--recipe-cache))
|
||||
(straight-use-package
|
||||
(intern package) nil (lambda (_) (cl-incf n) nil) " ")))
|
||||
(let ((straight-check-for-modifications '(find-when-checking)))
|
||||
(straight-check-all)
|
||||
(dolist (recipe (hash-table-values straight--recipe-cache))
|
||||
(straight--with-plist recipe (package local-repo no-build)
|
||||
(unless (or no-build (null local-repo))
|
||||
;; REVIEW We do these modification checks manually because
|
||||
;; Straight's checks seem to miss stale elc files. Need
|
||||
;; more tests to confirm this.
|
||||
(when (or (gethash package straight--cached-package-modifications)
|
||||
(file-newer-than-file-p (straight--repos-dir local-repo)
|
||||
(straight--build-dir package))
|
||||
(cl-loop for file
|
||||
in (doom-files-in (straight--build-dir package)
|
||||
:match "\\.el$"
|
||||
:full t)
|
||||
for elc-file = (byte-compile-dest-file file)
|
||||
if (and (file-exists-p elc-file)
|
||||
(file-newer-than-file-p file elc-file))
|
||||
return t))
|
||||
(print! (info "Rebuilding %s") package)
|
||||
;; REVIEW `straight-rebuild-package' alone wasn't enough. Why?
|
||||
(delete-directory (straight--build-dir package) 'recursive)
|
||||
(straight-rebuild-package package)
|
||||
(cl-incf n)))))))
|
||||
(if (= n 0)
|
||||
(ignore (print! (success "No packages need rebuilding")))
|
||||
(print! (success "Rebuilt %d package(s)" n))
|
||||
t))))
|
||||
|
||||
|
||||
(defun doom-packages-update (&optional auto-accept-p)
|
||||
"Updates packages.
|
||||
|
||||
Unless AUTO-ACCEPT-P is non-nil, this function will prompt for confirmation with
|
||||
a list of packages that will be updated."
|
||||
(print! "Looking for outdated packages...")
|
||||
(let ((packages (cl-sort (cl-copy-list (doom-get-outdated-packages)) #'string-lessp
|
||||
:key #'car)))
|
||||
(cond ((not packages)
|
||||
(print! (green "Everything is up-to-date"))
|
||||
nil)
|
||||
(print! (start "Scanning for outdated packages (this may take a while)..."))
|
||||
(print-group!
|
||||
;; REVIEW Does this fail gracefully enough? Is it error tolerant?
|
||||
;; TODO Add version-lock checks; don't want to spend all this effort on
|
||||
;; packages that shouldn't be updated
|
||||
(condition-case e
|
||||
(let (futures)
|
||||
(dolist (group (seq-partition (hash-table-values straight--repo-cache) 8))
|
||||
(push (async-start
|
||||
`(lambda ()
|
||||
(setq load-path ',load-path
|
||||
doom-modules ',doom-modules)
|
||||
(load ,(concat doom-core-dir "core.el"))
|
||||
(let (packages)
|
||||
(when (require 'straight nil t)
|
||||
(dolist (recipe ',group)
|
||||
(straight--with-plist recipe (package local-repo)
|
||||
(when (and local-repo (straight--repository-is-available-p recipe))
|
||||
(straight-fetch-package package)
|
||||
;; REVIEW Isn't there a better way to get this information? Maybe with `vc'?
|
||||
(let* ((default-directory (straight--repos-dir local-repo))
|
||||
(n (string-to-number
|
||||
(shell-command-to-string "git rev-list --right-only --count HEAD..@'{u}'")))
|
||||
(pretime
|
||||
(string-to-number
|
||||
(shell-command-to-string "git log -1 --format=%at HEAD")))
|
||||
(time
|
||||
(string-to-number
|
||||
(shell-command-to-string "git log -1 --format=%at FETCH_HEAD"))))
|
||||
(when (> n 0)
|
||||
(push (list n pretime time recipe)
|
||||
packages)))))))
|
||||
(nreverse packages))))
|
||||
futures))
|
||||
(let ((total (length futures))
|
||||
(futures (nreverse futures))
|
||||
(specs '(t)))
|
||||
(while futures
|
||||
(while (not (async-ready (car futures)))
|
||||
(sleep-for 2)
|
||||
(print! "."))
|
||||
(nconc specs (async-get (pop futures))))
|
||||
(terpri)
|
||||
(if-let (specs (delq nil (cdr specs)))
|
||||
(if (or auto-accept-p
|
||||
(y-or-n-p
|
||||
(format! "%s\n\nThere %s %d package%s available to update. Update them?"
|
||||
(mapconcat
|
||||
(lambda (spec)
|
||||
(cl-destructuring-bind (n pretime time recipe) spec
|
||||
(straight--with-plist recipe (package)
|
||||
(format! "+ %-33s %s commit(s) behind %s -> %s"
|
||||
(yellow package) (yellow n)
|
||||
(format-time-string "%Y%m%d" pretime)
|
||||
(format-time-string "%Y%m%d" time)))))
|
||||
specs
|
||||
"\n")
|
||||
(if (cdr specs) "are" "is")
|
||||
(length specs)
|
||||
(if (cdr specs) "s" ""))))
|
||||
(terpri)
|
||||
(dolist (spec specs t)
|
||||
(cl-destructuring-bind (n pretime time recipe) spec
|
||||
(straight--with-plist recipe (local-repo package)
|
||||
(let ((default-directory (straight--repos-dir local-repo)))
|
||||
(print! (start "Updating %S") package)
|
||||
;; HACK `straight' doesn't assume it would ever be used
|
||||
;; non-interactively, but here we are. If the repo is
|
||||
;; dirty, the command will lock up, waiting for
|
||||
;; interaction that will never come, so discard all local
|
||||
;; changes. Doom doesn't want you modifying those anyway.
|
||||
(and (straight--get-call "git" "reset" "--hard")
|
||||
(straight--get-call "git" "clean" "-ffd"))
|
||||
(straight-merge-package package)
|
||||
;; HACK `straight-rebuild-package' doesn't pick up that
|
||||
;; this package has changed, so we do it manually. Is
|
||||
;; there a better way?
|
||||
(run-hook-with-args 'straight-use-package-pre-build-functions package)
|
||||
(straight--build-package recipe " "))
|
||||
(with-current-buffer (straight--process-get-buffer)
|
||||
(with-silent-modifications
|
||||
(erase-buffer))))))
|
||||
(print! (info "Aborted update"))
|
||||
nil)
|
||||
(print! (success "No packages to update"))
|
||||
nil)))
|
||||
(error
|
||||
(message "Output:\n%s" (straight--process-get-output))
|
||||
(signal (car e) (error-message-string e))))))
|
||||
|
||||
((not (or auto-accept-p
|
||||
(y-or-n-p
|
||||
(format "%s packages will be updated:\n\n%s\n\nProceed?"
|
||||
(length packages)
|
||||
(let ((max-len
|
||||
(or (car (sort (mapcar (lambda (it) (length (symbol-name (car it)))) packages)
|
||||
#'>))
|
||||
10)))
|
||||
(mapconcat
|
||||
(lambda (pkg)
|
||||
(format (format "+ %%-%ds (%%s) %%-%ds -> %%s"
|
||||
(+ max-len 2) 14)
|
||||
(symbol-name (car pkg))
|
||||
(doom-package-backend (car pkg))
|
||||
(package-version-join (cadr pkg))
|
||||
(package-version-join (cl-caddr pkg))))
|
||||
packages
|
||||
"\n"))))))
|
||||
(user-error "Aborted!"))
|
||||
|
||||
((let (success)
|
||||
(dolist (pkg packages)
|
||||
(print! "Updating %s" (car pkg))
|
||||
(doom--condition-case!
|
||||
(print!
|
||||
(let ((result (doom-update-package (car pkg) t)))
|
||||
(when result (setq success t))
|
||||
(color (if result 'green 'red)
|
||||
(if result "✓ DONE" "✕ FAILED"))))))
|
||||
(print! (bold (green "Finished!")))
|
||||
(when success
|
||||
(set-file-times doom-packages-dir)
|
||||
(doom-delete-autoloads-file doom-package-autoload-file))
|
||||
success)))))
|
||||
(defun doom--packages-to-purge ()
|
||||
(let (builds repos)
|
||||
(dolist (name (straight--directory-files (straight--repos-dir)))
|
||||
(unless (straight--checkhash name straight--repo-cache)
|
||||
(push name repos)))
|
||||
(dolist (name (straight--directory-files (straight--build-dir)))
|
||||
(unless (gethash name straight--profile-cache)
|
||||
(push name builds)))
|
||||
(straight-prune-build-cache)
|
||||
(list builds repos)))
|
||||
|
||||
(defun doom-packages-autoremove (&optional auto-accept-p)
|
||||
"Auto-removes orphaned packages.
|
||||
(defun doom-packages-purge (&optional auto-accept-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.
|
||||
|
||||
Unless AUTO-ACCEPT-P is non-nil, this function will prompt for confirmation with
|
||||
a list of packages that will be removed."
|
||||
(print! "Looking for orphaned packages...")
|
||||
(let ((packages (doom-get-orphaned-packages)))
|
||||
(cond ((not packages)
|
||||
(print! (green "No unused packages to remove"))
|
||||
nil)
|
||||
|
||||
((not
|
||||
(or auto-accept-p
|
||||
(y-or-n-p
|
||||
(format "%s packages will be deleted:\n\n%s\n\nProceed?"
|
||||
(length packages)
|
||||
(mapconcat
|
||||
(lambda (sym)
|
||||
(let ((old-backend (doom-package-backend sym 'noerror))
|
||||
(new-backend (doom-package-recipe-backend sym 'noerror)))
|
||||
(format "+ %s (%s)" sym
|
||||
(cond ((null new-backend)
|
||||
"removed")
|
||||
((eq old-backend new-backend)
|
||||
(symbol-name new-backend))
|
||||
((format "%s -> %s" old-backend new-backend))))))
|
||||
(sort (cl-copy-list packages) #'string-lessp)
|
||||
"\n")))))
|
||||
(user-error "Aborted!"))
|
||||
|
||||
((let (success)
|
||||
(dolist (pkg packages)
|
||||
(doom--condition-case!
|
||||
(let ((result (doom-delete-package pkg t)))
|
||||
(if result (setq success t))
|
||||
(print! (color (if result 'green 'red) "%s %s")
|
||||
(if result "✓ Removed" "✕ Failed to remove")
|
||||
pkg))))
|
||||
(print! (bold (green "Finished!")))
|
||||
(when success
|
||||
(set-file-times doom-packages-dir)
|
||||
(doom-delete-autoloads-file doom-package-autoload-file))
|
||||
success)))))
|
||||
(print! (start "Searching for orphaned packages..."))
|
||||
(cl-destructuring-bind (builds repos) (doom--packages-to-purge)
|
||||
(unless (bound-and-true-p package--initialized)
|
||||
(package-initialize))
|
||||
(print-group!
|
||||
(let ((packages (append builds (mapcar #'car package-alist) nil)))
|
||||
(if (not packages)
|
||||
(ignore (print! (success "No orphaned packages to purge")))
|
||||
(or auto-accept-p
|
||||
(y-or-n-p
|
||||
(format! "\n%s\n\n%d packages are orphaned. Purge them (for the Emperor)?"
|
||||
(mapconcat (lambda (pkgs)
|
||||
(mapconcat (lambda (p) (format " + %-20.20s" p))
|
||||
pkgs
|
||||
""))
|
||||
(seq-partition (cl-sort (copy-sequence packages) #'string-lessp)
|
||||
3)
|
||||
"\n")
|
||||
(length packages)))
|
||||
(user-error "Aborted"))
|
||||
(let ((n 0))
|
||||
(dolist (dir (append (mapcar #'straight--repos-dir repos)
|
||||
(mapcar #'straight--build-dir builds)))
|
||||
(print! (info "Deleting %S") (relpath dir (straight--dir)))
|
||||
(delete-directory dir 'recursive)
|
||||
(unless (file-directory-p dir)
|
||||
(cl-incf n)))
|
||||
(straight-prune-build-cache)
|
||||
(when (file-directory-p package-user-dir)
|
||||
(delete-directory package-user-dir t)
|
||||
t)
|
||||
(> n 0)))))))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue