mirror of
https://github.com/doomemacs/doomemacs
synced 2025-08-01 12:17:25 -05:00
nit(cli): fix print-group! indentation
This commit is contained in:
Henrik Lissner
@ -338,24 +338,24 @@ Prevents pushing if there are unrebased or WIP commits."
|
||||
(equal local-sha z40))
|
||||
(throw 'continue t))
|
||||
(print-group!
|
||||
(mapc (lambda (commit)
|
||||
(seq-let (hash msg) (split-string commit "\t")
|
||||
(setq error t)
|
||||
(print! (item "%S commit in %s"
|
||||
(car (split-string msg " "))
|
||||
(substring hash 0 12)))))
|
||||
(split-string
|
||||
(cdr (doom-call-process
|
||||
"git" "rev-list"
|
||||
"--grep" (concat "^" (regexp-opt '("WIP" "squash!" "fixup!" "FIXUP") t) " ")
|
||||
"--format=%H\t%s"
|
||||
(if (equal remote-sha z40)
|
||||
local-sha
|
||||
(format "%s..%s" remote-sha local-sha))))
|
||||
"\n" t))
|
||||
(when error
|
||||
(print! (error "Aborting push due to unrebased WIP, squash!, or fixup! commits"))
|
||||
(exit! 1)))))))))
|
||||
(mapc (lambda (commit)
|
||||
(seq-let (hash msg) (split-string commit "\t")
|
||||
(setq error t)
|
||||
(print! (item "%S commit in %s"
|
||||
(car (split-string msg " "))
|
||||
(substring hash 0 12)))))
|
||||
(split-string
|
||||
(cdr (doom-call-process
|
||||
"git" "rev-list"
|
||||
"--grep" (concat "^" (regexp-opt '("WIP" "squash!" "fixup!" "FIXUP") t) " ")
|
||||
"--format=%H\t%s"
|
||||
(if (equal remote-sha z40)
|
||||
local-sha
|
||||
(format "%s..%s" remote-sha local-sha))))
|
||||
"\n" t))
|
||||
(when error
|
||||
(print! (error "Aborting push due to unrebased WIP, squash!, or fixup! commits"))
|
||||
(exit! 1)))))))))
|
||||
|
||||
|
||||
;;
|
||||
@ -425,24 +425,24 @@ Prevents pushing if there are unrebased or WIP commits."
|
||||
(failures 0))
|
||||
(print! (start "Linting %d commits" (length commits)))
|
||||
(print-group!
|
||||
(pcase-dolist (`(,ref . ,commitmsg) commits)
|
||||
(let* ((commit (doom-ci--parse-commit commitmsg))
|
||||
(shortref (substring ref 0 7))
|
||||
(subject (plist-get commit :subject)))
|
||||
(cl-block 'linter
|
||||
(letf! ((defun skip! (reason &rest args)
|
||||
(print! (warn "Skipped because: %s") (apply #'format reason args))
|
||||
(cl-return-from 'linter))
|
||||
(defun warn! (reason &rest args)
|
||||
(cl-incf warnings)
|
||||
(print! (warn "%s") (apply #'format reason args)))
|
||||
(defun fail! (reason &rest args)
|
||||
(cl-incf failures)
|
||||
(print! (error "%s") (apply #'format reason args))))
|
||||
(print! (start "%s %s") shortref subject)
|
||||
(print-group!
|
||||
(mapc (doom-rpartial #'apply commit)
|
||||
doom-ci-commit-rules)))))))
|
||||
(pcase-dolist (`(,ref . ,commitmsg) commits)
|
||||
(let* ((commit (doom-ci--parse-commit commitmsg))
|
||||
(shortref (substring ref 0 7))
|
||||
(subject (plist-get commit :subject)))
|
||||
(cl-block 'linter
|
||||
(letf! ((defun skip! (reason &rest args)
|
||||
(print! (warn "Skipped because: %s") (apply #'format reason args))
|
||||
(cl-return-from 'linter))
|
||||
(defun warn! (reason &rest args)
|
||||
(cl-incf warnings)
|
||||
(print! (warn "%s") (apply #'format reason args)))
|
||||
(defun fail! (reason &rest args)
|
||||
(cl-incf failures)
|
||||
(print! (error "%s") (apply #'format reason args))))
|
||||
(print! (start "%s %s") shortref subject)
|
||||
(print-group!
|
||||
(mapc (doom-rpartial #'apply commit)
|
||||
doom-ci-commit-rules)))))))
|
||||
(let ((issues (+ warnings failures)))
|
||||
(if (= issues 0)
|
||||
(print! (success "There were no issues!"))
|
||||
|
||||
@ -86,22 +86,22 @@ in."
|
||||
|
||||
(print! (start "Checking for Doom's prerequisites..."))
|
||||
(print-group!
|
||||
(if (not (executable-find "git"))
|
||||
(error! "Couldn't find git on your machine! Doom's package manager won't work.")
|
||||
(save-match-data
|
||||
(let* ((version
|
||||
(cdr (doom-call-process "git" "version")))
|
||||
(version
|
||||
(and (string-match "git version \\([0-9]+\\(?:\\.[0-9]+\\)\\{2\\}\\)" version)
|
||||
(match-string 1 version))))
|
||||
(if version
|
||||
(when (version< version "2.23")
|
||||
(error! "Git %s detected! Doom requires git 2.23 or newer!"
|
||||
version))
|
||||
(warn! "Cannot determine Git version. Doom requires git 2.23 or newer!")))))
|
||||
(if (not (executable-find "git"))
|
||||
(error! "Couldn't find git on your machine! Doom's package manager won't work.")
|
||||
(save-match-data
|
||||
(let* ((version
|
||||
(cdr (doom-call-process "git" "version")))
|
||||
(version
|
||||
(and (string-match "git version \\([0-9]+\\(?:\\.[0-9]+\\)\\{2\\}\\)" version)
|
||||
(match-string 1 version))))
|
||||
(if version
|
||||
(when (version< version "2.23")
|
||||
(error! "Git %s detected! Doom requires git 2.23 or newer!"
|
||||
version))
|
||||
(warn! "Cannot determine Git version. Doom requires git 2.23 or newer!")))))
|
||||
|
||||
(unless (executable-find "rg")
|
||||
(error! "Couldn't find the `rg' binary; this a hard dependecy for Doom, file searches may not work at all")))
|
||||
(unless (executable-find "rg")
|
||||
(error! "Couldn't find the `rg' binary; this a hard dependecy for Doom, file searches may not work at all")))
|
||||
|
||||
(print! (start "Checking for Emacs config conflicts..."))
|
||||
(print-group!
|
||||
|
||||
@ -95,47 +95,47 @@ Why this over exec-path-from-shell?
|
||||
"Regenerating"
|
||||
"Generating"))
|
||||
(print-group!
|
||||
(goto-char (point-min))
|
||||
(insert
|
||||
";; -*- mode: lisp-interaction; coding: utf-8-unix; -*-\n"
|
||||
";; ---------------------------------------------------------------------------\n"
|
||||
";; This file was auto-generated by `doom env'. It contains a list of environment\n"
|
||||
";; variables scraped from your default shell (based on your settings for \n"
|
||||
";; `doom-env-allow' and `doom-env-deny').\n"
|
||||
";;\n"
|
||||
(if (file-equal-p env-file doom-env-file)
|
||||
(concat ";; It is NOT safe to edit this file. Changes will be overwritten next time you\n"
|
||||
";; run 'doom sync'. To create a safe-to-edit envvar file use:\n;;\n"
|
||||
";; doom env -o ~/.doom.d/myenv\n;;\n"
|
||||
";; And load it with (doom-load-envvars-file \"~/.doom.d/myenv\").\n")
|
||||
(concat ";; This file is safe to edit by hand, but needs to be loaded manually with:\n;;\n"
|
||||
";; (doom-load-envvars-file \"path/to/this/file\")\n;;\n"
|
||||
";; Use 'doom env -o path/to/this/file' to regenerate it."))
|
||||
"\n")
|
||||
;; We assume that this noninteractive session was spawned from the user's
|
||||
;; interactive shell, so simply dump `process-environment' to a file.
|
||||
;;
|
||||
;; This should be well-formatted, in case humans want to hand-modify it.
|
||||
(let* ((denylist (remq nil (append (if deny-only '(".")) (list allow-only) doom-env-deny)))
|
||||
(allowlist (remq nil (append (if allow-only '(".")) (list deny-only) doom-env-allow))))
|
||||
(dolist (rule rules)
|
||||
(push (cdr rule) (if (member (car rule) '("-a" "--allow"))
|
||||
allowlist
|
||||
denylist)))
|
||||
(insert "(")
|
||||
(dolist (env (get 'process-environment 'initial-value))
|
||||
(catch 'skip
|
||||
(let* ((var (car (split-string env "=")))
|
||||
(pred (doom-rpartial #'string-match-p var)))
|
||||
(when (seq-find pred denylist)
|
||||
(if (seq-find pred allowlist)
|
||||
(doom-log "cli:env: allow %s" var)
|
||||
(doom-log "cli:env: deny %s" var)
|
||||
(throw 'skip t)))
|
||||
(insert (prin1-to-string env) "\n "))))
|
||||
(insert ")"))
|
||||
(print! (success "Generated %s") (path env-file))
|
||||
t))))
|
||||
(goto-char (point-min))
|
||||
(insert
|
||||
";; -*- mode: lisp-interaction; coding: utf-8-unix; -*-\n"
|
||||
";; ---------------------------------------------------------------------------\n"
|
||||
";; This file was auto-generated by `doom env'. It contains a list of environment\n"
|
||||
";; variables scraped from your default shell (based on your settings for \n"
|
||||
";; `doom-env-allow' and `doom-env-deny').\n"
|
||||
";;\n"
|
||||
(if (file-equal-p env-file doom-env-file)
|
||||
(concat ";; It is NOT safe to edit this file. Changes will be overwritten next time you\n"
|
||||
";; run 'doom sync'. To create a safe-to-edit envvar file use:\n;;\n"
|
||||
";; doom env -o ~/.doom.d/myenv\n;;\n"
|
||||
";; And load it with (doom-load-envvars-file \"~/.doom.d/myenv\").\n")
|
||||
(concat ";; This file is safe to edit by hand, but needs to be loaded manually with:\n;;\n"
|
||||
";; (doom-load-envvars-file \"path/to/this/file\")\n;;\n"
|
||||
";; Use 'doom env -o path/to/this/file' to regenerate it."))
|
||||
"\n")
|
||||
;; We assume that this noninteractive session was spawned from the user's
|
||||
;; interactive shell, so simply dump `process-environment' to a file.
|
||||
;;
|
||||
;; This should be well-formatted, in case humans want to hand-modify it.
|
||||
(let* ((denylist (remq nil (append (if deny-only '(".")) (list allow-only) doom-env-deny)))
|
||||
(allowlist (remq nil (append (if allow-only '(".")) (list deny-only) doom-env-allow))))
|
||||
(dolist (rule rules)
|
||||
(push (cdr rule) (if (member (car rule) '("-a" "--allow"))
|
||||
allowlist
|
||||
denylist)))
|
||||
(insert "(")
|
||||
(dolist (env (get 'process-environment 'initial-value))
|
||||
(catch 'skip
|
||||
(let* ((var (car (split-string env "=")))
|
||||
(pred (doom-rpartial #'string-match-p var)))
|
||||
(when (seq-find pred denylist)
|
||||
(if (seq-find pred allowlist)
|
||||
(doom-log "cli:env: allow %s" var)
|
||||
(doom-log "cli:env: deny %s" var)
|
||||
(throw 'skip t)))
|
||||
(insert (prin1-to-string env) "\n "))))
|
||||
(insert ")"))
|
||||
(print! (success "Generated %s") (path env-file))
|
||||
t))))
|
||||
|
||||
(defcli! (env (clear c)) ()
|
||||
"Deletes the default envvar file."
|
||||
|
||||
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
|
||||
@ -114,10 +114,10 @@ Change `$DOOMDIR' with the `--doomdir' option, e.g.
|
||||
(print! (warn "Not deploying commit-msg and pre-push git hooks, as requested"))
|
||||
(print! (start "Deploying commit-msg and pre-push git hooks"))
|
||||
(print-group!
|
||||
(condition-case e
|
||||
(call! `(ci deploy-hooks ,@(if yes? '("--force"))))
|
||||
('user-error
|
||||
(print! (warn "%s") (error-message-string e))))))
|
||||
(condition-case e
|
||||
(call! `(ci deploy-hooks ,@(if yes? '("--force"))))
|
||||
('user-error
|
||||
(print! (warn "%s") (error-message-string e))))))
|
||||
|
||||
(when (file-exists-p "~/.emacs")
|
||||
(print! (warn "A ~/.emacs file was detected. This conflicts with Doom and should be deleted!")))
|
||||
|
||||
@ -113,8 +113,8 @@ performance, it is best to run Doom out of ~/.config/emacs or ~/.emacs.d."
|
||||
(print-escape-newlines t))
|
||||
(print! (error "There was an unexpected error"))
|
||||
(print-group!
|
||||
(print! "%s %s" (bold "Message:") (error-message-string e))
|
||||
(print! "%s %S" (bold "Details:") (cdr e))))))))
|
||||
(print! "%s %s" (bold "Message:") (error-message-string e))
|
||||
(print! "%s %S" (bold "Details:") (cdr e))))))))
|
||||
(terpri))))
|
||||
|
||||
(provide 'doom-cli-run)
|
||||
|
||||
@ -144,10 +144,10 @@ libraries. It is the equivalent of the following shell commands:
|
||||
(ignore (print! (error "Aborted")))
|
||||
(print! (start "Upgrading Doom Emacs..."))
|
||||
(print-group!
|
||||
(doom-cli-context-put context 'straight-recipe (doom-upgrade--get-straight-recipe))
|
||||
(or (and (zerop (car (sh! "git" "reset" "--hard" target-remote)))
|
||||
(equal (cdr (sh! "git" "rev-parse" "HEAD")) new-rev))
|
||||
(error "Failed to check out %s" (substring new-rev 0 10)))))))))
|
||||
(doom-cli-context-put context 'straight-recipe (doom-upgrade--get-straight-recipe))
|
||||
(or (and (zerop (car (sh! "git" "reset" "--hard" target-remote)))
|
||||
(equal (cdr (sh! "git" "rev-parse" "HEAD")) new-rev))
|
||||
(error "Failed to check out %s" (substring new-rev 0 10)))))))))
|
||||
(ignore-errors
|
||||
(sh! "git" "branch" "-D" target-remote)
|
||||
(sh! "git" "remote" "remove" doom-upgrade-remote))))))
|
||||
|
||||
Reference in New Issue
Block a user