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

Rewrite core-cli

Browse source 
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
Download patch file Download diff file Expand all files Collapse all files

165
bin/doom
View file

@ -1,105 +1,79 @@
#!/usr/bin/env sh #!/usr/bin/env sh
":"; ( echo "$EMACS" | grep -q "term" ) && EMACS=emacs || EMACS=${EMACS:-emacs} # -*-emacs-lisp-*- :; ( 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; } :; command -v $EMACS >/dev/null || { >&2 echo "Can't find emacs in your PATH"; exit 1; }
":"; VERSION=$($EMACS --version | head -n1) :; 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 :; 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")/.. :; DOOMBASE="$(dirname "$0")/.."
":"; [ "$1" = -d ] || [ "$1" = --debug ] && { shift; export DEBUG=1; } :; [ "$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; }
":"; [ "$1" = run ] && { cd "$DOOMBASE"; shift; exec $EMACS -q --no-splash -l bin/doom "$@"; exit 0; } :; exec $EMACS --script "$0" -- "$@"
":"; exec $EMACS --script "$0" -- "$@" :; exit 0
":"; exit 0
(defconst user-emacs-directory (let* ((loaddir (file-name-directory (file-truename load-file-name)))
(or (getenv "EMACSDIR") (emacsdir (getenv "EMACSDIR"))
(expand-file-name "../" (file-name-directory (file-truename load-file-name))))) (user-emacs-directory (or emacsdir (expand-file-name "../" loaddir)))
(load-prefer-newer t))
(defun usage () (push (expand-file-name "core" user-emacs-directory) load-path)
(with-temp-buffer (require 'core)
(insert (format! "%s %s [COMMAND] [ARGS...]\n" (require 'core-cli)
(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))
;; (defcli! :main
(let ((args (cdr (cdr (cdr command-line-args))))) ((help-p ["-h" "--help"] "Same as help command")
;; Parse options (debug-p ["-d" "--debug"] "Turns on doom-debug-mode (and debug-on-error)")
(while (ignore-errors (string-prefix-p "-" (car args))) (yes-p ["-y" "--yes"] "Auto-accept all confirmation prompts")
(pcase (pop args) (emacsdir ["--emacsdir" dir] "Use the emacs config at DIR (e.g. ~/.emacs.d)")
((or "-h" "--help") (doomdir ["--doomdir" dir] "Use the private module at DIR (e.g. ~/.doom.d)")
(push "help" args)) (localdir ["--localdir" dir] "Use DIR as your local storage directory")
((or "-d" "--debug") &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."
: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") (setenv "DEBUG" "1")
(message "Debug mode on")) (setq doom-debug-mode t)
((or "-i" "--insecure") (print! (info "Debug mode on")))
(setenv "INSECURE" "1") (when yes-p
(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") (setenv "YES" "1")
(message "Auto-yes mode on")))) (setq doom-auto-accept t)
(print! (info "Auto-yes on")))
(when help-p
(push command args)
(setq command "help"))
(unless (file-directory-p user-emacs-directory) ;; Reload core in case any of the directories were changed.
(error "%s does not exist" user-emacs-directory)) (when (or emacsdir doomdir localdir)
(load! "core/core.el" user-emacs-directory))
;; Bootstrap Doom (cond ((not noninteractive)
(if (not noninteractive) (print! "Doom launched out of %s (test mode)" (path user-emacs-directory))
(let ((doom-interactive-mode t)) (load! "init.el" user-emacs-directory)
(load (expand-file-name "init.el" user-emacs-directory)
nil 'nomessage)
(doom-run-all-startup-hooks-h)) (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)
(cond ((or (not args) ((null command)
(and (not (cdr args)) (doom-cli-execute "help"))
(member (car args) '("help" "h"))))
(unless args ((condition-case e
(print! (error "No command detected.\n"))) (let ((start-time (current-time)))
(usage)) (and (doom-cli-execute command args)
((require 'core-cli) (terpri)
(setq argv nil) (print! (success "Finished! (%.4fs)")
(condition-case e (float-time
(doom-dispatch (car args) (cdr args)) (time-subtract (current-time)
start-time)))))
(user-error (user-error
(print! (error "%s\n") (error-message-string e)) (print! (error "%s\n") (error-message-string e))
(print! (yellow "See 'doom help %s' for documentation on this command.") (car args))) (print! (yellow "See 'doom help %s' for documentation on this command.") (car args)))
@ -116,5 +90,8 @@
"report, please include it!\n\n" "report, please include it!\n\n"
"Emacs outputs to standard error, so you'll need to redirect stderr to\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" "stdout to pipe this to a file or clipboard!\n\n"
" e.g. doom -d install 2>&1 | clipboard-program")) " e.g. doom -d install 2>&1 | clipboard-program\n"))
(signal 'doom-error e)))))))) (signal 'doom-error e)))))))
(doom-cli-execute :main (cdr (member "--" argv)))
(setq argv nil))

257
bin/doom-doctor
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!"))

86
core/autoload/cli.el
View file

@ -124,89 +124,3 @@ Warning: freezes indefinitely on any stdin prompt."
(sit-for 0.1)) (sit-for 0.1))
(process-exit-status process)) (process-exit-status process))
(string-trim (buffer-string))))) (string-trim (buffer-string)))))
(defun doom--cli-normalize (args specs)
(let* ((args (cl-remove-if-not #'stringp args))
(optspec (cl-remove-if-not #'listp specs))
(argspec (cl-remove-if #'listp specs))
(options (mapcar #'list (mapcar #'car-safe optspec)))
extra
arguments)
(dolist (spec optspec)
(setf (nth 1 spec) (doom-enlist (nth 1 spec))))
(while args
(let ((arg (pop args)))
(cl-check-type arg string)
(if (not (string-prefix-p "-" arg))
(push arg arguments)
(if-let (specs (cl-remove-if-not
(if (string-prefix-p "--" arg)
(doom-partial #'member arg)
(lambda (flags)
(cl-loop for switch in (split-string (string-remove-prefix "-" arg) "" t)
if (member (concat "-" switch) flags)
return t)))
optspec
:key #'cadr))
(pcase-dolist (`(,sym ,flags ,type) specs)
(setf (alist-get sym options)
(list
(let ((value (if type (pop args))))
(pcase type
(`&string value)
(`&int `(truncate (read ,value)))
(`&float `(float (read ,value)))
(`&path `(expand-file-name ,value))
(`&directory
`(let ((path (expand-file-name ,value)))
(unless (file-directory-p path)
(error "Directory does not exist: %s" path))
path))
(`&file
`(let ((path (expand-file-name ,value)))
(unless (file-exists-p path)
(error "File does not exist: %s" path))
path))
(`&sexp `(read ,value))
((or `nil `t) arg)
(_ (error "Not a valid type: %S" type)))))))
(push arg extra)))))
(list optspec (nreverse options)
argspec (nreverse arguments))))
;;;###autoload
(defun doom-cli-getopts (args specs)
"TODO"
(cl-destructuring-bind (optspec options argspec arguments)
(doom--cli-normalize args specs)
(let ((i 0)
optional-p
noerror-p)
(cl-dolist (spec argspec)
(cond ((eq spec '&rest)
(push (list (cadr (member '&rest specs))
`(quote
,(reverse
(butlast (reverse arguments) i))))
options)
(cl-return))
((eq spec '&all)
(push (list (cadr (member '&all specs))
`(quote ,args))
options))
((eq spec '&noerror) (setq noerror-p t))
((eq spec '&optional) (setq optional-p t))
((and (>= i (length arguments)) (not optional-p))
(signal 'wrong-number-of-arguments
(list argspec (length arguments))))
((push (list spec (nth i arguments)) options)
(cl-incf i)))))
(nreverse options)))
;;;###autoload
(defmacro let-cliopts! (args spec &rest body)
"Run BODY with command line ARGS parsed according to SPEC."
(declare (indent 2))
`(eval (append (list 'let (doom-cli-getopts ,args ',spec))
(quote ,body))
t))

89
core/cli/autoloads.el
View file

@ -1,14 +1,11 @@
;;; core/cli/autoloads.el -*- lexical-binding: t; -*- ;;; core/cli/autoloads.el -*- lexical-binding: t; -*-
(require 'autoload)
(defvar doom-autoload-excluded-packages '("gh") (defvar doom-autoload-excluded-packages '("gh")
"Packages that have silly or destructive autoload files that try to load "Packages that have silly or destructive autoload files that try to load
everyone in the universe and their dog, causing errors that make babies cry. No everyone in the universe and their dog, causing errors that make babies cry. No
one wants that.") one wants that.")
;; external variables ;; externs
(defvar autoload-timestamps) (defvar autoload-timestamps)
(defvar generated-autoload-load-name) (defvar generated-autoload-load-name)
(defvar generated-autoload-file) (defvar generated-autoload-file)
@ -27,15 +24,14 @@ byte-compiles `doom-autoload-file', as well as `doom-package-autoload-file'
It also caches `load-path', `Info-directory-list', `doom-disabled-packages', It also caches `load-path', `Info-directory-list', `doom-disabled-packages',
`package-activated-list' and `auto-mode-alist'." `package-activated-list' and `auto-mode-alist'."
;; REVIEW Can we avoid calling `straight-check-all' everywhere?
(straight-check-all) (straight-check-all)
(doom-reload-autoloads nil 'force)) (doom-cli-reload-autoloads nil 'force))
;; ;;
;;; Helpers ;;; Helpers
(defun doom-delete-autoloads-file (file) (defun doom--cli-delete-autoloads-file (file)
"Delete FILE (an autoloads file) and accompanying *.elc file, if any." "Delete FILE (an autoloads file) and accompanying *.elc file, if any."
(cl-check-type file string) (cl-check-type file string)
(when (file-exists-p file) (when (file-exists-p file)
@ -47,29 +43,29 @@ It also caches `load-path', `Info-directory-list', `doom-disabled-packages',
(ignore-errors (delete-file (byte-compile-dest-file file))) (ignore-errors (delete-file (byte-compile-dest-file file)))
t)) t))
(defun doom--warn-refresh-session-h () (defun doom--cli-warn-refresh-session-h ()
(message "Restart or reload Doom Emacs for changes to take effect:\n") (message "Restart or reload Doom Emacs for changes to take effect:\n")
(message " M-x doom/restart-and-restore") (message " M-x doom/restart-and-restore")
(message " M-x doom/restart") (message " M-x doom/restart")
(message " M-x doom/reload")) (message " M-x doom/reload"))
(defun doom--byte-compile-file (file) (defun doom--cli-byte-compile-file (file)
(let ((byte-compile-warnings (if doom-debug-mode byte-compile-warnings)) (let ((byte-compile-warnings (if doom-debug-mode byte-compile-warnings))
(byte-compile-dynamic t) (byte-compile-dynamic t)
(byte-compile-dynamic-docstrings t)) (byte-compile-dynamic-docstrings t))
(condition-case-unless-debug e (condition-case-unless-debug e
(when (byte-compile-file file) (when (byte-compile-file file)
(prog1 (load file 'noerror 'nomessage) (prog1 (load file 'noerror 'nomessage 'nosuffix)
(when noninteractive (when noninteractive
(add-hook 'doom-cli-post-success-execute-hook #'doom--warn-refresh-session-h)))) (add-hook 'doom-cli-post-success-execute-hook #'doom--cli-warn-refresh-session-h))))
((debug error) ((debug error)
(let ((backup-file (concat file ".bk"))) (let ((backup-file (concat file ".bk")))
(print! (warn "Copied backup to %s") (relpath backup-file)) (print! (warn "Copied backup to %s") (relpath backup-file))
(copy-file file backup-file 'overwrite)) (copy-file file backup-file 'overwrite))
(doom-delete-autoloads-file file) (doom--cli-delete-autoloads-file file)
(signal 'doom-autoload-error (list file e)))))) (signal 'doom-autoload-error (list file e))))))
(defun doom-reload-autoloads (&optional file force-p) (defun doom-cli-reload-autoloads (&optional file force-p)
"Reloads FILE (an autoload file), if it needs reloading. "Reloads FILE (an autoload file), if it needs reloading.
FILE should be one of `doom-autoload-file' or `doom-package-autoload-file'. If FILE should be one of `doom-autoload-file' or `doom-package-autoload-file'. If
@ -80,23 +76,23 @@ even if it doesn't need reloading!"
(signal 'wrong-type-argument (list 'stringp file))) (signal 'wrong-type-argument (list 'stringp file)))
(if (stringp file) (if (stringp file)
(cond ((file-equal-p file doom-autoload-file) (cond ((file-equal-p file doom-autoload-file)
(doom-reload-core-autoloads force-p)) (doom-cli-reload-core-autoloads force-p))
((file-equal-p file doom-package-autoload-file) ((file-equal-p file doom-package-autoload-file)
(doom-reload-package-autoloads force-p)) (doom-cli-reload-package-autoloads force-p))
((error "Invalid autoloads file: %s" file))) ((error "Invalid autoloads file: %s" file)))
(doom-reload-core-autoloads force-p) (doom-cli-reload-core-autoloads force-p)
(doom-reload-package-autoloads force-p))) (doom-cli-reload-package-autoloads force-p)))
;; ;;
;;; Doom autoloads ;;; Doom autoloads
(defun doom--generate-header (func) (defun doom--cli-generate-header (func)
(goto-char (point-min)) (goto-char (point-min))
(insert ";; -*- lexical-binding:t; -*-\n" (insert ";; -*- lexical-binding:t; -*-\n"
";; This file is autogenerated by `" (symbol-name func) "', DO NOT EDIT !!\n\n")) ";; This file is autogenerated by `" (symbol-name func) "', DO NOT EDIT !!\n\n"))
(defun doom--generate-autoloads (targets) (defun doom--cli-generate-autoloads (targets)
(let ((n 0)) (let ((n 0))
(dolist (file targets) (dolist (file targets)
(insert (insert
@ -115,7 +111,7 @@ even if it doesn't need reloading!"
"Scanned %d file(s)") "Scanned %d file(s)")
n))) n)))
(defun doom--expand-autoload-paths (&optional allow-internal-paths) (defun doom--cli-expand-autoload-paths (&optional allow-internal-paths)
(let ((load-path (let ((load-path
;; NOTE With `doom-private-dir' in `load-path', Doom autoloads files ;; NOTE With `doom-private-dir' in `load-path', Doom autoloads files
;; will be unable to declare autoloads for the built-in autoload.el ;; will be unable to declare autoloads for the built-in autoload.el
@ -140,7 +136,7 @@ even if it doesn't need reloading!"
path) path)
t t nil 1))))) t t nil 1)))))
(defun doom--generate-autodefs-1 (path &optional member-p) (defun doom--cli-generate-autodefs-1 (path &optional member-p)
(let (forms) (let (forms)
(while (re-search-forward "^;;;###autodef *\\([^\n]+\\)?\n" nil t) (while (re-search-forward "^;;;###autodef *\\([^\n]+\\)?\n" nil t)
(let* ((sexp (sexp-at-point)) (let* ((sexp (sexp-at-point))
@ -202,7 +198,7 @@ even if it doesn't need reloading!"
(member-p (push sexp forms))))) (member-p (push sexp forms)))))
forms)) forms))
(defun doom--generate-autodefs (targets enabled-targets) (defun doom--cli-generate-autodefs (targets enabled-targets)
(goto-char (point-max)) (goto-char (point-max))
(search-backward ";;;***" nil t) (search-backward ";;;***" nil t)
(save-excursion (insert "\n")) (save-excursion (insert "\n"))
@ -210,17 +206,17 @@ even if it doesn't need reloading!"
(insert (insert
(with-temp-buffer (with-temp-buffer
(insert-file-contents path) (insert-file-contents path)
(if-let (forms (doom--generate-autodefs-1 path (member path enabled-targets))) (if-let (forms (doom--cli-generate-autodefs-1 path (member path enabled-targets)))
(concat (mapconcat #'prin1-to-string (nreverse forms) "\n") (concat (mapconcat #'prin1-to-string (nreverse forms) "\n")
"\n") "\n")
""))))) "")))))
(defun doom--cleanup-autoloads () (defun doom--cli-cleanup-autoloads ()
(goto-char (point-min)) (goto-char (point-min))
(when (re-search-forward "^;;\\(;[^\n]*\\| no-byte-compile: t\\)\n" nil t) (when (re-search-forward "^;;\\(;[^\n]*\\| no-byte-compile: t\\)\n" nil t)
(replace-match "" t t))) (replace-match "" t t)))
(defun doom-reload-core-autoloads (&optional force-p) (defun doom-cli-reload-core-autoloads (&optional force-p)
"Refreshes `doom-autoload-file', if necessary (or if FORCE-P is non-nil). "Refreshes `doom-autoload-file', if necessary (or if FORCE-P is non-nil).
It scans and reads autoload cookies (;;;###autoload) in core/autoload/*.el, It scans and reads autoload cookies (;;;###autoload) in core/autoload/*.el,
@ -228,6 +224,7 @@ modules/*/*/autoload.el and modules/*/*/autoload/*.el, and generates
`doom-autoload-file'. `doom-autoload-file'.
Run this whenever your `doom!' block, or a module autoload file, is modified." Run this whenever your `doom!' block, or a module autoload file, is modified."
(require 'autoload)
(let* ((default-directory doom-emacs-dir) (let* ((default-directory doom-emacs-dir)
(doom-modules (doom-modules)) (doom-modules (doom-modules))
@ -269,37 +266,38 @@ Run this whenever your `doom!' block, or a module autoload file, is modified."
(ignore (ignore
(print! (success "Skipping core autoloads, they are up-to-date")) (print! (success "Skipping core autoloads, they are up-to-date"))
(doom-load-autoloads-file doom-autoload-file)) (doom-load-autoloads-file doom-autoload-file))
(print! (start "Regenerating core autoloads file")) (if (doom--cli-delete-autoloads-file doom-autoload-file)
(if (doom-delete-autoloads-file doom-autoload-file)
(print! (success "Deleted old %s") (filename doom-autoload-file)) (print! (success "Deleted old %s") (filename doom-autoload-file))
(make-directory (file-name-directory doom-autoload-file) t)) (make-directory (file-name-directory doom-autoload-file) t))
(print! (start "Regenerating core autoloads file"))
(print-group!
(with-temp-file doom-autoload-file (with-temp-file doom-autoload-file
(doom--generate-header 'doom-reload-core-autoloads) (doom--cli-generate-header 'doom-cli-reload-core-autoloads)
(save-excursion (save-excursion
(doom--generate-autoloads active-targets) (doom--cli-generate-autoloads active-targets)
(print! (success "Generated new autoloads.el"))) (print! (success "Generated new autoloads.el")))
;; Replace autoload paths (only for module autoloads) with absolute ;; Replace autoload paths (only for module autoloads) with absolute
;; paths for faster resolution during load and simpler `load-path' ;; paths for faster resolution during load and simpler `load-path'
(save-excursion (save-excursion
(doom--expand-autoload-paths 'allow-internal-paths) (doom--cli-expand-autoload-paths 'allow-internal-paths)
(print! (success "Expanded module autoload paths"))) (print! (success "Expanded module autoload paths")))
;; Generates stub definitions for functions/macros defined in disabled ;; Generates stub definitions for functions/macros defined in disabled
;; modules, so that you will never get a void-function when you use ;; modules, so that you will never get a void-function when you use
;; them. ;; them.
(save-excursion (save-excursion
(doom--generate-autodefs targets (reverse active-targets)) (doom--cli-generate-autodefs targets (reverse active-targets))
(print! (success "Generated autodefs"))) (print! (success "Generated autodefs")))
;; Remove byte-compile-inhibiting file variables so we can byte-compile ;; Remove byte-compile-inhibiting file variables so we can byte-compile
;; the file, and autoload comments. ;; the file, and autoload comments.
(doom--cleanup-autoloads) (doom--cli-cleanup-autoloads)
(print! (success "Clean up autoloads"))) (print! (success "Cleaned up autoloads"))))
;; Byte compile it to give the file a chance to reveal errors (and buy us a ;; Byte compile it to give the file a chance to reveal errors (and buy us a
;; few marginal performance boosts) ;; few marginal performance boosts)
(print! "> Byte-compiling %s..." (relpath doom-autoload-file)) (print! "> Byte-compiling %s..." (relpath doom-autoload-file))
(when (doom--byte-compile-file doom-autoload-file) (when (doom--cli-byte-compile-file doom-autoload-file)
(print! (success "Finished compiling %s") (relpath doom-autoload-file)))) (print-group!
(print! (success "Compiled %s") (relpath doom-autoload-file)))))
t))) t)))
@ -346,7 +344,7 @@ served no purpose but to waste cycles."
(goto-char (match-beginning 1)) (goto-char (match-beginning 1))
(kill-sexp))) (kill-sexp)))
(defun doom-reload-package-autoloads (&optional force-p) (defun doom-cli-reload-package-autoloads (&optional force-p)
"Compiles `doom-package-autoload-file' from the autoloads files of all "Compiles `doom-package-autoload-file' from the autoloads files of all
installed packages. It also caches `load-path', `Info-directory-list', installed packages. It also caches `load-path', `Info-directory-list',
`doom-disabled-packages', `package-activated-list' and `auto-mode-alist'. `doom-disabled-packages', `package-activated-list' and `auto-mode-alist'.
@ -355,6 +353,7 @@ Will do nothing if none of your installed packages have been modified. If
FORCE-P (universal argument) is non-nil, regenerate it anyway. FORCE-P (universal argument) is non-nil, regenerate it anyway.
This should be run whenever your `doom!' block or update your packages." This should be run whenever your `doom!' block or update your packages."
(require 'autoload)
(print! (start "Checking package autoloads file")) (print! (start "Checking package autoloads file"))
(print-group! (print-group!
(if (and (not force-p) (if (and (not force-p)
@ -381,14 +380,15 @@ This should be run whenever your `doom!' block or update your packages."
(version-control 'never) (version-control 'never)
(case-fold-search nil) ; reduce magic (case-fold-search nil) ; reduce magic
(autoload-timestamps nil)) (autoload-timestamps nil))
(print! (start "Regenerating package autoloads file"))
(if (doom-delete-autoloads-file doom-package-autoload-file) (if (doom--cli-delete-autoloads-file doom-package-autoload-file)
(print! (success "Deleted old %s") (filename doom-package-autoload-file)) (print! (success "Deleted old %s") (filename doom-package-autoload-file))
(make-directory (file-name-directory doom-autoload-file) t)) (make-directory (file-name-directory doom-autoload-file) t))
(print! (start "Regenerating package autoloads file"))
(print-group!
(with-temp-file doom-package-autoload-file (with-temp-file doom-package-autoload-file
(doom--generate-header 'doom-reload-package-autoloads) (doom--cli-generate-header 'doom-cli-reload-package-autoloads)
(save-excursion (save-excursion
;; Cache important and expensive-to-initialize state here. ;; Cache important and expensive-to-initialize state here.
@ -401,17 +401,18 @@ This should be run whenever your `doom!' block or update your packages."
;; Replace autoload paths (only for module autoloads) with absolute ;; Replace autoload paths (only for module autoloads) with absolute
;; paths for faster resolution during load and simpler `load-path' ;; paths for faster resolution during load and simpler `load-path'
(save-excursion (save-excursion
(doom--expand-autoload-paths) (doom--cli-expand-autoload-paths)
(print! (success "Expanded module autoload paths"))) (print! (success "Expanded module autoload paths")))
;; Remove `load-path' and `auto-mode-alist' modifications (most of them, ;; Remove `load-path' and `auto-mode-alist' modifications (most of them,
;; at least); they are cached later, so all those membership checks are ;; at least); they are cached later, so all those membership checks are
;; unnecessary overhead. ;; unnecessary overhead.
(doom--cleanup-package-autoloads) (doom--cleanup-package-autoloads)
(print! (success "Removed load-path/auto-mode-alist entries"))) (print! (success "Removed load-path/auto-mode-alist entries"))))
;; Byte compile it to give the file a chance to reveal errors (and buy us a ;; Byte compile it to give the file a chance to reveal errors (and buy us a
;; few marginal performance boosts) ;; few marginal performance boosts)
(print! (start "Byte-compiling %s...") (relpath doom-package-autoload-file)) (print! (start "Byte-compiling %s...") (relpath doom-package-autoload-file))
(when (doom--byte-compile-file doom-package-autoload-file) (when (doom--cli-byte-compile-file doom-package-autoload-file)
(print! (success "Finished compiling %s") (relpath doom-package-autoload-file))))) (print-group!
(print! (success "Compiled %s") (relpath doom-package-autoload-file))))))
t)) t))

15
core/cli/byte-compile.el
View file

@ -1,6 +1,8 @@
;;; core/cli/byte-compile.el -*- lexical-binding: t; -*- ;;; core/cli/byte-compile.el -*- lexical-binding: t; -*-
(defcli! (compile c) (&rest targets) (defcli! (compile c)
((recompile-p ["-r" "--recompile"])
&rest targets)
"Byte-compiles your config or selected modules. "Byte-compiles your config or selected modules.
compile [TARGETS...] compile [TARGETS...]
@ -10,14 +12,11 @@
Accepts :core and :private as special arguments, which target Doom's core files Accepts :core and :private as special arguments, which target Doom's core files
and your private config files, respectively. To recompile your packages, use and your private config files, respectively. To recompile your packages, use
'doom rebuild' instead." 'doom rebuild' instead."
(doom-byte-compile targets)) (doom-cli-byte-compile targets recompile-p))
(defcli! (recompile rc) (&rest targets)
"Re-byte-compiles outdated *.elc files."
(doom-byte-compile targets 'recompile))
(defcli! clean () (defcli! clean ()
"Delete all *.elc files." "Delete all *.elc files."
:bare t
(doom-clean-byte-compiled-files)) (doom-clean-byte-compiled-files))
@ -31,7 +30,7 @@ and your private config files, respectively. To recompile your packages, use
(not (equal (file-name-extension path) "el")) (not (equal (file-name-extension path) "el"))
(member filename (list "packages.el" "doctor.el"))))) (member filename (list "packages.el" "doctor.el")))))
(cl-defun doom-byte-compile (&optional modules recompile-p) (cl-defun doom-cli-byte-compile (&optional modules recompile-p)
"Byte compiles your emacs configuration. "Byte compiles your emacs configuration.
init.el is always byte-compiled by this. init.el is always byte-compiled by this.
@ -149,7 +148,7 @@ If RECOMPILE-P is non-nil, only recompile out-of-date files."
(unless recompile-p (unless recompile-p
(doom-clean-byte-compiled-files)) (doom-clean-byte-compiled-files))
(dolist (target (delete-dups targets)) (dolist (target (delete-dups (delq nil targets)))
(cl-incf (cl-incf
(if (not (or (not recompile-p) (if (not (or (not recompile-p)
(let ((elc-file (byte-compile-dest-file target))) (let ((elc-file (byte-compile-dest-file target)))

21
core/cli/debug.el
View file

@ -1,21 +1,11 @@
;;; core/cli/debug.el -*- lexical-binding: t; -*- ;;; core/cli/debug.el -*- lexical-binding: t; -*-
(load! "autoload/debug" doom-core-dir)
;; ;;
;;; Commands ;;; Commands
(defcli! info (&optional format) (defcli! info
"Output system info in markdown for bug reports. ((format ["--json" "--md" "--lisp"] "What format to dump info into"))
"Output system info in markdown for bug reports."
Will print in the following formats:
--json
--md / --markdown
--lisp
If no arguments are given, --raw is assumed."
(pcase format (pcase format
("--json" ("--json"
(require 'json) (require 'json)
@ -23,7 +13,7 @@ If no arguments are given, --raw is assumed."
(insert (json-encode (doom-info))) (insert (json-encode (doom-info)))
(json-pretty-print-buffer) (json-pretty-print-buffer)
(print! (buffer-string)))) (print! (buffer-string))))
((or "--md" "--markdown") ("--md"
(doom/info)) (doom/info))
((or `nil "--lisp") ((or `nil "--lisp")
(doom/info 'raw)) (doom/info 'raw))
@ -33,6 +23,7 @@ If no arguments are given, --raw is assumed."
nil) nil)
(defcli! (version v) () (defcli! (version v) ()
"Reports the version of Doom and Emacs." "Show version information for Doom & Emacs."
:bare t
(doom/version) (doom/version)
nil) nil)

209
core/cli/doctor.el Normal file
View file

@ -0,0 +1,209 @@
;;; core/cli/doctor.el -*- lexical-binding: t; -*-
(defvar doom-warnings ())
(defvar doom-errors ())
;;; 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")
file)
(warn! "%s is out-of-date" (abbreviate-file-name file)))))
(defmacro assert! (condition message &rest args)
`(unless ,condition
(error! ,message ,@args)))
;;; Logging
(defmacro error! (&rest args)
`(progn (unless inhibit-message (print! (error ,@args)))
(push (format! (error ,@args)) doom-errors)))
(defmacro warn! (&rest args)
`(progn (unless inhibit-message (print! (warn ,@args)))
(push (format! (warn ,@args)) doom-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))))
;;
;;; CLI commands
(defcli! (doctor doc) ()
"Diagnoses common issues on your system.
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."
:bare t
(print! "The doctor will see you now...\n")
;; REVIEW Refactor me
(print! (start "Checking your Emacs version..."))
(when EMACS27+
(warn! "Emacs %s detected. Emacs HEAD is unstable and may cause errors."
emacs-version))
(print! (start "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."))
(print! (start "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))
(print! (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.")))
(print! (start "Checking for stale elc files..."))
(elc-check-dir user-emacs-directory)
(print! (start "Checking Doom Emacs..."))
(condition-case-unless-debug ex
(print-group!
;; Make sure Doom is initialized and loaded
(let ((doom-interactive-mode t))
(doom-initialize 'force))
(doom-initialize-core)
(print! (success "Initialized Doom Emacs %s") doom-version)
(doom-initialize-modules)
(print!
(if (hash-table-p doom-modules)
(success "Detected %d modules" (hash-table-count doom-modules))
(warn "Failed to load any modules. Do you have an private init.el?")))
(print! (success "Detected %d packages") (length doom-packages))
(print! (start "Checking Doom core for irregularities..."))
(print-group!
;; Check for oversized problem files in cache that may cause unusual/tremendous
;; delays or freezing. This shouldn't happen often.
(dolist (file (list "savehist"
"projectile.cache"))
(let* ((path (expand-file-name file doom-cache-dir))
(size (/ (doom-file-size path) 1024)))
(when (and (numberp size) (> size 1000))
(warn! "%s is too large (%.02fmb). This may cause freezes or odd startup delays"
(relpath path)
(/ size 1024))
(explain! "Consider deleting it from your system (manually)"))))
(unless (ignore-errors (executable-find doom-projectile-fd-binary))
(warn! "Couldn't find the `fd' binary; project file searches will be slightly slower")
(unless (executable-find "rg")
(warn! "Couldn't find the `rg' binary either; project file searches will be even slower")))
(let ((default-directory "~"))
(require 'projectile)
(when (cl-find-if #'projectile-file-exists-p projectile-project-root-files-bottom-up)
(warn! "Your $HOME is recognized as a project root")
(explain! "Doom will disable bottom-up root search, which may reduce the accuracy of project\n"
"detection.")))
;; There should only be one
(when (and (file-equal-p doom-private-dir "~/.config/doom")
(file-directory-p "~/.doom.d"))
(print! (warn "Both %S and '~/.doom.d' exist on your system")
(path doom-private-dir))
(explain! "Doom will only load one of these (~/.config/doom takes precedence). Possessing\n"
"both is rarely intentional; you should one or the other."))
;; Check for fonts
(if (not (fboundp 'find-font))
(progn
(warn! "Warning: unable to detect font")
(explain! "The `find-font' function is missing. This could indicate the incorrect "
"version of Emacs is being used!"))
;; all-the-icons fonts
(when (and (pcase system-type
(`gnu/linux (concat (or (getenv "XDG_DATA_HOME")
"~/.local/share")
"/fonts/"))
(`darwin "~/Library/Fonts/"))
(require 'all-the-icons nil t))
(dolist (font all-the-icons-font-families)
(if (with-temp-buffer
(insert (cdr (doom-call-process "fc-list")))
(re-search-backward "Fira" nil t))
(success! "Found font %s" font)
(print! (warn "Warning: couldn't find %s font in %s")
font font-dest)
(explain! "You can install it by running `M-x all-the-icons-install-fonts' within Emacs.\n\n"
"This could also mean you've installed them in non-standard locations, in which "
"case feel free to ignore this warning."))))))
(print! (start "Checking for stale elc files in your DOOMDIR..."))
(when (file-directory-p doom-private-dir)
(print-group!
(elc-check-dir doom-private-dir)))
(when doom-modules
(print! (start "Checking your enabled modules..."))
(advice-add #'require :around #'doom-shut-up-a)
(maphash (lambda (key plist)
(let (doom-local-errors
doom-local-warnings)
(let (doom-errors
doom-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")))
(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 (print! (error "%s is not installed") 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)
(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)))
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)
(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)
(success! "Everything seems fine, happy Emacs'ing!"))
t)

119
core/cli/env.el
View file

@ -1,13 +1,15 @@
;;; core/cli/env.el -*- lexical-binding: t; -*- ;;; core/cli/env.el -*- lexical-binding: t; -*-
(defcli! env (&rest args) (defcli! env
((clear-p ["-c" "--clear"] "Clear and delete your envvar file")
(outputfile ["-o" PATH]
"Generate the envvar file at PATH. Note that 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.")
&rest args)
"Creates or regenerates your envvars file. "Creates or regenerates your envvars file.
doom env [-c|--clear]
This is meant to be a faster and more comprehensive alternative to
exec-path-from-shell. See the FAQ in the documentation for an explanation why.
The envvars file is created by scraping your (interactive) shell environment The envvars file is created by scraping your (interactive) shell environment
into newline-delimited KEY=VALUE pairs. Typically by running '$SHELL -ic env' into newline-delimited KEY=VALUE pairs. Typically by running '$SHELL -ic env'
(or '$SHELL -c set' on windows). Doom loads this file at startup (if it exists) (or '$SHELL -c set' on windows). Doom loads this file at startup (if it exists)
@ -21,14 +23,23 @@ app launchers on Linux).
This file is automatically regenerated when you run this command or 'doom This file is automatically regenerated when you run this command or 'doom
refresh'. However, 'doom refresh' will only regenerate this file if it exists. refresh'. However, 'doom refresh' will only regenerate this file if it exists.
Use the -c or --clear switch to delete your envvar file." Why this over exec-path-from-shell?
(when (member "clear" args) ; DEPRECATED
(message "'doom env clear' is deprecated. Use 'doom env -c' or 'doom env --clear' instead") 1. `exec-path-from-shell' spawns (at least) one process at startup to scrape
(push "-c" args)) your shell environment. This can be arbitrarily slow depending on the
(let ((env-file (or (cadr (member "-o" args)) user's shell configuration. A single program (like pyenv or nvm) or config
doom-env-file))) framework (like oh-my-zsh) could undo all of Doom's startup optimizations
(cond ((or (member "-c" args) in one fell swoop.
(member "--clear" args))
2. `exec-path-from-shell' only scrapes some state from your shell. You have to
be proactive in order to get it to capture all the envvars relevant to your
development environment.
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 it you least want to deal with it."
(let ((env-file (expand-file-name (or outputfile doom-env-file))))
(cond (clear-p
(unless (file-exists-p env-file) (unless (file-exists-p env-file)
(user-error! "%S does not exist to be cleared" (user-error! "%S does not exist to be cleared"
(path env-file))) (path env-file)))
@ -36,12 +47,11 @@ Use the -c or --clear switch to delete your envvar file."
(print! (success "Successfully deleted %S") (print! (success "Successfully deleted %S")
(path env-file))) (path env-file)))
((or (null args) (args
(member "-o" args)) (user-error "I don't understand 'doom env %s'"
(doom-reload-env-file 'force env-file)) (string-join args " ")))
((user-error "I don't understand 'doom env %s'" ((doom-cli-reload-env-file 'force env-file)))))
(string-join args " "))))))
;; ;;
@ -66,22 +76,7 @@ Use the -c or --clear switch to delete your envvar file."
Each string is a regexp, matched against variable names to omit from Each string is a regexp, matched against variable names to omit from
`doom-env-file'.") `doom-env-file'.")
(defvar doom-env-executable (defun doom-cli-reload-env-file (&optional force-p env-file)
(if IS-WINDOWS
"set"
(executable-find "env"))
"The program to use to scrape your shell environment with.
It is rare that you'll need to change this.")
(defvar doom-env-switches
(if IS-WINDOWS
"-c"
"-ic") ; Execute in an interactive shell
"The `shell-command-switch'es to use on `doom-env-executable'.
This is a list of strings. Each entry is run separately and in sequence with
`doom-env-executable' to scrape envvars from your shell environment.")
(defun doom-reload-env-file (&optional force-p env-file)
"Generates `doom-env-file', if it doesn't exist (or if FORCE-P). "Generates `doom-env-file', if it doesn't exist (or if FORCE-P).
This scrapes the variables from your shell environment by running This scrapes the variables from your shell environment by running
@ -99,49 +94,37 @@ default, on Linux, this is '$SHELL -ic /usr/bin/env'. Variables in
"Generating") "Generating")
(path env-file)) (path env-file))
(let ((process-environment doom--initial-process-environment)) (let ((process-environment doom--initial-process-environment))
(let ((shell-command-switch doom-env-switches) (print! (info "Scraping shell environment"))
(error-buffer (get-buffer-create "*env errors*")))
(print! (info "Scraping shell environment with '%s %s %s'")
(filename shell-file-name)
shell-command-switch
(filename doom-env-executable))
(save-excursion
(shell-command doom-env-executable (current-buffer) error-buffer))
(print-group! (print-group!
(let ((errors (with-current-buffer error-buffer (buffer-string)))) (when doom-interactive-mode
(unless (string-empty-p errors) (user-error "'doom env' must be run on the command line, not an interactive session"))
(print! (info "Warnings:\n\n%s") (indent 4 errors)))) (goto-char (point-min))
;; Remove undesireable variables
(insert (insert
(concat (concat
"# -*- mode: dotenv -*-\n" "# -*- mode: dotenv -*-\n"
(format "# Generated with: %s %s %s\n" (format "# Generated from a %s shell environent\n" shell-file-name)
shell-file-name
doom-env-switches
doom-env-executable)
"# ---------------------------------------------------------------------------\n" "# ---------------------------------------------------------------------------\n"
"# This file was auto-generated by `doom env'. It contains a list of environment\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" "# variables scraped from your default shell (excluding variables blacklisted\n"
"# in doom-env-ignored-vars).\n" "# in doom-env-ignored-vars).\n"
"#\n" "#\n"
"# It is NOT safe to edit this file. Changes will be overwritten next time that\n" (if (file-equal-p env-file doom-env-file)
"# `doom refresh` is executed. Alternatively, create your own env file with\n" (concat "# It is NOT safe to edit this file. Changes will be overwritten next time you\n"
"# `doom env -o ~/.doom.d/myenv`, then load it with (doom-load-envvars-file FILE)\n" "# run 'doom refresh'. To create a safe-to-edit envvar file use:\n#\n"
"# in your private config.el.\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\n")) "# ---------------------------------------------------------------------------\n\n"))
(goto-char (point-min)) ;; We assume that this noninteractive session was spawned from the
(while (re-search-forward "\n\\([^= \n]+\\)=" nil t) ;; user's interactive shell, therefore we just dump
(save-excursion ;; `process-environment' to a file.
(let* ((valend (or (save-match-data (dolist (env process-environment)
(when (re-search-forward "^\\([^= ]+\\)=" nil t) (if (cl-find-if (doom-rpartial #'string-match-p env)
(line-beginning-position))) doom-env-ignored-vars)
(point-max))) (print! (info "Ignoring %s") env)
(var (match-string 1))) (insert env "\n")))
(when (cl-loop for regexp in doom-env-ignored-vars
if (string-match-p regexp var)
return t)
(print! (info "Ignoring %s") var)
(delete-region (match-beginning 0) (1- valend)))))))
(print! (success "Successfully generated %S") (print! (success "Successfully generated %S")
(path env-file)) (path env-file))
t)))))) t))))))

101
core/cli/help.el Normal file
View file

@ -0,0 +1,101 @@
;;; core/cli/help.el -*- lexical-binding: t; -*-
(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)))))
" ")
"")))
(defun doom--cli-print-desc (cli &optional short)
(print! "%s"
(if short
(car (split-string (doom-cli-desc cli) "\n"))
(doom-cli-desc cli))))
(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 flags = (doom-cli-option-flags opt)
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))
;;
;;; 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 :main))
(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)))))

58
core/cli/install.el
View file

@ -1,13 +1,11 @@
;;; core/cli/install.el -*- lexical-binding: t; -*- ;;; core/cli/install.el -*- lexical-binding: t; -*-
(defcli! quickstart (&rest args) ; DEPRECATED (defcli! (install i)
"This is a deprecated alias for 'doom install'. ((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')")
See 'doom help install' instead." (noinstall-p ["--no-install"] "Don't auto-install packages")
:hidden t (nofonts-p ["--no-fonts"] "Don't install (or prompt to install) all-the-icons fonts")
(apply #'doom-cli-install args)) &rest args)
(defcli! (install i) (&rest args)
"Installs and sets up Doom Emacs for the first time. "Installs and sets up Doom Emacs for the first time.
This command does the following: This command does the following:
@ -25,23 +23,17 @@ The location of DOOMDIR can be changed with the -p option, or by setting the
DOOMDIR environment variable. e.g. DOOMDIR environment variable. e.g.
doom -p ~/.config/doom install doom -p ~/.config/doom install
DOOMDIR=~/.config/doom doom install DOOMDIR=~/.config/doom doom install"
:bare t
The following switches are recognized:
--no-config Don't create DOOMDIR or dummy files therein
--no-install Don't auto-install packages
--no-env Don't generate an envvars file (see `doom help env`)
--no-fonts Don't install (or prompt to install) all-the-icons fonts
-y / --yes Auto-accept any confirmation prompts"
(print! (green "Installing Doom Emacs!\n")) (print! (green "Installing Doom Emacs!\n"))
(let ((default-directory (doom-path "~"))) (let ((default-directory (doom-path "~")))
;; Create `doom-private-dir' ;; Create `doom-private-dir'
(if (member "--no-config" args) (if noconfig-p
(print! (warn "Not copying private config template, as requested")) (print! (warn "Not copying private config template, as requested"))
(print! "> Creating %s" (relpath doom-private-dir)) (print! (start "Creating %s") (relpath doom-private-dir))
(make-directory doom-private-dir 'parents) (make-directory doom-private-dir 'parents)
(print! (success "Created %s") (relpath doom-private-dir)) (print-group!
(print! (success "Created %s") (relpath doom-private-dir)))
;; Create init.el, config.el & packages.el ;; Create init.el, config.el & packages.el
(mapc (lambda (file) (mapc (lambda (file)
@ -71,26 +63,29 @@ The following switches are recognized:
;; In case no init.el was present the first time `doom-initialize-modules' was ;; In case no init.el was present the first time `doom-initialize-modules' was
;; called in core.el (e.g. on first install) ;; called in core.el (e.g. on first install)
(doom-initialize-packages 'force-p) (doom-initialize 'force)
(doom-initialize-modules)
;; Ask if Emacs.app should be patched ;; Ask if user would like an envvar file generated
(if (member "--no-env" args) (if noenv-p
(print! (warn "- Not generating envvars file, as requested")) (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 (when (or doom-auto-accept
(y-or-n-p "Generate an env file? (see `doom help env` for details)")) (y-or-n-p "Generate an env file? (see `doom help env` for details)"))
(doom-reload-env-file 'force-p))) (doom-cli-reload-env-file 'force-p))))
;; Install Doom packages ;; Install Doom packages
(if (member "--no-install" args) (if noinstall-p
(print! (warn "- Not installing plugins, as requested")) (print! (warn "Not installing plugins, as requested"))
(print! "Installing plugins") (print! "Installing plugins")
(doom-packages-install doom-auto-accept)) (doom-cli-packages-install doom-auto-accept))
(print! "Regenerating autoloads files") (print! "Regenerating autoloads files")
(doom-reload-autoloads nil 'force-p) (doom-reload-autoloads nil 'force-p)
(if (member "--no-fonts" args) (if nofonts-p
(print! (warn "- Not installing fonts, as requested")) (print! (warn "Not installing fonts, as requested"))
(when (or doom-auto-accept (when (or doom-auto-accept
(y-or-n-p "Download and install all-the-icon's fonts?")) (y-or-n-p "Download and install all-the-icon's fonts?"))
(require 'all-the-icons) (require 'all-the-icons)
@ -98,6 +93,9 @@ The following switches are recognized:
(IS-LINUX 'x)))) (IS-LINUX 'x))))
(all-the-icons-install-fonts 'yes)))) (all-the-icons-install-fonts 'yes))))
(when (file-exists-p "~/.emacs")
(print! (warn "A ~/.emacs file was detected. This conflicts with Doom and should be deleted!")))
(print! (success "\nFinished! Doom is ready to go!\n")) (print! (success "\nFinished! Doom is ready to go!\n"))
(with-temp-buffer (with-temp-buffer
(doom-template-insert "QUICKSTART_INTRO") (doom-template-insert "QUICKSTART_INTRO")

448
core/cli/packages.el
View file

@ -1,73 +1,55 @@
;; -*- no-byte-compile: t; -*- ;; -*- no-byte-compile: t; -*-
;;; core/cli/packages.el ;;; core/cli/packages.el
(defmacro doom--ensure-autoloads-while (&rest body) (defcli! (update u) ()
`(progn
(straight-check-all)
(doom-reload-core-autoloads)
(when (progn ,@body)
(doom-reload-package-autoloads 'force-p))
t))
;;
;;; Dispatchers
(defcli! (update u) (&rest args)
"Updates packages. "Updates packages.
This works by fetching all installed package repos and checking the distance This works by fetching all installed package repos and checking the distance
between HEAD and FETCH_HEAD. This can take a while. between HEAD and FETCH_HEAD. This can take a while.
This excludes packages whose `package!' declaration contains a non-nil :freeze This excludes packages whose `package!' declaration contains a non-nil :freeze
or :ignore property. or :ignore property."
(straight-check-all)
(doom-cli-reload-core-autoloads)
(when (doom-cli-packages-update)
(doom-cli-reload-package-autoloads 'force-p))
t)
Switches: (defcli! (build b)
-t/--timeout TTL Seconds until a thread is timed out (default: 45) ((rebuild-p ["-r"] "Only rebuild packages that need rebuilding"))
--threads N How many threads to use (default: 8)" "Byte-compiles & symlinks installed packages.
(doom--ensure-autoloads-while
(doom-packages-update
doom-auto-accept
(when-let (threads (cadr (member "--threads" args)))
(string-to-number threads))
(when-let (timeout (cadr (or (member "--timeout" args)
(member "-t" args))))
(string-to-number timeout)))))
(defcli! (rebuild build b) (&rest args)
"Rebuilds all installed packages.
This ensures that all needed files are symlinked from their package repo and This ensures that all needed files are symlinked from their package repo and
their elisp files are byte-compiled. 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))
(doom-cli-reload-package-autoloads 'force-p))
t)
Switches: (defcli! (purge p)
-f Forcibly rebuild autoloads files, even if they're up-to-date" ((nobuilds-p ["-b" "--no-builds"] "Don't purge unneeded (built) packages")
(doom--ensure-autoloads-while (noelpa-p ["-p" "--no-elpa"] "Don't purge ELPA packages")
(doom-packages-rebuild doom-auto-accept (member "-f" args)))) (norepos-p ["-r" "--no-repos"] "Don't purge unused straight repos")
(regraft-p ["-g" "--regraft"] "Regraft git repos (ie. compact them)"))
"Deletes orphaned packages & repos, and compacts them.
(defcli! (purge p) (&rest args) Purges all installed ELPA packages (as they are considered temporary). Purges
"Deletes any unused ELPA packages, straight builds, and (optionally) repos. all orphaned package repos and builds. If -g/--regraft is supplied, the git
repos among them will be regrafted and compacted to ensure they are as small as
possible.
By default, this does not purge ELPA packages or repos. It is a good idea to run It is a good idea to occasionally run this doom purge -g to ensure your package
'doom purge --all' once in a while, to stymy build-up of repos and ELPA list remains lean."
packages that could be taking up precious space. (straight-check-all)
(when (doom-cli-packages-purge
(not noelpa-p)
(not norepos-p)
(not nobuilds-p)
regraft-p)
(doom-cli-reload-package-autoloads 'force-p))
t)
Switches: ;; (defcli! rollback () ; TODO doom rollback
--no-builds Don't purge unneeded (built) packages
-e / --elpa Don't purge ELPA packages
-r / --repos Purge unused repos
--all Purge builds, elpa packages and repos"
(doom--ensure-autoloads-while
(doom-packages-purge (or (member "-e" args)
(member "--elpa" args)
(member "--all" args))
(not (member "--no-builds" args))
(or (member "-r" args)
(member "--repos" args)
(member "--all" args))
doom-auto-accept)))
;; (defcli! rollback () ; TODO rollback
;; "<Not implemented yet>" ;; "<Not implemented yet>"
;; (user-error "Not implemented yet, sorry!")) ;; (user-error "Not implemented yet, sorry!"))
@ -75,15 +57,12 @@ Switches:
;; ;;
;;; Library ;;; Library
(defun doom-packages-install (&optional auto-accept-p) (defun doom-cli-packages-install ()
"Installs missing packages. "Installs missing packages.
This function will install any primary package (i.e. a package with a `package!' This function will install any primary package (i.e. a package with a `package!'
declaration) or dependency thereof that hasn't already been. declaration) or dependency thereof that hasn't already been."
(print! (start "Installing & building packages..."))
Unless AUTO-ACCEPT-P is non-nil, this function will prompt for confirmation with
a list of packages that will be installed."
(print! "> Installing & building packages...")
(print-group! (print-group!
(let ((n 0)) (let ((n 0))
(dolist (package (hash-table-keys straight--recipe-cache)) (dolist (package (hash-table-keys straight--recipe-cache))
@ -91,7 +70,7 @@ a list of packages that will be installed."
(local-repo) (local-repo)
(let ((existed-p (file-directory-p (straight--repos-dir package)))) (let ((existed-p (file-directory-p (straight--repos-dir package))))
(condition-case-unless-debug e (condition-case-unless-debug e
(and (straight-use-package (intern package) nil nil " ") (and (straight-use-package (intern package) nil nil (make-string (1- (or doom-format-indent 1)) 32))
(not existed-p) (not existed-p)
(file-directory-p (straight--repos-dir package)) (file-directory-p (straight--repos-dir package))
(cl-incf n)) (cl-incf n))
@ -104,17 +83,18 @@ a list of packages that will be installed."
t)))) t))))
(defun doom-packages-rebuild (&optional auto-accept-p all) (defun doom-cli-packages-build (&optional force-p)
"(Re)build all packages." "(Re)build all packages."
(print! (start "(Re)building %spackages...") (if all "all " "")) (print! (start "(Re)building %spackages...") (if force-p "all " ""))
(print-group! (print-group!
(let ((n 0)) (let ((n 0))
(if all (if force-p
(let ((straight--packages-to-rebuild :all) (let ((straight--packages-to-rebuild :all)
(straight--packages-not-to-rebuild (make-hash-table :test #'equal))) (straight--packages-not-to-rebuild (make-hash-table :test #'equal)))
(dolist (package (hash-table-keys straight--recipe-cache)) (dolist (package (hash-table-keys straight--recipe-cache))
(straight-use-package (straight-use-package
(intern package) nil (lambda (_) (cl-incf n) nil) " "))) (intern package) nil (lambda (_) (cl-incf n) nil)
(make-string (1- (or doom-format-indent 1)) 32))))
(dolist (recipe (hash-table-values straight--recipe-cache)) (dolist (recipe (hash-table-values straight--recipe-cache))
(straight--with-plist recipe (package local-repo no-build) (straight--with-plist recipe (package local-repo no-build)
(unless (or no-build (null local-repo)) (unless (or no-build (null local-repo))
@ -139,7 +119,9 @@ a list of packages that will be installed."
(lambda (&rest _) (cl-incf n))) (lambda (&rest _) (cl-incf n)))
(let ((straight--packages-to-rebuild :all) (let ((straight--packages-to-rebuild :all)
(straight--packages-not-to-rebuild (make-hash-table :test #'equal))) (straight--packages-not-to-rebuild (make-hash-table :test #'equal)))
(straight-use-package (intern package) nil nil " ")) (straight-use-package
(intern package) nil nil
(make-string (or doom-format-indent 0) 32)))
(straight--byte-compile-package recipe) (straight--byte-compile-package recipe)
(dolist (dep (straight--get-dependencies package)) (dolist (dep (straight--get-dependencies package))
(when-let (recipe (gethash dep straight--recipe-cache)) (when-let (recipe (gethash dep straight--recipe-cache))
@ -151,268 +133,107 @@ a list of packages that will be installed."
t)))) t))))
(defun doom--packages-remove-outdated-f (packages) (defun doom-cli-packages-update ()
(async-start "Updates packages."
`(lambda () (print! (start "Updating packages (this may take a while)..."))
(setq load-path ',load-path
doom-modules ',doom-modules
user-emacs-directory ',user-emacs-directory)
(condition-case e
(let (packages errors)
(load ,(concat doom-core-dir "core.el"))
(doom-initialize 'force)
(dolist (recipe ',group)
(when (straight--repository-is-available-p recipe)
(straight-vc-git--destructure recipe
(package local-repo nonrecursive upstream-remote upstream-repo upstream-host branch)
(condition-case e
(let ((default-directory (straight--repos-dir local-repo)))
;; HACK We normalize packages to avoid certain scenarios
;; where `straight-fetch-package' will create an
;; interactive popup prompting for action (which will
;; cause this async process to block indefinitely). We
;; can't use `straight-normalize-package' because could
;; create popup prompts too, so we do it manually:
(shell-command-to-string "git merge --abort")
(straight--get-call "git" "reset" "--hard" branch)
(straight--get-call "git" "clean" "-ffd")
(unless nonrecursive
(shell-command-to-string "git submodule update --init --recursive"))
(when upstream-repo
(let ((desired-url (straight-vc-git--encode-url upstream-repo upstream-host))
(actual-url (condition-case nil
(straight--get-call "git" "remote" "get-url" upstream-remote)
(error nil))))
(unless (straight-vc-git--urls-compatible-p actual-url desired-url)
(straight--get-call "git" "remote" "remove" upstream-remote)
(straight--get-call "git" "remote" "add" upstream-remote desired-url)
(straight--get-call "git" "fetch" upstream-remote))))
(straight-fetch-package package)
;; REVIEW Is there no better way to get this information?
(let ((n (length
(split-string
(straight--get-call "git" "rev-list" "--left-right" "HEAD..@{u}")
"\n" t)))
(pretime
(string-to-number
(shell-command-to-string "git log -1 --format=%at HEAD")))
(time
(string-to-number
;; HACK `straight--get-call' has a higher failure
;; rate when querying FETCH_HEAD; not sure why.
;; Doing this manually, with
;; `shell-command-to-string' works fine.
(shell-command-to-string "git log -1 --format=%at FETCH_HEAD"))))
(with-current-buffer (straight--process-get-buffer)
(with-silent-modifications
(print! (debug (autofill "%s") (indent 2 (buffer-string))))
(erase-buffer)))
(when (> n 0)
(push (list n pretime time recipe)
packages))))
(error
(push (list package e (string-trim (or (straight--process-get-output) "")))
errors))))))
(if errors
(cons 'error errors)
(cons 'ok (nreverse packages))))
(error
(cons 'error e))))))
(defun doom-packages-update (&optional auto-accept-p threads timeout)
"Updates packages.
Unless AUTO-ACCEPT-P is non-nil, this function will prompt for confirmation with
a list of packages that will be updated."
(print! (start "Scanning for outdated packages (this may take a while)..."))
(print-group!
(when timeout
(print! (info "Using %S as timeout value" timeout)))
(when threads
(print! (info "Limiting to %d thread(s)" threads)))
;; REVIEW Does this fail gracefully enough? Is it error tolerant?
;; TODO Add version-lock checks; don't want to spend all this effort on
;; packages that shouldn't be updated
(let* ((futures
;; REVIEW We can do better "thread" management here
(or (cl-loop for group
in (seq-partition (hash-table-values straight--repo-cache)
(/ (hash-table-count straight--repo-cache)
(or threads 8)))
for future = (doom--packages-remove-outdated-f group)
if (processp future)
collect (cons future group)
else
do (print! (warn "Failed to create thread for:\n\n%s\n\nReason: %s"
group future)))
(error! "Failed to create any threads")))
(total (length futures))
(timeout (or timeout 45)))
(condition-case-unless-debug e
(let (specs)
(while futures
(print! ". %.0f%%" (* (/ (- total (length futures))
(float total))
100))
(let ((time 0))
(catch 'timeout
(while (not (async-ready (caar futures)))
(when (> time timeout)
(print! (warn "A thread has timed out. The following packages were skipped: %s"
(mapconcat (lambda (p) (plist-get p :package))
(cdar futures)
", ")))
(throw 'timeout (pop futures)))
(sleep-for 1)
(when (cl-evenp time)
(print! "."))
(cl-incf time))
(cl-destructuring-bind (status . result)
(or (async-get (car (pop futures)))
(cons nil nil))
(cond ((null status)
(error "Thread returned an invalid result: %S" errors))
((eq status 'error)
(error "There were errors:\n\n%s"
(cond ((and (listp result)
(symbolp (car result)))
(prin1-to-string result))
((stringp result)
result)
((mapconcat (lambda (e)
(format! " - %s: %s" (yellow (car e)) (cdr e)))
result
"\n")))))
((eq status 'ok)
(print! (debug "Appended %S to package list") (or result "nothing"))
(appendq! specs result))
((error "Thread returned a non-standard status: %s\n\n%s"
status result)))))))
(print! ". 100%%")
(terpri)
(if-let (specs (delq nil specs))
(if (not
(or auto-accept-p
(y-or-n-p
(format!
"%s\n\nThere %s %d package%s available to update. Update them?"
(mapconcat
(lambda (spec)
(cl-destructuring-bind (n pretime time recipe) spec
(straight--with-plist recipe (package)
(format! "+ %-33s %s commit(s) behind %s -> %s"
(yellow package) (yellow n)
(format-time-string "%Y%m%d" pretime)
(format-time-string "%Y%m%d" time)))))
specs
"\n")
(if (cdr specs) "are" "is")
(length specs)
(if (cdr specs) "s" "")))))
(ignore (print! (info "Aborted update")))
(terpri)
(straight--make-package-modifications-available)
(let ((straight--packages-to-rebuild (make-hash-table :test #'equal)) (let ((straight--packages-to-rebuild (make-hash-table :test #'equal))
(straight--packages-not-to-rebuild (make-hash-table :test #'equal))) (total (hash-table-count straight--repo-cache))
(dolist (spec specs) (i 1)
(cl-destructuring-bind (n pretime time recipe) spec errors)
(straight--with-plist recipe (local-repo package) (print-group!
(let ((default-directory (straight--repos-dir local-repo))) (dolist (recipe (hash-table-values straight--repo-cache))
(print! (start "Updating %S") package) (straight--with-plist recipe (package type local-repo)
(condition-case-unless-debug e
(let* ((default-directory (straight--repos-dir local-repo))
(commit (straight-vc-get-commit type local-repo)))
(if (not (straight-vc-fetch-from-remote recipe))
(print! (warn "(%d/%d) Failed to fetch %s" i total package))
(let ((output (straight--process-get-output)))
(straight-merge-package package) (straight-merge-package package)
;; HACK `straight-rebuild-package' doesn't pick up that (let ((newcommit (straight-vc-get-commit type local-repo)))
;; this package has changed, so we do it manually. Is (if (string= commit newcommit)
;; there a better way? (print! (info "(%d/%d) %s is up-to-date") i total package)
(ignore-errors (ignore-errors
(delete-directory (straight--build-dir package) 'recursive)) (delete-directory (straight--build-dir package) 'recursive))
(puthash package t straight--packages-to-rebuild) (puthash package t straight--packages-to-rebuild)
(cl-incf n)) (print! (success "(%d/%d) %s updated (%s -> %s)") i total package
(with-current-buffer (straight--process-get-buffer) (substring commit 0 7)
(with-silent-modifications (substring newcommit 0 7))
(print! (debug (autofill "%s") (indent 2 (buffer-string)))) (unless (string-empty-p output)
(erase-buffer)))))) (print-group!
(doom--finalize-straight) (print! (info "%s") output)
(doom-packages-rebuild auto-accept-p)) (when (eq type 'git)
t) (straight--call "git" "log" "--oneline" newcommit (concat "^" commit))
(print! (success "No packages to update")) (print-group!
nil)) (print! "%s" (straight--process-get-output))))))))))
(cl-incf i))
(user-error
(signal 'user-error (error-message-string e)))
(error (error
(message "Output:\n%s" (straight--process-get-output)) (print! (warn "(%d/%d) Encountered error with %s" i total package))
(signal (car e) (error-message-string e))))))) (print-group!
(print! (error "%s" e))
(print-group! (print! (info "%s" (straight--process-get-output)))))
(push package errors)))))
(when errors
(print! (error "There were %d errors, the offending packages are: %s")
(length errors) (string-join errors ", ")))
(if (hash-table-empty-p straight--packages-to-rebuild)
(ignore
(print! (success "All %d packages are up-to-date")
(hash-table-count straight--repo-cache)))
(let ((count (hash-table-count straight--packages-to-rebuild))
(packages (hash-table-keys straight--packages-to-rebuild)))
(sort packages #'string-lessp)
(doom--finalize-straight)
(doom-cli-packages-build)
(print! (success "Updated %d package(s)") count))
t))))
;;; PURGE (for the emperor) ;;; PURGE (for the emperor)
(defun doom--prompt-p (list-fn list preamble postamble) (defun doom--cli-packages-purge-build (build)
(or (y-or-n-p (format "%s%s\n\n%s"
(if preamble (concat preamble "\n\n") "")
(mapconcat list-fn list "\n")
(or postamble "")))
(user-error! "Aborted")))
(defun doom--prompt-columns-p (row-fn list preamble postamble)
(doom--prompt-p (lambda (row)
(mapconcat row-fn row ""))
(seq-partition (cl-sort (copy-sequence list) #'string-lessp)
3)
preamble
postamble))
(defun doom--packages-purge-build (build)
(let ((build-dir (straight--build-dir build))) (let ((build-dir (straight--build-dir build)))
(print! (start "Purging build/%s..." build))
(delete-directory build-dir 'recursive) (delete-directory build-dir 'recursive)
(if (file-directory-p build-dir) (if (file-directory-p build-dir)
(ignore (print! (error "Failed to purg build/%s" build))) (ignore (print! (error "Failed to purg build/%s" build)))
(print! (success "Purged build/%s" build)) (print! (success "Purged build/%s" build))
t))) t)))
(defun doom--packages-purge-builds (builds &optional auto-accept-p) (defun doom--cli-packages-purge-builds (builds)
(if (not builds) (if (not builds)
(progn (print! (info "No builds to purge")) (progn (print! (info "No builds to purge"))
0) 0)
(or auto-accept-p
(doom--prompt-columns-p
(lambda (p) (format " + %-20.20s" p)) builds nil
(format! "Found %d orphaned package builds. Purge them?"
(length builds))))
(length (length
(delq nil (mapcar #'doom--packages-purge-build builds))))) (delq nil (mapcar #'doom--cli-packages-purge-build builds)))))
(defun doom--packages-regraft-repo (repo) (defun doom--cli-packages-regraft-repo (repo)
(let ((default-directory (straight--repos-dir repo))) (let ((default-directory (straight--repos-dir repo)))
(if (not (file-directory-p ".git")) (if (not (file-directory-p ".git"))
(ignore (print! (warn "repos/%s is not a git repo, skipping" repo))) (ignore (print! (warn "repos/%s is not a git repo, skipping" repo)))
(print! (debug "Regrafting repos/%s..." repo)) (let ((before-size (doom-directory-size default-directory)))
(straight--call "git" "reset" "--hard") (straight--call "git" "reset" "--hard")
(straight--call "git" "clean" "--ffd") (straight--call "git" "clean" "-ffd")
(straight--call "git" "replace" "--graft" "HEAD") (if (not (car (straight--call "git" "replace" "--graft" "HEAD")))
(print! (info "repos/%s is already compact" repo))
(straight--call "git" "gc") (straight--call "git" "gc")
(print! (debug "%s" (straight--process-get-output))) (print! (success "Regrafted repos/%s (from %0.1fKB to %0.1fKB)")
(print! (success "Regrafted repos/%s" repo)) repo before-size (doom-directory-size default-directory))
(print-group! (print! "%s" (straight--process-get-output)))))
t))) t)))
(defun doom--packages-regraft-repos (repos &optional auto-accept-p) (defun doom--cli-packages-regraft-repos (repos)
(if (not repos) (if (not repos)
(progn (print! (info "No repos to regraft")) (progn (print! (info "No repos to regraft"))
0) 0)
(or auto-accept-p (let ((before-size (doom-directory-size (straight--repos-dir))))
(y-or-n-p (format! "Preparing to regraft all %d repos. Continue?" (prog1 (print-group! (delq nil (mapcar #'doom--cli-packages-regraft-repo repos)))
(length repos))) (let ((after-size (doom-directory-size (straight--repos-dir))))
(user-error! "Aborted!")) (print! (success "Finished regrafting. Size before: %0.1fKB and after: %0.1fKB (-%0.1fKB)")
(if (executable-find "du") before-size after-size
(cl-destructuring-bind (status . size) (- after-size before-size)))))))
(doom-sh "du" "-sh" (straight--repos-dir))
(prog1 (delq nil (mapcar #'doom--packages-regraft-repo repos))
(cl-destructuring-bind (status . newsize)
(doom-sh "du" "-sh" (straight--repos-dir))
(print! (success "Finshed regrafted. Size before: %s and after: %s"
(car (split-string size "\t"))
(car (split-string newsize "\t")))))))
(delq nil (mapcar #'doom--packages-regraft-repo repos)))))
(defun doom--packages-purge-repo (repo) (defun doom--cli-packages-purge-repo (repo)
(print! (debug "Purging repos/%s..." repo))
(let ((repo-dir (straight--repos-dir repo))) (let ((repo-dir (straight--repos-dir repo)))
(delete-directory repo-dir 'recursive) (delete-directory repo-dir 'recursive)
(ignore-errors (ignore-errors
@ -422,19 +243,14 @@ a list of packages that will be updated."
(print! (success "Purged repos/%s" repo)) (print! (success "Purged repos/%s" repo))
t))) t)))
(defun doom--packages-purge-repos (repos &optional auto-accept-p) (defun doom--cli-packages-purge-repos (repos)
(if (not repos) (if (not repos)
(progn (print! (info "No repos to purge")) (progn (print! (info "No repos to purge"))
0) 0)
(or auto-accept-p
(doom--prompt-columns-p
(lambda (p) (format " + %-20.20s" p)) repos nil
(format! "Found %d orphaned repos. Purge them?"
(length repos))))
(length (length
(delq nil (mapcar #'doom--packages-purge-repo repos))))) (delq nil (mapcar #'doom--cli-packages-purge-repo repos)))))
(defun doom--packages-purge-elpa (&optional auto-accept-p) (defun doom--cli-packages-purge-elpa ()
(unless (bound-and-true-p package--initialized) (unless (bound-and-true-p package--initialized)
(package-initialize)) (package-initialize))
(let ((packages (cl-loop for (package desc) in package-alist (let ((packages (cl-loop for (package desc) in package-alist
@ -444,16 +260,11 @@ a list of packages that will be updated."
(if (not package-alist) (if (not package-alist)
(progn (print! (info "No ELPA packages to purge")) (progn (print! (info "No ELPA packages to purge"))
0) 0)
(doom--prompt-columns-p
(lambda (p) (format " + %-20.20s" p))
(mapcar #'car packages) nil
(format! "Found %d orphaned ELPA packages. Purge them?"
(length package-alist)))
(mapc (doom-rpartial #'delete-directory 'recursive) (mapc (doom-rpartial #'delete-directory 'recursive)
(mapcar #'cdr packages)) (mapcar #'cdr packages))
(length packages)))) (length packages))))
(defun doom-packages-purge (&optional elpa-p builds-p repos-p auto-accept-p) (defun doom-cli-packages-purge (&optional elpa-p builds-p repos-p regraft-repos-p)
"Auto-removes orphaned packages and repos. "Auto-removes orphaned packages and repos.
An orphaned package is a package that isn't a primary package (i.e. doesn't have An orphaned package is a package that isn't a primary package (i.e. doesn't have
@ -461,10 +272,7 @@ a `package!' declaration) or isn't depended on by another primary package.
If BUILDS-P, include straight package builds. If BUILDS-P, include straight package builds.
If REPOS-P, include straight repos. If REPOS-P, include straight repos.
If ELPA-P, include packages installed with package.el (M-x package-install). If ELPA-P, include packages installed with package.el (M-x package-install)."
Unless AUTO-ACCEPT-P is non-nil, this function will prompt for confirmation with
a list of packages that will be removed."
(print! (start "Searching for orphaned packages to purge (for the emperor)...")) (print! (start "Searching for orphaned packages to purge (for the emperor)..."))
(cl-destructuring-bind (&optional builds-to-purge repos-to-purge repos-to-regraft) (cl-destructuring-bind (&optional builds-to-purge repos-to-purge repos-to-regraft)
(let ((rdirs (straight--directory-files (straight--repos-dir) nil nil 'sort)) (let ((rdirs (straight--directory-files (straight--repos-dir) nil nil 'sort))
@ -479,18 +287,20 @@ a list of packages that will be removed."
(print-group! (print-group!
(if (not builds-p) (if (not builds-p)
(print! (info "Skipping builds")) (print! (info "Skipping builds"))
(and (/= 0 (doom--packages-purge-builds builds-to-purge auto-accept-p)) (and (/= 0 (doom--cli-packages-purge-builds builds-to-purge))
(setq success t) (setq success t)
(straight-prune-build-cache))) (straight-prune-build-cache)))
(if (not elpa-p) (if (not elpa-p)
(print! (info "Skipping elpa packages")) (print! (info "Skipping elpa packages"))
(and (/= 0 (doom--packages-purge-elpa auto-accept-p)) (and (/= 0 (doom--cli-packages-purge-elpa))
(setq success t))) (setq success t)))
(if (not repos-p) (if (not repos-p)
(print! (info "Skipping repos")) (print! (info "Skipping repos"))
(and (/= 0 (doom--packages-purge-repos repos-to-purge auto-accept-p)) (and (/= 0 (doom--cli-packages-purge-repos repos-to-purge))
(setq success t)) (setq success t)))
(and (doom--packages-regraft-repos repos-to-regraft auto-accept-p) (if (not regraft-repos-p)
(print! (info "Skipping regrafting"))
(and (doom--cli-packages-regraft-repos repos-to-regraft)
(setq success t))) (setq success t)))
(when success (when success
(doom--finalize-straight) (doom--finalize-straight)

91
core/cli/test.el
View file

@ -7,9 +7,13 @@
runemacs-binary-path runemacs-binary-path
emacs-binary-path))) emacs-binary-path)))
(defcli! test (&rest targets) (defcli! test (&rest targets)
"Run Doom unit tests." "Run Doom unit tests."
(let (files error) :bare t
(doom-initialize 'force)
(require 'ansi-color)
(let (files error read-files)
(unless targets (unless targets
(setq targets (setq targets
(cons doom-core-dir (cons doom-core-dir
@ -17,7 +21,7 @@
(lambda (path) (file-in-directory-p path doom-emacs-dir)) (lambda (path) (file-in-directory-p path doom-emacs-dir))
;; Omit `doom-private-dir', which is always first ;; Omit `doom-private-dir', which is always first
(let (doom-modules) (let (doom-modules)
(load! "test/init" doom-core-dir) (load (expand-file-name "test/init" doom-core-dir) nil t)
(cdr (doom-module-load-path))))))) (cdr (doom-module-load-path)))))))
(while targets (while targets
(let ((target (pop targets))) (let ((target (pop targets)))
@ -31,45 +35,70 @@
(push target files))))) (push target files)))))
(with-temp-buffer (with-temp-buffer
(print! (start "Bootstrapping test environment, if necessary...")) (print! (start "Bootstrapping test environment, if necessary..."))
(if (zerop (cl-destructuring-bind (status . output)
(call-process (doom-exec-process
(doom--emacs-binary) (doom--emacs-binary)
nil t nil "--batch" "--batch"
"--eval" (prin1-to-string "--eval"
(prin1-to-string
`(progn `(progn
(setq doom-emacs-dir ,doom-emacs-dir (setq doom-emacs-dir ,doom-emacs-dir
doom-local-dir ,(concat doom-local-dir "test/") doom-local-dir ,(concat doom-local-dir "test/")
doom-private-dir ,(concat doom-core-dir "test/")) doom-private-dir ,(concat doom-core-dir "test/")
doom-auto-accept t)
(require 'core ,(locate-library "core")) (require 'core ,(locate-library "core"))
(require 'core-cli)
(doom-initialize 'force) (doom-initialize 'force)
(doom-initialize-modules) (doom-initialize-modules)
(require 'core-cli) (doom-cli-reload-core-autoloads 'force)
(doom-reload-core-autoloads 'force) (when (doom-cli-packages-install)
(when (doom-packages-install 'auto-accept) (doom-cli-reload-package-autoloads 'force)))))
(doom-reload-package-autoloads 'force)))))) (unless (zerop status)
(message "%s" (buffer-string)) (error "Failed to bootstrap unit tests"))))
(message "%s" (buffer-string)) (with-temp-buffer
(error "Failed to bootstrap unit tests")))
(dolist (file files) (dolist (file files)
(if (doom-file-cookie-p file "if" t) (if (doom-file-cookie-p file "if" t)
(with-temp-buffer (cl-destructuring-bind (_status . output)
(unless (apply #'doom-exec-process
(zerop
(apply #'call-process
(doom--emacs-binary) (doom--emacs-binary)
nil t nil "--batch" "--batch"
(append (list "-l" (concat doom-core-dir "core.el")
"-L" doom-core-dir "-l" (concat doom-core-dir "test/helpers.el")
"-l" "core" (append (when (file-in-directory-p file doom-modules-dir)
"-l" (concat doom-core-dir "test/helpers.el"))
(when (file-in-directory-p file doom-modules-dir)
(list "-f" "doom-initialize-core")) (list "-f" "doom-initialize-core"))
(list (list "-l" file
"-l" file "-f" "buttercup-run")))
"-f" "buttercup-run")))) (insert (replace-regexp-in-string ansi-color-control-seq-regexp "" output))
(setq error t)) (push file read-files))
(message "%s" (buffer-string)))
(print! (info "Ignoring %s" (relpath file))))) (print! (info "Ignoring %s" (relpath file)))))
(if error (let ((total 0)
(user-error "A test failed") (total-failed 0)
(i 0))
(print! "\n----------------------------------------\nTests finished")
(print-group!
(goto-char (point-min))
(while (re-search-forward "^Ran \\([0-9]+\\) specs, \\([0-9]+\\) failed," nil t)
(let ((ran (string-to-number (match-string 1)))
(failed (string-to-number (match-string 2))))
(when (> failed 0)
(terpri)
(print! (warn "(%s) Failed %d/%d tests")
(path (nth i read-files))
failed ran)
(save-excursion
(print-group!
(print!
"%s" (string-trim
(buffer-substring
(match-beginning 0)
(dotimes (_ failed (point))
(search-backward "========================================"))))))))
(cl-incf total ran)
(cl-incf total-failed failed)
(cl-incf i))))
(terpri)
(if (= total-failed 0)
(print! (success "Ran %d tests successfully." total total-failed))
(print! (error "Ran %d tests, %d failed") total total-failed)
(kill-emacs 1)))
t))) t)))

31
core/cli/upgrade.el
View file

@ -1,6 +1,8 @@
;;; core/cli/upgrade.el -*- lexical-binding: t; -*- ;;; core/cli/upgrade.el -*- lexical-binding: t; -*-
(defcli! (upgrade up) (&rest args) (defcli! (upgrade up)
((force-p ["-f" "--force"])
&rest args)
"Updates Doom and packages. "Updates Doom and packages.
This requires that ~/.emacs.d is a git repo, and is the equivalent of the This requires that ~/.emacs.d is a git repo, and is the equivalent of the
@ -10,22 +12,10 @@ following shell commands:
git pull --rebase git pull --rebase
bin/doom clean bin/doom clean
bin/doom refresh bin/doom refresh
bin/doom update bin/doom update"
(and (doom-cli-upgrade doom-auto-accept force-p)
Switches: (doom-cli-packages-update)
-t/--timeout TTL Seconds until a thread is timed out (default: 45) (doom-cli-reload-package-autoloads 'force-p)))
--threads N How many threads to use (default: 8)"
(and (doom-upgrade doom-auto-accept
(or (member "-f" args)
(member "--force" args)))
(doom-packages-update
doom-auto-accept
(when-let (threads (cadr (member "--threads" args)))
(string-to-number threads))
(when-let (timeout (cadr (or (member "--timeout" args)
(member "-t" args))))
(string-to-number timeout)))
(doom-reload-package-autoloads 'force-p)))
;; ;;
@ -44,7 +34,7 @@ Switches:
(error "Failed to check working tree in %s" dir)))) (error "Failed to check working tree in %s" dir))))
(defun doom-upgrade (&optional auto-accept-p force-p) (defun doom-cli-upgrade (&optional auto-accept-p force-p)
"Upgrade Doom to the latest version non-destructively." "Upgrade Doom to the latest version non-destructively."
(require 'vc-git) (require 'vc-git)
(let ((default-directory doom-emacs-dir) (let ((default-directory doom-emacs-dir)
@ -110,9 +100,8 @@ Switches:
(equal (vc-git--rev-parse "HEAD") new-rev)) (equal (vc-git--rev-parse "HEAD") new-rev))
(error "Failed to check out %s" (substring new-rev 0 10))) (error "Failed to check out %s" (substring new-rev 0 10)))
(print! (success "Finished upgrading Doom Emacs"))) (print! (success "Finished upgrading Doom Emacs")))
(doom-delete-autoloads-file doom-autoload-file) (doom-cli-execute "refresh" (append (if auto-accept-p '("-y")) '("-f")))
(doom-delete-autoloads-file doom-package-autoload-file) (doom-cli-execute "update" (if auto-accept-p '("-y")))
(doom-cli-refresh "-f")
t) t)
(print! (success "Done! Restart Emacs for changes to take effect.")))))) (print! (success "Done! Restart Emacs for changes to take effect."))))))

342
core/core-cli.el
View file

@ -1,156 +1,219 @@
;;; -*- lexical-binding: t; no-byte-compile: t; -*- ;;; -*- lexical-binding: t; no-byte-compile: t; -*-
(require 'seq) (require 'map)
;; Eagerly load these libraries because we may be in a session that
;; hasn't been fully initialized (e.g. where autoloads files haven't
;; been generated or `load-path' populated).
(mapc (doom-rpartial #'load 'noerror 'nomessage)
(file-expand-wildcards (concat doom-core-dir "autoload/*.el")))
;;
;;; Variables
(defvar doom-auto-accept (getenv "YES") (defvar doom-auto-accept (getenv "YES")
"If non-nil, Doom will auto-accept any confirmation prompts during batch "If non-nil, Doom will auto-accept any confirmation prompts during batch
commands like `doom-packages-install', `doom-packages-update' and commands like `doom-cli-packages-install', `doom-cli-packages-update' and
`doom-packages-autoremove'.") `doom-packages-autoremove'.")
(defvar doom-cli-pre-execute-hook nil (defvar doom--cli-p nil)
"TODO")
(defvar doom-cli-post-success-execute-hook nil
"TODO")
(defvar doom--cli-commands (make-hash-table :test 'equal)) (defvar doom--cli-commands (make-hash-table :test 'equal))
(defvar doom--cli-groups (make-hash-table :test 'equal)) (defvar doom--cli-groups (make-hash-table :test 'equal))
(defvar doom--cli-group nil) (defvar doom--cli-group nil)
;; TODO Constructors for optlist, arglist and fn
(cl-defstruct doom-cli
(name)
(desc "TODO")
(aliases ())
(optlist ())
(arglist ())
(plist ())
(fn (lambda (_) (print! "But nobody came!"))))
;; (cl-defstruct doom-cli-option
;;; Dispatcher API (symbol)
(flags ())
(args ())
(desc "TODO"))
(defun doom-sh (command &rest args) (defun doom--cli-get-option (cli flag)
"Execute COMMAND with ARGS in the shell and return (STATUS . OUTPUT). (cl-find-if (doom-partial #'member flag)
(doom-cli-optlist cli)
:key #'doom-cli-option-flags))
STATUS is a boolean" (defun doom--cli-process (cli args)
(let ((output (get-buffer-create "*doom-sh-output*"))) (let* ((args (copy-sequence args))
(unwind-protect (arglist (copy-sequence (doom-cli-arglist cli)))
(cons (or (apply #'call-process command nil output nil args) (expected (or (cl-position-if (doom-rpartial #'memq cl--lambda-list-keywords)
-1) arglist)
(with-current-buffer output (length arglist)))
(string-trim (buffer-string)))) (got 0)
(kill-buffer output)))) 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))
(defun doom--dispatch-command (command) ((string-match "^\\(--\\([a-zA-Z0-9][a-zA-Z0-9-_]*\\)\\)\\(?:=\\(.+\\)\\)?$" arg)
(when (symbolp command) (let* ((fullflag (match-string 1 arg))
(setq command (symbol-name command))) (opt (doom--cli-get-option cli fullflag)))
(cl-check-type command string) (unless opt
(intern-soft (user-error "Unrecognized switch %S" (concat "--" (match-string 2 arg))))
(format "doom-cli-%s" (map-put
(if (gethash command doom--cli-commands) alist (doom-cli-option-symbol opt)
command (or (if (doom-cli-option-args opt)
(cl-loop for key (or (match-string 3 arg)
being the hash-keys in doom--cli-commands (pop args)
for aliases = (plist-get (gethash key doom--cli-commands) :aliases) (user-error "%S expected an argument, but got none"
if (member command aliases) fullflag))
return key))))) (if (match-string 3 arg)
(user-error "%S was not expecting an argument, but got %S"
fullflag (match-string 3 arg))
fullflag))))))
(defun doom--dispatch-format (desc &optional short) ((string-match "^\\(-\\([a-zA-Z0-9]+\\)\\)$" arg)
(with-temp-buffer (let ((fullflag (match-string 1 arg))
(let ((fill-column 72)) (flag (match-string 2 arg)))
(save-excursion (dolist (switch (split-string flag "" t))
(insert desc) (if-let (opt (doom--cli-get-option cli (concat "-" switch)))
(while (re-search-backward "\n\n[^ \n]" nil t) (map-put
(fill-paragraph)))) alist (doom-cli-option-symbol opt)
(if (not short) (if (doom-cli-option-args opt)
(buffer-string) (or (pop args)
(buffer-substring (line-beginning-position) (user-error "%S expected an argument, but got none"
(line-end-position))))) fullflag))
fullflag))
(user-error "Unrecognized switch %S" (concat "-" switch))))))
(defun doom--dispatch-help-1 (command) (arglist
(cl-destructuring-bind (&key aliases hidden _group) (cl-incf got)
(gethash command doom--cli-commands) (let ((spec (pop arglist)))
(unless hidden (when (eq spec '&optional)
(print! "%-11s\t%s\t%s" (setq spec (pop arglist)))
command (if aliases (string-join aliases ",") "") (map-put alist spec arg))
(doom--dispatch-format (when (null arglist)
(documentation (doom--dispatch-command command)) (throw 'done t)))
t)))))
(defun doom--dispatch-help (&optional fn &rest args) (t
"Display help documentation for a dispatcher command. If fn and DESC are (push arg args)
omitted, show all available commands, their aliases and brief descriptions." (throw 'done t))))))
(if fn (when (< got expected)
(princ (documentation fn)) (error "Expected %d arguments, got %d" expected got))
(print! (bold "%-11s\t%s\t%s" "Command:" "Alias" "Description")) (when rest
(print-group! (map-put alist restvar rest))
(dolist (group (seq-group-by (lambda (key) (plist-get (gethash key doom--cli-commands) :group)) alist))
(hash-table-keys doom--cli-commands)))
(if (null (car group))
(mapc #'doom--dispatch-help-1 (cdr group))
(print! "%-30s\t%s" (bold (car group)) (gethash (car group) doom--cli-groups))
(print-group!
(mapc #'doom--dispatch-help-1 (cdr group))))
(terpri)))))
(defun doom-dispatch (cmd args &optional show-help) (defun doom-cli-get (command)
"Parses ARGS and invokes a dispatcher. "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)))))
If SHOW-HELP is non-nil, show the documentation for said dispatcher." (defun doom-cli-internal-p (cli)
(when (equal cmd "help") "Return non-nil if CLI is an internal (non-public) command."
(setq show-help t) (string-prefix-p ":" (doom-cli-name cli)))
(when args
(setq cmd (car args) (defun doom-cli-execute (command &optional args)
args (cdr args)))) "Execute COMMAND (string) with ARGS (list of strings).
(let ((fn (doom--dispatch-command cmd)))
(unless (fboundp fn) Executes a cli defined with `defcli!' with the name or alias specified by
(user-error "%S is not any command *I* know!" cmd)) COMMAND, and passes ARGS to it."
(if show-help (if-let (cli (doom-cli-get command))
(doom--dispatch-help fn args) (funcall (doom-cli-fn cli)
(let ((start-time (current-time))) (doom--cli-process cli args))
(run-hooks 'doom-cli-pre-execute-hook) (user-error "Couldn't find any %S command" command)))
(unwind-protect
(when-let (ret (apply fn args)) (defmacro defcli! (name speclist &optional docstring &rest body)
(print! "Defines a CLI command.
"\n%s"
(success "Finished! (%.4fs)" COMMAND is a symbol or a list of symbols representing the aliases for this
(float-time command. DOCSTRING is a string description; its first line should be short
(time-subtract (current-time) (under 60 characters), as it will be used as a summary for 'doom help'.
start-time))))
(run-hooks 'doom-cli-post-execute-hook) SPECLIST is a specification for options and arguments, which can be a list
ret) specification for an option/switch in the following format:
(run-hooks 'doom-cli-post-error-execute-hook))))))
(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 :name (symbol-name name)
:desc ,docstring
:aliases (mapcar #'symbol-name aliases)
:arglist ',arglist
: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))
:plist plist
:fn
(lambda (--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--))))
,@(unless (plist-get plist :bare)
'((unless doom-init-p
(doom-initialize 'force)
(doom-initialize-modules))))
,@body)))
doom--cli-commands)
(when aliases
(mapc (doom-rpartial #'puthash name doom--cli-commands)
aliases)))))
(defmacro defcligroup! (name docstring &rest body) (defmacro defcligroup! (name docstring &rest body)
"TODO" "Declare all enclosed cli commands are part of the NAME group."
(declare (indent defun) (doc-string 2)) (declare (indent defun) (doc-string 2))
`(let ((doom--cli-group ,name)) `(let ((doom--cli-group ,name))
(puthash doom--cli-group ,docstring doom--cli-groups) (puthash doom--cli-group ,docstring doom--cli-groups)
,@body)) ,@body))
(defmacro defcli! (names arglist docstring &rest body)
"Define a dispatcher command. COMMAND is a symbol or a list of symbols
representing the aliases for this command. DESC is a string description. The
first line should be short (under 60 letters), as it will be displayed for
bin/doom help.
BODY will be run when this dispatcher is called."
(declare (indent defun) (doc-string 3))
(let* ((names (mapcar #'symbol-name (doom-enlist names)))
(fn (intern (format "doom-cli-%s" (car names))))
(plist (cl-loop while (keywordp (car body))
collect (pop body)
collect (pop body))))
(macroexp-progn
(reverse
`((let ((plist ',plist))
(setq plist (plist-put plist :aliases ',(cdr names)))
(unless (or (plist-member plist :group)
(null doom--cli-group))
(plist-put plist :group doom--cli-group))
(puthash ,(car names) plist doom--cli-commands))
(defun ,fn ,arglist
,docstring
,@body))))))
;; ;;
;;; Dispatch commands ;;; CLI Commands
;; Load all of our subcommands (load! "cli/help")
(defcli! (refresh re) (&rest args) (load! "cli/install")
(defcli! (refresh re)
((force-p ["-f" "--force"] "Regenerate autoloads files, whether or not they're stale")
&rest args)
"Ensure Doom is properly set up. "Ensure Doom is properly set up.
This is the equivalent of running autoremove, install, autoloads, then This is the equivalent of running autoremove, install, autoloads, then
@ -165,36 +228,25 @@ 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 installed, autoloads files are up-to-date and no byte-compiled files have gone
stale." stale."
(print! (green "Initiating a refresh of Doom Emacs...\n")) (print! (green "Initiating a refresh of Doom Emacs...\n"))
(let ((force-p (or (member "-f" args) (let (success)
(member "--force" args)))
success)
(when (file-exists-p doom-env-file) (when (file-exists-p doom-env-file)
(doom-reload-env-file 'force)) (doom-cli-reload-env-file 'force))
(doom-reload-core-autoloads force-p) (doom-cli-reload-core-autoloads force-p)
(unwind-protect (unwind-protect
(progn (progn
(and (doom-packages-install doom-auto-accept) (and (doom-cli-packages-install)
(setq success t)) (setq success t))
(and (doom-packages-rebuild doom-auto-accept) (and (doom-cli-packages-build)
(setq success t)) (setq success t))
(and (doom-packages-purge nil 'builds-p nil doom-auto-accept) (and (doom-cli-packages-purge nil 'builds-p nil)
(setq success t))) (setq success t)))
(doom-reload-package-autoloads (or success force-p)) (doom-cli-reload-package-autoloads (or success force-p))
(doom-byte-compile nil 'recompile)) (doom-cli-byte-compile nil 'recompile))
t)) t))
;; Load all of our subcommands
(load! "cli/install")
(defcligroup! "Diagnostics" (defcligroup! "Diagnostics"
"For troubleshooting and diagnostics" "For troubleshooting and diagnostics"
(defcli! (doctor doc) () (load! "cli/doctor")
"Checks for issues with your environment & Doom config.
Use the doctor to diagnose common problems or list missing dependencies in
enabled modules.")
(load! "cli/debug") (load! "cli/debug")
(load! "cli/test")) (load! "cli/test"))
@ -205,8 +257,8 @@ enabled modules.")
(load! "cli/packages") (load! "cli/packages")
(load! "cli/autoloads")) (load! "cli/autoloads"))
(defcligroup! "Byte compilation" (defcligroup! "Compilation"
"For byte-compiling Doom and your config" "For compiling Doom and your config"
(load! "cli/byte-compile")) (load! "cli/byte-compile"))
(defcligroup! "Utilities" (defcligroup! "Utilities"
@ -214,7 +266,7 @@ enabled modules.")
(defcli! run () (defcli! run ()
"Run Doom Emacs from bin/doom's parent directory. "Run Doom Emacs from bin/doom's parent directory.
All arguments are passed on to Emacs (except for -p and -e). All arguments are passed on to Emacs.
doom run doom run
doom run -nw init.el doom run -nw init.el

33
core/core.el
View file

@ -434,26 +434,27 @@ in interactive sessions, nil otherwise (but logs a warning)."
(if (not (file-readable-p file)) (if (not (file-readable-p file))
(unless noerror (unless noerror
(signal 'file-error (list "Couldn't read envvar file" file))) (signal 'file-error (list "Couldn't read envvar file" file)))
(let (vars) (let (environment)
(with-temp-buffer (with-temp-buffer
(insert-file-contents file)
(while (re-search-forward "\n *\\([^#][^= \n]+\\)=" nil t)
(save-excursion (save-excursion
(let ((var (string-trim-left (match-string 1))) (insert "\n")
(value (buffer-substring-no-properties (insert-file-contents file))
(point) (while (re-search-forward "\n *\\([^#][^= \n]+\\)=" nil t)
(1- (or (when (re-search-forward "^\\([^= ]+\\)=" nil t) (push (buffer-substring
(line-beginning-position)) (match-beginning 1)
(point-max)))))) (1- (or (save-excursion
(push (cons var value) vars) (when (re-search-forward "^\\([^= ]+\\)=" nil t)
(setenv var value))))) (line-beginning-position)))
(when vars (point-max))))
environment)))
(when environment
(setq-default (setq-default
process-environment environment
exec-path (append (parse-colon-path (getenv "PATH")) exec-path (append (parse-colon-path (getenv "PATH"))
(list exec-directory)) (list exec-directory))
shell-file-name (or (getenv "SHELL") shell-file-name (or (getenv "SHELL")
shell-file-name)) shell-file-name))
(nreverse vars))))) t))))
(defun doom-initialize (&optional force-p) (defun doom-initialize (&optional force-p)
"Bootstrap Doom, if it hasn't already (or if FORCE-P is non-nil). "Bootstrap Doom, if it hasn't already (or if FORCE-P is non-nil).
@ -523,12 +524,6 @@ to least)."
(require 'core-packages) (require 'core-packages)
(doom-initialize-packages))) (doom-initialize-packages)))
;; Eagerly load these libraries because we may be in a session that
;; hasn't been fully initialized (e.g. where autoloads files haven't
;; been generated or `load-path' populated).
(mapc (doom-rpartial #'load 'noerror 'nomessage)
(file-expand-wildcards (concat doom-core-dir "autoload/*.el")))
;; Create all our core directories to quell file errors ;; Create all our core directories to quell file errors
(dolist (dir (list doom-local-dir (dolist (dir (list doom-local-dir
doom-etc-dir doom-etc-dir

61
core/doctor.el
View file

@ -1,61 +0,0 @@
;;; core/doctor.el -*- lexical-binding: t; -*-
(defun file-size (file &optional dir)
(setq file (expand-file-name file dir))
(when (file-exists-p file)
(/ (nth 7 (file-attributes file))
1024.0)))
;; Check for oversized problem files in cache that may cause unusual/tremendous
;; delays or freezing. This shouldn't happen often.
(dolist (file (list "savehist"
"projectile.cache"))
(let* ((path (expand-file-name file doom-cache-dir))
(size (file-size path)))
(when (and (numberp size) (> size 2000))
(warn! "%s is too large (%.02fmb). This may cause freezes or odd startup delays"
(file-relative-name path doom-core-dir)
(/ size 1024))
(explain! "Consider deleting it from your system (manually)"))))
(unless (ignore-errors (executable-find doom-projectile-fd-binary))
(warn! "Couldn't find the `fd' binary; project file searches will be slightly slower")
(unless (executable-find "rg")
(warn! "Couldn't find the `rg' binary either; project file searches will be even slower")))
(let ((default-directory "~"))
(require 'projectile)
(when (cl-find-if #'projectile-file-exists-p projectile-project-root-files-bottom-up)
(warn! "Your $HOME is recognized as a project root")
(explain! "Doom will disable bottom-up root search, which may reduce the accuracy of project\n"
"detection.")))
;; There should only be one
(when (and (file-equal-p doom-private-dir "~/.config/doom")
(file-directory-p "~/.doom.d"))
(warn! "Both %S and '~/.doom.d' exist on your system"
(abbreviate-file-name doom-private-dir))
(explain! "Doom will only load one of these (~/.config/doom takes precedence). Possessing\n"
"both is rarely intentional; you should one or the other."))
;; Check for fonts
(if (not (fboundp 'find-font))
(progn
(warn! "Warning: unable to detect font")
(explain! "The `find-font' function is missing. This could indicate the incorrect "
"version of Emacs is being used!"))
;; all-the-icons fonts
(let ((font-dest (pcase system-type
(`gnu/linux (concat (or (getenv "XDG_DATA_HOME")
"~/.local/share")
"/fonts/"))
(`darwin "~/Library/Fonts/"))))
(when (and font-dest (require 'all-the-icons nil t))
(dolist (font all-the-icons-font-families)
(if (sh "fc-list | grep %s" font)
(success! "Found font %s" font)
(warn! "Warning: couldn't find %s font in %s"
font font-dest)
(explain! "You can install it by running `M-x all-the-icons-install-fonts' within Emacs.\n\n"
"This could also mean you've installed them in non-standard locations, in which "
"case feel free to ignore this warning."))))))