Refactor package pinning
- Make doom/info package details more concise - Removed doom-pinned-packages variable (pin info now stored in doom-packages metadata) - Fix unpin! not actually unpinning some packages
This commit is contained in:
Henrik Lissner
parent
c5d6e6267c
commit
097972bd9d
|
|
@ -23,11 +23,25 @@
|
|||
(when (file-exists-p file)
|
||||
(insert-file-contents file))))
|
||||
|
||||
(defun doom--collect-forms-in (file form)
|
||||
(when (file-readable-p file)
|
||||
(let (forms)
|
||||
(with-temp-buffer
|
||||
(insert-file-contents file)
|
||||
(delay-mode-hooks (emacs-lisp-mode))
|
||||
(while (re-search-forward (format "(%s " (regexp-quote form)) nil t)
|
||||
(unless (doom-point-in-string-or-comment-p)
|
||||
(save-excursion
|
||||
(goto-char (match-beginning 0))
|
||||
(push (sexp-at-point) forms))))
|
||||
(nreverse forms)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-info ()
|
||||
"Returns diagnostic information about the current Emacs session in markdown,
|
||||
ready to be pasted in a bug report on github."
|
||||
(require 'vc-git)
|
||||
(require 'core-packages)
|
||||
(let ((default-directory doom-emacs-dir)
|
||||
(doom-modules (doom-modules)))
|
||||
(cl-letf
|
||||
|
|
@ -80,14 +94,10 @@ ready to be pasted in a bug report on github."
|
|||
'("n/a")))
|
||||
(packages
|
||||
,@(or (condition-case e
|
||||
(cl-loop for (name . plist) in (doom-package-list)
|
||||
if (cl-find :private (plist-get plist :modules)
|
||||
:key #'car)
|
||||
collect
|
||||
(if-let (splist (doom-plist-delete (copy-sequence plist)
|
||||
:modules))
|
||||
(prin1-to-string (cons name splist))
|
||||
name))
|
||||
(mapcar
|
||||
#'cdr (doom--collect-forms-in
|
||||
(doom-path doom-private-dir "packages.el")
|
||||
"package!"))
|
||||
(error (format "<%S>" e)))
|
||||
'("n/a")))
|
||||
(elpa
|
||||
|
|
@ -98,7 +108,14 @@ ready to be pasted in a bug report on github."
|
|||
collect (format "%s" name)))
|
||||
(error (format "<%S>" e)))
|
||||
'("n/a")))
|
||||
(unpin ,@(or (get 'doom-pinned-packages 'modified) '("n/a"))))))))
|
||||
(unpin ,@(or (condition-case e
|
||||
(mapcan #'identity
|
||||
(mapcar
|
||||
#'cdr (doom--collect-forms-in
|
||||
(doom-path doom-private-dir "packages.el")
|
||||
"unpin!")))
|
||||
(error (format "<%S>" e)))
|
||||
'("n/a"))))))))
|
||||
|
||||
|
||||
;;
|
||||
|
|
|
|||
|
|
@ -13,6 +13,13 @@
|
|||
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."
|
||||
|
|
@ -23,6 +30,14 @@
|
|||
nil-value)
|
||||
plist)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-package-recipe-repo (package)
|
||||
"Resolve and return PACKAGE's (symbol) local-repo property."
|
||||
(if-let* ((recipe (cdr (straight-recipes-retrieve package)))
|
||||
(repo (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."
|
||||
|
|
@ -190,6 +205,33 @@ ones."
|
|||
(doom--read-module-packages-file private-packages all-p t))
|
||||
(nreverse doom-packages)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-package-pinned-list ()
|
||||
"Return an alist mapping package names (strings) to pinned commits (strings)."
|
||||
(let (alist)
|
||||
(dolist (package doom-packages alist)
|
||||
(with-plist! (cdr package) (recipe modules disable ignore pin unpin)
|
||||
(when (and (not ignore)
|
||||
(not disable)
|
||||
(or pin unpin))
|
||||
(setf (alist-get (doom-package-recipe-repo (car package)) alist
|
||||
nil 'remove #'equal)
|
||||
(unless unpin pin)))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-package-unpinned-list ()
|
||||
"Return an alist mapping package names (strings) to pinned commits (strings)."
|
||||
(let (alist)
|
||||
(dolist (package doom-packages alist)
|
||||
(with-plist! (cdr package) (recipe modules disable ignore pin unpin)
|
||||
(when (and (not ignore)
|
||||
(not disable)
|
||||
(or unpin
|
||||
(and (plist-member recipe :pin)
|
||||
(null pin))))
|
||||
(cl-pushnew (doom-package-recipe-repo (car package)) alist
|
||||
:test #'equal))))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-package-recipe-list ()
|
||||
"Return straight recipes for non-builtin packages with a local-repo."
|
||||
|
|
|
|||
|
|
@ -81,34 +81,20 @@ This function will install any primary package (i.e. a package with a `package!'
|
|||
declaration) or dependency thereof that hasn't already been."
|
||||
(straight--transaction-finalize)
|
||||
(print! (start "Installing packages..."))
|
||||
(print-group!
|
||||
(if-let (built
|
||||
(doom-with-package-recipes (doom-package-recipe-list)
|
||||
(recipe package type local-repo)
|
||||
(condition-case-unless-debug e
|
||||
(progn
|
||||
(let ((pinned (doom-package-pinned-list)))
|
||||
(print-group!
|
||||
(if-let (built
|
||||
(doom-with-package-recipes (doom-package-recipe-list)
|
||||
(recipe package type local-repo)
|
||||
(condition-case-unless-debug e
|
||||
(straight-use-package (intern package))
|
||||
(when-let* ((target-ref (cdr (assoc local-repo doom-pinned-packages)))
|
||||
(ref (straight-vc-get-commit type local-repo)))
|
||||
(unless (doom--same-commit-p target-ref ref)
|
||||
(unless (straight-vc-commit-present-p recipe target-ref)
|
||||
(straight-vc-fetch-from-remote recipe))
|
||||
(if (straight-vc-commit-present-p recipe target-ref)
|
||||
(progn
|
||||
(print! (success "Checking out %s to %s")
|
||||
package (doom--abbrev-commit target-ref))
|
||||
(straight-vc-check-out-commit recipe target-ref)
|
||||
(straight-rebuild-package package t))
|
||||
(ignore-errors
|
||||
(delete-directory (straight--repos-dir local-repo) 'recursive))
|
||||
(straight-use-package (intern package))))))
|
||||
(error
|
||||
(signal 'doom-package-error
|
||||
(list package e (straight--process-get-output)))))))
|
||||
(print! (success "Installed %d packages")
|
||||
(length built))
|
||||
(print! (info "No packages need to be installed"))
|
||||
nil)))
|
||||
(error
|
||||
(signal 'doom-package-error
|
||||
(list package e (straight--process-get-output)))))))
|
||||
(print! (success "Installed %d packages")
|
||||
(length built))
|
||||
(print! (info "No packages need to be installed"))
|
||||
nil))))
|
||||
|
||||
|
||||
(defun doom-cli-packages-build (&optional force-p)
|
||||
|
|
@ -127,11 +113,27 @@ declaration) or dependency thereof that hasn't already been."
|
|||
(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))))
|
||||
(make-hash-table :test #'equal)))
|
||||
(recipes (doom-package-recipe-list)))
|
||||
(unless force-p
|
||||
(straight--make-build-cache-available)
|
||||
(straight--make-package-modifications-available))
|
||||
(if-let (built
|
||||
(doom-with-package-recipes (doom-package-recipe-list) (package)
|
||||
(doom-with-package-recipes recipes (package local-repo)
|
||||
;; Ensure packages with outdated files/bytecode are rebuilt
|
||||
(let ((build-dir (straight--build-dir package))
|
||||
(repo-dir (straight--repos-dir local-repo)))
|
||||
(and (or (file-newer-than-file-p repo-dir build-dir)
|
||||
;; Doesn't make sense to compare el and elc files
|
||||
;; when the former isn't a symlink to their source.
|
||||
(when straight-use-symlinks
|
||||
(cl-loop for file
|
||||
in (doom-files-in build-dir :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)))
|
||||
(puthash package t straight--packages-to-rebuild)))
|
||||
(straight-use-package (intern package))))
|
||||
(print! (success "Rebuilt %d package(s)") (length built))
|
||||
(print! (success "No packages need rebuilding"))
|
||||
|
|
@ -143,6 +145,7 @@ declaration) or dependency thereof that hasn't already been."
|
|||
(straight--transaction-finalize)
|
||||
(print! (start "Updating packages (this may take a while)..."))
|
||||
(let* ((repo-dir (straight--repos-dir))
|
||||
(pinned (doom-package-pinned-list))
|
||||
(packages-to-rebuild (make-hash-table :test 'equal))
|
||||
(repos-to-rebuild (make-hash-table :test 'equal))
|
||||
(recipes (doom-package-recipe-list))
|
||||
|
|
@ -166,7 +169,7 @@ declaration) or dependency thereof that hasn't already been."
|
|||
(cl-return))
|
||||
(condition-case-unless-debug e
|
||||
(let ((ref (straight-vc-get-commit type local-repo))
|
||||
(target-ref (cdr (assoc local-repo doom-pinned-packages)))
|
||||
(target-ref (cdr (assoc local-repo pinned)))
|
||||
output)
|
||||
(or (cond
|
||||
((not (stringp target-ref))
|
||||
|
|
|
|||
|
|
@ -43,14 +43,6 @@
|
|||
package's name as a symbol, and whose CDR is the plist supplied to its
|
||||
`package!' declaration. Set by `doom-initialize-packages'.")
|
||||
|
||||
(defvar doom-pinned-packages nil
|
||||
"An alist mapping package names to commit hashes; both strings.
|
||||
|
||||
We avoid straight's lockfiles because we want to pin packages straight from
|
||||
their `package!' declarations, which is simpler than lockfiles, where version
|
||||
management would be done in a whole new file that users shouldn't have to deal
|
||||
with.")
|
||||
|
||||
(defvar doom-core-packages '(straight use-package)
|
||||
"A list of packages that must be installed (and will be auto-installed if
|
||||
missing) and shouldn't be deleted.")
|
||||
|
|
@ -127,7 +119,8 @@ missing) and shouldn't be deleted.")
|
|||
(defadvice! doom--read-pinned-packages-a (orig-fn &rest args)
|
||||
"Read from `doom-pinned-packages' on top of straight's lockfiles."
|
||||
:around #'straight--lockfile-read-all
|
||||
(append (apply orig-fn args) doom-pinned-packages))
|
||||
(append (apply orig-fn args)
|
||||
(doom-package-pinned-list)))
|
||||
|
||||
|
||||
;;
|
||||
|
|
@ -173,17 +166,7 @@ necessary package metadata is initialized and available for them."
|
|||
(print! (warn "%s\n%s")
|
||||
(format "You've disabled %S" name)
|
||||
(indent 2 (concat "This is a core package. Disabling it will cause errors, as Doom assumes\n"
|
||||
"core packages are always available. Disable their minor-modes or hooks instead.")))))
|
||||
(when pin
|
||||
(let ((realname
|
||||
(if-let* ((recipe (cdr (straight-recipes-retrieve name)))
|
||||
(repo (straight-vc-local-repo-name recipe)))
|
||||
repo
|
||||
(symbol-name name))))
|
||||
(doom-log "Pinning package %S to %S" realname pin)
|
||||
(setf (alist-get realname doom-pinned-packages
|
||||
nil nil #'equal)
|
||||
pin)))))))))
|
||||
"core packages are always available. Disable their minor-modes or hooks instead.")))))))))))
|
||||
|
||||
(defun doom-ensure-straight ()
|
||||
"Ensure `straight' is installed and was compiled with this version of Emacs."
|
||||
|
|
@ -318,27 +301,31 @@ can be used one of five ways:
|
|||
+ To unpin packages in individual modules:
|
||||
(unpin! (:lang python javascript) (:tools docker))
|
||||
|
||||
Or any combination of the above."
|
||||
`(let ((targets ',targets))
|
||||
(put 'doom-pinned-packages 'modified
|
||||
(delete-dups (append targets (get 'doom-pinned-packages 'modified))))
|
||||
(dolist (target targets)
|
||||
(cond
|
||||
((eq target t)
|
||||
(setq doom-pinned-packages nil))
|
||||
((or (keywordp target)
|
||||
(listp target))
|
||||
(cl-destructuring-bind (category . modules) (doom-enlist target)
|
||||
(dolist (pkg doom-packages)
|
||||
(let ((pkg-modules (plist-get (cdr pkg) :modules)))
|
||||
(and (assq category pkg-modules)
|
||||
(or (null modules)
|
||||
(cl-loop for module in modules
|
||||
if (member (cons category module) pkg-modules)
|
||||
return t))
|
||||
(assq-delete-all (car pkg) doom-pinned-packages))))))
|
||||
((symbolp target)
|
||||
(assq-delete-all target doom-pinned-packages))))))
|
||||
Or any combination of the above.
|
||||
|
||||
This macro should only be used from the user's private packages.el. No module
|
||||
should use it!"
|
||||
(if (memq t targets)
|
||||
`(mapc (doom-rpartial #'doom-package-set :unpin t)
|
||||
(mapcar #'car doom-packages))
|
||||
(let (forms)
|
||||
(dolist (target targets)
|
||||
(cl-check-type target (or symbol keyword list))
|
||||
(cond
|
||||
((symbolp target)
|
||||
(push `(doom-package-set ',target :unpin t) forms))
|
||||
((or (keywordp target)
|
||||
(listp target))
|
||||
(cl-destructuring-bind (category . modules) (doom-enlist target)
|
||||
(dolist (pkg doom-packages)
|
||||
(let ((pkg-modules (plist-get (cdr pkg) :modules)))
|
||||
(and (assq category pkg-modules)
|
||||
(or (null modules)
|
||||
(cl-loop for module in modules
|
||||
if (member (cons category module) pkg-modules)
|
||||
return t))
|
||||
(push `(doom-package-set ',(car pkg) :unpin t) forms))))))))
|
||||
(macroexp-progn forms))))
|
||||
|
||||
(provide 'core-packages)
|
||||
;;; core-packages.el ends here
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user