Reorganize CLI libraries

bin/doom

@@ -23,77 +23,64 @@
         (expand-file-name
          "../" (file-name-directory (file-truename load-file-name)))))
 
-;; Handle some potential issues early
-(when (version< emacs-version "26.1")
-  (error (concat "Detected Emacs %s (at %s).\n\n"
-                 "Doom only supports Emacs 26.1 and newer. 27.1 is highly recommended. A guide\n"
-                 "to install a newer version of Emacs can be found at:\n\n  "
-                 (cond ((eq system-type 'darwin)
-                        "https://github.com/hlissner/doom-emacs/blob/develop/docs/getting_started.org#on-macos")
-                       ((memq system-type '(cygwin windows-nt ms-dos))
-                        "https://github.com/hlissner/doom-emacs/blob/develop/docs/getting_started.org#on-windows")
-                       ("https://github.com/hlissner/doom-emacs/blob/develop/docs/getting_started.org#on-linux"))
-                 "Aborting...")
-         emacs-version
-         (car command-line-args)))
-
-(unless (file-exists-p (expand-file-name "core/core.el" user-emacs-directory))
-  (error (concat "Couldn't find Doom Emacs in %S.\n\n"
-                 "This is likely because this script (or its parent directory) is a symlink.\n"
-                 "If you must use a symlink, you'll need to specify an EMACSDIR so Doom knows\n"
-                 "where to find itself. e.g.\n\n    "
-                 (if (string-match-p "/fish$" (getenv "SHELL"))
-                     "env EMACSDIR=~/.emacs.d doom"
-                   "EMACSDIR=~/.emacs.d doom sync")
-                 "\n\n"
-                 "Aborting...")
-         (abbreviate-file-name user-emacs-directory)
-         (abbreviate-file-name load-file-name)))
-
-(when (and (equal (user-real-uid) 0)
-           (not (file-in-directory-p user-emacs-directory "/root")))
-  (error (concat "This script is running as root. This likely wasn't intentional and\n"
-                 "will cause file permissions errors later if this Doom install is\n"
-                 "ever used on a non-root account.\n\n"
-                 "Aborting...")))
-
-;; HACK Load `cl' and site files manually to prevent polluting logs and stdout
-;;      with deprecation and/or file load messages.
-(let ((inhibit-message t))
-  (when (> emacs-major-version 26)
-    (require 'cl))
-  (unless site-run-file
-    (let ((tail load-path))
-      (while tail
-        (let ((default-directory (car tail)))
-          (load (expand-file-name "subdirs.el") t t t)
-          (setq tail (cdr tail)))))
-    (load "site-start" t t)))
-
-;; Load the heart of the beast and its CLI processing library
-(load (expand-file-name "core/core.el" user-emacs-directory) nil t)
-(require 'core-cli)
-
-;; I use our own home-grown debugger so we can capture and store backtraces,
-;; make them more presentable, and make it easier for users to produce better
-;; bug reports!
-(setq debugger #'doom-cli--debugger
-      debug-on-error t
-      debug-ignored-errors nil)
-
 (kill-emacs
  (pcase
      (catch 'exit
-       ;; Process the arguments passed to this script. `doom-cli-execute' should
+       ;; Catch some potential issues early
-       ;; return a boolean, integer (error code) or throw an 'exit event, which
+       (cond
-       ;; we handle specially.
+        ((version< emacs-version "26.3")
-       (apply #'doom-cli-execute :doom (cdr (member "--" argv))))
+         (princ (concat "Detected Emacs " emacs-version " (at " (car command-line-args) ").\n\n"))
+         (princ "Doom only supports Emacs 26.3 and newer. 27.1 is highly recommended. A guide\n")
+         (princ "to install a newer version of Emacs can be found at:\n\n  ")
+         (princ (format "https://doomemacs.org/docs/getting_started.org#%s"
+                        (cond ((eq system-type 'darwin) "on-macos")
+                              ((memq system-type '(cygwin windows-nt ms-dos)) "on-windows")
+                              ("on-linux"))))
+         (princ "Aborting...")
+         1)
+
+        ((not (file-readable-p (expand-file-name "core/core.el" user-emacs-directory)))
+         (princ (concat "Couldn't find or read '"
+                        (abbreviate-file-name
+                         (expand-file-name "core/core.el" user-emacs-directory))
+                        "'.\n\n"))
+         (princ "Are you sure Doom Emacs is correctly installed?\n\n")
+         (when (file-symlink-p load-file-name)
+           (princ "This error can occur if you've symlinked the 'doom' script, which Doom does not\n")
+           (princ "support. Consider symlinking its parent directory instead or explicitly set the\n")
+           (princ "EMACSDIR environment variable, e.g.\n\n  ")
+           (princ (if (string-match-p "/fish$" (getenv "SHELL"))
+                      "env EMACSDIR=~/.emacs.d doom"
+                    "EMACSDIR=~/.emacs.d doom sync"))
+           (princ "\n\n")
+           (princ "Aborting..."))
+         2)
+
+        ((and (equal (user-real-uid) 0)
+              (/= 0 (file-attribute-user-id (file-attributes user-emacs-directory))))
+         (princ "Do not run this script as root. It will cause file permissions errors later.\n\n")
+         (princ "To carry on anyway, change the owner of your Emacs config to root:\n\n")
+         (princ (concat "  chown root:root -R " (abbreviate-file-name user-emacs-directory) "\n\n"))
+         (princ "Aborting...")
+         3)
+
+        ;; Load the heart of the beast and its CLI processing library
+        ((load (expand-file-name "core/core.el" user-emacs-directory) nil t)
+         (require 'core-cli)
+
+         ;; Process the arguments passed to this script. `doom-cli-execute'
+         ;; should return a boolean, integer (error code) or throw an 'exit
+         ;; event, which is handled specially.
+         (apply #'doom-cli-execute :doom (cdr (member "--" argv))))))
+
    ;; Any non-zero integer is treated as an explicit exit code.
-   ((and (pred integerp) code) code)
+   ((and (pred integerp) code)
+    code)
+
    ;; If, instead, we were given a string or list of strings, copy these as
    ;; shell script commands to a temporary script file which this script will
    ;; execute after this session finishes. Also accepts special keywords, like
-   ;; `:restart', to rerun the current command.
+   ;; `:restart', to rerun the current command with the same arguments.
    ((and (or (pred consp)
              (pred stringp)
              (pred keywordp))
@@ -105,10 +92,8 @@
         (insert "#!/usr/bin/env sh\n"
                 "_postscript() {\n"
                 "  rm -f " (shell-quote-argument script) "\n  "
-                (cond ((eq command :restart)
+                (cond ((eq command :restart) "$@")
-                       "$@")
+                      ((stringp command) command)
-                      ((stringp command)
-                       command)
                       ((string-join
                         (if (listp (car-safe command))
                             (cl-loop for line in (doom-enlist command)
@@ -131,6 +116,7 @@
     ;; Error code 128 is special: it means run the post-script after this
     ;; session ends.
     128)
+
    ;; Anything else (e.g. booleans) is treated as a successful run. Yes, a `nil'
    ;; indicates a successful run too!
    (_ 0)))

core/cli/lib/debugger.el

@@ -0,0 +1,61 @@
+;;; core/cli/debugger.el -*- lexical-binding: t; -*-
+
+(cl-defun doom-cli--debugger (error data)
+  (cl-incf num-nonmacro-input-events)
+  (cl-destructuring-bind (backtrace &optional type data . _)
+      (cons (doom-cli--backtrace) data)
+    (with-output-to! doom--cli-log-buffer
+      (let ((straight-error-p
+             (and (bound-and-true-p straight-process-buffer)
+                  (string-match-p (regexp-quote straight-process-buffer)
+                                  (or (get type 'error-message) "")))))
+        (cond (straight-error-p
+               (print! (error "There was an unexpected package error"))
+               (when-let (output (straight--process-get-output))
+                 (print-group!
+                  (print! "%s" (string-trim output)))))
+              ((print! (error "There was an unexpected error"))
+               (print-group!
+                (print! "%s %s" (bold "Message:") (get type 'error-message))
+                (print! "%s %S" (bold "Data:") (cons type data))
+                (when backtrace
+                  (print! (bold "Backtrace:"))
+                  (print-group!
+                   (dolist (frame (seq-take backtrace 10))
+                     (print!
+                      "%0.74s" (replace-regexp-in-string
+                                "[\n\r]" "\\\\n"
+                                (format "%S" frame)))))))))
+        (when backtrace
+          (with-temp-file doom-cli-log-error-file
+            (insert "# -*- lisp-interaction -*-\n")
+            (insert "# vim: set ft=lisp:\n")
+            (let ((standard-output doom--cli-log-error-buffer)
+                  (print-quoted t)
+                  (print-escape-newlines t)
+                  (print-escape-control-characters t)
+                  (print-level nil)
+                  (print-circle nil))
+              (when straight-error-p
+                (print (string-trim (or (straight--process-get-output) ""))))
+              (mapc #'print (cons (list type data) backtrace)))
+            (print! (warn "Extended backtrace logged to %s")
+                    (relpath doom-cli-log-error-file)))))))
+  (throw 'exit 255))
+
+(defun doom-cli--backtrace ()
+  (let* ((n 0)
+         (frame (backtrace-frame n))
+         (frame-list nil)
+         (in-program-stack nil))
+    (while frame
+      (when in-program-stack
+        (push (cdr frame) frame-list))
+      (when (eq (elt frame 1) 'doom-cli--debugger)
+        (setq in-program-stack t))
+      (when (and (eq (elt frame 1) 'doom-cli-execute)
+                 (eq (elt frame 2) :doom))
+        (setq in-program-stack nil))
+      (setq n (1+ n)
+            frame (backtrace-frame n)))
+    (reverse frame-list)))

core/cli/lib/lib.el

@@ -0,0 +1,185 @@
+;;; core/cli/lib.el --- -*- lexical-binding: t; no-byte-compile: t; -*-
+
+(cl-defstruct
+    (doom-cli
+     (:constructor nil)
+     (:constructor
+      make-doom-cli
+      (name &key desc aliases optlist arglist plist fn
+            &aux
+            (optlist
+             (cl-loop for (symbol options desc) in optlist
+                      for ((_ . options) (_ . params))
+                      = (seq-group-by #'stringp options)
+                      collect
+                      (make-doom-cli-option :symbol symbol
+                                            :flags options
+                                            :args params
+                                            :desc desc))))))
+  (name nil :read-only t)
+  (desc "TODO")
+  aliases
+  optlist
+  arglist
+  plist
+  (fn (lambda (_) (print! "But nobody came!"))))
+
+(cl-defstruct doom-cli-option
+  (symbol)
+  (flags ())
+  (args ())
+  (desc "TODO"))
+
+(defun doom--cli-get-option (cli flag)
+  (cl-find-if (doom-partial #'member flag)
+              (doom-cli-optlist cli)
+              :key #'doom-cli-option-flags))
+
+(defun doom--cli-process (cli args)
+  (let* ((args (copy-sequence args))
+         (arglist (copy-sequence (doom-cli-arglist cli)))
+         (expected
+          (or (cl-position-if (doom-rpartial #'memq cl--lambda-list-keywords)
+                              arglist)
+              (length arglist)))
+         (got 0)
+         restvar
+         rest
+         alist)
+    (catch 'done
+      (while args
+        (let ((arg (pop args)))
+          (cond ((eq (car arglist) '&rest)
+                 (setq restvar (cadr arglist)
+                       rest (cons arg args))
+                 (throw 'done t))
+
+                ((string-match "^\\(--\\([a-zA-Z0-9][a-zA-Z0-9-_]*\\)\\)\\(?:=\\(.+\\)\\)?$" arg)
+                 (let* ((fullflag (match-string 1 arg))
+                        (opt (doom--cli-get-option cli fullflag)))
+                   (unless opt
+                     (user-error "Unrecognized switch %S" (concat "--" (match-string 2 arg))))
+                   (setf (alist-get (doom-cli-option-symbol opt) alist)
+                         (or (if (doom-cli-option-args opt)
+                                 (or (match-string 3 arg)
+                                     (pop args)
+                                     (user-error "%S expected an argument, but got none"
+                                                 fullflag))
+                               (if (match-string 3 arg)
+                                   (user-error "%S was not expecting an argument, but got %S"
+                                               fullflag (match-string 3 arg))
+                                 fullflag))))))
+
+                ((string-match "^\\(-\\([a-zA-Z0-9]+\\)\\)$" arg)
+                 (let ((fullflag (match-string 1 arg))
+                       (flag     (match-string 2 arg)))
+                   (dolist (switch (split-string flag "" t))
+                     (if-let (opt (doom--cli-get-option cli (concat "-" switch)))
+                         (setf (alist-get (doom-cli-option-symbol opt) alist)
+                               (if (doom-cli-option-args opt)
+                                   (or (pop args)
+                                       (user-error "%S expected an argument, but got none"
+                                                   fullflag))
+                                 fullflag))
+                       (user-error "Unrecognized switch %S" (concat "-" switch))))))
+
+                (arglist
+                 (cl-incf got)
+                 (let ((spec (pop arglist)))
+                   (when (eq spec '&optional)
+                     (setq spec (pop arglist)))
+                   (setf (alist-get spec alist) arg))
+                 (when (null arglist)
+                   (throw 'done t)))
+
+                (t
+                 (push arg args)
+                 (throw 'done t))))))
+    (when (< got expected)
+      (error "Expected %d arguments, got %d" expected got))
+    (when rest
+      (setf (alist-get restvar alist) rest))
+    alist))
+
+(defun doom-cli-get (command)
+  "Return a CLI object associated by COMMAND name (string)."
+  (cond ((null command) nil)
+        ((doom-cli-p command) command)
+        ((doom-cli-get
+          (gethash (cond ((symbolp command) command)
+                         ((stringp command) (intern command))
+                         (command))
+                   doom--cli-commands)))))
+
+(defun doom-cli-internal-p (cli)
+  "Return non-nil if CLI is an internal (non-public) command."
+  (string-prefix-p ":" (doom-cli-name cli)))
+
+(defun doom-cli-execute (command &rest args)
+  "Execute COMMAND (string) with ARGS (list of strings).
+
+Executes a cli defined with `defcli!' with the name or alias specified by
+COMMAND, and passes ARGS to it."
+  (if-let (cli (doom-cli-get command))
+      (funcall (doom-cli-fn cli)
+               (doom--cli-process cli (remq nil args)))
+    (user-error "Couldn't find any %S command" command)))
+
+(defmacro defcli! (name speclist &optional docstring &rest body)
+  "Defines a CLI command.
+
+COMMAND is a symbol or a list of symbols representing the aliases for this
+command. DOCSTRING is a string description; its first line should be short
+(under 60 characters), as it will be used as a summary for 'doom help'.
+
+SPECLIST is a specification for options and arguments, which can be a list
+specification for an option/switch in the following format:
+
+  (VAR [FLAGS... ARGS...] DESCRIPTION)
+
+Otherwise, SPECLIST accepts the same argument specifiers as `defun'.
+
+BODY will be run when this dispatcher is called."
+  (declare (indent 2) (doc-string 3))
+  (unless (stringp docstring)
+    (push docstring body)
+    (setq docstring "TODO"))
+  (let ((names (doom-enlist name))
+        (optlist (cl-remove-if-not #'listp speclist))
+        (arglist (cl-remove-if #'listp speclist))
+        (plist (cl-loop for (key val) on body by #'cddr
+                        if (keywordp key)
+                        nconc (list key val) into plist
+                        else return plist)))
+    `(let ((name ',(car names))
+           (aliases ',(cdr names))
+           (plist ',plist))
+       (when doom--cli-group
+         (setq plist (plist-put plist :group doom--cli-group)))
+       (puthash
+        name
+        (make-doom-cli (symbol-name name)
+                       :desc ,docstring
+                       :aliases (mapcar #'symbol-name aliases)
+                       :arglist ',arglist
+                       :optlist ',optlist
+                       :plist plist
+                       :fn
+                       (lambda (--alist--)
+                         (ignore --alist--)
+                         (let ,(cl-loop for opt in speclist
+                                        for optsym = (if (listp opt) (car opt) opt)
+                                        unless (memq optsym cl--lambda-list-keywords)
+                                        collect (list optsym `(cdr (assq ',optsym --alist--))))
+                           ,@body)))
+        doom--cli-commands)
+       (when aliases
+         (mapc (doom-rpartial #'puthash name doom--cli-commands)
+               aliases)))))
+
+(defmacro defcligroup! (name docstring &rest body)
+  "Declare all enclosed cli commands are part of the NAME group."
+  (declare (indent defun) (doc-string 2))
+  `(let ((doom--cli-group ,name))
+     (puthash doom--cli-group ,docstring doom--cli-groups)
+     ,@body))

core/cli/lib/straight-hacks.el

@@ -0,0 +1,123 @@
+;;; core/cli/straight-hacks.el --- -*- lexical-binding: t; no-byte-compile: t; -*-
+
+;; 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--straight-auto-options
+  '(("has diverged from"
+     . "^Reset [^ ]+ to branch")
+    ("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"))
+  "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 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 doom-interactive-p
+          (funcall orig-fn prompt)
+        (y-or-n-p (format! "%s" (or prompt ""))))))
+
+(defun doom--straight-recommended-option-p (prompt option)
+  (cl-loop for (prompt-re . opt-re) in doom--straight-auto-options
+           if (string-match-p prompt-re prompt)
+           return (string-match-p opt-re option)))
+
+(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 doom-interactive-p
+      (funcall orig-fn prompt actions)
+    (let ((doom--straight-auto-options doom--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 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 (doom--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--straight-recommended-option-p prompt desc)
+                                 (progn
+                                   (setq doom--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")))
+                           (kill-emacs 1))
+                         (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)))))))))
+
+(defadvice! doom--straight-respect-print-indent-a (args)
+  "Indent straight progress messages to respect `doom-output-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-output-indent)
+                   (> doom-output-indent 0))
+              (make-string (1- (or doom-output-indent 1)) 32)
+            cause)
+          interactive)))

core/core-cli.el

@@ -1,33 +1,5 @@
 ;;; core/core-cli.el --- -*- lexical-binding: t; no-byte-compile: t; -*-
 
-(load! "autoload/process")
-(load! "autoload/plist")
-(load! "autoload/files")
-(load! "autoload/output")
-(load! "autoload/system")
-(require 'seq)
-
-;; Create all our core directories to quell file errors.
-(mapc (doom-rpartial #'make-directory 'parents)
-      (list doom-local-dir
-            doom-etc-dir
-            doom-cache-dir))
-
-;; Ensure straight and the bare minimum is ready to go
-(require 'core-modules)
-(require 'core-packages)
-(doom-initialize-core-packages)
-
-;; Don't generate superfluous files when writing temp buffers
-(setq make-backup-files nil)
-
-;; Stop user configuration from interfering with package management
-(setq enable-dir-local-variables nil)
-
-
-;;
-;;; Variables
-
 (defvar doom-auto-accept (getenv "YES")
   "If non-nil, Doom will auto-accept any confirmation prompts during batch
 commands like `doom-cli-packages-install', `doom-cli-packages-update' and
@@ -44,11 +16,13 @@ additional CLI commands, or reconfigure existing ones to better suit their
 purpose.")
 
 (defvar doom-cli-log-file (concat doom-local-dir "doom.log")
-  "File to write the extended output to.")
+  "Where to write the extended output to.")
 
 (defvar doom-cli-log-error-file (concat doom-local-dir "doom.error.log")
-  "File to write the last backtrace to.")
+  "Where to write the last backtrace to.")
 
+(defvar doom--cli-log-buffer (generate-new-buffer " *doom log*"))
+(defvar doom--cli-log-error-buffer (generate-new-buffer " *doom error log*"))
 (defvar doom--cli-commands (make-hash-table :test 'equal))
 (defvar doom--cli-groups (make-hash-table :test 'equal))
 (defvar doom--cli-group nil)
@@ -61,373 +35,41 @@ purpose.")
 
 
 ;;
-;;; CLI library
+;;; Bootstrap
 
-(cl-defstruct
+(require 'seq)
-    (doom-cli
+(load! "autoload/process")
-     (:constructor nil)
+(load! "autoload/system")
-     (:constructor
+(load! "autoload/plist")
-      make-doom-cli
+(load! "autoload/files")
-      (name &key desc aliases optlist arglist plist fn
+(load! "autoload/output")
-            &aux
-            (optlist
-             (cl-loop for (symbol options desc) in optlist
-                      for ((_ . options) (_ . params))
-                      = (seq-group-by #'stringp options)
-                      collect
-                      (make-doom-cli-option :symbol symbol
-                                            :flags options
-                                            :args params
-                                            :desc desc))))))
-  (name nil :read-only t)
-  (desc "TODO")
-  aliases
-  optlist
-  arglist
-  plist
-  (fn (lambda (_) (print! "But nobody came!"))))
 
-(cl-defstruct doom-cli-option
+(load! "cli/lib/debugger")
-  (symbol)
+(load! "cli/lib/lib")
-  (flags ())
+(load! "cli/lib/straight-hacks")
-  (args ())
-  (desc "TODO"))
 
-(defun doom--cli-get-option (cli flag)
+;; Use our own home-grown debugger so we can capture and store backtraces, make
-  (cl-find-if (doom-partial #'member flag)
+;; them more presentable, and make it easier for users to produce better bug
-              (doom-cli-optlist cli)
+;; reports!
-              :key #'doom-cli-option-flags))
+(setq debugger #'doom-cli--debugger
+      debug-on-error t
+      debug-ignored-errors '(user-error))
 
-(defun doom--cli-process (cli args)
+;; Create all our core directories to quell file errors.
-  (let* ((args (copy-sequence args))
+(mapc (doom-rpartial #'make-directory 'parents)
-         (arglist (copy-sequence (doom-cli-arglist cli)))
+      (list doom-local-dir
-         (expected
+            doom-etc-dir
-          (or (cl-position-if (doom-rpartial #'memq cl--lambda-list-keywords)
+            doom-cache-dir))
-                              arglist)
-              (length arglist)))
-         (got 0)
-         restvar
-         rest
-         alist)
-    (catch 'done
-      (while args
-        (let ((arg (pop args)))
-          (cond ((eq (car arglist) '&rest)
-                 (setq restvar (cadr arglist)
-                       rest (cons arg args))
-                 (throw 'done t))
 
-                ((string-match "^\\(--\\([a-zA-Z0-9][a-zA-Z0-9-_]*\\)\\)\\(?:=\\(.+\\)\\)?$" arg)
+;; Ensure straight and core packages are ready to go for CLI commands.
-                 (let* ((fullflag (match-string 1 arg))
+(require 'core-modules)
-                        (opt (doom--cli-get-option cli fullflag)))
+(require 'core-packages)
-                   (unless opt
+(doom-initialize-core-packages)
-                     (user-error "Unrecognized switch %S" (concat "--" (match-string 2 arg))))
-                   (setf (alist-get (doom-cli-option-symbol opt) alist)
-                         (or (if (doom-cli-option-args opt)
-                                 (or (match-string 3 arg)
-                                     (pop args)
-                                     (user-error "%S expected an argument, but got none"
-                                                 fullflag))
-                               (if (match-string 3 arg)
-                                   (user-error "%S was not expecting an argument, but got %S"
-                                               fullflag (match-string 3 arg))
-                                 fullflag))))))
 
-                ((string-match "^\\(-\\([a-zA-Z0-9]+\\)\\)$" arg)
+;; Don't generate superfluous files when writing temp buffers
-                 (let ((fullflag (match-string 1 arg))
+(setq make-backup-files nil)
-                       (flag     (match-string 2 arg)))
+;; Stop user configuration from interfering with package management
-                   (dolist (switch (split-string flag "" t))
+(setq enable-dir-local-variables nil)
-                     (if-let (opt (doom--cli-get-option cli (concat "-" switch)))
-                         (setf (alist-get (doom-cli-option-symbol opt) alist)
-                               (if (doom-cli-option-args opt)
-                                   (or (pop args)
-                                       (user-error "%S expected an argument, but got none"
-                                                   fullflag))
-                                 fullflag))
-                       (user-error "Unrecognized switch %S" (concat "-" switch))))))
-
-                (arglist
-                 (cl-incf got)
-                 (let ((spec (pop arglist)))
-                   (when (eq spec '&optional)
-                     (setq spec (pop arglist)))
-                   (setf (alist-get spec alist) arg))
-                 (when (null arglist)
-                   (throw 'done t)))
-
-                (t
-                 (push arg args)
-                 (throw 'done t))))))
-    (when (< got expected)
-      (error "Expected %d arguments, got %d" expected got))
-    (when rest
-      (setf (alist-get restvar alist) rest))
-    alist))
-
-(defun doom-cli-get (command)
-  "Return a CLI object associated by COMMAND name (string)."
-  (cond ((null command) nil)
-        ((doom-cli-p command) command)
-        ((doom-cli-get
-          (gethash (cond ((symbolp command) command)
-                         ((stringp command) (intern command))
-                         (command))
-                   doom--cli-commands)))))
-
-(defun doom-cli-internal-p (cli)
-  "Return non-nil if CLI is an internal (non-public) command."
-  (string-prefix-p ":" (doom-cli-name cli)))
-
-(defun doom-cli-execute (command &rest args)
-  "Execute COMMAND (string) with ARGS (list of strings).
-
-Executes a cli defined with `defcli!' with the name or alias specified by
-COMMAND, and passes ARGS to it."
-  (if-let (cli (doom-cli-get command))
-      (funcall (doom-cli-fn cli)
-               (doom--cli-process cli (remq nil args)))
-    (user-error "Couldn't find any %S command" command)))
-
-(defmacro defcli! (name speclist &optional docstring &rest body)
-  "Defines a CLI command.
-
-COMMAND is a symbol or a list of symbols representing the aliases for this
-command. DOCSTRING is a string description; its first line should be short
-(under 60 characters), as it will be used as a summary for 'doom help'.
-
-SPECLIST is a specification for options and arguments, which can be a list
-specification for an option/switch in the following format:
-
-  (VAR [FLAGS... ARGS...] DESCRIPTION)
-
-Otherwise, SPECLIST accepts the same argument specifiers as `defun'.
-
-BODY will be run when this dispatcher is called."
-  (declare (indent 2) (doc-string 3))
-  (unless (stringp docstring)
-    (push docstring body)
-    (setq docstring "TODO"))
-  (let ((names (doom-enlist name))
-        (optlist (cl-remove-if-not #'listp speclist))
-        (arglist (cl-remove-if #'listp speclist))
-        (plist (cl-loop for (key val) on body by #'cddr
-                        if (keywordp key)
-                        nconc (list key val) into plist
-                        else return plist)))
-    `(let ((name ',(car names))
-           (aliases ',(cdr names))
-           (plist ',plist))
-       (when doom--cli-group
-         (setq plist (plist-put plist :group doom--cli-group)))
-       (puthash
-        name
-        (make-doom-cli (symbol-name name)
-                       :desc ,docstring
-                       :aliases (mapcar #'symbol-name aliases)
-                       :arglist ',arglist
-                       :optlist ',optlist
-                       :plist plist
-                       :fn
-                       (lambda (--alist--)
-                         (ignore --alist--)
-                         (let ,(cl-loop for opt in speclist
-                                        for optsym = (if (listp opt) (car opt) opt)
-                                        unless (memq optsym cl--lambda-list-keywords)
-                                        collect (list optsym `(cdr (assq ',optsym --alist--))))
-                           ,@body)))
-        doom--cli-commands)
-       (when aliases
-         (mapc (doom-rpartial #'puthash name doom--cli-commands)
-               aliases)))))
-
-(defmacro defcligroup! (name docstring &rest body)
-  "Declare all enclosed cli commands are part of the NAME group."
-  (declare (indent defun) (doc-string 2))
-  `(let ((doom--cli-group ,name))
-     (puthash doom--cli-group ,docstring doom--cli-groups)
-     ,@body))
-
-
-;;
-;;; Debugger
-
-(cl-defun doom-cli--debugger (error data)
-  (cl-incf num-nonmacro-input-events)
-  (cl-destructuring-bind (backtrace &optional type data . _)
-      (cons (doom-cli--backtrace) data)
-    (let ((straight-error-p
-           (and (bound-and-true-p straight-process-buffer)
-                (string-match-p (regexp-quote straight-process-buffer)
-                                (or (get type 'error-message) "")))))
-      (cond
-       (straight-error-p
-        (print! (error "There was an unexpected package error"))
-        (when-let (output (straight--process-get-output))
-          (print-group!
-           (print! "%s" (string-trim-right output)))))
-       ((print! (error "There was an unexpected error"))
-        (print-group!
-         (print! "%s %s" (bold "Message:") (get type 'error-message))
-         (print! "%s %S" (bold "Data:") (cons type data))
-         (when backtrace
-           (print! (bold "Backtrace:"))
-           (print-group!
-            (dolist (frame (seq-take backtrace 10))
-              (print!
-               "%0.74s" (replace-regexp-in-string
-                         "[\n\r]" "\\\\n" (format "%S" frame)))))))))
-      (when backtrace
-        (with-temp-file doom-cli-log-error-file
-          (insert "# -*- lisp-interaction -*-\n")
-          (insert "# vim: set ft=lisp:\n")
-          (let ((standard-output (current-buffer))
-                (print-quoted t)
-                (print-escape-newlines t)
-                (print-escape-control-characters t)
-                (print-level nil)
-                (print-circle nil))
-            (when straight-error-p
-              (print (string-trim (or (straight--process-get-output) ""))))
-            (mapc #'print (cons (list type data) backtrace)))
-          (print! (warn "Extended backtrace logged to %s")
-                  (relpath doom-cli-log-error-file))))))
-  (throw 'exit 255))
-
-(defun doom-cli--backtrace ()
-  (let* ((n 0)
-         (frame (backtrace-frame n))
-         (frame-list nil)
-         (in-program-stack nil))
-    (while frame
-      (when in-program-stack
-        (push (cdr frame) frame-list))
-      (when (eq (elt frame 1) 'doom-cli--debugger)
-        (setq in-program-stack t))
-      (when (and (eq (elt frame 1) 'doom-cli-execute)
-                 (eq (elt frame 2) :doom))
-        (setq in-program-stack nil))
-      (setq n (1+ n)
-            frame (backtrace-frame n)))
-    (reverse frame-list)))
-
-
-;;
-;;; straight.el 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--straight-discard-options
-  '(("has diverged from"
-     . "^Reset [^ ]+ to branch")
-    ("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 "
-     . "^Reset branch \\|^Delete remote [^,]+, re-create it with correct URL"))
-  "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 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 doom-interactive-p
-          (funcall orig-fn prompt)
-        (y-or-n-p (format! "%s" (or prompt ""))))))
-
-(defun doom--straight-recommended-option-p (prompt option)
-  (cl-loop for (prompt-re . opt-re) in doom--straight-discard-options
-           if (string-match-p prompt-re prompt)
-           return (string-match-p opt-re option)))
-
-(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 doom-interactive-p
-      (funcall orig-fn prompt actions)
-    (let ((doom--straight-discard-options doom--straight-discard-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 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 (doom--straight-recommended-option-p prompt desc)
-                   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 (doom--straight-recommended-option-p prompt desc)
-                                 (progn
-                                   (setq doom--straight-discard-options nil)
-                                   (green (concat desc " (Recommended)")))
-                               desc))))
-           (terpri)
-           (let* ((options
-                   (cons (lambda ()
-                           (let ((doom-output-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-output-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-output-indent)
-                   (> doom-output-indent 0))
-              (make-string (1- (or doom-output-indent 1)) 32)
-            cause)
-          interactive)))
 
 
 ;;
@@ -453,7 +95,7 @@ Environment variables:
   DOOMDIR       Where to find your private Doom config (normally ~/.doom.d)
   DOOMLOCALDIR  Where to store local files (normally ~/.emacs.d/.local)"
   (condition-case e
-      (with-output-to! doom-cli-log-file
+      (with-output-to! doom--cli-log-buffer
         (catch 'exit
           (when (and (not (getenv "__DOOMRESTART"))
                      (or doomdir
@@ -502,7 +144,7 @@ Environment variables:
      (print! (error "Command 'doom %s' not recognized") (string-join (cdr e) " "))
      (print! "\nDid you mean one of these commands?")
      (apply #'doom-cli-execute "help" "--similar" (string-join (cdr e) " "))
-     2)
+     5)
     ;; TODO Not implemented yet
     (doom-cli-wrong-number-of-arguments-error
      (cl-destructuring-bind (route opt arg n d) (cdr e)
@@ -510,7 +152,7 @@ Environment variables:
                (mapconcat #'symbol-name route " ") arg n d)
        (print-group!
         (apply #'doom-cli-execute "help" (mapcar #'symbol-name route))))
-     3)
+     6)
     ;; TODO Not implemented yet
     (doom-cli-unrecognized-option-error
      (let ((option (cadr e)))
@@ -519,7 +161,7 @@ Environment variables:
          (print! "The %S syntax isn't supported. Use '%s %s' instead."
                  option (car (split-string option "="))
                  (match-string 1 option))))
-     4)
+     7)
     ;; TODO Not implemented yet
     (doom-cli-deprecated-error
      (cl-destructuring-bind (route . commands) (cdr e)
@@ -528,10 +170,10 @@ Environment variables:
        (print-group!
         (dolist (command commands)
           (print! (info "%s") command))))
-     5)
+     8)
     (user-error
      (print! (warn "%s") (cadr e))
-     1)))
+     9)))
 
 
 ;;