awesome-emacs/doomemacs
1
0
Fork 0
mirror of https://github.com/doomemacs/doomemacs synced 2025-08-03 12:27:26 -05:00
Code Issues Packages Projects Releases Wiki Activity

nit(cli): fix print-group! indentation

Browse Source
This commit is contained in:
Henrik Lissner
2024-11-13 07:22:41 -05:00
parent cb557319a9
commit 5e84709577
11 changed files with 432 additions and 234 deletions
Download Patch File Download Diff File Expand all files Collapse all files

72
lisp/cli/ci.el
View File

@ -338,24 +338,24 @@ Prevents pushing if there are unrebased or WIP commits."
(equal local-sha z40)) (equal local-sha z40))
(throw 'continue t)) (throw 'continue t))
(print-group! (print-group!
(mapc (lambda (commit) (mapc (lambda (commit)
(seq-let (hash msg) (split-string commit "\t") (seq-let (hash msg) (split-string commit "\t")
(setq error t) (setq error t)
(print! (item "%S commit in %s" (print! (item "%S commit in %s"
(car (split-string msg " ")) (car (split-string msg " "))
(substring hash 0 12))))) (substring hash 0 12)))))
(split-string (split-string
(cdr (doom-call-process (cdr (doom-call-process
"git" "rev-list" "git" "rev-list"
"--grep" (concat "^" (regexp-opt '("WIP" "squash!" "fixup!" "FIXUP") t) " ") "--grep" (concat "^" (regexp-opt '("WIP" "squash!" "fixup!" "FIXUP") t) " ")
"--format=%H\t%s" "--format=%H\t%s"
(if (equal remote-sha z40) (if (equal remote-sha z40)
local-sha local-sha
(format "%s..%s" remote-sha local-sha)))) (format "%s..%s" remote-sha local-sha))))
"\n" t)) "\n" t))
(when error (when error
(print! (error "Aborting push due to unrebased WIP, squash!, or fixup! commits")) (print! (error "Aborting push due to unrebased WIP, squash!, or fixup! commits"))
(exit! 1))))))))) (exit! 1)))))))))
;; ;;
@ -425,24 +425,24 @@ Prevents pushing if there are unrebased or WIP commits."
(failures 0)) (failures 0))
(print! (start "Linting %d commits" (length commits))) (print! (start "Linting %d commits" (length commits)))
(print-group! (print-group!
(pcase-dolist (`(,ref . ,commitmsg) commits) (pcase-dolist (`(,ref . ,commitmsg) commits)
(let* ((commit (doom-ci--parse-commit commitmsg)) (let* ((commit (doom-ci--parse-commit commitmsg))
(shortref (substring ref 0 7)) (shortref (substring ref 0 7))
(subject (plist-get commit :subject))) (subject (plist-get commit :subject)))
(cl-block 'linter (cl-block 'linter
(letf! ((defun skip! (reason &rest args) (letf! ((defun skip! (reason &rest args)
(print! (warn "Skipped because: %s") (apply #'format reason args)) (print! (warn "Skipped because: %s") (apply #'format reason args))
(cl-return-from 'linter)) (cl-return-from 'linter))
(defun warn! (reason &rest args) (defun warn! (reason &rest args)
(cl-incf warnings) (cl-incf warnings)
(print! (warn "%s") (apply #'format reason args))) (print! (warn "%s") (apply #'format reason args)))
(defun fail! (reason &rest args) (defun fail! (reason &rest args)
(cl-incf failures) (cl-incf failures)
(print! (error "%s") (apply #'format reason args)))) (print! (error "%s") (apply #'format reason args))))
(print! (start "%s %s") shortref subject) (print! (start "%s %s") shortref subject)
(print-group! (print-group!
(mapc (doom-rpartial #'apply commit) (mapc (doom-rpartial #'apply commit)
doom-ci-commit-rules))))))) doom-ci-commit-rules)))))))
(let ((issues (+ warnings failures))) (let ((issues (+ warnings failures)))
(if (= issues 0) (if (= issues 0)
(print! (success "There were no issues!")) (print! (success "There were no issues!"))

30
lisp/cli/doctor.el
View File

@ -86,22 +86,22 @@ in."
(print! (start "Checking for Doom's prerequisites...")) (print! (start "Checking for Doom's prerequisites..."))
(print-group! (print-group!
(if (not (executable-find "git")) (if (not (executable-find "git"))
(error! "Couldn't find git on your machine! Doom's package manager won't work.") (error! "Couldn't find git on your machine! Doom's package manager won't work.")
(save-match-data (save-match-data
(let* ((version (let* ((version
(cdr (doom-call-process "git" "version"))) (cdr (doom-call-process "git" "version")))
(version (version
(and (string-match "git version \\([0-9]+\\(?:\\.[0-9]+\\)\\{2\\}\\)" version) (and (string-match "git version \\([0-9]+\\(?:\\.[0-9]+\\)\\{2\\}\\)" version)
(match-string 1 version)))) (match-string 1 version))))
(if version (if version
(when (version< version "2.23") (when (version< version "2.23")
(error! "Git %s detected! Doom requires git 2.23 or newer!" (error! "Git %s detected! Doom requires git 2.23 or newer!"
version)) version))
(warn! "Cannot determine Git version. Doom requires git 2.23 or newer!"))))) (warn! "Cannot determine Git version. Doom requires git 2.23 or newer!")))))
(unless (executable-find "rg") (unless (executable-find "rg")
(error! "Couldn't find the `rg' binary; this a hard dependecy for Doom, file searches may not work at all"))) (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! (start "Checking for Emacs config conflicts..."))
(print-group! (print-group!

82
lisp/cli/env.el
View File

@ -95,47 +95,47 @@ Why this over exec-path-from-shell?
"Regenerating" "Regenerating"
"Generating")) "Generating"))
(print-group! (print-group!
(goto-char (point-min)) (goto-char (point-min))
(insert (insert
";; -*- mode: lisp-interaction; coding: utf-8-unix; -*-\n" ";; -*- mode: lisp-interaction; coding: utf-8-unix; -*-\n"
";; ---------------------------------------------------------------------------\n" ";; ---------------------------------------------------------------------------\n"
";; This file was auto-generated by `doom env'. It contains a list of environment\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" ";; variables scraped from your default shell (based on your settings for \n"
";; `doom-env-allow' and `doom-env-deny').\n" ";; `doom-env-allow' and `doom-env-deny').\n"
";;\n" ";;\n"
(if (file-equal-p env-file doom-env-file) (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" (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" ";; run 'doom sync'. To create a safe-to-edit envvar file use:\n;;\n"
";; doom env -o ~/.doom.d/myenv\n;;\n" ";; doom env -o ~/.doom.d/myenv\n;;\n"
";; And load it with (doom-load-envvars-file \"~/.doom.d/myenv\").\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" (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" ";; (doom-load-envvars-file \"path/to/this/file\")\n;;\n"
";; Use 'doom env -o path/to/this/file' to regenerate it.")) ";; Use 'doom env -o path/to/this/file' to regenerate it."))
"\n") "\n")
;; We assume that this noninteractive session was spawned from the user's ;; We assume that this noninteractive session was spawned from the user's
;; interactive shell, so simply dump `process-environment' to a file. ;; interactive shell, so simply dump `process-environment' to a file.
;; ;;
;; This should be well-formatted, in case humans want to hand-modify it. ;; 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))) (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)))) (allowlist (remq nil (append (if allow-only '(".")) (list deny-only) doom-env-allow))))
(dolist (rule rules) (dolist (rule rules)
(push (cdr rule) (if (member (car rule) '("-a" "--allow")) (push (cdr rule) (if (member (car rule) '("-a" "--allow"))
allowlist allowlist
denylist))) denylist)))
(insert "(") (insert "(")
(dolist (env (get 'process-environment 'initial-value)) (dolist (env (get 'process-environment 'initial-value))
(catch 'skip (catch 'skip
(let* ((var (car (split-string env "="))) (let* ((var (car (split-string env "=")))
(pred (doom-rpartial #'string-match-p var))) (pred (doom-rpartial #'string-match-p var)))
(when (seq-find pred denylist) (when (seq-find pred denylist)
(if (seq-find pred allowlist) (if (seq-find pred allowlist)
(doom-log "cli:env: allow %s" var) (doom-log "cli:env: allow %s" var)
(doom-log "cli:env: deny %s" var) (doom-log "cli:env: deny %s" var)
(throw 'skip t))) (throw 'skip t)))
(insert (prin1-to-string env) "\n ")))) (insert (prin1-to-string env) "\n "))))
(insert ")")) (insert ")"))
(print! (success "Generated %s") (path env-file)) (print! (success "Generated %s") (path env-file))
t)))) t))))
(defcli! (env (clear c)) () (defcli! (env (clear c)) ()
"Deletes the default envvar file." "Deletes the default envvar file."

198
lisp/cli/gc.el Normal file
View 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

8
lisp/cli/install.el
View File

@ -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! (warn "Not deploying commit-msg and pre-push git hooks, as requested"))
(print! (start "Deploying commit-msg and pre-push git hooks")) (print! (start "Deploying commit-msg and pre-push git hooks"))
(print-group! (print-group!
(condition-case e (condition-case e
(call! `(ci deploy-hooks ,@(if yes? '("--force")))) (call! `(ci deploy-hooks ,@(if yes? '("--force"))))
('user-error ('user-error
(print! (warn "%s") (error-message-string e)))))) (print! (warn "%s") (error-message-string e))))))
(when (file-exists-p "~/.emacs") (when (file-exists-p "~/.emacs")
(print! (warn "A ~/.emacs file was detected. This conflicts with Doom and should be deleted!"))) (print! (warn "A ~/.emacs file was detected. This conflicts with Doom and should be deleted!")))

4
lisp/cli/run.el
View File

@ -113,8 +113,8 @@ performance, it is best to run Doom out of ~/.config/emacs or ~/.emacs.d."
(print-escape-newlines t)) (print-escape-newlines t))
(print! (error "There was an unexpected error")) (print! (error "There was an unexpected error"))
(print-group! (print-group!
(print! "%s %s" (bold "Message:") (error-message-string e)) (print! "%s %s" (bold "Message:") (error-message-string e))
(print! "%s %S" (bold "Details:") (cdr e)))))))) (print! "%s %S" (bold "Details:") (cdr e))))))))
(terpri)))) (terpri))))
(provide 'doom-cli-run) (provide 'doom-cli-run)

