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

@@ -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)
+                    (mapcar
-                             if (cl-find :private (plist-get plist :modules)
+                     #'cdr (doom--collect-forms-in
-                                         :key #'car)
+                            (doom-path doom-private-dir "packages.el")
-                             collect
+                            "package!"))
-                             (if-let (splist (doom-plist-delete (copy-sequence plist)
-                                                                :modules))
-                                 (prin1-to-string (cons name splist))
-                               name))
                   (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"))))))))
 
 
 ;;

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."

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!
+  (let ((pinned (doom-package-pinned-list)))
-   (if-let (built
+    (print-group!
-            (doom-with-package-recipes (doom-package-recipe-list)
+     (if-let (built
-                (recipe package type local-repo)
+              (doom-with-package-recipes (doom-package-recipe-list)
-              (condition-case-unless-debug e
+                  (recipe package type local-repo)
-                  (progn
+                (condition-case-unless-debug e
                     (straight-use-package (intern package))
-                    (when-let* ((target-ref (cdr (assoc local-repo doom-pinned-packages)))
+                  (error
-                                (ref (straight-vc-get-commit type local-repo)))
+                   (signal 'doom-package-error
-                      (unless (doom--same-commit-p target-ref ref)
+                           (list package e (straight--process-get-output)))))))
-                        (unless (straight-vc-commit-present-p recipe target-ref)
+         (print! (success "Installed %d packages")
-                          (straight-vc-fetch-from-remote recipe))
+                 (length built))
-                        (if (straight-vc-commit-present-p recipe target-ref)
+       (print! (info "No packages need to be installed"))
-                            (progn
+       nil))))
-                              (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)))
 
 
 (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))

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.")))))
+                                          "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)))))))))
 
 (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."
+Or any combination of the above.
-  `(let ((targets ',targets))
+
-     (put 'doom-pinned-packages 'modified
+This macro should only be used from the user's private packages.el. No module
-          (delete-dups (append targets (get 'doom-pinned-packages 'modified))))
+should use it!"
-     (dolist (target targets)
+  (if (memq t targets)
-       (cond
+      `(mapc (doom-rpartial #'doom-package-set :unpin t)
-        ((eq target t)
+             (mapcar #'car doom-packages))
-         (setq doom-pinned-packages nil))
+    (let (forms)
-        ((or (keywordp target)
+      (dolist (target targets)
-             (listp target))
+        (cl-check-type target (or symbol keyword list))
-         (cl-destructuring-bind (category . modules) (doom-enlist target)
+        (cond
-           (dolist (pkg doom-packages)
+         ((symbolp target)
-             (let ((pkg-modules (plist-get (cdr pkg) :modules)))
+          (push `(doom-package-set ',target :unpin t) forms))
-               (and (assq category pkg-modules)
+         ((or (keywordp target)
-                    (or (null modules)
+              (listp target))
-                        (cl-loop for module in modules
+          (cl-destructuring-bind (category . modules) (doom-enlist target)
-                                 if (member (cons category module) pkg-modules)
+            (dolist (pkg doom-packages)
-                                 return t))
+              (let ((pkg-modules (plist-get (cdr pkg) :modules)))
-                    (assq-delete-all (car pkg) doom-pinned-packages))))))
+                (and (assq category pkg-modules)
-        ((symbolp target)
+                     (or (null modules)
-         (assq-delete-all target doom-pinned-packages))))))
+                         (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