emenel/doomemacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

refactor(cli): reorganize CLI library

Browse source 
* lisp/cli/help.el (doom help): move to lisp/cli/meta.el, and add :dump
  definition.
* lisp/doom-cli.el:
  - (doom-before-init-hook): trigger hook after the file is done
    loading.
  - (doom-cli-backtrace-depth, doom-cli-straight-error-lines,
    doom-cli-benchmark-threshold): rename these variables' prefix from
    `doom-cli-` to `doom-cli-log-`.
  - (doom-cli--plist): rename to doom-cli--group-plist, to better clue
    in what changes it.
  - (doom-cli-context-parse): remove unused letbind (argsleft).
  - (doom-cli-create-context-functions, doom-cli-before-run-functions,
    doom-cli-after-run-functions): define with defcustom instead of
    defvar, to indicate that they are (especially) intended for end-user
    configuration.
This commit is contained in:
Henrik Lissner 2022-09-25 16:42:26 +02:00
parent a29041735c
commit 5222612527
No known key found for this signature in database
GPG key ID: B60957CA074D39A3
2 changed files with 532 additions and 55 deletions
Download patch file Download diff file Expand all files Collapse all files

482
lisp/cli/meta.el Normal file
View file

@ -0,0 +1,482 @@
;;; lisp/cli/meta.el -*- lexical-binding: t; -*-
;;; Commentary:
;;
;; This file defines special commands that the Doom CLI will invoke when a
;; command is passed with -?, --help, or --version. They can also be aliased to
;; a sub-command to make more of its capabilities accessible to users, with:
;;
;; (defcli-alias! (myscript (help h)) (:help))
;;
;; You can define your own command-specific help handlers, e.g.
;;
;; (defcli! (:help myscript subcommand) () ...)
;;
;; And it will be invoked instead of the generic one.
;;
;;; Code:
;;
;;; Variables
(defvar doom-help-commands '("%p %c {-?,--help}")
"A list of help commands recognized for the running script.
Recognizes %p (for the prefix) and %c (for the active command).")
;;
;;; Commands
;; When __DOOMDUMP is set, doomscripts trigger this special handler.
(defcli! (:root :dump)
((pretty? ("--pretty") "Pretty print output")
&context context
&args commands)
"Dump metadata to stdout for other commands to read."
(let* ((prefix (doom-cli-context-prefix context))
(command (cons prefix commands)))
(funcall (if pretty? #'pp #'prin1)
(cond ((equal commands '("-")) (hash-table-values doom-cli--table))
(commands (doom-cli-find command))
((doom-cli-find (list prefix)))))
(terpri)
;; Kill manually so we don't save output to logs.
(let (kill-emacs) (kill-emacs 0))))
(defcli! (:root :help)
((localonly? ("-g" "--no-global") "Hide global options")
(manpage? ("--manpage") "Generate in manpage format")
(commands? ("--commands") "List all known commands")
&multiple
(sections ("--synopsis" "--subcommands" "--similar" "--envvars"
"--postamble")
"Show only the specified sections.")
&context context
&args command)
"Show documentation for a Doom CLI command.
OPTIONS:
--synopsis, --subcommands, --similar, --envvars, --postamble
TODO"
(doom-cli-load-all)
(when (doom-cli-context-error context)
(terpri))
(let* ((command (cons (doom-cli-context-prefix context) command))
(cli (doom-cli-get command t))
(rcli (doom-cli-get cli))
(fallbackcli (cl-loop with targets = (doom-cli--command-expand (butlast command) t)
for cmd in (cons command targets)
if (doom-cli-get cmd t)
return it)))
(cond (commands?
(let ((cli (or cli (doom-cli-get (doom-cli-context-prefix context)))))
(print! "Commands under '%s':\n%s"
(doom-cli-command-string cli)
(indent (doom-cli-help--render-commands
(or (doom-cli-subcommands cli)
(user-error "No commands found"))
:prefix (doom-cli-command cli)
:inline? t
:docs? t)))))
((null sections)
(if (null cli)
(signal 'doom-cli-command-not-found-error command)
(doom-cli-help--print cli context manpage? localonly?)
(exit! :pager?)))
((dolist (section sections)
(unless (equal section (car sections)) (terpri))
(pcase section
("--synopsis"
(print! "%s" (doom-cli-help--render-synopsis
(doom-cli-help--synopsis cli)
"Usage: ")))
("--subcommands"
(print! "%s\n%s" (bold "Available commands:")
(indent (doom-cli-help--render-commands
(doom-cli-subcommands rcli 1)
:prefix command
:grouped? t
:docs? t)
doom-print-indent-increment)))
("--similar"
(unless command
(user-error "No command specified"))
(let ((similar (doom-cli-help-similar-commands command 0.4)))
(print! "Similar commands:")
(if (not similar)
(print! (indent (warn "Can't find any!")))
(dolist (command (seq-take similar 10))
(print! (indent (item "(%d%%) %s"))
(* (car command) 100)
(doom-cli-command-string (cdr command)))))))
("--envvars"
(let* ((key "ENVIRONMENT VARIABLES")
(clis (if command (doom-cli-find command) (hash-table-values doom-cli--table)))
(clis (seq-remove #'doom-cli-alias clis))
(clis (seq-filter (fn! (cdr (assoc key (doom-cli-docs %)))) clis))
(clis (seq-group-by #'doom-cli-command clis)))
(print! "List of environment variables for %s:\n" command)
(if (null clis)
(print! (indent "None!"))
(dolist (group clis)
(print! (bold "%s%s:"
(doom-cli-command-string (car group))
(if (doom-cli-fn (doom-cli-get (car group)))
"" " *")))
(dolist (cli (cdr group))
(print! (indent "%s") (markup (cdr (assoc key (doom-cli-docs cli))))))))))
("--postamble"
(print! "See %s for documentation."
(join (cl-loop with spec =
`((?p . ,(doom-cli-context-prefix context))
(?c . ,(doom-cli-command-string (cdr (doom-cli-command (or cli fallbackcli))))))
for cmd in doom-help-commands
for formatted = (trim (format-spec cmd spec))
collect (replace-regexp-in-string
" +" " " (format "'%s'" formatted)))
" or ")))))))))
(defcli! (:root :version)
((simple? ("--simple"))
&context context)
"Show installed versions of Doom, Doom modules, and Emacs."
(doom/version)
(unless simple?
(terpri)
(with-temp-buffer
(insert-file-contents (doom-path doom-emacs-dir "LICENSE"))
(re-search-forward "^Copyright (c) ")
(print! "%s\n" (trim (thing-at-point 'line t)))
(print! (p "Doom Emacs uses the MIT license and is provided without warranty "
"of any kind. You may redistribute and modify copies if "
"given proper attribution. See the LICENSE file for details.")))))
;;
;;; Helpers
(defun doom-cli-help (cli)
"Return an alist of documentation summarizing CLI (a `doom-cli')."
(let* ((rcli (doom-cli-get cli))
(docs (doom-cli-docs rcli)))
`((command . ,(doom-cli-command-string cli))
(summary . ,(or (cdr (assoc "SUMMARY" docs)) "TODO"))
(description . ,(or (cdr (assoc "MAIN" docs)) "TODO"))
(synopsis . ,(doom-cli-help--synopsis cli))
(arguments . ,(doom-cli-help--arguments rcli))
(options . ,(doom-cli-help--options rcli))
(commands . ,(doom-cli-subcommands cli 1))
(sections . ,(seq-filter #'cdr (cddr docs))))))
(defun doom-cli-help-similar-commands (command &optional maxscore)
"Return N commands that are similar to COMMAND."
(seq-take-while
(fn! (>= (car %) (or maxscore 0.0)))
(seq-sort-by
#'car #'>
(cl-loop with prefix = (seq-find #'doom-cli-get (nreverse (doom-cli--command-expand command t)))
with input = (doom-cli-command-string (cdr (doom-cli--command command t)))
for command in (hash-table-keys doom-cli--table)
if (doom-cli-fn (doom-cli-get command))
if (equal prefix (seq-take command (length prefix)))
collect (cons (doom-cli-help--similarity
input (doom-cli-command-string (cdr command)))
command)))))
(defun doom-cli-help--similarity (s1 s2)
;; Ratcliff-Obershelp similarity
(let* ((s1 (downcase s1))
(s2 (downcase s2))
(s1len (length s1))
(s2len (length s2)))
(if (or (zerop s1len)
(zerop s2len))
0.0
(/ (let ((i 0) (j 0) (score 0) jlast)
(while (< i s1len)
(unless jlast (setq jlast j))
(if (and (< j s2len)
(= (aref s1 i) (aref s2 j)))
(progn (cl-incf score)
(cl-incf i)
(cl-incf j))
(setq m 0)
(cl-incf j)
(when (>= j s2len)
(setq j (or jlast j)
jlast nil)
(cl-incf i))))
(* 2.0 score))
(+ (length s1)
(length s2))))))
;;; Help: printers
;; TODO Parameterize optional args with `cl-defun'
(defun doom-cli-help--print (cli context &optional manpage? noglobal?)
"Write CLI's documentation in a manpage-esque format to stdout."
(let-alist (doom-cli-help cli)
(let* ((alist
`(,@(if manpage?
`((nil . ,(let* ((title (cadr (member "--load" command-line-args)))
(width (floor (/ (- (doom-cli-context-width context)
(length title))
2.0))))
;; FIXME Who am I fooling?
(format (format "%%-%ds%%s%%%ds" width width)
"DOOM(1)" title "DOOM(1)")))
("NAME" . ,(concat .command " - " .summary))
("SYNOPSIS" . ,(doom-cli-help--render-synopsis .synopsis nil t))
("DESCRIPTION" . ,.description))
`((nil . ,(doom-cli-help--render-synopsis .synopsis "Usage: "))
(nil . ,(string-join (seq-remove #'string-empty-p (list .summary .description))
"\n\n"))))
("ARGUMENTS" . ,(doom-cli-help--render-arguments .arguments))
("COMMANDS"
. ,(doom-cli-help--render-commands
.commands :prefix (doom-cli-command cli) :grouped? t :docs? t))
("OPTIONS"
. ,(doom-cli-help--render-options
(if (or (not (doom-cli-fn cli)) noglobal?)
`(,(assq 'local .options))
.options)
cli))))
(command (doom-cli-command cli)))
(letf! (defun printsection (section)
(print! "%s\n"
(if (null section)
(dark "TODO")
(markup
(format-spec
section `((?p . ,(car command))
(?c . ,(doom-cli-command-string (cdr command))))
'ignore)))))
(pcase-dolist (`(,label . ,contents) alist)
(when (and contents (not (string-blank-p contents)))
(when label
(print! (bold "%s%s") label (if manpage? "" ":")))
(print-group! :if label (printsection contents))))
(pcase-dolist (`(,label . ,contents) .sections)
(when (and contents (not (assoc label alist)))
(print! (bold "%s:") label)
(print-group! (printsection contents))))))))
;;; Help: synopsis
(defun doom-cli-help--synopsis (cli &optional all-options?)
(let* ((rcli (doom-cli-get cli))
(opts (doom-cli-help--options rcli))
(opts (mapcar #'car (if all-options? (mapcan #'cdr opts) (alist-get 'local opts))))
(opts (cl-loop for opt in opts
for args = (cdar opt)
for switches = (mapcar #'car opt)
for multi? = (member "..." args)
if args
collect (format (if multi? "[%s %s]..." "[%s %s]")
(string-join switches "|")
(string-join (remove "..." args) "|"))
else collect (format "[%s]" (string-join switches "|"))))
(args (doom-cli-arguments rcli))
(subcommands? (doom-cli-subcommands rcli 1 :predicate? t)))
`((command . ,(doom-cli-command cli))
(options ,@opts)
(required ,@(mapcar (fn! (upcase (format "`%s'" %))) (if subcommands? '(command) (alist-get '&required args))))
(optional ,@(mapcar (fn! (upcase (format "[`%s']" %)))(alist-get '&optional args)))
(rest ,@(mapcar (fn! (upcase (format "[`%s'...]" %))) (if subcommands? '(args) (alist-get '&args args)))))))
(defun doom-cli-help--render-synopsis (synopsis &optional prefix)
(let-alist synopsis
(let ((doom-print-indent 0)
(prefix (or prefix ""))
(command (doom-cli-command-string .command)))
(string-trim-right
(format! "%s\n\n"
(fill (concat (bold prefix)
(format "%s " command)
(markup
(join (append .options
(and .options
(or .required
.optional
.rest)
(list (dark "[--]")))
.required
.optional
.rest))))
80 (1+ (length (concat prefix command)))))))))
;;; Help: arguments
(defun doom-cli-help--arguments (cli &optional all?)
(doom-cli-help--parse-docs (doom-cli-find cli t) "ARGUMENTS"))
(defun doom-cli-help--render-arguments (arguments)
(mapconcat (lambda (arg)
(format! "%-20s\n%s"
(underscore (car arg))
(indent (if (equal (cdr arg) "TODO")
(dark (cdr arg))
(cdr arg))
doom-print-indent-increment)))
arguments
"\n"))
;;; Help: commands
(cl-defun doom-cli-help--render-commands (commands &key prefix grouped? docs? (inline? t))
(with-temp-buffer
(let* ((doom-print-indent 0)
(commands (seq-group-by (fn! (if grouped? (doom-cli-prop (doom-cli-get % t) :group)))
(nreverse commands)))
(toplevel (assq nil commands))
(rest (remove toplevel commands))
(drop (if prefix (length prefix) 0))
(minwidth
(apply
#'max (or (cl-loop for cmd in (apply #'append (mapcar #'cdr commands))
for cmd = (seq-drop cmd drop)
collect (length (doom-cli-command-string cmd)))
(list 15))))
(ellipsis (doom-print--style 'dark " […]"))
(ellipsislen (- (length ellipsis) (if (eq doom-print-backend 'ansi) 2 4))))
(dolist (group (cons toplevel rest))
(let ((label (if (car-safe group) (cdr commands))))
(when label
(insert! ((bold "%s:") (car group)) "\n"))
(print-group! :if label
(dolist (command (cdr group))
(let* ((cli (doom-cli-get command t))
(rcli (doom-cli-get command))
(summary (doom-cli-short-docs rcli))
(subcommands? (doom-cli-subcommands cli 1 :predicate? t)))
(insert! ((format "%%-%ds%%s%%s"
(+ (- minwidth doom-print-indent)
doom-print-indent-increment
(if subcommands? ellipsislen 0)))
(concat (doom-cli-command-string (seq-drop command drop))
(if subcommands? ellipsis))
(if inline? " " "\n")
(indent (if (and (doom-cli-alias cli)
(not (doom-cli-type rcli)))
(dark "-> %s" (doom-cli-command-string cli))
(when docs?
(if summary (markup summary) (dark "TODO"))))))
"\n")))
(when (cdr rest)
(insert "\n")))))
(string-trim-right (buffer-string)))))
;;; Help: options
(defun doom-cli-help--options (cli &optional noformatting?)
"Return an alist summarizing CLI's options.
The alist's CAR are lists of formatted switches plus their arguments, e.g.
'((\"`--foo'\" \"`BAR'\") ...). Their CDR is their formatted documentation."
(let* ((docs (doom-cli-help--parse-docs (doom-cli-find cli t) "OPTIONS"))
(docs (mapcar (fn! (cons (split-string (car %) ", ")
(cdr %)))
docs))
(strfmt (if noformatting? "%s" "`%s'"))
local-options
global-options
seen)
(dolist (neighbor (nreverse (doom-cli-find cli)))
(dolist (option (doom-cli-options neighbor))
(when-let* ((switches (cl-loop for sw in (doom-cli-option-switches option)
if (and (doom-cli-option-flag-p option)
(string-prefix-p "--" sw))
collect (format "--[no-]%s" (substring sw 2))
else collect sw))
(switches (seq-difference switches seen)))
(dolist (switch switches) (push switch seen))
(push (cons (cl-loop for switch in switches
if (doom-cli-option-arguments option)
collect (cons (format strfmt switch)
(append (doom-cli-help--parse-args it noformatting?)
(when (doom-cli-option-multiple-p option)
(list "..."))))
else collect (list (format strfmt switch)))
(string-join
(or (delq
nil (cons (when-let (docs (doom-cli-option-docs option))
(concat docs "."))
(cl-loop for (flags . docs) in docs
unless (equal (seq-difference flags switches) flags)
collect docs)))
'("TODO"))
"\n\n"))
(if (equal (doom-cli-command neighbor)
(doom-cli-command cli))
local-options
global-options)))))
`((local . ,(nreverse local-options))
(global . ,(nreverse global-options)))))
(defun doom-cli-help--render-options (options &optional cli)
(let ((doom-print-indent 0)
(local (assq 'local options))
(global (assq 'global options)))
(when (or (cdr local) (cdr global))
(letf! (defun printopts (opts)
(pcase-dolist (`(,switches . ,docs) (cdr opts))
(let (multiple?)
(insert!
("%s%s\n%s"
(mapconcat
(fn! (when (member "..." (cdr %))
(setq multiple? t))
(string-trim-right
(format "%s %s"
(doom-print--cli-markup (car %))
(doom-print--cli-markup
(string-join (remove "..." (cdr %)) "|")))))
switches
", ")
(if multiple? ", ..." "")
(indent (fill (markup docs)) doom-print-indent-increment))
"\n\n"))))
(with-temp-buffer
(if (null (cdr local))
(insert (if global "This command has no local options.\n" "") "\n")
(printopts local))
(when (cdr global)
(insert! ((bold "Global options:\n")))
(print-group! (printopts global)))
(string-trim-right (buffer-string)))))))
;;; Help: internal
(defun doom-cli-help--parse-args (args &optional noformatting?)
(cl-loop for arg in args
if (listp arg)
collect (string-join (doom-cli-help--parse-args arg noformatting?) "|")
else if (symbolp arg)
collect (format (if noformatting? "%s" "`%s'") (upcase (symbol-name arg)))
else collect arg))
(defun doom-cli-help--parse-docs (cli-list section-name)
(cl-check-type section-name string)
(let (alist)
(dolist (cli cli-list (nreverse alist))
(when-let (section (cdr (assoc section-name (doom-cli-docs cli))))
(with-temp-buffer
(save-excursion (insert section))
(let ((lead (current-indentation))
(buffer (current-buffer)))
(while (not (eobp))
(let ((heading (string-trim (buffer-substring (point-at-bol) (point-at-eol))))
(beg (point-at-bol 2))
end)
(forward-line 1)
(while (and (not (eobp))
(/= (current-indentation) lead)
(forward-line 1)))
(setf (alist-get heading alist nil nil #'equal)
(string-join
(delq
nil (list (alist-get heading alist nil nil #'equal)
(let ((end (point)))
(with-temp-buffer
(insert-buffer-substring buffer beg end)
(goto-char (point-min))
(indent-rigidly (point-min) (point-max) (- (current-indentation)))
(string-trim-right (buffer-string))))))
"\n\n"))))))))))
(provide 'doom-cli-meta)
;;; meta.el ends here

105
lisp/doom-cli.el
View file

@ -6,6 +6,7 @@
;; expects a noninteractive session, so take care when testing code! ;; expects a noninteractive session, so take care when testing code!
;; ;;
;;; Code: ;;; Code:
(when noninteractive (when noninteractive
;; PERF: Deferring the GC in non-interactive sessions isn't as important, but ;; PERF: Deferring the GC in non-interactive sessions isn't as important, but
;; still yields a notable benefit. Still, avoid setting it to high here, as ;; still yields a notable benefit. Still, avoid setting it to high here, as
@ -72,12 +73,20 @@
;; Ensure straight and core packages are ready to go for CLI commands. ;; Ensure straight and core packages are ready to go for CLI commands.
(require 'doom-modules) (require 'doom-modules)
(require 'doom-packages) (require 'doom-packages)
(require 'doom-profiles)) (require 'doom-profiles)
;; Last minute initialization at the end of loading this file.
(with-eval-after-load 'doom-cli
(doom-run-hooks 'doom-before-init-hook)))
;; ;;
;;; Variables ;;; Variables
(defgroup doom-cli nil
"Doom's command-line interface framework."
:link '(url-link "https://doomemacs.org/cli")
:group 'doom)
(defvar doom-cli-load-path (defvar doom-cli-load-path
(let ((paths (split-string (or (getenv "DOOMPATH") "") path-separator))) (let ((paths (split-string (or (getenv "DOOMPATH") "") path-separator)))
(if (member "" paths) (if (member "" paths)
@ -89,6 +98,7 @@ It is prefilled by the DOOMPATH envvar (a colon-separated list on Linux/macOS,
semicolon otherwise). Empty entries in DOOMPATH are replaced with the semicolon otherwise). Empty entries in DOOMPATH are replaced with the
$EMACSDIR/cli/.") $EMACSDIR/cli/.")
;;; CLI definition variables
(defvar doom-cli-argument-types (defvar doom-cli-argument-types
'(&args '(&args
&cli &cli
@ -199,6 +209,7 @@ Recognizies the following properies:
:error STR :error STR
The message to display if a value fails :test.") The message to display if a value fails :test.")
;;; Post-script settings
(defvar doom-cli-exit-commands (defvar doom-cli-exit-commands
'(;; (:editor . doom-cli--exit-editor) '(;; (:editor . doom-cli--exit-editor)
;; (:emacs . doom-cli--exit-emacs) ;; (:emacs . doom-cli--exit-emacs)
@ -217,6 +228,7 @@ If nil, falls back to less.")
Only applies if (exit! :pager) or (exit! :pager?) are called.") Only applies if (exit! :pager) or (exit! :pager?) are called.")
;;; Logger settings
(defvar doom-cli-log-file-format (expand-file-name "logs/cli.%s.%s.%s" doom-local-dir) (defvar doom-cli-log-file-format (expand-file-name "logs/cli.%s.%s.%s" doom-local-dir)
"Where to write any output/log file to. "Where to write any output/log file to.
@ -225,47 +237,54 @@ Must have two arguments, one for session id and the other for log type.")
(defvar doom-cli-log-retain 12 (defvar doom-cli-log-retain 12
"Number of each log type to retain.") "Number of each log type to retain.")
(defvar doom-cli-backtrace-depth 12 (defvar doom-cli-log-backtrace-depth 12
"How many frames of the backtrace to display in stdout.") "How many frames of the backtrace to display in stdout.")
(defvar doom-cli-straight-error-lines 16 (defvar doom-cli-log-straight-error-lines 16
"How many lines of straight.el errors to display in stdout.") "How many lines of straight.el errors to display in stdout.")
(defvar doom-cli-benchmark-threshold 5 (defvar doom-cli-log-benchmark-threshold 5
"How much execution time (in seconds) before benchmark is shown. "How much execution time (in seconds) before benchmark is shown.
If set to nil, only display benchmark if a CLI explicitly requested with a If set to nil, only display benchmark if a CLI explicitly requested with a
non-nil :benchmark property. non-nil :benchmark property.
If set to `always', show the benchmark no matter what.") If set to `always', show the benchmark no matter what.")
;;; Internal variables
(defvar doom-cli--context nil) (defvar doom-cli--context nil)
(defvar doom-cli--exit-code 255) (defvar doom-cli--exit-code 255)
(defvar doom-cli--plist nil) (defvar doom-cli--group-plist nil)
(defvar doom-cli--table (make-hash-table :test 'equal)) (defvar doom-cli--table (make-hash-table :test 'equal))
;; ;;
;;; Hooks ;;; Custom hooks
(defvar doom-cli-create-context-functions () (defcustom doom-cli-create-context-functions ()
"A hook executed once a new context has been generated. "A hook executed once a new context has been generated.
Called by `doom-cli-context-parse' and `doom-cli-context-restore', once a Called by `doom-cli-context-parse' and `doom-cli-context-restore', once a
`doom-cli-context' is fully populated and ready to be executed (but before it `doom-cli-context' is fully populated and ready to be executed (but before it
has). has).
Hooks are run with one argument: the newly created context.") Hooks are run with one argument: the newly created context."
:type 'hook
:group 'doom-cli)
(defvar doom-cli-before-run-functions () (defcustom doom-cli-before-run-functions ()
"Hooks run before `doom-cli-run' executes the command. "Hooks run before `run!' executes the command.
Runs with a single argument: the active context (a `doom-cli-context' struct).") Runs with a single argument: the active context (a `doom-cli-context' struct)."
:type 'hook
:group 'doom-cli)
(defvar doom-cli-after-run-functions () (defcustom doom-cli-after-run-functions ()
"Hooks run after `doom-cli-run' has executed the command. "Hooks run after `run!' has executed the command.
Runs with two arguments: the active context (a `doom-cli-context' struct) and Runs with two arguments: the active context (a `doom-cli-context' struct) and
the return value of the executed CLI.") the return value of the executed CLI."
:type 'hook
:group 'doom-cli)
;; ;;
@ -835,7 +854,6 @@ executable context."
(signal 'doom-cli-unrecognized-option-error (signal 'doom-cli-unrecognized-option-error
(list fullflag)))) (list fullflag))))
(explicit-arg (match-string 2 arg)) (explicit-arg (match-string 2 arg))
(argsleft (+ (length args) (if explicit-arg 1 0)))
(arity (length (doom-cli-option-arguments option))) (arity (length (doom-cli-option-arguments option)))
(key (if (doom-cli-option-multiple-p option) (key (if (doom-cli-option-multiple-p option)
(car (doom-cli-option-switches option)) (car (doom-cli-option-switches option))
@ -1017,13 +1035,13 @@ considered as well."
(straight-error (straight-error
(print! (error "The package manager threw an error")) (print! (error "The package manager threw an error"))
(print! (error "Last %d lines of straight's error log:") (print! (error "Last %d lines of straight's error log:")
doom-cli-straight-error-lines) doom-cli-log-straight-error-lines)
(print-group! (print-group!
(print! (print!
"%s" (string-join "%s" (string-join
(seq-subseq straight-error (seq-subseq straight-error
(max 0 (- (length straight-error) (max 0 (- (length straight-error)
doom-cli-straight-error-lines)) doom-cli-log-straight-error-lines))
(length straight-error)) (length straight-error))
"\n"))) "\n")))
(print! (warn "Wrote extended straight log to %s") (print! (warn "Wrote extended straight log to %s")
@ -1034,7 +1052,7 @@ considered as well."
error-file)))) error-file))))
((eq type 'error) ((eq type 'error)
(let* ((generic? (eq (car data) 'error)) (let* ((generic? (eq (car data) 'error))
(doom-cli-backtrace-depth doom-cli-backtrace-depth) (doom-cli-log-backtrace-depth doom-cli-log-backtrace-depth)
(print-escape-newlines t)) (print-escape-newlines t))
(if (doom-cli-context-p context) (if (doom-cli-context-p context)
(print! (error "There was an unexpected runtime error")) (print! (error "There was an unexpected runtime error"))
@ -1053,7 +1071,7 @@ considered as well."
(when backtrace (when backtrace
(print! (bold "Backtrace:")) (print! (bold "Backtrace:"))
(print-group! (print-group!
(dolist (frame (seq-take backtrace doom-cli-backtrace-depth)) (dolist (frame (seq-take backtrace doom-cli-log-backtrace-depth))
(print! "%s" (truncate (prin1-to-string (print! "%s" (truncate (prin1-to-string
(cons (backtrace-frame-fun frame) (cons (backtrace-frame-fun frame)
(backtrace-frame-args frame))) (backtrace-frame-args frame)))
@ -1112,8 +1130,8 @@ See `doom-cli-log-file-format' for details."
Will also output it to stdout if requested (CLI sets :benchmark to t) or the Will also output it to stdout if requested (CLI sets :benchmark to t) or the
command takes >5s to run. If :benchmark is explicitly set to nil (or command takes >5s to run. If :benchmark is explicitly set to nil (or
`doom-cli-benchmark-threshold' is nil), under no condition should a benchmark be `doom-cli-log-benchmark-threshold' is nil), under no condition should a
shown." benchmark be shown."
(doom-cli-redirect-output context (doom-cli-redirect-output context
(doom-log "%s (GCs: %d, elapsed: %.6fs)" (doom-log "%s (GCs: %d, elapsed: %.6fs)"
(if (= doom-cli--exit-code 254) "Restarted" "Finished") (if (= doom-cli--exit-code 254) "Restarted" "Finished")
@ -1126,10 +1144,10 @@ shown."
(seconds (- duration (* hours 60 60) (* minutes 60)))) (seconds (- duration (* hours 60 60) (* minutes 60))))
(when (and (/= doom-cli--exit-code 254) (when (and (/= doom-cli--exit-code 254)
(or (eq (doom-cli-prop cli :benchmark) t) (or (eq (doom-cli-prop cli :benchmark) t)
(eq doom-cli-benchmark-threshold 'always) (eq doom-cli-log-benchmark-threshold 'always)
(and (eq (doom-cli-prop cli :benchmark :null) :null) (and (eq (doom-cli-prop cli :benchmark :null) :null)
(not (doom-cli-context-pipe-p context 'out t)) (not (doom-cli-context-pipe-p context 'out t))
(> duration (or doom-cli-benchmark-threshold (> duration (or doom-cli-log-benchmark-threshold
most-positive-fixnum))))) most-positive-fixnum)))))
(print! (success "Finished in %s") (print! (success "Finished in %s")
(join (list (unless (zerop hours) (format "%dh" hours)) (join (list (unless (zerop hours) (format "%dh" hours))
@ -1442,7 +1460,7 @@ ARGS are options passed to less. If DOOMPAGER is set, ARGS are ignored."
(or (when-let* ((path (doom-cli-autoload cli)) (or (when-let* ((path (doom-cli-autoload cli))
(path (locate-file-internal path doom-cli-load-path load-suffixes))) (path (locate-file-internal path doom-cli-load-path load-suffixes)))
(doom-log "load: autoload %s" path) (doom-log "load: autoload %s" path)
(let ((doom-cli--plist (doom-cli-plist cli))) (let ((doom-cli--group-plist (doom-cli-plist cli)))
(doom-load path)) (doom-load path))
(let* ((key (doom-cli-key cli)) (let* ((key (doom-cli-key cli))
(cli (gethash key doom-cli--table))) (cli (gethash key doom-cli--table)))
@ -1700,7 +1718,7 @@ ignored.
(&whole plist &key (&whole plist &key
alias autoload _benchmark docs disable hide _group partial alias autoload _benchmark docs disable hide _group partial
_prefix) _prefix)
(append (list ,@plist) doom-cli--plist) (append (list ,@plist) doom-cli--group-plist)
(unless disable (unless disable
(let* ((command (doom-cli-command-normalize (backquote ,commandspec) plist)) (let* ((command (doom-cli-command-normalize (backquote ,commandspec) plist))
(type (if (keywordp (car command)) (pop command))) (type (if (keywordp (car command)) (pop command)))
@ -1758,7 +1776,7 @@ TARGET is not a command specification, and should be a command list."
See `defcli!' for information about COMMANDSPEC. See `defcli!' for information about COMMANDSPEC.
TARGET is simply a command list. TARGET is simply a command list.
WHEN specifies what version this command was rendered obsolete." WHEN specifies what version this command was rendered obsolete."
`(let ((ncommand (doom-cli-command-normalize (backquote ,target) doom-cli--plist))) `(let ((ncommand (doom-cli-command-normalize (backquote ,target) doom-cli--group-plist)))
(defcli! ,commandspec (&context context &cli cli &rest args) (defcli! ,commandspec (&context context &cli cli &rest args)
:docs (format "An obsolete alias for '%s'." (doom-cli-command-string ncommand)) :docs (format "An obsolete alias for '%s'." (doom-cli-command-string ncommand))
:hide t :hide t
@ -1783,7 +1801,7 @@ yet. They won't be included in command listings (by help documentation)."
(defmacro defcli-autoload! (commandspec &optional path &rest plist) (defmacro defcli-autoload! (commandspec &optional path &rest plist)
"Defer loading of PATHS until PREFIX is called." "Defer loading of PATHS until PREFIX is called."
`(let* ((doom-cli--plist (append (list ,@plist) doom-cli--plist)) `(let* ((doom-cli--group-plist (append (list ,@plist) doom-cli--group-plist))
(commandspec (doom-cli-command-normalize ',commandspec)) (commandspec (doom-cli-command-normalize ',commandspec))
(commands (doom-cli--command-expand commandspec)) (commands (doom-cli--command-expand commandspec))
(path (or ,path (path (or ,path
@ -1801,14 +1819,14 @@ yet. They won't be included in command listings (by help documentation)."
"Declare common properties for any CLI commands defined in BODY." "Declare common properties for any CLI commands defined in BODY."
(when (stringp (car body)) (when (stringp (car body))
(push :group body)) (push :group body))
`(let ((doom-cli--plist (copy-sequence doom-cli--plist))) `(let ((doom-cli--group-plist (copy-sequence doom-cli--group-plist)))
,@(let (forms) ,@(let (forms)
(while (keywordp (car body)) (while (keywordp (car body))
(let ((key (pop body)) (let ((key (pop body))
(val (pop body))) (val (pop body)))
(push `(cl-callf plist-put doom-cli--plist (push `(cl-callf plist-put doom-cli--group-plist
,key ,(if (eq key :prefix) ,key ,(if (eq key :prefix)
`(append (plist-get doom-cli--plist ,key) `(append (plist-get doom-cli--group-plist ,key)
(ensure-list ,val)) (ensure-list ,val))
val)) val))
forms))) forms)))
@ -1982,34 +2000,11 @@ errors to `doom-cli-error-file')."
(defalias 'git! (doom-partial #'straight--process-run "git")) (defalias 'git! (doom-partial #'straight--process-run "git"))
;; ;;
;;; Predefined CLIs ;;; Predefined CLIs
;; Load standard :help and :version handlers. (load! "cli/meta") ; :help, :version, and :dump
(load! "cli/help")
;; When __DOOMDUMP is set, doomscripts trigger this special handler.
(defcli! (:root :dump)
((pretty? ("--pretty") "Pretty print output")
&context context
&args commands)
"Dump metadata to stdout for other commands to read."
(let* ((prefix (doom-cli-context-prefix context))
(command (cons prefix commands)))
(funcall (if pretty? #'pp #'prin1)
(cond ((equal commands '("-")) (hash-table-values doom-cli--table))
(commands (doom-cli-find command))
((doom-cli-find (list prefix)))))
(terpri)
;; Kill manually so we don't save output to logs.
(let (kill-emacs) (kill-emacs 0))))
;;
;;; Last minute initialization
(when noninteractive
(doom-run-hooks 'doom-before-init-hook))
(provide 'doom-cli) (provide 'doom-cli)
;;; doom-cli.el ends here ;;; doom-cli.el ends here