From e9c4c7471c95d1a35efd007a945ab3cd5912d4bc Mon Sep 17 00:00:00 2001 From: Henrik Lissner Date: Fri, 12 Mar 2021 17:55:41 -0500 Subject: [PATCH] Reorganize CLI libraries --- bin/doom | 122 ++++----- core/cli/lib/debugger.el | 61 +++++ core/cli/lib/lib.el | 185 ++++++++++++++ core/cli/lib/straight-hacks.el | 123 ++++++++++ core/core-cli.el | 436 +++------------------------------ 5 files changed, 462 insertions(+), 465 deletions(-) create mode 100644 core/cli/lib/debugger.el create mode 100644 core/cli/lib/lib.el create mode 100644 core/cli/lib/straight-hacks.el diff --git a/bin/doom b/bin/doom index 9b69d97b4..16f617439 100755 --- a/bin/doom +++ b/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 - ;; return a boolean, integer (error code) or throw an 'exit event, which - ;; we handle specially. - (apply #'doom-cli-execute :doom (cdr (member "--" argv)))) + ;; Catch some potential issues early + (cond + ((version< emacs-version "26.3") + (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) - "$@") - ((stringp command) - command) + (cond ((eq command :restart) "$@") + ((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))) diff --git a/core/cli/lib/debugger.el b/core/cli/lib/debugger.el new file mode 100644 index 000000000..f638c6507 --- /dev/null +++ b/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))) diff --git a/core/cli/lib/lib.el b/core/cli/lib/lib.el new file mode 100644 index 000000000..b84b157a5 --- /dev/null +++ b/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)) diff --git a/core/cli/lib/straight-hacks.el b/core/cli/lib/straight-hacks.el new file mode 100644 index 000000000..1aecbeeff --- /dev/null +++ b/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))) diff --git a/core/core-cli.el b/core/core-cli.el index 1124cff20..463df3d30 100644 --- a/core/core-cli.el +++ b/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 - (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!")))) +(require 'seq) +(load! "autoload/process") +(load! "autoload/system") +(load! "autoload/plist") +(load! "autoload/files") +(load! "autoload/output") -(cl-defstruct doom-cli-option - (symbol) - (flags ()) - (args ()) - (desc "TODO")) +(load! "cli/lib/debugger") +(load! "cli/lib/lib") +(load! "cli/lib/straight-hacks") -(defun doom--cli-get-option (cli flag) - (cl-find-if (doom-partial #'member flag) - (doom-cli-optlist cli) - :key #'doom-cli-option-flags)) +;; 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 '(user-error)) -(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)) +;; 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)) - ((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)))))) +;; Ensure straight and core packages are ready to go for CLI commands. +(require 'core-modules) +(require 'core-packages) +(doom-initialize-core-packages) - ((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)) - - -;; -;;; 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))) +;; 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) ;; @@ -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))) ;;