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))))))
|
||||
|
||||
@ -982,13 +982,13 @@ considered as well."
|
||||
(print! (error "Last %d lines of straight's error log:")
|
||||
doom-cli-log-straight-error-lines)
|
||||
(print-group!
|
||||
(print!
|
||||
"%s" (string-join
|
||||
(seq-subseq straight-error
|
||||
(max 0 (- (length straight-error)
|
||||
doom-cli-log-straight-error-lines))
|
||||
(length straight-error))
|
||||
"\n")))
|
||||
(print!
|
||||
"%s" (string-join
|
||||
(seq-subseq straight-error
|
||||
(max 0 (- (length straight-error)
|
||||
doom-cli-log-straight-error-lines))
|
||||
(length straight-error))
|
||||
"\n")))
|
||||
(print! (warn "Wrote extended straight log to %s")
|
||||
(path (let ((coding-system-for-write 'utf-8-auto))
|
||||
(with-file-modes #o600
|
||||
@ -1003,30 +1003,30 @@ considered as well."
|
||||
(print! (error "There was an unexpected runtime error"))
|
||||
(print! (bold (error "There was a fatal initialization error"))))
|
||||
(print-group!
|
||||
(print! "%s %s" (bold "Message:")
|
||||
(if generic?
|
||||
(error-message-string data)
|
||||
(get (car data) 'error-message)))
|
||||
(unless generic?
|
||||
(print! "%s %s" (bold "Details:")
|
||||
(let* ((print-level 4)
|
||||
(print-circle t)
|
||||
(print-escape-newlines t))
|
||||
(prin1-to-string (cdr data)))))
|
||||
(when backtrace
|
||||
(print! (bold "Backtrace:"))
|
||||
(print-group!
|
||||
(dolist (frame (seq-take backtrace doom-cli-log-backtrace-depth))
|
||||
(print! "%s" (truncate (prin1-to-string
|
||||
(cons (backtrace-frame-fun frame)
|
||||
(backtrace-frame-args frame)))
|
||||
(- (doom-cli-context-width context)
|
||||
doom-print-indent
|
||||
1)
|
||||
"..."))))
|
||||
(when-let (backtrace-file (doom-backtrace-write-to-file backtrace error-file))
|
||||
(print! (warn "Wrote extended backtrace to %s")
|
||||
(path backtrace-file))))))))
|
||||
(print! "%s %s" (bold "Message:")
|
||||
(if generic?
|
||||
(error-message-string data)
|
||||
(get (car data) 'error-message)))
|
||||
(unless generic?
|
||||
(print! "%s %s" (bold "Details:")
|
||||
(let* ((print-level 4)
|
||||
(print-circle t)
|
||||
(print-escape-newlines t))
|
||||
(prin1-to-string (cdr data)))))
|
||||
(when backtrace
|
||||
(print! (bold "Backtrace:"))
|
||||
(print-group!
|
||||
(dolist (frame (seq-take backtrace doom-cli-log-backtrace-depth))
|
||||
(print! "%s" (truncate (prin1-to-string
|
||||
(cons (backtrace-frame-fun frame)
|
||||
(backtrace-frame-args frame)))
|
||||
(- (doom-cli-context-width context)
|
||||
doom-print-indent
|
||||
1)
|
||||
"..."))))
|
||||
(when-let (backtrace-file (doom-backtrace-write-to-file backtrace error-file))
|
||||
(print! (warn "Wrote extended backtrace to %s")
|
||||
(path backtrace-file))))))))
|
||||
(exit! 255)))
|
||||
|
||||
(defmacro doom-cli-redirect-output (context &rest body)
|
||||
|
||||
@ -198,40 +198,40 @@ original state.")
|
||||
return (funcall func))
|
||||
(print! (start "%s") (red prompt))
|
||||
(print-group!
|
||||
(terpri)
|
||||
(let (recommended options)
|
||||
(print-group!
|
||||
(print! " 1) Abort")
|
||||
(cl-loop for (_key desc func) in actions
|
||||
when desc
|
||||
do (push func options)
|
||||
and do
|
||||
(print! "%2s) %s" (1+ (length options))
|
||||
(if (doom-straight--recommended-option-p prompt desc)
|
||||
(progn
|
||||
(setq doom-straight--auto-options nil
|
||||
recommended (length options))
|
||||
(green (concat desc " (Choose this if unsure)")))
|
||||
desc))))
|
||||
(terpri)
|
||||
(let* ((options
|
||||
(cons (lambda ()
|
||||
(let ((doom-output-indent 0))
|
||||
(terpri)
|
||||
(print! (warn "Aborted")))
|
||||
(doom-cli--exit 1 doom-cli--context))
|
||||
(nreverse options)))
|
||||
(prompt
|
||||
(format! "How to proceed? (%s%s) "
|
||||
(mapconcat #'number-to-string
|
||||
(number-sequence 1 (length options))
|
||||
", ")
|
||||
(if (not recommended) ""
|
||||
(format "; don't know? Pick %d" (1+ recommended)))))
|
||||
answer fn)
|
||||
(while (null (nth (setq answer (1- (read-number prompt))) options))
|
||||
(print! (warn "%s is not a valid answer, try again.") answer))
|
||||
(funcall (nth answer options)))))))))
|
||||
(terpri)
|
||||
(let (recommended options)
|
||||
(print-group!
|
||||
(print! " 1) Abort")
|
||||
(cl-loop for (_key desc func) in actions
|
||||
when desc
|
||||
do (push func options)
|
||||
and do
|
||||
(print! "%2s) %s" (1+ (length options))
|
||||
(if (doom-straight--recommended-option-p prompt desc)
|
||||
(progn
|
||||
(setq doom-straight--auto-options nil
|
||||
recommended (length options))
|
||||
(green (concat desc " (Choose this if unsure)")))
|
||||
desc))))
|
||||
(terpri)
|
||||
(let* ((options
|
||||
(cons (lambda ()
|
||||
(let ((doom-output-indent 0))
|
||||
(terpri)
|
||||
(print! (warn "Aborted")))
|
||||
(doom-cli--exit 1 doom-cli--context))
|
||||
(nreverse options)))
|
||||
(prompt
|
||||
(format! "How to proceed? (%s%s) "
|
||||
(mapconcat #'number-to-string
|
||||
(number-sequence 1 (length options))
|
||||
", ")
|
||||
(if (not recommended) ""
|
||||
(format "; don't know? Pick %d" (1+ recommended)))))
|
||||
answer fn)
|
||||
(while (null (nth (setq answer (1- (read-number prompt))) options))
|
||||
(print! (warn "%s is not a valid answer, try again.") answer))
|
||||
(funcall (nth answer options)))))))))
|
||||
|
||||
(setq straight-arrow " > ")
|
||||
(defadvice! doom-straight--respect-print-indent-a (string &rest objects)
|
||||
|
||||
@ -86,36 +86,36 @@ package's name as a symbol, and whose CDR is the plist supplied to its
|
||||
version)))))
|
||||
(print! (start "Installing straight..."))
|
||||
(print-group!
|
||||
(cl-destructuring-bind (depth . options)
|
||||
(ensure-list straight-vc-git-default-clone-depth)
|
||||
(let ((branch-switch (if (memq 'single-branch options)
|
||||
"--single-branch"
|
||||
"--no-single-branch")))
|
||||
(cond
|
||||
((eq 'full depth)
|
||||
(funcall call "git" "clone" "--origin" "origin"
|
||||
branch-switch repo-url repo-dir))
|
||||
((integerp depth)
|
||||
(if (null pin)
|
||||
(progn
|
||||
(when (file-directory-p repo-dir)
|
||||
(delete-directory repo-dir 'recursive))
|
||||
(funcall call "git" "clone" "--origin" "origin" repo-url
|
||||
"--no-checkout" repo-dir
|
||||
"--depth" (number-to-string depth)
|
||||
branch-switch
|
||||
"--no-tags"
|
||||
"--branch" straight-repository-branch))
|
||||
(make-directory repo-dir 'recursive)
|
||||
(let ((default-directory repo-dir))
|
||||
(funcall call "git" "init")
|
||||
(funcall call "git" "branch" "-m" straight-repository-branch)
|
||||
(funcall call "git" "remote" "add" "origin" repo-url
|
||||
"--master" straight-repository-branch)
|
||||
(funcall call "git" "fetch" "origin" pin
|
||||
"--depth" (number-to-string depth)
|
||||
"--no-tags")
|
||||
(funcall call "git" "reset" "--hard" pin)))))))))
|
||||
(cl-destructuring-bind (depth . options)
|
||||
(ensure-list straight-vc-git-default-clone-depth)
|
||||
(let ((branch-switch (if (memq 'single-branch options)
|
||||
"--single-branch"
|
||||
"--no-single-branch")))
|
||||
(cond
|
||||
((eq 'full depth)
|
||||
(funcall call "git" "clone" "--origin" "origin"
|
||||
branch-switch repo-url repo-dir))
|
||||
((integerp depth)
|
||||
(if (null pin)
|
||||
(progn
|
||||
(when (file-directory-p repo-dir)
|
||||
(delete-directory repo-dir 'recursive))
|
||||
(funcall call "git" "clone" "--origin" "origin" repo-url
|
||||
"--no-checkout" repo-dir
|
||||
"--depth" (number-to-string depth)
|
||||
branch-switch
|
||||
"--no-tags"
|
||||
"--branch" straight-repository-branch))
|
||||
(make-directory repo-dir 'recursive)
|
||||
(let ((default-directory repo-dir))
|
||||
(funcall call "git" "init")
|
||||
(funcall call "git" "branch" "-m" straight-repository-branch)
|
||||
(funcall call "git" "remote" "add" "origin" repo-url
|
||||
"--master" straight-repository-branch)
|
||||
(funcall call "git" "fetch" "origin" pin
|
||||
"--depth" (number-to-string depth)
|
||||
"--no-tags")
|
||||
(funcall call "git" "reset" "--hard" pin)))))))))
|
||||
(require 'straight (concat repo-dir "/straight.el"))
|
||||
(doom-log "Initializing recipes")
|
||||
(mapc #'straight-use-recipes
|
||||
@ -147,9 +147,9 @@ package's name as a symbol, and whose CDR is the plist supplied to its
|
||||
(when-let (local-repo (plist-get recipe :local-repo))
|
||||
(setq repo local-repo)))
|
||||
(print-group!
|
||||
;; Only clone the package, don't build them. Straight hasn't been fully
|
||||
;; configured by this point.
|
||||
(straight-use-package name nil t))
|
||||
;; Only clone the package, don't build them. Straight hasn't been fully
|
||||
;; configured by this point.
|
||||
(straight-use-package name nil t))
|
||||
;; In case the package hasn't been built yet.
|
||||
(or (member (directory-file-name (straight--build-dir (symbol-name name)))
|
||||
load-path)
|
||||
|
||||
@ -20,40 +20,40 @@
|
||||
(dest (expand-file-name dest)))
|
||||
(print! (start "Tangling your literate config..."))
|
||||
(print-group!
|
||||
(let (;; Do as little unnecessary work as possible in these org files.
|
||||
(org-startup-indented nil)
|
||||
(org-startup-folded nil)
|
||||
(vc-handled-backends nil)
|
||||
;; Prevent unwanted entries in recentf, or formatters, or
|
||||
;; anything that could be on these hooks, really. Nothing else
|
||||
;; should be touching these files (particularly in interactive
|
||||
;; sessions).
|
||||
(write-file-functions nil)
|
||||
(before-save-hook nil)
|
||||
(after-save-hook nil)
|
||||
;; Prevent infinite recursion due to recompile-on-save hooks
|
||||
;; later, and speed up `org-mode' init.
|
||||
(org-mode-hook nil)
|
||||
(org-inhibit-startup t)
|
||||
;; Allow evaluation of src blocks at tangle-time (would abort
|
||||
;; them otherwise). This is a security hazard, but Doom will
|
||||
;; trust that you know what you're doing!
|
||||
(org-confirm-babel-evaluate nil)
|
||||
;; Say a little more
|
||||
(doom-print-message-level 'info))
|
||||
(cond ((not (file-exists-p target))
|
||||
(print! (warn "No org file at %s. Skipping...") (path target))
|
||||
nil)
|
||||
((with-temp-buffer
|
||||
(insert-file-contents target)
|
||||
(let ((case-fold-search t))
|
||||
(not (re-search-forward "^ *#\\+begin_src e\\(?:macs-\\)?lisp" nil t))))
|
||||
(print! (warn "No src blocks to tangle in %s. Skipping...") (path target))
|
||||
nil)
|
||||
((if-let (files (org-babel-tangle-file target dest))
|
||||
(always (print! (success "Done tangling %d file(s)!" (length files))))
|
||||
(print! (error "Failed to tangle any blocks from your config."))
|
||||
nil))))))))
|
||||
(let (;; Do as little unnecessary work as possible in these org files.
|
||||
(org-startup-indented nil)
|
||||
(org-startup-folded nil)
|
||||
(vc-handled-backends nil)
|
||||
;; Prevent unwanted entries in recentf, or formatters, or
|
||||
;; anything that could be on these hooks, really. Nothing else
|
||||
;; should be touching these files (particularly in interactive
|
||||
;; sessions).
|
||||
(write-file-functions nil)
|
||||
(before-save-hook nil)
|
||||
(after-save-hook nil)
|
||||
;; Prevent infinite recursion due to recompile-on-save hooks
|
||||
;; later, and speed up `org-mode' init.
|
||||
(org-mode-hook nil)
|
||||
(org-inhibit-startup t)
|
||||
;; Allow evaluation of src blocks at tangle-time (would abort
|
||||
;; them otherwise). This is a security hazard, but Doom will
|
||||
;; trust that you know what you're doing!
|
||||
(org-confirm-babel-evaluate nil)
|
||||
;; Say a little more
|
||||
(doom-print-message-level 'info))
|
||||
(cond ((not (file-exists-p target))
|
||||
(print! (warn "No org file at %s. Skipping...") (path target))
|
||||
nil)
|
||||
((with-temp-buffer
|
||||
(insert-file-contents target)
|
||||
(let ((case-fold-search t))
|
||||
(not (re-search-forward "^ *#\\+begin_src e\\(?:macs-\\)?lisp" nil t))))
|
||||
(print! (warn "No src blocks to tangle in %s. Skipping...") (path target))
|
||||
nil)
|
||||
((if-let (files (org-babel-tangle-file target dest))
|
||||
(always (print! (success "Done tangling %d file(s)!" (length files))))
|
||||
(print! (error "Failed to tangle any blocks from your config."))
|
||||
nil))))))))
|
||||
|
||||
(defun +literate-tangle--sync ()
|
||||
"Tangles `+literate-config-file' if it has changed."
|
||||
|
||||
Reference in New Issue
Block a user