emenel/doomemacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Rewrite 'doom purge'; add repo regrafting

Browse source 
'doom purge -r' now re-grafts shallow cloned packages (compacting them
as much as possible).
This commit is contained in:
Henrik Lissner 2019-07-29 21:04:58 +02:00
parent 99c73cea0b
commit 7559949e09
No known key found for this signature in database
GPG key ID: 5F6C0EA160557395
1 changed files with 125 additions and 69 deletions
Download patch file Download diff file Expand all files Collapse all files

194
core/cli/packages.el
View file

@ -296,54 +296,112 @@ a list of packages that will be updated."
(signal (car e) (error-message-string e))))))) (signal (car e) (error-message-string e)))))))
(defun doom--packages-to-purge () ;;; PURGE (for the emperor)
(let (builds repos) (defun doom--prompt-p (list-fn list preamble postamble)
(dolist (name (straight--directory-files (straight--repos-dir))) (or (y-or-n-p (format "%s%s\n\n%s"
(unless (straight--checkhash name straight--repo-cache) (if preamble (concat preamble "\n\n") "")
(push name repos))) (mapconcat list-fn list "\n")
(dolist (name (straight--directory-files (straight--build-dir))) (or postamble "")))
(unless (gethash name straight--profile-cache) (user-error! "Aborted")))
(push name builds)))
(straight-prune-build-cache)
(list builds repos)))
(defmacro doom--packages-purge (packages label auto-accept-p &rest files) (defun doom--prompt-columns-p (row-fn list preamble postamble)
(declare (indent defun)) (doom--prompt-p (lambda (row)
`(let ((packages ,packages) (mapconcat row-fn row ""))
(label ,label)) (seq-partition (cl-sort (copy-sequence list) #'string-lessp)
(if (not packages) 3)
(ignore (print! (success "No orphaned %s(s) to purge" label))) preamble
(if (not (or ,auto-accept-p postamble))
(y-or-n-p
(format! "\n%s\n\n%d %s(s) are orphaned. Purge them (for the Emperor)?" (defun doom--packages-purge-build (build)
(mapconcat (lambda (pkgs) (let ((build-dir (straight--build-dir build)))
(mapconcat (lambda (p) (format " + %-20.20s" p)) (print! (start "Purging build/%s..." build))
pkgs (delete-directory build-dir)
"")) (if (file-directory-p build-dir)
(seq-partition (cl-sort (copy-sequence packages) #'string-lessp) (ignore (print! (error "Failed to purg build/%s" build)))
3) (print! (success "Purged build/%s" build))
"\n") t)))
(length packages)
label)))) (defun doom--packages-purge-builds (builds &optional auto-accept-p)
(ignore (print! (warn "Aborted"))) (if (not builds)
(let ((n 0)) (progn (print! (info "No builds to purge"))
(print! (start "Pruning %ss..." label)) 0)
(print-group! (or auto-accept-p
(dolist (it packages) (doom--prompt-columns-p
(print! (info "Deleting %s/%s") label it) (lambda (p) (format " + %-20.20s" p)) builds nil
(dolist (path (list ,@files)) (format! "Found %d orphaned package builds. Purge them?"
(cond ((file-directory-p path) (length builds))))
(delete-directory path 'recursive)) (length
((file-regular-p path) (delq nil (mapcar #'doom--packages-purge-build builds)))))
(delete-file path)))
(if (file-exists-p path) (defun doom--packages-regraft-repo (repo)
(print! (error "Failed to find %s/%s") label it) (let ((default-directory (straight--repos-dir repo)))
(cl-incf n)))) (if (not (file-directory-p ".git"))
(if (= n 0) (ignore (print! (warn "repos/%s is not a git repo, skipping" repo)))
(ignore (print! (warn "Didn't prune any %s(s) for some reason" label))) (straight--call "git" "reset" "--hard")
(print! (success "Pruned %d %s(s)" n label)) (straight--call "git" "clean" "--ffd")
(doom--finalize-straight) (straight--call "git" "replace" "--graft" "HEAD")
t))))))) (straight--call "git" "gc")
(print! (debug "%s" (straight--process-get-output)))
(print! (success "Regrafted repos/%s" repo))
t)))
(defun doom--packages-regraft-repos (repos &optional auto-accept-p)
(if (not repos)
(progn (print! (info "No repos to regraft"))
0)
(or auto-accept-p
(y-or-n-p (format! "Preparing to regraft all %d repos. Continue?"
(length repos)))
(user-error! "Aborted!"))
(if (executable-find "du")
(cl-destructuring-bind (status . size)
(doom-sh "du" "-sh" (straight--repos-dir))
(prog1 (delq nil (mapcar #'doom--packages-regraft-repo repos))
(cl-destructuring-bind (status . newsize)
(doom-sh "du" "-sh" (straight--repos-dir))
(print! (success "Finshed regrafted. Size before: %s and after: %s"
(car (split-string size "\t"))
(car (split-string newsize "\t")))))))
(delq nil (mapcar #'doom--packages-regraft-repo repos)))))
(defun doom--packages-purge-repo (repo)
(print! (start "Purging repos/%s..." repo))
(let ((repo-dir (straight--repos-dir repo)))
(delete-directory repo-dir 'recursive)
(ignore-errors
(delete-file (straight--modified-file repo)))
(if (file-directory-p repo-dir)
(ignore (print! (error "Failed to purge repos/%s" repo)))
(print! (success "Purged repos/%s" repo))
t)))
(defun doom--packages-purge-repos (repos &optional auto-accept-p)
(if (not repos)
(progn (print! (info "No repos to purge"))
0)
(or auto-accept-p
(doom--prompt-columns-p
(lambda (p) (format " + %-20.20s" p)) repos nil
(format! "Found %d orphaned repos. Purge them?"
(length repos))))
(length
(delq nil (mapcar #'doom--packages-purge-repo repos)))))
(defun doom--packages-purge-elpa (&optional auto-accept-p)
(unless (bound-and-true-p package--initialized)
(package-initialize))
(if (not package-alist)
(progn (print! (info "No ELPA packages to purge"))
0)
(doom--prompt-columns-p
(lambda (p) (format " + %-20.20s" p))
(mapcar #'car package-alist) nil
(format! "Found %d orphaned ELPA packages. Purge them?"
(length package-alist)))
(mapc (doom-rpartial #'delete-directory 'recursive)
(mapcar #'package-desc-dir
(mapcar #'cadr package-alist)))
(length package-alist)))
(defun doom-packages-purge (&optional elpa-p builds-p repos-p auto-accept-p) (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.
@ -357,33 +415,31 @@ 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 to purge (for the emperor)..."))
(cl-destructuring-bind (builds repos) (cl-destructuring-bind (&optional builds-to-purge repos-to-purge repos-to-regraft)
(doom--packages-to-purge) (list (cl-remove-if (doom-rpartial #'gethash straight--profile-cache)
(straight--directory-files (straight--build-dir)))
(cl-remove-if (doom-rpartial #'straight--checkhash straight--repo-cache)
(straight--directory-files (straight--repos-dir)))
(cl-remove-if-not (doom-rpartial #'straight--checkhash straight--repo-cache)
(straight--directory-files (straight--repos-dir))))
(let (success) (let (success)
(print-group! (print-group!
(if builds-p (if (not builds-p)
(and (doom--packages-purge builds "build" auto-accept-p (print! (info "Skipping builds"))
(straight--build-dir it) (and (/= 0 (doom--packages-purge-builds builds-to-purge auto-accept-p))
(straight--modified-file it)) (setq success t)
(setq success t) (straight-prune-build-cache)))
(straight-prune-build-cache))
(print! (info "Skipping builds")))
(if repos-p
(and (doom--packages-purge repos "repo" auto-accept-p
(straight--repos-dir it))
(setq success t))
(print! (info "Skipping repos")))
(if (not elpa-p) (if (not elpa-p)
(print! (info "Skipping elpa packages")) (print! (info "Skipping elpa packages"))
(unless (bound-and-true-p package--initialized) (and (/= 0 (doom--packages-purge-elpa auto-accept-p))
(package-initialize)) (setq success t)))
(and (doom--packages-purge (mapcar #'symbol-name (mapcar #'car package-alist)) (if (not repos-p)
"package" auto-accept-p (print! (info "Skipping repos"))
(package-desc-dir (cadr (assq (intern it) package-alist)))) (and (/= 0 (doom--packages-purge-repos repos-to-purge auto-accept-p))
(setq success t)) (setq success t))
(when (file-directory-p package-user-dir) (and (doom--packages-regraft-repos repos-to-regraft auto-accept-p)
(delete-directory package-user-dir t))) (setq success t)))
(when success (when success
(doom--finalize-straight) (doom--finalize-straight)
t))))) t)))))