Updating dotfiles.

.emacs.d/core/core-cli.el

@@ -1,13 +1,12 @@
-;;; -*- lexical-binding: t; no-byte-compile: t; -*-
-
-(require 'seq)
+;;; core/core-cli.el --- -*- lexical-binding: t; no-byte-compile: t; -*-
 
 (load! "autoload/process")
 (load! "autoload/plist")
 (load! "autoload/files")
 (load! "autoload/output")
+(require 'seq)
 
-;; Create all our core directories to quell file errors
+;; Create all our core directories to quell file errors.
 (mapc (doom-rpartial #'make-directory 'parents)
       (list doom-local-dir
             doom-etc-dir
@@ -21,6 +20,9 @@
 ;; Don't generate superfluous files when writing temp buffers
 (setq make-backup-files nil)
 
+;; Stop user configuration from interfering with Doom
+(setq enable-dir-local-variables nil)
+
 
 ;;
 ;;; Variables
@@ -40,10 +42,26 @@ These are loaded when a Doom's CLI starts up. There users and modules can define
 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.")
+
+(defvar doom-cli-log-error-file (concat doom-local-dir "doom.error.log")
+  "File to write the last backtrace to.")
+
 (defvar doom--cli-commands (make-hash-table :test 'equal))
 (defvar doom--cli-groups (make-hash-table :test 'equal))
 (defvar doom--cli-group nil)
 
+(define-error 'doom-cli-error "There was an unexpected error" 'doom-error)
+(define-error 'doom-cli-command-not-found-error "Could not find that command" 'doom-cli-error)
+(define-error 'doom-cli-wrong-number-of-arguments-error "Wrong number of CLI arguments" 'doom-cli-error)
+(define-error 'doom-cli-unrecognized-option-error "Not a recognized option" 'doom-cli-error)
+(define-error 'doom-cli-deprecated-error "Command is deprecated" 'doom-cli-error)
+
+
+;;
+;;; CLI library
+
 (cl-defstruct
     (doom-cli
      (:constructor nil)
@@ -159,7 +177,7 @@ purpose.")
   "Return non-nil if CLI is an internal (non-public) command."
   (string-prefix-p ":" (doom-cli-name cli)))
 
-(defun doom-cli-execute (command &optional args)
+(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
@@ -169,24 +187,6 @@ COMMAND, and passes ARGS to it."
                (doom--cli-process cli (remq nil args)))
     (user-error "Couldn't find any %S command" command)))
 
-(defun doom-cli-execute-after (&rest args)
-  "Execute shell command ARGS after this CLI session quits.
-
-This is particularly useful when the capabilities of Emacs' batch terminal are
-insufficient (like opening an instance of Emacs, or reloading Doom after a 'doom
-upgrade')."
-  (let ((post-script (concat doom-local-dir ".doom.sh")))
-    (with-temp-file post-script
-      (insert "#!/usr/bin/env sh\n"
-              "rm -f " (prin1-to-string post-script) "\n"
-              "exec " (mapconcat #'shell-quote-argument (remq nil args) " ")
-              "\n"))
-    (let* ((current-mode (file-modes post-script))
-           (add-mode (logand ?\111 (default-file-modes))))
-      (or (/= (logand ?\111 current-mode) 0)
-          (zerop add-mode)
-          (set-file-modes post-script (logior current-mode add-mode))))))
-
 (defmacro defcli! (name speclist &optional docstring &rest body)
   "Defines a CLI command.
 
@@ -247,6 +247,65 @@ BODY will be run when this dispatcher is called."
      ,@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)
+    (cond
+     ((and (bound-and-true-p straight-process-buffer)
+           (stringp data)
+           (string-match-p (regexp-quote straight-process-buffer)
+                           data))
+      (print! (error "There was an unexpected package error"))
+      (print-group!
+       (print! "%s" (string-trim-right (straight--process-get-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))
+          (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
 
@@ -366,52 +425,102 @@ everywhere we use it (and internally)."
           interactive)))
 
 
+;;
+;;; Entry point
+
+(defcli! :doom
+    ((help-p        ["-h" "--help"]  "Same as help command")
+     (auto-accept-p ["-y" "--yes"]   "Auto-accept all confirmation prompts")
+     (debug-p       ["-d" "--debug"] "Enables on verbose output")
+     (doomdir       ["--doomdir"  dir] "Use the private module at DIR (e.g. ~/.doom.d)")
+     (localdir      ["--localdir" dir] "Use DIR as your local storage directory")
+     &optional command
+     &rest args)
+  "A command line interface for managing Doom Emacs.
+
+Includes package management, diagnostics, unit tests, and byte-compilation.
+
+This tool also makes it trivial to launch Emacs out of a different folder or
+with a different private module."
+  (condition-case e
+      (with-output-to! doom-cli-log-file
+        (catch 'exit
+          (when (and (not (getenv "__DOOMRESTART"))
+                     (or doomdir
+                         localdir
+                         debug-p
+                         auto-accept-p))
+            (when doomdir
+              (setenv "DOOMDIR" (file-name-as-directory doomdir))
+              (print! (info "DOOMDIR=%s") localdir))
+            (when localdir
+              (setenv "DOOMLOCALDIR" (file-name-as-directory localdir))
+              (print! (info "DOOMLOCALDIR=%s") localdir))
+            (when debug-p
+              (setenv "DEBUG" "1")
+              (print! (info "DEBUG=1")))
+            (when auto-accept-p
+              (setenv "YES" auto-accept-p)
+              (print! (info "Confirmations auto-accept enabled")))
+            (throw 'exit "__DOOMRESTART=1 $@"))
+          ;; TODO Rotate logs out, instead of overwriting them?
+          (delete-file doom-cli-log-file)
+          (delete-file doom-cli-log-error-file)
+          (when help-p
+            (when command
+              (push command args))
+            (setq command "help"))
+          (if (null command)
+              (doom-cli-execute "help")
+            (let ((start-time (current-time)))
+              (run-hooks 'doom-cli-pre-hook)
+              (when (apply #'doom-cli-execute command args)
+                (run-hooks 'doom-cli-post-hook)
+                (print! (success "Finished in %.4fs")
+                        (float-time (time-subtract (current-time) start-time))))))))
+    ;; TODO Not implemented yet
+    (doom-cli-command-not-found-error
+     (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)
+    ;; TODO Not implemented yet
+    (doom-cli-wrong-number-of-arguments-error
+     (cl-destructuring-bind (route opt arg n d) (cdr e)
+       (print! (error "doom %s: %S requires %d arguments, but %d given\n")
+               (mapconcat #'symbol-name route " ") arg n d)
+       (print-group!
+        (apply #'doom-cli-execute "help" (mapcar #'symbol-name route))))
+     3)
+    ;; TODO Not implemented yet
+    (doom-cli-unrecognized-option-error
+     (let ((option (cadr e)))
+       (print! (error "Unrecognized option: %S") option)
+       (when (string-match "^--[^=]+=\\(.+\\)$" option)
+         (print! "The %S syntax isn't supported. Use '%s %s' instead."
+                 option (car (split-string option "="))
+                 (match-string 1 option))))
+     4)
+    ;; TODO Not implemented yet
+    (doom-cli-deprecated-error
+     (cl-destructuring-bind (route . commands) (cdr e)
+       (print! (warn "The 'doom %s' command was removed and replaced with:\n")
+               (mapconcat #'symbol-name route " "))
+       (print-group!
+        (dolist (command commands)
+          (print! (info "%s") command))))
+     5)
+    (user-error
+     (print! (warn "%s") (cadr e))
+     1)))
+
+
 ;;
 ;;; CLI Commands
 
 (load! "cli/help")
 (load! "cli/install")
-
-(defcli! (refresh re) ()
-  "Deprecated for 'doom sync'"
-  :hidden t
-  (user-error "'doom refresh' has been replaced with 'doom sync'. Use that instead"))
-
-(defcli! (sync s)
-    ((inhibit-envvar-p ["-e"] "Don't regenerate the envvar file")
-     (inhibit-elc-p    ["-c"] "Don't recompile config")
-     (update-p         ["-u"] "Update installed packages after syncing")
-     (prune-p          ["-p" "--prune"] "Purge orphaned package repos & regraft them"))
-  "Synchronize your config with Doom Emacs.
-
-This is the equivalent of running autoremove, install, autoloads, then
-recompile. Run this whenever you:
-
-  1. Modify your `doom!' block,
-  2. Add or remove `package!' blocks to your config,
-  3. Add or remove autoloaded functions in module autoloaded files.
-  4. Update Doom outside of Doom (e.g. with git)
-
-It will ensure that unneeded packages are removed, all needed packages are
-installed, autoloads files are up-to-date and no byte-compiled files have gone
-stale."
-  (print! (start "Synchronizing your config with Doom Emacs..."))
-  (print-group!
-   (delete-file doom-autoload-file)
-   (when (and (not inhibit-envvar-p)
-              (file-exists-p doom-env-file))
-     (doom-cli-reload-env-file 'force))
-   (run-hooks 'doom-sync-pre-hook)
-   (doom-cli-packages-install)
-   (doom-cli-packages-build)
-   (when update-p
-     (doom-cli-packages-update))
-   (doom-cli-packages-purge prune-p 'builds-p prune-p prune-p)
-   (run-hooks 'doom-sync-post-hook)
-   (when (doom-autoloads-reload)
-     (print! (info "Restart Emacs or use 'M-x doom/reload' for changes to take effect")))
-   t))
-
+(load! "cli/sync")
 (load! "cli/env")
 (load! "cli/upgrade")
 (load! "cli/packages")
@@ -427,12 +536,10 @@ stale."
   ;; (load! "cli/test")
   )
 
-
 (defcligroup! "Compilation"
   "For compiling Doom and your config"
   (load! "cli/byte-compile"))
 
-
 (defcligroup! "Utilities"
   "Conveniences for interacting with Doom externally"
   (defcli! run (&rest args)
@@ -446,8 +553,16 @@ All arguments are passed on to Emacs.
 WARNING: this command exists for convenience and testing. Doom will suffer
 additional overhead by being started this way. For the best performance, it is
 best to run Doom out of ~/.emacs.d and ~/.doom.d."
-    (apply #'doom-cli-execute-after invocation-name args)
-    nil))
+    (throw 'exit (cons invocation-name args))))
+
+
+;;
+;;; Bootstrap
+
+(doom-log "Initializing Doom CLI")
+(load! doom-module-init-file doom-private-dir t)
+(maphash (doom-module-loader doom-cli-file) doom-modules)
+(load! doom-cli-file doom-private-dir t)
 
 (provide 'core-cli)
 ;;; core-cli.el ends here