8
lisp/cli/upgrade.el
View File

@ -144,10 +144,10 @@ libraries. It is the equivalent of the following shell commands:
(ignore (print! (error "Aborted"))) (ignore (print! (error "Aborted")))
(print! (start "Upgrading Doom Emacs...")) (print! (start "Upgrading Doom Emacs..."))
(print-group! (print-group!
(doom-cli-context-put context 'straight-recipe (doom-upgrade--get-straight-recipe)) (doom-cli-context-put context 'straight-recipe (doom-upgrade--get-straight-recipe))
(or (and (zerop (car (sh! "git" "reset" "--hard" target-remote))) (or (and (zerop (car (sh! "git" "reset" "--hard" target-remote)))
(equal (cdr (sh! "git" "rev-parse" "HEAD")) new-rev)) (equal (cdr (sh! "git" "rev-parse" "HEAD")) new-rev))
(error "Failed to check out %s" (substring new-rev 0 10))))))))) (error "Failed to check out %s" (substring new-rev 0 10)))))))))
(ignore-errors (ignore-errors
(sh! "git" "branch" "-D" target-remote) (sh! "git" "branch" "-D" target-remote)
(sh! "git" "remote" "remove" doom-upgrade-remote)))))) (sh! "git" "remote" "remove" doom-upgrade-remote))))))

