Rewrite core-cli

Highlights:
- 'doom purge' now purges builds, elpa packages, and repos by default.
  Regrafting repos is now opt-in with the -g/--regraft switches.
  Negation flags have been added for elpa/repos: -e/--no-elpa and
  -r/--no-repos.
- Removed 'doom rebuild' (it is now just 'doom build' or 'doom b').
- Removed 'doom build's -f flag, this is now the default. Added the -r
  flag instead, which only builds packages that need rebuilding.
- 'doom update' now updates packages synchronously, but produces more
  informative output about the updating process.
- Straight can now prompt in batch mode, which resolves a lot of issues
  with 'doom update' (and 'doom upgrade') freezing indefinitely or
  throwing repo branch errors.
- 'bin/doom's switches are now positional. Switches aimed at `bin/doom`
  must precede any subcommands. e.g.
    Do: 'doom -yd upgrade'
    Don't do: 'doom upgrade -yd'
- Moved 'doom doctor' from bin/doom-doctor to core/cli/doctor, and
  integrated core/doctor.el into it, as to avoid naming conflicts
  between it and Emacs doctor.
- The defcli! macro now has a special syntax for declaring flags, their
  arguments and descriptions.

Addresses #1981, #1925, #1816, #1721, #1322
This commit is contained in:
Henrik Lissner 2019-11-07 15:59:56 -05:00
parent 99cd52e70f
commit 873fc5c0db
No known key found for this signature in database
GPG key ID: 5F6C0EA160557395
16 changed files with 996 additions and 1266 deletions

171
bin/doom
View file

