Reorganize CLI libraries
This commit is contained in:
Henrik Lissner
parent
cf31b91858
commit
e9c4c7471c
5 changed files with 462 additions and 465 deletions
122
bin/doom
122
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)))
|
||||
|
|
|
|||
61
core/cli/lib/debugger.el
Normal file
61
core/cli/lib/debugger.el
Normal file
|
|
@ -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)))
|
||||
185
core/cli/lib/lib.el
Normal file
185
core/cli/lib/lib.el
Normal file
|
|
@ -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))
|
||||
123
core/cli/lib/straight-hacks.el
Normal file
123
core/cli/lib/straight-hacks.el
Normal file
|
|
@ -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)))
|
||||
436
core/core-cli.el
436
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)))
|
||||
|
||||
|
||||
;;
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue