diff --git a/lisp/cli/packages.el b/lisp/cli/packages.el index 7543ac66b..f7dbf9f2c 100644 --- a/lisp/cli/packages.el +++ b/lisp/cli/packages.el @@ -666,229 +666,5 @@ If ELPA-P, include packages installed with package.el (M-x package-install)." (ignore (print! (item "Skipping native bytecode"))) (doom-packages--purge-eln)))))))) - -;; -;;; Hacks - -;; Straight was designed primarily for interactive use, in an interactive Emacs -;; session, but Doom does its package management in the terminal. Some things -;; must be modified get straight to behave and improve its UX for our users. - -(defvar doom-cli--straight-auto-options - '(("has diverged from" - . "^Reset [^ ]+ to ") - ("but recipe specifies a URL of" - . "Delete remote \"[^\"]+\", re-create it with correct URL") - ("has a merge conflict:" - . "^Abort merge$") - ("has a dirty worktree:" - . "^Discard changes$") - ("^In repository \"[^\"]+\", [^ ]+ (on branch \"main\") is ahead of default branch \"master\"" - . "^Checkout branch \"master\"") - ("^In repository \"[^\"]+\", [^ ]+ (on branch \"[^\"]+\") is ahead of default branch \"[^\"]+\"" - . "^Checkout branch \"") - ("^In repository " - . "^Reset branch \\|^Delete remote [^,]+, re-create it with correct URL\\|^Checkout \"")) - "A list of regexps, mapped to regexps. - -Their CAR is tested against the prompt, and CDR is tested against the presented -option, and is used by `straight-vc-git--popup-raw' to select which option to -recommend. - -It may not be obvious to users what they should do for some straight prompts, -so Doom will recommend the one that reverts a package back to its (or target) -original state.") - -;; HACK Remove dired & magit options from prompt, since they're inaccessible in -;; noninteractive sessions. -(advice-add #'straight-vc-git--popup-raw :override #'straight--popup-raw) - -;; HACK: `native-comp' only respects `native-comp-jit-compilation-deny-list' -;; when native-compiling packages in interactive sessions. It ignores the -;; variable when, say, straight is building packages. This advice forces it to -;; obey it, even when used by straight (but only in the CLI). -(defadvice! doom-cli--native--compile-async-skip-p (fn files &optional recursively load selector) - :around #'native-compile-async - (let (file-list) - (dolist (file-or-dir (ensure-list files)) - (cond ((file-directory-p file-or-dir) - (dolist (file (if recursively - (directory-files-recursively - file-or-dir comp-valid-source-re) - (directory-files file-or-dir - t comp-valid-source-re))) - (push file file-list))) - ((file-exists-p file-or-dir) - (push file-or-dir file-list)) - ((signal 'native-compiler-error - (list "Not a file nor directory" file-or-dir))))) - (funcall fn (seq-remove (lambda (file) - (seq-some (lambda (re) (string-match-p re file)) - native-comp-deferred-compilation-deny-list)) - file-list) - recursively load selector))) - -;; HACK Replace GUI popup prompts (which hang indefinitely in tty Emacs) with -;; simple prompts. -(defadvice! doom-cli--straight-fallback-to-y-or-n-prompt-a (fn &optional prompt noprompt?) - :around #'straight-are-you-sure - (or noprompt? - (if noninteractive - (y-or-n-p (format! "%s" (or prompt ""))) - (funcall fn prompt)))) - -(defun doom-cli--straight-recommended-option-p (prompt option) - (cl-loop for (prompt-re . opt-re) in doom-cli--straight-auto-options - if (string-match-p prompt-re prompt) - return (string-match-p opt-re option))) - -(defadvice! doom-cli--straight-no-compute-prefixes-a (fn &rest args) - :around #'straight--build-autoloads - (let (autoload-compute-prefixes) - (apply fn args))) - -(defadvice! doom-cli--straight-suppress-confirm-a (&rest _) - :before-until #'straight-are-you-sure - (and (bound-and-true-p doom-cli--context) - (doom-cli-context-suppress-prompts-p doom-cli--context))) - -(defadvice! doom-cli--straight-fallback-to-tty-prompt-a (fn prompt actions) - "Modifies straight to prompt on the terminal when in noninteractive sessions." - :around #'straight--popup-raw - (if (bound-and-true-p async-in-child-emacs) - (error "Straight prompt: %s" prompt) - (let ((doom-cli--straight-auto-options doom-cli--straight-auto-options)) - ;; We can't intercept C-g, so no point displaying any options for this key - ;; when C-c is the proper way to abort batch Emacs. - (delq! "C-g" actions 'assoc) - ;; HACK: Remove actions that don't work in noninteractive Emacs (like - ;; opening dired or magit). - (setq actions - (cl-remove-if (lambda (o) - (string-match-p "^\\(?:Magit\\|Dired\\)" (nth 1 o))) - actions)) - (if (doom-cli-context-suppress-prompts-p doom-cli--context) - (cl-loop for (_key desc func) in actions - when desc - when (doom-cli--straight-recommended-option-p prompt desc) - 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-cli--straight-recommended-option-p prompt desc) - (progn - (setq doom-cli--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-cli--straight-respect-print-indent-a (string &rest objects) - "Same as `message' (which see for STRING and OBJECTS) normally. -However, in batch mode, print to stdout instead of stderr." - :override #'straight--output - (let ((msg (apply #'format string objects))) - (save-match-data - (when (string-match (format "^%s\\(.+\\)$" (regexp-quote straight-arrow)) msg) - (setq msg (match-string 1 msg)))) - (and (string-match-p "^\\(Cloning\\|\\(Reb\\|B\\)uilding\\) " msg) - (not (string-suffix-p "...done" msg)) - (doom-print (concat "> " msg) :format t)))) - -(defadvice! doom-cli--straight-ignore-gitconfig-a (fn &rest args) - "Prevent user and system git configuration from interfering with git calls." - :around #'straight--process-call - (with-environment-variables - (("GIT_CONFIG" nil) - ("GIT_CONFIG_NOSYSTEM" "1") - ("GIT_CONFIG_GLOBAL" (or (getenv "DOOMGITCONFIG") - "/dev/null"))) - (apply fn args))) - -;; If the repo failed to clone correctly (usually due to a connection failure), -;; straight proceeds as normal until a later call produces a garbage result -;; (typically, when it fails to fetch the remote branch of the empty directory). -;; This causes Straight to throw an otherwise cryptic type error when it tries -;; to sanitize the result for its log buffer. -;; -;; This error is a common source of user confusion and false positive bug -;; reports, so this advice catches them to regurgitates a more cogent -;; explanation. -(defadvice! doom-cli--straight-throw-error-on-no-branch-a (fn &rest args) - :around #'straight--process-log - (letf! ((defun shell-quote-argument (&rest args) - (unless (car args) - (error "Package was not properly cloned due to a connection failure, please try again later")) - (apply shell-quote-argument args))) - (apply fn args))) - -(defadvice! doom-cli--straight-regurgitate-empty-string-error-a (fn &rest args) - :around #'straight-vc-git-local-repo-name - (condition-case-unless-debug e - (apply fn args) - (wrong-type-argument - (if (eq (cadr e) 'stringp) - (error "Package was not properly cloned due to a connection failure, please try again later") - (signal (car e) (cdr e)))))) - -;; HACK: Fix an issue where straight wasn't byte-compiling some packages (or -;; some files in packages) due to missing (invisible) dependencies. -(defadvice! doom-cli--straight-byte-compile-a (recipe) - "See https://github.com/radian-software/straight.el/pull/1132" - :override #'straight--build-compile - (let* ((pkg (plist-get recipe :package)) - (dir (straight--build-dir pkg)) - (emacs (concat invocation-directory invocation-name)) - (buffer straight-byte-compilation-buffer) - (deps - (let (tmp) - (dolist (dep (straight--flatten (straight-dependencies pkg)) tmp) - (let ((build-dir (straight--build-dir dep))) - (when (file-exists-p build-dir) - (push build-dir tmp)))))) - (print-circle nil) - (print-length nil) - (program - (format "%S" `(let ((default-directory ,(straight--build-dir)) - (lp load-path)) - (setq load-path (list default-directory)) - (normal-top-level-add-subdirs-to-load-path) - (setq load-path (append '(,dir) ',deps load-path lp)) - (byte-recompile-directory ,dir 0 'force)))) - (args (list "-Q" "--batch" "--eval" program))) - (when buffer - (with-current-buffer (get-buffer-create buffer) - (insert (format "\n$ %s %s \\\n %S\n" emacs - (string-join (butlast args) " ") - program)))) - (apply #'call-process `(,emacs nil ,buffer nil ,@args)))) - (provide 'doom-cli-packages) ;;; packages.el ends here