@ -1,105 +1,79 @@
#!/usr/bin/env sh
":"; ( echo "$EMACS" | grep -q "term" ) && EMACS=emacs || EMACS=${EMACS:-emacs} # -*-emacs-lisp-*-
":"; command -v $EMACS >/dev/null || { >&2 echo "Emacs isn't installed"; exit 1; }
":"; VERSION=$($EMACS --version | head -n1)
":"; case "$VERSION" in *\ 2[0-2].[0-1].[0-9]) echo "You're running $VERSION"; echo "That version is too old to run Doom. Check your PATH"; echo; exit 2 ;; esac
":"; DOOMBASE=$(dirname "$0")/..
":"; [ "$1" = -d ] || [ "$1" = --debug ] && { shift; export DEBUG=1; }
":"; [ "$1" = doc ] || [ "$1" = doctor ] && { cd "$DOOMBASE"; shift; exec $EMACS --script bin/doom-doctor "$@"; exit 0; }
":"; [ "$1" = run ] && { cd "$DOOMBASE"; shift; exec $EMACS -q --no-splash -l bin/doom "$@"; exit 0; }
":"; exec $EMACS --script "$0" -- "$@"
":"; exit 0
:; ( echo "$EMACS" | grep -q "term" ) && EMACS=emacs || EMACS=${EMACS:-emacs} # -*-emacs-lisp-*-
:; command -v $EMACS >/dev/null || { >&2 echo "Can't find emacs in your PATH"; exit 1; }
:; VERSION=$($EMACS --version | head -n1)
:; case "$VERSION" in *\ 2[0-5].[0-9]) echo "Detected Emacs $VERSION"; echo "Doom only supports Emacs 26.1 and newer"; echo; exit 2 ;; esac
:; DOOMBASE="$(dirname "$0")/.."
:; [ "$1" = -d ] || [ "$1" = --debug ] && { shift; export DEBUG=1; }
:; [ "$1" = run ] && { cd "$DOOMBASE"; shift; exec $EMACS -q --no-splash -l bin/doom "$@"; exit 0; }
:; exec $EMACS --script "$0" -- "$@"
:; exit 0
(defconst user-emacs-directory
(or (getenv "EMACSDIR")
(expand-file-name "../" (file-name-directory (file-truename load-file-name)))))
(let* ((loaddir (file-name-directory (file-truename load-file-name)))
(emacsdir (getenv "EMACSDIR"))
(user-emacs-directory (or emacsdir (expand-file-name "../" loaddir)))
(load-prefer-newer t))
(defun usage ()
(with-temp-buffer
(insert (format! "%s %s [COMMAND] [ARGS...]\n"
(bold "Usage:")
(file-name-nondirectory load-file-name))
"\n"
"A command line interface for managing Doom Emacs; including\n"
"package management, diagnostics, unit tests, and byte-compilation.\n"
"\n"
"This tool also makes it trivial to launch Emacs out of a different\n"
"folder or with a different private module.\n"
"\n"
(format! (bold "Example:\n"))
" doom install\n"
" doom help update\n"
" doom compile :core lang/php lang/python\n"
" doom run\n"
" doom run -nw file.txt file2.el\n"
" doom run -p ~/.other.doom.d -e ~/.other.emacs.d -nw file.txt\n"
"\n"
(format! (bold "Options:\n"))
" -h --help\t\tSame as help command\n"
" -d --debug\t\tTurns on doom-debug-mode (and debug-on-error)\n"
" -e --emacsd DIR\tUse the emacs config at DIR (e.g. ~/.emacs.d)\n"
" -i --insecure\t\tDisable TLS/SSL validation (not recommended)\n"
" -l --local DIR\tUse DIR as your local storage directory\n"
" -p --private DIR\tUse the private module at DIR (e.g. ~/.doom.d)\n"
" -y --yes\t\tAuto-accept all confirmation prompts\n\n")
(princ (buffer-string)))
(doom--dispatch-help))
(push (expand-file-name "core" user-emacs-directory) load-path)
(require 'core)
(require 'core-cli)
;;
(let ((args (cdr (cdr (cdr command-line-args)))))
;; Parse options
(while (ignore-errors (string-prefix-p "-" (car args)))
(pcase (pop args)
((or "-h" "--help")
(push "help" args))
((or "-d" "--debug")
(setenv "DEBUG" "1")
(message "Debug mode on"))
((or "-i" "--insecure")
(setenv "INSECURE" "1")
(message "Insecure mode on"))
((or "-p" "--private")
(setq doom-private-dir (expand-file-name (concat (pop args) "/")))
(setenv "DOOMDIR" doom-private-dir)
(message "DOOMDIR changed to %s" doom-private-dir)
(or (file-directory-p doom-private-dir)
(message "Warning: %s does not exist"
(abbreviate-file-name doom-private-dir))))
((or "-l" "--local")
(setq doom-local-dir (expand-file-name (concat (pop args) "/")))
(setenv "DOOMLOCALDIR" doom-local-dir)
(message "DOOMLOCALDIR changed to %s" doom-local-dir))
((or "-e" "--emacsd")
(setq user-emacs-directory (expand-file-name (concat (pop args) "/")))
(message "Emacs directory changed to %s" user-emacs-directory))
((or "-y" "--yes")
(setenv "YES" "1")
(message "Auto-yes mode on"))))
(defcli! :main
((help-p ["-h" "--help"] "Same as help command")
(debug-p ["-d" "--debug"] "Turns on doom-debug-mode (and debug-on-error)")
(yes-p ["-y" "--yes"] "Auto-accept all confirmation prompts")
(emacsdir ["--emacsdir" dir] "Use the emacs config at DIR (e.g. ~/.emacs.d)")
(doomdir ["--doomdir" dir] "Use the private module at DIR (e.g. ~/.doom.d)")
(localdir ["--localdir" dir] "Use DIR as your local storage directory")
&optional command &rest args)
"A command line interface for managing Doom Emacs.
(unless (file-directory-p user-emacs-directory)
(error "%s does not exist" user-emacs-directory))
Includes package management, diagnostics, unit tests, and byte-compilation.
;; Bootstrap Doom
(if (not noninteractive)
(let ((doom-interactive-mode t))
(load (expand-file-name "init.el" user-emacs-directory)
nil 'nomessage)
(doom-run-all-startup-hooks-h))
(load (expand-file-name "core/core.el" user-emacs-directory)
nil 'nomessage)
(doom-initialize 'force-p)
(doom-initialize-modules)
This tool also makes it trivial to launch Emacs out of a different folder or
with a different private module."
:bare t
(when emacsdir
(setq user-emacs-directory (file-name-as-directory emacsdir))
(print! (info "EMACSDIR=%s") localdir))
(when doomdir
(setenv "DOOMDIR" doomdir)
(print! (info "DOOMDIR=%s") localdir))
(when localdir
(setenv "DOOMLOCALDIR" localdir)
(print! (info "DOOMLOCALDIR=%s") localdir))
(when debug-p
(setenv "DEBUG" "1")
(setq doom-debug-mode t)
(print! (info "Debug mode on")))
(when yes-p
(setenv "YES" "1")
(setq doom-auto-accept t)
(print! (info "Auto-yes on")))
(when help-p
(push command args)
(setq command "help"))
(cond ((or (not args)
(and (not (cdr args))
(member (car args) '("help" "h"))))
(unless args
(print! (error "No command detected.\n")))
(usage))
((require 'core-cli)
(setq argv nil)
(condition-case e
(doom-dispatch (car args) (cdr args))
;; Reload core in case any of the directories were changed.
(when (or emacsdir doomdir localdir)
(load! "core/core.el" user-emacs-directory))
(cond ((not noninteractive)
(print! "Doom launched out of %s (test mode)" (path user-emacs-directory))
(load! "init.el" user-emacs-directory)
(doom-run-all-startup-hooks-h))
((null command)
(doom-cli-execute "help"))
((condition-case e
(let ((start-time (current-time)))
(and (doom-cli-execute command args)
(terpri)
(print! (success "Finished! (%.4fs)")
(float-time
(time-subtract (current-time)
start-time)))))
(user-error
(print! (error "%s\n") (error-message-string e))
(print! (yellow "See 'doom help %s' for documentation on this command.") (car args)))
@ -116,5 +90,8 @@
"report, please include it!\n\n"
"Emacs outputs to standard error, so you'll need to redirect stderr to\n"
"stdout to pipe this to a file or clipboard!\n\n"
" e.g. doom -d install 2>&1 | clipboard-program"))
(signal 'doom-error e))))))))
" e.g. doom -d install 2>&1 | clipboard-program\n"))
(signal 'doom-error e)))))))
(doom-cli-execute :main (cdr (member "--" argv)))
(setq argv nil))

View file

@ -1,257 +0,0 @@
#!/usr/bin/env sh
":"; command -v emacs >/dev/null || { >&2 echo "Emacs isn't installed"; exit 1; } # -*-emacs-lisp-*-
":"; VERSION=$(emacs --version | head -n1)
":"; case $VERSION in *\ 2[0-2].[0-1].[0-9]) echo "You're running $VERSION"; echo "That version is too old to run the doctor (25.3 minimum). Check your PATH"; echo; exit 2 ;; esac
":"; exec emacs --quick --script "$0"; exit 0
;; The Doom doctor is essentially one big, self-contained elisp shell script
;; that uses a series of simple heuristics to diagnose common issues on your
;; system. Issues that could intefere with Doom Emacs.
;;
;; Doom modules may optionally have a doctor.el file to run their own heuristics
;; in. Doctor scripts may run in versions of Emacs as old as Emacs 23, so make
;; no assumptions about what's available in the standard library (e.g. avoid
;; cl/cl-lib, subr-x, map, seq, etc).
;; Ensure Doom doctor always runs out of the current Emacs directory (optionally
;; specified by the EMACSDIR envvar)
(setq user-emacs-directory
(or (getenv "EMACSDIR")
(expand-file-name "../" (file-name-directory (file-truename load-file-name))))
default-directory user-emacs-directory)
(unless (file-directory-p user-emacs-directory)
(error "Couldn't find a Doom config!"))
(unless noninteractive
(error "This script must not be run from an interactive session."))
(when (getenv "DEBUG")
(setq debug-on-error t))
(require 'subr-x)
(require 'pp)
(load (expand-file-name "core/autoload/format" user-emacs-directory) nil t)
(defvar doom-init-p nil)
(defvar doom-warnings 0)
(defvar doom-errors 0)
;;; Helpers
(defun sh (cmd &rest args)
(ignore-errors
(string-trim-right
(shell-command-to-string (if args (apply #'format cmd args) cmd)))))
(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")
file)
(warn! "%s is out-of-date" (abbreviate-file-name file)))))
(defmacro assert! (condition message &rest args)
`(unless ,condition
(error! ,message ,@args)))
;;; Logging
(defvar indent 0)
(defvar prefix "")
(defmacro msg! (msg &rest args)
`(print!
(indent indent
(format (concat prefix ,msg)
,@args))))
(defmacro error! (&rest args)
`(progn (msg! (red ,@args))
(setq doom-errors (+ doom-errors 1))))
(defmacro warn! (&rest args)
`(progn (msg! (yellow ,@args))
(setq doom-warnings (+ doom-warnings 1))))
(defmacro success! (&rest args) `(msg! (green ,@args)))
(defmacro section! (&rest args) `(msg! (bold (blue ,@args))))
(defmacro explain! (&rest args)
`(msg! (indent (+ indent 2) (autofill ,@args))))
;;; Polyfills
;; early versions of emacs won't have this
(unless (fboundp 'string-match-p)
(defun string-match-p (regexp string &optional start)
(save-match-data
(string-match regexp string &optional start))))
;; subr-x don't exist in older versions of Emacs
(unless (fboundp 'string-trim-right)
(defsubst string-trim-right (string &optional regexp)
(if (string-match (concat "\\(?:" (or regexp "[ \t\n\r]+") "\\)\\'") string)
(replace-match "" t t string)
string)))
;;
;;; Basic diagnostics
(msg! (bold "Doom Doctor"))
(msg! "Emacs v%s" emacs-version)
(msg! "Doom v%s (%s)"
(or (let ((core-file (expand-file-name "core/core.el" user-emacs-directory)))
(and (file-exists-p core-file)
(ignore-errors
(with-temp-buffer
(insert-file-contents-literally core-file)
(goto-char (point-min))
(when (search-forward "doom-version" nil t)
(forward-char)
(sexp-at-point))))))
"???")
(if (and (executable-find "git")
(file-directory-p (expand-file-name ".git" user-emacs-directory)))
(sh "git log -1 --format=\"%D %h %ci\"")
"n/a"))
(msg! "shell: %s%s"
(getenv "SHELL")
(if (equal (getenv "SHELL") (sh "echo $SHELL"))
""
(red " (mismatch)")))
(when (boundp 'system-configuration-features)
(msg! "Compiled with:\n%s" (indent 2 system-configuration-features)))
(msg! "uname -msrv:\n%s\n" (indent 2 (sh "uname -msrv")))
;;
;;; Check if Emacs is set up correctly
(section! "Checking Emacs")
(let ((indent 2))
(section! "Checking your Emacs version is 25.3 or newer...")
(when (version< emacs-version "25.3")
(error! "Important: Emacs %s detected [%s]" emacs-version (executable-find "emacs"))
(explain!
"DOOM only supports >= 25.3. Perhaps your PATH wasn't set up properly."
(when (eq system-type 'darwin)
(concat "\nMacOS users should use homebrew (https://brew.sh) to install Emacs\n"
" brew install emacs --with-modules --with-imagemagick --with-cocoa"))))
(section! "Checking for Emacs config conflicts...")
(when (file-exists-p "~/.emacs")
(warn! "Detected an ~/.emacs file, which may prevent Doom from loading")
(explain! "If Emacs finds an ~/.emacs file, it will ignore ~/.emacs.d, where Doom is "
"typically installed. If you're seeing a vanilla Emacs splash screen, this "
"may explain why. If you use Chemacs, you may ignore this warning."))
(section! "Checking for private config conflicts...")
(let ((xdg-dir (concat (or (getenv "XDG_CONFIG_HOME")
"~/.config")
"/doom/"))
(doom-dir (or (getenv "DOOMDIR")
"~/.doom.d/")))
(when (and (not (file-equal-p xdg-dir doom-dir))
(file-directory-p xdg-dir)
(file-directory-p doom-dir))
(warn! "Detected two private configs, in %s and %s"
(abbreviate-file-name xdg-dir)
doom-dir)
(explain! "The second directory will be ignored, as it has lower precedence.")))
(section! "Checking for stale elc files...")
(elc-check-dir user-emacs-directory))
;;
;;; Check if system environment is set up correctly
(section! "Checking your system...")
(let ((indent 2))
;; on windows?
(when (memq system-type '(windows-nt ms-dos cygwin))
(warn! "Warning: Windows detected")
(explain! "DOOM was designed for MacOS and Linux. Expect a bumpy ride!")))
;;
;;; Check if Doom Emacs is set up correctly
(condition-case-unless-debug ex
(let ((after-init-time (current-time))
(doom-format-backend 'ansi)
noninteractive)
(section! "Checking DOOM Emacs...")
(load (concat user-emacs-directory "core/core.el") nil t)
(unless (file-directory-p doom-private-dir)
(error "No DOOMDIR was found, did you run `doom install` yet?"))
(let ((indent 2))
;; Make sure Doom is initialized and loaded
(doom-initialize 'force)
(doom-initialize-core)
(success! "Initialized Doom Emacs %s" doom-version)
(doom-initialize-modules)
(if (hash-table-p doom-modules)
(success! "Initialized %d modules" (hash-table-count doom-modules))
(warn! "Failed to load any modules. Do you have an private init.el?"))
(doom-initialize-packages)
(success! "Initialized %d packages" (length doom-packages))
(section! "Checking Doom core for irregularities...")
(let ((indent (+ indent 2)))
(load (expand-file-name "doctor.el" doom-core-dir) nil 'nomessage))
(section! "Checking for stale elc files in your DOOMDIR...")
(when (file-directory-p doom-private-dir)
(let ((indent (+ indent 2)))
(elc-check-dir doom-private-dir)))
(when doom-modules
(section! "Checking your enabled modules...")
(let ((indent (+ indent 2)))
(advice-add #'require :around #'doom-shut-up-a)
(maphash
(lambda (key plist)
(let ((prefix (format! (bold "(%s %s) " (car key) (cdr key)))))
(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")))
(cl-loop for name in (let (doom-packages
doom-disabled-packages)
(load packages-file 'noerror 'nomessage)
(mapcar #'car doom-packages))
unless (or (doom-package-get name :disable)
(eval (doom-package-get name :ignore))
(doom-package-built-in-p name)
(doom-package-installed-p name))
do (error! "%s is not installed" name))
(load doctor-file 'noerror 'nomessage))
(file-missing (error! "%s" (error-message-string ex)))
(error (error! "Syntax error: %s" ex)))))
doom-modules)))))
(error
(warn! "Attempt to load DOOM failed\n %s\n"
(or (cdr-safe ex) (car ex)))
(setq doom-modules nil)))
;;
;;; Final report
(message "")
(dolist (msg (list (list doom-errors "error" 'red)
(list doom-warnings "warning" 'yellow)))
(when (> (car msg) 0)
(msg! (color (nth 2 msg)
(if (= (car msg) 1)
"There is %d %s!"
"There are %d %ss!")
(car msg) (nth 1 msg)))))
(when (and (zerop doom-errors)
(zerop doom-warnings))
(success! "Everything seems fine, happy Emacs'ing!"))