62
lisp/doom-cli.el
View File

@ -982,13 +982,13 @@ considered as well."
(print! (error "Last %d lines of straight's error log:") (print! (error "Last %d lines of straight's error log:")
doom-cli-log-straight-error-lines) doom-cli-log-straight-error-lines)
(print-group! (print-group!
(print! (print!
"%s" (string-join "%s" (string-join
(seq-subseq straight-error (seq-subseq straight-error
(max 0 (- (length straight-error) (max 0 (- (length straight-error)
doom-cli-log-straight-error-lines)) doom-cli-log-straight-error-lines))
(length straight-error)) (length straight-error))
"\n"))) "\n")))
(print! (warn "Wrote extended straight log to %s") (print! (warn "Wrote extended straight log to %s")
(path (let ((coding-system-for-write 'utf-8-auto)) (path (let ((coding-system-for-write 'utf-8-auto))
(with-file-modes #o600 (with-file-modes #o600
@ -1003,30 +1003,30 @@ considered as well."
(print! (error "There was an unexpected runtime error")) (print! (error "There was an unexpected runtime error"))
(print! (bold (error "There was a fatal initialization error")))) (print! (bold (error "There was a fatal initialization error"))))
(print-group! (print-group!
(print! "%s %s" (bold "Message:") (print! "%s %s" (bold "Message:")
(if generic? (if generic?
(error-message-string data) (error-message-string data)
(get (car data) 'error-message))) (get (car data) 'error-message)))
(unless generic? (unless generic?
(print! "%s %s" (bold "Details:") (print! "%s %s" (bold "Details:")
(let* ((print-level 4) (let* ((print-level 4)
(print-circle t) (print-circle t)
(print-escape-newlines t)) (print-escape-newlines t))
(prin1-to-string (cdr data))))) (prin1-to-string (cdr data)))))
(when backtrace (when backtrace
(print! (bold "Backtrace:")) (print! (bold "Backtrace:"))
(print-group! (print-group!
(dolist (frame (seq-take backtrace doom-cli-log-backtrace-depth)) (dolist (frame (seq-take backtrace doom-cli-log-backtrace-depth))
(print! "%s" (truncate (prin1-to-string (print! "%s" (truncate (prin1-to-string
(cons (backtrace-frame-fun frame) (cons (backtrace-frame-fun frame)
(backtrace-frame-args frame))) (backtrace-frame-args frame)))
(- (doom-cli-context-width context) (- (doom-cli-context-width context)
doom-print-indent doom-print-indent
1) 1)
"...")))) "..."))))
(when-let (backtrace-file (doom-backtrace-write-to-file backtrace error-file)) (when-let (backtrace-file (doom-backtrace-write-to-file backtrace error-file))
(print! (warn "Wrote extended backtrace to %s") (print! (warn "Wrote extended backtrace to %s")
(path backtrace-file)))))))) (path backtrace-file))))))))
(exit! 255))) (exit! 255)))
(defmacro doom-cli-redirect-output (context &rest body) (defmacro doom-cli-redirect-output (context &rest body)

68
lisp/doom-straight.el
View File

@ -198,40 +198,40 @@ original state.")
return (funcall func)) return (funcall func))
(print! (start "%s") (red prompt)) (print! (start "%s") (red prompt))
(print-group! (print-group!
(terpri) (terpri)
(let (recommended options) (let (recommended options)
(print-group! (print-group!
(print! " 1) Abort") (print! " 1) Abort")
(cl-loop for (_key desc func) in actions (cl-loop for (_key desc func) in actions
when desc when desc
do (push func options) do (push func options)
and do and do
(print! "%2s) %s" (1+ (length options)) (print! "%2s) %s" (1+ (length options))
(if (doom-straight--recommended-option-p prompt desc) (if (doom-straight--recommended-option-p prompt desc)
(progn (progn
(setq doom-straight--auto-options nil (setq doom-straight--auto-options nil
recommended (length options)) recommended (length options))
(green (concat desc " (Choose this if unsure)"))) (green (concat desc " (Choose this if unsure)")))
desc)))) desc))))
(terpri) (terpri)
(let* ((options (let* ((options
(cons (lambda () (cons (lambda ()
(let ((doom-output-indent 0)) (let ((doom-output-indent 0))
(terpri) (terpri)
(print! (warn "Aborted"))) (print! (warn "Aborted")))
(doom-cli--exit 1 doom-cli--context)) (doom-cli--exit 1 doom-cli--context))
(nreverse options))) (nreverse options)))
(prompt (prompt
(format! "How to proceed? (%s%s) " (format! "How to proceed? (%s%s) "
(mapconcat #'number-to-string (mapconcat #'number-to-string
(number-sequence 1 (length options)) (number-sequence 1 (length options))
", ") ", ")
(if (not recommended) "" (if (not recommended) ""
(format "; don't know? Pick %d" (1+ recommended))))) (format "; don't know? Pick %d" (1+ recommended)))))
answer fn) answer fn)
(while (null (nth (setq answer (1- (read-number prompt))) options)) (while (null (nth (setq answer (1- (read-number prompt))) options))
(print! (warn "%s is not a valid answer, try again.") answer)) (print! (warn "%s is not a valid answer, try again.") answer))
(funcall (nth answer options))))))))) (funcall (nth answer options)))))))))
(setq straight-arrow " > ") (setq straight-arrow " > ")
(defadvice! doom-straight--respect-print-indent-a (string &rest objects) (defadvice! doom-straight--respect-print-indent-a (string &rest objects)

66
lisp/lib/packages.el
View File

@ -86,36 +86,36 @@ package's name as a symbol, and whose CDR is the plist supplied to its
version))))) version)))))
(print! (start "Installing straight...")) (print! (start "Installing straight..."))
(print-group! (print-group!
(cl-destructuring-bind (depth . options) (cl-destructuring-bind (depth . options)
(ensure-list straight-vc-git-default-clone-depth) (ensure-list straight-vc-git-default-clone-depth)
(let ((branch-switch (if (memq 'single-branch options) (let ((branch-switch (if (memq 'single-branch options)
"--single-branch" "--single-branch"
"--no-single-branch"))) "--no-single-branch")))
(cond (cond
((eq 'full depth) ((eq 'full depth)
(funcall call "git" "clone" "--origin" "origin" (funcall call "git" "clone" "--origin" "origin"
branch-switch repo-url repo-dir)) branch-switch repo-url repo-dir))
((integerp depth) ((integerp depth)
(if (null pin) (if (null pin)
(progn (progn
(when (file-directory-p repo-dir) (when (file-directory-p repo-dir)
(delete-directory repo-dir 'recursive)) (delete-directory repo-dir 'recursive))
(funcall call "git" "clone" "--origin" "origin" repo-url (funcall call "git" "clone" "--origin" "origin" repo-url
"--no-checkout" repo-dir "--no-checkout" repo-dir
"--depth" (number-to-string depth) "--depth" (number-to-string depth)
branch-switch branch-switch
"--no-tags" "--no-tags"
"--branch" straight-repository-branch)) "--branch" straight-repository-branch))
(make-directory repo-dir 'recursive) (make-directory repo-dir 'recursive)
(let ((default-directory repo-dir)) (let ((default-directory repo-dir))
(funcall call "git" "init") (funcall call "git" "init")
(funcall call "git" "branch" "-m" straight-repository-branch) (funcall call "git" "branch" "-m" straight-repository-branch)
(funcall call "git" "remote" "add" "origin" repo-url (funcall call "git" "remote" "add" "origin" repo-url
"--master" straight-repository-branch) "--master" straight-repository-branch)
(funcall call "git" "fetch" "origin" pin (funcall call "git" "fetch" "origin" pin
"--depth" (number-to-string depth) "--depth" (number-to-string depth)
"--no-tags") "--no-tags")
(funcall call "git" "reset" "--hard" pin))))))))) (funcall call "git" "reset" "--hard" pin)))))))))
(require 'straight (concat repo-dir "/straight.el")) (require 'straight (concat repo-dir "/straight.el"))
(doom-log "Initializing recipes") (doom-log "Initializing recipes")
(mapc #'straight-use-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)) (when-let (local-repo (plist-get recipe :local-repo))
(setq repo local-repo))) (setq repo local-repo)))
(print-group! (print-group!
;; Only clone the package, don't build them. Straight hasn't been fully ;; Only clone the package, don't build them. Straight hasn't been fully
;; configured by this point. ;; configured by this point.
(straight-use-package name nil t)) (straight-use-package name nil t))
;; In case the package hasn't been built yet. ;; In case the package hasn't been built yet.
(or (member (directory-file-name (straight--build-dir (symbol-name name))) (or (member (directory-file-name (straight--build-dir (symbol-name name)))
load-path) load-path)

68
modules/config/literate/autoload.el
View File

@ -20,40 +20,40 @@
(dest (expand-file-name dest))) (dest (expand-file-name dest)))
(print! (start "Tangling your literate config...")) (print! (start "Tangling your literate config..."))
(print-group! (print-group!
(let (;; Do as little unnecessary work as possible in these org files. (let (;; Do as little unnecessary work as possible in these org files.
(org-startup-indented nil) (org-startup-indented nil)
(org-startup-folded nil) (org-startup-folded nil)
(vc-handled-backends nil) (vc-handled-backends nil)
;; Prevent unwanted entries in recentf, or formatters, or ;; Prevent unwanted entries in recentf, or formatters, or
;; anything that could be on these hooks, really. Nothing else ;; anything that could be on these hooks, really. Nothing else
;; should be touching these files (particularly in interactive ;; should be touching these files (particularly in interactive
;; sessions). ;; sessions).
(write-file-functions nil) (write-file-functions nil)
(before-save-hook nil) (before-save-hook nil)
(after-save-hook nil) (after-save-hook nil)
;; Prevent infinite recursion due to recompile-on-save hooks ;; Prevent infinite recursion due to recompile-on-save hooks
;; later, and speed up `org-mode' init. ;; later, and speed up `org-mode' init.
(org-mode-hook nil) (org-mode-hook nil)
(org-inhibit-startup t) (org-inhibit-startup t)
;; Allow evaluation of src blocks at tangle-time (would abort ;; Allow evaluation of src blocks at tangle-time (would abort
;; them otherwise). This is a security hazard, but Doom will ;; them otherwise). This is a security hazard, but Doom will
;; trust that you know what you're doing! ;; trust that you know what you're doing!
(org-confirm-babel-evaluate nil) (org-confirm-babel-evaluate nil)
;; Say a little more ;; Say a little more
(doom-print-message-level 'info)) (doom-print-message-level 'info))
(cond ((not (file-exists-p target)) (cond ((not (file-exists-p target))
(print! (warn "No org file at %s. Skipping...") (path target)) (print! (warn "No org file at %s. Skipping...") (path target))
nil) nil)
((with-temp-buffer ((with-temp-buffer
(insert-file-contents target) (insert-file-contents target)
(let ((case-fold-search t)) (let ((case-fold-search t))
(not (re-search-forward "^ *#\\+begin_src e\\(?:macs-\\)?lisp" nil t)))) (not (re-search-forward "^ *#\\+begin_src e\\(?:macs-\\)?lisp" nil t))))
(print! (warn "No src blocks to tangle in %s. Skipping...") (path target)) (print! (warn "No src blocks to tangle in %s. Skipping...") (path target))
nil) nil)
((if-let (files (org-babel-tangle-file target dest)) ((if-let (files (org-babel-tangle-file target dest))
(always (print! (success "Done tangling %d file(s)!" (length files)))) (always (print! (success "Done tangling %d file(s)!" (length files))))
(print! (error "Failed to tangle any blocks from your config.")) (print! (error "Failed to tangle any blocks from your config."))
nil)))))))) nil))))))))
(defun +literate-tangle--sync () (defun +literate-tangle--sync ()
"Tangles `+literate-config-file' if it has changed." "Tangles `+literate-config-file' if it has changed."