mirror of
https://github.com/doomemacs/doomemacs
synced 2025-08-03 12:27:26 -05:00
nit(cli): fix print-group! indentation
This commit is contained in:
198
lisp/cli/gc.el
Normal file
198
lisp/cli/gc.el
Normal file
@ -0,0 +1,198 @@
|
||||
;;; lisp/cli/gc.el --- clean up after profiles, packages, and logs -*- lexical-binding: t; -*-
|
||||
;;; Commentary:
|
||||
;;; Code:
|
||||
|
||||
(doom-require 'doom-lib 'packages)
|
||||
|
||||
|
||||
;;
|
||||
;;; Variables
|
||||
|
||||
;; None yet!
|
||||
|
||||
|
||||
;;
|
||||
;;; Helpers
|
||||
|
||||
(defun doom-gc--build (build)
|
||||
(let ((build-dir (straight--build-dir build)))
|
||||
(delete-directory build-dir 'recursive)
|
||||
(if (file-directory-p build-dir)
|
||||
(ignore (print! (error "Failed to purg build/%s" build)))
|
||||
(print! (success "Purged build/%s" build))
|
||||
t)))
|
||||
|
||||
(defun doom-gc--builds (builds)
|
||||
(if (not builds)
|
||||
(prog1 0
|
||||
(print! (item "No builds to purge")))
|
||||
(print! (start "Purging straight builds..." (length builds)))
|
||||
(print-group!
|
||||
(length
|
||||
(delq nil (mapcar #'doom-gc--build builds))))))
|
||||
|
||||
(defun doom-gc--elpa ()
|
||||
(let ((dirs (doom-files-in package-user-dir :type t :depth 0)))
|
||||
(if (not dirs)
|
||||
(prog1 0
|
||||
(print! (item "No ELPA packages to purge")))
|
||||
(print! (start "Purging ELPA packages..."))
|
||||
(dolist (path dirs (length dirs))
|
||||
(condition-case e
|
||||
(print-group!
|
||||
(if (file-directory-p path)
|
||||
(delete-directory path 'recursive)
|
||||
(delete-file path))
|
||||
(print! (success "Deleted %s") (filename path)))
|
||||
(error
|
||||
(print! (error "Failed to delete %s because: %s")
|
||||
(filename path)
|
||||
e)))))))
|
||||
|
||||
(defun doom-gc--repo (repo)
|
||||
(let ((repo-dir (straight--repos-dir repo)))
|
||||
(when (file-directory-p repo-dir)
|
||||
(delete-directory repo-dir 'recursive)
|
||||
(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-gc--repos (repos)
|
||||
(if (not repos)
|
||||
(prog1 0
|
||||
(print! (item "No repos to purge")))
|
||||
(print! (start "Purging straight repositories..."))
|
||||
(print-group!
|
||||
(length
|
||||
(delq nil (mapcar #'doom-gc--repo repos))))))
|
||||
|
||||
(defun doom-gc--eln ()
|
||||
(if-let (dirs
|
||||
(cl-delete (expand-file-name comp-native-version-dir doom-packages--eln-output-path)
|
||||
(directory-files doom-packages--eln-output-path t "^[^.]" t)
|
||||
:test #'file-equal-p))
|
||||
(progn
|
||||
(print! (start "Purging old native bytecode..."))
|
||||
(print-group!
|
||||
(dolist (dir dirs)
|
||||
(print! (item "Deleting %S") (relpath dir doom-packages--eln-output-path))
|
||||
(delete-directory dir 'recursive))
|
||||
(print! (success "Purged %d directory(ies)" (length dirs))))
|
||||
(length dirs))
|
||||
(print! (item "No ELN directories to purge"))
|
||||
0))
|
||||
|
||||
(cl-defun doom-gc--regraft-repo (repo)
|
||||
(unless repo
|
||||
(error "No repo specified for regrafting"))
|
||||
(let ((default-directory (straight--repos-dir repo)))
|
||||
(unless (file-directory-p ".git")
|
||||
(print! (warn "\rrepos/%s is not a git repo, skipping" repo))
|
||||
(cl-return))
|
||||
(unless (file-in-directory-p default-directory straight-base-dir)
|
||||
(print! (warn "\rSkipping repos/%s because it is local" repo))
|
||||
(cl-return))
|
||||
(let ((before-size (doom-directory-size default-directory)))
|
||||
(doom-call-process "git" "reset" "--hard")
|
||||
(doom-call-process "git" "clean" "-ffd")
|
||||
(if (not (zerop (car (doom-call-process "git" "replace" "--graft" "HEAD"))))
|
||||
(print! (item "\rrepos/%s is already compact\033[1A" repo))
|
||||
(doom-call-process "git" "reflog" "expire" "--expire=all" "--all")
|
||||
(doom-call-process "git" "gc" "--prune=now")
|
||||
(let ((after-size (doom-directory-size default-directory)))
|
||||
(if (equal after-size before-size)
|
||||
(print! (success "\rrepos/%s cannot be compacted further" repo))
|
||||
(print! (success "\rRegrafted repos/%s (from %0.1fKB to %0.1fKB)")
|
||||
repo before-size after-size)))))
|
||||
t))
|
||||
|
||||
(defun doom-gc--regraft-repos (repos)
|
||||
(if (not repos)
|
||||
(prog1 0
|
||||
(print! (item "No repos to regraft")))
|
||||
(print! (start "Regrafting %d repos..." (length repos)))
|
||||
(let ((before-size (doom-directory-size (straight--repos-dir))))
|
||||
(print-group!
|
||||
(prog1 (delq nil (mapcar #'doom-gc--regraft-repo repos))
|
||||
;; (princ "\r\033[K")
|
||||
(let ((after-size (doom-directory-size (straight--repos-dir))))
|
||||
(print! (success "\rFinished regrafting. Size before: %0.1fKB and after: %0.1fKB (%0.1fKB)")
|
||||
before-size after-size
|
||||
(- after-size before-size))))))))
|
||||
|
||||
;;
|
||||
;;; Commands
|
||||
|
||||
;;;###autoload
|
||||
(defcli! (gc)
|
||||
((nobuilds-p ("-b" "--no-builds") "Don't purge unneeded (built) packages")
|
||||
(noelpa-p ("-p" "--no-elpa") "Don't purge ELPA packages")
|
||||
(norepos-p ("-r" "--no-repos") "Don't purge unused straight repos")
|
||||
(noeln-p ("-e" "--no-eln") "Don't purge old ELN bytecode")
|
||||
(noregraft-p ("-g" "--no-regraft") "Don't regraft git repos (ie. compact them)"))
|
||||
"Deletes orphaned packages & repos, and compacts them.
|
||||
|
||||
Purges all installed ELPA packages (as they are considered temporary). Purges
|
||||
all orphaned package repos and builds. Also regrafts and compacts package repos
|
||||
to ensure they are as small as possible.
|
||||
|
||||
It is a good idea to occasionally run this command to ensure your package list
|
||||
remains lean."
|
||||
:benchmark t
|
||||
:group 'emacs
|
||||
(require 'comp nil t)
|
||||
(doom-initialize-packages)
|
||||
(doom-packages--barf-if-incomplete)
|
||||
(print! (start "Purging orphaned packages (for the emperor)..."))
|
||||
(quiet! (straight-prune-build-cache))
|
||||
(cl-destructuring-bind (&optional builds-to-purge repos-to-purge repos-to-regraft)
|
||||
(let ((rdirs
|
||||
(when (or (not norepos-p) (not noregraft-p))
|
||||
(straight--directory-files (straight--repos-dir) nil nil 'sort))))
|
||||
(list (unless nobuilds-p
|
||||
(let ((default-directory (straight--build-dir)))
|
||||
(seq-filter #'file-directory-p
|
||||
(seq-remove (doom-rpartial #'gethash straight--profile-cache)
|
||||
(straight--directory-files default-directory nil nil 'sort)))))
|
||||
(unless norepos-p
|
||||
(seq-remove (doom-rpartial #'straight--checkhash straight--repo-cache)
|
||||
rdirs))
|
||||
(unless noregraft-p
|
||||
(seq-filter (doom-rpartial #'straight--checkhash straight--repo-cache)
|
||||
rdirs))))
|
||||
(print-group!
|
||||
(delq
|
||||
nil (list
|
||||
(if nobuilds-p
|
||||
(ignore (print! (item "Skipping builds")))
|
||||
(/= 0 (doom-gc--builds builds-to-purge)))
|
||||
(if noelpa-p
|
||||
(ignore (print! (item "Skipping elpa packages")))
|
||||
(/= 0 (doom-gc--elpa)))
|
||||
(if norepos-p
|
||||
(ignore (print! (item "Skipping repos")))
|
||||
(/= 0 (doom-gc--repos repos-to-purge)))
|
||||
(if noregraft-p
|
||||
(ignore (print! (item "Skipping regrafting")))
|
||||
(doom-gc--regraft-repos repos-to-regraft))
|
||||
(when (featurep 'native-compile)
|
||||
(if noeln-p
|
||||
(ignore (print! (item "Skipping native bytecode")))
|
||||
(doom-gc--eln)))))))
|
||||
t)
|
||||
|
||||
;;;###autoload
|
||||
(defcli-obsolete! ((purge p)) (gc) "3.0.0")
|
||||
|
||||
;; (defcli! gc
|
||||
;; ((keep ( "--keep" time) "Don't delete generations in the last TIME units")
|
||||
;; (keep-last ( "--keep-last" num) "Don't delete last NUM generations")
|
||||
;; (keep-elpa-p ("-e" "--keep-elpa") "Don't delete package.el-installed packages")
|
||||
;; (keep-orphans-p ("-o" "--keep-orphaned") "Don't delete unused packages")
|
||||
;; (keep-history-p ( "--keep-history") "Don't regraft repos"))
|
||||
;; "Purge unused profile data, generations, and packages.")
|
||||
|
||||
(provide 'doom-cli '(gc))
|
||||
;;; gc.el ends here
|
Reference in New Issue
Block a user