Add --discard switch to 'doom upgrade' #2224

Also rewrites straight prompt-in-batch-Emacs hack, and move it to
core-cli.el.

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