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:
Henrik Lissner 2020-01-09 03:31:05 -05:00
parent 15f2245b10
commit f6852a2c9f
No known key found for this signature in database
GPG key ID: 5F6C0EA160557395
3 changed files with 118 additions and 95 deletions

View file

@ -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)
(let ((doom-auto-discard discard-p))
(doom-cli-reload-core-autoloads)
(when (doom-cli-packages-update)
(doom-cli-reload-package-autoloads))
t)
t))
(defcli! (build b)
((rebuild-p ["-r"] "Only rebuild packages that need rebuilding"))

View file

@ -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

View file

@ -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)))
;;