diff --git a/lisp/cli/ci.el b/lisp/cli/ci.el index b0b515662..ef997908e 100644 --- a/lisp/cli/ci.el +++ b/lisp/cli/ci.el @@ -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!")) diff --git a/lisp/cli/doctor.el b/lisp/cli/doctor.el index 4866f724e..788527eea 100644 --- a/lisp/cli/doctor.el +++ b/lisp/cli/doctor.el @@ -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! diff --git a/lisp/cli/env.el b/lisp/cli/env.el index 6d06f9136..5ed36b669 100644 --- a/lisp/cli/env.el +++ b/lisp/cli/env.el @@ -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." diff --git a/lisp/cli/gc.el b/lisp/cli/gc.el new file mode 100644 index 000000000..bc989103a --- /dev/null +++ b/lisp/cli/gc.el @@ -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 diff --git a/lisp/cli/install.el b/lisp/cli/install.el index 0852b7b67..ce032c1d9 100644 --- a/lisp/cli/install.el +++ b/lisp/cli/install.el @@ -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!"))) diff --git a/lisp/cli/run.el b/lisp/cli/run.el index 8819f3e3c..81b2f503c 100644 --- a/lisp/cli/run.el +++ b/lisp/cli/run.el @@ -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) diff --git a/lisp/cli/upgrade.el b/lisp/cli/upgrade.el index e2eac21d2..6a1715723 100644 --- a/lisp/cli/upgrade.el +++ b/lisp/cli/upgrade.el @@ -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)))))) diff --git a/lisp/doom-cli.el b/lisp/doom-cli.el index 7eea56e5b..83b93f5cf 100644 --- a/lisp/doom-cli.el +++ b/lisp/doom-cli.el @@ -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) diff --git a/lisp/doom-straight.el b/lisp/doom-straight.el index 13549fa35..64593c990 100644 --- a/lisp/doom-straight.el +++ b/lisp/doom-straight.el @@ -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) diff --git a/lisp/lib/packages.el b/lisp/lib/packages.el index b2929d6b0..6e0dfc282 100644 --- a/lisp/lib/packages.el +++ b/lisp/lib/packages.el @@ -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) diff --git a/modules/config/literate/autoload.el b/modules/config/literate/autoload.el index 02f792aad..5b52f467e 100644 --- a/modules/config/literate/autoload.el +++ b/modules/config/literate/autoload.el @@ -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."