cli/packages: refactor doom-packages-purge
Sets it up for a later update where purging repos will no longer be the default behavior.
This commit is contained in:
parent
905ba1d23c
commit
829ad8c8b7
|
@ -32,13 +32,11 @@ their elisp files are byte-compiled."
|
||||||
(doom--ensure-autoloads-while
|
(doom--ensure-autoloads-while
|
||||||
(doom-packages-rebuild doom-auto-accept (member "all" args))))
|
(doom-packages-rebuild doom-auto-accept (member "all" args))))
|
||||||
|
|
||||||
(def-command! (purge p) ()
|
(def-command! (purge p) (&rest args)
|
||||||
"Deletes any unused packages and package repos.
|
"Deletes any unused packages and repos."
|
||||||
|
|
||||||
You should run this once in a while, as repos tend to build up over time."
|
|
||||||
(doom--ensure-autoloads-while
|
(doom--ensure-autoloads-while
|
||||||
(straight-check-all)
|
(straight-check-all)
|
||||||
(doom-packages-purge doom-auto-accept)))
|
(doom-packages-purge 'elpa-p 'build-p 'repos-p doom-auto-accept)))
|
||||||
|
|
||||||
;; (def-command! rollback () ; TODO rollback
|
;; (def-command! rollback () ; TODO rollback
|
||||||
;; "<Not implemented yet>"
|
;; "<Not implemented yet>"
|
||||||
|
@ -247,43 +245,76 @@ a list of packages that will be updated."
|
||||||
(straight-prune-build-cache)
|
(straight-prune-build-cache)
|
||||||
(list builds repos)))
|
(list builds repos)))
|
||||||
|
|
||||||
(defun doom-packages-purge (&optional auto-accept-p)
|
(defmacro doom--packages-purge (packages label auto-accept-p &rest files)
|
||||||
|
(declare (indent defun))
|
||||||
|
`(let ((packages ,packages)
|
||||||
|
(label ,label))
|
||||||
|
(if (not packages)
|
||||||
|
(ignore (print! (success "No orphaned %s(s) to purge" label)))
|
||||||
|
(if (not (or ,auto-accept-p
|
||||||
|
(y-or-n-p
|
||||||
|
(format! "\n%s\n\n%d %s(s) 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)
|
||||||
|
label))))
|
||||||
|
(ignore (print! (warn "Aborted")))
|
||||||
|
(let ((n 0))
|
||||||
|
(print! (start "Pruning %ss..." label))
|
||||||
|
(print-group!
|
||||||
|
(dolist (it packages)
|
||||||
|
(print! (info "Deleting %s/%s") label it)
|
||||||
|
(dolist (path (list ,@files))
|
||||||
|
(if (file-directory-p path)
|
||||||
|
(delete-directory path 'recursive)
|
||||||
|
(if (file-exists-p path)
|
||||||
|
(delete-file path)
|
||||||
|
(print! (error "Failed to find %s/%s") label it)))
|
||||||
|
(unless (file-exists-p path)
|
||||||
|
(cl-incf n))))
|
||||||
|
(if (= n 0)
|
||||||
|
(ignore (print! (warn "Didn't prune any %s(s) for some reason" label)))
|
||||||
|
(print! (success "Pruned %d %s(s)" n label))
|
||||||
|
t)))))))
|
||||||
|
|
||||||
|
(defun doom-packages-purge (&optional elpa-p builds-p repos-p auto-accept-p)
|
||||||
"Auto-removes orphaned packages and repos.
|
"Auto-removes orphaned packages and repos.
|
||||||
|
|
||||||
An orphaned package is a package that isn't a primary package (i.e. doesn't have
|
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.
|
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).
|
||||||
|
|
||||||
Unless AUTO-ACCEPT-P is non-nil, this function will prompt for confirmation with
|
Unless AUTO-ACCEPT-P is non-nil, this function will prompt for confirmation with
|
||||||
a list of packages that will be removed."
|
a list of packages that will be removed."
|
||||||
(print! (start "Searching for orphaned packages..."))
|
(print! (start "Searching for orphaned packages..."))
|
||||||
(cl-destructuring-bind (builds repos) (doom--packages-to-purge)
|
(cl-destructuring-bind (builds repos)
|
||||||
(unless (bound-and-true-p package--initialized)
|
(doom--packages-to-purge)
|
||||||
(package-initialize))
|
|
||||||
(print-group!
|
(print-group!
|
||||||
(let ((packages (append builds (mapcar #'car package-alist) nil)))
|
(if builds-p
|
||||||
(if (not packages)
|
(and (doom--packages-purge builds "build" auto-accept-p
|
||||||
(ignore (print! (success "No orphaned packages to purge")))
|
(straight--build-dir it)
|
||||||
(or auto-accept-p
|
(straight--modified-file it))
|
||||||
(y-or-n-p
|
(straight-prune-build-cache))
|
||||||
(format! "\n%s\n\n%d packages are orphaned. Purge them (for the Emperor)?"
|
(print! (info "Skipping builds")))
|
||||||
(mapconcat (lambda (pkgs)
|
(if repos-p
|
||||||
(mapconcat (lambda (p) (format " + %-20.20s" p))
|
(doom--packages-purge repos "repo" auto-accept-p
|
||||||
pkgs
|
(straight--repos-dir it))
|
||||||
""))
|
(print! (info "Skipping repos")))
|
||||||
(seq-partition (cl-sort (copy-sequence packages) #'string-lessp)
|
(if (not elpa-p)
|
||||||
3)
|
(print! (info "Skipping elpa packages"))
|
||||||
"\n")
|
(unless (bound-and-true-p package--initialized)
|
||||||
(length packages)))
|
(package-initialize))
|
||||||
(user-error "Aborted"))
|
(doom--packages-purge (mapcar #'symbol-name (mapcar #'car package-alist))
|
||||||
(let ((n 0))
|
"package" auto-accept-p
|
||||||
(dolist (dir (append (mapcar #'straight--repos-dir repos)
|
(package-desc-dir (cadr (assq (intern it) package-alist))))
|
||||||
(mapcar #'straight--build-dir builds)))
|
(when (file-directory-p package-user-dir)
|
||||||
(print! (info "Deleting %S") (relpath dir (straight--dir)))
|
(delete-directory package-user-dir t)))
|
||||||
(delete-directory dir 'recursive)
|
t)))
|
||||||
(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…
Reference in New Issue
Block a user