Add --discard switch to 'doom upgrade' #2224
Also rewrites straight prompt-in-batch-Emacs hack, and move it to core-cli.el.
This commit is contained in:
parent
15f2245b10
commit
f6852a2c9f
3 changed files with 118 additions and 95 deletions
|
@ -1,7 +1,8 @@
|
|||
;; -*- no-byte-compile: t; -*-
|
||||
;;; core/cli/packages.el
|
||||
|
||||
(defcli! (update u) ()
|
||||
(defcli! (update u)
|
||||
((discard-p ["--discard"] "All local changes to packages are discarded"))
|
||||
"Updates packages.
|
||||
|
||||
This works by fetching all installed package repos and checking the distance
|
||||
|
@ -10,10 +11,11 @@ between HEAD and FETCH_HEAD. This can take a while.
|
|||
This excludes packages whose `package!' declaration contains a non-nil :freeze
|
||||
or :ignore property."
|
||||
(straight-check-all)
|
||||
(doom-cli-reload-core-autoloads)
|
||||
(when (doom-cli-packages-update)
|
||||
(doom-cli-reload-package-autoloads))
|
||||
t)
|
||||
(let ((doom-auto-discard discard-p))
|
||||
(doom-cli-reload-core-autoloads)
|
||||
(when (doom-cli-packages-update)
|
||||
(doom-cli-reload-package-autoloads))
|
||||
t))
|
||||
|
||||
(defcli! (build b)
|
||||
((rebuild-p ["-r"] "Only rebuild packages that need rebuilding"))
|
||||
|
|
123
core/core-cli.el
123
core/core-cli.el
|
@ -1,17 +1,5 @@
|
|||
;;; -*- lexical-binding: t; no-byte-compile: t; -*-
|
||||
|
||||
(require 'seq)
|
||||
|
||||
;; Eagerly load these libraries because we may be in a session that hasn't been
|
||||
;; fully initialized (e.g. where autoloads files haven't been generated or
|
||||
;; `load-path' populated).
|
||||
(load! "autoload/cli")
|
||||
(load! "autoload/debug")
|
||||
(load! "autoload/files")
|
||||
(load! "autoload/format")
|
||||
(load! "autoload/plist")
|
||||
|
||||
|
||||
;;
|
||||
;;; Variables
|
||||
|
||||
|
@ -20,6 +8,9 @@
|
|||
commands like `doom-cli-packages-install', `doom-cli-packages-update' and
|
||||
`doom-packages-autoremove'.")
|
||||
|
||||
(defvar doom-auto-discard (getenv "FORCE")
|
||||
"If non-nil, discard all local changes while updating.")
|
||||
|
||||
(defvar doom--cli-p nil)
|
||||
(defvar doom--cli-commands (make-hash-table :test 'equal))
|
||||
(defvar doom--cli-groups (make-hash-table :test 'equal))
|
||||
|
@ -213,6 +204,114 @@ BODY will be run when this dispatcher is called."
|
|||
,@body))
|
||||
|
||||
|
||||
;;
|
||||
;;; Straight hacks
|
||||
|
||||
(defvar doom--cli-straight-discard-options
|
||||
'("^Delete remote \"[^\"]+\", re-create it with correct "
|
||||
"^Reset branch "
|
||||
"^Abort merge$"
|
||||
"^Discard changes$"))
|
||||
|
||||
;; 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 Replace GUI popup prompts (which hang indefinitely in tty Emacs) with
|
||||
;; simple prompts.
|
||||
(defadvice! doom--straight-fallback-to-y-or-n-prompt-a (orig-fn &optional prompt)
|
||||
:around #'straight-are-you-sure
|
||||
(or doom-auto-accept
|
||||
(if noninteractive
|
||||
(y-or-n-p (format! "%s" (or prompt "")))
|
||||
(funcall orig-fn prompt))))
|
||||
|
||||
(defadvice! doom--straight-fallback-to-tty-prompt-a (orig-fn prompt actions)
|
||||
"Modifies straight to prompt on the terminal when in noninteractive sessions."
|
||||
:around #'straight--popup-raw
|
||||
(if (not noninteractive)
|
||||
(funcall orig-fn prompt actions)
|
||||
;; 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 These are associated with opening dired or magit, which isn't
|
||||
;; possible in tty Emacs, so...
|
||||
(delq! "e" actions 'assoc)
|
||||
(delq! "g" actions 'assoc)
|
||||
(if doom-auto-discard
|
||||
(cl-loop with doom-auto-accept = t
|
||||
for (_key desc func) in actions
|
||||
when desc
|
||||
when (cl-find-if (doom-rpartial #'string-match-p desc)
|
||||
doom--cli-straight-discard-options)
|
||||
return (funcall func))
|
||||
(print! (start "%s") (red prompt))
|
||||
(print-group!
|
||||
(terpri)
|
||||
(let (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 (cl-find-if (doom-rpartial #'string-match-p desc)
|
||||
doom--cli-straight-discard-options)
|
||||
(concat desc " (Recommended)")
|
||||
desc))))
|
||||
(terpri)
|
||||
(let* ((options
|
||||
(cons (lambda ()
|
||||
(let ((doom-format-indent 0))
|
||||
(terpri)
|
||||
(print! (warn "Aborted")))
|
||||
(kill-emacs 1))
|
||||
(nreverse options)))
|
||||
(prompt
|
||||
(format! "How to proceed? (%s) "
|
||||
(mapconcat #'number-to-string
|
||||
(number-sequence 1 (length options))
|
||||
", ")))
|
||||
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))))))))
|
||||
|
||||
(defadvice! doom--straight-respect-print-indent-a (args)
|
||||
"Indent straight progress messages to respect `doom-format-indent', so we
|
||||
don't have to pass whitespace to `straight-use-package's fourth argument
|
||||
everywhere we use it (and internally)."
|
||||
:filter-args #'straight-use-package
|
||||
(cl-destructuring-bind
|
||||
(melpa-style-recipe &optional no-clone no-build cause interactive)
|
||||
args
|
||||
(list melpa-style-recipe no-clone no-build
|
||||
(if (and (not cause)
|
||||
(boundp 'doom-format-indent)
|
||||
(> doom-format-indent 0))
|
||||
(make-string (1- (or doom-format-indent 1)) 32)
|
||||
cause)
|
||||
interactive)))
|
||||
|
||||
|
||||
;;
|
||||
;;; Dependencies
|
||||
|
||||
(require 'seq)
|
||||
|
||||
;; Eagerly load these libraries because we may be in a session that hasn't been
|
||||
;; fully initialized (e.g. where autoloads files haven't been generated or
|
||||
;; `load-path' populated).
|
||||
(load! "autoload/cli")
|
||||
(load! "autoload/debug")
|
||||
(load! "autoload/files")
|
||||
(load! "autoload/format")
|
||||
(load! "autoload/plist")
|
||||
|
||||
|
||||
;;
|
||||
;;; CLI Commands
|
||||
|
||||
|
|
|
@ -124,84 +124,6 @@ missing) and shouldn't be deleted.")
|
|||
;; We handle it ourselves
|
||||
straight-fix-org nil)
|
||||
|
||||
;;; Getting straight to behave in batch mode
|
||||
(when noninteractive
|
||||
;; 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 Replace GUI popup prompts (which hang indefinitely in tty Emacs) with
|
||||
;; simple prompts.
|
||||
(defadvice! doom--straight-fallback-to-y-or-n-prompt-a (orig-fn &optional prompt)
|
||||
:around #'straight-are-you-sure
|
||||
(if noninteractive
|
||||
(y-or-n-p (format! "%s" (or prompt "")))
|
||||
(funcall orig-fn prompt)))
|
||||
|
||||
(defvar doom--straight-recommended-options
|
||||
'("^Delete remote \"[^\"]+\", re-create it with correct "
|
||||
"^Reset branch "
|
||||
"^Abort merge$"))
|
||||
|
||||
(defadvice! doom--straight-fallback-to-tty-prompt-a (orig-fn prompt actions)
|
||||
"Modifies straight to prompt on the terminal when in noninteractive sessions."
|
||||
:around #'straight--popup-raw
|
||||
(if (not noninteractive)
|
||||
(funcall orig-fn prompt actions)
|
||||
;; We can't intercept C-g, so no point displaying any options for this key
|
||||
;; Just use C-c
|
||||
(delq! "C-g" actions 'assoc)
|
||||
;; HACK These are associated with opening dired or magit, which isn't
|
||||
;; possible in tty Emacs, so...
|
||||
(delq! "e" actions 'assoc)
|
||||
(delq! "g" actions 'assoc)
|
||||
(let ((options (list (lambda ()
|
||||
(let ((doom-format-indent 0))
|
||||
(terpri)
|
||||
(print! (error "Aborted")))
|
||||
(kill-emacs)))))
|
||||
(print! (start "%s") (red prompt))
|
||||
(terpri)
|
||||
(print-group!
|
||||
(print-group!
|
||||
(print! " 1) Abort")
|
||||
(dolist (action actions)
|
||||
(cl-destructuring-bind (_key desc func) action
|
||||
(when desc
|
||||
(push func options)
|
||||
(cl-loop for regexp in doom--straight-recommended-options
|
||||
if (string-match-p regexp desc)
|
||||
return (setq desc (concat desc " (Recommended)")))
|
||||
(print! "%2s) %s" (length options) desc)))))
|
||||
(terpri)
|
||||
(let ((options (nreverse options))
|
||||
answer fn)
|
||||
(while
|
||||
(not
|
||||
(setq
|
||||
fn (ignore-errors
|
||||
(nth (1- (setq answer
|
||||
(read-number
|
||||
(format! "How to proceed? (%s) "
|
||||
(mapconcat #'number-to-string
|
||||
(number-sequence 1 (length options))
|
||||
", ")))))
|
||||
options))))
|
||||
(print! (warn "%s is not a valid answer, try again.") answer))
|
||||
(funcall fn))))))
|
||||
|
||||
(defadvice! doom--straight-respect-print-indent-a (args)
|
||||
:filter-args #'straight-use-package
|
||||
(cl-destructuring-bind
|
||||
(melpa-style-recipe &optional no-clone no-build cause interactive)
|
||||
args
|
||||
(list melpa-style-recipe no-clone no-build
|
||||
(if (and (not cause)
|
||||
(boundp 'doom-format-indent)
|
||||
(> doom-format-indent 0))
|
||||
(make-string (1- (or doom-format-indent 1)) 32)
|
||||
cause)
|
||||
interactive)))
|
||||
|
||||
|
||||
;;
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue