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

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

core/cli/packages.el

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

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
 

core/core-packages.el

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