mirror of
https://github.com/doomemacs/doomemacs
synced 2025-08-03 12:27:26 -05:00
refactor: remove redundant straight hacks
These were moved to doom-straight and renamed in8cafbe4. Amend:8cafbe4408
This commit is contained in:
Henrik Lissner
@ -666,229 +666,5 @@ If ELPA-P, include packages installed with package.el (M-x package-install)."
|
|||||||
(ignore (print! (item "Skipping native bytecode")))
|
(ignore (print! (item "Skipping native bytecode")))
|
||||||
(doom-packages--purge-eln))))))))
|
(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)
|
(provide 'doom-cli-packages)
|
||||||
;;; packages.el ends here
|
;;; packages.el ends here
|
||||||
|
|||||||
Reference in New Issue
Block a user