From 097972bd9d19d31ceaf280efc155461ff38570d9 Mon Sep 17 00:00:00 2001 From: Henrik Lissner Date: Tue, 28 Jan 2020 17:54:51 -0500 Subject: [PATCH] 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 --- core/autoload/debug.el | 35 +++++++++++++++----- core/autoload/packages.el | 42 ++++++++++++++++++++++++ core/cli/packages.el | 63 ++++++++++++++++++----------------- core/core-packages.el | 69 ++++++++++++++++----------------------- 4 files changed, 129 insertions(+), 80 deletions(-) diff --git a/core/autoload/debug.el b/core/autoload/debug.el index e7206ac8f..d54256035 100644 --- a/core/autoload/debug.el +++ b/core/autoload/debug.el @@ -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")))))))) ;; diff --git a/core/autoload/packages.el b/core/autoload/packages.el index 7981d3382..68e2f8f6e 100644 --- a/core/autoload/packages.el +++ b/core/autoload/packages.el @@ -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." diff --git a/core/cli/packages.el b/core/cli/packages.el index 9ea99c9a2..24f87598f 100644 --- a/core/cli/packages.el +++ b/core/cli/packages.el @@ -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)) diff --git a/core/core-packages.el b/core/core-packages.el index cb0c5362e..24690a1c0 100644 --- a/core/core-packages.el +++ b/core/core-packages.el @@ -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