refactor(cli): reorganize CLI library
* 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
parent
a29041735c
commit
5222612527
2 changed files with 532 additions and 55 deletions
482
lisp/cli/meta.el
Normal file
482
lisp/cli/meta.el
Normal 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
105
lisp/doom-cli.el
|
|
@ -6,6 +6,7 @@
|
|||
;; expects a noninteractive session, so take care when testing code!
|
||||
;;
|
||||
;;; Code:
|
||||
|
||||
(when noninteractive
|
||||
;; 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
|
||||
|
|
@ -72,12 +73,20 @@
|
|||
;; Ensure straight and core packages are ready to go for CLI commands.
|
||||
(require 'doom-modules)
|
||||
(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
|
||||
|
||||
(defgroup doom-cli nil
|
||||
"Doom's command-line interface framework."
|
||||
:link '(url-link "https://doomemacs.org/cli")
|
||||
:group 'doom)
|
||||
|
||||
(defvar doom-cli-load-path
|
||||
(let ((paths (split-string (or (getenv "DOOMPATH") "") path-separator)))
|
||||
(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
|
||||
$EMACSDIR/cli/.")
|
||||
|
||||
;;; CLI definition variables
|
||||
(defvar doom-cli-argument-types
|
||||
'(&args
|
||||
&cli
|
||||
|
|
@ -199,6 +209,7 @@ Recognizies the following properies:
|
|||
:error STR
|
||||
The message to display if a value fails :test.")
|
||||
|
||||
;;; Post-script settings
|
||||
(defvar doom-cli-exit-commands
|
||||
'(;; (:editor . doom-cli--exit-editor)
|
||||
;; (: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.")
|
||||
|
||||
;;; Logger settings
|
||||
(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.
|
||||
|
||||
|
|
@ -225,47 +237,54 @@ Must have two arguments, one for session id and the other for log type.")
|
|||
(defvar doom-cli-log-retain 12
|
||||
"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.")
|
||||
|
||||
(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.")
|
||||
|
||||
(defvar doom-cli-benchmark-threshold 5
|
||||
(defvar doom-cli-log-benchmark-threshold 5
|
||||
"How much execution time (in seconds) before benchmark is shown.
|
||||
|
||||
If set to nil, only display benchmark if a CLI explicitly requested with a
|
||||
non-nil :benchmark property.
|
||||
If set to `always', show the benchmark no matter what.")
|
||||
|
||||
;;; Internal variables
|
||||
(defvar doom-cli--context nil)
|
||||
(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))
|
||||
|
||||
|
||||
;;
|
||||
;;; 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.
|
||||
|
||||
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
|
||||
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 ()
|
||||
"Hooks run before `doom-cli-run' executes the command.
|
||||
(defcustom doom-cli-before-run-functions ()
|
||||
"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 ()
|
||||
"Hooks run after `doom-cli-run' has executed the command.
|
||||
(defcustom doom-cli-after-run-functions ()
|
||||
"Hooks run after `run!' has executed the command.
|
||||
|
||||
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
|
||||
(list fullflag))))
|
||||
(explicit-arg (match-string 2 arg))
|
||||
(argsleft (+ (length args) (if explicit-arg 1 0)))
|
||||
(arity (length (doom-cli-option-arguments option)))
|
||||
(key (if (doom-cli-option-multiple-p option)
|
||||
(car (doom-cli-option-switches option))
|
||||
|
|
@ -1017,13 +1035,13 @@ considered as well."
|
|||
(straight-error
|
||||
(print! (error "The package manager threw an error"))
|
||||
(print! (error "Last %d lines of straight's error log:")
|
||||
doom-cli-straight-error-lines)
|
||||
doom-cli-log-straight-error-lines)
|
||||
(print-group!
|
||||
(print!
|
||||
"%s" (string-join
|
||||
(seq-subseq straight-error
|
||||
(max 0 (- (length straight-error)
|
||||
doom-cli-straight-error-lines))
|
||||
doom-cli-log-straight-error-lines))
|
||||
(length straight-error))
|
||||
"\n")))
|
||||
(print! (warn "Wrote extended straight log to %s")
|
||||
|
|
@ -1034,7 +1052,7 @@ considered as well."
|
|||
error-file))))
|
||||
((eq type '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))
|
||||
(if (doom-cli-context-p context)
|
||||
(print! (error "There was an unexpected runtime error"))
|
||||
|
|
@ -1053,7 +1071,7 @@ considered as well."
|
|||
(when backtrace
|
||||
(print! (bold "Backtrace:"))
|
||||
(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
|
||||
(cons (backtrace-frame-fun 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
|
||||
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
|
||||
shown."
|
||||
`doom-cli-log-benchmark-threshold' is nil), under no condition should a
|
||||
benchmark be shown."
|
||||
(doom-cli-redirect-output context
|
||||
(doom-log "%s (GCs: %d, elapsed: %.6fs)"
|
||||
(if (= doom-cli--exit-code 254) "Restarted" "Finished")
|
||||
|
|
@ -1126,10 +1144,10 @@ shown."
|
|||
(seconds (- duration (* hours 60 60) (* minutes 60))))
|
||||
(when (and (/= doom-cli--exit-code 254)
|
||||
(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)
|
||||
(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)))))
|
||||
(print! (success "Finished in %s")
|
||||
(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))
|
||||
(path (locate-file-internal path doom-cli-load-path load-suffixes)))
|
||||
(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))
|
||||
(let* ((key (doom-cli-key cli))
|
||||
(cli (gethash key doom-cli--table)))
|
||||
|
|
@ -1700,7 +1718,7 @@ ignored.
|
|||
(&whole plist &key
|
||||
alias autoload _benchmark docs disable hide _group partial
|
||||
_prefix)
|
||||
(append (list ,@plist) doom-cli--plist)
|
||||
(append (list ,@plist) doom-cli--group-plist)
|
||||
(unless disable
|
||||
(let* ((command (doom-cli-command-normalize (backquote ,commandspec) plist))
|
||||
(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.
|
||||
TARGET is simply a command list.
|
||||
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)
|
||||
:docs (format "An obsolete alias for '%s'." (doom-cli-command-string ncommand))
|
||||
: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)
|
||||
"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))
|
||||
(commands (doom-cli--command-expand commandspec))
|
||||
(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."
|
||||
(when (stringp (car 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)
|
||||
(while (keywordp (car body))
|
||||
(let ((key (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)
|
||||
`(append (plist-get doom-cli--plist ,key)
|
||||
`(append (plist-get doom-cli--group-plist ,key)
|
||||
(ensure-list ,val))
|
||||
val))
|
||||
forms)))
|
||||
|
|
@ -1982,34 +2000,11 @@ errors to `doom-cli-error-file')."
|
|||
(defalias 'git! (doom-partial #'straight--process-run "git"))
|
||||
|
||||
|
||||
|
||||
;;
|
||||
;;; Predefined CLIs
|
||||
|
||||
;; Load standard :help and :version handlers.
|
||||
(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))
|
||||
(load! "cli/meta") ; :help, :version, and :dump
|
||||
|
||||
(provide 'doom-cli)
|
||||
;;; doom-cli.el ends here
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue