refactor!(cli): rewrite CLI framework libraries
BREAKING CHANGE: this changes Doom's CLI framework in subtle ways, which is listed in greater detail below. If you've never extended Doom's CLI, then this won't affect you, but otherwise it'd be recommended you read on below. This commit focuses on the CLI framework itself and backports some foundational changes to its DSL and how it resolves command line arguments to CLIs, validates input, displays documentation, and persists state across sessions -- and more. This is done in preparation for the final stretch towarding completing the CLI rewrite (see #4273). This is also an effort to generalize Doom's CLI (both its framework and bin/doom), to increase it versatility and make it a viable dev tool for other Doom projects (on our Github org) and beyond. However, there is a *lot* to cover so I'll try to be brief: - Refactor: generalize Doom's CLI framework by moving all bin/doom specific configuration/commands out of core-cli into bin/doom. This makes it easier to use bin/doom as a project-agnostic development tool (or for users to write their own). - Refactor: change the namespace for CLI variables/functions from doom-cli-X to doom-X. - Fix: subcommands being mistaken as arguments. "doom make index" will resolve to (defcli! (doom make index)) if it exists, otherwise (defcli! (doom make)) with "index" as an argument. Before this, it would resolve to the latter no matter what. &rest can override this; with (defcli! (doom make) (&rest args)), (defcli! (doom make index)) will never be invoked. - Refactor!: redesign our output library (was core/autoload/output.el, is now core/autoload/print.el), and how our CLI framework buffers and logs output, and now merges logs across (exit! ...) restarts. - Feat: add support for :before and :after pseudo commands. E.g. (defcli! (:before doom help) () ...) (defcli! (:after doom sync) () ...) Caveat: unlike advice, only one of each can be defined per-command. - Feat: option arguments now have rudimentary type validation (see `doom-cli-option-arg-types`). E.g. (defcli! (doom foo) ((foo ("--foo" num))) ...) If NUM is not a numeric, it will throw a validation error. Any type that isn't in `doom-cli-option-arg-types` will be treated as a wildcard string type. `num` can also be replaced with a specification, e.g. "HOST[:PORT]", and can be formatted by using symbol quotes: "`HOST'[:`PORT']". - Feat: it is no longer required that options *immediately* follow the command that defines them (but it must be somewhere after it, not before). E.g. With: (defcli! (:before doom foo) ((foo ("--foo"))) ...) (defcli! (doom foo baz) () ...) Before: FAIL: doom --foo foo baz GOOD: doom foo --foo baz FAIL: doom foo baz --foo After: FAIL: doom --foo foo baz GOOD: doom foo --foo baz GOOD: doom foo baz --foo - Refactor: CLI session state is now kept in a doom-cli-context struct (which can be bound to a CLI-local variable with &context in the arglist): (defcli! (doom sync) (&context context) (print! "Command: " (doom-cli-context-command context))) These contexts are persisted across sessions (when restarted). This is necessary to support seamless script restarting (i.e. execve emulation) in post-3.0. - Feat: Doom's CLI framework now understands "--". Everything after it will be treated as regular arguments, instead of sub-commands or options. - Refactor!: the semantics of &rest for CLIs has changed. It used to be "all extra literal, non-option arguments". It now means *all* unprocessed arguments, and its use will suppress "unrecognized option" errors, and tells the framework not to process any further subcommands. Use &args if you just want "all literal arguments following this command". - Feat: add new auxiliary keywords for CLI arglists: &context, &multiple, &flags, &args, &stdin, &whole, and &cli. - &context SYM: binds the currently running context to SYM (a `doom-cli-context` struct). Helpful for introspection or passing along state when calling subcommands by hand (with `call!`). - &stdin SYM: SYM will be bound to a string containing any input piped into the running script, or nil if none. Use `doom-cli-context-pipe-p` to detect whether the script has been piped into or out of. - &multiple OPTIONS...: allows all following OPTIONS to be repeated. E.g. "foo -x a -x b -x c" will pass (list ("-x" . "a") ("-x" . "b") ("-x" . "c")) as -x's value. - &flags OPTIONS...: All options after "&flags" get an implicit --no-* switch and cannot accept arguments. Will be set to :yes or :no depending on which flag is provided, and nil if the flag isn't provided. Otherwise, a default value can be specified in that options' arglist. E.g. (defcli! (doom foo) (&flags (foo ("--foo" :no))) ...) When called, this command sets FOO to :yes if --foo, :no if --no-foo, and defaults to :no otherwise. - &args SYM: this replaces what &rest used to be; it binds to SYM a list of all unprocessed (non-option) arguments. - &rest SYM: now binds SYM to a list of all unprocessed arguments, including options. This also suppresses "unrecognized option" errors, but will render any sub-commands inaccessible. E.g. (defcli! (doom make) (&rest rest) ...) ;; These are now inaccessible! (defcli! (doom make foo) (&rest rest) ...) (defcli! (doom make bar) (&rest rest) ...) - &cli SYM: binds SYM to the currently running `doom-cli` struct. Can also be obtained via `(doom-cli-get (doom-cli-context-command context))`. Possibly useful for introspection. - feat: add defobsolete! macro for quickly defining obsolete commands. - feat: add defalias! macro for quickly defining alias commands. - feat: add defautoload! macro for defining an autoloaded command (won't be loaded until it is called for). - refactor!: rename defcligroup! to defgroup! for consistency. - fix: CLIs will now recursively inherit plist properties from parent defcli-group!'s (but will stack :prefix). - refactor!: remove obsolete 'doom update': - refactor!: further generalize 'doom ci' - In an effort to generalize 'doom ci' (so other Doom--or non-doom--projects can use it), all its subcommands have been changed to operate on the current working directory's repo instead of $EMACSDIR. - Doom-specific CI configuration was moved to .github/ci.el. - All 'doom ci' commands will now preload one of \$CURRENT_REPO_ROOT/ci.el or \$DOOMDIR/ci.el before executing. - refactor!: changed 'doom env' - 'doom env {-c,--clear}' is now 'doom env {clear,c}' - -r/--reject and -a/--allow may now be specified multiple times - refactor!: rewrote CLI help framework and error handling to be more sophisticated and detailed. - feat: can now initiate $PAGER on output with (exit! :pager) (or use :pager? to only invoke pager is output is longer than the terminal is tall). - refactor!: changed semantics+conventions for global bin/doom options - Single-character global options are now uppercased, to distinguish them from local options: - -d (for debug mode) is now -D - -y (to suppress prompts) is now -! - -l (to load elisp) is now -L - -h (short for --help) is now -? - Replace --yes/-y switches with --force/-! - -L/--load FILE: now silently ignores file errors. - Add --strict-load FILE: does the same as -L/--load, but throws an error if FILE does not exist/is unreadable. - Add -E/--eval FORM: evaluates arbitrary lisp before commands are processed. - -L/--load, --strict-load, and -E/--eval can now be used multiple times in one command. - Add --pager COMMAND to specify an explicit pager. Will also obey $DOOMPAGER envvar. Does not obey $PAGER. - Fix #3746: which was likely caused by the generated post-script overwriting the old mid-execution. By salting the postscript filenames (with both an overarching session ID and a step counter). - Docs: document websites, environment variables, and exit codes in 'doom --help' - Feat: add imenu support for def{cli,alias,obsolete}! Ref: #4273 Fix: #3746 Fix: #3844
This commit is contained in:
Henrik Lissner
parent
6c5537b487
commit
6c0b7e1530
28 changed files with 4068 additions and 1828 deletions
416
bin/doom
416
bin/doom
|
|
@ -1,25 +1,81 @@
|
|||
#!/usr/bin/env sh
|
||||
:; set -e # -*- mode: emacs-lisp; lexical-binding: t -*-
|
||||
:; case "$EMACS" in *term*) EMACS=emacs ;; *) EMACS="${EMACS:-emacs}" ;; esac
|
||||
:; $EMACS --version >/dev/null 2>&1 || { >&2 echo "Can't find emacs in your PATH"; exit 1; }
|
||||
:; $EMACS --no-site-file --script "$0" -- "$@" || __DOOMCODE=$?
|
||||
:; [ "${__DOOMCODE:-0}" -eq 128 ] && { sh "`$EMACS -Q --batch --eval '(princ temporary-file-directory)'`/doom.sh" "$0" "$@" && true; __DOOMCODE=$?; }
|
||||
:; exit $__DOOMCODE
|
||||
:; tmpdir=`$EMACS -Q --batch --eval '(princ (temporary-file-directory))' 2>/dev/null`
|
||||
:; [ -z "$tmpdir" ] && { >&2 echo "Error: failed to run Emacs with command '$EMACS'"; >&2 echo; >&2 echo "Are you sure Emacs is installed and in your \$PATH?"; exit 1; }
|
||||
:; export __DOOMPID="${__DOOMPID:-$$}"
|
||||
:; export __DOOMSTEP="$((__DOOMSTEP+1))"
|
||||
:; export __DOOMGEOM="${__DOOMGEOM:-`tput cols lines 2>/dev/null`}"
|
||||
:; export __DOOMGPIPE=${__DOOMGPIPE:-$__DOOMPIPE}
|
||||
:; export __DOOMPIPE=; [ -t 0 ] || __DOOMPIPE+=0; [ -t 1 ] || __DOOMPIPE+=1
|
||||
:; $EMACS -Q --batch --load "$0" -- "$@" || exit=$?
|
||||
:; [ "${exit:-0}" -eq 254 ] && { sh "${tmpdir}/doom.${__DOOMPID}.${__DOOMSTEP}.sh" "$0" "$@" && true; exit="$?"; }
|
||||
:; exit $exit
|
||||
|
||||
;; The garbage collector isn't as important during CLI ops. A higher threshold
|
||||
;; makes it 15-30% faster, but set it too high and we risk runaway memory usage
|
||||
;; in longer sessions.
|
||||
(setq gc-cons-threshold 134217728) ; 128mb
|
||||
;; This magical mess of a shebang is necessary for any script that relies on
|
||||
;; Doom's CLI framework, because Emacs' tty libraries and capabilities are too
|
||||
;; immature (borderline non-existent) at the time of writing (28.1). This
|
||||
;; shebang sets out to accomplish these three goals:
|
||||
;;
|
||||
;; 1. To produce a more helpful error if Emacs isn't installed or broken. It
|
||||
;; must do so without assuming whether $EMACS is a shell command (e.g. 'snap
|
||||
;; run emacs') or an absolute path (to an emacs executable). I've avoided
|
||||
;; 'command -v $EMACS' for this reason.
|
||||
;;
|
||||
;; 2. To allow this Emacs session to "exit into" a child process (since Elisp
|
||||
;; lacks an analogue for exec system calls) by calling an auto-generated and
|
||||
;; self-destructing "exit script" if the parent Emacs process exits with code
|
||||
;; 254. It takes care to prevent nested child instances from clobbering the
|
||||
;; exit script.
|
||||
;;
|
||||
;; 3. To expose some information about the terminal and session:
|
||||
;; - $__DOOMGEOM holds the dimensions of the terminal (W . H).
|
||||
;; - $__DOOMPIPE indicates whether the script has been piped (in and/or out).
|
||||
;; - $__DOOMGPIPE indicates whether one of this process' parent has been
|
||||
;; piped to/from.
|
||||
;; - $__DOOMPID is a unique identifier for the parent script, so
|
||||
;; child processes can identify which persistent data files (like logs) it
|
||||
;; has access to.
|
||||
;; - $__DOOMSTEP counts how many levels deep we are in the dream (appending
|
||||
;; this to the exit script's filename avoids child processes clobbering the
|
||||
;; same exit script and causing read errors).
|
||||
;; - $TMPDIR (or $TEMP and $TMP on Windows) aren't guaranteed to have values,
|
||||
;; and mktemp isn't available on all systems, but you know what is? Emacs!
|
||||
;; So I use it to print `temporary-file-directory'. And it seconds as a
|
||||
;; quick sanity check for Emacs' existence (for goal #1).
|
||||
;;
|
||||
;; Other weird facts about this shebang line:
|
||||
;;
|
||||
;; - The :; hack exploits properties of : and ; in shell scripting and elisp to
|
||||
;; allow shell script and elisp to coexist in the same file without either's
|
||||
;; interpreter throwing foreign syntax errors:
|
||||
;;
|
||||
;; - In elisp, ":" is a valid keyword symbol literal; it evaluates to itself
|
||||
;; and has no side-effect.
|
||||
;; - In the shell, ":" is a valid command that does nothing and ignores its
|
||||
;; arguments.
|
||||
;; - In elisp, ";" begins a comment. I.e. the interpreter ignores everything
|
||||
;; after it.
|
||||
;; - In the shell, ";" is a command separator.
|
||||
;;
|
||||
;; Put together, plus a strategically placed exit call, the shell will read
|
||||
;; one part of this file and ignore the rest, while the elisp interpreter will
|
||||
;; do the opposite.
|
||||
;; - I intentionally avoid loading site files (using -Q), because
|
||||
;; core/core-cli.el loads them by hand later. There, I can suppress and deal
|
||||
;; with unhelpful warnings (e.g. "package cl is deprecated"), "Loading
|
||||
;; X...DONE" spam, and any other disasterous side-effects.
|
||||
;; - POSIX-compliancy is paramount: there's no guarantee what /bin/sh will be
|
||||
;; symlinked to in the esoteric OSes/distros Emacs users use.
|
||||
;; - The user may have a noexec flag set on /tmp, so pass the exit script to
|
||||
;; /bin/sh rather than executing them directly.
|
||||
|
||||
;; Prioritize non-byte-compiled source files in non-interactive sessions to
|
||||
;; prevent loading stale byte-code.
|
||||
(setq load-prefer-newer t)
|
||||
|
||||
;; Ensure Doom runs out of this file's parent directory, where Doom is
|
||||
;; presumably installed. Use the EMACSDIR envvar to change this.
|
||||
;; Ensure Doom runs out of this file's parent directory (or $EMACSDIR), where
|
||||
;; Doom is presumably installed.
|
||||
(setq user-emacs-directory
|
||||
(if (getenv-internal "EMACSDIR")
|
||||
(file-name-as-directory (expand-file-name (getenv-internal "EMACSDIR")))
|
||||
(file-name-as-directory
|
||||
(file-truename (getenv-internal "EMACSDIR")))
|
||||
(expand-file-name
|
||||
"../" (file-name-directory (file-truename load-file-name)))))
|
||||
|
||||
|
|
@ -27,140 +83,222 @@
|
|||
;;
|
||||
;;; Sanity checks
|
||||
|
||||
(when (version< emacs-version "27.1")
|
||||
(error
|
||||
(concat "Detected Emacs " emacs-version " (at " (car command-line-args) ").\n\n"
|
||||
"Doom only supports Emacs 27.1 and newer. A guide to install a newer version\n"
|
||||
"of Emacs can be found at:\n\n "
|
||||
(format "https://doomemacs.org/docs/getting_started.org#%s\n"
|
||||
(cond ((eq system-type 'darwin) "on-macos")
|
||||
((memq system-type '(cygwin windows-nt ms-dos)) "on-windows")
|
||||
("on-linux")))
|
||||
"Aborting...")))
|
||||
|
||||
(unless (file-readable-p (expand-file-name "core/core.el" user-emacs-directory))
|
||||
(error
|
||||
(concat
|
||||
"Couldn't find or read '"
|
||||
(abbreviate-file-name
|
||||
(expand-file-name "core/core.el" user-emacs-directory))
|
||||
"'.\n\n"
|
||||
"Are you sure Doom Emacs is correctly installed?\n\n"
|
||||
(when (file-symlink-p load-file-name)
|
||||
(concat "This error can occur if you've symlinked the 'doom' script, which Doom does not\n"
|
||||
"support. Consider symlinking its parent directory instead or explicitly set the\n"
|
||||
"EMACSDIR environment variable, e.g.\n\n "
|
||||
(if (string-match-p "/fish$" (getenv "SHELL"))
|
||||
"env EMACSDIR=~/.emacs.d doom"
|
||||
"EMACSDIR=~/.emacs.d doom sync"))
|
||||
"\n\n")
|
||||
"Aborting...")))
|
||||
|
||||
(when (equal (user-real-uid) 0)
|
||||
;; If ~/.emacs.d is owned by root, assume the user genuinely wants root to be
|
||||
;; their primary user.
|
||||
;; their primary user, otherwise complain.
|
||||
(unless (= 0 (file-attribute-user-id (file-attributes user-emacs-directory)))
|
||||
(error
|
||||
(message
|
||||
(concat
|
||||
"Do not run this script as root. It will cause file permissions errors later.\n\n"
|
||||
"To carry on anyway, change the owner of your Emacs config to root:\n\n"
|
||||
"Error: this script is being run as root, which is likely not what you want.\n"
|
||||
"It will cause file permissions errors later, when you run Doom as another\n"
|
||||
"user.\n\n"
|
||||
"If this really *is* what you want, then change the owner of your Emacs\n"
|
||||
"config to root:\n\n"
|
||||
;; TODO Add cmd.exe/powershell commands
|
||||
" chown root:root -R " (abbreviate-file-name user-emacs-directory) "\n\n"
|
||||
"Aborting..."))))
|
||||
"Aborting..."))
|
||||
(kill-emacs 2)))
|
||||
|
||||
|
||||
;;
|
||||
;;; Let 'er rip!
|
||||
;;; Load Doom's CLI framework
|
||||
|
||||
;; HACK Load `cl' and site files manually to prevent polluting logs and stdout
|
||||
;; with deprecation and/or file load messages.
|
||||
(let ((inhibit-message t))
|
||||
(require 'cl)
|
||||
(unless site-run-file
|
||||
(let ((site-run-file "site-start")
|
||||
(verbose (or (getenv "DEBUG") init-file-debug))
|
||||
(tail load-path)
|
||||
(lispdir (expand-file-name "../lisp" data-directory))
|
||||
dir)
|
||||
(while tail
|
||||
(setq dir (car tail))
|
||||
(let ((default-directory dir))
|
||||
(load (expand-file-name "subdirs.el") t (not verbose) t))
|
||||
(or (string-prefix-p lispdir dir)
|
||||
(let ((default-directory dir))
|
||||
(load (expand-file-name "leim-list.el") t (not verbose) t)))
|
||||
(setq tail (cdr tail)))
|
||||
(load site-run-file t (not verbose)))))
|
||||
(require 'core-cli (expand-file-name "core/core-cli" user-emacs-directory))
|
||||
|
||||
;; 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)
|
||||
|
||||
(kill-emacs
|
||||
;; Process the arguments passed to this script. `doom-cli-execute' should
|
||||
;; return one of two things: a cons cell whose CAR is t, and CDR is the
|
||||
;; command's return value OR one of: a keyword, command string, or command
|
||||
;; list.
|
||||
(pcase (apply #'doom-cli-execute :doom (cdr (member "--" argv)))
|
||||
;;
|
||||
;;; Entry point
|
||||
|
||||
;; If a CLI command returns an integer, treat it as an exit code.
|
||||
((and (app car-safe `t) code)
|
||||
(if (integerp (cdr code))
|
||||
(cdr code)))
|
||||
(defcli! doom (&args _command)
|
||||
"A command line interface to Doom Emacs.
|
||||
|
||||
;; CLI commands can do (throw 'exit SHELL-COMMAND) to run something after
|
||||
;; this session ends. e.g.
|
||||
;;
|
||||
;; (throw 'exit "$@") or (throw 'exit :restart)
|
||||
;; This reruns the current command with the same arguments.
|
||||
;; (throw 'exit "$@ -h -c")
|
||||
;; This reruns the current command with two new switches.
|
||||
;; (throw 'exit "emacs -nw FILE")
|
||||
;; Opens Emacs on FILE
|
||||
;; (throw 'exit t) or (throw 'exit nil)
|
||||
;; A safe way to simply abort back to the shell with exit code 0
|
||||
;; (throw 'exit 42)
|
||||
;; Abort to shell with an explicit exit code (as a more abrupt
|
||||
;; alternative to having the CLI command return 42).
|
||||
;;
|
||||
;; How this works: the command is written to a temporary shell script which
|
||||
;; is executed after this session ends (see the shebang lines of this file).
|
||||
;; It's done this way because Emacs' batch library lacks an implementation of
|
||||
;; the exec system call.
|
||||
(command
|
||||
(cond
|
||||
((integerp command)
|
||||
command)
|
||||
((booleanp command)
|
||||
0)
|
||||
((let ((script (expand-file-name "doom.sh" temporary-file-directory))
|
||||
(coding-system-for-write 'utf-8-unix)
|
||||
(coding-system-for-read 'utf-8-unix))
|
||||
(with-temp-file script
|
||||
(insert "#!/usr/bin/env sh\n"
|
||||
"_postscript() {\n"
|
||||
" rm -f " (shell-quote-argument script) "\n "
|
||||
(cond ((eq command :restart) "$@")
|
||||
((stringp command) command)
|
||||
((listp command)
|
||||
(string-join
|
||||
(if (listp (car-safe command))
|
||||
(cl-loop for line in (doom-enlist command)
|
||||
collect (mapconcat #'shell-quote-argument (remq nil line) " "))
|
||||
(list (mapconcat #'shell-quote-argument (remq nil command) " ")))
|
||||
"\n ")))
|
||||
"\n}\n"
|
||||
(save-match-data
|
||||
(cl-loop for env
|
||||
in (cl-set-difference process-environment
|
||||
(get 'process-environment 'initial-value)
|
||||
:test #'equal)
|
||||
if (string-match "^\\([a-zA-Z0-9_]+\\)=\\(.+\\)$" env)
|
||||
concat (format "%s=%s \\\n"
|
||||
(match-string 1 env)
|
||||
(shell-quote-argument (match-string 2 env)))))
|
||||
(format "PATH=\"%s%s$PATH\" \\\n" (concat doom-emacs-dir "bin/") path-separator)
|
||||
"_postscript $@\n"))
|
||||
(set-file-modes script #o600)
|
||||
;; Error code 128 is special: it means run the post-script after this
|
||||
;; session ends.
|
||||
128))))))
|
||||
Includes package management, diagnostics, unit tests, and byte-compilation.
|
||||
|
||||
This tool also makes it trivial to launch Emacs out of a different folder or
|
||||
with a different private module.
|
||||
|
||||
ENVIRONMENT VARIABLES:
|
||||
`$EMACS'
|
||||
The Emacs executable or command to use for any Emacs operations in this or
|
||||
other Doom CLI shell scripts (default: first emacs found in `$PATH').
|
||||
|
||||
`$EMACSDIR'
|
||||
The location of your Doom Emacs installation (defaults to ~/.config/emacs or
|
||||
~/.emacs.d; whichever is found first). This is *not* your private Doom
|
||||
configuration. The `--emacsdir' option also sets this variable.
|
||||
|
||||
`$DOOMDIR'
|
||||
The location of your private configuration for Doom Emacs (defaults to
|
||||
~/.config/doom or ~/.doom.d; whichever it finds first). This is *not* the
|
||||
place you've cloned doomemacs/doomemacs to. The `--doomdir' option also sets
|
||||
this variable.
|
||||
|
||||
`$DOOMPAGER'
|
||||
The pager to invoke for large output (default: \"less +g\"). The `--pager'
|
||||
option also sets this variable.
|
||||
|
||||
`$DOOMPROFILE'
|
||||
(Not implemented yet) Which Doom profile to activate (default: \"current\").
|
||||
|
||||
`$DOOMPROFILESDIR'
|
||||
(Not implemented yet) Where to find or write generated Doom profiles
|
||||
(default: `$EMACSDIR'/profiles).
|
||||
|
||||
EXIT CODES:
|
||||
0 Successful run
|
||||
1 General internal error
|
||||
2 Error with Emacs/Doom install or execution context
|
||||
3 Unrecognized user input error
|
||||
4 Command not found, or is incorrect/deprecated
|
||||
5 Invalid, missing, or extra options/arguments
|
||||
6-49 Reserved for Doom
|
||||
50-200 Reserved for custom user codes
|
||||
254 Successful run (but then execute `doom-cli-restart-script')
|
||||
255 Uncaught internal errors
|
||||
|
||||
SEE ALSO:
|
||||
https://doomemacs.org Homepage
|
||||
https://docs.doomemacs.org Official documentation
|
||||
https://discourse.doomemacs.org Discourse (discussion & support forum)
|
||||
https://doomemacs.org/discord Discord chat server
|
||||
https://doomemacs.org/roadmap Development roadmap
|
||||
https://git.doomemacs.org Shortcut to Github org
|
||||
https://git.doomemacs.org/issues Global issue tracker"
|
||||
:partial t)
|
||||
|
||||
(defcli! (:before doom)
|
||||
((force? ("-!" "--force") "Suppress prompts by auto-accepting their consequences")
|
||||
(debug? ("-D" "--debug") "Enable verbose output")
|
||||
(doomdir ("--doomdir" dir) "Use Doom config living in `DIR' (e.g. ~/.doom.d)")
|
||||
(emacsdir ("--emacsdir" dir) "Use Doom install living in `DIR' (e.g. ~/.emacs.d)")
|
||||
(pager ("--pager" bool) "Pager command to use for large output")
|
||||
;; TODO Implement after v3.0
|
||||
;; (profile ("--profile" name) "Use profile named NAME")
|
||||
&flags
|
||||
(color? ("--color") "Whether or not to show ANSI color codes")
|
||||
&multiple
|
||||
(loads ("-L" "--load" "--strict-load" file) "Load elisp `FILE' before executing `COMMAND'")
|
||||
(evals ("-E" "--eval" form) "Evaluate `FORM' before executing commands")
|
||||
&input input
|
||||
&context context
|
||||
&args _)
|
||||
"OPTIONS:
|
||||
-E, -eval
|
||||
Can be used multiple times.
|
||||
|
||||
-L, --load, --strict-load
|
||||
Can be used multiple times to load multiple files. Both -L and --load will
|
||||
silently fail on missing files, but --strict-load won't.
|
||||
|
||||
Warning: files loaded this way load too late to define new commands. To
|
||||
define commands, do so from `$DOOMDIR'/cli.el or `$DOOMDIR'/init.el
|
||||
instead."
|
||||
(when color?
|
||||
(setq doom-print-backend (if (eq color? :yes) 'ansi)))
|
||||
(when (and (equal (doom-cli-context-step context) 0)
|
||||
(or ;; profile
|
||||
debug?
|
||||
force?
|
||||
emacsdir
|
||||
doomdir
|
||||
pager))
|
||||
;; TODO Implement after v3.0
|
||||
;; (when profile
|
||||
;; (setenv "DOOMPROFILE" profile))
|
||||
(when debug?
|
||||
(setenv "DEBUG" "1")
|
||||
(print! (item "Debug mode enabled")))
|
||||
(when force?
|
||||
(setenv "__DOOMFORCE" (and force? "1"))
|
||||
(print! (item "Suppressing all prompts")))
|
||||
(when emacsdir
|
||||
(setenv "EMACSDIR" emacsdir))
|
||||
(when doomdir
|
||||
(setenv "DOOMDIR" doomdir))
|
||||
(when pager
|
||||
(setenv "DOOMPAGER" pager))
|
||||
(exit! :restart))
|
||||
;; Load $DOOMDIR/init.el, so users can customize things, if they like.
|
||||
(doom-log "Loading $DOOMDIR/init.el")
|
||||
(load! doom-module-init-file doom-private-dir t)
|
||||
;; Load extra files and forms, as per given options.
|
||||
(dolist (file loads)
|
||||
(load (doom-path (cdr file))
|
||||
(not (equal (car file) "--strict-load"))
|
||||
(not doom-debug-p) t))
|
||||
(dolist (form evals)
|
||||
(eval (read (cdr form)) t)))
|
||||
|
||||
|
||||
;;
|
||||
;;; Commands
|
||||
|
||||
(let ((dir (doom-path doom-core-dir "cli")))
|
||||
;; It'd be simple to just load these files directly, but because there could
|
||||
;; be a lot of them (and some of them have expensive dependencies), I use
|
||||
;; `defautoload!' to load them lazily.
|
||||
(add-to-list 'doom-cli-load-path dir)
|
||||
|
||||
;; Library for generating autoloads files for Doom modules & packages.
|
||||
(load! "autoloads" dir)
|
||||
|
||||
(defgroup!
|
||||
:prefix 'doom
|
||||
;; Import this for implicit 'X help' commands for your script:
|
||||
(defalias! ((help h)) (:root :help))
|
||||
;; And suggest its use when errors occur.
|
||||
(add-to-list 'doom-help-commands "%p h[elp] %c")
|
||||
|
||||
(defgroup! "Config Management"
|
||||
:docs "Commands for maintaining your Doom Emacs configuration."
|
||||
(defautoload! ((sync s)))
|
||||
(defautoload! ((upgrade up)))
|
||||
(defautoload! (env))
|
||||
(defautoload! ((build b purge p rollback)) "packages")
|
||||
(defautoload! ((install i)))
|
||||
(defautoload! ((compile c)))
|
||||
|
||||
;; TODO Post-3.0 commands
|
||||
;; (load! "gc" dir)
|
||||
;; (load! "module" dir)
|
||||
;; (load! "nuke" dir)
|
||||
;; (load! "package" dir)
|
||||
;; (load! "profile" dir)
|
||||
;; (defobsolete! ((compile c)) "doom sync --compile" "v3.0.0")
|
||||
;; (defobsolete! ((build b)) "doom sync --rebuild" "v3.0.0")
|
||||
)
|
||||
|
||||
(defgroup! "Diagnostics"
|
||||
:docs "Commands for troubleshooting and debugging Doom."
|
||||
(defautoload! ((doctor doc)))
|
||||
(defautoload! (info))
|
||||
(defalias! ((version v)) (:root :version)))
|
||||
|
||||
(defgroup! "Development"
|
||||
:docs "Commands for developing or launching Doom."
|
||||
(defautoload! (ci))
|
||||
;; TODO (defautoload! (make))
|
||||
(defautoload! (run))
|
||||
|
||||
;; FIXME Test framework
|
||||
;; (load! "test" dir)
|
||||
)
|
||||
|
||||
(let ((cli-file "cli"))
|
||||
(defgroup! "Module commands"
|
||||
(dolist (key (hash-table-keys doom-modules))
|
||||
(when-let* ((path (plist-get (gethash key doom-modules) path))
|
||||
(path (car (doom-glob path cli-file))))
|
||||
(defgroup! :prefix (format "+%s" (cdr key))
|
||||
(defautoload! () path)))))
|
||||
|
||||
(doom-log "Loading $DOOMDIR/cli.el")
|
||||
(load! cli-file doom-private-dir t))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Let 'er rip
|
||||
|
||||
(run! "doom" (cdr (member "--" argv)))
|
||||
|
||||
;;; doom ends here, unless...
|
||||
|
|
|
|||
|
|
@ -7,7 +7,9 @@
|
|||
(defvar doom-debug-variables
|
||||
'(async-debug
|
||||
debug-on-error
|
||||
(debugger . doom-debugger)
|
||||
doom-debug-p
|
||||
(doom-print-level . debug)
|
||||
garbage-collection-messages
|
||||
gcmh-verbose
|
||||
init-file-debug
|
||||
|
|
@ -67,6 +69,73 @@ symbol and CDR is the value to set it to when `doom-debug-mode' is activated.")
|
|||
(message "Debug mode %s" (if enabled "on" "off"))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Custom debuggers
|
||||
|
||||
(autoload 'backtrace-get-frames "backtrace")
|
||||
|
||||
(defun doom-backtrace ()
|
||||
"Return a stack trace as a list of `backtrace-frame' objects."
|
||||
;; (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) 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)))
|
||||
;; (nreverse frame-list))
|
||||
(cdr (backtrace-get-frames debugger)))
|
||||
|
||||
(defun doom-backtrace-write-to-file (backtrace file)
|
||||
"Write BACKTRACE to FILE with appropriate boilerplate."
|
||||
(make-directory (file-name-directory file) t)
|
||||
(let ((doom-print-indent 0))
|
||||
(with-temp-file file
|
||||
(insert ";; -*- lisp-interaction -*-\n")
|
||||
(insert ";; vim: set ft=lisp:\n")
|
||||
(insert (format ";; command=%S\n" command-line-args))
|
||||
(insert (format ";; date=%S\n\n" (format-time-string "%Y-%m-%d %H-%M-%S" before-init-time)))
|
||||
(insert ";;;; ENVIRONMENT\n" (with-output-to-string (doom/version)) "\n")
|
||||
(let ((standard-output (current-buffer))
|
||||
(print-quoted t)
|
||||
(print-escape-newlines t)
|
||||
(print-escape-control-characters t)
|
||||
(print-symbols-bare t)
|
||||
(print-level nil)
|
||||
(print-circle nil)
|
||||
(n -1))
|
||||
(mapc (lambda (frame)
|
||||
(princ (format ";;;; %d\n" (cl-incf n)))
|
||||
(pp (list (cons (backtrace-frame-fun frame)
|
||||
(backtrace-frame-args frame))
|
||||
(backtrace-frame-locals frame)))
|
||||
(terpri))
|
||||
backtrace))
|
||||
file)))
|
||||
|
||||
(defun doom-debugger (&rest args)
|
||||
"Enter `debugger' in interactive sessions, `doom-cli-debugger' otherwise.
|
||||
|
||||
Writes backtraces to file and ensures the backtrace is recorded, so the user can
|
||||
always access it."
|
||||
(let ((backtrace (doom-backtrace)))
|
||||
;; Work around Emacs's heuristic (in eval.c) for detecting errors in the
|
||||
;; debugger, which would run this handler again on subsequent calls. Taken
|
||||
;; from `ert--run-test-debugger'.
|
||||
(cl-incf num-nonmacro-input-events)
|
||||
;; TODO Write backtraces to file
|
||||
;; TODO Write backtrace to a buffer in case recursive error interupts the
|
||||
;; debugger (happens more often than it should).
|
||||
(apply #'debug args)))
|
||||
|
||||
|
||||
;;
|
||||
;;; Time-stamped *Message* logs
|
||||
|
||||
|
|
|
|||
|
|
@ -1,278 +0,0 @@
|
|||
;;; core/autoload/output.el -*- lexical-binding: t; -*-
|
||||
|
||||
(defvar doom-output-ansi-alist
|
||||
'(;; fx
|
||||
(bold 1 :weight bold)
|
||||
(dark 2)
|
||||
(italic 3 :slant italic)
|
||||
(underscore 4 :underline t)
|
||||
(blink 5)
|
||||
(rapid 6)
|
||||
(contrary 7)
|
||||
(concealed 8)
|
||||
(strike 9 :strike-through t)
|
||||
;; fg
|
||||
(black 30 term-color-black)
|
||||
(red 31 term-color-red)
|
||||
(green 32 term-color-green)
|
||||
(yellow 33 term-color-yellow)
|
||||
(blue 34 term-color-blue)
|
||||
(magenta 35 term-color-magenta)
|
||||
(cyan 36 term-color-cyan)
|
||||
(white 37 term-color-white)
|
||||
;; bg
|
||||
(on-black 40 term-color-black)
|
||||
(on-red 41 term-color-red)
|
||||
(on-green 42 term-color-green)
|
||||
(on-yellow 43 term-color-yellow)
|
||||
(on-blue 44 term-color-blue)
|
||||
(on-magenta 45 term-color-magenta)
|
||||
(on-cyan 46 term-color-cyan)
|
||||
(on-white 47 term-color-white))
|
||||
"An alist of fg/bg/fx names mapped to ansi codes and term-color-* variables.
|
||||
|
||||
This serves as the cipher for converting (COLOR ...) function calls in `print!'
|
||||
and `format!' into colored output, where COLOR is any car of this list.")
|
||||
|
||||
(defvar doom-output-class-alist
|
||||
`((color . doom--output-color)
|
||||
(class . doom--output-class)
|
||||
(indent . doom--output-indent)
|
||||
(autofill . doom--output-autofill)
|
||||
(success . (lambda (str &rest args)
|
||||
(apply #'doom--output-color 'green (format "✓ %s" str) args)))
|
||||
(warn . (lambda (str &rest args)
|
||||
(apply #'doom--output-color 'yellow (format "! %s" str) args)))
|
||||
(error . (lambda (str &rest args)
|
||||
(apply #'doom--output-color 'red (format "x %s" str) args)))
|
||||
(info . (lambda (str &rest args)
|
||||
(concat "- " (if args (apply #'format str args) str))))
|
||||
(start . (lambda (str &rest args)
|
||||
(concat "> " (if args (apply #'format str args) str))))
|
||||
(debug . (lambda (str &rest args)
|
||||
(if doom-debug-p
|
||||
(apply #'doom--output-color 'dark
|
||||
(format "- %s" str)
|
||||
args)
|
||||
"")))
|
||||
(path . abbreviate-file-name)
|
||||
(symbol . symbol-name)
|
||||
(relpath . (lambda (str &optional dir)
|
||||
(if (or (not str)
|
||||
(not (stringp str))
|
||||
(string-empty-p str))
|
||||
str
|
||||
(let ((dir (or dir (file-truename default-directory)))
|
||||
(str (file-truename str)))
|
||||
(if (file-in-directory-p str dir)
|
||||
(file-relative-name str dir)
|
||||
(abbreviate-file-name str))))))
|
||||
(filename . file-name-nondirectory)
|
||||
(dirname . (lambda (path)
|
||||
(unless (file-directory-p path)
|
||||
(setq path (file-name-directory path)))
|
||||
(directory-file-name path))))
|
||||
"An alist of text classes that map to transformation functions.
|
||||
|
||||
Any of these classes can be called like functions from within `format!' and
|
||||
`print!' calls, which will transform their input.")
|
||||
|
||||
(defvar doom-output-indent 0
|
||||
"Level to rigidly indent text returned by `format!' and `print!'.")
|
||||
|
||||
(defvar doom-output-indent-increment 2
|
||||
"Steps in which to increment `doom-output-indent' for consecutive levels.")
|
||||
|
||||
(defvar doom-output-backend
|
||||
(if doom-interactive-p 'text-properties 'ansi)
|
||||
"Determines whether to print colors with ANSI codes or with text properties.
|
||||
|
||||
Accepts 'ansi and 'text-properties. nil means don't render colors.")
|
||||
|
||||
|
||||
;;
|
||||
;;; Library
|
||||
|
||||
;;;###autoload
|
||||
(defun doom--format (output)
|
||||
(if (string-empty-p (string-trim output))
|
||||
""
|
||||
(concat (make-string doom-output-indent 32)
|
||||
(replace-regexp-in-string
|
||||
"\n" (concat "\n" (make-string doom-output-indent 32))
|
||||
output t t))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom--print (output)
|
||||
(unless (string-empty-p output)
|
||||
(if noninteractive
|
||||
(send-string-to-terminal output)
|
||||
(princ output))
|
||||
(terpri)
|
||||
output))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom--output-indent (width text &optional prefix)
|
||||
"Indent TEXT by WIDTH spaces. If ARGS, format TEXT with them."
|
||||
(with-temp-buffer
|
||||
(setq text (format "%s" text))
|
||||
(insert text)
|
||||
(indent-rigidly (point-min) (point-max) width)
|
||||
(when (stringp prefix)
|
||||
(when (> width 2)
|
||||
(goto-char (point-min))
|
||||
(beginning-of-line-text)
|
||||
(delete-char (- (length prefix)))
|
||||
(insert prefix)))
|
||||
(buffer-string)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom--output-autofill (&rest msgs)
|
||||
"Ensure MSG is split into lines no longer than `fill-column'."
|
||||
(with-temp-buffer
|
||||
(let ((fill-column 76))
|
||||
(dolist (line msgs)
|
||||
(when line
|
||||
(insert (format "%s" line))))
|
||||
(fill-region (point-min) (point-max))
|
||||
(buffer-string))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom--output-color (style format &rest args)
|
||||
"Apply STYLE to formatted MESSAGE with ARGS.
|
||||
|
||||
STYLE is a symbol that correlates to `doom-output-ansi-alist'.
|
||||
|
||||
In a noninteractive session, this wraps the result in ansi color codes.
|
||||
Otherwise, it maps colors to a term-color-* face."
|
||||
(let* ((code (cadr (assq style doom-output-ansi-alist)))
|
||||
(format (format "%s" format))
|
||||
(message (if args (apply #'format format args) format)))
|
||||
(unless code
|
||||
(error "%S is an invalid color" style))
|
||||
(pcase doom-output-backend
|
||||
(`ansi
|
||||
(format "\e[%dm%s\e[%dm" code message 0))
|
||||
(`text-properties
|
||||
(require 'term) ; piggyback on term's color faces
|
||||
(propertize
|
||||
message
|
||||
'face
|
||||
(append (get-text-property 0 'face format)
|
||||
(cond ((>= code 40)
|
||||
`(:background ,(caddr (assq style doom-output-ansi-alist))))
|
||||
((>= code 30)
|
||||
`(:foreground ,(face-foreground (caddr (assq style doom-output-ansi-alist)))))
|
||||
((cddr (assq style doom-output-ansi-alist)))))))
|
||||
(_ message))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom--output-class (class format &rest args)
|
||||
"Apply CLASS to formatted format with ARGS.
|
||||
|
||||
CLASS is derived from `doom-output-class-alist', and can contain any arbitrary,
|
||||
transformative logic."
|
||||
(let (fn)
|
||||
(cond ((setq fn (cdr (assq class doom-output-class-alist)))
|
||||
(if (functionp fn)
|
||||
(apply fn format args)
|
||||
(error "%s does not have a function" class)))
|
||||
(args (apply #'format format args))
|
||||
(format))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom--output-apply (forms &optional sub)
|
||||
"Replace color-name functions with calls to `doom--output-color'."
|
||||
(cond ((null forms) nil)
|
||||
((listp forms)
|
||||
(append (cond ((not (symbolp (car forms)))
|
||||
(list (doom--output-apply (car forms))))
|
||||
(sub
|
||||
(list (car forms)))
|
||||
((assq (car forms) doom-output-ansi-alist)
|
||||
`(doom--output-color ',(car forms)))
|
||||
((assq (car forms) doom-output-class-alist)
|
||||
`(doom--output-class ',(car forms)))
|
||||
((list (car forms))))
|
||||
(doom--output-apply (cdr forms) t)
|
||||
nil))
|
||||
(forms)))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro format! (message &rest args)
|
||||
"An alternative to `format' that understands (color ...) and converts them
|
||||
into faces or ANSI codes depending on the type of sesssion we're in."
|
||||
`(doom--format (format ,@(doom--output-apply `(,message ,@args)))))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro print-group! (&rest body)
|
||||
"Indents any `print!' or `format!' output within BODY."
|
||||
`(let ((doom-output-indent (+ doom-output-indent-increment doom-output-indent)))
|
||||
,@body))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro print! (message &rest args)
|
||||
"Prints MESSAGE, formatted with ARGS, to stdout.
|
||||
|
||||
Returns non-nil if the message is a non-empty string.
|
||||
|
||||
Can be colored using (color ...) blocks:
|
||||
|
||||
(print! \"Hello %s\" (bold (blue \"How are you?\")))
|
||||
(print! \"Hello %s\" (red \"World\"))
|
||||
(print! (green \"Great %s!\") \"success\")
|
||||
|
||||
Uses faces in interactive sessions and ANSI codes otherwise."
|
||||
`(doom--print (format! ,message ,@args)))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro insert! (message &rest args)
|
||||
"Like `insert'; the last argument must be format arguments for MESSAGE.
|
||||
|
||||
\(fn MESSAGE... ARGS)"
|
||||
`(insert (format! (concat ,message ,@(butlast args))
|
||||
,@(car (last args)))))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro error! (message &rest args)
|
||||
"Like `error', but with the power of `format!'."
|
||||
`(error (format! ,message ,@args)))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro user-error! (message &rest args)
|
||||
"Like `user-error', but with the power of `format!'."
|
||||
`(user-error (format! ,message ,@args)))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro with-output-to! (dest &rest body)
|
||||
"Send all output produced in BODY to DEST.
|
||||
DEST can be one or more of `standard-output', a buffer, a file"
|
||||
(declare (indent 1))
|
||||
`(let* ((log-buffer (generate-new-buffer " *doom log*"))
|
||||
(standard-output
|
||||
(lambda (out)
|
||||
(with-current-buffer log-buffer
|
||||
(insert-char out))
|
||||
(send-string-to-terminal (char-to-string out)))))
|
||||
(letf! (defun message (msg &rest args)
|
||||
(when msg
|
||||
(print-group!
|
||||
(with-current-buffer log-buffer
|
||||
(insert (doom--format (apply #'format msg args)) "\n"))
|
||||
(when (or doom-debug-p (not inhibit-message))
|
||||
(doom--print (doom--format (apply #'format msg args))))))
|
||||
message)
|
||||
(unwind-protect
|
||||
,(macroexp-progn body)
|
||||
(with-current-buffer log-buffer
|
||||
(require 'ansi-color)
|
||||
(ansi-color-filter-region (point-min) (point-max)))
|
||||
(let ((dest ,dest))
|
||||
(cond ((bufferp dest)
|
||||
(with-current-buffer dest
|
||||
(insert-buffer-substring log-buffer)))
|
||||
((stringp dest)
|
||||
(make-directory (file-name-directory dest) 'parents)
|
||||
(with-temp-file dest
|
||||
(insert-buffer-substring log-buffer))))
|
||||
(kill-buffer log-buffer))))))
|
||||
473
core/autoload/print.el
Normal file
473
core/autoload/print.el
Normal file
|
|
@ -0,0 +1,473 @@
|
|||
;;; core/autoload/print.el -*- lexical-binding: t; -*-
|
||||
;;; Commentary
|
||||
;;;
|
||||
;;; This is Doom's output library, for controlling what does and doesn't get
|
||||
;;; logged, and provides a simple DSL for formatting output. It's mainly to
|
||||
;;; serve the noninteractive use-case, as `message' is more than good enough in
|
||||
;;; interactive sessions, but `print!' and `doom-log' are safe to use as a
|
||||
;;; drop-in replacement.
|
||||
;;;
|
||||
;;; Code:
|
||||
|
||||
(require 'ansi-color)
|
||||
|
||||
(defvar doom-print-ansi-alist
|
||||
'(;; fx
|
||||
(bold 1 :weight bold)
|
||||
(dark 2)
|
||||
(italic 3 :slant italic)
|
||||
(underscore 4 :underline t)
|
||||
(blink 5)
|
||||
(rapid 6)
|
||||
(contrary 7)
|
||||
(concealed 8)
|
||||
(strike 9 :strike-through t)
|
||||
;; fg
|
||||
(black 30 term-color-black)
|
||||
(red 31 term-color-red)
|
||||
(green 32 term-color-green)
|
||||
(yellow 33 term-color-yellow)
|
||||
(blue 34 term-color-blue)
|
||||
(magenta 35 term-color-magenta)
|
||||
(cyan 36 term-color-cyan)
|
||||
(white 37 term-color-white)
|
||||
;; bg
|
||||
(on-black 40 term-color-black)
|
||||
(on-red 41 term-color-red)
|
||||
(on-green 42 term-color-green)
|
||||
(on-yellow 43 term-color-yellow)
|
||||
(on-blue 44 term-color-blue)
|
||||
(on-magenta 45 term-color-magenta)
|
||||
(on-cyan 46 term-color-cyan)
|
||||
(on-white 47 term-color-white))
|
||||
"An alist of fg/bg/fx names mapped to ansi codes and term-color-* variables.
|
||||
|
||||
This serves as the cipher for converting (COLOR ...) function calls in `print!'
|
||||
and `format!' into colored output, where COLOR is any car of this list.")
|
||||
|
||||
(defvar doom-print-class-alist
|
||||
`((buffer . doom-print--buffer)
|
||||
(color . doom-print--style)
|
||||
(class . doom-print--class)
|
||||
(indent . doom-print--indent)
|
||||
(fill . doom-print--fill)
|
||||
(join . doom-print--join)
|
||||
(org . doom-print--org)
|
||||
(markup . doom-print--cli-markup)
|
||||
(trim . string-trim)
|
||||
(rtrim . string-trim-right)
|
||||
(ltrim . string-trim-left)
|
||||
(p . doom-print--paragraph)
|
||||
(buffer . (lambda (buffer)
|
||||
(with-current-buffer buffer
|
||||
(buffer-string))))
|
||||
(truncate . doom-print--truncate)
|
||||
(success . (lambda (str &rest args)
|
||||
(apply #'doom-print--style 'green
|
||||
(doom-print--indent str "✓ ")
|
||||
args)))
|
||||
(warn . (lambda (str &rest args)
|
||||
(apply #'doom-print--style 'yellow
|
||||
(doom-print--indent str "! ")
|
||||
args)))
|
||||
(error . (lambda (str &rest args)
|
||||
(apply #'doom-print--style 'red
|
||||
(doom-print--indent str "x ")
|
||||
args)))
|
||||
(item . (lambda (str &rest args)
|
||||
(doom-print--indent
|
||||
(if args (apply #'format str args) str)
|
||||
"- ")))
|
||||
(start . (lambda (str &rest args)
|
||||
(doom-print--indent
|
||||
(if args (apply #'format str args) str)
|
||||
"> ")))
|
||||
(path . abbreviate-file-name)
|
||||
(symbol . symbol-name)
|
||||
(relpath . (lambda (str &optional dir)
|
||||
(if (or (not str)
|
||||
(not (stringp str))
|
||||
(string-blank-p str))
|
||||
str
|
||||
(let ((dir (or dir (file-truename default-directory)))
|
||||
(str (file-truename str)))
|
||||
(if (file-in-directory-p str dir)
|
||||
(file-relative-name str dir)
|
||||
(abbreviate-file-name str))))))
|
||||
(filename . file-name-nondirectory)
|
||||
(dirname . (lambda (path)
|
||||
(unless (file-directory-p path)
|
||||
(setq path (file-name-directory path)))
|
||||
(directory-file-name path))))
|
||||
"An alist of text classes that map to transformation functions.
|
||||
|
||||
Any of these classes can be called like functions from within `format!' and
|
||||
`print!' calls, which will transform their input.")
|
||||
|
||||
(defvar doom-print-indent 0
|
||||
"Level to rigidly indent text returned by `format!' and `print!'.")
|
||||
|
||||
(defvar doom-print-indent-increment 2
|
||||
"Steps in which to increment `doom-print-indent' for consecutive levels.")
|
||||
|
||||
(defvar doom-print-backend
|
||||
(if doom-interactive-p 'text-properties 'ansi)
|
||||
"Whether to print colors/styles with ANSI codes or with text properties.
|
||||
|
||||
Accepts `ansi' and `text-properties'. `nil' means don't render styles at all.")
|
||||
|
||||
(defvar doom-print-level (if doom-debug-p 'debug 'info)
|
||||
"The default level of messages to print.")
|
||||
|
||||
(defvar doom-print-logging-level 'debug
|
||||
"The default logging level used by `doom-log'/`doom-print'.")
|
||||
|
||||
(defvar doom-print-message-level (if noninteractive 'debug 'info)
|
||||
"The default logging level used by `message'.")
|
||||
|
||||
(defvar doom-print--levels
|
||||
'(debug ; the system is thinking out loud
|
||||
info ; a FYI; to keep you posted
|
||||
warning ; a dismissable issue that may have reprecussions later
|
||||
error)) ; functionality has been disabled by misbehavior
|
||||
|
||||
(dotimes (i (length doom-print--levels))
|
||||
(put (nth i doom-print--levels) 'level i))
|
||||
|
||||
|
||||
;;
|
||||
;;; Library
|
||||
|
||||
;;;###autoload
|
||||
(cl-defun doom-print
|
||||
(output &key
|
||||
(format t)
|
||||
(newline t)
|
||||
(stream standard-output)
|
||||
(level doom-print-level))
|
||||
"Print OUTPUT to stdout.
|
||||
|
||||
Unlike `message', this:
|
||||
- Respects `standard-output'.
|
||||
- Respects `doom-print-indent' (if FORMAT)
|
||||
- Prints to stdout instead of stderr in batch mode.
|
||||
- Respects more ANSI codes (only in batch mode).
|
||||
- No-ops if OUTPUT is nil or an empty/blank string.
|
||||
|
||||
Returns OUTPUT."
|
||||
(cl-check-type output (or null string))
|
||||
(when (and (stringp output)
|
||||
(not (string-blank-p output))
|
||||
(or (eq level t)
|
||||
(>= (get level 'level)
|
||||
(get doom-print-level 'level))))
|
||||
(let ((output (if format
|
||||
(doom-print--format "%s" output)
|
||||
output)))
|
||||
(princ output stream)
|
||||
(if newline (terpri stream))
|
||||
output)))
|
||||
|
||||
;;;###autoload
|
||||
(progn
|
||||
;; Autoload whole definition, so its buried uses don't pull in this whole file
|
||||
;; with them at expansion time.
|
||||
(defmacro doom-log (output &rest args)
|
||||
"Log a message in *Messages*.
|
||||
|
||||
Does not emit the message in the echo area. This is a macro instead of a
|
||||
function to prevent the potentially expensive execution of its arguments when
|
||||
debug mode is off."
|
||||
`(when (or doom-debug-p (not doom-interactive-p))
|
||||
(let ((inhibit-message t))
|
||||
(message
|
||||
"%s" (propertize
|
||||
(doom-print--format
|
||||
(format
|
||||
"* [%s] %s"
|
||||
,(let ((time `(format "%.06f" (float-time (time-subtract (current-time) before-init-time)))))
|
||||
(cond (noninteractive time)
|
||||
((bound-and-true-p doom--current-module)
|
||||
(format "[:%s %s] "
|
||||
(doom-keyword-name (car doom--current-module))
|
||||
(cdr doom--current-module)))
|
||||
((when-let (file (ignore-errors (file!)))
|
||||
(format "[%s] "
|
||||
(file-relative-name
|
||||
file (doom-path (file-name-directory file) "../")))))
|
||||
(time)))
|
||||
,output)
|
||||
,@args)
|
||||
'face 'font-lock-doc-face))))))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro format! (message &rest args)
|
||||
"An alternative to `format' that understands (color ...) and converts them
|
||||
into faces or ANSI codes depending on the type of sesssion we're in."
|
||||
`(doom-print--format ,@(doom-print--apply `(,message ,@args))))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro print-group! (&rest body)
|
||||
"Indents any `print!' or `format!' output within BODY."
|
||||
`(print-group-if! t ,@body))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro print-group-if! (condition &rest body)
|
||||
"Indents any `print!' or `format!' output within BODY."
|
||||
(declare (indent 1))
|
||||
`(let ((doom-print-indent
|
||||
(+ (if ,condition doom-print-indent-increment 0)
|
||||
doom-print-indent)))
|
||||
,@body))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro print! (message &rest args)
|
||||
"Prints MESSAGE, formatted with ARGS, to stdout.
|
||||
|
||||
Returns non-nil if the message is a non-empty string.
|
||||
|
||||
Can be colored using (color ...) blocks:
|
||||
|
||||
(print! \"Hello %s\" (bold (blue \"How are you?\")))
|
||||
(print! \"Hello %s\" (red \"World\"))
|
||||
(print! (green \"Great %s!\") \"success\")
|
||||
|
||||
Uses faces in interactive sessions and ANSI codes otherwise."
|
||||
`(doom-print (format! ,message ,@args) :format nil))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro insert! (&rest args)
|
||||
"Like `insert', but with the power of `format!'.
|
||||
|
||||
Each argument in ARGS can be a list, as if they were arguments to `format!':
|
||||
\(MESSAGE [ARGS...]).
|
||||
|
||||
\(fn &rest (MESSAGE . ARGS)...)"
|
||||
`(insert ,@(cl-loop for arg in args
|
||||
if (listp arg)
|
||||
collect `(format! ,@arg)
|
||||
else collect arg)))
|
||||
|
||||
|
||||
;;
|
||||
;;; Helpers
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-print--format (message &rest args)
|
||||
(if (or (null message) (string-blank-p message))
|
||||
""
|
||||
(concat (make-string doom-print-indent 32)
|
||||
(replace-regexp-in-string
|
||||
"\n" (concat "\n" (make-string doom-print-indent 32))
|
||||
(if args (apply #'format message args) message)
|
||||
t t))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-print--indent (text &optional prefix)
|
||||
"Indent TEXT by WIDTH spaces. If ARGS, format TEXT with them."
|
||||
(with-temp-buffer
|
||||
(let ((width
|
||||
(cond ((null prefix)
|
||||
doom-print-indent-increment)
|
||||
((integerp prefix)
|
||||
prefix)
|
||||
((length (ansi-color-filter-apply (format "%s" prefix)))))))
|
||||
(insert (format "%s" (or text "")))
|
||||
(indent-rigidly (point-min) (point-max) width)
|
||||
(when (stringp prefix)
|
||||
(goto-char (point-min))
|
||||
(delete-char width)
|
||||
(insert prefix))
|
||||
(buffer-string))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-print--fill (message &optional column indent)
|
||||
"Ensure MSG is split into lines no longer than `fill-column'."
|
||||
(with-temp-buffer
|
||||
(let* ((fill-column (or column fill-column))
|
||||
(col 0)
|
||||
(indent (or indent 0))
|
||||
(fill-prefix (make-string indent ?\s)))
|
||||
(save-excursion
|
||||
(insert (format "%s" (or message ""))))
|
||||
;; HACK This monkey patches `fill-region' to not count ANSI codes as
|
||||
;; legitimate characters, when calculating per-line `fill-column'.
|
||||
(letf! (defun current-fill-column ()
|
||||
(let ((target (funcall current-fill-column)))
|
||||
(save-excursion
|
||||
(goto-char (line-beginning-position))
|
||||
(let ((n 0)
|
||||
(c 0))
|
||||
(while (and (not (eolp)) (<= n target))
|
||||
(save-match-data
|
||||
(if (looking-at ansi-color--control-seq-fragment-regexp)
|
||||
(let ((len (length (match-string 0))))
|
||||
(cl-incf c len)
|
||||
(forward-char len))
|
||||
(cl-incf n 1)
|
||||
(forward-char 1))))
|
||||
(+ target c (length fill-prefix))))))
|
||||
(fill-region (point-min) (point-max) nil t))
|
||||
(buffer-string))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-print--paragraph (&rest lines)
|
||||
"TODO"
|
||||
(doom-print--fill (apply #'concat lines)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-print--join (sequence &optional separator)
|
||||
"Ensure SEQUENCE is joined with SEPARATOR.
|
||||
|
||||
`nil' and empty strings in SEQUENCE are omitted."
|
||||
(mapconcat (doom-partial #'format "%s")
|
||||
(seq-remove (fn!! (or (null %)
|
||||
(and (stringp %)
|
||||
(string-empty-p %))))
|
||||
sequence)
|
||||
(or separator " ")))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-print--truncate (text &optional col ellipsis)
|
||||
"Replaces basic org markup with ansi/text-properties."
|
||||
(truncate-string-to-width (or text "") (or col (- fill-column doom-print-indent))
|
||||
nil nil (or ellipsis "...")))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-print--buffer (buffer &optional beg end)
|
||||
"Replaces basic org markup with ansi/text-properties."
|
||||
(if (and (bufferp buffer) (buffer-live-p buffer))
|
||||
(with-current-buffer buffer
|
||||
(if (or beg end)
|
||||
(buffer-substring (or beg (point-min))
|
||||
(or end (point-max)))
|
||||
(buffer-string)))
|
||||
""))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-print--cli-markup (text)
|
||||
"Replace `...', `...`, and ```...``` quotes in TEXT with CLI formatting.
|
||||
|
||||
- `$ENVVAR' = bolded
|
||||
- `--switch' = bolded
|
||||
- `ARG' = underlined
|
||||
- `symbol' = highlighted in blue
|
||||
- `arbitrary code` = highlighted in blue
|
||||
- ```
|
||||
Arbitrary multiline code gets highlighted in blue too.
|
||||
```"
|
||||
(if (not text) ""
|
||||
(let ((case-fold-search nil))
|
||||
;; TODO Syntax highlighting?
|
||||
(replace-regexp-in-string
|
||||
" *```\n\\(.+?\\)\n *```" (doom-print--style 'blue "%s" "\\1")
|
||||
(replace-regexp-in-string
|
||||
"`\\$ \\([^`\n]+?\\)`" (format "`%s`" (doom-print--style 'blue "%s" "\\1"))
|
||||
(replace-regexp-in-string
|
||||
"`\\([^ \n]+?\\)'"
|
||||
(let ((styles '(("^\\$" . envvar)
|
||||
("^--?" . option)
|
||||
("^[A-Z][A-Z0-9-_]*$" . arg)
|
||||
("." . symbol))))
|
||||
(lambda (match)
|
||||
(let ((text (match-string 1 match)))
|
||||
(pcase (assoc-default text styles #'string-match-p)
|
||||
(`arg (doom-print--style 'underscore "%s" text))
|
||||
(`envvar (doom-print--style 'bold "%s" text))
|
||||
(`option (doom-print--style 'bold "%s" text))
|
||||
(_ (format "`%s'" (doom-print--style 'blue "%s" text)))))))
|
||||
text t)
|
||||
t)
|
||||
t))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-print--org (text)
|
||||
"Replaces basic Org markup with ansi/text-properties.
|
||||
|
||||
All emphasis markers need to be preceded by a backslash."
|
||||
(let* ((inhibit-modification-hooks t)
|
||||
(styles '((?* . bold)
|
||||
(?_ . underscore)
|
||||
(?/ . italic)
|
||||
(?= . magenta)
|
||||
(?+ . strike)
|
||||
(?~ . blue)))
|
||||
(fences (regexp-quote (mapconcat #'char-to-string (mapcar #'car styles) ""))))
|
||||
(with-temp-buffer
|
||||
(save-excursion (insert text))
|
||||
(while (re-search-forward (format "\\([%s]\\)" fences) nil t)
|
||||
(unless (= (char-before (match-beginning 0)) ?\\)
|
||||
(let* ((beg (match-beginning 0))
|
||||
(ibeg (point))
|
||||
(fence (match-string 1))
|
||||
(fence-re (regexp-quote fence)))
|
||||
(when (re-search-forward (format "[^\\]%s" fence-re) (line-end-position 2) t)
|
||||
(let ((end (point))
|
||||
(iend (1- (point))))
|
||||
(let ((text (buffer-substring ibeg iend)))
|
||||
(when-let (style (cdr (assq (string-to-char fence) styles)))
|
||||
(goto-char beg)
|
||||
(delete-region beg end)
|
||||
(insert (doom-print--style style "%s" text)))))
|
||||
(goto-char beg)))))
|
||||
(buffer-string))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-print--style (style format &rest args)
|
||||
"Apply STYLE to formatted MESSAGE with ARGS.
|
||||
|
||||
STYLE is a symbol that correlates to `doom-print-ansi-alist'.
|
||||
|
||||
In a noninteractive session, this wraps the result in ansi color codes.
|
||||
Otherwise, it maps colors to a term-color-* face."
|
||||
(let* ((code (cadr (assq style doom-print-ansi-alist)))
|
||||
(format (format "%s" (or format "")))
|
||||
(message (if args (apply #'format format args) format)))
|
||||
(unless code
|
||||
(error "Invalid print style: %s" style))
|
||||
(pcase doom-print-backend
|
||||
(`ansi
|
||||
(format "\e[0%dm%s\e[%dm" code message 0))
|
||||
(`text-properties
|
||||
(require 'term) ; piggyback on term's color faces
|
||||
(propertize
|
||||
message
|
||||
'face
|
||||
(append (get-text-property 0 'face format)
|
||||
(cond ((>= code 40)
|
||||
`(:background ,(caddr (assq style doom-print-ansi-alist))))
|
||||
((>= code 30)
|
||||
`(:foreground ,(face-foreground (caddr (assq style doom-print-ansi-alist)))))
|
||||
((cddr (assq style doom-print-ansi-alist)))))))
|
||||
(_ message))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-print--class (class format &rest args)
|
||||
"Apply CLASS to formatted format with ARGS.
|
||||
|
||||
CLASS is derived from `doom-print-class-alist', and can contain any arbitrary,
|
||||
transformative logic."
|
||||
(let (fn)
|
||||
(cond ((setq fn (cdr (assq class doom-print-class-alist)))
|
||||
(if (functionp fn)
|
||||
(apply fn format args)
|
||||
(error "%s does not have a function" class)))
|
||||
(args (apply #'format format args))
|
||||
(format))))
|
||||
|
||||
(defun doom-print--apply (forms &optional sub)
|
||||
"Replace color-name functions with calls to `doom-print--style'."
|
||||
(cond ((null forms) nil)
|
||||
((listp forms)
|
||||
(append (cond ((not (symbolp (car forms)))
|
||||
(list (doom-print--apply (car forms))))
|
||||
(sub
|
||||
(list (car forms)))
|
||||
((assq (car forms) doom-print-ansi-alist)
|
||||
`(doom-print--style ',(car forms)))
|
||||
((assq (car forms) doom-print-class-alist)
|
||||
`(doom-print--class ',(car forms)))
|
||||
((list (car forms))))
|
||||
(doom-print--apply (cdr forms) t)
|
||||
nil))
|
||||
(forms)))
|
||||
|
|
@ -30,6 +30,9 @@ one wants that.")
|
|||
(defun doom-autoloads-reload (&optional file)
|
||||
"Regenerates Doom's autoloads and writes them to FILE."
|
||||
(unless file
|
||||
;; TODO Uncomment when profile system is implemented
|
||||
;; (make-directory doom-profile-dir t)
|
||||
;; (setq file (expand-file-name "init.el" doom-profile-dir))
|
||||
(setq file doom-autoloads-file))
|
||||
(print! (start "(Re)generating autoloads file..."))
|
||||
(print-group!
|
||||
|
|
@ -59,7 +62,10 @@ one wants that.")
|
|||
(seq-difference (hash-table-keys straight--build-cache)
|
||||
doom-autoloads-excluded-packages))
|
||||
doom-autoloads-excluded-files
|
||||
'literal))
|
||||
'literal)
|
||||
;; TODO Uncomment when profile system is implemented
|
||||
;; `((if doom-interactive-p (require 'core-start)))
|
||||
)
|
||||
(print! (start "Byte-compiling autoloads file..."))
|
||||
(doom-autoloads--compile-file file)
|
||||
(print! (success "Generated %s")
|
||||
|
|
@ -128,10 +134,10 @@ one wants that.")
|
|||
(cond ((and (not module-enabled-p) altform)
|
||||
(print (read altform)))
|
||||
((memq definer '(defun defmacro cl-defun cl-defmacro))
|
||||
(if module-enabled-p
|
||||
(print (make-autoload form file))
|
||||
(cl-destructuring-bind (_ _ arglist &rest body) form
|
||||
(print
|
||||
(print
|
||||
(if module-enabled-p
|
||||
(make-autoload form file)
|
||||
(seq-let (_ _ arglist &rest body) form
|
||||
(if altform
|
||||
(read altform)
|
||||
(append
|
||||
|
|
@ -141,21 +147,20 @@ one wants that.")
|
|||
(_ type))
|
||||
symbol arglist
|
||||
(format "THIS FUNCTION DOES NOTHING BECAUSE %s IS DISABLED\n\n%s"
|
||||
module
|
||||
(if (stringp (car body))
|
||||
(pop body)
|
||||
"No documentation.")))
|
||||
module (if (stringp (car body))
|
||||
(pop body)
|
||||
"No documentation.")))
|
||||
(cl-loop for arg in arglist
|
||||
if (and (symbolp arg)
|
||||
(not (keywordp arg))
|
||||
(not (memq arg cl--lambda-list-keywords)))
|
||||
if (symbolp arg)
|
||||
if (not (keywordp arg))
|
||||
if (not (memq arg cl--lambda-list-keywords))
|
||||
collect arg into syms
|
||||
else if (listp arg)
|
||||
collect (car arg) into syms
|
||||
finally return (if syms `((ignore ,@syms)))))))))
|
||||
(print `(put ',symbol 'doom-module ',module)))
|
||||
((eq definer 'defalias)
|
||||
(cl-destructuring-bind (_ _ target &optional docstring) form
|
||||
(seq-let (_ _ target docstring) form
|
||||
(unless module-enabled-p
|
||||
(setq target #'ignore
|
||||
docstring
|
||||
|
|
@ -176,7 +181,7 @@ one wants that.")
|
|||
;; the autoloads file.
|
||||
debug-on-error
|
||||
;; Non-nil interferes with autoload generation in Emacs < 29. See
|
||||
;; raxod502/straight.el#904.
|
||||
;; radian-software/straight.el#904.
|
||||
(left-margin 0)
|
||||
;; The following bindings are in `package-generate-autoloads'.
|
||||
;; Presumably for a good reason, so I just copied them.
|
||||
|
|
|
|||
231
core/cli/ci.el
231
core/cli/ci.el
|
|
@ -1,60 +1,9 @@
|
|||
;;; core/cli/ci.el -*- lexical-binding: t; -*-
|
||||
|
||||
(defcli! ci (&optional target &rest args)
|
||||
"TODO"
|
||||
(unless target
|
||||
(user-error "No CI target given"))
|
||||
(when-let* ((ci-dir
|
||||
(or (locate-dominating-file default-directory ".github/ci.el")
|
||||
doom-private-dir))
|
||||
(ci-config
|
||||
(car (or (doom-glob ci-dir ".github/ci.el")
|
||||
(doom-glob ci-dir "ci.el")
|
||||
(doom-glob ci-dir "cli.el")))))
|
||||
(print! (info "Loading %s") (path ci-config))
|
||||
(load ci-config nil t t))
|
||||
(if-let (fn (intern-soft (format "doom-cli--ci-%s" target)))
|
||||
(apply fn args)
|
||||
(user-error "No known CI target: %S" target)))
|
||||
|
||||
|
||||
;;
|
||||
;;;
|
||||
;;; Variables
|
||||
|
||||
|
||||
(defun doom-cli--ci-deploy-hooks (&optional force)
|
||||
(let* ((repo-path (cdr (doom-call-process "git" "rev-parse" "--show-toplevel")))
|
||||
(submodule-p (string-empty-p (cdr (doom-call-process "git" "rev-parse" "show-superproject-working-tree"))))
|
||||
(config-hooks-path (cdr (doom-call-process "git" "config" "core.hooksPath")))
|
||||
(hooks-path (cdr (doom-call-process "git" "rev-parse" "--git-path" "hooks"))))
|
||||
(unless (string-empty-p config-hooks-path)
|
||||
(or force
|
||||
(y-or-n-p
|
||||
(format (concat "Detected non-standard core.hookPath: %S\n\n"
|
||||
"Install Doom's commit-msg and pre-push git hooks anyway?")
|
||||
hooks-path))
|
||||
(user-error "Aborted")))
|
||||
(make-directory hooks-path 'parents)
|
||||
(print! (start "Deploying git hooks in %S") (path hooks-path))
|
||||
(print-group!
|
||||
(dolist (hook '("commit-msg" "pre-push"))
|
||||
(let* ((hook (doom-path hooks-path hook))
|
||||
(overwrite-p (file-exists-p hook)))
|
||||
(with-temp-file hook
|
||||
(insert "#!/usr/bin/env sh\n"
|
||||
(doom-path doom-emacs-dir "bin/doom")
|
||||
" --nocolor ci hook-" (file-name-base hook)
|
||||
" \"$@\""))
|
||||
(set-file-modes hook #o700)
|
||||
(print! (success "%s %s")
|
||||
(if overwrite-p "Overwrote" "Created")
|
||||
(path hook)))))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Git hooks
|
||||
|
||||
(defvar doom-cli-commit-trailer-keys
|
||||
(defvar doom-ci-commit-trailer-keys
|
||||
'(("Fix" ref hash url)
|
||||
("Ref" ref hash url)
|
||||
("Close" ref)
|
||||
|
|
@ -66,7 +15,7 @@
|
|||
|
||||
Accapted value types can be one or more of ref, hash, url, username, or name.")
|
||||
|
||||
(defvar doom-cli-commit-trailer-types
|
||||
(defvar doom-ci-commit-trailer-types
|
||||
'((ref . "^\\(https?://[^ ]+\\|[^/]+/[^/]+\\)?#[0-9]+$")
|
||||
(hash . "^\\(https?://[^ ]+\\|[^/]+/[^/]+@\\)?[a-z0-9]\\{12\\}$")
|
||||
(url . "^https?://")
|
||||
|
|
@ -76,17 +25,17 @@ Accapted value types can be one or more of ref, hash, url, username, or name.")
|
|||
|
||||
Accapted value types can be one or more of ref, hash, url, username, or name.")
|
||||
|
||||
(defvar doom-cli-commit-types
|
||||
(defvar doom-ci-commit-types
|
||||
'(bump dev docs feat fix merge nit perf refactor release revert test tweak)
|
||||
"A list of valid commit types.")
|
||||
|
||||
(defvar doom-cli-commit-scopeless-types '(bump merge release revert)
|
||||
(defvar doom-ci-commit-scopeless-types '(bump merge release revert)
|
||||
"A list of commit types whose scopes should be passed in its BODY.
|
||||
|
||||
Don't: \"bump(SCOPE): ...\"
|
||||
Do: \"bump: SCOPE\"")
|
||||
|
||||
(defvar doom-cli-commit-scopes '("ci" doom-cli-enforce-scopeless-types)
|
||||
(defvar doom-ci-commit-scopes '("ci" doom-ci-enforce-scopeless-types)
|
||||
"A list of valid commit scopes as strings, predicate functions, or lists.
|
||||
|
||||
These are checked against each item in the comma-delimited scope field of the
|
||||
|
|
@ -96,7 +45,7 @@ Each element of this list can be one of:
|
|||
|
||||
- A string, compared literally against the scope's name.
|
||||
- A function predicate, taking two arguments (a scope as a symbol, and a plist
|
||||
containing information about the current commit--see `doom-cli-commit-scopes'
|
||||
containing information about the current commit--see `doom-ci-commit-scopes'
|
||||
for more about its structure). These predicates should:
|
||||
- Return non-nil to immediately pass a scope.
|
||||
- Throw a `user-error' to immediately fail the scope.
|
||||
|
|
@ -106,13 +55,7 @@ Each element of this list can be one of:
|
|||
|
||||
'(docs \"faq\" \"install\" check-docs)")
|
||||
|
||||
(cl-defun doom-cli-enforce-scopeless-types (scope (&key type scopes summary &allow-other-keys))
|
||||
"Complain about scoped types that are incompatible with scopes"
|
||||
(when (memq type doom-cli-commit-scopeless-types)
|
||||
(user-error "Scopes for %s commits should go after the colon, not before"
|
||||
type)))
|
||||
|
||||
(defvar doom-cli-commit-rules
|
||||
(defvar doom-ci-commit-rules
|
||||
;; TODO Extract into named functions
|
||||
(list (fn! (&key subject)
|
||||
"If a fixup/squash commit, don't lint this commit"
|
||||
|
|
@ -136,7 +79,7 @@ Each element of this list can be one of:
|
|||
|
||||
(fn! (&key type)
|
||||
"Ensure commit has valid type"
|
||||
(or (memq type doom-cli-commit-types)
|
||||
(or (memq type doom-ci-commit-types)
|
||||
(if type
|
||||
(fail! "Invalid commit type: %s" type)
|
||||
(fail! "Commit has no detectable type"))))
|
||||
|
|
@ -166,7 +109,7 @@ Each element of this list can be one of:
|
|||
(and (listp rule)
|
||||
(eq type (car rule))
|
||||
(seq-find #'check-rule (cdr rule)))))
|
||||
(or (seq-find #'check-rule doom-cli-commit-scopes)
|
||||
(or (seq-find #'check-rule doom-ci-commit-scopes)
|
||||
(fail! "Invalid scope: %s" scope)))
|
||||
(user-error (fail! "%s" (error-message-string e))))))
|
||||
|
||||
|
|
@ -228,7 +171,7 @@ Each element of this list can be one of:
|
|||
;; TODO Add bump validations for revert: type.
|
||||
(fn! (&key body trailers)
|
||||
"Validate commit trailers."
|
||||
(let* ((keys (mapcar #'car doom-cli-commit-trailer-keys))
|
||||
(let* ((keys (mapcar #'car doom-ci-commit-trailer-keys))
|
||||
(key-re (regexp-opt keys t))
|
||||
(lines
|
||||
;; Scan BODY because invalid trailers won't be in TRAILERS.
|
||||
|
|
@ -250,13 +193,13 @@ Each element of this list can be one of:
|
|||
(truncate-string-to-width (string-trim line) 16 nil nil "…")
|
||||
(match-string 1 line))))
|
||||
(pcase-dolist (`(,key . ,value) trailers)
|
||||
(if (and (not (memq 'name (cdr (assoc key doom-cli-commit-trailer-keys))))
|
||||
(if (and (not (memq 'name (cdr (assoc key doom-ci-commit-trailer-keys))))
|
||||
(string-match-p " " value))
|
||||
(fail! "Found %S, but only one value allowed per trailer"
|
||||
(truncate-string-to-width (concat key ": " value) 20 nil nil "…"))
|
||||
(when-let (allowed-types (cdr (assoc key doom-cli-commit-trailer-keys)))
|
||||
(when-let (allowed-types (cdr (assoc key doom-ci-commit-trailer-keys)))
|
||||
(or (cl-loop for type in allowed-types
|
||||
if (cdr (assq type doom-cli-commit-trailer-types))
|
||||
if (cdr (assq type doom-ci-commit-trailer-types))
|
||||
if (string-match-p it value)
|
||||
return t)
|
||||
(fail! "%S expects one of %s, but got %S"
|
||||
|
|
@ -299,18 +242,98 @@ as `format'.
|
|||
|
||||
Note: warnings are not considered failures.")
|
||||
|
||||
(defun doom-cli--ci-hook-commit-msg (file)
|
||||
|
||||
;;
|
||||
;;; Commands
|
||||
|
||||
;;; doom ci
|
||||
(defcli! (:before ci) (&rest _)
|
||||
(when-let*
|
||||
((repo-root (or (cdr (doom-call-process "git" "rev-parse" "--show-toplevel"))
|
||||
default-directory))
|
||||
(local-config
|
||||
(car (or (doom-glob repo-root "ci.el")
|
||||
(doom-glob doom-private-dir "ci.el")))))
|
||||
(print! (item "Loading %s") (path local-config))
|
||||
(load local-config nil t t)))
|
||||
|
||||
(defcli! ci ()
|
||||
"Commands that automate development processes."
|
||||
:partial t)
|
||||
|
||||
(defcli! (ci deploy-hooks) ((force ("--force")))
|
||||
"TODO"
|
||||
(let* ((default-directory doom-emacs-dir)
|
||||
(repo-path (cdr (doom-call-process "git" "rev-parse" "--show-toplevel")))
|
||||
(submodule-p (string-empty-p (cdr (doom-call-process "git" "rev-parse" "show-superproject-working-tree"))))
|
||||
(config-hooks-path (cdr (doom-call-process "git" "config" "core.hooksPath")))
|
||||
(hooks-path (cdr (doom-call-process "git" "rev-parse" "--git-path" "hooks"))))
|
||||
(unless (string-empty-p config-hooks-path)
|
||||
(or force
|
||||
(y-or-n-p
|
||||
(format (concat "Detected non-standard core.hookPath: %S\n\n"
|
||||
"Install Doom's commit-msg and pre-push git hooks anyway?")
|
||||
hooks-path))
|
||||
(user-error "Aborted")))
|
||||
(make-directory hooks-path 'parents)
|
||||
(print-group!
|
||||
(dolist (hook '("commit-msg" "pre-push"))
|
||||
(let* ((hook (doom-path hooks-path hook))
|
||||
(overwrite-p (file-exists-p hook)))
|
||||
(with-temp-file hook
|
||||
(insert "#!/usr/bin/env sh\n"
|
||||
(doom-path doom-emacs-dir "bin/doom")
|
||||
" --no-color ci hook " (file-name-base hook)
|
||||
" \"$@\""))
|
||||
(set-file-modes hook #o700)
|
||||
(print! (success "%s %s")
|
||||
(if overwrite-p "Overwrote" "Created")
|
||||
(path hook)))))))
|
||||
|
||||
(defcli! (ci lint-commits) (from &optional to)
|
||||
"TODO"
|
||||
(with-temp-buffer
|
||||
(insert
|
||||
(cdr (doom-call-process
|
||||
"git" "log"
|
||||
(format "%s...%s" from (or to (concat from "~1"))))))
|
||||
(doom-ci--lint
|
||||
(let (commits)
|
||||
(while (re-search-backward "^commit \\([a-z0-9]\\{40\\}\\)" nil t)
|
||||
(push (cons (match-string 1)
|
||||
(replace-regexp-in-string
|
||||
"^ " ""
|
||||
(save-excursion
|
||||
(buffer-substring-no-properties
|
||||
(search-forward "\n\n")
|
||||
(if (re-search-forward "\ncommit \\([a-z0-9]\\{40\\}\\)" nil t)
|
||||
(match-beginning 0)
|
||||
(point-max))))))
|
||||
commits))
|
||||
commits))))
|
||||
|
||||
;;; TODO
|
||||
(defcli! (ci run-tests) (&rest targets) :stub t)
|
||||
|
||||
;;; doom ci hook
|
||||
(defcli! (ci hook commit-msg) (file)
|
||||
"Run git commit-msg hook.
|
||||
|
||||
Lints the current commit message."
|
||||
(with-temp-buffer
|
||||
(insert-file-contents file)
|
||||
(doom-cli--ci--lint
|
||||
(list (cons
|
||||
"CURRENT"
|
||||
(buffer-substring (point-min)
|
||||
(if (re-search-forward "^# Please enter the commit message" nil t)
|
||||
(match-beginning 0)
|
||||
(point-max))))))))
|
||||
(doom-ci--lint
|
||||
`(("CURRENT" .
|
||||
,(buffer-substring
|
||||
(point-min)
|
||||
(if (re-search-forward "^# Please enter the commit message" nil t)
|
||||
(match-beginning 0)
|
||||
(point-max))))))))
|
||||
|
||||
(defun doom-cli--ci-hook-pre-push (_remote _url)
|
||||
(defcli! (ci hook pre-push) (remote url)
|
||||
"Run git pre-push hook.
|
||||
|
||||
Prevents pushing if there are unrebased or WIP commits."
|
||||
(with-temp-buffer
|
||||
(let ((z40 (make-string 40 ?0))
|
||||
line error)
|
||||
|
|
@ -318,6 +341,7 @@ Note: warnings are not considered failures.")
|
|||
(catch 'continue
|
||||
(seq-let (local-ref local-sha remote-ref remote-sha)
|
||||
(split-string line " ")
|
||||
;; TODO Extract this branch detection to a variable
|
||||
(unless (or (string-match-p "^refs/heads/\\(master\\|main\\)$" remote-ref)
|
||||
(equal local-sha z40))
|
||||
(throw 'continue t))
|
||||
|
|
@ -325,7 +349,7 @@ Note: warnings are not considered failures.")
|
|||
(mapc (lambda (commit)
|
||||
(seq-let (hash msg) (split-string commit "\t")
|
||||
(setq error t)
|
||||
(print! (info "%S commit in %s"
|
||||
(print! (item "%S commit in %s"
|
||||
(car (split-string msg " "))
|
||||
(substring hash 0 12)))))
|
||||
(split-string
|
||||
|
|
@ -339,13 +363,20 @@ Note: warnings are not considered failures.")
|
|||
"\n" t))
|
||||
(when error
|
||||
(print! (error "Aborting push due to unrebased WIP, squash!, or fixup! commits"))
|
||||
(throw 'exit 1)))))))))
|
||||
(exit! 1)))))))))
|
||||
|
||||
|
||||
;;
|
||||
;;;
|
||||
;;; Helpers
|
||||
|
||||
(defun doom-cli--parse-commit (commit-msg)
|
||||
(cl-defun doom-ci-enforce-scopeless-types (scope (&key type scopes summary &allow-other-keys))
|
||||
"Complain about scoped commit types that shouldn't be scoped."
|
||||
(when (memq type doom-ci-commit-scopeless-types)
|
||||
(user-error "Scopes for %s commits should go after the colon, not before"
|
||||
type)))
|
||||
|
||||
|
||||
(defun doom-ci--parse-commit (commit-msg)
|
||||
(with-temp-buffer
|
||||
(save-excursion (insert commit-msg))
|
||||
(append
|
||||
|
|
@ -379,7 +410,7 @@ Note: warnings are not considered failures.")
|
|||
(match-string 2)))))
|
||||
`(:bumps ,(cl-sort (delete-dups bumps) #'string-lessp :key #'car)))))))
|
||||
|
||||
(defun doom-cli--parse-bumps (from end)
|
||||
(defun doom-ci--parse-bumps (from end)
|
||||
(with-temp-buffer
|
||||
(save-excursion
|
||||
(insert
|
||||
|
|
@ -397,13 +428,13 @@ Note: warnings are not considered failures.")
|
|||
(match-string 2)))))
|
||||
(cl-sort (delete-dups packages) #'string-lessp :key #'car)))))
|
||||
|
||||
(defun doom-cli--ci--lint (commits)
|
||||
(defun doom-ci--lint (commits)
|
||||
(let ((warnings 0)
|
||||
(failures 0))
|
||||
(print! (start "Linting %d commits" (length commits)))
|
||||
(print-group!
|
||||
(pcase-dolist (`(,ref . ,commitmsg) commits)
|
||||
(let* ((commit (doom-cli--parse-commit commitmsg))
|
||||
(let* ((commit (doom-ci--parse-commit commitmsg))
|
||||
(shortref (substring ref 0 7))
|
||||
(subject (plist-get commit :subject)))
|
||||
(cl-block 'linter
|
||||
|
|
@ -419,7 +450,7 @@ Note: warnings are not considered failures.")
|
|||
(print! (start "%s %s") shortref subject)
|
||||
(print-group!
|
||||
(mapc (doom-rpartial #'apply commit)
|
||||
doom-cli-commit-rules)))))))
|
||||
doom-ci-commit-rules)))))))
|
||||
(let ((issues (+ warnings failures)))
|
||||
(if (= issues 0)
|
||||
(print! (success "There were no issues!"))
|
||||
|
|
@ -427,26 +458,8 @@ Note: warnings are not considered failures.")
|
|||
(if (> failures 0) (print! (warn "Failures: %d" failures)))
|
||||
(print! "\nSee https://discourse.doomemacs.org/git-conventions")
|
||||
(unless (zerop failures)
|
||||
(throw 'exit 1)))
|
||||
(exit! 1)))
|
||||
t)))
|
||||
|
||||
(defun doom-cli--ci-lint-commits (from &optional to)
|
||||
(with-temp-buffer
|
||||
(insert
|
||||
(cdr (doom-call-process
|
||||
"git" "log"
|
||||
(format "%s...%s" from (or to (concat from "~1"))))))
|
||||
(doom-cli--ci--lint
|
||||
(let (commits)
|
||||
(while (re-search-backward "^commit \\([a-z0-9]\\{40\\}\\)" nil t)
|
||||
(push (cons (match-string 1)
|
||||
(replace-regexp-in-string
|
||||
"^ " ""
|
||||
(save-excursion
|
||||
(buffer-substring-no-properties
|
||||
(search-forward "\n\n")
|
||||
(if (re-search-forward "\ncommit \\([a-z0-9]\\{40\\}\\)" nil t)
|
||||
(match-beginning 0)
|
||||
(point-max))))))
|
||||
commits))
|
||||
commits))))
|
||||
(provide 'core-cli-ci)
|
||||
;;; ci.el ends here
|
||||
|
|
|
|||
|
|
@ -1,10 +1,19 @@
|
|||
;;; core/cli/byte-compile.el -*- lexical-binding: t; -*-
|
||||
;;; core/cli/commands/byte-compile.el -*- lexical-binding: t; -*-
|
||||
|
||||
(defcli! (compile c)
|
||||
((recompile-p ["-r" "--recompile"])
|
||||
(core-p ["-c" "--core"])
|
||||
(private-p ["-p" "--private"])
|
||||
(verbose-p ["-v" "--verbose"]))
|
||||
;;
|
||||
;;; Variables
|
||||
|
||||
;; None yet!
|
||||
|
||||
|
||||
;;
|
||||
;;; Commands
|
||||
|
||||
(defcli! ((compile c))
|
||||
((recompile-p ("-r" "--recompile"))
|
||||
(core-p ("-c" "--core"))
|
||||
(private-p ("-p" "--private"))
|
||||
(verbose-p ("-v" "--verbose")))
|
||||
"Byte-compiles your config or selected modules.
|
||||
|
||||
compile [TARGETS...]
|
||||
|
|
@ -14,7 +23,7 @@
|
|||
Accepts :core and :private as special arguments, which target Doom's core files
|
||||
and your private config files, respectively. To recompile your packages, use
|
||||
'doom build' instead."
|
||||
(doom-cli-byte-compile
|
||||
(doom-cli-compile
|
||||
(if (or core-p private-p)
|
||||
(append (if core-p (doom-glob doom-emacs-dir "init.el"))
|
||||
(if core-p (list doom-core-dir))
|
||||
|
|
@ -38,23 +47,13 @@ and your private config files, respectively. To recompile your packages, use
|
|||
|
||||
(defcli! clean ()
|
||||
"Delete all *.elc files."
|
||||
:bare t
|
||||
(doom-clean-byte-compiled-files))
|
||||
(doom-compile-clean))
|
||||
|
||||
|
||||
;;
|
||||
;; Helpers
|
||||
;;; Helpers
|
||||
|
||||
(defun doom--byte-compile-ignore-file-p (path)
|
||||
(let ((filename (file-name-nondirectory path)))
|
||||
(or (not (equal (file-name-extension path) "el"))
|
||||
(member filename (list "packages.el" "doctor.el"))
|
||||
(string-prefix-p "." filename)
|
||||
(string-prefix-p "test-" filename)
|
||||
(string-prefix-p "flycheck_" filename)
|
||||
(string-suffix-p ".example.el" filename))))
|
||||
|
||||
(cl-defun doom-cli-byte-compile (&optional targets recompile-p verbose-p)
|
||||
(cl-defun doom-cli-compile (&optional targets recompile-p verbose-p)
|
||||
"Byte compiles your emacs configuration.
|
||||
|
||||
init.el is always byte-compiled by this.
|
||||
|
|
@ -69,7 +68,7 @@ WARNING: byte-compilation yields marginal gains and makes debugging new issues
|
|||
difficult. It is recommended you don't use it unless you understand the
|
||||
reprecussions.
|
||||
|
||||
Use `doom-clean-byte-compiled-files' or `make clean' to reverse
|
||||
Use `doom-compile-clean' or `make clean' to reverse
|
||||
byte-compilation.
|
||||
|
||||
If RECOMPILE-P is non-nil, only recompile out-of-date files."
|
||||
|
|
@ -85,11 +84,11 @@ If RECOMPILE-P is non-nil, only recompile out-of-date files."
|
|||
;; Assemble el files we want to compile, and preserve in the order
|
||||
;; they are loaded in, so we don't run into any scary catch-22s
|
||||
;; while byte-compiling, like missing macros.
|
||||
(cons (let ((target-dirs (cl-remove-if-not #'file-directory-p targets)))
|
||||
(cons (let ((target-dirs (seq-filter #'file-directory-p targets)))
|
||||
(lambda (path)
|
||||
(and (not (doom--byte-compile-ignore-file-p path))
|
||||
(cl-find-if (doom-partial #'file-in-directory-p path)
|
||||
target-dirs)
|
||||
(and (not (doom-compile--ignore-file-p path))
|
||||
(seq-find (doom-partial #'file-in-directory-p path)
|
||||
target-dirs)
|
||||
(cl-pushnew path targets))))
|
||||
after-load-functions))))
|
||||
(doom-log "Reloading Doom in preparation for byte-compilation")
|
||||
|
|
@ -103,7 +102,7 @@ If RECOMPILE-P is non-nil, only recompile out-of-date files."
|
|||
(quiet! (doom-initialize-modules))))
|
||||
|
||||
(if (null targets)
|
||||
(print! (info "No targets to %scompile" (if recompile-p "re" "")))
|
||||
(print! (item "No targets to %scompile" (if recompile-p "re" "")))
|
||||
(print! (start "%scompiling your config...")
|
||||
(if recompile-p "Re" "Byte-"))
|
||||
|
||||
|
|
@ -112,7 +111,7 @@ If RECOMPILE-P is non-nil, only recompile out-of-date files."
|
|||
(setq targets (cl-remove-if #'file-directory-p targets)))
|
||||
(prependq! targets
|
||||
(doom-files-in
|
||||
dir :match "\\.el" :filter #'doom--byte-compile-ignore-file-p)))
|
||||
dir :match "\\.el" :filter #'doom-compile--ignore-file-p)))
|
||||
|
||||
(print-group!
|
||||
(require 'use-package)
|
||||
|
|
@ -164,8 +163,7 @@ If RECOMPILE-P is non-nil, only recompile out-of-date files."
|
|||
(byte-compile-file target)
|
||||
(quiet! (byte-compile-file target))))
|
||||
(`no-byte-compile
|
||||
(print! (debug "(% 3d/%d) Ignored %s")
|
||||
i total-modules (relpath target))
|
||||
(doom-log "(% 3d/%d) Ignored %s" i total-modules (relpath target))
|
||||
total-noop)
|
||||
(`nil
|
||||
(print! (error "(% 3d/%d) Failed to compile %s")
|
||||
|
|
@ -183,7 +181,16 @@ If RECOMPILE-P is non-nil, only recompile out-of-date files."
|
|||
"Reverting changes...")
|
||||
(signal 'doom-error (list 'byte-compile e))))))))
|
||||
|
||||
(defun doom-clean-byte-compiled-files ()
|
||||
(defun doom-compile--ignore-file-p (path)
|
||||
(let ((filename (file-name-nondirectory path)))
|
||||
(or (not (equal (file-name-extension path) "el"))
|
||||
(member filename (list "packages.el" "doctor.el"))
|
||||
(string-prefix-p "." filename)
|
||||
(string-prefix-p "test-" filename)
|
||||
(string-prefix-p "flycheck_" filename)
|
||||
(string-suffix-p ".example.el" filename))))
|
||||
|
||||
(defun doom-compile-clean ()
|
||||
"Delete all the compiled elc files in your Emacs configuration and private
|
||||
module. This does not include your byte-compiled, third party packages.'"
|
||||
(require 'core-modules)
|
||||
|
|
@ -204,5 +211,8 @@ module. This does not include your byte-compiled, third party packages.'"
|
|||
finally do
|
||||
(print! (if (> success 0)
|
||||
(success "\033[K%d elc files deleted" success)
|
||||
(info "\033[KNo elc files to clean"))))
|
||||
(item "\033[KNo elc files to clean"))))
|
||||
t))
|
||||
|
||||
(provide 'core-cli-compile)
|
||||
;;; compile.el ends here
|
||||
|
|
@ -1,86 +0,0 @@
|
|||
;;; core/cli/debug.el -*- lexical-binding: t; -*-
|
||||
|
||||
(load! "autoload/debug" doom-core-dir)
|
||||
|
||||
;;
|
||||
;;; Commands
|
||||
|
||||
(defcli! info
|
||||
((format ["--json" "--md" "--lisp"] "What format to dump info into"))
|
||||
"Output system info in markdown for bug reports."
|
||||
(with-temp-buffer
|
||||
(pcase format
|
||||
("--json"
|
||||
(require 'json)
|
||||
(insert (json-encode (doom-info)))
|
||||
(json-pretty-print-buffer))
|
||||
("--lisp"
|
||||
(pp (doom-info)))
|
||||
(`nil
|
||||
(dolist (spec (cl-remove-if-not #'cdr (doom-info)))
|
||||
(insert! "%-11s %s\n"
|
||||
((car spec)
|
||||
(if (listp (cdr spec))
|
||||
(mapconcat (lambda (x) (format "%s" x))
|
||||
(cdr spec) " ")
|
||||
(cdr spec))))))
|
||||
(_
|
||||
(user-error "I don't understand %S. Did you mean --json, --md/--markdown or --lisp?"
|
||||
format)))
|
||||
(print! (buffer-string)))
|
||||
nil)
|
||||
|
||||
(defcli! (version v) ()
|
||||
"Show version information for Doom & Emacs."
|
||||
(doom/version)
|
||||
nil)
|
||||
|
||||
(defcli! amisecure ()
|
||||
"TODO"
|
||||
(unless (string-match-p "\\_<GNUTLS\\_>" system-configuration-features)
|
||||
(warn "gnutls support isn't built into Emacs, there may be problems"))
|
||||
(if-let* ((bad-hosts
|
||||
(cl-loop for bad
|
||||
in '("https://expired.badssl.com/"
|
||||
"https://wrong.host.badssl.com/"
|
||||
"https://self-signed.badssl.com/"
|
||||
"https://untrusted-root.badssl.com/"
|
||||
;; "https://revoked.badssl.com/"
|
||||
;; "https://pinning-test.badssl.com/"
|
||||
"https://sha1-intermediate.badssl.com/"
|
||||
"https://rc4-md5.badssl.com/"
|
||||
"https://rc4.badssl.com/"
|
||||
"https://3des.badssl.com/"
|
||||
"https://null.badssl.com/"
|
||||
"https://sha1-intermediate.badssl.com/"
|
||||
;; "https://client-cert-missing.badssl.com/"
|
||||
"https://dh480.badssl.com/"
|
||||
"https://dh512.badssl.com/"
|
||||
"https://dh-small-subgroup.badssl.com/"
|
||||
"https://dh-composite.badssl.com/"
|
||||
"https://invalid-expected-sct.badssl.com/"
|
||||
;; "https://no-sct.badssl.com/"
|
||||
;; "https://mixed-script.badssl.com/"
|
||||
;; "https://very.badssl.com/"
|
||||
"https://subdomain.preloaded-hsts.badssl.com/"
|
||||
"https://superfish.badssl.com/"
|
||||
"https://edellroot.badssl.com/"
|
||||
"https://dsdtestprovider.badssl.com/"
|
||||
"https://preact-cli.badssl.com/"
|
||||
"https://webpack-dev-server.badssl.com/"
|
||||
"https://captive-portal.badssl.com/"
|
||||
"https://mitm-software.badssl.com/"
|
||||
"https://sha1-2016.badssl.com/"
|
||||
"https://sha1-2017.badssl.com/")
|
||||
if (condition-case _e
|
||||
(url-retrieve-synchronously bad)
|
||||
(error nil))
|
||||
collect bad)))
|
||||
(print! (error "tls seems to be misconfigured (it got %s).")
|
||||
bad-hosts)
|
||||
(url-retrieve "https://badssl.com"
|
||||
(lambda (status)
|
||||
(if (or (not status) (plist-member status :error))
|
||||
(print! (warn "Something went wrong.\n\n%s") (pp-to-string status))
|
||||
(print! (success "Your trust roots are set up properly.\n\n%s") (pp-to-string status))
|
||||
t)))))
|
||||
|
|
@ -1,9 +1,14 @@
|
|||
;;; core/cli/doctor.el -*- lexical-binding: t; -*-
|
||||
;;; core/cli/doctor.el --- userland heuristics and Emacs diagnostics -*- lexical-binding: t; -*-
|
||||
;;; Commentary:
|
||||
;;; Code:
|
||||
|
||||
(defvar doom-warnings ())
|
||||
(defvar doom-errors ())
|
||||
(defvar doom-doctor--warnings ())
|
||||
(defvar doom-doctor--errors ())
|
||||
|
||||
|
||||
;;
|
||||
;;; DSL
|
||||
|
||||
;;; Helpers
|
||||
(defun elc-check-dir (dir)
|
||||
(dolist (file (directory-files-recursively dir "\\.elc$"))
|
||||
(when (file-newer-than-file-p (concat (file-name-sans-extension file) ".el")
|
||||
|
|
@ -14,27 +19,28 @@
|
|||
`(unless ,condition
|
||||
(error! ,message ,@args)))
|
||||
|
||||
|
||||
;;; Logging
|
||||
(defmacro error! (&rest args)
|
||||
`(progn (unless inhibit-message (print! (error ,@args)))
|
||||
(push (format! (error ,@args)) doom-errors)))
|
||||
(push (format! (error ,@args)) doom-doctor--errors)))
|
||||
|
||||
(defmacro warn! (&rest args)
|
||||
`(progn (unless inhibit-message (print! (warn ,@args)))
|
||||
(push (format! (warn ,@args)) doom-warnings)))
|
||||
(push (format! (warn ,@args)) doom-doctor--warnings)))
|
||||
|
||||
(defmacro success! (&rest args)
|
||||
`(print! (green ,@args)))
|
||||
|
||||
(defmacro section! (&rest args)
|
||||
`(print! (bold (blue ,@args))))
|
||||
|
||||
(defmacro explain! (&rest args)
|
||||
`(print-group! (print! (autofill ,@args))))
|
||||
`(print-group! (print! (fill (string-join (list ,@args) "\n")))))
|
||||
|
||||
|
||||
;;
|
||||
;;; CLI commands
|
||||
|
||||
(defcli! (doctor doc) ()
|
||||
(defcli! ((doctor doc)) ()
|
||||
"Diagnoses common issues on your system.
|
||||
|
||||
The Doom doctor is essentially one big, self-contained elisp shell script that
|
||||
|
|
@ -43,7 +49,7 @@ Issues that could intefere with Doom Emacs.
|
|||
|
||||
Doom modules may optionally have a doctor.el file to run their own heuristics
|
||||
in."
|
||||
:bare t
|
||||
:benchmark nil
|
||||
(print! "The doctor will see you now...\n")
|
||||
|
||||
;; REVIEW Refactor me
|
||||
|
|
@ -55,10 +61,10 @@ in."
|
|||
;; There are 2 newlines between each item to fight against
|
||||
;; the (fill-region) call in `doom--output-autofill'
|
||||
(explain! "Doom supports this version, but you are using a development version of Emacs! "
|
||||
"Be prepared for possibly weekly breakages that\n\n"
|
||||
"\t- you will have to investigate yourself,\n\n"
|
||||
"\t- might appear, or be solved, on any Emacs update,\n\n"
|
||||
"\t- might depend subtly on upstream packages updates\n\n"
|
||||
"Be prepared for possibly weekly breakages that\n"
|
||||
"\t- you will have to investigate yourself."
|
||||
"\t- might appear, or be solved, on any Emacs update."
|
||||
"\t- might depend subtly on upstream packages updates.\n"
|
||||
"You might need to unpin packages to get a fix for a specific commit of Emacs, "
|
||||
"and you should be ready to downgrade Emacs if something is just not fixable."))
|
||||
(EMACS29+
|
||||
|
|
@ -152,9 +158,11 @@ in."
|
|||
(print! (start "Checking Doom Emacs..."))
|
||||
(condition-case-unless-debug ex
|
||||
(print-group!
|
||||
(let ((doom-interactive-p 'doctor))
|
||||
(doom-initialize 'force)
|
||||
(doom-initialize-modules))
|
||||
(let ((doom-interactive-p 'doctor)
|
||||
(noninteractive nil))
|
||||
(defvar doom-reloading-p nil)
|
||||
(require 'core-start)
|
||||
(doom-initialize-packages))
|
||||
|
||||
(print! (success "Initialized Doom Emacs %s") doom-version)
|
||||
(print!
|
||||
|
|
@ -234,8 +242,8 @@ in."
|
|||
(maphash (lambda (key plist)
|
||||
(let (doom-local-errors
|
||||
doom-local-warnings)
|
||||
(let (doom-errors
|
||||
doom-warnings)
|
||||
(let (doom-doctor--errors
|
||||
doom-doctor--warnings)
|
||||
(condition-case-unless-debug ex
|
||||
(let ((doctor-file (doom-module-path (car key) (cdr key) "doctor.el"))
|
||||
(packages-file (doom-module-path (car key) (cdr key) "packages.el")))
|
||||
|
|
@ -247,21 +255,23 @@ in."
|
|||
unless (or (doom-package-get name :disable)
|
||||
(eval (doom-package-get name :ignore))
|
||||
(plist-member (doom-package-get name :recipe) :local-repo)
|
||||
(doom-package-built-in-p name)
|
||||
(doom-package-installed-p name))
|
||||
(locate-library (symbol-name name))
|
||||
;; (doom-package-built-in-p name)
|
||||
;; (doom-package-installed-p name)
|
||||
)
|
||||
do (print! (error "Missing emacs package: %S") name))
|
||||
(let ((inhibit-message t))
|
||||
(load doctor-file 'noerror 'nomessage)))
|
||||
(file-missing (error! "%s" (error-message-string ex)))
|
||||
(error (error! "Syntax error: %s" ex)))
|
||||
(when (or doom-errors doom-warnings)
|
||||
(when (or doom-doctor--errors doom-doctor--warnings)
|
||||
(print-group!
|
||||
(print! (start (bold "%s %s")) (car key) (cdr key))
|
||||
(print! "%s" (string-join (append doom-errors doom-warnings) "\n")))
|
||||
(setq doom-local-errors doom-errors
|
||||
doom-local-warnings doom-warnings)))
|
||||
(appendq! doom-errors doom-local-errors)
|
||||
(appendq! doom-warnings doom-local-warnings)))
|
||||
(print! "%s" (string-join (append doom-doctor--errors doom-doctor--warnings) "\n")))
|
||||
(setq doom-local-errors doom-doctor--errors
|
||||
doom-local-warnings doom-doctor--warnings)))
|
||||
(appendq! doom-doctor--errors doom-local-errors)
|
||||
(appendq! doom-doctor--warnings doom-local-warnings)))
|
||||
doom-modules)))
|
||||
(error
|
||||
(warn! "Attempt to load DOOM failed\n %s\n"
|
||||
|
|
@ -269,15 +279,18 @@ in."
|
|||
(setq doom-modules nil)))
|
||||
|
||||
;; Final report
|
||||
(message "")
|
||||
(dolist (msg (list (list doom-errors "error" 'red)
|
||||
(list doom-warnings "warning" 'yellow)))
|
||||
(terpri)
|
||||
(dolist (msg (list (list doom-doctor--warnings "warning" 'yellow)
|
||||
(list doom-doctor--errors "error" 'red)))
|
||||
(when (car msg)
|
||||
(print! (color (nth 2 msg)
|
||||
(if (cdr msg)
|
||||
"There are %d %ss!"
|
||||
"There is %d %s!")
|
||||
(length (car msg)) (nth 1 msg)))))
|
||||
(unless (or doom-errors doom-warnings)
|
||||
(unless (or doom-doctor--errors doom-doctor--warnings)
|
||||
(success! "Everything seems fine, happy Emacs'ing!"))
|
||||
t)
|
||||
(exit! :pager? "+G"))
|
||||
|
||||
(provide 'core-cli-doctor)
|
||||
;;; doctor.el ends here
|
||||
|
|
|
|||
217
core/cli/env.el
217
core/cli/env.el
|
|
@ -1,17 +1,54 @@
|
|||
;;; core/cli/env.el -*- lexical-binding: t; -*-
|
||||
;;; core/cli/env.el --- envvar file generator -*- lexical-binding: t; -*-
|
||||
;;; Commentary:
|
||||
;;; Code:
|
||||
|
||||
;;
|
||||
;;; Variables
|
||||
|
||||
(defvar doom-env-file (doom-path doom-profile-data-dir "env")
|
||||
"The location of your envvar file, generated by `doom env`.
|
||||
|
||||
This file contains environment variables scraped from your shell environment,
|
||||
which is loaded at startup (if it exists). This is helpful if Emacs can't
|
||||
\(easily) be launched from the correct shell session (particularly for MacOS
|
||||
users).")
|
||||
|
||||
(defvar doom-env-deny
|
||||
'(;; Unix/shell state that shouldn't be persisted
|
||||
"^HOME$" "^\\(OLD\\)?PWD$" "^SHLVL$" "^PS1$" "^R?PROMPT$" "^TERM\\(CAP\\)?$"
|
||||
"^USER$" "^GIT_CONFIG" "^INSIDE_EMACS$"
|
||||
;; X server or services' variables that shouldn't be persisted
|
||||
"^DISPLAY$" "^DBUS_SESSION_BUS_ADDRESS$" "^XAUTHORITY$" "^XDG_SESSION_TYPE$"
|
||||
;; Windows+WSL envvars that shouldn't be persisted
|
||||
"^WSL_INTEROP$"
|
||||
;; ssh and gpg variables (likely to become stale)
|
||||
"^SSH_\\(AUTH_SOCK\\|AGENT_PID\\)$" "^\\(SSH\\|GPG\\)_TTY$"
|
||||
"^GPG_AGENT_INFO$"
|
||||
;; Internal Doom envvars
|
||||
"^DEBUG$" "^INSECURE$" "^\\(EMACS\\|DOOM\\)DIR$" "^__")
|
||||
"Environment variables to omit from envvar files.
|
||||
|
||||
Each string is a regexp, matched against variable names to omit from
|
||||
`doom-env-file'.")
|
||||
|
||||
(defvar doom-env-allow '()
|
||||
"Environment variables to include in envvar files.
|
||||
|
||||
This overrules `doom-env-deny'. Each string is a regexp, matched against
|
||||
variable names to omit from `doom-env-file'.")
|
||||
|
||||
|
||||
;;
|
||||
;;; Commands
|
||||
|
||||
(defcli! env
|
||||
((allow ["-a" "--allow" regexp] "An additive envvar whitelist regexp")
|
||||
(reject ["-r" "--reject" regexp] "An additive envvar blacklist regexp")
|
||||
(allow-only ["-A" regexp] "Blacklist everything but REGEXP")
|
||||
(reject-only ["-R" regexp] "Whitelist everything but REGEXP")
|
||||
(clear-p ["-c" "--clear"] "Clear and delete your envvar file")
|
||||
(outputfile ["-o" path]
|
||||
"Generate the envvar file at PATH. Envvar files that aren't in
|
||||
`doom-env-file' won't be loaded automatically at startup. You will need to load
|
||||
them manually from your private config with the `doom-load-envvars-file'
|
||||
function."))
|
||||
"Creates or regenerates your envvars file.
|
||||
((allow-only ("--allow-all"))
|
||||
(deny-only ("--deny-all"))
|
||||
(output-file ("-o" path) "Write envvar file to non-standard PATH.")
|
||||
;; TODO (refresh? ("-r" "--refresh"))
|
||||
&multiple
|
||||
(rules ("-a" "--allow" "-d" "--deny" regexp) "Allow/deny envvars that match REGEXP"))
|
||||
"(Re)generates envvars file from your shell environment.
|
||||
|
||||
The envvars file is created by scraping the current shell environment into
|
||||
newline-delimited KEY=VALUE pairs. Typically by running '$SHELL -ic env' (or
|
||||
|
|
@ -41,101 +78,65 @@ Why this over exec-path-from-shell?
|
|||
I'd rather it inherit your shell environment /correctly/ (and /completely/)
|
||||
or not at all. It frontloads the debugging process rather than hiding it
|
||||
until you least want to deal with it."
|
||||
(let ((env-file (expand-file-name (or outputfile doom-env-file))))
|
||||
(if (null clear-p)
|
||||
(doom-cli-reload-env-file
|
||||
'force env-file
|
||||
(append (if reject-only (list ".")) (list allow allow-only))
|
||||
(append (if allow-only (list ".")) (list reject reject-only)))
|
||||
(unless (file-exists-p env-file)
|
||||
(user-error! "%S does not exist to be cleared" (path env-file)))
|
||||
(delete-file env-file)
|
||||
(print! (success "Successfully deleted %S") (path env-file)))))
|
||||
(let ((env-file (doom-path (or output-file doom-env-file))))
|
||||
(with-temp-file env-file
|
||||
(setq-local coding-system-for-write 'utf-8-unix)
|
||||
(print! (start "%s envvars file")
|
||||
(if (file-exists-p env-file)
|
||||
"Regenerating"
|
||||
"Generating"))
|
||||
(print-group!
|
||||
(when doom-interactive-p
|
||||
(user-error "doom env: must be run on the command line, not an interactive session"))
|
||||
(goto-char (point-min))
|
||||
(insert
|
||||
";; -*- mode: lisp-interaction; coding: utf-8-unix; -*-\n"
|
||||
";; ---------------------------------------------------------------------------\n"
|
||||
";; This file was auto-generated by `doom env'. It contains a list of environment\n"
|
||||
";; variables scraped from your default shell (based on your settings for \n"
|
||||
";; `doom-env-allow' and `doom-env-deny').\n"
|
||||
";;\n"
|
||||
(if (file-equal-p env-file doom-env-file)
|
||||
(concat ";; It is NOT safe to edit this file. Changes will be overwritten next time you\n"
|
||||
";; run 'doom sync'. To create a safe-to-edit envvar file use:\n;;\n"
|
||||
";; doom env -o ~/.doom.d/myenv\n;;\n"
|
||||
";; And load it with (doom-load-envvars-file \"~/.doom.d/myenv\").\n")
|
||||
(concat ";; This file is safe to edit by hand, but needs to be loaded manually with:\n;;\n"
|
||||
";; (doom-load-envvars-file \"path/to/this/file\")\n;;\n"
|
||||
";; Use 'doom env -o path/to/this/file' to regenerate it."))
|
||||
"\n")
|
||||
;; We assume that this noninteractive session was spawned from the user's
|
||||
;; interactive shell, so simply dump `process-environment' to a file.
|
||||
;;
|
||||
;; This should be well-formatted, in case humans want to hand-modify it.
|
||||
(let* ((denylist (remq nil (append (if deny-only '(".")) (list allow-only) doom-env-deny)))
|
||||
(allowlist (remq nil (append (if allow-only '(".")) (list deny-only) doom-env-allow))))
|
||||
(dolist (rule rules)
|
||||
(push (cdr rule) (if (member (car rule) '("-a" "--allow"))
|
||||
allowlist
|
||||
denylist)))
|
||||
(insert "(")
|
||||
(dolist (env (get 'process-environment 'initial-value))
|
||||
(catch 'skip
|
||||
(let* ((var (car (split-string env "=")))
|
||||
(pred (doom-rpartial #'string-match-p var)))
|
||||
(when (seq-find pred denylist)
|
||||
(if (seq-find pred allowlist)
|
||||
(doom-log "Whitelisted %s" var)
|
||||
(doom-log "Ignored %s" var)
|
||||
(throw 'skip t)))
|
||||
(insert (prin1-to-string env) "\n "))))
|
||||
(insert ")"))
|
||||
(print! (success "Generated %s") (path env-file))
|
||||
t))))
|
||||
|
||||
(defcli! (env (clear c)) ()
|
||||
"Deletes the default envvar file."
|
||||
(let ((env-file (abbreviate-file-name doom-env-file)))
|
||||
(unless (file-exists-p env-file)
|
||||
(user-error "No envvar file to delete: %s" env-file))
|
||||
(delete-file env-file)
|
||||
(print! (success "Deleted %s") (path env-file))))
|
||||
|
||||
;;
|
||||
;; Helpers
|
||||
|
||||
(defvar doom-env-blacklist
|
||||
'(;; State that may be problematic if overwritten
|
||||
"^HOME$" "^\\(OLD\\)?PWD$" "^SHLVL$" "^PS1$" "^R?PROMPT$" "^TERM\\(CAP\\)?$"
|
||||
"^USER$" "^GIT_CONFIG"
|
||||
;; X server or services' variables that shouldn't be persisted
|
||||
"^DISPLAY$" "^DBUS_SESSION_BUS_ADDRESS$" "^XAUTHORITY$" "^XDG_SESSION_TYPE$"
|
||||
;; Windows+WSL envvars that shouldn't be persisted
|
||||
"^WSL_INTEROP$"
|
||||
;; ssh and gpg variables (likely to become stale)
|
||||
"^SSH_\\(AUTH_SOCK\\|AGENT_PID\\)$" "^\\(SSH\\|GPG\\)_TTY$"
|
||||
"^GPG_AGENT_INFO$"
|
||||
;; Internal Doom envvars
|
||||
"^DEBUG$" "^INSECURE$" "^YES$" "^__")
|
||||
"Environment variables to not save in `doom-env-file'.
|
||||
|
||||
Each string is a regexp, matched against variable names to omit from
|
||||
`doom-env-file'.")
|
||||
|
||||
(defvar doom-env-whitelist '()
|
||||
"A whitelist for envvars to save in `doom-env-file'.
|
||||
|
||||
This overrules `doom-env-ignored-vars'. Each string is a regexp, matched against
|
||||
variable names to omit from `doom-env-file'.")
|
||||
|
||||
(defun doom-cli-reload-env-file (&optional force-p env-file whitelist blacklist)
|
||||
"Generates `doom-env-file', if it doesn't exist (or if FORCE-P).
|
||||
|
||||
This scrapes the variables from your shell environment by running
|
||||
`doom-env-executable' through `shell-file-name' with `doom-env-switches'. By
|
||||
default, on Linux, this is '$SHELL -ic /usr/bin/env'. Variables in
|
||||
`doom-env-ignored-vars' are removed."
|
||||
(let ((env-file (expand-file-name (or env-file doom-env-file))))
|
||||
(when (or force-p (not (file-exists-p env-file)))
|
||||
(with-temp-file env-file
|
||||
(setq-local coding-system-for-write 'utf-8-unix)
|
||||
(print! (start "%s envvars file at %S")
|
||||
(if (file-exists-p env-file)
|
||||
"Regenerating"
|
||||
"Generating")
|
||||
(path env-file))
|
||||
(print-group!
|
||||
(when doom-interactive-p
|
||||
(user-error "'doom env' must be run on the command line, not an interactive session"))
|
||||
(goto-char (point-min))
|
||||
(insert
|
||||
(concat
|
||||
";; -*- mode: lisp-interaction; coding: utf-8-unix; -*-\n"
|
||||
";; ---------------------------------------------------------------------------\n"
|
||||
";; This file was auto-generated by `doom env'. It contains a list of environment\n"
|
||||
";; variables scraped from your default shell (excluding variables blacklisted\n"
|
||||
";; in doom-env-ignored-vars).\n"
|
||||
";;\n"
|
||||
(if (file-equal-p env-file doom-env-file)
|
||||
(concat ";; It is NOT safe to edit this file. Changes will be overwritten next time you\n"
|
||||
";; run 'doom sync'. To create a safe-to-edit envvar file use:\n;;\n"
|
||||
";; doom env -o ~/.doom.d/myenv\n;;\n"
|
||||
";; And load it with (doom-load-envvars-file \"~/.doom.d/myenv\").\n")
|
||||
(concat ";; This file is safe to edit by hand, but needs to be loaded manually with:\n;;\n"
|
||||
";; (doom-load-envvars-file \"path/to/this/file\")\n;;\n"
|
||||
";; Use 'doom env -o path/to/this/file' to regenerate it."))
|
||||
"\n"))
|
||||
;; We assume that this noninteractive session was spawned from the
|
||||
;; user's interactive shell, therefore simply dump
|
||||
;; `process-environment' to a file.
|
||||
;;
|
||||
;; This file should be somewhat formatted, so humans could hand-modify
|
||||
;; it if they please.
|
||||
(let ((blacklist (remq nil (append blacklist doom-env-blacklist)))
|
||||
(whitelist (remq nil (append whitelist doom-env-whitelist))))
|
||||
(insert "(")
|
||||
(dolist (env (get 'process-environment 'initial-value))
|
||||
(catch 'skip
|
||||
(let* ((var (car (split-string env "=")))
|
||||
(pred (doom-rpartial #'string-match-p var)))
|
||||
(when (seq-find pred blacklist)
|
||||
(if (seq-find pred whitelist)
|
||||
(doom-log "Whitelisted %s" var)
|
||||
(doom-log "Ignored %s" var)
|
||||
(throw 'skip t)))
|
||||
(insert (prin1-to-string env) "\n "))))
|
||||
(insert ")"))
|
||||
(print! (success "Successfully generated %S") (path env-file))
|
||||
t)))))
|
||||
(provide 'core-cli-env)
|
||||
;;; env.el ends here
|
||||
|
|
|
|||
542
core/cli/help.el
542
core/cli/help.el
|
|
@ -1,102 +1,458 @@
|
|||
;;; core/cli/help.el -*- lexical-binding: t; -*-
|
||||
;;; ../../projects/dotfiles/emacs/core/cli/help.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:
|
||||
;;
|
||||
;; (defalias! (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:
|
||||
|
||||
(defun doom--cli-print-signature (cli)
|
||||
(print! (bold "Usage: doom %s%s%s")
|
||||
(if (doom-cli-internal-p cli)
|
||||
""
|
||||
(concat (doom-cli-name cli) " "))
|
||||
(if-let* ((optlist (doom-cli-optlist cli))
|
||||
(flags (cl-loop for opt in optlist
|
||||
append (doom-cli-option-flags opt)))
|
||||
(fn (doom-partial #'string-prefix-p "--")))
|
||||
(concat (when-let (short-flags (cl-remove-if fn flags))
|
||||
;; TODO Show arguments of short flags
|
||||
(format "[-%s]"
|
||||
(string-join (mapcar (doom-rpartial #'substring 1 nil) short-flags)
|
||||
"")))
|
||||
;; TODO Show long flags
|
||||
;; (when-let (long-flags (cl-remove-if-not fn flags))
|
||||
;; (concat " " (string-join long-flags " ")))
|
||||
" ")
|
||||
"")
|
||||
(if-let (arglist (doom-cli-arglist cli))
|
||||
(string-join (append (cl-loop for arg in arglist
|
||||
until (memq arg cl--lambda-list-keywords)
|
||||
collect (upcase (symbol-name arg)))
|
||||
(cl-loop for arg in (cdr (memq '&optional arglist))
|
||||
until (memq arg cl--lambda-list-keywords)
|
||||
collect (format "[%s]" (upcase (symbol-name arg)))))
|
||||
" ")
|
||||
""))
|
||||
(when-let (aliases (doom-cli-aliases cli))
|
||||
(print! "Aliases: %s" (string-join aliases ", "))))
|
||||
;;
|
||||
;;; Variables
|
||||
|
||||
(defun doom--cli-print-desc (cli &optional short)
|
||||
(print! "%s"
|
||||
(if short
|
||||
(car (split-string (doom-cli-desc cli) "\n"))
|
||||
(doom-cli-desc cli))))
|
||||
(defvar doom-help-commands '("%p %c {-?,--help}")
|
||||
"A list of help commands recognized for the running script.
|
||||
|
||||
(defun doom--cli-print-short-desc (cli)
|
||||
(doom--cli-print-desc cli 'short))
|
||||
|
||||
(defun doom--cli-print-options (cli)
|
||||
(when-let (optlist (doom-cli-optlist cli))
|
||||
(print! (bold "Options:"))
|
||||
(print-group!
|
||||
(cl-loop for opt in optlist
|
||||
for desc = (doom-cli-option-desc opt)
|
||||
for args = (doom-cli-option-args opt)
|
||||
for flagstr = (string-join (doom-cli-option-flags opt) ", ")
|
||||
do
|
||||
;; TODO Adjust columns dynamically
|
||||
(print! "%-18s"
|
||||
(concat flagstr
|
||||
(when-let (arg (car args))
|
||||
(concat " " (upcase (symbol-name arg))))))
|
||||
(print-group!
|
||||
(print! (autofill "%s") desc))))))
|
||||
|
||||
|
||||
(defun doom--cli-print (cli)
|
||||
(doom--cli-print-signature cli)
|
||||
(terpri)
|
||||
(doom--cli-print-desc cli)
|
||||
(terpri)
|
||||
(doom--cli-print-options cli))
|
||||
Recognizes %p (for the prefix) and %c (for the active command).")
|
||||
|
||||
|
||||
;;
|
||||
;;; Commands
|
||||
|
||||
(defcli! (help h) (&optional command)
|
||||
"Describe a command or list them all."
|
||||
:bare t
|
||||
(if command
|
||||
(doom--cli-print (doom-cli-get (intern command)))
|
||||
(doom--cli-print (doom-cli-get :doom))
|
||||
(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 (nreverse 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? (not localonly?))
|
||||
(exit! :pager?)))
|
||||
(t
|
||||
(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"))
|
||||
(when-let (similar (doom-cli-help-similar-commands command 0.4))
|
||||
(print! "Similar commands:")
|
||||
(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 cli)))))
|
||||
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)
|
||||
(print! (bold "Commands:"))
|
||||
(print-group!
|
||||
(dolist (group (seq-group-by (lambda (cli)
|
||||
(plist-get (doom-cli-plist cli) :group))
|
||||
(cl-loop for name being the hash-keys of doom--cli-commands
|
||||
for cli = (gethash name doom--cli-commands)
|
||||
if (and (doom-cli-p cli)
|
||||
(not (doom-cli-internal-p cli))
|
||||
(not (plist-get (doom-cli-plist cli) :hidden)))
|
||||
collect cli)))
|
||||
(if (null (car group))
|
||||
(dolist (cli (cdr group))
|
||||
(print! "%-16s %s"
|
||||
(doom-cli-name cli)
|
||||
(car (split-string (doom-cli-desc cli) "\n"))))
|
||||
(print! "%-26s %s"
|
||||
(bold (concat (car group) ":"))
|
||||
(gethash (car group) doom--cli-groups))
|
||||
(print-group!
|
||||
(dolist (cli (cdr group))
|
||||
(print! "%-16s %s"
|
||||
(doom-cli-name cli)
|
||||
(car (split-string (doom-cli-desc cli) "\n"))))))
|
||||
(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 ((docs (doom-cli-docs cli)))
|
||||
`((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 cli))
|
||||
(options . ,(doom-cli-help--options cli))
|
||||
(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 (doom-cli-command-string cli) " - " .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)) localonly?)
|
||||
`(,(assq 'local .options))
|
||||
.options)
|
||||
cli)))))
|
||||
(letf! (defun printsection (section)
|
||||
(print! "%s\n" (if section (markup section) (dark "TODO"))))
|
||||
(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* ((opts (doom-cli-help--options cli))
|
||||
(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 cli))
|
||||
;; (partial? (null (doom-cli-fn cli)))
|
||||
(subcommands? (doom-cli-subcommands cli 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))))
|
||||
(examples ,@(doom-cli-help--parse-docs (doom-cli-find cli t) "SYNOPSIS")))))
|
||||
|
||||
(defun doom-cli-help--render-synopsis (synopsis &optional prefix with-examples?)
|
||||
(let-alist synopsis
|
||||
(let ((doom-print-indent 0)
|
||||
(prefix (or prefix ""))
|
||||
(command (doom-cli-command-string .command)))
|
||||
(with-temp-buffer
|
||||
(insert! ("%s\n\n"
|
||||
(fill (concat prefix
|
||||
(bold (format "%s " command))
|
||||
(markup
|
||||
(join (append .options
|
||||
(and .options
|
||||
(or .required
|
||||
.optional
|
||||
.rest)
|
||||
(list (dark "[--]")))
|
||||
.required
|
||||
.optional
|
||||
.rest))))
|
||||
80 (1+ (length (concat prefix command))))))
|
||||
(dolist (example (if with-examples? .examples))
|
||||
(insert! ("%s\n%s\n" (markup (car example))
|
||||
(if (cdr example)
|
||||
(format "%s\n" (indent (markup (cdr example))
|
||||
doom-print-indent-increment))))))
|
||||
(string-trim-right (buffer-string))))))
|
||||
|
||||
;;; 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))) commands))
|
||||
(toplevel (assq nil commands))
|
||||
(rest (nreverse (remove toplevel commands)))
|
||||
(drop (if prefix (length prefix) 0))
|
||||
(minwidth (apply #'max (cl-loop for cmd in (apply #'append (mapcar #'cdr commands))
|
||||
for cmd = (seq-drop cmd drop)
|
||||
collect (length (doom-cli-command-string cmd)))))
|
||||
(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 (doom-cli-command 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 'core-cli-help)
|
||||
;;; help.el ends here
|
||||
|
|
|
|||
34
core/cli/info.el
Normal file
34
core/cli/info.el
Normal file
|
|
@ -0,0 +1,34 @@
|
|||
;;; core/cli/info.el --- information about your Doom install -*- lexical-binding: t; -*-
|
||||
;;; Commentary:
|
||||
;;; Code:
|
||||
|
||||
;;
|
||||
;;; Variables
|
||||
|
||||
;; None yet!
|
||||
|
||||
|
||||
;;
|
||||
;;; Commands
|
||||
|
||||
(defcli! info
|
||||
((format ("--lisp" "--json") "What format to dump info into")
|
||||
&context context)
|
||||
"Print detailed information about your config for bug reports."
|
||||
(with-temp-buffer
|
||||
(pcase format
|
||||
("--json"
|
||||
(require 'json)
|
||||
(insert (json-encode (doom-info)))
|
||||
(json-pretty-print-buffer))
|
||||
("--lisp"
|
||||
(pp (doom-info)))
|
||||
(_
|
||||
(insert (doom-info-string
|
||||
(if (doom-cli-context-pipe-p context :out t)
|
||||
72
|
||||
(doom-cli-context-width context))))))
|
||||
(print! "%s" (string-trim-right (buffer-string)))))
|
||||
|
||||
(provide 'core-cli-info)
|
||||
;;; info.el ends here
|
||||
|
|
@ -1,32 +1,50 @@
|
|||
;;; core/cli/install.el -*- lexical-binding: t; -*-
|
||||
;;; core/cli/install.el --- Doom Emacs install wizard -*- lexical-binding: t; -*-
|
||||
;;; Commentary:
|
||||
;;; Code:
|
||||
|
||||
(defcli! (install i)
|
||||
((noconfig-p ["--no-config"] "Don't create DOOMDIR or dummy files therein")
|
||||
(noenv-p ["--no-env"] "Don't generate an envvars file (see 'doom help env')")
|
||||
(noinstall-p ["--no-install"] "Don't auto-install packages")
|
||||
(nofonts-p ["--no-fonts"] "Don't install (or prompt to install) all-the-icons fonts")
|
||||
(nohooks-p ["--no-hooks"] "Don't deploy git hooks"))
|
||||
(eval-when-compile (require 'core-cli)) ; appease byte-compiler-sama
|
||||
|
||||
|
||||
;;
|
||||
;;; Variables
|
||||
|
||||
;; None yet!
|
||||
|
||||
|
||||
;;
|
||||
;;; Commands
|
||||
|
||||
(defcli! ((install i))
|
||||
(&flags
|
||||
(config? ("--config" :yes) "Create `$DOOMDIR' or dummy files therein?")
|
||||
(envfile? ("--env" :yes) "(Re)generate an envvars file? (see `$ doom help env`)")
|
||||
(install? ("--install" :yes) "Auto-install packages?")
|
||||
(fonts? ("--fonts" :yes) "Install (or prompt to install) all-the-icons fonts?")
|
||||
(hooks? ("--hooks" :yes) "Deploy Doom's git hooks to itself?")
|
||||
&context context)
|
||||
"Installs and sets up Doom Emacs for the first time.
|
||||
|
||||
This command does the following:
|
||||
|
||||
1. Creates DOOMDIR at ~/.doom.d,
|
||||
2. Copies ~/.emacs.d/init.example.el to $DOOMDIR/init.el (if it doesn't exist),
|
||||
3. Creates dummy files for $DOOMDIR/{config,packages}.el,
|
||||
4. Prompts you to generate an envvar file (same as 'doom env'),
|
||||
5. Installs any dependencies of enabled modules (specified by $DOOMDIR/init.el),
|
||||
1. Creates `$DOOMDIR' at ~/.doom.d,
|
||||
2. Copies ~/.emacs.d/init.example.el to `$DOOMDIR'/init.el (if it doesn't exist),
|
||||
3. Creates dummy files for `$DOOMDIR'/{config,packages}.el,
|
||||
4. Prompts you to generate an envvar file (same as `$ doom env`),
|
||||
5. Installs any dependencies of enabled modules (specified by `$DOOMDIR'/init.el),
|
||||
6. And prompts to install all-the-icons' fonts
|
||||
|
||||
This command is idempotent and safe to reuse.
|
||||
|
||||
The location of DOOMDIR can be changed with the environment variable of the same
|
||||
name. e.g.
|
||||
Change `$DOOMDIR' with the `--doomdir' option, e.g.
|
||||
|
||||
DOOMDIR=~/.config/doom doom install"
|
||||
```
|
||||
$ doom --doomdir /other/doom/config install
|
||||
```"
|
||||
(print! (green "Installing Doom Emacs!\n"))
|
||||
(let ((default-directory doom-emacs-dir))
|
||||
(let ((default-directory doom-emacs-dir)
|
||||
(yes? (doom-cli-context-suppress-prompts-p context)))
|
||||
;; Create `doom-private-dir'
|
||||
(if noconfig-p
|
||||
(if (eq config? :no)
|
||||
(print! (warn "Not copying private config template, as requested"))
|
||||
;; Create DOOMDIR in ~/.config/doom if ~/.config/emacs exists.
|
||||
(when (and (not (file-directory-p doom-private-dir))
|
||||
|
|
@ -34,39 +52,41 @@ name. e.g.
|
|||
(let ((xdg-config-dir (or (getenv "XDG_CONFIG_HOME") "~/.config")))
|
||||
(when (file-in-directory-p doom-emacs-dir xdg-config-dir)
|
||||
(setq doom-private-dir (expand-file-name "doom/" xdg-config-dir)))))
|
||||
(print! (start "Creating %s") (relpath doom-private-dir))
|
||||
(make-directory doom-private-dir 'parents)
|
||||
(print-group!
|
||||
(print! (success "Created %s") (relpath doom-private-dir)))
|
||||
|
||||
(if (file-directory-p doom-private-dir)
|
||||
(print! (item "Skipping %s (already exists)") (relpath doom-private-dir))
|
||||
(make-directory doom-private-dir 'parents)
|
||||
(print! (success "Created %s") (relpath doom-private-dir)))
|
||||
|
||||
;; Create init.el, config.el & packages.el
|
||||
(mapc (lambda (file)
|
||||
(cl-destructuring-bind (filename . template) file
|
||||
(if (file-exists-p! filename doom-private-dir)
|
||||
(print! (warn "%s already exists, skipping") filename)
|
||||
(print! (info "Creating %s%s") (relpath doom-private-dir) filename)
|
||||
(with-temp-file (doom-path doom-private-dir filename)
|
||||
(insert-file-contents template))
|
||||
(print! (success "Done!")))))
|
||||
`(("init.el" . ,(doom-path doom-emacs-dir "init.example.el"))
|
||||
("config.el" . ,(doom-path doom-core-dir "templates/config.example.el"))
|
||||
("packages.el" . ,(doom-path doom-core-dir "templates/packages.example.el")))))
|
||||
(print-group!
|
||||
(mapc (lambda (file)
|
||||
(cl-destructuring-bind (filename . template) file
|
||||
(if (file-exists-p! filename doom-private-dir)
|
||||
(print! (item "Skipping %s (already exists)")
|
||||
(path filename))
|
||||
(print! (item "Creating %s%s") (relpath doom-private-dir) filename)
|
||||
(with-temp-file (doom-path doom-private-dir filename)
|
||||
(insert-file-contents template))
|
||||
(print! (success "Done!")))))
|
||||
`(("init.el" . ,(doom-path doom-emacs-dir "init.example.el"))
|
||||
("config.el" . ,(doom-path doom-core-dir "templates/config.example.el"))
|
||||
("packages.el" . ,(doom-path doom-core-dir "templates/packages.example.el"))))))
|
||||
|
||||
;; In case no init.el was present the first time `doom-initialize-modules' was
|
||||
;; called in core.el (e.g. on first install)
|
||||
(doom-initialize-modules 'force 'no-config)
|
||||
|
||||
;; Ask if user would like an envvar file generated
|
||||
(if noenv-p
|
||||
(if (eq envfile? :no)
|
||||
(print! (warn "Not generating envvars file, as requested"))
|
||||
(if (file-exists-p doom-env-file)
|
||||
(print! (info "Envvar file already exists, skipping"))
|
||||
(when (or doom-auto-accept
|
||||
(y-or-n-p "Generate an envvar file? (see `doom help env` for details)"))
|
||||
(print! (item "Envvar file already exists, skipping"))
|
||||
(when (or yes? (y-or-n-p "Generate an envvar file? (see `doom help env` for details)"))
|
||||
(doom-cli-reload-env-file 'force-p))))
|
||||
|
||||
;; Install Doom packages
|
||||
(if noinstall-p
|
||||
(if (eq install? :no)
|
||||
(print! (warn "Not installing plugins, as requested"))
|
||||
(print! "Installing plugins")
|
||||
(doom-cli-packages-install))
|
||||
|
|
@ -74,16 +94,16 @@ name. e.g.
|
|||
(print! "Regenerating autoloads files")
|
||||
(doom-autoloads-reload)
|
||||
|
||||
(if nohooks-p
|
||||
(if (eq hooks? :no)
|
||||
(print! (warn "Not deploying commit-msg and pre-push git hooks, as requested"))
|
||||
(print! "Deploying commit-msg and pre-push git hooks")
|
||||
(print-group!
|
||||
(condition-case e
|
||||
(doom-cli--ci-deploy-hooks doom-auto-accept)
|
||||
(doom-cli--ci-deploy-hooks yes?)
|
||||
('user-error
|
||||
(print! (warn "%s") (error-message-string e))))))
|
||||
|
||||
(cond (nofonts-p)
|
||||
(cond ((eq fonts? :no))
|
||||
(IS-WINDOWS
|
||||
(print! (warn "Doom cannot install all-the-icons' fonts on Windows!\n"))
|
||||
(print-group!
|
||||
|
|
@ -93,8 +113,7 @@ name. e.g.
|
|||
" 2. Execute 'M-x all-the-icons-install-fonts' to download the fonts\n"
|
||||
" 3. Open the download location in windows explorer\n"
|
||||
" 4. Open each font file to install them"))))
|
||||
((or doom-auto-accept
|
||||
(y-or-n-p "Download and install all-the-icon's fonts?"))
|
||||
((or yes? (y-or-n-p "Download and install all-the-icon's fonts?"))
|
||||
(require 'all-the-icons)
|
||||
(let ((window-system (cond (IS-MAC 'ns)
|
||||
(IS-LINUX 'x))))
|
||||
|
|
@ -107,3 +126,6 @@ name. e.g.
|
|||
(with-temp-buffer
|
||||
(insert-file-contents (doom-path doom-core-dir "templates/QUICKSTART_INTRO"))
|
||||
(print! "%s" (buffer-string)))))
|
||||
|
||||
(provide 'core-cli-install)
|
||||
;;; install.el ends here
|
||||
|
|
|
|||
|
|
@ -1,71 +0,0 @@
|
|||
;;; 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 . rest)
|
||||
(cons (doom-cli--backtrace) data)
|
||||
(with-output-to! doom--cli-log-buffer
|
||||
(let ((straight-error
|
||||
(and (bound-and-true-p straight-process-buffer)
|
||||
(stringp data)
|
||||
(string-match-p (regexp-quote straight-process-buffer)
|
||||
data)
|
||||
(with-current-buffer (straight--process-buffer)
|
||||
(split-string (buffer-string) "\n" t)))))
|
||||
(cond (straight-error
|
||||
(print! (error "The package manager threw an error"))
|
||||
(print! (error "Last 25 lines of straight's error log:"))
|
||||
(print-group!
|
||||
(print!
|
||||
"%s" (string-join
|
||||
(seq-subseq straight-error
|
||||
(max 0 (- (length straight-error) 25))
|
||||
(length straight-error))
|
||||
"\n"))))
|
||||
((print! (error "There was an unexpected error"))
|
||||
(print-group!
|
||||
(print! "%s %s" (bold "Message:") (get type 'error-message))
|
||||
(print! "%s %S" (bold "Error:") (append (list type data) rest))
|
||||
(when backtrace
|
||||
(print! (bold "Backtrace:"))
|
||||
(print-group!
|
||||
(dolist (frame (seq-take backtrace 10))
|
||||
(let* ((frame (replace-regexp-in-string
|
||||
"[\n\r]" "\\\\n" (prin1-to-string frame)))
|
||||
(frame (if (> (length frame) 74)
|
||||
(concat (substring frame 0 74) "...")
|
||||
frame)))
|
||||
(print! "%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
|
||||
(print (string-join straight-error "\n")))
|
||||
(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)))
|
||||
|
|
@ -1,185 +0,0 @@
|
|||
;;; 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))
|
||||
|
|
@ -1,129 +0,0 @@
|
|||
;;; 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 (fn &optional prompt)
|
||||
:around #'straight-are-you-sure
|
||||
(or doom-auto-accept
|
||||
(if doom-interactive-p
|
||||
(funcall 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 (fn prompt actions)
|
||||
"Modifies straight to prompt on the terminal when in noninteractive sessions."
|
||||
:around #'straight--popup-raw
|
||||
(if doom-interactive-p
|
||||
(funcall 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)))))))))
|
||||
|
||||
(setq straight-arrow " > ")
|
||||
(defadvice! doom--straight-respect-print-indent-a (string &rest objects)
|
||||
"Same as `message' (which see for STRING and OBJECTS) normally.
|
||||
However, in batch mode, print to stdout instead of stderr."
|
||||
:override #'straight--output
|
||||
(let ((msg (apply #'format string objects)))
|
||||
(save-match-data
|
||||
(when (string-match (format "^%s\\(.+\\)$" (regexp-quote straight-arrow)) msg)
|
||||
(setq msg (match-string 1 msg))))
|
||||
(and (string-match-p "^\\(Cloning\\|\\(Reb\\|B\\)uilding\\) " msg)
|
||||
(not (string-suffix-p "...done" msg))
|
||||
(doom--print (doom--format (concat "> " msg))))))
|
||||
|
||||
(defadvice! doom--straight-ignore-gitconfig-a (fn &rest args)
|
||||
"Prevent user and system git configuration from interfering with git calls."
|
||||
:around #'straight--process-call
|
||||
(letenv! (("GIT_CONFIG" nil)
|
||||
("GIT_CONFIG_NOSYSTEM" "1")
|
||||
("GIT_CONFIG_GLOBAL" (or (getenv "DOOMGITCONFIG")
|
||||
"/dev/null")))
|
||||
(apply fn args)))
|
||||
|
|
@ -1,37 +1,39 @@
|
|||
;; -*- no-byte-compile: t; -*-
|
||||
;;; core/cli/packages.el
|
||||
;;; core/cli/packages.el --- package management commands -*- lexical-binding: t; -*-
|
||||
;;; Commentary:
|
||||
;;; Code:
|
||||
|
||||
(require 'comp nil t)
|
||||
;;
|
||||
;;; Variables
|
||||
|
||||
;; None yet!
|
||||
|
||||
|
||||
;;
|
||||
;;; Commands
|
||||
|
||||
(defcli! (update u) (&rest _)
|
||||
"This command was removed."
|
||||
:hidden t
|
||||
(print! (error "This command has been removed.\n"))
|
||||
(print-group!
|
||||
(print! "To update Doom run 'doom upgrade'. To only update packages run 'doom sync -u'."))
|
||||
nil)
|
||||
(defcli! (:before (build b purge p)) (&context context)
|
||||
(require 'comp nil t)
|
||||
(doom-initialize-core-packages))
|
||||
|
||||
(defcli! (build b)
|
||||
((rebuild-p ["-r"] "Only rebuild packages that need rebuilding"))
|
||||
;; DEPRECATED Replace with "doom sync --rebuild"
|
||||
(defcli! ((build b))
|
||||
((rebuild-p ("-r") "Only rebuild packages that need rebuilding"))
|
||||
"Byte-compiles & symlinks installed packages.
|
||||
|
||||
This ensures that all needed files are symlinked from their package repo and
|
||||
their elisp files are byte-compiled. This is especially necessary if you upgrade
|
||||
Emacs (as byte-code is generally not forward-compatible)."
|
||||
(when (doom-cli-packages-build (not rebuild-p))
|
||||
(when (doom-packages-build (not rebuild-p))
|
||||
(doom-autoloads-reload))
|
||||
t)
|
||||
|
||||
(defcli! (purge p)
|
||||
((nobuilds-p ["-b" "--no-builds"] "Don't purge unneeded (built) packages")
|
||||
(noelpa-p ["-p" "--no-elpa"] "Don't purge ELPA packages")
|
||||
(norepos-p ["-r" "--no-repos"] "Don't purge unused straight repos")
|
||||
(noeln-p ["-e" "--no-eln"] "Don't purge old ELN bytecode")
|
||||
(noregraft-p ["-g" "--no-regraft"] "Regraft git repos (ie. compact them)"))
|
||||
;; TODO Rename to "doom gc" and move to its own file
|
||||
(defcli! ((purge p))
|
||||
((nobuilds-p ("-b" "--no-builds") "Don't purge unneeded (built) packages")
|
||||
(noelpa-p ("-p" "--no-elpa") "Don't purge ELPA packages")
|
||||
(norepos-p ("-r" "--no-repos") "Don't purge unused straight repos")
|
||||
(noeln-p ("-e" "--no-eln") "Don't purge old ELN bytecode")
|
||||
(noregraft-p ("-g" "--no-regraft") "Regraft git repos (ie. compact them)"))
|
||||
"Deletes orphaned packages & repos, and compacts them.
|
||||
|
||||
Purges all installed ELPA packages (as they are considered temporary). Purges
|
||||
|
|
@ -42,7 +44,7 @@ possible.
|
|||
It is a good idea to occasionally run this doom purge -g to ensure your package
|
||||
list remains lean."
|
||||
(straight-check-all)
|
||||
(when (doom-cli-packages-purge
|
||||
(when (doom-packages-purge
|
||||
(not noelpa-p)
|
||||
(not norepos-p)
|
||||
(not nobuilds-p)
|
||||
|
|
@ -51,24 +53,24 @@ list remains lean."
|
|||
(doom-autoloads-reload))
|
||||
t)
|
||||
|
||||
;; (defcli! rollback () ; TODO doom rollback
|
||||
;; "<Not implemented yet>"
|
||||
;; (user-error "Not implemented yet, sorry!"))
|
||||
(defcli! rollback () :stub t) ; TODO Implement me post-3.0
|
||||
|
||||
|
||||
;;
|
||||
;;; Library
|
||||
|
||||
(defun doom--same-commit-p (abbrev-ref ref)
|
||||
;; FIXME Enforce naming conventions for all functions below
|
||||
|
||||
(defun doom-packages--same-commit-p (abbrev-ref ref)
|
||||
(and (stringp abbrev-ref)
|
||||
(stringp ref)
|
||||
(string-match-p (concat "^" (regexp-quote abbrev-ref))
|
||||
ref)))
|
||||
|
||||
(defun doom--abbrev-commit (commit &optional full)
|
||||
(defun doom-packages--abbrev-commit (commit &optional full)
|
||||
(if full commit (substring commit 0 7)))
|
||||
|
||||
(defun doom--commit-log-between (start-ref end-ref)
|
||||
(defun doom-packages--commit-log-between (start-ref end-ref)
|
||||
(straight--process-with-result
|
||||
(straight--process-run
|
||||
"git" "log" "--oneline" "--no-merges"
|
||||
|
|
@ -77,7 +79,7 @@ list remains lean."
|
|||
(string-trim-right (or stdout ""))
|
||||
(format "ERROR: Couldn't collect commit list because: %s" stderr))))
|
||||
|
||||
(defmacro doom--straight-with (form &rest body)
|
||||
(defmacro doom-packages--straight-with (form &rest body)
|
||||
(declare (indent 1))
|
||||
`(let-alist
|
||||
(let* ((buffer (straight--process-buffer))
|
||||
|
|
@ -94,12 +96,12 @@ list remains lean."
|
|||
"\n+\\[Return code: [0-9-]+\\]\n+")))))
|
||||
,@body))
|
||||
|
||||
(defun doom--barf-if-incomplete-packages ()
|
||||
(defun doom-packages--barf-if-incomplete ()
|
||||
(let ((straight-safe-mode t))
|
||||
(condition-case _ (straight-check-all)
|
||||
(error (user-error "Package state is incomplete. Run 'doom sync' first")))))
|
||||
|
||||
(defmacro doom--with-package-recipes (recipes binds &rest body)
|
||||
(defmacro doom-packages--with-recipes (recipes binds &rest body)
|
||||
(declare (indent 2))
|
||||
(let ((recipe-var (make-symbol "recipe"))
|
||||
(recipes-var (make-symbol "recipes")))
|
||||
|
|
@ -114,14 +116,14 @@ list remains lean."
|
|||
,(doom-enlist binds)
|
||||
,@body))))))
|
||||
|
||||
(defvar doom--cli-updated-recipes nil)
|
||||
(defun doom--cli-recipes-update ()
|
||||
(defvar doom-packages--cli-updated-recipes nil)
|
||||
(defun doom-packages--cli-recipes-update ()
|
||||
"Updates straight and recipe repos."
|
||||
(unless doom--cli-updated-recipes
|
||||
(unless doom-packages--cli-updated-recipes
|
||||
(straight--make-build-cache-available)
|
||||
(print! (start "Updating recipe repos..."))
|
||||
(print-group!
|
||||
(doom--with-package-recipes
|
||||
(doom-packages--with-recipes
|
||||
(delq
|
||||
nil (mapcar (doom-rpartial #'gethash straight--repo-cache)
|
||||
(mapcar #'symbol-name straight-recipe-repositories)))
|
||||
|
|
@ -130,39 +132,39 @@ list remains lean."
|
|||
(ref (straight-vc-get-commit type local-repo))
|
||||
newref output)
|
||||
(print! (start "\033[KUpdating recipes for %s...%s") package esc)
|
||||
(doom--straight-with (straight-vc-fetch-from-remote recipe)
|
||||
(doom-packages--straight-with (straight-vc-fetch-from-remote recipe)
|
||||
(when .it
|
||||
(setq output .output)
|
||||
(straight-merge-package package)
|
||||
(unless (equal ref (setq newref (straight-vc-get-commit type local-repo)))
|
||||
(print! (success "\033[K%s updated (%s -> %s)")
|
||||
package
|
||||
(doom--abbrev-commit ref)
|
||||
(doom--abbrev-commit newref))
|
||||
(doom-packages--abbrev-commit ref)
|
||||
(doom-packages--abbrev-commit newref))
|
||||
(unless (string-empty-p output)
|
||||
(print-group! (print! (info "%s" output))))))))))
|
||||
(print-group! (print! (item "%s" output))))))))))
|
||||
(setq straight--recipe-lookup-cache (make-hash-table :test #'eq)
|
||||
doom--cli-updated-recipes t)))
|
||||
doom-packages--cli-updated-recipes t)))
|
||||
|
||||
(defvar doom--eln-output-expected nil)
|
||||
(defvar doom-packages--eln-output-expected nil)
|
||||
|
||||
(defvar doom--eln-output-path (car (bound-and-true-p native-comp-eln-load-path)))
|
||||
(defvar doom-packages--eln-output-path (car (bound-and-true-p native-comp-eln-load-path)))
|
||||
|
||||
(defun doom--eln-file-name (file)
|
||||
(defun doom-packages--eln-file-name (file)
|
||||
"Return the short .eln file name corresponding to `file'."
|
||||
(concat comp-native-version-dir "/"
|
||||
(file-name-nondirectory
|
||||
(comp-el-to-eln-filename file))))
|
||||
|
||||
(defun doom--eln-output-file (eln-name)
|
||||
(defun doom-packages--eln-output-file (eln-name)
|
||||
"Return the expected .eln file corresponding to `eln-name'."
|
||||
(concat doom--eln-output-path eln-name))
|
||||
(concat doom-packages--eln-output-path eln-name))
|
||||
|
||||
(defun doom--eln-error-file (eln-name)
|
||||
(defun doom-packages--eln-error-file (eln-name)
|
||||
"Return the expected .error file corresponding to `eln-name'."
|
||||
(concat doom--eln-output-path eln-name ".error"))
|
||||
(concat doom-packages--eln-output-path eln-name ".error"))
|
||||
|
||||
(defun doom--find-eln-file (eln-name)
|
||||
(defun doom-packages--find-eln-file (eln-name)
|
||||
"Find `eln-name' on the `native-comp-eln-load-path'."
|
||||
(cl-some (lambda (eln-path)
|
||||
(let ((file (concat eln-path eln-name)))
|
||||
|
|
@ -170,7 +172,7 @@ list remains lean."
|
|||
file)))
|
||||
native-comp-eln-load-path))
|
||||
|
||||
(defun doom--elc-file-outdated-p (file)
|
||||
(defun doom-packages--elc-file-outdated-p (file)
|
||||
"Check whether the corresponding .elc for `file' is outdated."
|
||||
(let ((elc-file (byte-compile-dest-file file)))
|
||||
;; NOTE Ignore missing elc files, they could be missing due to
|
||||
|
|
@ -180,11 +182,11 @@ list remains lean."
|
|||
(doom-log "%s is newer than %s" file elc-file)
|
||||
t)))
|
||||
|
||||
(defun doom--eln-file-outdated-p (file)
|
||||
(defun doom-packages--eln-file-outdated-p (file)
|
||||
"Check whether the corresponding .eln for `file' is outdated."
|
||||
(let* ((eln-name (doom--eln-file-name file))
|
||||
(eln-file (doom--find-eln-file eln-name))
|
||||
(error-file (doom--eln-error-file eln-name)))
|
||||
(let* ((eln-name (doom-packages--eln-file-name file))
|
||||
(eln-file (doom-packages--find-eln-file eln-name))
|
||||
(error-file (doom-packages--eln-error-file eln-name)))
|
||||
(cond (eln-file
|
||||
(when (file-newer-than-file-p file eln-file)
|
||||
(doom-log "%s is newer than %s" file eln-file)
|
||||
|
|
@ -197,28 +199,28 @@ list remains lean."
|
|||
(doom-log "%s doesn't exist" eln-name)
|
||||
t))))
|
||||
|
||||
(defun doom--native-compile-done-h (file)
|
||||
(defun doom-packages--native-compile-done-h (file)
|
||||
"Callback fired when an item has finished async compilation."
|
||||
(when file
|
||||
(let* ((eln-name (doom--eln-file-name file))
|
||||
(eln-file (doom--eln-output-file eln-name))
|
||||
(error-file (doom--eln-error-file eln-name)))
|
||||
(let* ((eln-name (doom-packages--eln-file-name file))
|
||||
(eln-file (doom-packages--eln-output-file eln-name))
|
||||
(error-file (doom-packages--eln-error-file eln-name)))
|
||||
(if (file-exists-p eln-file)
|
||||
(doom-log "Compiled %s" eln-file)
|
||||
(make-directory (file-name-directory error-file) 'parents)
|
||||
(write-region "" nil error-file)
|
||||
(doom-log "Wrote %s" error-file)))))
|
||||
|
||||
(defun doom--native-compile-jobs ()
|
||||
(defun doom-packages--native-compile-jobs ()
|
||||
"How many async native compilation jobs are queued or in-progress."
|
||||
(if (featurep 'comp)
|
||||
(+ (length comp-files-queue)
|
||||
(comp-async-runnings))
|
||||
0))
|
||||
|
||||
(defun doom--wait-for-native-compile-jobs ()
|
||||
(defun doom-packages--wait-for-native-compile-jobs ()
|
||||
"Wait for all pending async native compilation jobs."
|
||||
(cl-loop for pending = (doom--native-compile-jobs)
|
||||
(cl-loop for pending = (doom-packages--native-compile-jobs)
|
||||
with previous = 0
|
||||
while (not (zerop pending))
|
||||
if (/= previous pending) do
|
||||
|
|
@ -228,21 +230,21 @@ list remains lean."
|
|||
(let ((inhibit-message t))
|
||||
(sleep-for 0.1))))
|
||||
|
||||
(defun doom--write-missing-eln-errors ()
|
||||
(defun doom-packages--write-missing-eln-errors ()
|
||||
"Write .error files for any expected .eln files that are missing."
|
||||
(when NATIVECOMP
|
||||
(cl-loop for file in doom--eln-output-expected
|
||||
for eln-name = (doom--eln-file-name file)
|
||||
for eln-file = (doom--eln-output-file eln-name)
|
||||
for error-file = (doom--eln-error-file eln-name)
|
||||
(cl-loop for file in doom-packages--eln-output-expected
|
||||
for eln-name = (doom-packages--eln-file-name file)
|
||||
for eln-file = (doom-packages--eln-output-file eln-name)
|
||||
for error-file = (doom-packages--eln-error-file eln-name)
|
||||
unless (or (file-exists-p eln-file)
|
||||
(file-newer-than-file-p error-file file))
|
||||
do (make-directory (file-name-directory error-file) 'parents)
|
||||
(write-region "" nil error-file)
|
||||
(doom-log "Wrote %s" error-file))
|
||||
(setq doom--eln-output-expected nil)))
|
||||
(setq doom-packages--eln-output-expected nil)))
|
||||
|
||||
(defun doom--compile-site-packages ()
|
||||
(defun doom-packages--compile-site-files ()
|
||||
"Queue async compilation for all non-doom Elisp files."
|
||||
(when NATIVECOMP
|
||||
(cl-loop with paths = (cl-loop for path in load-path
|
||||
|
|
@ -250,14 +252,14 @@ list remains lean."
|
|||
collect path)
|
||||
for file in (doom-files-in paths :match "\\.el\\(?:\\.gz\\)?$")
|
||||
if (and (file-exists-p (byte-compile-dest-file file))
|
||||
(not (doom--find-eln-file (doom--eln-file-name file)))
|
||||
(not (doom-packages--find-eln-file (doom-packages--eln-file-name file)))
|
||||
(not (cl-some (lambda (re)
|
||||
(string-match-p re file))
|
||||
native-comp-deferred-compilation-deny-list))) do
|
||||
(doom-log "Compiling %s" file)
|
||||
(native-compile-async file))))
|
||||
|
||||
(defun doom-cli-packages-install ()
|
||||
(defun doom-packages-install ()
|
||||
"Installs missing packages.
|
||||
|
||||
This function will install any primary package (i.e. a package with a `package!'
|
||||
|
|
@ -266,17 +268,17 @@ declaration) or dependency thereof that hasn't already been."
|
|||
(print! (start "Installing packages..."))
|
||||
(let ((pinned (doom-package-pinned-list)))
|
||||
(print-group!
|
||||
(add-hook 'native-comp-async-cu-done-functions #'doom--native-compile-done-h)
|
||||
(add-hook 'native-comp-async-cu-done-functions #'doom-packages--native-compile-done-h)
|
||||
(if-let (built
|
||||
(doom--with-package-recipes (doom-package-recipe-list)
|
||||
(doom-packages--with-recipes (doom-package-recipe-list)
|
||||
(recipe package type local-repo)
|
||||
(unless (file-directory-p (straight--repos-dir local-repo))
|
||||
(doom--cli-recipes-update))
|
||||
(doom-packages--cli-recipes-update))
|
||||
(condition-case-unless-debug e
|
||||
(let ((straight-use-package-pre-build-functions
|
||||
(cons (lambda (pkg &rest _)
|
||||
(when-let (commit (cdr (assoc pkg pinned)))
|
||||
(print! (info "Checked out %s: %s") pkg commit)))
|
||||
(print! (item "Checked out %s: %s") pkg commit)))
|
||||
straight-use-package-pre-build-functions)))
|
||||
(straight-use-package (intern package))
|
||||
;; HACK Line encoding issues can plague repos with dirty
|
||||
|
|
@ -291,16 +293,16 @@ declaration) or dependency thereof that hasn't already been."
|
|||
(error
|
||||
(signal 'doom-package-error (list package e))))))
|
||||
(progn
|
||||
(doom--compile-site-packages)
|
||||
(doom-packages--compile-site-files)
|
||||
(when NATIVECOMP
|
||||
(doom--wait-for-native-compile-jobs)
|
||||
(doom--write-missing-eln-errors))
|
||||
(doom-packages--wait-for-native-compile-jobs)
|
||||
(doom-packages--write-missing-eln-errors))
|
||||
(print! (success "\033[KInstalled %d packages") (length built)))
|
||||
(print! (info "No packages need to be installed"))
|
||||
(print! (item "No packages need to be installed"))
|
||||
nil))))
|
||||
|
||||
|
||||
(defun doom-cli-packages-build (&optional force-p)
|
||||
(defun doom-packages-build (&optional force-p)
|
||||
"(Re)build all packages."
|
||||
(doom-initialize-packages)
|
||||
(print! (start "(Re)building %spackages...") (if force-p "all " ""))
|
||||
|
|
@ -318,11 +320,11 @@ declaration) or dependency thereof that hasn't already been."
|
|||
(or (if force-p :all straight--packages-to-rebuild)
|
||||
(make-hash-table :test #'equal)))
|
||||
(recipes (doom-package-recipe-list)))
|
||||
(add-hook 'native-comp-async-cu-done-functions #'doom--native-compile-done-h)
|
||||
(add-hook 'native-comp-async-cu-done-functions #'doom-packages--native-compile-done-h)
|
||||
(unless force-p
|
||||
(straight--make-build-cache-available))
|
||||
(if-let (built
|
||||
(doom--with-package-recipes recipes (package local-repo recipe)
|
||||
(doom-packages--with-recipes recipes (package local-repo recipe)
|
||||
(unless force-p
|
||||
;; Ensure packages with outdated files/bytecode are rebuilt
|
||||
(let* ((build-dir (straight--build-dir package))
|
||||
|
|
@ -346,19 +348,19 @@ declaration) or dependency thereof that hasn't already been."
|
|||
(file-exists-p (straight--modified-dir (or local-repo package)))
|
||||
(cl-loop with outdated = nil
|
||||
for file in (doom-files-in build-dir :match "\\.el$" :full t)
|
||||
if (or (if want-byte-compile (doom--elc-file-outdated-p file))
|
||||
(if want-native-compile (doom--eln-file-outdated-p file)))
|
||||
if (or (if want-byte-compile (doom-packages--elc-file-outdated-p file))
|
||||
(if want-native-compile (doom-packages--eln-file-outdated-p file)))
|
||||
do (setq outdated t)
|
||||
(when want-native-compile
|
||||
(push file doom--eln-output-expected))
|
||||
(push file doom-packages--eln-output-expected))
|
||||
finally return outdated))
|
||||
(puthash package t straight--packages-to-rebuild))))
|
||||
(straight-use-package (intern package))))
|
||||
(progn
|
||||
(doom--compile-site-packages)
|
||||
(doom-packages--compile-site-files)
|
||||
(when NATIVECOMP
|
||||
(doom--wait-for-native-compile-jobs)
|
||||
(doom--write-missing-eln-errors))
|
||||
(doom-packages--wait-for-native-compile-jobs)
|
||||
(doom-packages--write-missing-eln-errors))
|
||||
;; HACK Every time you save a file in a package that straight tracks,
|
||||
;; it is recorded in ~/.emacs.d/.local/straight/modified/.
|
||||
;; Typically, straight will clean these up after rebuilding, but
|
||||
|
|
@ -367,16 +369,16 @@ declaration) or dependency thereof that hasn't already been."
|
|||
;; sync' or similar is run, so we clean it up ourselves:
|
||||
(delete-directory (straight--modified-dir) 'recursive)
|
||||
(print! (success "\033[KRebuilt %d package(s)") (length built)))
|
||||
(print! (info "No packages need rebuilding"))
|
||||
(print! (item "No packages need rebuilding"))
|
||||
nil))))
|
||||
|
||||
|
||||
|
||||
(defun doom-cli-packages-update ()
|
||||
(defun doom-packages-update ()
|
||||
"Updates packages."
|
||||
(doom-initialize-packages)
|
||||
(doom--barf-if-incomplete-packages)
|
||||
(doom--cli-recipes-update)
|
||||
(doom-packages--barf-if-incomplete)
|
||||
(doom-packages--cli-recipes-update)
|
||||
(let* ((repo-dir (straight--repos-dir))
|
||||
(pinned (doom-package-pinned-list))
|
||||
(recipes (doom-package-recipe-list))
|
||||
|
|
@ -387,7 +389,7 @@ declaration) or dependency thereof that hasn't already been."
|
|||
(i 0)
|
||||
errors)
|
||||
(print! (start "Updating packages (this may take a while)..."))
|
||||
(doom--with-package-recipes recipes (recipe package type local-repo)
|
||||
(doom-packages--with-recipes recipes (recipe package type local-repo)
|
||||
(cl-incf i)
|
||||
(print-group!
|
||||
(unless (straight--repository-is-available-p recipe)
|
||||
|
|
@ -414,30 +416,37 @@ declaration) or dependency thereof that hasn't already been."
|
|||
(or (cond
|
||||
((not (stringp target-ref))
|
||||
(print! (start "\033[K(%d/%d) Fetching %s...%s") i total package esc)
|
||||
(doom--straight-with (straight-vc-fetch-from-remote recipe)
|
||||
(doom-packages--straight-with (straight-vc-fetch-from-remote recipe)
|
||||
(when .it
|
||||
(straight-merge-package package)
|
||||
;; (condition-case e
|
||||
;; (straight-merge-package package)
|
||||
;; (wrong-type-argument
|
||||
;; (if (not (equal (cdr e) '(arrayp nil)))
|
||||
;; (signal (car e) (cdr e))
|
||||
;; (delete-directory (straight--build-dir local-repo) t)
|
||||
;; (straight-use-package (intern package)))))
|
||||
(setq target-ref (straight-vc-get-commit type local-repo))
|
||||
(setq output (doom--commit-log-between ref target-ref)
|
||||
(setq output (doom-packages--commit-log-between ref target-ref)
|
||||
commits (length (split-string output "\n" t)))
|
||||
(or (not (doom--same-commit-p target-ref ref))
|
||||
(or (not (doom-packages--same-commit-p target-ref ref))
|
||||
(cl-return)))))
|
||||
|
||||
((doom--same-commit-p target-ref ref)
|
||||
(print! (info "\033[K(%d/%d) %s is up-to-date...%s") i total package esc)
|
||||
((doom-packages--same-commit-p target-ref ref)
|
||||
(print! (item "\033[K(%d/%d) %s is up-to-date...%s") i total package esc)
|
||||
(cl-return))
|
||||
|
||||
((if (straight-vc-commit-present-p recipe target-ref)
|
||||
(print! (start "\033[K(%d/%d) Checking out %s (%s)...%s")
|
||||
i total package (doom--abbrev-commit target-ref) esc)
|
||||
i total package (doom-packages--abbrev-commit target-ref) esc)
|
||||
(print! (start "\033[K(%d/%d) Fetching %s...%s") i total package esc)
|
||||
(and (straight-vc-fetch-from-remote recipe)
|
||||
(straight-vc-commit-present-p recipe target-ref)))
|
||||
(straight-vc-check-out-commit recipe target-ref)
|
||||
(or (not (eq type 'git))
|
||||
(setq output (doom--commit-log-between ref target-ref)
|
||||
(setq output (doom-packages--commit-log-between ref target-ref)
|
||||
commits (length (split-string output "\n" t))))
|
||||
(doom--same-commit-p target-ref (straight-vc-get-commit type local-repo)))
|
||||
(doom-packages--same-commit-p target-ref (straight-vc-get-commit type local-repo)))
|
||||
|
||||
((print! (start "\033[K(%d/%d) Re-cloning %s...") i total local-repo esc)
|
||||
(let ((repo (straight--repos-dir local-repo))
|
||||
|
|
@ -447,20 +456,20 @@ declaration) or dependency thereof that hasn't already been."
|
|||
(straight-use-package (intern package) nil 'no-build))
|
||||
(prog1 (file-directory-p repo)
|
||||
(or (not (eq type 'git))
|
||||
(setq output (doom--commit-log-between ref target-ref)
|
||||
(setq output (doom-packages--commit-log-between ref target-ref)
|
||||
commits (length (split-string output "\n" t))))))))
|
||||
(progn
|
||||
(print! (warn "\033[K(%d/%d) Failed to fetch %s")
|
||||
i total local-repo)
|
||||
(unless (string-empty-p output)
|
||||
(print-group! (print! (info "%s" output))))
|
||||
(print-group! (print! (item "%s" output))))
|
||||
(cl-return)))
|
||||
(puthash local-repo t repos-to-rebuild)
|
||||
(puthash package t packages-to-rebuild)
|
||||
(print! (success "\033[K(%d/%d) %s: %s -> %s%s")
|
||||
i total local-repo
|
||||
(doom--abbrev-commit ref)
|
||||
(doom--abbrev-commit target-ref)
|
||||
(doom-packages--abbrev-commit ref)
|
||||
(doom-packages--abbrev-commit target-ref)
|
||||
(if (and (integerp commits) (> commits 0))
|
||||
(format " [%d commit(s)]" commits)
|
||||
""))
|
||||
|
|
@ -471,7 +480,7 @@ declaration) or dependency thereof that hasn't already been."
|
|||
(concat (string-join (cl-subseq (butlast lines 1) 0 20) "\n")
|
||||
"\n[...]")
|
||||
output)))
|
||||
(print-group! (print! "%s" (indent 2 output)))))
|
||||
(print-group! (print! "%s" (indent output 2)))))
|
||||
(user-error
|
||||
(signal 'user-error (error-message-string e)))
|
||||
(error
|
||||
|
|
@ -486,12 +495,12 @@ declaration) or dependency thereof that hasn't already been."
|
|||
(hash-table-keys packages-to-rebuild)))
|
||||
(print! (success "Updated %d package(s)")
|
||||
(hash-table-count packages-to-rebuild))
|
||||
(doom-cli-packages-build)
|
||||
(doom-packages-build)
|
||||
t))))
|
||||
|
||||
|
||||
;;; PURGE (for the emperor)
|
||||
(defun doom--cli-packages-purge-build (build)
|
||||
(defun doom-packages--purge-build (build)
|
||||
(let ((build-dir (straight--build-dir build)))
|
||||
(delete-directory build-dir 'recursive)
|
||||
(if (file-directory-p build-dir)
|
||||
|
|
@ -499,16 +508,16 @@ declaration) or dependency thereof that hasn't already been."
|
|||
(print! (success "Purged build/%s" build))
|
||||
t)))
|
||||
|
||||
(defun doom--cli-packages-purge-builds (builds)
|
||||
(defun doom-packages--purge-builds (builds)
|
||||
(if (not builds)
|
||||
(prog1 0
|
||||
(print! (info "No builds to purge")))
|
||||
(print! (item "No builds to purge")))
|
||||
(print! (start "Purging straight builds..." (length builds)))
|
||||
(print-group!
|
||||
(length
|
||||
(delq nil (mapcar #'doom--cli-packages-purge-build builds))))))
|
||||
(delq nil (mapcar #'doom-packages--purge-build builds))))))
|
||||
|
||||
(cl-defun doom--cli-packages-regraft-repo (repo)
|
||||
(cl-defun doom-packages--regraft-repo (repo)
|
||||
(unless repo
|
||||
(error "No repo specified for regrafting"))
|
||||
(let ((default-directory (straight--repos-dir repo)))
|
||||
|
|
@ -522,7 +531,7 @@ declaration) or dependency thereof that hasn't already been."
|
|||
(doom-call-process "git" "reset" "--hard")
|
||||
(doom-call-process "git" "clean" "-ffd")
|
||||
(if (not (zerop (car (doom-call-process "git" "replace" "--graft" "HEAD"))))
|
||||
(print! (info "\033[Krepos/%s is already compact\033[1A" repo))
|
||||
(print! (item "\033[Krepos/%s is already compact\033[1A" repo))
|
||||
(doom-call-process "git" "reflog" "expire" "--expire=all" "--all")
|
||||
(doom-call-process "git" "gc" "--prune=now")
|
||||
(let ((after-size (doom-directory-size default-directory)))
|
||||
|
|
@ -532,21 +541,21 @@ declaration) or dependency thereof that hasn't already been."
|
|||
repo before-size after-size)))))
|
||||
t))
|
||||
|
||||
(defun doom--cli-packages-regraft-repos (repos)
|
||||
(defun doom-packages--regraft-repos (repos)
|
||||
(if (not repos)
|
||||
(prog1 0
|
||||
(print! (info "No repos to regraft")))
|
||||
(print! (item "No repos to regraft")))
|
||||
(print! (start "Regrafting %d repos..." (length repos)))
|
||||
(let ((before-size (doom-directory-size (straight--repos-dir))))
|
||||
(print-group!
|
||||
(prog1 (delq nil (mapcar #'doom--cli-packages-regraft-repo repos))
|
||||
(prog1 (delq nil (mapcar #'doom-packages--regraft-repo repos))
|
||||
(princ "\033[K")
|
||||
(let ((after-size (doom-directory-size (straight--repos-dir))))
|
||||
(print! (success "Finished regrafting. Size before: %0.1fKB and after: %0.1fKB (%0.1fKB)")
|
||||
before-size after-size
|
||||
(- after-size before-size))))))))
|
||||
|
||||
(defun doom--cli-packages-purge-repo (repo)
|
||||
(defun doom-packages--purge-repo (repo)
|
||||
(let ((repo-dir (straight--repos-dir repo)))
|
||||
(when (file-directory-p repo-dir)
|
||||
(delete-directory repo-dir 'recursive)
|
||||
|
|
@ -556,21 +565,21 @@ declaration) or dependency thereof that hasn't already been."
|
|||
(print! (success "Purged repos/%s" repo))
|
||||
t))))
|
||||
|
||||
(defun doom--cli-packages-purge-repos (repos)
|
||||
(defun doom-packages--purge-repos (repos)
|
||||
(if (not repos)
|
||||
(prog1 0
|
||||
(print! (info "No repos to purge")))
|
||||
(print! (item "No repos to purge")))
|
||||
(print! (start "Purging straight repositories..."))
|
||||
(print-group!
|
||||
(length
|
||||
(delq nil (mapcar #'doom--cli-packages-purge-repo repos))))))
|
||||
(delq nil (mapcar #'doom-packages--purge-repo repos))))))
|
||||
|
||||
(defun doom--cli-packages-purge-elpa ()
|
||||
(defun doom-packages--purge-elpa ()
|
||||
(require 'core-packages)
|
||||
(let ((dirs (doom-files-in package-user-dir :type t :depth 0)))
|
||||
(if (not dirs)
|
||||
(prog1 0
|
||||
(print! (info "No ELPA packages to purge")))
|
||||
(print! (item "No ELPA packages to purge")))
|
||||
(print! (start "Purging ELPA packages..."))
|
||||
(dolist (path dirs (length dirs))
|
||||
(condition-case e
|
||||
|
|
@ -584,23 +593,23 @@ declaration) or dependency thereof that hasn't already been."
|
|||
(filename path)
|
||||
e)))))))
|
||||
|
||||
(defun doom--cli-packages-purge-eln ()
|
||||
(defun doom-packages--purge-eln ()
|
||||
(if-let (dirs
|
||||
(cl-delete (expand-file-name comp-native-version-dir doom--eln-output-path)
|
||||
(directory-files doom--eln-output-path t "^[^.]" t)
|
||||
(cl-delete (expand-file-name comp-native-version-dir doom-packages--eln-output-path)
|
||||
(directory-files doom-packages--eln-output-path t "^[^.]" t)
|
||||
:test #'file-equal-p))
|
||||
(progn
|
||||
(print! (start "Purging old native bytecode..."))
|
||||
(print-group!
|
||||
(dolist (dir dirs)
|
||||
(print! (info "Deleting %S") (relpath dir doom--eln-output-path))
|
||||
(print! (item "Deleting %S") (relpath dir doom-packages--eln-output-path))
|
||||
(delete-directory dir 'recursive))
|
||||
(print! (success "Purged %d directory(ies)" (length dirs))))
|
||||
(length dirs))
|
||||
(print! (info "No ELN directories to purge"))
|
||||
(print! (item "No ELN directories to purge"))
|
||||
0))
|
||||
|
||||
(defun doom-cli-packages-purge (&optional elpa-p builds-p repos-p regraft-repos-p eln-p)
|
||||
(defun doom-packages-purge (&optional elpa-p builds-p repos-p regraft-repos-p eln-p)
|
||||
"Auto-removes orphaned packages and repos.
|
||||
|
||||
An orphaned package is a package that isn't a primary package (i.e. doesn't have
|
||||
|
|
@ -610,7 +619,7 @@ If BUILDS-P, include straight package builds.
|
|||
If REPOS-P, include straight repos.
|
||||
If ELPA-P, include packages installed with package.el (M-x package-install)."
|
||||
(doom-initialize-packages)
|
||||
(doom--barf-if-incomplete-packages)
|
||||
(doom-packages--barf-if-incomplete)
|
||||
(print! (start "Purging orphaned packages (for the emperor)..."))
|
||||
(cl-destructuring-bind (&optional builds-to-purge repos-to-purge repos-to-regraft)
|
||||
(let ((rdirs
|
||||
|
|
@ -631,19 +640,158 @@ If ELPA-P, include packages installed with package.el (M-x package-install)."
|
|||
(delq
|
||||
nil (list
|
||||
(if (not builds-p)
|
||||
(ignore (print! (info "Skipping builds")))
|
||||
(and (/= 0 (doom--cli-packages-purge-builds builds-to-purge))
|
||||
(ignore (print! (item "Skipping builds")))
|
||||
(and (/= 0 (doom-packages--purge-builds builds-to-purge))
|
||||
(straight-prune-build-cache)))
|
||||
(if (not elpa-p)
|
||||
(ignore (print! (info "Skipping elpa packages")))
|
||||
(/= 0 (doom--cli-packages-purge-elpa)))
|
||||
(ignore (print! (item "Skipping elpa packages")))
|
||||
(/= 0 (doom-packages--purge-elpa)))
|
||||
(if (not repos-p)
|
||||
(ignore (print! (info "Skipping repos")))
|
||||
(/= 0 (doom--cli-packages-purge-repos repos-to-purge)))
|
||||
(ignore (print! (item "Skipping repos")))
|
||||
(/= 0 (doom-packages--purge-repos repos-to-purge)))
|
||||
(if (not regraft-repos-p)
|
||||
(ignore (print! (info "Skipping regrafting")))
|
||||
(doom--cli-packages-regraft-repos repos-to-regraft))
|
||||
(ignore (print! (item "Skipping regrafting")))
|
||||
(doom-packages--regraft-repos repos-to-regraft))
|
||||
(when NATIVECOMP
|
||||
(if (not eln-p)
|
||||
(ignore (print! (info "Skipping native bytecode")))
|
||||
(doom--cli-packages-purge-eln))))))))
|
||||
(ignore (print! (item "Skipping native bytecode")))
|
||||
(doom-packages--purge-eln))))))))
|
||||
|
||||
|
||||
;;
|
||||
;;; 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-cli--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.")
|
||||
|
||||
;; FIXME Replace with a -j/--jobs option in 'doom sync' et co
|
||||
(defadvice! doom-cli--comp-use-all-cores-a (&rest _)
|
||||
"Default to using all cores, rather than half.
|
||||
Doom compiles packages ahead-of-time, in a dedicated noninteractive session, so
|
||||
it doesn't make sense to slack."
|
||||
:before #'comp-effective-async-max-jobs
|
||||
(setq comp-num-cpus (doom-system-cpus)))
|
||||
|
||||
;; 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-cli--straight-fallback-to-y-or-n-prompt-a (fn &optional prompt noprompt?)
|
||||
:around #'straight-are-you-sure
|
||||
(or noprompt?
|
||||
(if doom-interactive-p
|
||||
(funcall fn prompt)
|
||||
(y-or-n-p (format! "%s" (or prompt ""))))))
|
||||
|
||||
(defun doom-cli--straight-recommended-option-p (prompt option)
|
||||
(cl-loop for (prompt-re . opt-re) in doom-cli--straight-auto-options
|
||||
if (string-match-p prompt-re prompt)
|
||||
return (string-match-p opt-re option)))
|
||||
|
||||
(defadvice! doom-cli--straight-fallback-to-tty-prompt-a (fn prompt actions)
|
||||
"Modifies straight to prompt on the terminal when in noninteractive sessions."
|
||||
:around #'straight--popup-raw
|
||||
(if (bound-and-true-p async-in-child-emacs)
|
||||
(error "Straight prompt: %s" prompt)
|
||||
(let ((doom-cli--straight-auto-options doom-cli--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-cli-context-suppress-prompts-p doom-cli--context)
|
||||
(cl-loop for (_key desc func) in actions
|
||||
when desc
|
||||
when (doom-cli--straight-recommended-option-p prompt desc t)
|
||||
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-cli--straight-recommended-option-p prompt desc)
|
||||
(progn
|
||||
(setq doom-cli--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")))
|
||||
(doom-cli--exit 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)))))))))
|
||||
|
||||
(setq straight-arrow " > ")
|
||||
(defadvice! doom-cli--straight-respect-print-indent-a (string &rest objects)
|
||||
"Same as `message' (which see for STRING and OBJECTS) normally.
|
||||
However, in batch mode, print to stdout instead of stderr."
|
||||
:override #'straight--output
|
||||
(let ((msg (apply #'format string objects)))
|
||||
(save-match-data
|
||||
(when (string-match (format "^%s\\(.+\\)$" (regexp-quote straight-arrow)) msg)
|
||||
(setq msg (match-string 1 msg))))
|
||||
(and (string-match-p "^\\(Cloning\\|\\(Reb\\|B\\)uilding\\) " msg)
|
||||
(not (string-suffix-p "...done" msg))
|
||||
(doom-print (concat "> " msg)))))
|
||||
|
||||
(defadvice! doom-cli--straight-ignore-gitconfig-a (fn &rest args)
|
||||
"Prevent user and system git configuration from interfering with git calls."
|
||||
:around #'straight--process-call
|
||||
(letenv! (("GIT_CONFIG" nil)
|
||||
("GIT_CONFIG_NOSYSTEM" "1")
|
||||
("GIT_CONFIG_GLOBAL" (or (getenv "DOOMGITCONFIG")
|
||||
"/dev/null")))
|
||||
(apply fn args)))
|
||||
|
||||
(provide 'core-cli-packages)
|
||||
;;; packages.el ends here
|
||||
|
|
|
|||
103
core/cli/run.el
Normal file
103
core/cli/run.el
Normal file
|
|
@ -0,0 +1,103 @@
|
|||
;;; core/cli/run.el --- launching Emacs in a sandbox -*- lexical-binding: t; -*-
|
||||
;;; Commentary:
|
||||
;;; Code:
|
||||
|
||||
;;
|
||||
;;; Variables
|
||||
|
||||
;; None yet!
|
||||
|
||||
|
||||
;;
|
||||
;;; Commands
|
||||
|
||||
(defcli! run
|
||||
(;; TODO Implement sandbox functionality post-3.0
|
||||
;; (daemon? ("--daemon"))
|
||||
;; (window-type ("--gui" "--tty"))
|
||||
;; (version ("--with-emacs" version))
|
||||
;; (doomversion ("--with-doom" version))
|
||||
;; (profile ("--profile" name))
|
||||
(repl? ("--repl") "Launch an elisp REPL")
|
||||
;; &multiple
|
||||
;; (calls ("-f" "--funcall" fn))
|
||||
;; (loads ("-l" "--load" file))
|
||||
;; (evals ( "--eval" form))
|
||||
&context context
|
||||
&input input
|
||||
&rest args)
|
||||
"Launch Doom Emacs or an Emacs sandbox
|
||||
|
||||
Opens from bin/doom's parent directory.
|
||||
|
||||
Keep in mind there is some overhead opening Doom this way. For the best
|
||||
performance, it is best to run Doom out of ~/.config/emacs or ~/.emacs.d."
|
||||
:benchmark nil
|
||||
;; TODO Implement sandbox functionality post-3.0
|
||||
;; (when version
|
||||
;; (unless (executable-find "nix-shell")
|
||||
;; (user-error "--emacs option is not supported without nix"))
|
||||
;; ...)
|
||||
(if repl?
|
||||
(if input
|
||||
;; Evaluate piped-in text directly, if given.
|
||||
(eval (read input) t)
|
||||
(doom-run-repl context))
|
||||
;; TODO Does this work on Windows?
|
||||
(let* ((tempdir (doom-path (temporary-file-directory) "doom.run"))
|
||||
(tempemacsdir (doom-path tempdir ".emacs.d")))
|
||||
(delete-directory tempdir t)
|
||||
(make-directory tempemacsdir t)
|
||||
(with-temp-file (doom-path tempemacsdir "early-init.el")
|
||||
(prin1 `(progn
|
||||
(setenv "HOME" ,(getenv "HOME"))
|
||||
(setq user-emacs-directory ,doom-emacs-dir)
|
||||
(load-file ,(doom-path doom-emacs-dir "early-init.el")))
|
||||
(current-buffer)))
|
||||
(exit! (format "HOME=%S %s %s"
|
||||
tempdir
|
||||
invocation-name
|
||||
(combine-and-quote-strings args))))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Helpers
|
||||
|
||||
(defun doom-run-repl (context)
|
||||
"Launch a rudimentary Elisp REPL."
|
||||
;; I wrote this for fun; not with any serious intention of adding a
|
||||
;; fully-fledged REPL to the Doom CLI. Still, I occasionally need to check
|
||||
;; something, and once this has nix integration and can sandbox Emacs versions
|
||||
;; separately, it may be useful for quick tests and demos.
|
||||
(let (form)
|
||||
(while (setq form (read-from-minibuffer "(elisp) $ "))
|
||||
(when (member form '(":quit" ":q"))
|
||||
(print! "\nGoodbye!")
|
||||
(exit! 0))
|
||||
(let (debug-on-error)
|
||||
(condition-case e
|
||||
(print! "%S" (eval (read form) t))
|
||||
(error
|
||||
(let* ((n 0)
|
||||
(frame (backtrace-frame n))
|
||||
(frame-list nil)
|
||||
(in-program-stack t))
|
||||
(while frame
|
||||
(when in-program-stack
|
||||
(push (cdr frame) frame-list))
|
||||
;; (when (eq (elt frame 1) 'doom-run-repl)
|
||||
;; (setq in-program-stack t))
|
||||
(when (eq (elt frame 1) 'doom-run-repl)
|
||||
(setq in-program-stack nil))
|
||||
(setq n (1+ n)
|
||||
frame (backtrace-frame n)))
|
||||
(let* ((depth doom-cli-backtrace-depth)
|
||||
(print-escape-newlines t))
|
||||
(print! (error "There was an unexpected error"))
|
||||
(print-group!
|
||||
(print! "%s %s" (bold "Message:") (error-message-string e))
|
||||
(print! "%s %S" (bold "Details:") (cdr e))))))))
|
||||
(terpri))))
|
||||
|
||||
(provide 'core-cli-run)
|
||||
;;; run.el ends here
|
||||
|
|
@ -1,10 +1,30 @@
|
|||
;;; core/cli/sync.el -*- lexical-binding: t; -*-
|
||||
;;; core/cli/sync.el --- synchronize config command -*- lexical-binding: t; -*-
|
||||
;;; Commentary:
|
||||
;;; Code:
|
||||
|
||||
(defcli! (sync s)
|
||||
((no-envvar-p ["-e"] "Don't regenerate the envvar file")
|
||||
(no-elc-p ["-c"] "Don't recompile config")
|
||||
(update-p ["-u"] "Update installed packages after syncing")
|
||||
(purge-p ["-p" "--prune"] "Purge orphaned package repos & regraft them"))
|
||||
(load! "packages")
|
||||
|
||||
|
||||
;;
|
||||
;;; Variables
|
||||
|
||||
(defvar doom-after-sync-hook ()
|
||||
"Hooks run after 'doom sync' synchronizes the user's config with Doom.")
|
||||
|
||||
(defvar doom-before-sync-hook ()
|
||||
"Hooks run before 'doom sync' synchronizes the user's config with Doom.")
|
||||
|
||||
|
||||
;;
|
||||
;;; Commands
|
||||
|
||||
(defalias! (:before (sync s)) (:before build))
|
||||
|
||||
(defcli! ((sync s))
|
||||
((noenvvar? ("-e") "Don't regenerate the envvar file")
|
||||
(noelc? ("-c") "Don't recompile config")
|
||||
(update? ("-u") "Update installed packages after syncing")
|
||||
(purge? ("-p") "Purge orphaned package repos & regraft them"))
|
||||
"Synchronize your config with Doom Emacs.
|
||||
|
||||
This is the equivalent of running autoremove, install, autoloads, then
|
||||
|
|
@ -18,39 +38,36 @@ recompile. Run this whenever you:
|
|||
It will ensure that unneeded packages are removed, all needed packages are
|
||||
installed, autoloads files are up-to-date and no byte-compiled files have gone
|
||||
stale."
|
||||
(run-hooks 'doom-sync-pre-hook)
|
||||
(add-hook 'kill-emacs-hook #'doom--cli-abort-warning-h)
|
||||
:benchmark t
|
||||
(run-hooks 'doom-before-sync-hook)
|
||||
(add-hook 'kill-emacs-hook #'doom-sync--abort-warning-h)
|
||||
(print! (start "Synchronizing your config with Doom Emacs..."))
|
||||
(unwind-protect
|
||||
(print-group!
|
||||
(delete-file doom-autoloads-file)
|
||||
(when (and (not no-envvar-p)
|
||||
(when (and (not noenvvar?)
|
||||
(file-exists-p doom-env-file))
|
||||
(doom-cli-reload-env-file 'force))
|
||||
(doom-cli-packages-install)
|
||||
(doom-cli-packages-build)
|
||||
(when update-p
|
||||
(doom-cli-packages-update))
|
||||
(doom-cli-packages-purge purge-p 'builds-p purge-p purge-p purge-p)
|
||||
(run-hooks 'doom-sync-post-hook)
|
||||
(doom-cli-call '("doom" "env")))
|
||||
(doom-packages-install)
|
||||
(doom-packages-build)
|
||||
(when update?
|
||||
(doom-packages-update))
|
||||
(doom-packages-purge purge? 'builds-p purge? purge? purge?)
|
||||
(run-hooks 'doom-after-sync-hook)
|
||||
(when (doom-autoloads-reload)
|
||||
(print! (info "Restart Emacs or use 'M-x doom/reload' for changes to take effect")))
|
||||
(print! (item "Restart Emacs or use 'M-x doom/reload' for changes to take effect")))
|
||||
t)
|
||||
(remove-hook 'kill-emacs-hook #'doom--cli-abort-warning-h)))
|
||||
(remove-hook 'kill-emacs-hook #'doom-sync--abort-warning-h)))
|
||||
|
||||
|
||||
;;
|
||||
;;; DEPRECATED Commands
|
||||
|
||||
(defcli! (refresh re) ()
|
||||
"Deprecated for 'doom sync'"
|
||||
:hidden t
|
||||
(user-error "'doom refresh' has been replaced with 'doom sync'. Use that instead"))
|
||||
;; DEPRECATED Remove when v3.0 is released
|
||||
(defobsolete! ((refresh re)) "doom sync" "v3.0.0")
|
||||
|
||||
|
||||
;;
|
||||
;;; Helpers
|
||||
|
||||
(defun doom--cli-abort-warning-h ()
|
||||
(terpri)
|
||||
(print! (warn "Script was abruptly aborted! Run 'doom sync' to repair inconsistencies")))
|
||||
(defun doom-sync--abort-warning-h ()
|
||||
(print! (warn "Script was abruptly aborted, leaving Doom in an incomplete state!"))
|
||||
(print! (item "Run 'doom sync' to repair it.")))
|
||||
|
||||
(provide 'core-cli-sync)
|
||||
;;; sync.el ends here
|
||||
|
|
|
|||
|
|
@ -1,16 +1,20 @@
|
|||
;;; core/cli/test.el -*- lexical-binding: t; -*-
|
||||
;;; Commentary:
|
||||
;;; Code:
|
||||
|
||||
(defun doom--emacs-binary ()
|
||||
(let ((emacs-binary-path (doom-path invocation-directory invocation-name))
|
||||
(runemacs-binary-path (if IS-WINDOWS (doom-path invocation-directory "runemacs.exe"))))
|
||||
(if (and runemacs-binary-path (file-exists-p runemacs-binary-path))
|
||||
runemacs-binary-path
|
||||
emacs-binary-path)))
|
||||
;;
|
||||
;;; Variables
|
||||
|
||||
;; None yet!
|
||||
|
||||
|
||||
;;
|
||||
;;; Commands
|
||||
|
||||
(defcli! test (&rest targets)
|
||||
"Run Doom unit tests."
|
||||
:bare t
|
||||
:disable t
|
||||
;; FIXME Tests don't work; will be fixed in v3.1
|
||||
(doom-initialize 'force 'noerror)
|
||||
(require 'ansi-color)
|
||||
(let (files read-files)
|
||||
|
|
@ -39,13 +43,12 @@
|
|||
(print! (start "Bootstrapping test environment, if necessary..."))
|
||||
(cl-destructuring-bind (status . output)
|
||||
(doom-exec-process
|
||||
(doom--emacs-binary)
|
||||
(doom-test--emacs-binary)
|
||||
"--batch"
|
||||
"--eval"
|
||||
(prin1-to-string
|
||||
`(progn
|
||||
(setq user-emacs-directory ,doom-emacs-dir
|
||||
doom-auto-accept t)
|
||||
(setq user-emacs-directory ,doom-emacs-dir)
|
||||
(require 'core ,(locate-library "core"))
|
||||
(require 'core-cli)
|
||||
(doom-initialize 'force 'noerror)
|
||||
|
|
@ -60,7 +63,7 @@
|
|||
(if (doom-file-cookie-p file "if" t)
|
||||
(cl-destructuring-bind (_status . output)
|
||||
(apply #'doom-exec-process
|
||||
(doom--emacs-binary)
|
||||
(doom-test--emacs-binary)
|
||||
"--batch"
|
||||
"-l" (concat doom-core-dir "core.el")
|
||||
"-l" (concat doom-core-dir "test/helpers.el")
|
||||
|
|
@ -70,7 +73,7 @@
|
|||
"-f" "buttercup-run")))
|
||||
(insert (replace-regexp-in-string ansi-color-control-seq-regexp "" output))
|
||||
(push file read-files))
|
||||
(print! (info "Ignoring %s" (relpath file)))))
|
||||
(print! (item "Ignoring %s" (relpath file)))))
|
||||
(let ((total 0)
|
||||
(total-failed 0)
|
||||
(i 0))
|
||||
|
|
@ -102,3 +105,16 @@
|
|||
(print! (error "Ran %d tests, %d failed") total total-failed)
|
||||
(kill-emacs 1)))
|
||||
t)))
|
||||
|
||||
|
||||
;;
|
||||
;;; Helpers
|
||||
|
||||
(defun doom-test--emacs-binary ()
|
||||
(let ((emacs-binary-path (doom-path invocation-directory invocation-name))
|
||||
(runemacs-binary-path (if IS-WINDOWS (doom-path invocation-directory "runemacs.exe"))))
|
||||
(if (and runemacs-binary-path (file-exists-p runemacs-binary-path))
|
||||
runemacs-binary-path
|
||||
emacs-binary-path)))
|
||||
|
||||
;;; test.el ends here
|
||||
|
|
|
|||
|
|
@ -1,8 +1,26 @@
|
|||
;;; core/cli/upgrade.el -*- lexical-binding: t; -*-
|
||||
;;; Commentary:
|
||||
;;; Code:
|
||||
|
||||
(defcli! (upgrade up)
|
||||
((force-p ["-f" "--force"] "Discard local changes to Doom and packages, and upgrade anyway")
|
||||
(packages-only-p ["-p" "--packages"] "Only upgrade packages, not Doom"))
|
||||
(load! "packages")
|
||||
|
||||
|
||||
;;
|
||||
;;; Variables
|
||||
|
||||
(defvar doom-upgrade-url "https://github.com/doomemacs/doomemacs"
|
||||
"The git repo url for Doom Emacs.")
|
||||
|
||||
(defvar doom-upgrade-remote "_upgrade"
|
||||
"The name to use as our staging remote.")
|
||||
|
||||
|
||||
;;
|
||||
;;; Commands
|
||||
|
||||
(defcli! ((upgrade up))
|
||||
((packages? ("-p" "--packages") "Only upgrade packages, not Doom")
|
||||
&context context)
|
||||
"Updates Doom and packages.
|
||||
|
||||
This requires that ~/.emacs.d is a git repo, and is the equivalent of the
|
||||
|
|
@ -10,50 +28,27 @@ following shell commands:
|
|||
|
||||
cd ~/.emacs.d
|
||||
git pull --rebase
|
||||
bin/doom clean
|
||||
bin/doom sync -u"
|
||||
:bare t
|
||||
(let ((doom-auto-discard force-p))
|
||||
doom clean
|
||||
doom sync -u"
|
||||
(let* ((force? (doom-cli-context-suppress-prompts-p context))
|
||||
(sync-cmd `("doom" "sync" "-u")))
|
||||
(cond
|
||||
(packages-only-p
|
||||
(doom-cli-execute "sync" "-u")
|
||||
(packages-only?
|
||||
(doom-cli-call sync-cmd)
|
||||
(print! (success "Finished upgrading Doom Emacs")))
|
||||
|
||||
((doom-cli-upgrade doom-auto-accept doom-auto-discard)
|
||||
((doom-cli-upgrade force? force?)
|
||||
;; Reload Doom's CLI & libraries, in case there were any upstream changes.
|
||||
;; Major changes will still break, however
|
||||
(print! (info "Reloading Doom Emacs"))
|
||||
(throw 'exit (list "doom" "upgrade" "-p" (if force-p "-f"))))
|
||||
(print! (item "Reloading Doom Emacs"))
|
||||
(exit! "doom" "upgrade" "-p" (if force? "--force")))
|
||||
|
||||
((print! "Doom is up-to-date!")
|
||||
(doom-cli-execute "sync" "-u")))))
|
||||
(doom-cli-call sync-cmd)))))
|
||||
|
||||
|
||||
;;
|
||||
;;; library
|
||||
|
||||
(defvar doom-repo-url "https://github.com/hlissner/doom-emacs"
|
||||
"The git repo url for Doom Emacs.")
|
||||
(defvar doom-repo-remote "_upgrade"
|
||||
"The name to use as our staging remote.")
|
||||
|
||||
(defun doom--working-tree-dirty-p (dir)
|
||||
(cl-destructuring-bind (success . stdout)
|
||||
(doom-call-process "git" "status" "--porcelain" "-uno")
|
||||
(if (= 0 success)
|
||||
(split-string stdout "\n" t)
|
||||
(error "Failed to check working tree in %s" dir))))
|
||||
|
||||
(defun doom--get-straight-recipe ()
|
||||
(with-temp-buffer
|
||||
(insert-file-contents (doom-path doom-core-dir "packages.el"))
|
||||
(when (re-search-forward "(package! straight" nil t)
|
||||
(goto-char (match-beginning 0))
|
||||
(let ((sexp (sexp-at-point)))
|
||||
(plist-put sexp :recipe
|
||||
(eval (plist-get sexp :recipe)
|
||||
t))))))
|
||||
|
||||
;;; Helpers
|
||||
|
||||
(defun doom-cli-upgrade (&optional auto-accept-p force-p)
|
||||
"Upgrade Doom to the latest version non-destructively."
|
||||
|
|
@ -70,18 +65,19 @@ following shell commands:
|
|||
(cdr (doom-call-process "git" "name-rev" "--name-only" "HEAD"))))
|
||||
(target-remote (format "%s_%s" doom-repo-remote branch)))
|
||||
(unless branch
|
||||
(error! (if (file-exists-p! ".git" doom-emacs-dir)
|
||||
"Couldn't find Doom's .git directory. Was Doom cloned properly?"
|
||||
"Couldn't detect what branch you're on. Is Doom detached?")))
|
||||
(error (if (file-exists-p! ".git" doom-emacs-dir)
|
||||
"Couldn't find Doom's .git directory. Was Doom cloned properly?"
|
||||
"Couldn't detect what branch you're on. Is Doom detached?")))
|
||||
|
||||
;; We assume that a dirty .emacs.d is intentional and abort
|
||||
(when-let (dirty (doom--working-tree-dirty-p default-directory))
|
||||
(when-let (dirty (doom-upgrade--working-tree-dirty-p default-directory))
|
||||
(if (not force-p)
|
||||
(user-error! "%s\n\n%s\n\n %s"
|
||||
(format "Refusing to upgrade because %S has been modified." (path doom-emacs-dir))
|
||||
"Either stash/undo your changes or run 'doom upgrade -f' to discard local changes."
|
||||
(string-join dirty "\n"))
|
||||
(print! (info "You have local modifications in Doom's source. Discarding them..."))
|
||||
(user-error "%s\n\n%s\n\n %s"
|
||||
(format "Refusing to upgrade because %S has been modified."
|
||||
(abbreviate-file-name doom-emacs-dir))
|
||||
"Either stash/undo your changes or run 'doom upgrade -f' to discard local changes."
|
||||
(string-join dirty "\n"))
|
||||
(print! (item "You have local modifications in Doom's source. Discarding them..."))
|
||||
(doom-call-process "git" "reset" "--hard" (format "origin/%s" branch))
|
||||
(doom-call-process "git" "clean" "-ffd")))
|
||||
|
||||
|
|
@ -104,7 +100,7 @@ following shell commands:
|
|||
(print! (success "Doom is already up-to-date!"))
|
||||
nil)
|
||||
|
||||
((print! (info "A new version of Doom Emacs is available!\n\n Old revision: %s (%s)\n New revision: %s (%s)\n"
|
||||
((print! (item "A new version of Doom Emacs is available!\n\n Old revision: %s (%s)\n New revision: %s (%s)\n"
|
||||
(substring this-rev 0 10)
|
||||
(cdr (doom-call-process "git" "log" "-1" "--format=%cr" "HEAD"))
|
||||
(substring new-rev 0 10)
|
||||
|
|
@ -117,7 +113,7 @@ following shell commands:
|
|||
(print! "Link to diff: %s" diff-url)
|
||||
(when (and (not auto-accept-p)
|
||||
(y-or-n-p "View the comparison diff in your browser?"))
|
||||
(print! (info "Opened github in your browser."))
|
||||
(print! (item "Opened github in your browser."))
|
||||
(browse-url diff-url)))
|
||||
|
||||
(if (not (or auto-accept-p
|
||||
|
|
@ -126,24 +122,43 @@ following shell commands:
|
|||
(print! (start "Upgrading Doom Emacs..."))
|
||||
(print-group!
|
||||
(doom-clean-byte-compiled-files)
|
||||
(let ((straight-recipe (doom--get-straight-recipe)))
|
||||
(let ((straight-recipe (doom-upgrade--get-straight-recipe)))
|
||||
(or (and (zerop (car (doom-call-process "git" "reset" "--hard" target-remote)))
|
||||
(equal (cdr (doom-call-process "git" "rev-parse" "HEAD")) new-rev))
|
||||
(error "Failed to check out %s" (substring new-rev 0 10)))
|
||||
;; HACK It's messy to use straight to upgrade straight, due
|
||||
;; to the potential for backwards incompatibility, so
|
||||
;; we staticly check if Doom's `package!' declaration
|
||||
;; for straight has changed. If it has, delete
|
||||
;; straight so 'doom upgrade's second stage will
|
||||
;; install the new version for us.
|
||||
;; to the potential for backwards incompatibility, so we
|
||||
;; staticly check if Doom's `package!' declaration for
|
||||
;; straight has changed. If it has, delete straight so
|
||||
;; 'doom upgrade's second stage will install the new
|
||||
;; version for us.
|
||||
;;
|
||||
;; Clumsy, but a better solution is in the works.
|
||||
(unless (equal straight-recipe (doom--get-straight-recipe))
|
||||
(print! (info "Preparing straight for an update"))
|
||||
;; Clumsy, but a better solution is in the works.
|
||||
(unless (equal straight-recipe (doom-upgrade--get-straight-recipe))
|
||||
(print! (item "Preparing straight for an update"))
|
||||
(delete-directory (doom-path straight-base-dir "straight/repos/straight.el")
|
||||
'recursive)))
|
||||
(print! (info "%s") (cdr result))
|
||||
(print! (item "%s") (cdr result))
|
||||
t))))))
|
||||
(ignore-errors
|
||||
(doom-call-process "git" "branch" "-D" target-remote)
|
||||
(doom-call-process "git" "remote" "remove" doom-repo-remote))))))
|
||||
|
||||
(defun doom-upgrade--working-tree-dirty-p (dir)
|
||||
(cl-destructuring-bind (success . stdout)
|
||||
(doom-call-process "git" "status" "--porcelain" "-uno")
|
||||
(if (= 0 success)
|
||||
(split-string stdout "\n" t)
|
||||
(error "Failed to check working tree in %s" dir))))
|
||||
|
||||
(defun doom-upgrade--get-straight-recipe ()
|
||||
(with-temp-buffer
|
||||
(insert-file-contents (doom-path doom-core-dir "packages.el"))
|
||||
(when (re-search-forward "(package! straight" nil t)
|
||||
(goto-char (match-beginning 0))
|
||||
(let ((sexp (sexp-at-point)))
|
||||
(plist-put sexp :recipe
|
||||
(eval (plist-get sexp :recipe)
|
||||
t))))))
|
||||
|
||||
;;; upgrade.el ends here
|
||||
|
|
|
|||
1724
core/core-cli-lib.el
Normal file
1724
core/core-cli-lib.el
Normal file
File diff suppressed because it is too large
Load diff
342
core/core-cli.el
342
core/core-cli.el
|
|
@ -1,58 +1,110 @@
|
|||
;;; core/core-cli.el --- -*- lexical-binding: t; no-byte-compile: t; -*-
|
||||
;;; core/core-cli.el --- The heart of Doom's CLI framework -*- lexical-binding: t; no-byte-compile: t; -*-
|
||||
;;; Commentary:
|
||||
;;
|
||||
;; The heart of Doom's CLI framework. This is safe to load in interactive
|
||||
;; sessions (for API access and syntax highlighting), but much of the API
|
||||
;; expects a noninteractive session, so take care when testing code!
|
||||
;;
|
||||
;;; Code:
|
||||
|
||||
(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
|
||||
`doom-packages-autoremove'.")
|
||||
(when (version< emacs-version "27.1")
|
||||
(message
|
||||
(concat
|
||||
"Error: detected Emacs " emacs-version ", but 27.1 or newer is required.\n\n"
|
||||
"The version of Emacs in use is located at:\n\n " (car command-line-args) "\n\n"
|
||||
"A guide for installing a newer version of Emacs can be found at:\n\n "
|
||||
(format "https://doomemacs.org/docs/getting_started.org#%s\n"
|
||||
(cond ((eq system-type 'darwin) "on-macos")
|
||||
((memq system-type '(cygwin windows-nt ms-dos)) "on-windows")
|
||||
("on-linux"))) "\n"
|
||||
"Alternatively, alter the EMACS environment variable to temporarily change what\n"
|
||||
"command this script uses to invoke Emacs. For example:\n\n"
|
||||
(let ((command (file-name-nondirectory (cadr (member "--load" command-line-args)))))
|
||||
(concat " $ EMACS=/path/to/valid/emacs " command " ...\n"
|
||||
" $ EMACS=\"/Applications/Emacs.app/Contents/MacOS/Emacs\" " command " ...\n"
|
||||
" $ EMACS=\"snap run emacs\" " command " ...\n"))
|
||||
"\nAborting..."))
|
||||
(kill-emacs 2))
|
||||
|
||||
(defvar doom-auto-discard (getenv "FORCE")
|
||||
"If non-nil, discard all local changes while updating.")
|
||||
|
||||
(defvar doom-cli-file "cli"
|
||||
"The basename of CLI config files for modules.
|
||||
;;
|
||||
;;; Variables
|
||||
|
||||
These are loaded when a Doom's CLI starts up. There users and modules can define
|
||||
additional CLI commands, or reconfigure existing ones to better suit their
|
||||
purpose.")
|
||||
(defvar doom-cli--dump (getenv "__DOOMDUMP")
|
||||
"If non-nil, dump target CLIs to stdout (or all of `doom-cli--table').
|
||||
|
||||
(defvar doom-cli-log-file (concat doom-local-dir "doom.log")
|
||||
"Where to write the extended output to.")
|
||||
This exists so external tools or Doom binscripts can inspect each other.")
|
||||
|
||||
(defvar doom-cli-log-error-file (concat doom-local-dir "doom.error.log")
|
||||
"Where to write the last backtrace to.")
|
||||
|
||||
(defvar doom--cli-log-buffer (generate-new-buffer " *doom log*"))
|
||||
(defvar doom--cli-commands (make-hash-table :test 'equal))
|
||||
(defvar doom--cli-groups (make-hash-table :test 'equal))
|
||||
(defvar doom--cli-group nil)
|
||||
;;
|
||||
;;; Setup CLI session
|
||||
|
||||
(define-error 'doom-cli-error "There was an unexpected error" 'doom-error)
|
||||
(define-error 'doom-cli-command-not-found-error "Could not find that command" 'doom-cli-error)
|
||||
(define-error 'doom-cli-wrong-number-of-arguments-error "Wrong number of CLI arguments" 'doom-cli-error)
|
||||
(define-error 'doom-cli-unrecognized-option-error "Not a recognized option" 'doom-cli-error)
|
||||
(define-error 'doom-cli-deprecated-error "Command is deprecated" 'doom-cli-error)
|
||||
;; The garbage collector isn't so important during CLI ops. A higher threshold
|
||||
;; makes it 15-30% faster, but set it too high and we risk runaway memory usage
|
||||
;; in longer sessions.
|
||||
(setq gc-cons-threshold 134217728) ; 128mb
|
||||
|
||||
;; Ensure errors are sufficiently detailed from this point on.
|
||||
(setq debug-on-error t)
|
||||
|
||||
;; HACK Load `cl' and site files manually to prevent polluting logs and stdout
|
||||
;; with deprecation and/or file load messages.
|
||||
(let ((inhibit-message t))
|
||||
(require 'cl)
|
||||
(unless site-run-file
|
||||
(let ((site-run-file "site-start")
|
||||
(verbose (or (getenv "DEBUG") init-file-debug))
|
||||
(tail load-path)
|
||||
(lispdir (expand-file-name "../lisp" data-directory))
|
||||
dir)
|
||||
(while tail
|
||||
(setq dir (car tail))
|
||||
(let ((default-directory dir))
|
||||
(load (expand-file-name "subdirs.el") t (not verbose) t))
|
||||
(or (string-prefix-p lispdir dir)
|
||||
(let ((default-directory dir))
|
||||
(load (expand-file-name "leim-list.el") t (not verbose) t)))
|
||||
(setq tail (cdr tail)))
|
||||
(load site-run-file t (not verbose)))))
|
||||
|
||||
;; Just the... bear necessities~
|
||||
(require 'core (expand-file-name "core" (file-name-directory load-file-name)))
|
||||
(require 'seq)
|
||||
(require 'map)
|
||||
|
||||
;; Load these eagerly, since autoloads haven't been generated/loaded yet
|
||||
(load! "autoload/process")
|
||||
(load! "autoload/system")
|
||||
(load! "autoload/plist")
|
||||
(load! "autoload/files")
|
||||
(load! "autoload/debug")
|
||||
(load! "autoload/print")
|
||||
;; (load! "autoload/autoloads")
|
||||
|
||||
;; Ensure straight and core packages are ready to go for CLI commands.
|
||||
(require 'core-modules)
|
||||
(require '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)
|
||||
;; Reduce ambiguity, embrace specificity, enjoy predictability.
|
||||
(setq-default case-fold-search nil)
|
||||
;; Don't clog the user's trash with anything we clean up during this session.
|
||||
(setq delete-by-moving-to-trash nil)
|
||||
|
||||
|
||||
;;
|
||||
;;; Bootstrap
|
||||
|
||||
(require 'seq)
|
||||
(load! "autoload/process")
|
||||
(load! "autoload/system")
|
||||
(load! "autoload/plist")
|
||||
(load! "autoload/files")
|
||||
(load! "autoload/output")
|
||||
;; Our DSL, API, and everything nice.
|
||||
(require 'core-cli-lib)
|
||||
|
||||
(load! "cli/lib/debugger")
|
||||
(load! "cli/lib/lib")
|
||||
(load! "cli/lib/straight-hacks")
|
||||
|
||||
;; 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))
|
||||
;; Use our own home-grown debugger so we can capture backtraces, make them more
|
||||
;; presentable, and write them to a file. Cleaner backtraces are better UX than
|
||||
;; the giant wall of text the default debugger throws up.
|
||||
(setq debugger #'doom-cli-debugger)
|
||||
|
||||
;; Create all our core directories to quell file errors.
|
||||
(mapc (doom-rpartial #'make-directory 'parents)
|
||||
|
|
@ -60,214 +112,8 @@ purpose.")
|
|||
doom-etc-dir
|
||||
doom-cache-dir))
|
||||
|
||||
;; Ensure straight and core packages are ready to go for CLI commands.
|
||||
(require 'core-modules)
|
||||
(require 'core-packages)
|
||||
(doom-initialize-core-packages)
|
||||
|
||||
;; Default to using all cores, rather than half of them, since we compile things
|
||||
;; ahead-of-time in a non-interactive session.
|
||||
(defadvice! doom--comp-use-all-cores-a (&rest _)
|
||||
:before #'comp-effective-async-max-jobs
|
||||
(setq comp-num-cpus (doom-system-cpus)))
|
||||
|
||||
|
||||
;;
|
||||
;;; Entry point
|
||||
|
||||
(defcli! :doom
|
||||
((help-p ["-h" "--help"] "Same as help command")
|
||||
(auto-accept-p ["-y" "--yes"] "Auto-accept all confirmation prompts")
|
||||
(debug-p ["-d" "--debug"] "Enables on verbose output")
|
||||
(loadfile ["-l" "--load" file] "Load an elisp FILE before executing any commands")
|
||||
(doomdir ["--doomdir" dir] "Use the private module at DIR (e.g. ~/.doom.d)")
|
||||
(localdir ["--localdir" dir] "Use DIR as your local storage directory")
|
||||
(nocolor ["-C" "--nocolor"] "Disable colored output")
|
||||
&optional command
|
||||
&rest args)
|
||||
"A command line interface for managing Doom Emacs.
|
||||
|
||||
Includes package management, diagnostics, unit tests, and byte-compilation.
|
||||
|
||||
This tool also makes it trivial to launch Emacs out of a different folder or
|
||||
with a different private module.
|
||||
|
||||
Environment variables:
|
||||
EMACSDIR Where to find the Doom Emacs repo (normally ~/.emacs.d)
|
||||
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-buffer
|
||||
(when nocolor
|
||||
(setq doom-output-backend nil))
|
||||
(catch 'exit
|
||||
(when (and (not (getenv "__DOOMRESTART"))
|
||||
(or doomdir
|
||||
localdir
|
||||
debug-p
|
||||
auto-accept-p))
|
||||
(when doomdir
|
||||
(setenv "DOOMDIR" (file-name-as-directory doomdir))
|
||||
(print! (info "DOOMDIR=%s") doomdir))
|
||||
(when localdir
|
||||
(setenv "DOOMLOCALDIR" (file-name-as-directory localdir))
|
||||
(print! (info "DOOMLOCALDIR=%s") localdir))
|
||||
(when debug-p
|
||||
(setenv "DEBUG" "1")
|
||||
(print! (info "DEBUG=1")))
|
||||
(when auto-accept-p
|
||||
(setenv "YES" auto-accept-p)
|
||||
(print! (info "Confirmations auto-accept enabled")))
|
||||
(throw 'exit "__DOOMRESTART=1 $@"))
|
||||
(when loadfile
|
||||
(load (doom-path loadfile) nil t t))
|
||||
(when help-p
|
||||
(when command
|
||||
(push command args))
|
||||
(setq command "help"))
|
||||
(cons
|
||||
t (if (null command)
|
||||
(doom-cli-execute "help")
|
||||
(let ((start-time (current-time)))
|
||||
(run-hooks 'doom-cli-pre-hook)
|
||||
(unless (getenv "__DOOMRESTART")
|
||||
(print! (start "Executing 'doom %s' with Emacs %s at %s")
|
||||
(string-join
|
||||
(cons (or (ignore-errors
|
||||
(doom-cli-name (doom-cli-get command)))
|
||||
command)
|
||||
args)
|
||||
" ")
|
||||
emacs-version
|
||||
(format-time-string "%Y-%m-%d %H:%M:%S")))
|
||||
(print-group!
|
||||
(when-let (result (apply #'doom-cli-execute command args))
|
||||
(run-hooks 'doom-cli-post-hook)
|
||||
(print! (success "Finished in %s")
|
||||
(let* ((duration (float-time (time-subtract (current-time) before-init-time)))
|
||||
(hours (/ (truncate duration) 60 60))
|
||||
(minutes (- (/ (truncate duration) 60) (* hours 60)))
|
||||
(seconds (- duration (* hours 60 60) (* minutes 60))))
|
||||
(string-join
|
||||
(delq
|
||||
nil (list (unless (zerop hours) (format "%dh" hours))
|
||||
(unless (zerop minutes) (format "%dm" minutes))
|
||||
(format (if (> duration 60) "%ds" "%.4fs")
|
||||
seconds))))))
|
||||
result)))))))
|
||||
;; TODO Not implemented yet
|
||||
(doom-cli-command-not-found-error
|
||||
(print! (error "Command 'doom %s' not recognized") (string-join (cdr e) " "))
|
||||
(print! "\nDid you mean one of these commands?")
|
||||
(apply #'doom-cli-execute "help" "--similar" (string-join (cdr e) " "))
|
||||
5)
|
||||
;; TODO Not implemented yet
|
||||
(doom-cli-wrong-number-of-arguments-error
|
||||
(cl-destructuring-bind (route opt arg n d) (cdr e)
|
||||
(print! (error "doom %s: %S requires %d arguments, but %d given\n")
|
||||
(mapconcat #'symbol-name route " ") arg n d)
|
||||
(print-group!
|
||||
(apply #'doom-cli-execute "help" (mapcar #'symbol-name route))))
|
||||
6)
|
||||
;; TODO Not implemented yet
|
||||
(doom-cli-unrecognized-option-error
|
||||
(let ((option (cadr e)))
|
||||
(print! (error "Unrecognized option: %S") option)
|
||||
(when (string-match "^--[^=]+=\\(.+\\)$" option)
|
||||
(print! "The %S syntax isn't supported. Use '%s %s' instead."
|
||||
option (car (split-string option "="))
|
||||
(match-string 1 option))))
|
||||
7)
|
||||
;; TODO Not implemented yet
|
||||
(doom-cli-deprecated-error
|
||||
(cl-destructuring-bind (route . commands) (cdr e)
|
||||
(print! (warn "The 'doom %s' command was removed and replaced with:\n")
|
||||
(mapconcat #'symbol-name route " "))
|
||||
(print-group!
|
||||
(dolist (command commands)
|
||||
(print! (info "%s") command))))
|
||||
8)
|
||||
(user-error
|
||||
(print! (warn "%s") (cadr e))
|
||||
9)))
|
||||
|
||||
|
||||
;;
|
||||
;;; CLI Commands
|
||||
|
||||
;; Load standard :help and :version handlers.
|
||||
(load! "cli/help")
|
||||
(load! "cli/install")
|
||||
(load! "cli/sync")
|
||||
(load! "cli/env")
|
||||
(load! "cli/upgrade")
|
||||
(load! "cli/packages")
|
||||
(load! "cli/autoloads")
|
||||
(load! "cli/ci")
|
||||
|
||||
(defcligroup! "Diagnostics"
|
||||
"For troubleshooting and diagnostics"
|
||||
(load! "cli/doctor")
|
||||
(load! "cli/debug")
|
||||
|
||||
;; Our tests are broken at the moment. Working on fixing them, but for now we
|
||||
;; disable them:
|
||||
;; (load! "cli/test")
|
||||
)
|
||||
|
||||
(defcligroup! "Compilation"
|
||||
"For compiling Doom and your config"
|
||||
(load! "cli/byte-compile"))
|
||||
|
||||
(defcligroup! "Utilities"
|
||||
"Conveniences for interacting with Doom externally"
|
||||
(defcli! run (&rest args)
|
||||
"Run Doom Emacs from bin/doom's parent directory.
|
||||
|
||||
All arguments are passed on to Emacs.
|
||||
|
||||
doom run
|
||||
doom run -nw init.el
|
||||
|
||||
WARNING: this command exists for convenience and testing. Doom will suffer
|
||||
additional overhead by being started this way. For the best performance, it is
|
||||
best to run Doom out of ~/.emacs.d and ~/.doom.d."
|
||||
;; TODO Does this work on Windows?
|
||||
(let* ((tempdir (doom-path (temporary-file-directory) "doom.run"))
|
||||
(tempemacsdir (doom-path tempdir ".emacs.d")))
|
||||
(delete-directory tempdir t)
|
||||
(make-directory tempemacsdir t)
|
||||
(with-temp-file (doom-path tempemacsdir "early-init.el")
|
||||
(prin1 `(progn
|
||||
(setenv "HOME" ,(getenv "HOME"))
|
||||
(setq user-emacs-directory ,doom-emacs-dir)
|
||||
(load ,(doom-path doom-emacs-dir "early-init.el")
|
||||
nil ,(not doom-debug-mode))
|
||||
(define-advice startup--load-user-init-file (:filter-args (args) init-doom)
|
||||
(cons (lambda () ,(doom-path doom-emacs-dir "init.el"))
|
||||
(cdr args))))
|
||||
(current-buffer)))
|
||||
(throw 'exit (format "HOME=%S %s %s"
|
||||
tempdir invocation-name
|
||||
(combine-and-quote-strings args))))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Bootstrap
|
||||
|
||||
(doom-log "Initializing Doom CLI")
|
||||
(load! doom-module-init-file doom-private-dir t)
|
||||
(maphash (doom-module-loader doom-cli-file) doom-modules)
|
||||
(load! doom-cli-file doom-private-dir t)
|
||||
|
||||
|
||||
;; 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)
|
||||
;; Reduce ambiguity, embrace specificity. It's more predictable.
|
||||
(setq-default case-fold-search nil)
|
||||
;; Don't clog the user's trash with anything we clean up in this session.
|
||||
(setq delete-by-moving-to-trash nil)
|
||||
|
||||
(provide 'core-cli)
|
||||
;;; core-cli.el ends here
|
||||
|
|
|
|||
|
|
@ -70,23 +70,6 @@ list is returned as-is."
|
|||
(cl-check-type keyword keyword)
|
||||
(substring (symbol-name keyword) 1))
|
||||
|
||||
(defmacro doom-log (format-string &rest args)
|
||||
"Log to *Messages* if `doom-debug-p' is on.
|
||||
Does not display text in echo area, but still logs to *Messages*. Accepts the
|
||||
same arguments as `message'."
|
||||
`(when doom-debug-p
|
||||
(let ((inhibit-message t))
|
||||
(message
|
||||
,(concat (propertize "DOOM " 'face 'font-lock-comment-face)
|
||||
(when (bound-and-true-p doom--current-module)
|
||||
(propertize
|
||||
(format "[%s/%s] "
|
||||
(doom-keyword-name (car doom--current-module))
|
||||
(cdr doom--current-module))
|
||||
'face 'warning))
|
||||
format-string)
|
||||
,@args))))
|
||||
|
||||
(defalias 'doom-partial #'apply-partially)
|
||||
|
||||
(defun doom-rpartial (fn &rest args)
|
||||
|
|
@ -213,8 +196,8 @@ TRIGGER-HOOK is a list of quoted hooks and/or sharp-quoted functions."
|
|||
|
||||
(defun file! ()
|
||||
"Return the emacs lisp file this function is called from."
|
||||
(cond ((bound-and-true-p byte-compile-current-file))
|
||||
(load-file-name)
|
||||
(cond (load-in-progress load-file-name)
|
||||
((bound-and-true-p byte-compile-current-file))
|
||||
((stringp (car-safe current-load-list))
|
||||
(car current-load-list))
|
||||
(buffer-file-name)
|
||||
|
|
@ -558,6 +541,8 @@ This is a wrapper around `eval-after-load' that:
|
|||
(cons 'doom-error doom-core-dir))
|
||||
((file-in-directory-p source doom-private-dir)
|
||||
(cons 'doom-private-error doom-private-dir))
|
||||
((file-in-directory-p source (expand-file-name "cli" doom-core-dir))
|
||||
(cons 'doom-cli-error (expand-file-name "cli" doom-core-dir)))
|
||||
((cons 'doom-module-error doom-emacs-dir)))))
|
||||
(signal (car err)
|
||||
(list (file-relative-name
|
||||
|
|
@ -579,8 +564,8 @@ If NOERROR is non-nil, don't throw an error if the file doesn't exist."
|
|||
(error "Could not detect path to look for '%s' in"
|
||||
filename)))
|
||||
(file (if path
|
||||
`(expand-file-name ,filename ,path)
|
||||
filename)))
|
||||
`(expand-file-name ,filename ,path)
|
||||
filename)))
|
||||
`(condition-case-unless-debug e
|
||||
(let (file-name-handler-alist)
|
||||
(load ,file ,noerror 'nomessage))
|
||||
|
|
|
|||
|
|
@ -1,5 +1,5 @@
|
|||
;;; app/everywhere/cli.el -*- lexical-binding: t; -*-
|
||||
|
||||
(defcli! everywhere ()
|
||||
(defcli! () ()
|
||||
"Spawn an emacsclient window for quick edits."
|
||||
(throw 'exit (list "emacsclient" "--eval" "(emacs-everywhere)")))
|
||||
(throw :exit "emacsclient --eval '(emacs-everywhere)'"))
|
||||
|
|
|
|||
|
|
@ -27,7 +27,7 @@ byte-compiled from.")
|
|||
;; Ensure output conforms to the formatting of all doom CLIs
|
||||
(defun message (msg &rest args)
|
||||
(when msg
|
||||
(print! (info "%s") (apply #'format msg args)))))
|
||||
(print! (item "%s") (apply #'format msg args)))))
|
||||
(print! (start "Compiling your literate config..."))
|
||||
(print-group!
|
||||
(let (;; Do as little unnecessary work as possible in these org files.
|
||||
|
|
@ -53,8 +53,8 @@ byte-compiled from.")
|
|||
;; Write an empty file to serve as our mtime cache
|
||||
(with-temp-file cache)
|
||||
(if doom-interactive-p t
|
||||
(message "Restarting..." )
|
||||
(throw 'exit "__DOOMRESTART=1 __NOTANGLE=1 $@"))))))
|
||||
(print! "Restarting...")
|
||||
(exit! "__DOOMRESTART=1 __NOTANGLE=1 $@"))))))
|
||||
|
||||
;;;###autoload
|
||||
(defalias '+literate/reload #'doom/reload)
|
||||
|
|
|
|||
|
|
@ -3,4 +3,4 @@
|
|||
(load! "autoload")
|
||||
|
||||
;; Tangle the user's config.org before 'doom sync' runs
|
||||
(add-hook 'doom-sync-pre-hook #'+literate-tangle-h)
|
||||
(add-hook 'doom-before-sync-hook #'+literate-tangle-h)
|
||||
|
|
|
|||
|
|
@ -239,6 +239,7 @@ https://emacs.stackexchange.com/questions/10230/how-to-indent-keywords-aligned"
|
|||
("Advice" "^\\s-*(\\(?:def\\(?:\\(?:ine-\\)?advice!?\\)\\) +\\([^ )\n]+\\)" 1)
|
||||
("Macros" "^\\s-*(\\(?:cl-\\)?def\\(?:ine-compile-macro\\|macro\\) +\\([^ )\n]+\\)" 1)
|
||||
("Inline functions" "\\s-*(\\(?:cl-\\)?defsubst +\\([^ )\n]+\\)" 1)
|
||||
("CLI Command" "^\\s-*(\\(def\\(?:cli\\|alias\\|obsolete\\|autoload\\)! +\\([^\n]+\\)\\)" 1)
|
||||
("Functions" "^\\s-*(\\(?:cl-\\)?def\\(?:un\\|un\\*\\|method\\|generic\\|-memoized!\\) +\\([^ ,)\n]+\\)" 1)
|
||||
("Variables" "^\\s-*(\\(def\\(?:c\\(?:onst\\(?:ant\\)?\\|ustom\\)\\|ine-symbol-macro\\|parameter\\|var\\(?:-local\\)?\\)\\)\\s-+\\(\\(?:\\sw\\|\\s_\\|\\\\.\\)+\\)" 2)
|
||||
("Types" "^\\s-*(\\(cl-def\\(?:struct\\|type\\)\\|def\\(?:class\\|face\\|group\\|ine-\\(?:condition\\|error\\|widget\\)\\|package\\|struct\\|t\\(?:\\(?:hem\\|yp\\)e\\)\\)\\)\\s-+'?\\(\\(?:\\sw\\|\\s_\\|\\\\.\\)+\\)" 2))))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue